Skip to content

Instantly share code, notes, and snippets.

@CalebMacdonaldBlack
Forked from maxweber/query_check.clj
Created April 11, 2018 04:05
Show Gist options
  • Save CalebMacdonaldBlack/41e5847662845ee7460e0af9b157a505 to your computer and use it in GitHub Desktop.
Save CalebMacdonaldBlack/41e5847662845ee7460e0af9b157a505 to your computer and use it in GitHub Desktop.
Checks if a Datomic datalog query contains only allowed symbols / functions.
(require '[datomic.api :as d]
'[clojure.string :as str])
(defn normalize-query
"Turns a vector formatted Datomic datalog query into a map formatted
one."
[query]
(let [pairs (partition-by keyword? query)]
(assert (even? (count pairs)))
(into
{}
(map
(fn [[k v]]
[(first k) v])
(partition
2
pairs)))))
(defn check-functions
"Checks if pred-expr and fn-expr (see
http://docs.datomic.com/query.html#sec-4) contains only functions,
which satisfy function-allowed?"
[function-allowed? normalized-query]
(remove
nil?
(mapcat
(fn [clause]
(keep
(fn [expr]
(when (and (sequential? expr)
(symbol? (first expr))
(not (function-allowed? expr)))
[:not-allowed-function expr]))
clause))
(:where normalized-query))))
(def function-whitelist
'#{clojure.string/starts-with?
clojure.string/lower-case
clojure.string/includes?})
(defn function-allowed? [function-call]
(contains? function-whitelist (first function-call)))
(defn check-symbols
"Checks if every symbol in the Datomic datalog query satisfies
symbol-allowed?"
[symbol-allowed? normalized-query]
(keep
(fn [x]
(when (and (symbol? x) (not (symbol-allowed? x)))
[:not-allowed-symbol x]))
(tree-seq coll? seq normalized-query)))
(defn variable?
"Is x a variable (see http://docs.datomic.com/query.html#sec-4)"
[x]
(and (symbol? x)
(str/starts-with? (str x) "?")))
(defn src-var?
"Is x a src-var (see http://docs.datomic.com/query.html#sec-4)"
[x]
(and (symbol? x)
(str/starts-with? (str x) "$")))
(def symbol-whitelist
'#{.
...
pull})
(defn plain-symbol?
"Is x a plain-symbol (see http://docs.datomic.com/query.html#sec-4)"
[x]
(and (symbol? x)
(not (variable? x))
(not (src-var? x))))
(defn symbol-allowed?
"Every plain-symbol (see http://docs.datomic.com/query.html#sec-4)
has to be either on the function-whitelist or the
symbol-whitelist (or both)."
[x]
(or (not (plain-symbol? x))
(contains? function-whitelist x)
(contains? symbol-whitelist x)))
(defn check-query
"Checks if the Datomic datalog query contains only allowed symbols /
functions."
[query]
(seq
(if-not (vector? query)
[[:not-a-vector query]]
(let [normalized-query (normalize-query query)]
(concat
(check-functions
function-allowed?
normalized-query)
(check-symbols
symbol-allowed?
normalized-query))))))
@CalebMacdonaldBlack
Copy link
Author

Query, pattern, limit & offset. Use dependency injection and

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment