Skip to content

Instantly share code, notes, and snippets.

@favila
Last active September 30, 2021 03:50
Show Gist options
  • Star 11 You must be signed in to star a gist
  • Fork 2 You must be signed in to fork a gist
  • Save favila/785070fc35afb71d46c9 to your computer and use it in GitHub Desktop.
Save favila/785070fc35afb71d46c9 to your computer and use it in GitHub Desktop.
Restore a datomic database "manually", i.e. from raw datoms. Useful for memory databases. Context: https://groups.google.com/d/msg/datomic/BkTdKYB3WpE/AKfqKYqPONMJ
(ns favila.datomic-util.restore-datoms
"A \"manual\" datomic database restore.
Writes raw datoms (stored in a stream written by d/datoms) to an empty database.
Useful for memory databases: you can write out all the datoms in it, then read
them into another database. (Note mem dbs have no log or retractions)."
(:require [datomic.api :as d]
[clojure.edn :as edn]))
(defrecord datom [e a v tx added?])
(def ^long ^:const min-user-tx (long (d/t->tx 1000)))
(defn load-backup [file]
(edn/read-string {:readers
;; You may need more readers for e.g. uris in datoms.
{'datom #(apply ->datom %)}}
(slurp file)))
(defn group-by-tx [backup-datoms]
(->> (group-by :tx backup-datoms)
(sort-by key)))
(defn bootstrap-datom? [{^long tx :tx}]
;; Datoms in a transaction with t < 1000 are from a bootstrap transaction and
;; cannot be reissued.
(< tx min-user-tx))
(defn drop-bootstrap-datoms [datoms]
(remove bootstrap-datom? datoms))
(defn db-bootstrap-entity-ids
"Return all bootstrapped entity ids in a db.
Intended for use with a clean, unused db to return all bootstrap (i.e. not user
transacted) entities."
[fresh-db]
(->> (d/datoms fresh-db :eavt)
(filter bootstrap-datom?)
(map :e)
(into #{})))
(defn get-safe [m k]
(let [v (m k)]
(if (nil? v)
(throw (ex-info "missing key" {:m m :k k}))
v)))
(defn eid->tempid [eid-map backup-eid]
{:pre (> backup-eid 0)}
(d/tempid (get-safe eid-map (d/part backup-eid))))
(defn ref-attr? [db eid]
(= (-> db (d/attribute eid) :value-type) :db.type/ref))
(defn unknown-eids [eid-map ref-attr? datoms]
(->> (reduce (fn [unknown {:keys [e a v]}]
(cond-> unknown
(nil? (eid-map e)) (conj! e)
(nil? (eid-map a)) (conj! a)
(and (and (instance? Long v) (ref-attr? v) (nil? (eid-map v))))
(conj! v)))
(transient #{}) datoms)
(persistent!)))
(defn eids->tempids [partition-map eids]
(zipmap eids (map #(eid->tempid partition-map %) eids)))
(defn tempid-map [eid-map ref-attr? datoms]
(->> (unknown-eids eid-map ref-attr? datoms)
(eids->tempids eid-map)))
(defn datom->tx-item [eid-map ref-attr? {:keys [e a v added?]}]
[(case added? true :db/add false :db/retract) (eid-map e) (eid-map a)
(if (and (instance? Long v) (ref-attr? a)) (eid-map v) v)])
(defn transaction-id [datoms-in-tx]
(let [tx (-> datoms-in-tx first :tx)]
(assert (first datoms-in-tx) "Transaction is empty.")
(assert (every? #(= (:tx %) tx) datoms-in-tx)
"Datoms are not all from same transaction.")
tx))
(defn chained-lookup [& maps]
(fn [v] (some #(% v) maps)))
(defn datoms->tx-data
"Return `[old-eid->tempid adds+retracts]`."
[db eid-map datoms-in-tx]
(let [ref-attr?' (partial ref-attr? db)
tempids (tempid-map eid-map ref-attr?' datoms-in-tx)
eid-map' (chained-lookup eid-map tempids)]
[tempids (mapv #(datom->tx-item eid-map' ref-attr?' %) datoms-in-tx)]))
(defn remap-vals [map1 map2 & more-maps]
(let [maps (cons map2 more-maps)]
(map (fn [[k v]] [k (reduce #(get-safe %2 %1) v maps)]) map1)))
(defn ^long mint-entity-id [^long part ^long idx]
{:pre [(<= 0 part 0xfffff)
(zero? (cond-> (bit-and-not idx 0x3ffffffffff)
(neg? idx) (-> (bit-xor 0x3ffffffffff) bit-not)))]}
(bit-or (bit-and-not idx 0x7ffffc0000000000)
(bit-shift-left part 42)
(bit-and idx 0x3ffffffffff)))
(defn ^long tempid-record->long
([tempid-record] (tempid-record->long nil tempid-record))
([db {:keys [part ^long idx]}]
(let [part-id ^long (if (keyword? part) (d/entid db part) part)]
(mint-entity-id part-id idx))))
(def magic-idents
#{:db.install/partition ;; always 11?
:db.install/valueType ;; always 12?
:db.install/attribute ;; always 13?
:db.alter/attribute}) ;; always 19?
(defn magic-attributes [db]
(zipmap (map #(d/entid db %) magic-idents) magic-idents))
(defn reorder-magic-datoms [magic-eids datoms]
;; Datomic requires that "installation" asserts (e.g. :db.install/attribute)
;; come *after* the datoms that construct the entity they install,
;; or you will get an error:
;;
;; IllegalArgumentExceptionInfo :db.error/invalid-attribute Schema change
;; must be followed by :db.install/attribute or :db.alter/attribute
;;
;; (i.e., txes do not have strict set semantics!)
;; We hack around this by making sure these datoms come last.
(let [{magic true normal false} (group-by #(contains? magic-eids (:a %)) datoms)]
(concat normal magic)))
(defn transact-backup-datoms
"Transact a map of datoms from a `(d/datoms db :eavt)` call (i.e. \"backup
datoms\") on another database into the supplied connection.
`grouped-backup-datoms` must be datoms which all have the same `:tx` value.
Returns a map with keys:
* `:old->new-eids` Mapping of old datom eids to new eids
* `:db-after` Database object after all transactions.
Assumptions:
1. The database is \"clean\", i.e. it has no user transactions in it.
If this is not true transactions are likely to fail.
2. The datoms supplied for transaction do not include \"bootstrap\" datoms.
These are datoms from the first few transactions in a database.
3. The db the backup datoms came from and the supplied connection have the
same entity ids for their bootstrap transactions. (This may not be true
across different versions of datomic.)
The reason for these restrictions is that there is no 100% reliable way
(especially for memory dbs) to reconcile datoms from bootstrapping
transactions in different databases and hence to do correct entity id
remapping between old and new databases."
[conn grouped-backup-datoms]
(let [db (d/db conn)
magic-attrs (magic-attributes db)]
(loop [db-before db
;; Initialize eid-map with identity-mapping for bootstrap eids.
;; WARNING: Assumes `conn` has never been transacted against!
eid-map (let [eids (db-bootstrap-entity-ids (d/db conn))] (zipmap eids eids))
[group & groups] grouped-backup-datoms]
(if (nil? group)
{:old->new-eids eid-map :db-after db-before}
(let [resorted-group (reorder-magic-datoms magic-attrs group)
[eid->tempid-map adds+retracts]
(datoms->tx-data db-before eid-map resorted-group)
{:keys [tempids db-after]} @(d/transact-async conn adds+retracts)]
(recur db-after
(into eid-map (remap-vals eid->tempid-map
(partial d/resolve-tempid db-after tempids)))
groups))))))
(defn load-backup-datoms-by-tx [backup-file]
(->> (load-backup backup-file)
(drop-bootstrap-datoms)
(group-by-tx)
(vals)))
(defn db-from-backup [db-uri backup-file]
(when (d/create-database db-uri)
(let [conn (d/connect db-uri)
backup (load-backup-datoms-by-tx backup-file)]
(assoc
(transact-backup-datoms conn backup)
:conn conn))))
(comment
(let [s "datomic:mem://gitfile1"
b "https://gist.githubusercontent.com/yayitswei/a566188b51e9b3d72ef9/raw/1795b663b59a0ef961e0e8b48e83542332142c44/gistfile1.txt"]
(d/delete-database s)
(db-from-backup s b)))
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment