/src/core/document.lisp
Lisp | 219 lines | 185 code | 22 blank | 12 comment | 9 complexity | 2c7be85bf087981c9f3148bdec78967a MD5 | raw file
1(in-package :chillax.core) 2 3;;; 4;;; Document errors 5;;; 6(define-condition document-error (couchdb-error) ()) 7 8(define-condition document-not-found (document-error) 9 ((id :initarg :id :reader document-404-id) 10 (db :initarg :db :reader document-404-db)) 11 (:report (lambda (e s) 12 (format s "No document with id ~S was found in ~A" 13 (document-404-id e) 14 (document-404-db e))))) 15 16(define-condition document-conflict (document-error) 17 ((conflicting-doc :initarg :doc :reader conflicting-document) 18 (conflicting-doc-id :initarg :id :reader conflicting-document-id)) 19 (:report (lambda (e s) 20 (format s "Revision for ~A conflicts with latest revision for~@ 21 document with ID ~S" 22 (conflicting-document e) 23 (conflicting-document-id e))))) 24 25;;; 26;;; Direct Document API 27;;; 28(defun get-document-revision (db doc-id &key (errorp t)) 29 "Quickly fetches the latest revision for DOC-ID. If ERRORP is NIL, this can be used to quickly 30test the existence of a document." 31 (multiple-value-bind (x status-code headers) 32 (http-request (strcat (db-uri db) "/" (url-encode (princ-to-string doc-id))) 33 :method :head) 34 (declare (ignore x)) 35 (case (or (cdr (assoc status-code +status-codes+ :test #'=)) 36 (error "Unknown status code: ~A." status-code)) 37 (:ok (dequote (cdr (assoc :etag headers)))) 38 (:not-found (when errorp (error 'document-not-found :db db :id doc-id)))))) 39 40(defun get-document (db id &key attachmentsp (errorp t) params) 41 "Finds a CouchDB document in DB, named by ID. PARAMS should be an alist containing the parameters 42for the HTTP GET request. If ATTACHMENTSP is TRUE, the document's attachments will be included in 43their entirety in their base64-encoded version. It is not recommended you use this unless you really 44know what you're doing. If ERRORP is NIL, GET-DOCUMENT will simply return NIL on 404." 45 (handle-request (response db (url-encode (princ-to-string id)) 46 :parameters (if attachmentsp 47 (cons (cons "attachments" "true") params) 48 params)) 49 (:ok response) 50 (:not-found (when errorp (error 'document-not-found :db db :id id))))) 51 52(defun put-document (db id doc &key batch-ok-p) 53 "Puts a document into DB, using ID." 54 (handle-request (response db (url-encode (princ-to-string id)) :method :put :content doc 55 :parameters (when batch-ok-p '(("batch" . "ok")))) 56 ((:created :accepted) response) 57 (:conflict (error 'document-conflict :id id :doc doc)))) 58 59(defun post-document (db doc) 60 "POSTs a document into DB. CouchDB will automatically assign a UUID if the document does not 61already exist. Note that using this function is discouraged in the CouchDB documentation, since it 62may result in duplicate documents because of proxies and other network intermediaries. If what you 63need is to create a new document with a generated id, consider using GET-UUIDS with PUT-DOCUMENT." 64 (handle-request (response db "" :method :post :content doc) 65 ((:created :accepted) response) 66 (:conflict (error 'document-conflict :doc doc)))) 67 68(defun delete-document (db id revision) 69 "Deletes an existing document." 70 (handle-request (response db 71 (strcat (url-encode (princ-to-string id)) 72 "?rev=" 73 (url-encode (princ-to-string revision))) 74 :method :delete) 75 (:ok response) 76 (:not-found (error 'document-not-found :db db :id id)))) 77 78(defun copy-document (db from-id to-id &key revision) 79 "Copies a document's content in-database." 80 (handle-request (response db (url-encode (princ-to-string from-id)) :method :copy 81 :additional-headers `(("Destination" . ,(princ-to-string to-id))) 82 :parameters `(,(when revision `("rev" . ,revision)))) 83 (:created response) 84 (:not-found (error 'document-not-found :db db :id from-id)))) 85 86;;; 87;;; Bulk Document API 88;;; 89(defun all-documents (db &rest all-keys) 90 "Requests the _all_docs document. ALL-KEYS correspond to GET-DOCUMENT's keyword arguments." 91 (apply #'get-document db "_all_docs" all-keys)) 92 93(defun batch-get-documents (db doc-ids) 94 "Uses _all_docs to quickly fetch the given DOC-IDs in a single request. Note that this function 95will NOT signal a DOCUMENT-NOT-FOUND error when one or more DOC-IDs are not found. Instead, the 96results will be returned, and it's the user's responsibility to deal with any missing docs." 97 (handle-request (response db "_all_docs" :method :post 98 :parameters '(("include_docs" . "true")) 99 :content (format nil "{\"keys\":~S}" 100 (data->json (database-server db) doc-ids)) 101 :convert-data-p nil) 102 (:ok response))) 103 104(defun bulk-post-documents (db documents &key all-or-nothing-p) 105 "Allows you to update or submit multiple documents at the same time, using CouchDB's _bulk_docs 106API. In order to delete a document through this API, the document must have a _document attribute 107with JSON 'true' as its value (note that what gets translated into 'true' depends on the server). 108 109DOCUMENTS must be a sequence or sequence-like (depending on what DATA->JSON will do to it). 110 111If ALL-OR-NOTHING-P is true, the entire submission will fail if a single one fails." 112 (let ((as-json (data->json (database-server db) documents))) 113 (handle-request (response db "_bulk_docs" :method :post 114 :content (with-output-to-string (s) 115 (princ "{\"docs\":" s) 116 (princ as-json s) 117 (when all-or-nothing-p 118 (princ ",\"all_or_nothing\":true" s)) 119 (princ "}" s)) 120 :convert-data-p nil) 121 ((:ok :accepted :created) response)))) 122 123;;; 124;;; Standalone Attachments 125;;; 126(defun put-attachment (db doc-id attachment-name data &key rev (content-type "application/octet-stream")) 127 "Adds DATA as an attachment. DATA can be a number of things: 128 129 * String or sequence of octets - DATA will be sent as-is directly to the server (using 130 EXTERNAL-FORMAT-OUT for strings). 131 * Stream - The stream will be read until EOF is reached. 132 * Pathname - The file the pathname denotes will be opened and its data uploaded. 133 * Function designator - The corresponding function will be called with one argument, the 134 stream to the server, to which it should send data. 135 136If the document already exists, REV is required. This function can be used on non-existent 137documents. If so, REV is not needed, and a document will be created automatically, and the 138attachment associated with it. 139 140The CONTENT-TYPE should be a string specifying the content type for DATA." 141 (multiple-value-bind (response status-code) 142 (http-request (strcat (server-uri (database-server db)) 143 "/" 144 (database-name db) 145 "/" 146 (url-encode (princ-to-string doc-id)) 147 "/" 148 attachment-name) 149 :method :put 150 :parameters (when rev 151 `(("rev" . ,rev))) 152 :content data 153 :content-type content-type) 154 (case (or (cdr (assoc status-code +status-codes+ :test #'=)) 155 (error "Unknown status code: ~A. HTTP Response: ~A" 156 status-code response)) 157 (:ok (json->data (database-server db) response)) 158 (:created (json->data (database-server db) response)) 159 (:not-found (error 'document-not-found :db db :id doc-id)) 160 (otherwise (error 'unexpected-response :status-code status-code :response response))))) 161 162(defun get-attachment (db doc-id attachment-name) 163 "Returns 3 values: 164 165 1. STREAM - An open flexi-stream that can be READ. In order to read straight binary data, you must 166 first fetch the underlying stream with FLEXI-STREAMS:FLEXI-STREAM-STREAM. 167 2. MUST-CLOSE-P - A boolean. If TRUE, the user must CLOSE this stream themselves 168 once reading is done. 169 3. CONTENT-LENGTH - Declared content length for the incoming data." 170 (multiple-value-bind (response status-code headers fourth fifth must-close-p) 171 (http-request (strcat (server-uri (database-server db)) 172 "/" 173 (database-name db) 174 "/" 175 (url-encode (princ-to-string doc-id)) 176 "/" 177 attachment-name) 178 :want-stream t) 179 (declare (ignore fourth fifth)) 180 (case (or (cdr (assoc status-code +status-codes+ :test #'=)) 181 (error "Unknown status code: ~A. HTTP Response: ~A" 182 status-code response)) 183 (:ok (values response must-close-p 184 (let ((content-length (cdr (assoc :content-length headers)))) 185 (when content-length (parse-integer content-length))))) 186 (:not-found (error 'document-not-found :db db :id doc-id)) 187 (otherwise (when (streamp response) (close response)) 188 (error 'unexpected-response :status-code status-code :response response))))) 189 190(defun delete-attachment (db doc-id attachment-name doc-revision) 191 "Deletes an attachment from a document. DOC-REVISION must be the latest revision for the document." 192 (multiple-value-bind (response status-code) 193 (http-request (strcat (server-uri (database-server db)) 194 "/" 195 (database-name db) 196 "/" 197 (url-encode (princ-to-string doc-id)) 198 "/" 199 attachment-name) 200 :method :delete 201 :parameters `(("rev" . ,doc-revision))) 202 (case (or (cdr (assoc status-code +status-codes+ :test #'=)) 203 (error "Unknown status code: ~A. HTTP Response: ~A" 204 status-code response)) 205 (:ok (json->data (database-server db) response)) 206 (:not-found (error 'document-not-found :db db :id doc-id)) 207 (otherwise (error 'unexpected-response :status-code status-code :response response))))) 208 209(defun copy-attachment (db doc-id attachment-name output-stream &key (max-buffer-size 4096)) 210 "Copies data from the named attachment to OUTPUT-STREAM. Returns the number of bytes copied." 211 (multiple-value-bind (attachment-stream must-close-p content-length) 212 (get-attachment db doc-id attachment-name) 213 (unwind-protect 214 (if (plusp content-length) 215 (copy-stream (flex:flexi-stream-stream attachment-stream) output-stream 216 :buffer-size (mod content-length max-buffer-size)) 217 0) 218 (when must-close-p 219 (close attachment-stream)))))