Applying access policies to Datomic queries.

policing.clj

(require '[datomic.api :as d])

(def uri "datomic:mem://policing")
(d/create-database uri)
(def conn (d/connect uri))

;; We are managing classified documents.

(def schema
  [{:db/ident       :level/rank
    :db/valueType   :db.type/long
    :db/cardinality :db.cardinality/one}
   {:db/ident       :doc/name
    :db/valueType   :db.type/string
    :db/unique      :db.unique/identity
    :db/cardinality :db.cardinality/one}
   {:db/ident       :doc/content
    :db/valueType   :db.type/string
    :db/cardinality :db.cardinality/one}
   {:db/ident       :doc/level
    :db/valueType   :db.type/keyword
    :db/cardinality :db.cardinality/one}
   {:db/ident       :user/name
    :db/valueType   :db.type/string
    :db/unique      :db.unique/identity
    :db/cardinality :db.cardinality/one}
   {:db/ident       :user/clearance
    :db/valueType   :db.type/keyword
    :db/cardinality :db.cardinality/one}])

(comment

  (d/transact conn schema)

  (d/transact conn
              [{:db/ident :level/official :level/rank 0}
               {:db/ident :level/restricted :level/rank 1}
               {:db/ident :level/top-secret :level/rank 2}])
  
  (d/transact conn
              [{:user/name "General" :user/clearance :level/top-secret}
               {:user/name "Midlevel" :user/clearance :level/restricted}
               {:user/name "Peon" :user/clearance :level/official}
              
               {:doc/name    "TOP-SECRET PLAN"
                :doc/level   :level/top-secret
                :doc/content "Attack here."}
               {:doc/name    "COMPROMISING PHOTO"
                :doc/level   :level/restricted
                :doc/content "..."}
               {:doc/name    "BUS SCHEDULE"
                :doc/level   :level/official
                :doc/content "Every couple 'o minutes."}])

  ;; verify
  (d/q '[:find [?name ...] :where [?lvl :level/rank _] [?lvl :db/ident ?name]] (d/db conn))
  (d/q '[:find [?name ...] :where [_ :doc/name ?name]] (d/db conn))
  (d/q '[:find [?name ...] :where [_ :user/name ?name]] (d/db conn)))

;; Users have read/write access to any document equal to or below
;; their clearance level.

(def policy
  '[[(access? ?user ?doc)
     [?user :user/clearance ?clearance] [?clearance :level/rank ?r1]
     [?doc :doc/level ?lvl] [?lvl :level/rank ?r2]
     [(<= ?r2 ?r1)]]])

;; Given arbitrary, flat transaction data, we can determine
;; automatically, whether a transaction is authorized.

(def tx [{:doc/name    "TOP-SECRET"
          :doc/content "Updated content"}])

(defn write? [db user tx]
  (let [;; apply w/o affecting database
        {:keys [db-before tx-data]} (d/with db tx)
        ;; resolve idents
        user                        (d/entid db-before user)
        ;; query across db and novelty
        unauthorized-docs           (d/q '[:find [?doc ...]
                                           :in $ % ?user [[?doc ?a _ _]]
                                           :where
                                           [?a :db/ident :doc/content]
                                           (not (access? ?user ?doc))]
                                         db-before policy user tx-data)]
    (empty? unauthorized-docs)))

(comment

  (write? (d/db conn)
          [:user/name "Peon"]
          '[{:doc/name "TOP-SECRET PLAN" :doc/content "forbidden"}])

  (write? (d/db conn)
          [:user/name "General"]
          '[{:doc/name "TOP-SECRET PLAN" :doc/content "forbidden"}]))

;; What about reading?

(comment

  (let [db   (d/db conn)
        user (d/entid db [:user/name "Peon"])]
    (d/q '[:find [?content ...]
           :in $ % ?user
           :where
           [?doc :doc/content ?content]
           (access? ?user ?doc)]
         db policy user))

  (let [db              (d/db conn)
        user            (d/entid db [:user/name "Peon"])
        accessible-docs (set (d/q '[:find [?doc ...]
                                    :in $ % ?user
                                    :where (access? ?user ?doc)] db policy user))
        filtered-db     (d/filter db (fn [db datom]
                                       (contains? accessible-docs (.-e datom))))]
    (d/q '[:find [?content ...]
           :where [?doc :doc/content ?content]] filtered-db)))

;; In general, this becomes non-trivial, as filtering becomes more
;; expensive: per-entity policies, policies depending on prior
;; interactions, etc..