/src/core/document.lisp

  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)))))