modified datomic_session

datomic_session.clj

; original https://github.com/hozumi/datomic-session
; https://github.com/hozumi/datomic-session/blob/master/epl-v10.html
(ns datomic-session
  (:use [always]
        [clojure.pprint])
  (:require [clojure.data :as data]
            [datomic.api :as d]
            [my-ns.db.datomic :as db]
            [ring.middleware.session.store :as rs]
            [ring.middleware.session.memory :as memstore]))

(def ^:private session-atom (atom {}))
(def ^:private memory-store (memstore/memory-store session-atom))

(defn key->eid [db key]
  (when key
    (ffirst
      (d/q '[:find ?eid
             :in $ ?key
             :where [?eid :session/key ?key]]
        db key))))

(defn diff-tx-data [eid old-m new-m]
  (let [[old-only new-only] (data/diff old-m new-m)
        retracts (->> old-only
      (remove (fn [[k]] (get new-only k)))
      (map (fn [[k v]] [:db/retract eid k v])))]
    (if (seq new-only)
      (conj retracts (assoc new-only :db/id eid))
      retracts)))

(defn- build-session-tx [data key partition]
  [(assoc data
     :db/id (d/tempid (or partition :db.part/user ))
     :session/key key)])

(defn- is-drawbridge-session? [data]
  (->> (keys data)
    (some #(= "cemerick.drawbridge" (namespace %)))))

(deftype DatomicStore [partition auto-key-change?]
  rs/SessionStore
  (read-session [_ key]
    (if-let [mem-session (rs/read-session memory-store key)]
      mem-session
      (let [db (db/get-db)]
        (into {} (d/entity db (key->eid db key))))))
  (write-session [_ key data]
    (if (is-drawbridge-session? data)
      (rs/write-session memory-store key data)
      (let [db (and key (db/get-db))
            eid (key->eid db key)
            key-change? (or (not eid) auto-key-change?)
            key (if key-change? (str (d/squuid)) key)]
        (if eid
          (let [old-data (into {} (d/entity db eid))
                tx-data (diff-tx-data eid old-data (assoc data :session/key key))]
            (when (seq tx-data)
              @(db/transact tx-data)))
          @(db/transact (build-session-tx data key partition)))
        key)))
  (delete-session [_ key]
    (rs/delete-session memory-store key)
    (when-let [eid (key->eid (db/get-db) key)]
      @(db/transact [[:db.fn/retractEntity eid]]))
    nil))

(defn datomic-store [{:keys [partition auto-key-change?]}]
  (DatomicStore. partition auto-key-change?))

; repl helpers
(defn find-sessions []
  (let [the-db (db/get-db)]
    (->> (d/q '[:find ?s :where [?s :session/key ]] the-db)
      (map (comp d/touch (partial d/entity the-db) first)))))

(defn cleanup-old-sessions! []
  (let [the-db (db/get-db)]
    (->> (d/q '[:find ?s :where [?s :session/key ]] the-db)
      (map first)
      (map (fn [lid] [:db.fn/retractEntity lid]))
      (partition 20 20 nil)
      (map vec)
      (map (comp deref db/transact))
      doall)))