Skip to content

Instantly share code, notes, and snippets.

Embed
What would you like to do?
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))))))
@theronic

This comment has been minimized.

Copy link

@theronic theronic commented Aug 22, 2018

How do you whitelist certain attributes, incl. those touched in pull?

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