├── .gitignore ├── resources ├── requiring-sample.edn ├── migrations │ ├── txes.clj │ └── requiring.clj └── sample4.edn ├── project.clj ├── README.md ├── src └── io │ └── rkn │ └── conformity.clj └── test └── io └── rkn └── conformity_test.clj /.gitignore: -------------------------------------------------------------------------------- 1 | /target 2 | /lib 3 | /classes 4 | /checkouts 5 | pom.xml 6 | *.jar 7 | *.class 8 | .lein-deps-sum 9 | .lein-failures 10 | .lein-plugins 11 | dev 12 | -------------------------------------------------------------------------------- /resources/requiring-sample.edn: -------------------------------------------------------------------------------- 1 | {:requiring/base 2 | {:txes [[{:db/ident :preferences/color 3 | :db/valueType :db.type/string 4 | :db/cardinality :db.cardinality/one 5 | :db/id #db/id[:db.part/db] 6 | :db.install/_attribute :db.part/db}] 7 | 8 | [{:db/id #db/id[:db.part/user] 9 | :preferences/color "green"}]]} 10 | 11 | :requiring/dependent 12 | {:requires [:requiring/base] 13 | :txes-fn migrations.requiring/everyone-likes-orange-instead}} 14 | 15 | -------------------------------------------------------------------------------- /resources/migrations/txes.clj: -------------------------------------------------------------------------------- 1 | (ns migrations.txes 2 | (:require [datomic.api :as d])) 3 | 4 | (defn attr 5 | [prefix ident] 6 | [{:db/id (d/tempid :db.part/db) 7 | :db/ident (keyword prefix ident) 8 | :db/valueType :db.type/string 9 | :db/cardinality :db.cardinality/one 10 | :db.install/_attribute :db.part/db}]) 11 | 12 | (defn txes-foo [conn] 13 | (vector (vec 14 | (mapcat (partial attr "txes-fn") 15 | ["foo-1" "foo-2"])))) 16 | 17 | (defn txes-bar [conn] 18 | (vector (vec 19 | (mapcat (partial attr "txes-fn") 20 | ["bar-1" "bar-2"]))) ) 21 | -------------------------------------------------------------------------------- /project.clj: -------------------------------------------------------------------------------- 1 | (defproject io.rkn/conformity "0.5.4" 2 | :description "Idempotent datom transacting for Datomic.\n\nSpecial thanks to Stuart Halloway for the original idea, implementation and permission to take it and run." 3 | :url "http://github.com/rkneufeld/conformity" 4 | :license {:name "Eclipse Public License" 5 | :url "http://www.eclipse.org/legal/epl-v10.html"} 6 | :profiles {:dev {:dependencies [[org.clojure/clojure "1.5.1"] 7 | [com.datomic/datomic-free "0.9.4815.12"] 8 | [org.clojure/tools.namespace "0.2.3"]] 9 | :source-paths ["dev"]}}) 10 | -------------------------------------------------------------------------------- /resources/migrations/requiring.clj: -------------------------------------------------------------------------------- 1 | (ns migrations.requiring 2 | (:require [datomic.api :as d])) 3 | 4 | (def attr-q 5 | '[:find ?e 6 | :in $ ?attr ?v 7 | :where 8 | [?e ?attr ?v]]) 9 | 10 | (defn find-eids-with-val-for-attr 11 | [db attr val] 12 | (map first 13 | (d/q attr-q db attr val))) 14 | 15 | (defn everyone-likes-orange-instead 16 | "Everybody who liked green now likes orange instead." 17 | [conn] 18 | (let [green-eids (find-eids-with-val-for-attr 19 | (d/db conn) 20 | :preferences/color 21 | "green")] 22 | [(for [eid green-eids] 23 | [:db/add eid 24 | :preferences/color "orange"])])) 25 | -------------------------------------------------------------------------------- /resources/sample4.edn: -------------------------------------------------------------------------------- 1 | {:test4/norm1 2 | {:txes [[{:db/ident :test/attribute1 3 | :db/doc "test attribute 1" 4 | :db/valueType :db.type/string 5 | :db/cardinality :db.cardinality/one 6 | :db/id #db/id[:db.part/db] 7 | :db.install/_attribute :db.part/db} 8 | {:db/ident :test/user 9 | :db/doc "test user" 10 | :db/valueType :db.type/string 11 | :db/cardinality :db.cardinality/one 12 | :db/id #db/id[:db.part/db] 13 | :db.install/_attribute :db.part/db} 14 | {:db/ident :test/transaction-metadata 15 | :db/doc "annotates the transaction with metadata" 16 | :db/id #db/id[:db.part/user] 17 | :db/fn #db/fn 18 | {:lang :clojure 19 | :params [db metadata] 20 | :code [(assoc metadata :db/id #db/id[:db.part/tx])]}}]]} 21 | 22 | :test4/norm2 23 | {:txes-fn migrations.txes/txes-foo}} 24 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # conformity 2 | 3 | A Clojure/Datomic library for idempotently transacting datoms (norms) into your database – be they schema, data, or otherwise. 4 | 5 | In the simplest sense, conformity allows you to write migrations and ensure that they run once and only once. 6 | 7 | In a more general sense, conformity allows you to declare expectations (in the form of norms) about the state of your database, and enforce those idempotently without repeatedly transacting schema, required data, etc. 8 | 9 | ## Dependency 10 | 11 | Conformity is available on clojars, and can be included in your leiningen `project.clj` by adding the following to `:dependencies`: 12 | 13 | [![Clojars Project](http://clojars.org/io.rkn/conformity/latest-version.svg)](http://clojars.org/io.rkn/conformity) 14 | 15 | 16 | ## Usage 17 | 18 | The easiest way to use conformity is to store your norms in an edn file that lives in your `resources/` folder. 19 | 20 | ```clojure 21 | ;; resources/something.edn 22 | {:my-project/something-schema 23 | {:txes [[{:db/id #db/id [:db.part/db] 24 | :db/ident :something/title 25 | :db/valueType :db.type/string 26 | :db/cardinality :db.cardinality/one 27 | :db/index false 28 | :db.install/_attribute :db.part/db}]]}} 29 | ``` 30 | Then in your code: 31 | # src/my_project/something.clj 32 | ```clojure 33 | (ns my-project.something 34 | (:require [io.rkn.conformity :as c] 35 | [datomic.api :as d])) 36 | 37 | (def uri "datomic:mem://my-project") 38 | (d/create-database uri) 39 | (def conn (d/connect uri)) 40 | 41 | (def norms-map (c/read-resource "something.edn")) 42 | 43 | (println (str "Has attribute? " (c/has-attribute? (d/db conn) :something/title))) 44 | (c/ensure-conforms conn norms-map [:my-project/something-schema]) 45 | (println (str "Has attribute? " (c/has-attribute? (d/db conn) :something/title))) 46 | 47 | ; ... Code dependant on the presence of attributes in :my-project/something-schema 48 | ``` 49 | You can see this more directly illustrated in a console… 50 | ```clojure 51 | ; nREPL 0.1.5 52 | 53 | ; Setup a in-memory db 54 | (require '[datomic.api :as d]) 55 | (def uri "datomic:mem://my-project") 56 | (d/create-database uri) 57 | (def conn (d/connect uri)) 58 | 59 | ; Hook up conformity and your sample datom 60 | (require '[io.rkn.conformity :as c]) 61 | (def norms-map (c/read-resource "something.edn")) 62 | 63 | (c/has-attribute? (d/db conn) :something/title) 64 | ; -> false 65 | 66 | (c/ensure-conforms conn norms-map [:my-project/something-schema]) 67 | (c/has-attribute? (d/db conn) :something/title) 68 | ; -> true 69 | ``` 70 | 71 | ### Migrations as code 72 | 73 | Instead of using the `:txes` key to point to an inline transaction, you can also use a `:txes-fn` key pointing to a symbol reference to a function, as follows... 74 | 75 | ```clojure 76 | ;; resources/something.edn 77 | {:my-project/something-else-schema 78 | {:txes-fn my-project.migrations.txes/everyone-likes-orange-instead}} 79 | ``` 80 | 81 | `everyone-likes-orange-instead` will be passed the Datomic connection and should return transaction data, allowing transactions to be driven by full-fledged inspection of the database. 82 | 83 | For example... 84 | 85 | ```clojure 86 | (ns my-project.migrations.txes 87 | (:require [datomic.api :as d]) 88 | 89 | (def attr-q 90 | '[:find ?e 91 | :in $ ?attr ?v 92 | :where 93 | [?e ?attr ?v]]) 94 | 95 | (defn find-eids-with-val-for-attr 96 | [db attr val] 97 | (map first 98 | (d/q attr-q db attr val))) 99 | 100 | (defn everyone-likes-orange-instead 101 | "Everybody who liked green now likes orange instead." 102 | [conn] 103 | (let [green-eids (find-eids-with-val-for-attr 104 | (d/db conn) 105 | :preferences/color 106 | "green")] 107 | [(for [eid green-eids] 108 | [:db/add eid 109 | :preferences/color "orange"])])) 110 | ``` 111 | 112 | 113 | ### Schema dependencies 114 | 115 | Norms can also carry a `:requires` attribute, which points to the keyword/ident of some other such map which it depends on having been already transacted before it can be. This is declarative; Once specified in the map passed to `ensure-conforms`, confirmity handles the rest. 116 | 117 | ### Norms versioning 118 | 119 | Most of the time your norms are supposed to be ran only once. 120 | Once a map gets conformed, a trace of that event will be left in Datomic. 121 | Then every trial of conforming the same norm will be ignored. 122 | 123 | However keep in mind that: 124 | 125 | 1. Conformity upon every `ensure-conforms` call will count how many `txes` 126 | (meaning number of collections of new facts, not a number of facts in one collection) 127 | you're trying to do. If that number is equal as it was before, nothing will happen. 128 | 129 | If it's not, then the norm will be considered not fully transacted and each element from `txes` will 130 | get transacted again. **WARNING:** you shouldn't use it to alter migrations effect. It's meant to make up 131 | for conforms not being atomic. If you need to _fix_ your past migrations then write a new migration for it. 132 | 133 | 2. To be capable of the above, Conformity has to evaluate `:txes-fn` every time `ensure-conforms` is ran. 134 | If you're sure you don't want to update your norms, 135 | add `:first-time-only` additional parameter to the norm map, as follows: 136 | 137 | ```clojure 138 | {:my/migration 139 | {:txes [[{:db/id [:foo/id "foo"] 140 | :foo/bool true}]] 141 | :first-time-only true}} 142 | ``` 143 | 144 | ### Maintaining txInstant 145 | 146 | In Datomic it is possible to do an [initial import of existing data that has its own timestamps](https://docs.datomic.com/on-prem/best-practices.html#set-txinstant-on-imports), where the timestamps are used as the `:db/txInstant` value. To enable the use of Conformity *before* the initial import, a custom `:db/txInstant` value (rather than the transactor's clock time) is necessary. This is because `:db/txInstant` cannot be set to a value that is older than any existing transaction. 147 | 148 | This can be done by passing the `tx-instant` argument: 149 | 150 | ```clojure 151 | (def conformity-attr (c/default-conformity-attribute-for-db (d/db conn))) 152 | (def tx-instant (c/last-tx-instant (d/db conn))) 153 | (c/ensure-conforms conn conformity-attr norms-map (keys norms-map) tx-instant) 154 | ``` 155 | 156 | ## License 157 | 158 | Copyright © 2012-2014 Ryan Neufeld 159 | 160 | Distributed under the Eclipse Public License, the same as Clojure. 161 | -------------------------------------------------------------------------------- /src/io/rkn/conformity.clj: -------------------------------------------------------------------------------- 1 | (ns io.rkn.conformity 2 | (:require [datomic.api :refer [q db] :as d] 3 | [clojure.java.io :as io])) 4 | 5 | (def ^:deprecated default-conformity-attribute :confirmity/conformed-norms) 6 | (def conformity-ensure-norm-tx :conformity/ensure-norm-tx) 7 | 8 | (def ensure-norm-tx-txfn 9 | "Transaction function to ensure each norm tx is executed exactly once" 10 | (d/function 11 | '{:lang :clojure 12 | :params [db norm-attr norm index-attr index tx] 13 | :code (when-not (seq (q '[:find ?tx 14 | :in $ ?na ?nv ?ia ?iv 15 | :where [?tx ?na ?nv ?tx] [?tx ?ia ?iv ?tx]] 16 | db norm-attr norm index-attr index)) 17 | (cons {:db/id (d/tempid :db.part/tx) 18 | norm-attr norm 19 | index-attr index} 20 | tx))})) 21 | 22 | (defn read-resource 23 | "Reads and returns data from a resource containing edn text. An 24 | optional argument allows specifying opts for clojure.edn/read" 25 | ([resource-name] 26 | (read-resource {:readers *data-readers*} resource-name)) 27 | ([opts resource-name] 28 | (with-open [reader (->> (io/resource resource-name) 29 | (io/reader) 30 | (java.io.PushbackReader.))] 31 | (clojure.edn/read opts reader)))) 32 | 33 | (defn index-attr 34 | "Returns the index-attr corresponding to a conformity-attr" 35 | [conformity-attr] 36 | (keyword (namespace conformity-attr) 37 | (str (name conformity-attr) "-index"))) 38 | 39 | (defn has-attribute? 40 | "Returns true if a database has an attribute named attr-name" 41 | [db attr-name] 42 | (-> (d/entity db attr-name) 43 | :db.install/_attribute 44 | boolean)) 45 | 46 | (defn has-function? 47 | "Returns true if a database has a function named fn-name" 48 | [db fn-name] 49 | (-> (d/entity db fn-name) 50 | :db/fn 51 | boolean)) 52 | 53 | (defn default-conformity-attribute-for-db 54 | "Returns the default-conformity-attribute for a db." 55 | [db] 56 | (or (some #(and (has-attribute? db %) %) [:conformity/conformed-norms default-conformity-attribute]) 57 | :conformity/conformed-norms)) 58 | 59 | (defn last-tx-instant 60 | "Returns a value of the :db/txInstant attribute of the last transaction." 61 | [db] 62 | (let [tx (-> db (d/basis-t) (d/t->tx))] 63 | (ffirst (q '[:find ?inst 64 | :in $ ?tx 65 | :where [?tx :db/txInstant ?inst]] 66 | db tx)))) 67 | 68 | (defn with-tx-instant 69 | "If instant is not nil, add it as the :db/txInstant attribute of transaction." 70 | [instant tx-data] 71 | (if instant 72 | (cons {:db/id (d/tempid :db.part/tx) 73 | :db/txInstant instant} 74 | tx-data) 75 | tx-data)) 76 | 77 | (defn ensure-conformity-schema 78 | "Ensure that the two attributes and one transaction function 79 | required to track conformity via the conformity-attr keyword 80 | parameter are installed in the database." 81 | ([conn conformity-attr] 82 | (ensure-conformity-schema conn conformity-attr nil)) 83 | ([conn conformity-attr tx-instant] 84 | (when-not (has-attribute? (db conn) conformity-attr) 85 | (d/transact conn (with-tx-instant tx-instant 86 | [{:db/id (d/tempid :db.part/db) 87 | :db/ident conformity-attr 88 | :db/valueType :db.type/keyword 89 | :db/cardinality :db.cardinality/one 90 | :db/doc "Name of this transaction's norm" 91 | :db/index true 92 | :db.install/_attribute :db.part/db}]))) 93 | (when-not (has-attribute? (db conn) (index-attr conformity-attr)) 94 | (d/transact conn (with-tx-instant tx-instant 95 | [{:db/id (d/tempid :db.part/db) 96 | :db/ident (index-attr conformity-attr) 97 | :db/valueType :db.type/long 98 | :db/cardinality :db.cardinality/one 99 | :db/doc "Index of this transaction within its norm" 100 | :db/index true 101 | :db.install/_attribute :db.part/db}]))) 102 | (when-not (has-function? (db conn) conformity-ensure-norm-tx) 103 | (d/transact conn (with-tx-instant tx-instant 104 | [{:db/id (d/tempid :db.part/user) 105 | :db/ident conformity-ensure-norm-tx 106 | :db/doc "Ensures each norm tx is executed exactly once" 107 | :db/fn ensure-norm-tx-txfn}]))))) 108 | 109 | (defn conforms-to? 110 | "Does database have a norm installed? 111 | 112 | conformity-attr (optional) the keyword name of the attribute used to 113 | track conformity 114 | norm the keyword name of the norm you want to check 115 | tx-count the count of transactions for that norm" 116 | ([db norm tx-count] 117 | (conforms-to? db (default-conformity-attribute-for-db db) norm tx-count)) 118 | ([db conformity-attr norm tx-count] 119 | (and (has-attribute? db conformity-attr) 120 | (pos? tx-count) 121 | (-> (q '[:find ?tx 122 | :in $ ?na ?nv 123 | :where [?tx ?na ?nv ?tx]] 124 | db conformity-attr norm) 125 | count 126 | (= tx-count))))) 127 | 128 | (defn maybe-timeout-synch-schema [conn maybe-timeout] 129 | (if maybe-timeout 130 | (let [result (deref (d/sync-schema conn (d/basis-t (d/db conn))) maybe-timeout ::timed-out)] 131 | (if (= result ::timed-out) 132 | (throw (ex-info "Timed out calling synch-schema between conformity transactions" {:timeout maybe-timeout})) 133 | result)) 134 | @(d/sync-schema conn (d/basis-t (d/db conn))))) 135 | 136 | (defn reduce-txes 137 | "Reduces the seq of transactions for a norm into a transaction 138 | result accumulator" 139 | ([acc conn norm-attr norm-name txes sync-schema-timeout] 140 | (reduce-txes acc conn norm-attr norm-name txes sync-schema-timeout nil)) 141 | ([acc conn norm-attr norm-name txes sync-schema-timeout tx-instant] 142 | (reduce 143 | (fn [acc [tx-index tx]] 144 | (try 145 | (let [safe-tx [conformity-ensure-norm-tx 146 | norm-attr norm-name 147 | (index-attr norm-attr) tx-index 148 | (with-tx-instant tx-instant tx)] 149 | _ (maybe-timeout-synch-schema conn sync-schema-timeout) 150 | tx-result @(d/transact conn [safe-tx])] 151 | (if (next (:tx-data tx-result)) 152 | (conj acc {:norm-name norm-name 153 | :tx-index tx-index 154 | :tx-result tx-result}) 155 | acc)) 156 | (catch Throwable t 157 | (let [reason (.getMessage t) 158 | data {:succeeded acc 159 | :failed {:norm-name norm-name 160 | :tx-index tx-index 161 | :reason reason}}] 162 | (throw (ex-info reason data t)))))) 163 | acc (map-indexed vector txes)))) 164 | 165 | (defn eval-txes-fn 166 | "Given a connection and a symbol referencing a function on the classpath... 167 | - `require` the symbol's namespace 168 | - `resolve` the symbol 169 | - evaluate the function, passing it the connection 170 | - return the result" 171 | [conn txes-fn] 172 | (try (require (symbol (namespace txes-fn))) 173 | {:txes ((resolve txes-fn) conn)} 174 | (catch Throwable t 175 | {:ex (str "Exception evaluating " txes-fn ": " t)}))) 176 | 177 | (defn get-norm 178 | "Pull from `norm-map` the `norm-name` value. If the norm contains a 179 | `txes-fn` key, allow processing of that key to stand in for a `txes` 180 | value. Returns the value containing transactable data." 181 | [conn norm-map norm-name] 182 | (let [{:keys [txes txes-fn] :as norm} (get norm-map norm-name)] 183 | (cond-> norm 184 | txes-fn (merge (eval-txes-fn conn txes-fn))))) 185 | 186 | (defn handle-txes 187 | "If a collection of txes data to transact is empty then return: 188 | 1. an info of what's been successfully transacted this far 189 | 2. a structure with info which norm failed and for what reason. 190 | 191 | Run transaction for each element of txes collection otherwise." 192 | [acc conn norm-attr norm-name txes ex sync-schema-timeout tx-instant] 193 | (if (empty? txes) 194 | (let [reason (or ex 195 | (str "No transactions provided for norm " 196 | norm-name)) 197 | data {:succeeded acc 198 | :failed {:norm-name norm-name 199 | :reason reason}}] 200 | (throw (ex-info reason data))) 201 | (reduce-txes acc conn norm-attr norm-name txes sync-schema-timeout 202 | tx-instant))) 203 | 204 | (defn first-time-only-conforms-to? 205 | "If a norm is supposed to be first-time-only/not-changeable then the decision whether 206 | a norm should be conformed is absence of norm name in conformed norms registry. 207 | 208 | Does database have an unchangeable norm installed? 209 | 210 | conformity-attr (optional) the keyword name of the attribute used to 211 | track conformity 212 | norm the keyword name of the norm you want to check" 213 | ([db norm] 214 | (first-time-only-conforms-to? db (default-conformity-attribute-for-db db) norm)) 215 | ([db conformity-attr norm] 216 | (and (has-attribute? db conformity-attr) 217 | (ffirst (q '[:find ?nv 218 | :in $ ?na ?nv 219 | :where [?tx ?na ?nv]] 220 | db conformity-attr norm))))) 221 | 222 | (defn handle-first-time-only-norm 223 | [acc conn norm-attr norm-map norm-name sync-schema-timeout tx-instant] 224 | (if (first-time-only-conforms-to? (db conn) norm-attr norm-name) 225 | acc 226 | (let [{:keys [txes ex]} (get-norm conn norm-map norm-name)] 227 | (handle-txes acc conn norm-attr norm-name txes ex sync-schema-timeout 228 | tx-instant)))) 229 | 230 | (defn handle-mutable-norm 231 | [acc conn norm-attr norm-map norm-name sync-schema-timeout tx-instant] 232 | (let [{:keys [txes ex]} (get-norm conn norm-map norm-name)] 233 | (if (conforms-to? (db conn) norm-attr norm-name (count txes)) 234 | acc 235 | (handle-txes acc conn norm-attr norm-name txes ex sync-schema-timeout 236 | tx-instant)))) 237 | 238 | (defn reduce-norms 239 | "Reduces norms from a norm-map specified by a seq of norm-names into 240 | a transaction result accumulator" 241 | ([acc conn norm-attr norm-map norm-names] 242 | (reduce-norms acc conn norm-attr norm-map norm-names nil)) 243 | ([acc conn norm-attr norm-map norm-names tx-instant] 244 | (let [sync-schema-timeout (:conformity.setting/sync-schema-timeout norm-map)] 245 | (reduce 246 | (fn [acc norm-name] 247 | (let [{:keys [requires first-time-only]} (get norm-map norm-name) 248 | acc (cond-> acc 249 | requires (reduce-norms conn norm-attr norm-map requires 250 | tx-instant))] 251 | (if first-time-only 252 | (handle-first-time-only-norm acc conn norm-attr norm-map norm-name 253 | sync-schema-timeout tx-instant) 254 | (handle-mutable-norm acc conn norm-attr norm-map norm-name 255 | sync-schema-timeout tx-instant)))) 256 | acc norm-names)))) 257 | 258 | (defn ensure-conforms 259 | "Ensure that norms represented as datoms are conformed-to (installed), be they 260 | schema, data or otherwise. 261 | 262 | conformity-attr (optional) the keyword name of the attribute used to 263 | track conformity 264 | norm-map a map from norm names to data maps. 265 | a data map contains: 266 | :txes - the data to install 267 | :txes-fn - An alternative to txes, pointing to a 268 | symbol representing a fn on the classpath that 269 | will return transactions. 270 | :requires - (optional) a list of prerequisite norms 271 | in norm-map. 272 | :first-time-only - (optional) a boolean. If true, a norm will be 273 | conformed only once. After that norm-name will 274 | be permanently ignored. Any norm with same norm-name, 275 | be it modification of the old one or new norm 276 | named the same will not even be considered to conformed 277 | as soon as the name reuse is detected. 278 | norm-names (optional) A collection of names of norms to conform to. 279 | Will use keys of norm-map if not provided. 280 | 281 | On success, returns a vector of maps with values for :norm-name, :tx-index, 282 | and :tx-result for each transaction that improved the db's conformity. 283 | 284 | On failure, throws an ex-info with a reason and data about any partial 285 | success before the failure." 286 | ([conn norm-map] 287 | (ensure-conforms conn norm-map (keys norm-map))) 288 | ([conn norm-map norm-names] 289 | (ensure-conforms conn (default-conformity-attribute-for-db (d/db conn)) norm-map norm-names)) 290 | ([conn conformity-attr norm-map norm-names] 291 | (ensure-conforms conn conformity-attr norm-map norm-names nil)) 292 | ([conn conformity-attr norm-map norm-names tx-instant] 293 | (ensure-conformity-schema conn conformity-attr tx-instant) 294 | (reduce-norms [] conn conformity-attr norm-map norm-names tx-instant))) 295 | 296 | (defn- speculative-conn 297 | "Creates a mock datomic.Connection that speculatively applies transactions using datomic.api/with" 298 | [db] 299 | (let [state (atom {:db-after db}) 300 | wrap-listenable-future (fn [value] 301 | (reify datomic.ListenableFuture 302 | (get [this] value) 303 | (get [this timeout time-unit] value) 304 | (toString [this] (prn-str value))))] 305 | (reify datomic.Connection 306 | (db [_] (:db-after @state)) 307 | (transact [_ tx-data] 308 | (let [tx-result-after (swap! state #(d/with (:db-after %) tx-data))] 309 | (wrap-listenable-future tx-result-after))) 310 | (sync [_] (wrap-listenable-future (:db-after @state))) 311 | (sync [_ t] (wrap-listenable-future (:db-after @state))) 312 | (syncSchema [_ t] (wrap-listenable-future (:db-after @state)))))) 313 | 314 | (defn with-conforms 315 | "Variation of ensure-conforms that speculatively ensures norm are conformed to 316 | 317 | On success, returns a map with: 318 | :db the resulting database that conforms the the provided norms 319 | :result a vector of maps with values for :norm-name, :tx-index, 320 | and :tx-result for each transaction that improved the db's conformity. 321 | 322 | On failure, throws an ex-info with a reason and data about any partial 323 | success before the failure." 324 | ([db norm-map] 325 | (with-conforms db norm-map (keys norm-map))) 326 | ([db norm-map norm-names] 327 | (with-conforms db (default-conformity-attribute-for-db db) norm-map norm-names)) 328 | ([db conformity-attr norm-map norm-names] 329 | (let [conn (speculative-conn db)] 330 | (ensure-conformity-schema conn conformity-attr) 331 | (let [result (reduce-norms [] conn conformity-attr norm-map norm-names)] 332 | {:db (d/db conn) 333 | :result result})))) 334 | -------------------------------------------------------------------------------- /test/io/rkn/conformity_test.clj: -------------------------------------------------------------------------------- 1 | (ns io.rkn.conformity-test 2 | (:require [clojure.test :refer :all] 3 | [io.rkn.conformity :refer :all] 4 | [datomic.api :refer [q db] :as d] 5 | [migrations.txes :refer [txes-foo txes-bar]])) 6 | 7 | (def uri "datomic:mem://test") 8 | (defn fresh-conn [] 9 | (d/delete-database uri) 10 | (d/create-database uri) 11 | (d/connect uri)) 12 | 13 | (defn attr 14 | ([ident] 15 | (attr ident :db.type/string)) 16 | ([ident value-type] 17 | [{:db/id (d/tempid :db.part/db) 18 | :db/ident ident 19 | :db/valueType value-type 20 | :db/cardinality :db.cardinality/one 21 | :db.install/_attribute :db.part/db}])) 22 | 23 | (def sample-norms-map1 {:test1/norm1 24 | {:txes [(attr :test/attribute1) 25 | (attr :test/attribute2)]} 26 | :test1/norm2 27 | {:txes [(attr :test/attribute3)]}}) 28 | 29 | (def sample-norms-map2 {:test2/norm1 30 | {:txes [(attr :test/attribute1)]} 31 | :test2/norm2 ;; Bad data type - should 'splode 32 | {:txes [(attr :test/attribute2 :db.type/nosuch)]}}) 33 | 34 | (def sample-norms-map3 {:test3/norm1 35 | {:txes [(attr :test/attribute1) 36 | (attr :test/attribute2)]} 37 | :test3/norm2 38 | {:txes [(attr :test/attribute3)] 39 | :requires [:test3/norm1]}}) 40 | 41 | (def sample-norms-map5 {:test4/norm1 42 | {:txes [[{:db/id (d/tempid :db.part/db) 43 | :db/ident :test/unique-attribute 44 | :db/valueType :db.type/string 45 | :db/cardinality :db.cardinality/one 46 | :db.install/_attribute :db.part/db}] 47 | [{:db/id :test/unique-attribute 48 | :db/index true 49 | :db.alter/_attribute :db.part/db}] 50 | [{:db/id :test/unique-attribute 51 | :db/unique :db.unique/value 52 | :db.alter/_attribute :db.part/db}]]}}) 53 | 54 | (def sample-norms-map-txes-fns {:test-txes-fn/norm1 55 | {:txes-fn 'migrations.txes/txes-foo} 56 | :test-txes-fn/norm2 57 | {:txes-fn 'migrations.txes/txes-bar}}) 58 | 59 | (deftest test-ensure-conforms 60 | (testing "installs all expected norms" 61 | 62 | (testing "without explicit norms list" 63 | (let [conn (fresh-conn) 64 | result (ensure-conforms conn sample-norms-map1)] 65 | (is (= (set (map (juxt :norm-name :tx-index) result)) 66 | (set [[:test1/norm1 0] [:test1/norm1 1] [:test1/norm2 0]]))) 67 | (is (has-attribute? (db conn) :test/attribute1)) 68 | (is (has-attribute? (db conn) :test/attribute2)) 69 | (is (has-attribute? (db conn) :test/attribute3)) 70 | (is (empty? (ensure-conforms conn sample-norms-map1))))) 71 | 72 | (testing "can add db/unique after an avet index add" 73 | (let [conn (fresh-conn) 74 | result (ensure-conforms conn sample-norms-map5)] 75 | (is (has-attribute? (db conn) :test/unique-attribute)))) 76 | 77 | (testing "with explicit norms list" 78 | (let [conn (fresh-conn) 79 | result (ensure-conforms conn sample-norms-map2 [:test2/norm1])] 80 | (is (= (map (juxt :norm-name :tx-index) result) 81 | [[:test2/norm1 0]])) 82 | (is (has-attribute? (db conn) :test/attribute1)) 83 | (is (not (has-attribute? (db conn) :test/attribute2))) 84 | (is (empty? (ensure-conforms conn sample-norms-map2 [:test2/norm1])))) 85 | 86 | (testing "and requires" 87 | (let [conn (fresh-conn) 88 | result (ensure-conforms conn sample-norms-map3 [:test3/norm2])] 89 | (is (= (map (juxt :norm-name :tx-index) result) 90 | [[:test3/norm1 0] [:test3/norm1 1] [:test3/norm2 0]])) 91 | (is (has-attribute? (db conn) :test/attribute1)) 92 | (is (has-attribute? (db conn) :test/attribute2)) 93 | (is (has-attribute? (db conn) :test/attribute3)) 94 | (is (empty? (ensure-conforms conn sample-norms-map3 95 | [:test3/norm2]))))))) 96 | 97 | (testing "throws exception if norm-map lacks transactions for a norm" 98 | (let [conn (fresh-conn)] 99 | (is (thrown-with-msg? clojure.lang.ExceptionInfo 100 | #"No transactions provided for norm :test4/norm1" 101 | (ensure-conforms conn {} 102 | [:test4/norm1]))) 103 | (is (thrown-with-msg? clojure.lang.ExceptionInfo 104 | #"No transactions provided for norm :test4/norm1" 105 | (ensure-conforms conn {:test4/norm1 {}} 106 | [:test4/norm1]))) 107 | (is (thrown-with-msg? clojure.lang.ExceptionInfo 108 | #"No transactions provided for norm :test4/norm1" 109 | (ensure-conforms conn {:test4/norm1 {:txes []}} 110 | [:test4/norm1]))))) 111 | 112 | (testing "it uses the corrected spelling of the default-conformity-attribute on a new db" 113 | (let [conn (fresh-conn)] 114 | (ensure-conforms conn sample-norms-map1) 115 | (is (= false (has-attribute? (db conn) :confirmity/conformed-norms))) 116 | (is (= true (has-attribute? (db conn) :conformity/conformed-norms))))) 117 | 118 | (testing "it continues to use the bad spelling of the default-conformity-attribute if already installed" 119 | (let [conn (fresh-conn)] 120 | (ensure-conforms conn :confirmity/conformed-norms sample-norms-map1 (keys sample-norms-map1)) 121 | (is (= true (has-attribute? (db conn) :confirmity/conformed-norms))) 122 | (is (= false (has-attribute? (db conn) :conformity/conformed-norms))) 123 | (ensure-conforms conn sample-norms-map1) 124 | (is (= true (has-attribute? (db conn) :confirmity/conformed-norms))) 125 | (is (= false (has-attribute? (db conn) :conformity/conformed-norms))))) 126 | 127 | (testing "with tx-instant" 128 | (let [conn (fresh-conn) 129 | before (last-tx-instant (db conn))] 130 | (ensure-conforms conn :conformity/conformed-norms sample-norms-map1 131 | (keys sample-norms-map1) before) 132 | (is (has-attribute? (db conn) :test/attribute1)) 133 | (is (has-attribute? (db conn) :test/attribute2)) 134 | (is (= before (last-tx-instant (db conn))))))) 135 | 136 | (deftest test-with-conforms 137 | (testing "speculatively installs all expected norms" 138 | 139 | (testing "without explicit norms list" 140 | (let [{:keys [db result]} (with-conforms (d/db (fresh-conn)) sample-norms-map1)] 141 | (is (= (set (map (juxt :norm-name :tx-index) result)) 142 | (set [[:test1/norm1 0] [:test1/norm1 1] [:test1/norm2 0]]))) 143 | (is (has-attribute? db :test/attribute1)) 144 | (is (has-attribute? db :test/attribute2)) 145 | (is (has-attribute? db :test/attribute3)) 146 | (is (empty? (:result (with-conforms db sample-norms-map1)))))) 147 | 148 | (testing "can add db/unique after an avet index add" 149 | (let [{:keys [db result]} (with-conforms (d/db (fresh-conn)) sample-norms-map5)] 150 | (is (has-attribute? db :test/unique-attribute)))) 151 | 152 | (testing "with explicit norms list" 153 | (let [{:keys [db result]} (with-conforms (d/db (fresh-conn)) sample-norms-map2 [:test2/norm1])] 154 | (is (= (map (juxt :norm-name :tx-index) result) 155 | [[:test2/norm1 0]])) 156 | (is (has-attribute? db :test/attribute1)) 157 | (is (not (has-attribute? db :test/attribute2))) 158 | (is (empty? (:result (with-conforms db sample-norms-map2 [:test2/norm1]))))) 159 | 160 | (testing "and requires" 161 | (let [{:keys [db result]} (with-conforms (d/db (fresh-conn)) sample-norms-map3 [:test3/norm2])] 162 | (is (= (map (juxt :norm-name :tx-index) result) 163 | [[:test3/norm1 0] [:test3/norm1 1] [:test3/norm2 0]])) 164 | (is (has-attribute? db :test/attribute1)) 165 | (is (has-attribute? db :test/attribute2)) 166 | (is (has-attribute? db :test/attribute3)) 167 | (is (empty? (:result (with-conforms db sample-norms-map3 168 | [:test3/norm2])))))))) 169 | 170 | (testing "throws exception if norm-map lacks transactions for a norm" 171 | (let [db (d/db (fresh-conn))] 172 | (is (thrown-with-msg? clojure.lang.ExceptionInfo 173 | #"No transactions provided for norm :test4/norm1" 174 | (with-conforms db {} 175 | [:test4/norm1]))) 176 | (is (thrown-with-msg? clojure.lang.ExceptionInfo 177 | #"No transactions provided for norm :test4/norm1" 178 | (with-conforms db {:test4/norm1 {}} 179 | [:test4/norm1]))) 180 | (is (thrown-with-msg? clojure.lang.ExceptionInfo 181 | #"No transactions provided for norm :test4/norm1" 182 | (with-conforms db {:test4/norm1 {:txes []}} 183 | [:test4/norm1])))))) 184 | 185 | (deftest test-conforms-to? 186 | (let [tx-count (count (:txes (sample-norms-map1 :test1/norm1)))] 187 | (testing "returns true if a norm is already installed" 188 | (let [conn (fresh-conn)] 189 | (ensure-conforms conn sample-norms-map1 [:test1/norm1]) 190 | (is (= true (conforms-to? (db conn) :test1/norm1 tx-count))))) 191 | 192 | (testing "returns false if" 193 | (testing "a norm has not been installed" 194 | (let [conn (fresh-conn)] 195 | (ensure-conformity-schema conn default-conformity-attribute) 196 | (is (= false (conforms-to? (db conn) :test1/norm1 tx-count))))) 197 | 198 | (testing "conformity-attr does not exist" 199 | (let [conn (fresh-conn)] 200 | (is (= false (conforms-to? (db conn) :test1/norm1 tx-count)))))))) 201 | 202 | (deftest test-ensure-conformity-schema 203 | (testing "it adds the conformity schema if it is absent" 204 | (let [conn (fresh-conn) 205 | _ (ensure-conformity-schema conn :test/conformity) 206 | db (db conn)] 207 | (is (has-attribute? db :test/conformity)) 208 | (is (has-attribute? db :test/conformity-index)) 209 | (is (has-function? db conformity-ensure-norm-tx)))) 210 | 211 | (testing "it does nothing if the conformity schema exists" 212 | (let [conn (fresh-conn) 213 | count-txes (fn [db] 214 | (-> (q '[:find ?tx 215 | :where [?tx :db/txInstant]] 216 | db) 217 | count)) 218 | _ (ensure-conformity-schema conn :test/conformity) 219 | before (count-txes (db conn)) 220 | _ (ensure-conformity-schema conn :test/conformity) 221 | after (count-txes (db conn))] 222 | (is (= before after))))) 223 | 224 | (deftest test-fails-on-bad-norm 225 | (testing "It explodes when you pass it a bad norm" 226 | (let [conn (fresh-conn)] 227 | (is (thrown-with-msg? clojure.lang.ExceptionInfo 228 | #":db.error/not-an-entity Unable to resolve entity: :db.type/nosuch" 229 | (ensure-conforms conn sample-norms-map2 [:test2/norm2])))))) 230 | 231 | (deftest test-loads-norms-from-a-resource 232 | (testing "loads a datomic schema from edn in a resource" 233 | (let [sample-norms-map4 (read-resource "sample4.edn") 234 | tx-count (count (:txes (sample-norms-map4 :test4/norm1))) 235 | conn (fresh-conn)] 236 | (is (ensure-conforms conn sample-norms-map4)) 237 | (is (conforms-to? (db conn) :test4/norm1 tx-count)) 238 | (let [tx-meta {:test/user "bob"} 239 | tx-result @(d/transact conn 240 | [[:test/transaction-metadata tx-meta] 241 | {:db/id (d/tempid :db.part/user) 242 | :test/attribute1 "forty two"}]) 243 | rel (d/q '[:find ?user ?val 244 | :where 245 | [_ :test/attribute1 ?val ?tx] 246 | [?tx :test/user ?user]] 247 | (db conn)) 248 | [user val] (first rel)] 249 | (is (= "bob" user)) 250 | (is (= "forty two" val))))) 251 | (testing "loads txes from from txes-fn reference in a resource" 252 | (let [sample-norms-map4 (read-resource "sample4.edn") 253 | conn (fresh-conn)] 254 | (is (ensure-conforms conn sample-norms-map4)) 255 | (let [ret (d/q '[:find ?e 256 | :where 257 | [?e :db/ident :txes-fn/foo-1]] 258 | (db conn))] 259 | (is (= 1 (count ret))))))) 260 | 261 | (defn txes= [a b] 262 | (letfn [(drop-id [xs] 263 | (mapv #(dissoc % :db/id) 264 | xs))] 265 | (= (map drop-id a) 266 | (map drop-id b)))) 267 | 268 | (deftest test-get-norm-gets-norms 269 | (testing "get-norm loads :txes key from norms-map" 270 | (is (= (:test1/norm1 sample-norms-map1) 271 | (get-norm (fresh-conn) sample-norms-map1 :test1/norm1)))) 272 | (testing "get-norm loads :txes-fn key from norms-map" 273 | (let [conn (fresh-conn)] 274 | (is (txes= (txes-foo conn) 275 | (:txes (get-norm conn sample-norms-map-txes-fns :test-txes-fn/norm1)))) 276 | (is (txes= (txes-bar conn) 277 | (:txes (get-norm conn sample-norms-map-txes-fns :test-txes-fn/norm2))))))) 278 | 279 | (deftest test-requires-transacted-eagerly 280 | (testing "required norms transacted prior to evaluation of requiring `txes-fn` norms" 281 | (let [conn (fresh-conn) 282 | norms (read-resource "requiring-sample.edn")] 283 | (ensure-conforms conn norms [:requiring/dependent]) 284 | (let [ret (d/q '[:find ?v :with ?e :where [?e :preferences/color ?v]] (d/db conn))] 285 | (is (= [["orange"]] ret)))))) 286 | 287 | (deftest test-unchangeable-norms 288 | (let [norms-map {:test-unchangeable/prep 289 | {:txes [[{:db/id (d/tempid :db.part/db) 290 | :db/ident :foo/id 291 | :db/valueType :db.type/string 292 | :db/unique :db.unique/value 293 | :db/cardinality :db.cardinality/one 294 | :db.install/_attribute :db.part/db} 295 | {:db/id (d/tempid :db.part/db) 296 | :db/ident :foo/bool 297 | :db/valueType :db.type/boolean 298 | :db/cardinality :db.cardinality/one 299 | :db.install/_attribute :db.part/db} 300 | {:db/id (d/tempid :db.part/db) 301 | :db/ident :foo/color 302 | :db/valueType :db.type/string 303 | :db/cardinality :db.cardinality/one 304 | :db.install/_attribute :db.part/db}]]} 305 | :test-unchangeable/populate 306 | {:txes [[{:db/id (d/tempid :db.part/user) 307 | :foo/id "bar"}]] 308 | :requires [:test-unchangeable/prep]} 309 | 310 | :test-unchangeable/migration 311 | {:txes [[{:db/id [:foo/id "bar"] 312 | :foo/bool true}]] 313 | :requires [:test-unchangeable/populate]}} 314 | map-w-repeated-norm {:test-unchangeable/migration 315 | {:txes [[{:db/id [:foo/id "bar"] 316 | :foo/bool true}] 317 | [{:db/id [:foo/id "bar"] 318 | :foo/color "green"}]]}}] 319 | (testing "conforming a norm which name's known to had been conformed once should be skipped" 320 | 321 | (testing "if norm isn't marked unchangeable, new element in txes will conform the norm again" 322 | (let [conn (fresh-conn)] 323 | (ensure-conforms conn norms-map) 324 | (is (= (:foo/bool 325 | (d/entity (db conn) [:foo/id "bar"])) 326 | true)) 327 | (ensure-conforms conn map-w-repeated-norm) 328 | (is (= (:foo/color 329 | (d/entity (db conn) [:foo/id "bar"])) 330 | "green")))) 331 | 332 | (testing "if norm is marked unchangeable, new element in txes will not conform" 333 | (let [conn (fresh-conn)] 334 | (ensure-conforms conn norms-map) 335 | (is (= (:foo/bool 336 | (d/entity (db conn) [:foo/id "bar"])) 337 | true)) 338 | (ensure-conforms conn 339 | (assoc-in map-w-repeated-norm 340 | [:test-unchangeable/migration :first-time-only] 341 | true)) 342 | (is (nil? (:foo/color 343 | (d/entity (db conn) [:foo/id "bar"]))))))))) 344 | --------------------------------------------------------------------------------