generic key-value store data access library, currently using simpledb

data.clj

(ns xxx.data
  "Core functionality for working with data store entities"
  (:gen-class)
  (:require [xxx.vendor.aws.sdb :as sdb]
	    [xxx.vendor.aws.common :as aws-common]
	    [xxx.config.vendor :as config]
	    [xxx.util.core :as util]))

(def aws-credentials (aws-common/get-basic-credentials 
		      config/aws-access-key-id config/aws-secret-access-key))

(def *client* (sdb/create-client aws-credentials))

(def entity-domains {:user "xxx_user" :location "xxx_location"})

(defn update-domains
  "Add any domains from the app-domains collection that do not exist
   in the data store."
  [app-domains]
  (let [domains (sdb/domains *client*)]
    (doseq [d app-domains] 
      (cond 
       (not (contains? (set domains) d)) (sdb/create-domain *client* d)))))

(defn- where-component
  "Builds a component for a where clause from the specified key value pair.
   This component will be either `(= key val) or `(null key)"
  [attr-kvp]
  (let [attr-name (key attr-kvp) attr-val (val attr-kvp)]
    (cond (nil? attr-val) `(null ~attr-name)
	  :else `(= ~attr-name ~attr-val))))

(defn- build-basic-select
  "Returns an sdb query map for the specified domain.  All attributes
   are combined in the where clause with 'and', meaning that the results
   will match all specified attributes.

   This function will not build more advanced queries, only simple equals
   comparisons 'anded' together.  It will handle is null though, meaning
   that if nil is passed as a value for an attribute, 'is null' will be
   queried, not '= nil' (which would actually be converted to '= \"\"')

   domain:  the sdb domain to build the query map for
   props:  the seq of domain attributes that you want returned, or nil or 
           :all if you want to select all attributes (select *)
   attrs: a map of attributes that must be matched in the query"
  [domain props attrs]
  (let [p (condp = props
	    nil '*
	    :all '*
	    (seq props))
	s `{:select ~p :from ~domain}
	where-comps (map where-component attrs)]
    (cond
     (empty? attrs) s
     (= (count attrs) 1) (assoc s :where (first where-comps))
     (> (count attrs) 1) (assoc s :where `(and ~@where-comps)))))

(defn- new-entity-key
  "Returns a new unique id value that can be used as an entity key value"
  []
  (str (aws-common/uuid)))

(defn- check-entity-key
  "If the specified entity map does not have a :key key, or if that
   key has a value of nil, then add a valid :key to the map and return
   that map, otherwise just return the input entity map."
  [entity]
  (cond 
   (not (nil? (:key entity))) entity
   :else (assoc entity :key (new-entity-key))))

(declare save)

(defn create
  "Creates a new entity in the data store of the specified kind,
   with the specified map of attributes.  In the process, it creates
   a new entity key value, adds it to the attrs map, saves the new
   entity, and then returns the new entity."
  [kind attrs]
  (let [entity (assoc attrs :key (new-entity-key))]
    (first (save kind entity))))

(defn save
  "Save the specified entity(ies), of the specified kind, to the 
   data store, adding them as new entities if they do not already
   exist in the data store.

   This replaces any current value(s) for each attribute in the entity,
   and deletes any attributes in the entity map whose value is nil.

   Returns a list of the saved entities, with updated id keys if added."
  [kind entity & more]
  (let [entities (map check-entity-key (conj more entity))
	domain (kind entity-domains)]
    (do
      ;delete nil attrs
      (doseq [e (map #(assoc (util/keep-nil %) :key (:key %)) entities)] 
	(cond (> (count e) 1)
	      (sdb/delete-attrs *client* domain (:key e) (set (keys e)))))
      ;save non-nil attrs
      (doseq [e (map util/remove-nil entities)] 
	(sdb/put-attrs *client* domain e))
      ;return non-nil saved attrs (will match database)
      (apply list (map util/remove-nil entities)))))

(defn delete
  "Delete the specified entity(ies), of the specified kind, from 
   the data store."
  [kind entity & more]
  (let [entities (remove nil? (conj more entity))
	domain (kind entity-domains)]
    (doseq [e entities] (sdb/delete-attrs *client* domain (:key e)))))

(defn find-by-prop
  "Find entities of the specified type that have the specified value 
   for the specified property(ies).

   Also, consistent? specifies whether you want to perform a consistent
   read from the data store, which will contain the last write. Using
   this options degrades performance, so you will only want to use it
   when you need it, and generally will specify false.

   kind:  a keyword value indicating the type of the entity 
          (e.g. :user, :location)
   attrs:  a map of attributes / values that must be matched
           (e.g. {:name \"jimmy\" :age 23})
   consistent?:  a boolean value indicating whether to do a consistent read"
  ([kind attrs]
     (find-by-prop kind attrs false))
  ([kind attrs consistent?]
     (let [domain (kind entity-domains)
	   query-map (build-basic-select domain :all attrs)]
       (sdb/query-all *client* query-map consistent?))))

(defn find-all
  "Find all entities of the specified kind. Convenience function for
   calling find-by-prop with an empty map.

   Also, consistent? specifies whether you want to perform a consistent
   read from the data store, which will contain the last write. Using
   this options degrades performance, so you will only want to use it
   when you need it, and generally will specify false.

   kind:  a keyword value indicating the type of entity
   consistent?:  a boolean value indicating whether to do a consistent read"
  ([kind]
     (find-all kind false))
  ([kind consistent?]
     (find-by-prop kind {} consistent?)))

(defn get-props
  "Selects and returns the specified entity attributes for the specified 
   kind of entity.  

   In an eventually consistent model, this function may not return the
   most recent results. To get the most recent, consistent results, use
   the find-all or find-by-prop functions.

   kind:  a keyword value indicaing the type of the entity
          (e.g. :user, :location)
   props:  a sequence of attribute names that you want returned for 
           the specified kind (the :key value will always be returned)
   attrs:  a map of attributes/values that must be matched
           (e.g. {:name \"jimmy\" :age 23})"
  ([kind props]
     (get-props kind props {}))
  ([kind props attrs]
     (let [domain (kind entity-domains)
	   query-map (build-basic-select domain props attrs)]
       (sdb/query-all *client* query-map false))))
  

sdb.clj

;   Copyright (c) Rich Hickey. All rights reserved.
;   The use and distribution terms for this software are covered by the
;   Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
;   which can be found in the file epl-v10.html at the root of this distribution.
;   By using this software in any fashion, you are agreeing to be bound by
;   the terms of this license.
;   You must not remove this notice, or any other, from this software.

(ns xxx.vendor.aws.sdb
 "Library functions for working with Amazon SimpleDB
   
    *** Modified version of Rich Hickey's clojure sdb library (at http://github.com/richhickey/sdb)

    *** Updated to use current aws java sdk, and to support consistent read, among other small changes.
  
    http://aws.amazon.com/simpledb/

    Built on top of the AWS SDK for Java:
      http://aws.amazon.com/sdkforjava/
      http://developer.amazonwebservices.com/connect/entry.jspa?externalID=3586
      http://docs.amazonwebservices.com/AWSJavaSDK/latest/javadoc/index.html"

 (:use clojure.contrib.pprint)
 (:require [clojure.string :as string])
 (:import
   (com.amazonaws.services.simpledb 
    AmazonSimpleDBAsyncClient AmazonSimpleDBClient)
   (com.amazonaws.services.simpledb.model
     Attribute BatchPutAttributesRequest CreateDomainRequest 
     DeleteAttributesRequest DeleteDomainRequest DomainMetadataRequest 
     GetAttributesRequest Item ListDomainsRequest ListDomainsResult
     PutAttributesRequest ReplaceableAttribute ReplaceableItem
     SelectRequest UpdateCondition)
   (com.amazonaws.services.simpledb.util SimpleDBUtils)))

(defn create-client
  "Creates a client for talking to a specific AWS SimpleDB
  account. The same client can be reused for multiple requests (from
  the same thread?). **Should add ASync client option**"
  ([credentials config]
     (AmazonSimpleDBClient. credentials config))
  ([credentials]
     (AmazonSimpleDBClient. credentials)))

(defn create-domain
  "Creates a domain in the account. This is an administrative operation"
  [client name]
  (.createDomain client (CreateDomainRequest. name)))

(defn domains 
  "Returns a sequence of domain names"
  [client]
  (vec (.. client (listDomains (ListDomainsRequest.)) getDomainNames)))

(defn domain-metadata 
  "Returns a map of domain metadata"
  [client domain]
  (select-keys
    (bean (.domainMetadata client (DomainMetadataRequest. domain)))
    [:timestamp :attributeValuesSizeBytes  :attributeNameCount  :itemCount
     :attributeValueCount  :attributeNamesSizeBytes :itemNamesSizeBytes]))

(defn- encode-integer [offset n]
  (let [noff (+ n offset)]
    (assert (pos? noff))
    (let [s (str noff)]
      (if (> (count (str offset)) (count s))
        (str "0" s)
        s))))

(defn- decode-integer [offset nstr]
  (- (read-string (if (= \0 (nth nstr 0)) (subs nstr 1) nstr))
     offset))

(defmulti #^{:doc "Produces the representation of the item as a string for sdb"}
  to-sdb-str type)
(defmethod to-sdb-str String [s] (str s))
(defmethod to-sdb-str clojure.lang.Keyword [k] (str (name k)))
(defmethod to-sdb-str Integer [i] (str (encode-integer 10000000000 i)))
(defmethod to-sdb-str Long [n] (str (encode-integer 10000000000000000000 n)))
(defmethod to-sdb-str java.util.UUID [u] (str u))
(defmethod to-sdb-str java.util.Date [d] (str (SimpleDBUtils/encodeDate d)))
(defmethod to-sdb-str Boolean [z] (str z))
(defmethod to-sdb-str :default [x] (str x))

(defn- item-attrs [item]
  (reduce (fn [kvs [k v :as kv]]
              (cond
               (= k :key) kvs
               (set? v) (reduce (fn [kvs v] (conj kvs [k v])) kvs v)
               :else (conj kvs kv)))
          [] item))

(defn item-triples
  "Given an item-map, returns a set of triples representing the attrs of an item"
  [item]
  (let [s (:key item)]
    (reduce (fn [ts [k v]]
                (conj ts {:s s :p k :o v}))
            #{} (item-attrs item))))

(defn- replaceable-attrs [item add-to?]
  (map (fn [[k v]] 
	 (doto (ReplaceableAttribute.) 
	   (.setName (to-sdb-str k)) 
	   (.setValue (to-sdb-str v)) 
	   (.setReplace (not (add-to? k)))))
       (item-attrs item)))

(defn put-attrs
  "Puts attrs for one item into the domain. By default, attrs replace
  all values present at the same attrs/keys. You can pass an add-to?
  function (usually a set), and when it returns true for a key, values
  will be added to the set of values at that key, if any."
  ([client domain item] (put-attrs client domain item #{}))
  ([client domain item add-to?]
    (let [item-name (to-sdb-str (:key item))
          attrs (replaceable-attrs item add-to?)]
      (.putAttributes client (PutAttributesRequest. domain item-name attrs)))))

(defn batch-put-attrs
  "Puts the attrs for multiple items into a domain, with the same semantics as put-attrs"
  ([client domain items] (batch-put-attrs client domain items #{}))
  ([client domain items add-to?]
    (.batchPutAttributes client
      (BatchPutAttributesRequest. domain
        (map
          #(doto (ReplaceableItem.) 
	     (.setName (to-sdb-str (:key %))) 
	     (.setAttributes (replaceable-attrs % add-to?)))
          items)))))

(defn setify
  "If v is a set, returns it, else returns a set containing v"
  [v]
  (if (set? v) v (hash-set v)))

(defn build-item [item-id attrs]
  (reduce (fn [m #^Attribute a]
            (let [k (keyword (.getName a))
                  v (.getValue a)
                  ov (m k)]
              (assoc m k (if ov (conj (setify ov) v) v))))
          {:key item-id} attrs))

(defn get-attrs
  "Gets the attributes for an item, as a valid item map. If no attrs are supplied,
  gets all attrs for the item."
  [client domain item-id consistent? & attrs]
  (let [r (.getAttributes client
                          (doto (GetAttributesRequest. domain (to-sdb-str item-id)) 
			    (.setAttributeNames (map to-sdb-str attrs)) 
			    (.setConsistentRead consistent?)))
        attrs (.getAttributes r)]
    (build-item item-id attrs)))

;todo remove a subset of a set of vals
(defn delete-attrs
  "Deletes the attrs from the item. If no attrs are supplied, deletes
  all attrs and the item. attrs can be a set, in which case all values
  at those keys will be deleted, or a map, in which case only the
  values supplied will be deleted."
  ([client domain item-id] (delete-attrs client domain item-id #{}))
  ([client domain item-id attrs]
    (.deleteAttributes client
      (doto (DeleteAttributesRequest. domain (to-sdb-str item-id))
        (.setAttributes 
	 (cond 
	  (set? attrs) (map #(doto (Attribute.) (.setName (to-sdb-str %))) attrs)
          (map? attrs) (map (fn [[k v]] 
			      (doto (Attribute.) (.setName (to-sdb-str k)) (.setValue (to-sdb-str v)))) 
			    attrs)
          :else (throw (Exception. "attrs must be set or map"))))))))

(defn- attr-str [attr]
  (if (sequential? attr)
    (let [[op a] attr]
      (assert (= op 'every))
      (format "every(%s)" (attr-str a)))
    (cond (= attr :key) "ItemName()" :else (str \` (to-sdb-str attr) \`))))

(defn- op-str [op]
  (.replace (str op) "-" " "))

(defn- val-str [v]
  (str \" (.replace (to-sdb-str v) "\"" "\"\"") \"))

(defn- simplify-sym [x]
  (if (and (symbol? x) (namespace x))
    (symbol (name x))
    x))

(defn- expr-str
  [e]
  (condp #(%1 %2) (simplify-sym (first e))
    '#{not}
      (format "(not %s)" (expr-str (second e)))
    '#{and or intersection}
      :>> #(format "(%s %s %s)" (expr-str (nth e 1)) % (expr-str (nth e 2)))
    '#{= != < <= > >= like not-like}
      :>> #(format "(%s %s %s)" (attr-str (nth e 1)) (op-str %) (val-str (nth e 2)))
    '#{null not-null}
      :>> #(format "(%s is %s)" (attr-str (nth e 1)) (op-str %))
    '#{between}
      :>> #(format "(%s %s %s and %s)" (attr-str (nth e 1)) % (val-str (nth e 2)) (val-str (nth e 3)))
    '#{in} (cl-format nil "~a in(~{~a~^, ~})"
             (attr-str (nth e 1)) (map val-str (nth e 2)))
    ))

(defn- where-str
  [q] (expr-str q))

(defn select-str
  "Produces a string representing the query map in the SDB Select language.
  query calls this for you, just public for diagnostic purposes."
  [m]
  (str "select "
    (condp = (simplify-sym (:select m))
      '* "*"
      'ids "itemName()"
      'count "count(*)"
      (cl-format nil "~{~a~^, ~}" (map attr-str (:select m))))
    " from " (:from m)
    (when-let [w (:where m)]
      (str " where " (where-str w)))
    (when-let [s (:order-by m)]
      (str " order by " (attr-str (first s)) " " (or (second s) 'asc)))
    (when-let [n (:limit m)]
      (str " limit " n))))

(defn query
  "Issue a query. q is a map with mandatory keys:

  :select */ids/count/[sequence-of-attrs]
  :from domain-name

  and optional keys:

  :where sexpr-based query expr supporting

    (not expr)
    (and/or/intersection expr expr)
    (=/!=/</<=/>/>=/like/not-like attr val)
    (null/not-null attr)
    (between attr val1 val2)
    (in attr #(val-set})

  :order-by [attr] or [attr asc/desc]
  :limit n

  When :select is
      count - returns a number
      ids - returns a sequence of ids
      * or [sequence-of-attrs] - returns a sequence of item maps, containing all or specified attrs.

  See:

      http://docs.amazonwebservices.com/AmazonSimpleDB/2007-11-07/DeveloperGuide/

  for further details of select semantics. Note query maps to the SDB Select, not Query, API
  next-token, if supplied, must be the value obtained from the :next-token attr of the metadata
  of a previous call to the same query, e.g. (:next-token (meta last-result))

  consistent? indicates whether you want to perform a consistent read"
  ([client q consistent?] (query client q consistent? nil))
  ([client q next-token consistent?]
    (let [result (.select client (doto (SelectRequest. (select-str q)) 
				   (.setNextToken next-token) 
				   (.setConsistentRead consistent?)))
          items (.getItems result)
          m {:next-token (.getNextToken result)}]
      (condp = (simplify-sym (:select q))
        'count (-> items first .getAttributes (.get 0) .getValue Integer/valueOf)
        'ids (with-meta (map #(.getName %) items) m)
        (with-meta (map (fn [item]
                          (build-item (.getName item) (.getAttributes item)))
                     items)
          m)))))

(defn query-all
  "Issue a query repeatedly to get all results"
  [client q consistent?]
  (loop [ret [] next-token nil]
    (let [r1 (query client q next-token consistent?)
          nt (:next-token (meta r1))]
      (if nt
        (recur (into ret r1) nt)
        (with-meta (into ret r1) (meta r1))))))