Skip to content
Browse files

made document API immutable

  • Loading branch information...
1 parent 5c3367e commit 6944a77c117a5103572f68044e2f368876d495dc @fmw committed Sep 22, 2012
View
4 resources/database-views/map_document_by_feed.js
@@ -1,5 +1,7 @@
function(doc) {
- if(doc.type === "document") {
+ if(doc.type === "document" &&
+ doc["current-state"] === true &&
+ doc.action !== "delete") {
emit([[doc.language, doc.feed], doc.published], doc);
}
}
View
2 resources/database-views/map_document_by_slug.js
@@ -1,5 +1,5 @@
function(doc) {
if(doc.type === "document") {
- emit(doc.slug, doc);
+ emit([doc.slug, doc.datestamp], doc);
}
}
View
4 resources/database-views/map_events_by_feed.js
@@ -1,5 +1,7 @@
function(doc) {
- if(doc.type === "document" && doc["end-time-rfc3339"]) {
+ if(doc.type === "document" &&
+ doc["end-time-rfc3339"] &&
+ doc["current-state"] === true) {
emit([[doc.language, doc.feed], doc["end-time-rfc3339"]], doc);
}
}
View
342 src/clj/vix/db.clj
@@ -14,7 +14,8 @@
;; limitations under the License.
(ns vix.db
- (:use [slingshot.slingshot :only [try+ throw+]])
+ (:use [slingshot.slingshot :only [try+ throw+]]
+ [clojure.set])
(:require [clojure.java.io :as io]
[com.ashafa.clutch :as clutch]
[vix.util :as util])
@@ -68,9 +69,10 @@
query-params-map
post-data-map))))
-(defn- clean-feed
- "Internal fn to extract value from a CouchDB result and
- remove the internal :current-state value."
+(defn- clean
+ "Internal fn to extract value from a CouchDB result and remove the
+ internal :current-state value. Also turns the :action value into a
+ keyword."
[clutch-result]
(update-in (dissoc (:value clutch-result) :current-state)
[:action]
@@ -81,7 +83,7 @@
given database, optionally restricting them to the provided
language. Omits deleted feeds."
[database & [language]]
- (map clean-feed
+ (map clean
(get-view database
"views"
:feeds_overview
@@ -97,7 +99,7 @@
language, limited to the provided default-document-type.
Omits deleted feeds."
[database default-document-type & [language]]
- (map clean-feed
+ (map clean
(get-view database
"views"
:feeds_by_default_document_type
@@ -116,7 +118,7 @@
the :current-state key (which makes the output immutable from the
viewpoint of this API)."
[database language name & [limit]]
- (map clean-feed
+ (map clean
(get-view database
"views"
:feeds
@@ -131,6 +133,13 @@
:endkey [language name nil]
:descending true}))))
+(def invalid-action
+ {:type ::invalid-action
+ :message (str "The provided :action value is invalid "
+ "(or \"action\" if JSON). The actions "
+ ":create, :update & :delete are allowed "
+ "(or \"create\", \"update\" & \"delete\" if JSON).")})
+
(def feed-update-conflict
{:type ::feed-update-conflict
:message "This feed map doesn't contain the most recent :previous-id."})
@@ -171,9 +180,12 @@
immutable."
[database {:keys [action language name previous-id] :as feed}]
- (let [previous-state (first (get-feed database language name 1))
+ (let [action (keyword action)
+ previous-state (first (get-feed database language name 1))
datestamp (util/now-rfc3339)]
(cond
+ (not (some #{action} [:create :update :delete]))
+ (throw+ invalid-action)
(and (= action :create)
(some #{(:action previous-state)} [:create :update]))
(throw+ feed-already-exists-conflict)
@@ -191,7 +203,8 @@
[(assoc (if (= action :create)
(assoc feed
:created datestamp)
- (dissoc feed :_rev :_id))
+ (assoc (dissoc feed :_rev :_id)
+ :created (:created previous-state)))
:type "feed"
:current-state true
:datestamp datestamp)
@@ -211,12 +224,13 @@
:startkey [feed {}]
:endkey [feed nil]
:descending true}]
- (map :value (get-view database
- "views"
- :events_by_feed
- (if (nil? limit)
- options
- (assoc options :limit limit))))))
+ (map clean
+ (get-view database
+ "views"
+ :events_by_feed
+ (if (nil? limit)
+ options
+ (assoc options :limit limit))))))
(defn get-documents-for-feed
"Returns documents for language and feed-name from the given database.
@@ -228,14 +242,14 @@
fn with the particular limit and the startkey_docid from the :next
map of the current page, with the :published value as startkey."
[database language feed-name & [limit startkey startkey_docid]]
- (let [feed [language feed-name]
- docs (map
- :value
+ (let [docs (map
+ clean
(get-view database
"views"
:by_feed
- (merge {:endkey [feed nil]
- :startkey [feed (or startkey "2999")]
+ (merge {:endkey [[language feed-name] nil]
+ :startkey [[language feed-name]
+ (or startkey "2999")]
:include_docs true
:descending true}
(when startkey_docid
@@ -254,153 +268,167 @@
(defn get-attachment-as-base64-string
"Returns Base64 encoded string or nil (if the attachment wasn't
found) for the attachment with the given attachment-key in
- id-or-document and database."
- [database id-or-doc attachment-key]
- (when-let [a (clutch/get-attachment database id-or-doc attachment-key)]
+ document-id and database."
+
+ [database document-id attachment-key]
+ (when-let [a (clutch/get-attachment database document-id attachment-key)]
(let [byte-array-os (java.io.ByteArrayOutputStream.)]
(io/copy a byte-array-os)
(Base64/encodeBase64String (.toByteArray byte-array-os)))))
(defn get-document
- "Retrieves the document identified by slug (the URI) from the given
- database, optionally adding an attachment if the
- include-attachment? argument evaluates to true. In that case, the
- attachment identified by the :original key is added to the returned
- map under the :attachment key (pointing to a map, with :type
- and :data keys for respectively the content type and a Base64
- encoded string representation of the attachment)."
- [database slug & [include-attachment?]]
- (let [doc (:value (first (get-view database
- "views"
- :by_slug
- {:include_docs true
- :key slug})))]
- (if (and include-attachment? (:original (:_attachments doc)))
- (assoc doc
- :attachment
- {:type (get-in doc [:_attachments :original :content_type])
- :data (get-attachment-as-base64-string database doc :original)})
- doc)))
+ "Retrieves all available states of the document identified by
+ slug (the URI) from the given database. It is possible to pass a
+ map with CouchDB query options as an optional third argument (e.g.
+ {:limit 1}). Note that when working with documents that have
+ attachments, each state will contain a Base64 encoded attachment.
+ This can be demanding in terms of bandwidth, so it is advisable to
+ use a query limit by default for documents that may contain
+ attachments."
+ [database slug & [couchdb-options]]
+ (let [states
+ (vec ;; turn into vector to enable assoc-in/get-in
+ (map (fn [raw-state]
+ (let [state (clean raw-state)]
+ (if (contains? state :_attachments)
+ (assoc (dissoc state :_attachments)
+ :attachments
+ {:original
+ {:type (get-in state [:_attachments
+ :original
+ :content_type])
+ :data (get-attachment-as-base64-string database
+ (:_id state)
+ :original)
+ :length (get-in state [:_attachments
+ :original
+ :length])}})
+ state)))
+ (get-view database
+ "views"
+ :by_slug
+ (merge {:include_docs true
+ :startkey [slug {}]
+ :endkey [slug nil]
+ :descending true}
+ couchdb-options))))]
+ (if (not-empty states)
+ states
+ nil)))
+
+(def document-update-conflict
+ {:type ::document-update-conflict
+ :message (str "This document map doesn't contain the most "
+ "recent :previous-id.")})
-(defn get-unique-slug
- "Checks given database if desired-slug is available. If so,
- it is returned. Otherwise a prefix is appended (e.g. -2) and the
- process is repeated until a unique slug is found. "
- [database desired-slug]
- (loop [slug desired-slug]
- (let [document (get-document database slug)]
- (if document
- (recur (util/increment-slug slug))
- slug))))
+(def document-already-exists-conflict
+ {:type ::document-already-exists-conflict
+ :message "There is an existing document with the provided slug."})
-(defn create-document
- "Creates document in the given database, with provided language and
- feed-name, assuming the given timezone for converting :start-time
- and :end-time in the provided document map to UTC. Apart from
- :start-time, :end-time and :slug, the document map is expected to
- have values for :draft, :content and :title. Other keys are also
- supported. Optionally saves an attachment when the document map
- contains an :attachment map with a mime type under
+(def document-already-deleted-error
+ {:type ::document-already-deleted
+ :message "This document has already been deleted."})
+
+(def document-missing-required-keys-error
+ {:type ::document-missing-required-keys
+ :message (str "This document is missing required keys. "
+ "The keys :slug, :language, :feed, :title "
+ "are required.")})
+
+(defn append-to-document
+ "Accepts a map describing a document state to be stored in the given
+ database. The map must contain the following
+ keys: :action (i.e. :create, :update, :delete),
+ :previous-id, :slug, :language and :feed-name. The :previous-id
+ value is the CouchDB document ID for the document describing the
+ previous state and is only required only for :update and :delete
+ actions. If the :previous-id doesn't refer to the last state of the
+ feed, a :vix.db/feed-update-conflict exception is thrown.
+ Optionally saves an attachment when the document map contains
+ an :attachment map with a mime type under
:type and the Base64 encoded data under :data. Returns the newly
- created document."
- [database
- language
- feed-name
- timezone
- {:keys [slug start-time end-time] :as document}]
- (let [unique-slug (get-unique-slug database slug)
- doc (clutch/put-document
- database
- (merge (dissoc document :attachment)
- {:type "document"
- :feed feed-name
- :language language
- :slug unique-slug
- :published (util/now-rfc3339)}
- (when start-time
- {:start-time-rfc3339
- (util/editor-datetime-to-rfc3339 start-time
- timezone)})
- (when end-time
- {:end-time-rfc3339
- (util/editor-datetime-to-rfc3339 end-time
- timezone)})))]
- (if-not (and (nil? (:data (:attachment document)))
- (nil? (:type (:attachment document))))
- (do
- (clutch/put-attachment database
- doc
- (Base64/decodeBase64
- (:data (:attachment document)))
- :filename :original
- :mime-type (:type (:attachment document)))
- ;; return newly fetched doc from db (including attachment)
- (get-document database unique-slug true))
- ;; when there is no attachment we don't need to refetch
- doc)))
+ created document state appended to the existing states. The
+ optional fourth argument, couchdb-options, is a map with options
+ to be passed to the final get-document call that returns the
+ states for the document.
+
+ Currently returns a copy of the attachment for every state of the
+ document, which has an obvious downside in terms of bandwidth usage
+ (particularly for larger images). This trade-off might change in a
+ future version of the API, but for now the consideration is that
+ documents with attachments are generally not updated so much for
+ this to become a problem. The upside is consistency and immutability
+ in the output of this function. The good news is that the optional
+ fourth argument, couchdb-options, allows for passing a limit
+ (e.g. {:limit 1}). This means that you can restrict the number of
+ returned states, which is useful for appends to really big documents.
-(defn update-document
- "Updates document with provided slug in given database,
- using the values from new-doc and given timezone to convert the
- editor datetime to UTC. The :start-time and :end-type keys are used
- for event documents. Generates RFC3339 timestamps for :updated, as
- well as :start-time-rfc3339 and :end-time-rfc3339 (using the values
- from :start-time and :end-time). Updates the following document
- keys: :title, :subtitle, :content, :description, draft, :start-time,
- :end-time, :icon, :related-pages and :related-images. Returns the
- updated document."
- [database timezone slug new-doc]
- (if-let [document (get-document database slug)]
- (let [doc (clutch/put-document
- database
- (merge (dissoc document :attachment)
- {:updated (util/now-rfc3339)
- :title (:title new-doc)
- :subtitle (:subtitle new-doc)
- :content (:content new-doc)
- :description (:description new-doc)
- :draft (:draft new-doc)
- :start-time (:start-time new-doc)
- :end-time (:end-time new-doc)
- :icon (:icon new-doc)
- :related-pages (:related-pages new-doc)
- :related-images (:related-images new-doc)}
- (when (:start-time new-doc)
- {:start-time-rfc3339 (util/editor-datetime-to-rfc3339
- (:start-time new-doc)
- timezone)})
- (when (:end-time new-doc)
- {:end-time-rfc3339 (util/editor-datetime-to-rfc3339
- (:end-time new-doc)
- timezone)})))]
-
- (if-not (and (nil? (:data (:attachment new-doc)))
- (nil? (:type (:attachment new-doc))))
- (do
- (clutch/put-attachment database
- doc
- (Base64/decodeBase64
- (:data (:attachment new-doc)))
- :filename :original
- :mime-type (:type (:attachment new-doc)))
- ;; return newly fetched doc from db (including attachment)
- (get-document database slug true))
- ;; when there is no attachment we don't need to refetch
- doc))))
+ Optionally, the document map may contain :start-time and
+ :end-time keys mapping to date strings in yyyy-MM-dd HH:mm format.
+ These keys and their values are removed and used to create
+ :start-date-rfc3339 and :end-date-rfc3339.
-(defn delete-document
- "Deletes the document with the given slug from the provided database.
- Returns a map with the :ok key mapped to true and an :id and :rev
- if successful or nil if the document couldn't be found or in case
- of a 409 conflict."
- [database slug]
- (when-let [document (get-document database slug)]
- (try+
- (clutch/delete-document database document)
- ;; could possibly raise an kind of error to differentiate between
- ;; not found and 409, but not important for now.
- (catch java.io.IOException _ ; for 409 conflicts
- nil))))
+ Also see the append-to-feed docstring."
+
+ [database
+ timezone
+ {:keys [action slug previous-id start-time end-time] :as document}
+ & [couchdb-options]]
+ (let [action (keyword action) ;; fix action for json requests
+ previous-state (first (get-document database slug {:limit 1}))
+ datestamp (util/now-rfc3339)]
+ (cond
+ (not (some #{action} [:create :update :delete]))
+ (throw+ invalid-action)
+ (and (= action :create)
+ (some #{(:action previous-state)} [:create :update]))
+ (throw+ document-already-exists-conflict)
+ (and (not (= action :create))
+ (not (= (:_id previous-state) previous-id)))
+ (throw+ document-update-conflict)
+ (and (= action :delete) (= (:action previous-state) :delete))
+ (throw+ document-already-deleted-error)
+ (not (subset? #{:slug :language :feed :title} (set (keys document))))
+ (throw+ document-missing-required-keys-error)
+ :default
+ (do
+ (clutch/bulk-update
+ database
+ (filter #(not (nil? %))
+ ;; new state
+ [(merge (dissoc document
+ :_id
+ :_rev
+ :attachment
+ :start-time
+ :end-time)
+ {:type "document"
+ :current-state true
+ :datestamp datestamp}
+ (if (= action :create)
+ {:created datestamp
+ :published datestamp}
+ {:created (:created previous-state)
+ :published (:published previous-state)})
+ (when start-time
+ {:start-time-rfc3339
+ (util/editor-datetime-to-rfc3339 start-time
+ timezone)})
+ (when end-time
+ {:end-time-rfc3339
+ (util/editor-datetime-to-rfc3339 end-time
+ timezone)})
+ (when (not
+ (and (nil? (:data (:attachment document)))
+ (nil? (:type (:attachment document)))))
+ {:_attachments
+ {:original
+ {:content_type (:type (:attachment document))
+ :data (:data (:attachment document))}}}))
+ ;; update previous state
+ (when previous-state
+ (assoc previous-state :current-state false))]))
+ (get-document database slug (or couchdb-options {}))))))
(defn get-available-languages [database]
"Returns a sequence of available languages directly from the database."
View
238 src/clj/vix/routes.clj
@@ -34,6 +34,12 @@
{:type ::invalid-request-body
:message "The JSON or Clojure request body is invalid."})
+(def method-action-mismatch-error
+ {:type ::method-action-mismatch
+ :message (str "The :action value in the provided map must correspond "
+ "to the right HTTP method (i.e. POST & :create, "
+ "PUT & :update and DELETE and :delete).")})
+
(def available-languages
"Atom; Sequence of available languages used for language selection."
(atom (db/get-available-languages config/database)))
@@ -122,31 +128,28 @@
(response "<h1>Page not found</h1>" :status 404))
(defn image-response
- "Returns the attachment for the :original key for the given document
- in database, or a page-not-found-response if the attachment wasn't
- found. Uses the CouchDB revision identifier as the value for the HTTP
- ETag header and uses the most recent date from the document (either
+ "Returns the attachment for the :original key of the most recent
+ state in the given document-state sequence in database, or a
+ page-not-found-response if the attachment wasn't found. Uses the
+ CouchDB revision identifier as the value for the HTTP ETag header
+ and uses the most recent date from the document (either
:updated or published) as the value of the Last-Modified header."
- [database document]
- (if-let [attachment (clutch/get-attachment database
- document
- :original)]
- (let [resp (response attachment
- :content-type (:content_type
- (:original
- (:_attachments
- document))))]
- (assoc resp :headers
- (assoc (:headers resp)
- "ETag"
- (:_rev document))
- "Last-Modified"
- (time-format/unparse (time-format/formatters :rfc822)
- (util/rfc3339-to-jodatime
- (or (:updated document)
- (:published document))
- "UTC"))))
- (page-not-found-response)))
+ [database document-states]
+ (let [{:keys [_id attachments datestamp] :as document}
+ (first document-states)]
+ (if-let [attachment (clutch/get-attachment database _id :original)]
+ (let [resp (response attachment
+ :content-type
+ (:type (:original attachments)))]
+ (assoc resp :headers
+ (assoc (:headers resp)
+ "ETag"
+ (:_rev document)
+ "Last-Modified"
+ (time-format/unparse (time-format/formatters :rfc822)
+ (util/rfc3339-to-jodatime datestamp
+ "UTC")))))
+ (page-not-found-response))))
(defmulti get-segment
"Multimethod that retrieves the data associated with a page segment
@@ -164,7 +167,9 @@
[segment-details database language timezone]
(assoc segment-details
:data
- (db/get-document database ((:slug segment-details) language))))
+ (first (db/get-document database
+ ((:slug segment-details) language)
+ {:limit 1}))))
(defmethod get-segment :most-recent-events
[segment-details database language timezone]
@@ -258,30 +263,32 @@
[database slug timezone]
(if-let [p (get @page-cache slug)]
p
- (if-let [document (db/get-document database slug)]
- (cond
- ;; files always skip the cache
- (:original (:_attachments document))
- (image-response database document)
- ;; for event-like documents
- ;;(not (nil? (:end-time-rfc3339 document)))
- ;; for all other documents
- :default
- (do
- (swap! page-cache
- assoc
- slug
- (response
- (views/page-view (:language document)
- timezone
- document
- (get-segments (:default-page
- config/page-segments)
- database
- (:language document)
- timezone))))
- (get-cached-page! database slug timezone)))
- (page-not-found-response))))
+ (let [{:keys [attachments language] :as document}
+ (first (db/get-document database slug {:limit 1}))]
+ (if (and document (not (= (keyword (:action document)) :delete)))
+ (cond
+ ;; files always skip the cache
+ (:original attachments)
+ (image-response database [document])
+ ;; for event-like documents
+ ;;(not (nil? (:end-time-rfc3339 document)))
+ ;; for all other documents
+ :default
+ (do
+ (swap! page-cache
+ assoc
+ slug
+ (response
+ (views/page-view language
+ timezone
+ document
+ (get-segments (:default-page
+ config/page-segments)
+ database
+ language
+ timezone))))
+ (get-cached-page! database slug timezone)))
+ (page-not-found-response)))))
(defn reset-page-cache!
"Resets the page-cache atom to an empty map."
@@ -363,61 +370,47 @@
method))
(defmethod document-request :GET
- [method response-type new-doc existing-doc language feed-name]
- (data-response existing-doc :type response-type))
+ [method response-type doc]
+ (data-response doc :type response-type))
(defmethod document-request :POST
- [method response-type new-doc existing-doc language feed-name]
- (let [document (db/create-document config/database
- language
- feed-name
- config/default-timezone
- new-doc)]
+ [method response-type {:keys [language] :as doc}]
+ (let [document (db/append-to-document config/database
+ config/default-timezone
+ doc)]
(reset-index-reader!)
- (lucene/add-documents-to-index! lucene/directory [new-doc])
+ (lucene/add-documents-to-index! lucene/directory [(first document)])
(reset-all! config/database language)
(data-response document :status 201 :type response-type)))
(defmethod document-request :PUT
- [method
- response-type
- new-doc
- {:keys [slug feed] :as existing-doc}
- language
- feed-name]
- (if (and existing-doc
- (= slug (:slug new-doc))
- (= feed (:feed new-doc))
- (= language (:language existing-doc) (:language new-doc)))
- (let [document (db/update-document config/database
- config/default-timezone
- slug
- new-doc)]
- (reset-index-reader!)
- (lucene/update-document-in-index! lucene/directory slug document)
- (reset-all! config/database language)
- (data-response document :type response-type))
- (data-response nil :type response-type)))
+ [method response-type {:keys [language slug] :as doc}]
+ (let [document (db/append-to-document config/database
+ config/default-timezone
+ doc)]
+ (reset-index-reader!)
+ (lucene/update-document-in-index! lucene/directory slug (first document))
+ (reset-all! config/database language)
+ (data-response document :type response-type)))
(defmethod document-request :DELETE
- [method
- response-type
- new-doc
- {:keys [slug] :as existing-doc}
- language ; FIXME: take language from doc, not uri
- feed-name]
- (if existing-doc
- (let [document (db/delete-document config/database slug)]
- (reset-index-reader!)
- (lucene/delete-document-from-index! lucene/directory slug)
- (reset-all! config/database language)
- (data-response document :type response-type))
- (data-response nil :type response-type)))
+ [method response-type {:keys [language slug] :as doc}]
+ (let [document (db/append-to-document config/database
+ config/default-timezone
+ doc)]
+ (reset-index-reader!)
+ (lucene/delete-document-from-index! lucene/directory slug)
+ (reset-all! config/database language)
+ (data-response document :type response-type)))
(def http-methods
"HTTP method as keywords, with lowercase keys and uppercase values."
{:get :GET :post :POST :put :PUT :delete :DELETE})
+(def method-action-matches
+ "Mapping of HTTP methods to feed/document map :action values."
+ {:POST :create :PUT :update :DELETE :delete})
+
(defn read-body
"Returns a string representation of body, treated like the provided
type. Supported types are json and clj (with the lattter as the
@@ -545,46 +538,37 @@
body :body
session :session}
(let [method (http-methods lowercase-method)
- new-doc (read-body type body)]
- ;; FIXME: add authenticate for both old and new feed
- ;; if not :POST/GET
+ {:keys [action] :as new-doc} (read-body type body)]
(when (if (= method :POST)
(authorize session :POST nil :*)
(authorize session method language feed-name))
- (feed-request config/database
- method
- (keyword type)
- new-doc
- language
- feed-name))))
+ (if (or (= method :GET)
+ (= (keyword action) (method-action-matches method)))
+ (feed-request config/database
+ method
+ (keyword type)
+ new-doc
+ language
+ feed-name)
+ (throw+ method-action-mismatch-error)))))
(ANY "/_api/:type/_document/*"
{lowercase-method :request-method
{type :type raw-slug :*} :params
body :body
session :session}
- (let [method (http-methods lowercase-method)
- existing-doc (db/get-document
- config/database
- (util/force-initial-slash raw-slug)
- true)
- new-doc (read-body type body)
- feed (or (:feed new-doc)
- (:feed existing-doc))
- language (or (:language new-doc)
- (:language existing-doc))]
- ;; FIXME: authenticate both new & old if not GET/POST/HEAD
- (when (if (= method :GET)
- (authorize session
- method
- (:language existing-doc)
- (:feed existing-doc))
- (authorize session method language feed))
- (document-request method
- (keyword type)
- new-doc
- existing-doc
- language
- feed))))
+ (let [method
+ (http-methods lowercase-method)
+ {:keys [action language feed] :as doc}
+ (if (= method :GET)
+ (db/get-document
+ config/database
+ (util/force-initial-slash raw-slug))
+ (read-body type body))]
+ (when (authorize session method language feed)
+ (if (or (= method :GET)
+ (= (keyword action) (method-action-matches method)))
+ (document-request method (keyword type) doc)
+ (throw+ method-action-mismatch-error)))))
(route/resources "/static/")
(GET "/*"
{{slug :*} :params}
@@ -609,11 +593,21 @@
(redirect "/login"))
(catch [:type :vix.routes/invalid-request-body] e
(data-error-response (:message e)))
+ (catch [:type :vix.routes/method-action-mismatch] e
+ (data-error-response (:message e)))
(catch [:type :vix.db/feed-already-deleted] e
(data-error-response (:message e)))
(catch [:type :vix.db/feed-update-conflict] e
(data-error-response (:message e)))
(catch [:type :vix.db/feed-already-exists-conflict] e
+ (data-error-response (:message e)))
+ (catch [:type :vix.db/document-already-exists-conflict] e
+ (data-error-response (:message e)))
+ (catch [:type :vix.db/document-update-conflict] e
+ (data-error-response (:message e)))
+ (catch [:type :vix.db/document-already-deleted] e
+ (data-error-response (:message e)))
+ (catch [:type :vix.db/document-missing-required-keys] e
(data-error-response (:message e))))))
(defn wrap-caching-headers
View
26 src/cljs/src/document.cljs
@@ -47,14 +47,26 @@
(defn get-doc [slug callback]
(request-doc slug callback "GET" nil))
-(defn delete-doc [slug callback]
- (request-doc slug callback "DELETE" nil))
+(defn append-to-document
+ [{:keys [action slug] :as doc} callback]
+ (request-doc slug
+ callback
+ ({:create "POST" :update "PUT" :delete "DELETE"} action)
+ doc))
-(defn create-doc [slug callback doc]
- (request-doc slug callback "POST" doc))
-
-(defn update-doc [slug callback doc]
- (request-doc slug callback "PUT" doc))
+(defn delete-document-shortcut [slug callback]
+ (get-doc slug
+ (fn [e]
+ (let [xhr (.-target e)
+ status (. xhr (getStatus))]
+ (if (= status 200)
+ (let [document (first
+ (reader/read-string
+ (. xhr (getResponseText))))]
+ (append-to-document (assoc document
+ :previous-id (:_id document)
+ :action :delete)
+ callback)))))))
(defn get-documents-for-feed
[language feed-name callback & [limit startkey-published startkey_docid]]
View
221 src/cljs/src/views/editor.cljs
@@ -287,13 +287,18 @@
(str slug "-2")))
(defn handle-duplicate-slug-callback [e]
- (let [status (. (.-target e) (getStatus))
+ (let [xhr (.-target e)
slug-el (dom/getElement "slug")]
- (when (= status 200)
- (ui/set-form-value slug-el
- (increment-slug
- (document/add-initial-slash (.-value slug-el))))
- (document/get-doc (.-value slug-el) handle-duplicate-slug-callback))))
+ (when (= (. xhr (getStatus)) 200)
+ (let [last-state (first
+ (reader/read-string (. xhr (getResponseText))))]
+ (when-not (= (:action last-state) :delete)
+ (ui/set-form-value slug-el
+ (increment-slug
+ (document/add-initial-slash
+ (.-value slug-el))))
+ (document/get-doc (.-value slug-el)
+ handle-duplicate-slug-callback))))))
(defn handle-duplicate-custom-slug-callback [e]
(let [status (. (.-target e) (getStatus))
@@ -439,28 +444,25 @@
(dom/getElement "related-images-container")))}))
-(defn handle-successful-save []
- (enable-save-button!))
+(defn handle-successful-save [new-uri new-title]
+ (enable-save-button!)
+ (util/navigate-replace-state new-uri new-title))
(defn save-new-document-xhr-callback [e]
(let [xhr (.-target e)]
(if (= (.getStatus xhr e) 201)
- (let [doc (reader/read-string (. xhr (getResponseText)))]
- (util/navigate-replace-state (str (:language doc)
- "/"
- (:feed doc)
- "/edit"
- (:slug doc))
- (str "Edit \"" (:title doc) "\""))
- (handle-successful-save))
+ (let [{:keys [language feed slug title]}
+ (first (reader/read-string (. xhr (getResponseText))))]
+ (handle-successful-save (str language "/" feed "/edit" slug)
+ (str "Edit \"" title "\"")))
(ui/display-error (dom/getElement "status-message")
could-not-create-document-err))))
(defn save-new-document-click-callback [language feed-name & _]
- (let [doc (get-document-value-map! language feed-name)]
- (document/create-doc (:slug doc)
- save-new-document-xhr-callback
- doc)))
+ (document/append-to-document (assoc (get-document-value-map! language
+ feed-name)
+ :action :create)
+ save-new-document-xhr-callback))
(defn get-link-data-from-li [el]
(when-not (classes/has el "add-item-node") ; ignore "Add Item" li
@@ -487,32 +489,40 @@
menu-string)))
(defn save-new-menu-document-click-callback [language feed-name & _]
- (let [doc (get-document-value-map! language
- feed-name
- (render-menu-content-string!))]
- (document/create-doc (:slug doc)
- save-new-document-xhr-callback
- doc)))
+ (document/append-to-document (assoc (get-document-value-map!
+ language
+ feed-name
+ (render-menu-content-string!))
+ :action :create)
+ save-new-document-xhr-callback))
(defn save-existing-document-xhr-callback [e]
(let [xhr (.-target e)]
(if (= (. xhr (getStatus)) 200)
- (handle-successful-save)
+ (let [{:keys [language feed slug title]}
+ (first (reader/read-string (. xhr (getResponseText))))]
+ (handle-successful-save (str language "/" feed "/edit" slug)
+ (str "Edit \"" title "\"")))
(ui/display-error (dom/getElement "status-message")
could-not-save-document-err))))
-(defn save-existing-document-click-callback [language feed-name & _]
- (document/update-doc (.-value (dom/getElement "slug"))
- save-existing-document-xhr-callback
- (get-document-value-map! language feed-name)))
-
-(defn save-existing-menu-document-click-callback [language feed-name & _]
- (document/update-doc (.-value (dom/getElement "slug"))
- save-existing-document-xhr-callback
- (get-document-value-map!
- language
- feed-name
- (render-menu-content-string!))))
+(defn save-existing-document-click-callback
+ [language feed-name previous-id & _]
+ (document/append-to-document (assoc (get-document-value-map! language
+ feed-name)
+ :action :update
+ :previous-id previous-id)
+ save-existing-document-xhr-callback))
+
+(defn save-existing-menu-document-click-callback
+ [language feed-name previous-id & _]
+ (document/append-to-document (assoc (get-document-value-map!
+ language
+ feed-name
+ (render-menu-content-string!))
+ :action :update
+ :previous-id previous-id)
+ save-existing-document-xhr-callback))
(defn strip-filename-extension [filename]
(let [pieces (re-find #"^(.*?)\.[a-zA-Z0-9]{1,10}$" filename)]
@@ -530,7 +540,8 @@
:src (.-result (.-target e))})))
(. reader (readAsDataURL file))))
-(defn save-image-document-click-callback [create? language feed-name]
+(defn save-image-document-click-callback
+ [create? language feed-name previous-id current-attachments]
(let [file (:obj @*file*)]
(if file
(let [reader (new js/FileReader)]
@@ -539,21 +550,28 @@
(let [image-data {:type (.-type file)
:data (base64/encodeString
(.-result (.-target e)))}
- doc (assoc (get-document-value-map! language feed-name)
- :attachment image-data)]
- (if create?
- (document/create-doc (:slug doc)
- save-new-document-xhr-callback
- doc)
- (document/update-doc (:slug doc)
- save-existing-document-xhr-callback
- doc)))))
+ doc (merge (get-document-value-map! language feed-name)
+ {:action (if create?
+ :create
+ :update)
+ :attachment image-data}
+ (when (not create?)
+ {:previous-id previous-id}))]
+ (document/append-to-document
+ doc
+ (if create?
+ save-new-document-xhr-callback
+ save-existing-document-xhr-callback)))))
(. reader (readAsBinaryString file)))
(if-not create?
;; update without changing image
- (document/update-doc (.-value (dom/getElement "slug"))
- save-existing-document-xhr-callback
- (get-document-value-map! language feed-name))
+ (document/append-to-document (assoc
+ (get-document-value-map! language
+ feed-name)
+ :action :update
+ :previous-id previous-id
+ :attachments current-attachments)
+ save-existing-document-xhr-callback)
(ui/display-error (dom/getElement "status-message")
file-required-err)))))
@@ -562,37 +580,37 @@
(. e (preventDefault))
(. e (stopPropagation)))
- (let [status-el (dom/getElement "status-message")
- image-information-el (dom/getElement "image-information")
- file (aget (.-files (.-dataTransfer e)) 0)
- title (string/join " "
- (filter #(not (string/blank? %))
- (.split (strip-filename-extension
- (.-name file))
- #"[^a-zA-Z0-9]")))
- extension (cond
- (= (.-type file) "image/png") "png"
- (= (.-type file) "image/gif") "gif"
- (= (.-type file) "image/jpeg") "jpg")]
- (if extension
- (do
- (swap! *file* assoc :obj file :data {:extension extension})
- (ui/remove-error status-el)
- (ui/set-form-value (dom/getElement "title") title)
- (display-image-preview file title)
- (classes/remove image-information-el "hide")
- (ui/render-template image-information-el
- tpl/image-information
- {:filename (.-name file)
- :filetype (.-type file)
- :size (/ (.-size file) 1024)})
+ (if-let [file (aget (.-files (.-dataTransfer e)) 0)]
+ (let [status-el (dom/getElement "status-message")
+ image-information-el (dom/getElement "image-information")
+ title (string/join " "
+ (filter #(not (string/blank? %))
+ (.split (strip-filename-extension
+ (.-name file))
+ #"[^a-zA-Z0-9]")))
+ extension (cond
+ (= (.-type file) "image/png") "png"
+ (= (.-type file) "image/gif") "gif"
+ (= (.-type file) "image/jpeg") "jpg")]
+ (if extension
+ (do
+ (swap! *file* assoc :obj file :data {:extension extension})
+ (ui/remove-error status-el)
+ (ui/set-form-value (dom/getElement "title") title)
+ (display-image-preview file title)
+ (classes/remove image-information-el "hide")
+ (ui/render-template image-information-el
+ tpl/image-information
+ {:filename (.-name file)
+ :filetype (.-type file)
+ :size (/ (.-size file) 1024)})
- (when (= status "new")
- (sync-slug-with-title feed)))
- (do
- (swap! *file* dissoc :obj :data)
- (classes/add image-information-el "hide")
- (ui/display-error status-el invalid-filetype-err)))))
+ (when (= status "new")
+ (sync-slug-with-title feed)))
+ (do
+ (swap! *file* dissoc :obj :data)
+ (classes/add image-information-el "hide")
+ (ui/display-error status-el invalid-filetype-err))))))
(defn render-editor-template [mode data]
(ui/render-template (dom/getElement "main-page")
@@ -1113,10 +1131,15 @@
:default :default)
tpl-map (if (and (= mode :image) (not new?))
(assoc tpl-map :image (str "data:"
- (:type (:attachment tpl-map))
+ (get-in tpl-map
+ [:attachments
+ :original
+ :type])
";base64,"
- (:data
- (:attachment tpl-map))))
+ (get-in tpl-map
+ [:attachments
+ :original
+ :data])))
tpl-map)]
(if new?
(do
@@ -1147,7 +1170,9 @@
(save-image-document-click-callback
true
(:language feed)
- (:name feed)))
+ (:name feed)
+ (:_id tpl-map)
+ (:attachments tpl-map)))
(= mode :menu)
(do
(save-new-menu-document-click-callback
@@ -1164,17 +1189,21 @@
(save-image-document-click-callback
false
(:language feed)
- (:name feed)))
+ (:name feed)
+ (:_id tpl-map)
+ (:attachments tpl-map)))
(= mode :menu)
(do
(save-existing-menu-document-click-callback
(:language feed)
- (:name feed)))
+ (:name feed)
+ (:_id tpl-map)))
:default
(do
(save-existing-document-click-callback
(:language feed)
- (:name feed)))))))]
+ (:name feed)
+ (:_id tpl-map)))))))]
(events/listen (dom/getElement "save-document")
"click"
@@ -1372,9 +1401,10 @@
(fn [e]
(let [xhr (.-target e)]
(if (= (. xhr (getStatus)) 200)
- (let [doc (reader/read-string
- (. xhr
- (getResponseText)))]
+ (let [doc (first
+ (reader/read-string
+ (. xhr
+ (getResponseText))))]
(util/set-page-title!
(str "Edit \"" (:title doc) "\""))
(render-editor feed
@@ -1402,8 +1432,9 @@
(fn [e]
(let [xhr (.-target e)]
(if (= (. xhr (getStatus)) 200)
- (let [doc (reader/read-string
- (. xhr (getResponseText)))]
+ (let [doc (first
+ (reader/read-string
+ (. xhr (getResponseText))))]
(util/set-page-title!
(str "Edit \"" (:title doc) "\""))
(render-editor feed
@@ -1416,7 +1447,7 @@
(defn start-mode-callback! [slug status event]
(let [xhr (.-target event)]
(when (= (. xhr (getStatus)) 200)
- (let [feed (reader/read-string (. xhr (getResponseText)))]
+ (let [feed (first (reader/read-string (. xhr (getResponseText))))]
(call-with-feeds-and-documents
(:language feed)
(fn [feeds documents]
View
9 src/cljs/src/views/feed.cljs
@@ -131,10 +131,11 @@
(let [slug (nth
(string/split (.-id (.-target e)) "_")
2)]
- (document/delete-doc slug
- (partial delete-doc-callback
- language
- feed-name))))))
+ (document/delete-document-shortcut
+ slug
+ (partial delete-doc-callback
+ language
+ feed-name))))))
(defn create-feed-list-events []
(util/xhrify-internal-links! (util/get-internal-links!))
(events/listen (dom/getElement "add-feed")
View
1,119 test/clj/vix/test/db.clj
@@ -99,17 +99,17 @@
(is (= (:map (:by_slug (:views view-doc)))
(str "function(doc) {\n"
" if(doc.type === \"document\") {\n"
- " emit(doc.slug, doc);\n"
- " }\n"
- "}\n")))
+ " emit([doc.slug, doc.datestamp], doc);\n"
+ " }\n}\n")))
(is (= (:map (:by_feed (:views view-doc)))
(str "function(doc) {\n"
- " if(doc.type === \"document\") {\n"
- " emit([[doc.language, doc.feed], doc.published]"
- ", doc);\n"
- " }\n"
- "}\n")))
+ " if(doc.type === \"document\" &&\n"
+ " doc[\"current-state\"] === true &&\n"
+ " doc.action !== \"delete\") {\n"
+ " emit([[doc.language, doc.feed], doc.published], "
+ "doc);\n"
+ " }\n}\n")))
(is (= (:map (:by_username (:views view-doc)))
(str "function(doc) {\n"
@@ -120,8 +120,9 @@
(is (= (:map (:events_by_feed (:views view-doc)))
(str "function(doc) {\n"
- " if(doc.type === \"document\" "
- "&& doc[\"end-time-rfc3339\"]) {\n"
+ " if(doc.type === \"document\" &&\n"
+ " doc[\"end-time-rfc3339\"] &&\n"
+ " doc[\"current-state\"] === true) {\n"
" emit([[doc.language, doc.feed], "
"doc[\"end-time-rfc3339\"]], doc);\n }\n}\n")))
@@ -145,73 +146,140 @@
(deftest test-get-attachment-as-base64-string
(let [gif (str "R0lGODlhAQABA++/vQAAAAAAAAAA77+9AQIAAAAh77+9BAQUA++/"
"vQAsAAAAAAEAAQAAAgJEAQA7")
- document (create-document +test-db+
- "en"
- "images"
- "Europe/Amsterdam"
- {:attachment {:type "image/gif"
- :data gif}
- :title "a single black pixel!"
- :slug "pixel.gif"
- :content ""
- :draft false})]
- (is (= (get-attachment-as-base64-string +test-db+ document :original)
+ document (append-to-document +test-db+
+ "Europe/Amsterdam"
+ {:action :create
+ :attachment {:type "image/gif"
+ :data gif}
+ :feed "images"
+ :language "en"
+ :title "a single black pixel!"
+ :slug "pixel.gif"
+ :content ""
+ :draft false})]
+ (is (= (get-attachment-as-base64-string +test-db+
+ (:_id (first document))
+ :original)
gif))))
(deftest test-get-document
- (do
- (create-document +test-db+
- "en"
- "blog"
- "Europe/Amsterdam"
- {:title "foo"
- :slug "/blog/foo"
- :content "bar"
- :draft true}))
-
- ;; we didn't create the view manually here, this test also implies
- ;; are created automatically by get-document
- (let [document (get-document +test-db+ "/blog/foo")]
- (is (couchdb-id? (:_id document)))
- (is (couchdb-rev? (:_rev document)))
- (is (iso-date? (:published document)))
- (is (= (:language document) "en"))
- (is (= (:feed document) "blog"))
- (is (= (:title document) "foo"))
- (is (= (:slug document) (str "/blog/foo")))
- (is (= (:content document) "bar"))
- (is (true? (:draft document))))
-
- (testing "Test if attachments are handled correctly."
- (let [gif (str "R0lGODlhAQABA++/vQAAAAAAAAAA77+9AQIAAAAh77+9BAQUA++/"
- "vQAsAAAAAAEAAQAAAgJEAQA7")]
- (do
- (create-document +test-db+
- "en"
- "images"
+ (is (nil? (get-document +test-db+ "/blog/foo")))
+ (is (nil? (get-document +test-db+ "/blog/foo" {:limit 100000})))
+
+ (with-redefs [util/now-rfc3339 #(str "2012-09-15T23:48:58.050Z")]
+ (append-to-document +test-db+
"Europe/Amsterdam"
- {:attachment {:type "image/gif" :data gif}
- :title "a single black pixel!"
- :slug "/images/white-pixel.gif"
- :content ""
- :draft false})
- (create-document +test-db+
- "en"
- "images"
+ {:action :create
+ :title "foo"
+ :slug "/blog/foo"
+ :language "en"
+ :feed "blog"
+ :content "bar"
+ :draft true})
+ (append-to-document +test-db+
"Europe/Amsterdam"
- {:title "not a single black pixel!"
- :slug "/images/not-a-white-pixel.gif"
- :content ""
+ {:action :update
+ :previous-id (:_id
+ (first
+ (get-document
+ +test-db+
+ "/blog/foo")))
+ :title "foo"
+ :slug "/blog/foo"
+ :language "en"
+ :feed "blog"
+ :content "bar"
:draft false}))
- (is (= (:attachment (get-document +test-db+
- "/images/white-pixel.gif"
- true))
- {:type "image/gif" :data gif}))
+ ;; The view isn't created manually; successful execution of
+ ;; this test also implies that it is created automatically.
- (is (nil? (:attachment (get-document +test-db+
- "/images/not-a-white-pixel.gif"
- true)))))))
+ (is (couchdb-id? (:_id (first (get-document +test-db+ "/blog/foo")))))
+ (is (couchdb-rev? (:_rev (first (get-document +test-db+ "/blog/foo")))))
+
+ (is (= (vec (map #(dissoc % :_id :_rev :previous-id)
+ (get-document +test-db+ "/blog/foo")))
+ [{:slug "/blog/foo"
+ :content "bar"
+ :action :update
+ :language "en"
+ :title "foo"
+ :published "2012-09-15T23:48:58.050Z"
+ :datestamp "2012-09-15T23:48:58.050Z"
+ :created "2012-09-15T23:48:58.050Z"
+ :type "document"
+ :feed "blog"
+ :draft false}
+ {:slug "/blog/foo"
+ :content "bar"
+ :action :create
+ :language "en"
+ :title "foo"
+ :published "2012-09-15T23:48:58.050Z"
+ :datestamp "2012-09-15T23:48:58.050Z"
+ :created "2012-09-15T23:48:58.050Z"
+ :type "document"
+ :feed "blog"
+ :draft true}]))
+
+ (is (= (vec (map #(dissoc % :_id :_rev :previous-id)
+ (get-document +test-db+ "/blog/foo" {:limit 1})))
+ [{:slug "/blog/foo"
+ :content "bar"
+ :action :update
+ :language "en"
+ :title "foo"
+ :published "2012-09-15T23:48:58.050Z"
+ :datestamp "2012-09-15T23:48:58.050Z"
+ :created "2012-09-15T23:48:58.050Z"
+ :type "document"
+ :feed "blog"
+ :draft false}]))
+
+ (testing "Test if attachments are handled correctly."
+ (let [gif (str "R0lGODlhAQABA++/vQAAAAAAAAAA77+9AQIAAAAh77+9BAQUA++/"
+ "vQAsAAAAAAEAAQAAAgJEAQA7")]
+ (do
+ (append-to-document +test-db+
+ "Europe/Amsterdam"
+ {:action :create
+ :attachment {:type "image/gif" :data gif}
+ :title "a single black pixel!"
+ :slug "/images/white-pixel.gif"
+ :language "en"
+ :feed "images"
+ :content ""
+ :draft false})
+ (append-to-document +test-db+
+ "Europe/Amsterdam"
+ {:action :update
+ :previous-id (:_id
+ (first
+ (get-document
+ +test-db+
+ "/images/white-pixel.gif")))
+ :attachment {:type "image/gif" :data gif}
+ :title "a single black pixel!"
+ :slug "/images/white-pixel.gif"
+ :language "en"
+ :feed "images"
+ :content ""
+ :draft false})
+ (append-to-document +test-db+
+ "Europe/Amsterdam"
+ {:action :create
+ :title "not a single black pixel!"
+ :slug "/images/not-a-white-pixel.gif"
+ :language "en"
+ :feed "images"
+ :content ""
+ :draft false}))
+
+ (is (= (get-in (get-document +test-db+ "/images/white-pixel.gif")
+ [0 :attachments :original])
+ (get-in (get-document +test-db+ "/images/white-pixel.gif")
+ [1 :attachments :original])
+ {:type "image/gif" :data gif :length 57})))))
(deftest test-get-feed
(with-redefs [util/now-rfc3339 #(str "2012-09-04T03:46:52.096Z")]
@@ -283,6 +351,7 @@
:language "nl"
:title "B2"
:datestamp "2012-09-04T03:55:52.096Z"
+ :created "2012-09-04T03:46:52.096Z"
:type "feed"
:default-document-type "with-description"
:default-slug-format "/{document-title}"}
@@ -292,6 +361,7 @@
:language "nl"
:title "B1"
:datestamp "2012-09-04T03:50:52.096Z"
+ :created "2012-09-04T03:46:52.096Z"
:type "feed"
:default-document-type "with-description"
:default-slug-format "/{document-title}"}
@@ -314,6 +384,7 @@
:language "nl"
:title "B2"
:datestamp "2012-09-04T03:55:52.096Z"
+ :created "2012-09-04T03:46:52.096Z"
:type "feed"
:default-document-type "with-description"
:default-slug-format "/{document-title}"}]))
@@ -330,107 +401,6 @@
2 1
2 2)))))
-(deftest test-get-unique-slug
- (is (= (get-unique-slug +test-db+ "/blog/foo") "/blog/foo"))
-
- (do
- (create-document +test-db+
- "en"
- "blog"
- "Europe/Amsterdam"
- {:title "foo"
- :slug "/blog/foo-1234567890"
- :content "bar"
- :draft true})
-
- (create-document +test-db+
- "en"
- "blog"
- "Europe/Amsterdam"
- {:title "foo"
- :slug "/blog/foo-1234567891"
- :content "bar"
- :draft true}))
-
- ; this should retrieve the next available slug:
- (is (= (get-unique-slug +test-db+ "/blog/foo-1234567890")
- "/blog/foo-1234567892")))
-
-(deftest test-create-document
- (testing "Test document creation"
- (let [document (create-document +test-db+
- "en"
- "blog"
- "Europe/Amsterdam"
- {:title "foo"
- :slug "/blog/foo"
- :content "bar"
- :start-time "2012-02-21 01:19"
- :end-time "2012-02-21 10:00"
- :draft false})]
-
- (is (couchdb-id? (:_id document)))
- (is (couchdb-rev? (:_rev document)))
- (is (iso-date? (:published document)))
- (is (= (:type document) "document"))
- (is (= (:language document) "en"))
- (is (= (:feed document) "blog"))
- (is (= (:title document) "foo"))
- (is (= (:slug document) "/blog/foo"))
- (is (= (:content document) "bar"))
- (is (= (:start-time document) "2012-02-21 01:19"))
- (is (= (:end-time document) "2012-02-21 10:00"))
- (is (= (:start-time-rfc3339 document) "2012-02-21T00:19:00.000Z"))
- (is (= (:end-time-rfc3339 document) "2012-02-21T09:00:00.000Z"))
- (is (false? (:draft document)))))
-
- (testing "Test if slugs are correctly autoincremented"
- (dotimes [n 10]
- (let [document (create-document +test-db+
- "en"
- "blog"
- "Europe/Amsterdam"
- {:title "foo"
- :slug "/blog/foo"
- :content "bar"
- :draft true})]
- (is (couchdb-id? (:_id document)))
- (is (couchdb-rev? (:_rev document)))
- (is (iso-date? (:published document)))
- (is (= (:language document) "en"))
- (is (= (:feed document) "blog"))
- (is (= (:title document) "foo"))
- (is (= (:slug document) (str "/blog/foo-" (+ n 2))))
- (is (= (:content document) "bar"))
- (is (true? (:draft document))))))
-
-
- (testing "Test if attachments are handled correctly."
- (let [gif (str "R0lGODlhAQABA++/vQAAAAAAAAAA77+9AQIAAAAh77+9BAQUA++/"
- "vQAsAAAAAAEAAQAAAgJEAQA7")
- document (create-document +test-db+
- "en"
- "images"
- "Europe/Amsterdam"
- {:attachment {:type "image/gif"
- :data gif}
- :title "a single black pixel!"
- :slug "pixel.gif"
- :content ""
- :draft false})]
- (is (= (:attachment document)
- {:type "image/gif"
- :data (str "R0lGODlhAQABA++/vQAAAAAAAAAA77+9AQIAAAAh77+"
- "9BAQUA++/vQAsAAAAAAEAAQAAAgJEAQA7")}))
- (is (= (:_attachments document)
- {:original {:content_type "image/gif"
- :revpos 2
- :length 57
- :stub true}}))
-
- (is (= (get-attachment-as-base64-string +test-db+ document :original)
- gif)))))
-
(deftest test-append-to-feed
(let [blog-feed (with-redefs [util/now-rfc3339
#(str "2012-09-04T04:30:17.872Z")]
@@ -457,6 +427,39 @@
(is (= (:default-slug-format blog-feed) "/{document-title}"))
(is (= (:default-document-type blog-feed) "with-description")))
+ ;; make sure that invalid actions aren't allowed
+ (is (thrown+? (partial check-exc :vix.db/invalid-action)
+ (append-to-feed
+ +test-db+
+ (assoc blog-feed
+ :action :invalid
+ :previous-id (:_id blog-feed)
+ :title "Updated Weblog Feed"
+ :default-document-type "standard"
+ :searchable true))))
+
+ (is (thrown+? (partial check-exc :vix.db/invalid-action)
+ (append-to-feed
+ +test-db+
+ (dissoc (assoc blog-feed
+ :previous-id (:_id blog-feed)
+ :title "Updated Weblog Feed"
+ :default-document-type "standard"
+ :searchable true)
+ :action))))
+
+
+ ;; a non-keyword action should work:
+ (append-to-feed
+ +test-db+
+ {:action :create
+ :title "Weblog"
+ :subtitle "Another Weblog!"
+ :name "another-blog"
+ :language "en"
+ :default-slug-format "/{document-title}"
+ :default-document-type "with-description"})
+
(let [blog-feed-updated (with-redefs [util/now-rfc3339
#(str "2012-09-04T04:30:17.930Z")]
(first
@@ -613,57 +616,64 @@
:default-slug-format "/{document-title}"}))))
(deftest test-get-documents-for-feed
- (let [doc-1 (create-document +test-db+
- "en"
- "blog"
- "Europe/Amsterdam"
- {:title "foo"
- :slug "/blog/foo"
- :content "bar"
- :draft true})
-
- doc-2 (create-document +test-db+
- "en"
- "blog"
- "Europe/Amsterdam"
- {:title "foo"
- :slug "/blog/foo"
- :content "bar"
- :draft true})
-
- doc-3 (create-document +test-db+
- "nl"
- "blog"
- "Europe/Amsterdam"
- {:title "foo"
- :slug "/blog/foo"
- :content "bar"
- :draft true})
+ (let [doc-1 (append-to-document +test-db+
+ "Europe/Amsterdam"
+ {:action :create
+ :language "en"
+ :feed "blog"
+ :title "foo"
+ :slug "/blog/foo-0"
+ :content "bar"
+ :draft true})
+
+ doc-2 (append-to-document +test-db+
+ "Europe/Amsterdam"
+ {:action :create
+ :language "en"
+ :feed "blog"
+ :title "foo"
+ :slug "/blog/foo-1"
+ :content "bar"
+ :draft true})
+
+ doc-3 (append-to-document +test-db+
+ "Europe/Amsterdam"
+ {:action :create
+ :language "nl"
+ :feed "blog"
+ :title "foo"
+ :slug "/blog/foo-nl"
+ :content "bar"
+ :draft true})
feed (get-documents-for-feed +test-db+ "en" "blog")]
;; FIXME: should also test other possible argument combinations!
(is (= (count (:documents feed)) 2))
(is (= (:next feed) nil))
- (is (some #{doc-1} (:documents feed)))
- (is (some #{doc-2} (:documents feed))))
+ (is (some #{(first doc-1)} (:documents feed)))
+ (is (some #{(first doc-2)} (:documents feed))))
(testing "test pagination"
(let [now "2011-09-06T12:56:16.322Z"]
(dotimes [n 21]
- (clutch/put-document +test-db+
- {:type "document"
- :title (str "doc " n)
- :slug (str "/pages/doc-" n)
- :content ""
- :draft false
- :language "en"
- :feed "pages"
- ; mix identical and unique dates
- :published (if (< n 7)
- now
- (util/now-rfc3339))})))
+ (let [my-now (if (< n 7) ;; mix identical and unique datestamps
+ now
+ (util/now-rfc3339))]
+ (clutch/put-document +test-db+
+ {:action :create
+ :current-state true
+ :type "document"
+ :title (str "doc " n)
+ :slug (str "/pages/doc-" n)
+ :content ""
+ :draft false
+ :language "en"
+ :feed "pages"
+ :published my-now
+ :created my-now
+ :datestamp my-now}))))
(is (= (count (:documents (get-documents-for-feed +test-db+
"en"
@@ -878,26 +888,201 @@
"nl")
[images-feed-nl])))))
-(deftest test-update-document
- (let [new-doc (create-document
- +test-db+
- "en"
- "blog"
- "Europe/Amsterdam"
- {:title "foo"
- :subtitle ""
- :slug "/blog/bar"
- :content "bar"
- :description ""
- :draft false
- :icon nil
- :related-pages []
- :related-images []})
- updated-doc (update-document
- +test-db+
+(deftest test-append-to-document-create
+ (with-redefs [util/now-rfc3339 #(str "2012-09-16T00:17:30.722Z")]
+ (let [document (append-to-document +test-db+
+ "Europe/Amsterdam"
+ {:action :create
+ :language "en"
+ :feed "blog"
+ :title "foo"
+ :slug "/blog/foo"
+ :content "bar"
+ :start-time "2012-02-21 01:19"
+ :end-time "2012-02-21 10:00"
+ :draft false})]
+
+ (is (couchdb-id? (:_id (first document))))
+ (is (couchdb-rev? (:_rev (first document))))
+
+ (is (= (vec (map #(dissoc % :_id :_rev) document))
+ [{:slug "/blog/foo"
+ :content "bar"
+ :action :create
+ :language "en"
+ :title "foo"
+ :start-time-rfc3339 "2012-02-21T00:19:00.000Z"
+ :published "2012-09-16T00:17:30.722Z"
+ :datestamp "2012-09-16T00:17:30.722Z"
+ :created "2012-09-16T00:17:30.722Z"
+ :type "document"
+ :feed "blog"
+ :draft false
+ :end-time-rfc3339 "2012-02-21T09:00:00.000Z"}]))))
+
+ ;; make sure valid actions are enforced
+ (is (thrown+? (partial check-exc :vix.db/invalid-action)
+ (append-to-document
+ +test-db+
+ "Europe/Amsterdam"
+ {:action :invalid
+ :language "en"
+ :feed "blog"
+ :title "foo"
+ :slug "/blog/foo-action"
+ :content "bar"
+ :start-time "2012-02-21 01:19"
+ :end-time "2012-02-21 10:00"
+ :draft false})))
+
+ (is (thrown+? (partial check-exc :vix.db/invalid-action)
+ (append-to-document
+ +test-db+
+ "Europe/Amsterdam"
+ {:language "en"
+ :feed "blog"
+ :title "foo"
+ :slug "/blog/foo-action"
+ :content "bar"
+ :start-time "2012-02-21 01:19"
+ :end-time "2012-02-21 10:00"
+ :draft false})))
+
+ ;; non-keyword actions should work:
+ (append-to-document +test-db+
"Europe/Amsterdam"
- "/blog/bar"
- (assoc new-doc
+ {:action "create"
+ :language "en"
+ :feed "blog"
+ :title "foo"
+ :slug "/blog/foo-action"
+ :content "bar"
+ :start-time "2012-02-21 01:19"
+ :end-time "2012-02-21 10:00"
+ :draft false})
+
+ ;; make sure existing documents don't get overwritten
+ (is (thrown+? (partial check-exc :vix.db/document-already-exists-conflict)
+ (append-to-document
+ +test-db+
+ "Europe/Amsterdam"
+ {:action :create
+ :language "en"
+ :feed "blog"
+ :title "foo"
+ :slug "/blog/foo"
+ :content "bar"
+ :start-time "2012-02-21 01:19"
+ :end-time "2012-02-21 10:00"
+ :draft false})))
+
+ ;; test without a :language key
+ (is (thrown+? (partial check-exc :vix.db/document-missing-required-keys)
+ (append-to-document
+ +test-db+
+ "Europe/Amsterdam"
+ {:action :create
+ :feed "blog"
+ :title "foo"
+ :slug "/blog/foobar"
+ :content "bar"
+ :start-time "2012-02-21 01:19"
+ :end-time "2012-02-21 10:00"
+ :draft false})))
+
+ ;; test without a :feed key
+ (is (thrown+? (partial check-exc :vix.db/document-missing-required-keys)
+ (append-to-document
+ +test-db+
+ "Europe/Amsterdam"
+ {:action :create
+ :language "en"
+ :title "foo"
+ :slug "/blog/foobar"
+ :content "bar"
+ :start-time "2012-02-21 01:19"
+ :end-time "2012-02-21 10:00"
+ :draft false})))
+
+ ;; test without a :slug key
+ (is (thrown+? (partial check-exc :vix.db/document-missing-required-keys)
+ (append-to-document
+ +test-db+
+ "Europe/Amsterdam"
+ {:action :create
+ :language "en"
+ :feed "blog"
+ :title "foo"
+ :content "bar"
+ :start-time "2012-02-21 01:19"
+ :end-time "2012-02-21 10:00"
+ :draft false})))
+
+ ;; test without a :title key
+ (is (thrown+? (partial check-exc :vix.db/document-missing-required-keys)
+ (append-to-document
+ +test-db+
+ "Europe/Amsterdam"
+ {:action :create
+ :language "en"
+ :feed "blog"
+ :slug "/blog/foobar"
+ :content "bar"
+ :start-time "2012-02-21 01:19"
+ :end-time "2012-02-21 10:00"
+ :draft false})))
+
+ (testing "Test if attachments are handled correctly."
+ (let [gif (str "R0lGODlhAQABA++/vQAAAAAAAAAA77+9AQIAAAAh77+9BAQUA++/"
+ "vQAsAAAAAAEAAQAAAgJEAQA7")
+ document (first
+ (append-to-document +test-db+
+ "Europe/Amsterdam"
+ {:action :create
+ :attachment {:type "image/gif"
+ :data gif}
+ :title "a single black pixel!"
+ :language "en"
+ :feed "images"
+ :slug "pixel.gif"
+ :content ""
+ :draft false}))]
+ (is (= (:original (:attachments document))
+ {:type "image/gif"
+ :length 57
+ :data (str "R0lGODlhAQABA++/vQAAAAAAAAAA77+9AQIAAAAh77+"
+ "9BAQUA++/vQAsAAAAAAEAAQAAAgJEAQA7")}))
+
+ (is (= (get-attachment-as-base64-string +test-db+
+ (:_id document)
+ :original)
+ gif)))))
+
+(deftest test-append-to-document-update
+ (with-redefs [util/now-rfc3339 #(str "2012-09-16T02:51:47.588Z")]
+ (let [new-doc (append-to-document
+ +test-db+
+ "Europe/Amsterdam"
+ {:action :create
+ :language "en"
+ :feed "blog"
+ :title "foo"
+ :subtitle ""
+ :slug "/blog/bar"
+ :content "bar"
+ :description ""
+ :draft false
+ :icon nil
+ :related-pages []
+ :related-images []})
+ updated-doc (append-to-document
+ +test-db+
+ "Europe/Amsterdam"
+ {:action :update
+ :previous-id (:_id (first new-doc))
+ :language "en"
+ :feed "blog"
+ :slug "/blog/bar"
:title "hic sunt dracones"
:subtitle "old maps are cool!"
:description "hey!"
@@ -906,110 +1091,276 @@
:end-time "2012-02-21 10:00"
:icon {:title "cat" :slug "/cat.png"}
:related-pages [{:title "foo" :slug "bar"}]
- :related-images [{:title "cat" :slug "cat.png"}]))]
- (is (= (get-document +test-db+ "/blog/bar") updated-doc))
- (is (couchdb-rev? 2 (:_rev updated-doc)))
- (is (iso-date? (:updated updated-doc)))
-
- (is (= (:published new-doc) (:published updated-doc)))
-
- (is (= (:subtitle new-doc) ""))
- (is (= (:description new-doc) ""))
- (is (= (:start-time new-doc) nil))
- (is (= (:end-time new-doc) nil))
- (is (= (:start-time-rfc3339 new-doc) nil))
- (is (= (:end-time-rfc3339 new-doc) nil))
- (is (not (:draft new-doc)))
- (is (nil? (:icon new-doc)))
- (is (= (:related-pages new-doc) []))
- (is (= (:related-images new-doc) []))
-
- (is (= (:title updated-doc) "hic sunt dracones"))
- (is (= (:subtitle updated-doc) "old maps are cool!"))
- (is (= (:description updated-doc) "hey!"))
- (is (= (:start-time updated-doc) "2012-02-21 01:19"))
- (is (= (:end-time updated-doc) "2012-02-21 10:00"))
- (is (= (:start-time-rfc3339 updated-doc) "2012-02-21T00:19:00.000Z"))
- (is (= (:end-time-rfc3339 updated-doc) "2012-02-21T09:00:00.000Z"))
- (is (true? (:draft updated-doc)))
- (is (= (:icon updated-doc) {:title "cat" :slug "/cat.png"}))
- (is (= (:related-pages updated-doc) [{:title "foo" :slug "bar"}]))
- (is (= (:related-images updated-doc) [{:title "cat" :slug "cat.png"}])))
-
- (testing "Test if attachments are handled correctly."
- (let [black-pixel (str "R0lGODlhAQABA++/vQAAAAAAAAAA77+9AQIAAAAh77+9BAQU"
- "A++/vQAsAAAAAAEAAQAAAgJEAQA7")
- white-pixel (str "/9j/4AAQSkZJRgABAQAAAQABAAD/2wBDAAgGBgcGBQgHBwcJ"
- "CQgKDBQNDAsLDBkSEw8UHRofHh0aHBwgJC4nICIsIxwcKDcp"
- "LDAxNDQ0Hyc5PTgyPC4zNDL/2wBDAQkJCQwLDBgNDRgyIRwh"
- "MjIyMjIyMjIyMjIyMjIyMjIyMjIyMjIyMjIyMjIyMjIyMjIy"
- "MjIyMjIyMjIyMjIyMjL/wAARCAABAAEDASIAAhEBAxEB/8QA"
- "HwAAAQUBAQEBAQEAAAAAAAAAAAECAwQFBgcICQoL/8QAtRAA"
- "AgEDAwIEAwUFBAQAAAF9AQIDAAQRBRIhMUEGE1FhByJxFDKB"
- "kaEII0KxwRVS0fAkM2JyggkKFhcYGRolJicoKSo0NTY3ODk6"
- "Q0RFRkdISUpTVFVWV1hZWmNkZWZnaGlqc3R1dnd4eXqDhIWG"
- "h4iJipKTlJWWl5iZmqKjpKWmp6ipqrKztLW2t7i5usLDxMXG"
- "x8jJytLT1NXW19jZ2uHi4+Tl5ufo6erx8vP09fb3+Pn6/8QA"
- "HwEAAwEBAQEBAQEBAQAAAAAAAAECAwQFBgcICQoL/8QAtREA"
- "AgECBAQDBAcFBAQAAQJ3AAECAxEEBSExBhJBUQdhcRMiMoEI"
- "FEKRobHBCSMzUvAVYnLRChYkNOEl8RcYGRomJygpKjU2Nzg5"
- "OkNERUZHSElKU1RVVldYWVpjZGVmZ2hpanN0dXZ3eHl6goOE"
- "hYaHiImKkpOUlZaXmJmaoqOkpaanqKmqsrO0tba3uLm6wsPE"
- "xcbHyMnK0tPU1dbX2Nna4uPk5ebn6Onq8vP09fb3+Pn6/9oA"
- "DAMBAAIRAxEAPwD3+iiigD//2Q==")
- new-doc (create-document
+ :related-images [{:title "cat" :slug "cat.png"}]})]
+ (is (= (get-document +test-db+ "/blog/bar") updated-doc))
+ (is (couchdb-rev? 1 (:_rev (first updated-doc))))
+ (is (couchdb-id? (:previous-id (first updated-doc))))
+
+ (is (= (map #(dissoc % :_id :_rev :previous-id) updated-doc)
+ [{:subtitle "old maps are cool!"
+ :slug "/blog/bar"
+ :icon {:slug "/cat.png"
+ :title "cat"}
+ :action :update
+ :related-images [{:slug "cat.png"
+ :title "cat"}]
+ :language "en"
+ :title "hic sunt dracones"
+ :start-time-rfc3339 "2012-02-21T00:19:00.000Z"
+ :published "2012-09-16T02:51:47.588Z"
+ :datestamp "2012-09-16T02:51:47.588Z"
+ :created "2012-09-16T02:51:47.588Z"
+ :type "document"
+ :feed "blog"
+ :draft true
+ :related-pages [{:slug "bar"
+ :title "foo"}]
+ :description "hey!"
+ :end-time-rfc3339 "2012-02-21T09:00:00.000Z"}
+ {:subtitle ""
+ :slug "/blog/bar"
+ :icon nil
+ :content "bar"
+ :action :create
+ :related-images []
+ :language "en"
+ :title "foo"
+ :published "2012-09-16T02:51:47.588Z"
+ :datestamp "2012-09-16T02:51:47.588Z"
+ :created "2012-09-16T02:51:47.588Z"
+ :type "document"
+ :feed "blog"
+ :draft false
+ :related-pages []
+ :description ""}]))
+
+ ;; make sure that the internal current-state flag is removed
+ ;; from non-current document states (this non-public flag is
+ ;; used for overview views that show e.g. the most recent states
+ ;; for documents in a specific feed).
+ (is (= (:current-state
+ (clutch/get-document +test-db+ (get-in updated-doc [0 :_id])))
+ true))
+
+ (is (= (:current-state
+ (clutch/get-document +test-db+ (get-in updated-doc [1 :_id])))
+ false))
+
+ ;; test with expired :previous-id
+ (is (thrown+? (partial check-exc :vix.db/document-update-conflict)
+ (append-to-document
+ +test-db+
+ "Europe/Amsterdam"
+ {:action :update
+ :previous-id (:_id (first new-doc))
+ :language "en"
+ :feed "blog"
+ :slug "/blog/bar"
+ :title "hic sunt dracones"
+ :subtitle "old maps are cool!"
+ :description "hey!"
+ :draft true
+ :start-time "2012-02-21 01:19"
+ :end-time "2012-02-21 10:00"
+ :icon {:title "cat" :slug "/cat.png"}
+ :related-pages [{:title "foo" :slug "bar"}]
+ :related-images [{:title "cat" :slug "cat.png"}]})))
+
+ ;; test without :previous-id
+ (is (thrown+? (partial check-exc :vix.db/document-update-conflict)
+ (append-to-document
+ +test-db+
+ "Europe/Amsterdam"
+ {:action :update
+ :language "en"
+ :feed "blog"
+ :slug "/blog/bar"
+ :title "hic sunt dracones"
+ :subtitle "old maps are cool!"
+ :description "hey!"
+ :draft true
+ :start-time "2012-02-21 01:19"
+ :end-time "2012-02-21 10:00"
+ :icon {:title "cat" :slug "/cat.png"}
+ :related-pages [{:title "foo" :slug "bar"}]
+ :related-images [{:title "cat" :slug "cat.png"}]})))
+
+ ;; make sure that passing couchdb-options works (useful for
+ ;; limiting returned states on frequently updated image
+ ;; documents).
+ (is (= (map #(dissoc % :_rev :_id :previous-id)
+ (append-to-document
+test-db+
- "en"
- "images"
"Europe/Amsterdam"
- {:attachment {:type "image/jpeg" :data white-pixel}
- :title "a single black pixel!"
- :slug "/pixel.jpeg"
- :content ""
- :draft false})
- updated-doc (update-document
- +test-db+
- "Europe/Amsterdam"
- "/pixel.jpeg"
- {:attachment {:type "image/gif" :data black-pixel}
- :title "a single black pixel!"
- :content ""
- :draft false})
- attachment (clutch/get-attachment +test-db+ updated-doc :original)]
-
- (is (= (:_attachments updated-doc)
- {:original {:content_type "image/gif"
- :revpos 4
+ {:action :update
+ :previous-id (:_id (first (get-document +test-db+
+ "/blog/bar")))
+ :language "en"
+ :feed "blog"
+ :slug "/blog/bar"
+ :title "here be dragons"
+ :subtitle "old maps are cool!"
+ :description "hey!"
+ :draft true
+ :start-time "2012-02-21 01:19"
+ :end-time "2012-02-21 10:00"
+ :icon {:title "cat" :slug "/cat.png"}
+ :related-pages [{:title "foo" :slug "bar"}]
+ :related-images [{:title "cat" :slug "cat.png"}]}
+ {:limit 1}))
+ [{:subtitle "old maps are cool!"
+ :slug "/blog/bar"
+ :icon {:slug "/cat.png"
+ :title "cat"}
+ :action :update
+ :related-images [{:slug "cat.png"
+ :title "cat"}]
+ :language "en"
+ :title "here be dragons"
+ :start-time-rfc3339 "2012-02-21T00:19:00.000Z"
+ :datestamp "2012-09-16T02:51:47.588Z"
+ :created "2012-09-16T02:51:47.588Z"
+ :published "2012-09-16T02:51:47.588Z"
+ :type "document"
+ :feed "blog"
+ :draft true
+ :related-pages [{:slug "bar"
+ :title "foo"}]
+ :description "hey!"
+ :end-time-rfc3339 "2012-02-21T09:00:00.000Z"}]))))
+
+ (testing "Test if attachments are handled correctly."
+ (let [black-pixel
+ (str "R0lGODlhAQABA++/vQAAAAAAAAAA77+9AQIAAAAh77+9BAQU"
+ "A++/vQAsAAAAAAEAAQAAAgJEAQA7")
+ white-pixel
+ (str "/9j/4AAQSkZJRgABAQAAAQABAAD/2wBDAAgGBgcGBQgHBwcJ"
+ "CQgKDBQNDAsLDBkSEw8UHRofHh0aHBwgJC4nICIsIxwcKDcp"
+ "LDAxNDQ0Hyc5PTgyPC4zNDL/2wBDAQkJCQwLDBgNDRgyIRwh"
+ "MjIyMjIyMjIyMjIyMjIyMjIyMjIyMjIyMjIyMjIyMjIyMjIy"
+ "MjIyMjIyMjIyMjIyMjL/wAARCAABAAEDASIAAhEBAxEB/8QA"
+ "HwAAAQUBAQEBAQEAAAAAAAAAAAECAwQFBgcICQoL/8QAtRAA"
+ "AgEDAwIEAwUFBAQAAAF9AQIDAAQRBRIhMUEGE1FhByJxFDKB"
+ "kaEII0KxwRVS0fAkM2JyggkKFhcYGRolJicoKSo0NTY3ODk6"
+ "Q0RFRkdISUpTVFVWV1hZWmNkZWZnaGlqc3R1dnd4eXqDhIWG"
+ "h4iJipKTlJWWl5iZmqKjpKWmp6ipqrKztLW2t7i5usLDxMXG"
+ "x8jJytLT1NXW19jZ2uHi4+Tl5ufo6erx8vP09fb3+Pn6/8QA"
+ "HwEAAwEBAQEBAQEBAQAAAAAAAAECAwQFBgcICQoL/8QAtREA"