Fulcro RAD Authorization Idea

_Fulcro_Authorization_Idea

account.cljc

(ns io.laef.model.account
  (:require
   [com.fulcrologic.rad.form-options :as fo]
   [com.fulcrologic.rad.attributes :as attr :refer [defattr]]
   [com.fulcrologic.rad.attributes-options :as ao]
   [io.laef.authorization :as auth]
   [io.laef.components.database-queries :as queries]))

(defattr id :account/id :uuid
  {ao/identity? true
   ao/schema    :production
   ;; Anyone can "walk the edge" to an account, but only the account owner
   ;; can delete their account.
   ;; Admins are capable of creating new accounts.
   ::auth/auth (fn [env ident user-ident]
                 (cond-> #{:read}
                   (= ident user-ident) (conj :delete)
                   (queries/admin? env user-ident) (conj :create)))})

(defattr email :account/email :string
  {ao/identities #{:account/id}
   ao/required?  true
   ao/schema     :production
   :com.fulcrologic.rad.database-adapters.datomic/attribute-schema
   {:db/unique :db.unique/value}
   ;; Only account owner can read and modify their email address
   ::auth/auth   (fn [_env ident user-ident]
                   (when (= ident user-ident)
                     #{:read :update}))})

(defattr active? :account/active? :boolean
  {ao/identities    #{:account/id}
   ao/schema        :production
   fo/default-value true
   ;; This attribute is publicly readable, but *nobody* can edit it
   })

(defattr password :password/hashed-value :string
  {ao/required?  true
   ao/identities #{:account/id}
   ao/schema     :production
   ;; Account owner can update their own password, but *nobody* can read it
   ::auth/auth   (fn [env ident user-ident]
                   (when (= ident user-ident)
                     #{:update}))})

(defattr widget-id :widget/id :uuid
  {ao/identity? true
   ao/schema    :production})

(defattr widget-name :widget/name :string
  {ao/identities #{:widget/id}
   ao/required?  true
   ao/schema     :production})

(defattr widgets :account/widgets :ref
  {ao/identities  #{:account/id}
   ao/schema      :production
   ao/cardinality :many
   ao/target      :widget/id
   ;; Only the account owner can "walk the edge" to their owned widgets
   ::auth/auth    (fn [env ident user-ident]
                    (when (= ident user-ident)
                      #{:read}))})

(def attributes [id email active? password
                 widgets widget-id widget-name
                 ])

authorization.clj

(ns io.laef.authorization
  "Pathom plugin and Fulcro RAD save/delete middleware implementing attribute-level authorization"
  (:require [com.wsscode.pathom.core :as p]
            [com.fulcrologic.rad.attributes :as attr]
            [com.fulcrologic.rad.form :as form]
            [com.fulcrologic.fulcro.algorithms.tempid :as tempid]))

(defn pathom-plugin
  [get-user-from-env]
  {::p/wrap-parser
   (fn [parser]
     (fn [env tx]
       (if (and (map? env) (seq tx))
         (let [curr-user (get-user-from-env env)]
           (parser (assoc env :current-user curr-user) tx))
         {})))
   ::p/wrap-read
   (fn [reader]
     (fn [env]
       (let [{:keys       [ast current-user]
              ::attr/keys [key->attribute]
              ::p/keys    [entity]}     env
             {:keys [dispatch-key
                     key]}              ast
             {::keys      [auth]
              ::attr/keys [identity?
                           identities]} (key->attribute dispatch-key)
             ident                      (if identity?
                                          (if (vector? key)
                                            key
                                            [dispatch-key (get @entity dispatch-key)])
                                          (first (keep #(find @entity %) identities)))]
         (if (or (nil? auth) ;; Publicly readable by default
                 (contains? (set (auth env ident current-user)) :read))
           (reader env)
           ::redacted))))})

(defn- can-mutate-entity?
  [env [ident data]]
  (let [{:keys       [current-user]
         ::attr/keys [key->attribute]} env
        create? (tempid/tempid? (second ident))
        attrs   (map key->attribute (keys data))
        can?    (fn [{::keys [auth]}]
                  (if-not auth
                    false ;; No mutation by default
                    (contains?
                     (auth env ident current-user)
                     (if create? :create :update))))]
    (every? can? attrs)))

(defn save-middleware
  ([]
   (fn [_]
     (throw (ex-info "Auth middleware must be first in middleware chain" {}))))
  ([handler]
   (fn [{::form/keys [params]
         :as         pathom-env}]
     (let [can-mutate? (partial can-mutate-entity? pathom-env)
           can?        (every? can-mutate? (::form/delta params))]
       (if can?
         (handler pathom-env)
         (throw (ex-info "Unauthorized save!" {})))))))

(defn- can-delete-entity?
  [env ident]
  (let [{:keys       [current-user]
         ::attr/keys [key->attribute]} env
        {::keys [auth]} (key->attribute (first ident))]
    (if-not auth
      false ;; No deletion by default
      (contains?
       (auth env ident current-user)
       :delete))))

(defn delete-middleware
  ([]
   (fn [_]
     (throw (ex-info "Auth middleware must be first in middleware chain" {}))))
  ([handler]
   (fn [{::form/keys [params] :as pathom-env}]
     (let [can-delete? (partial can-delete-entity? pathom-env)
           can?        (every? can-delete? params)]
       (if can?
         (handler pathom-env)
         (throw (ex-info "Unauthorized delete!" {})))))))

form_middleware.clj

;; ...

(def save-middleware
  (->
   (datomic/wrap-datomic-save)
   (blob/wrap-persist-images model/all-attributes)
   (r.s.middleware/wrap-rewrite-values)
   ;; Auth must come last in threaded order (first in execution order)
   (auth/save-middleware)))

(def delete-middleware
  (-> (datomic/wrap-datomic-delete)
      ;; Auth must come last in threaded order (first in execution order)
      (auth/delete-middleware)))

parser.clj

;; ...

(pathom/new-parser config
                     [(auth/pathom-plugin
                       ;; Accepts a (fn [env]) as an argument and should return the authenticated user's ident
                       ;; TODO: actually look at the ring reqest, hard-coded for demonstration
                       (constantly [:account/id (ids/new-uuid 1)]))
                      ;; Other RAD plugins...
                      ]
                     [automatic-resolvers
                      ;; Other resolvers...
                      ])