Checks if a Datomic datalog query contains only allowed symbols / functions.

query_check.clj

(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))))))

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