ICanReadWrite protocol

src/metabase/api/common.clj

@@ -8,6 +8,7 @@
             [metabase.api.common.internal :refer :all]
             [metabase.db :refer :all]
             [metabase.db.internal :refer [entity->korma]]
+            [metabase.models.interface :as models]
             [metabase.util :as u]
             [metabase.util.password :as password])
   (:import com.metabase.corvus.api.ApiException
@@ -29,17 +30,6 @@
   (atom nil)) ; default binding is just something that will return nil when dereferenced
 
 
-;;; ## GENERAL HELPER FNS / MACROS
-
-;; TODO - move this to something like `metabase.util.debug`
-(defmacro with-current-user
-  "Primarily for debugging purposes. Evaulates BODY as if `*current-user*` was the User with USER-ID."
-  [user-id & body]
-  `(binding [*current-user-id* ~user-id
-             *current-user* (delay (sel :one 'metabase.models.user/User :id ~user-id))]
-     ~@body))
-
-
 ;;; ## CONDITIONAL RESPONSE FUNCTIONS / MACROS
 
 (defn check
@@ -421,44 +411,28 @@
     `(defroutes ~'routes ~@api-routes ~@additional-routes)))
 
 
-;; ## NEW PERMISSIONS CHECKING MACROS
-;; Since checking `@can_read`/`@can_write` is such a common pattern, these
-;; macros eliminate a bit of the redundancy around doing so.
-;; They support two forms:
-;;
-;;     (read-check my-table) ; checks @(:can_read my-table)
-;;     (read-check Table 1)  ; checks @(:can_read (sel :one Table :id 1))
-;;
-;; *  The first form is useful when you've already fetched an object (especially in threading forms such as `->404`).
-;; *  The second form takes care of fetching the object for you and is useful in cases where you won't need the object afterward
-;;    or want to combine the `sel` and permissions check statements into a single form.
-;;
-;; Both forms will throw a 404 if the object doesn't exist (saving you one more check!) and return the selected object.
-
-(defmacro read-check
-  "Checks that `@can_read` is true for this object."
+(defn read-check
+  "Check whether we can read an existing OBJ, or ENTITY with ID."
   ([obj]
-   `(let-404 [{:keys [~'can_read] :as obj#} ~obj]
-      (check-403 @~'can_read)
-      obj#))
+   (check-404 obj)
+   (check-403 (if (satisfies? models/ICanReadWrite obj) (models/can-read? obj)
+                  @(:can_read obj)))
+   obj)
   ([entity id]
-   (cond
-     ;; simple optimization : since @can-read is always true for a Database
-     ;; the read-check macro will just resolve to true in this simple case
-     ;; use `name` so we can match 'Database or 'metabase.models.database/Database
-     ;;
-     ;; TODO - it would be nice to generalize the read-checking pattern, and make it
-     ;; a separate multimethod or protocol so other models besides DB can write optimized
-     ;; implementations. Currently, we always fetch an *entire* object to do read checking,
-     ;; which is wasteful.
-     (= (name entity) "Database") `(comment "@(:can-read database) is always true.") ; put some non-constant value here so Eastwood doesn't complain about unused return values
-     :else                        `(read-check (sel :one ~entity :id ~id)))))
-
-(defmacro write-check
-  "Checks that `@can_write` is true for this object."
+   {:pre [(models/metabase-entity? entity)
+          (integer? id)]}
+   (if (satisfies? models/ICanReadWrite entity) (models/can-read? entity id)
+       (read-check (entity id)))))
+
+(defn write-check
+  "Check whether we can write an existing OBJ, or ENTITY with ID."
   ([obj]
-   `(let-404 [{:keys [~'can_write] :as obj#} ~obj]
-      (check-403 @~'can_write)
-      obj#))
+   (check-404 obj)
+   (check-403 (if (satisfies? models/ICanReadWrite obj) (models/can-write? obj)
+                  @(:can_write obj)))
+   obj)
   ([entity id]
-   `(write-check (sel :one ~entity :id ~id))))
+   {:pre [(models/metabase-entity? entity)
+          (integer? id)]}
+   (if (satisfies? models/ICanReadWrite entity) (models/can-write? entity id)
+       (write-check (entity id)))))

src/metabase/api/meta/table.clj

@@ -107,7 +107,4 @@
         new_order))
     {:result "success"}))
 
-;; TODO - GET /:id/segments
-;; TODO - POST /:id/segments
-
 (define-routes)

src/metabase/db/internal.clj

@@ -42,7 +42,7 @@
     *  Symbols like `'metabase.models.user/User` are handled the same way as strings."
   (memoize
    (fn -entity->korma [entity]
-     ;; {:post [(= (type %) :korma.core/Entity)]}
+     {:post [(:metabase.models.interface/entity %)]}
      (cond (vector? entity) (-entity->korma (first entity))
            (string? entity) (-entity->korma (symbol entity))
            (symbol? entity) (try (eval entity)

src/metabase/models/database.clj

@@ -17,6 +17,8 @@
     (cond-> this
       (not (:is_superuser @*current-user*)) (dissoc :details))))
 
+(extend-ICanReadWrite DatabaseInstance :read :always, :write :superuser)
+
 (defentity Database
   [(table :metabase_database)
    (hydration-keys database db)
@@ -24,10 +26,9 @@
    timestamped]
 
   (post-select [_ db]
-    (map->DatabaseInstance
-     (assoc db
-            :can_read  (delay true)
-            :can_write (delay (:is_superuser @*current-user*)))))
+    (map->DatabaseInstance db))
 
   (pre-cascade-delete [_ {:keys [id] :as database}]
     (cascade-delete 'metabase.models.table/Table :db_id id)))
+
+(extend-ICanReadWrite DatabaseEntity :read :always, :write :superuser)

src/metabase/models/field.clj

@@ -74,6 +74,14 @@
     :info        ; Non-numerical value that is not meant to be used
     :sensitive}) ; A Fields that should *never* be shown *anywhere*
 
+(defrecord FieldInstance []
+  clojure.lang.IFn
+  (invoke [this k]
+    (get this k)))
+
+(extend-ICanReadWrite FieldInstance :read :always, :write :superuser)
+
+
 (defentity Field
   [(table :metabase_field)
    (hydration-keys destination field origin)
@@ -100,19 +108,21 @@
       (future (create-field-values-if-needed (sel :one [this :id :table_id :base_type :special_type :field_type] :id id)))))
 
   (post-select [_ {:keys [table_id] :as field}]
-    (u/assoc* field
-      :table               (delay (sel :one 'metabase.models.table/Table :id table_id))
-      :db                  (delay @(:db @(:table <>)))
-      :target              (delay (field->fk-field field))
-      :can_read            (delay @(:can_read @(:table <>)))
-      :can_write           (delay @(:can_write @(:table <>)))
-      :human_readable_name (when (name :field)
-                             (delay (common/name->human-readable-name (:name field))))))
+    (map->FieldInstance
+      (u/assoc* field
+        :table               (delay (sel :one 'metabase.models.table/Table :id table_id))
+        :db                  (delay @(:db @(:table <>)))
+        :target              (delay (field->fk-field field))
+        :human_readable_name (when (name :field)
+                               (delay (common/name->human-readable-name (:name field)))))))
 
   (pre-cascade-delete [_ {:keys [id]}]
     (cascade-delete ForeignKey (where (or (= :origin_id id)
                                           (= :destination_id id))))
-    (cascade-delete 'metabase.models.field-values/FieldValues :field_id id) ))
+    (cascade-delete 'metabase.models.field-values/FieldValues :field_id id)))
+
+(extend-ICanReadWrite FieldEntity :read :always, :write :superuser)
+
 
 (defn field->fk-field
   "Attempts to follow a `ForeignKey` from the the given `Field` to a destination `Field`.

src/metabase/models/interface.clj

@@ -8,6 +8,22 @@
             metabase.db.internal
             [metabase.util :as u]))
 
+(defprotocol ICanReadWrite
+  (can-read?  [obj] [entity ^Integer id])
+  (can-write? [obj] [entity ^Integer id]))
+
+(defn extend-ICanReadWrite
+  "Add standard implementations of `can-read?` and `can-write?` to KLASS."
+  [klass & {:keys [read write]}]
+  (let [key->method #(case %
+                       :always    (constantly true)
+                       :superuser (fn [& args]
+                                    (:is_superuser @@(resolve 'metabase.api.common/*current-user*))))]
+    (extend klass
+      ICanReadWrite {:can-read?  (key->method read)
+                     :can-write? (key->method write)})))
+
+
 ;;; ## ---------------------------------------- ENTITIES ----------------------------------------
 
 (defprotocol IEntity
@@ -56,14 +72,15 @@
 
 (defn- identity-second [_ obj] obj)
 (def ^:private constantly-nil (constantly nil))
+(def ^:private constantly-true (constantly true))
 
 (def ^:const ^:private default-entity-method-implementations
-  {:pre-insert           #'identity-second
-   :post-insert          #'identity-second
-   :pre-update           #'identity-second
-   :post-update          #'constantly-nil
-   :post-select          #'identity-second
-   :pre-cascade-delete   #'constantly-nil})
+  {:pre-insert         #'identity-second
+   :post-insert        #'identity-second
+   :pre-update         #'identity-second
+   :post-update        #'constantly-nil
+   :post-select        #'identity-second
+   :pre-cascade-delete #'constantly-nil})
 
 (def ^:const ^:private type-fns
   {:json    {:in  'metabase.db.internal/write-json
@@ -112,17 +129,19 @@
 
 (defmacro defentity
   "Similar to korma `defentity`, but creates a new record type where you can specify protocol implementations."
-  [entity entity-forms & methods]
-  {:pre [(vector? entity-forms)
-         (every? list? methods)]}
+  [entity entity-forms & methods+specs]
+  {:pre [(vector? entity-forms)]}
   (let [entity-symb               (symbol (format "%sEntity" (name entity)))
         internal-post-select-symb (symbol (format "internal-post-select-%s" (name entity)))
-        entity-map                (eval `(macrolet-entity-map ~entity ~@entity-forms))]
+        entity-map                (eval `(macrolet-entity-map ~entity ~@entity-forms))
+        [methods specs]           (split-with list? methods+specs)]
     `(do
        (defrecord ~entity-symb []
          clojure.lang.IFn
          (~'invoke [~'this ~'id]
-           (-invoke-entity ~'this ~'id)))
+           (-invoke-entity ~'this ~'id))
+
+         ~@specs)
 
        (extend ~entity-symb
          IEntity ~(merge default-entity-method-implementations
@@ -140,7 +159,12 @@
                                (for [[method-name & impl] methods]
                                  {(keyword method-name) `(fn ~@impl)}))))
        (def ~entity
-         (~(symbol (format "map->%sEntity" (name entity))) ~entity-map)))))
+         (~(symbol (format "map->%sEntity" (name entity))) ~(assoc entity-map ::entity true))))))
+
+(defn metabase-entity?
+  "Is ENTITY a valid metabase model entity?"
+  [entity]
+  (::entity entity))
 
 
 ;;; # ---------------------------------------- INSTANCE ----------------------------------------

src/metabase/models/table.clj

@@ -12,6 +12,13 @@
   "Valid values for `Table.entity_type` (field may also be `nil`)."
   #{:person :event :photo :place})
 
+(defrecord TableInstance []
+  clojure.lang.IFn
+  (invoke [this k]
+    (get this k)))
+
+(extend-ICanReadWrite TableInstance :read :always, :write :superuser)
+
 (defentity Table
   [(table :metabase_table)
    (hydration-keys table)
@@ -19,23 +26,24 @@
    timestamped]
 
   (post-select [_ {:keys [id db db_id description] :as table}]
-    (u/assoc* table
-      :db                  (or db (delay (sel :one db/Database :id db_id)))
-      :fields              (delay (sel :many Field :table_id id :active true (order :position :ASC) (order :name :ASC)))
-      :field_values        (delay
-                            (let [field-ids (sel :many :field [Field :id]
-                                                 :table_id id
-                                                 :active true
-                                                 :field_type [not= "sensitive"]
-                                                 (order :position :asc)
-                                                 (order :name :asc))]
-                              (sel :many :field->field [FieldValues :field_id :values] :field_id [in field-ids])))
-      :description         (u/jdbc-clob->str description)
-      :pk_field            (delay (:id (sel :one :fields [Field :id] :table_id id (where {:special_type "id"}))))
-      :can_read            (delay @(:can_read @(:db <>)))
-      :can_write           (delay @(:can_write @(:db <>)))
-      :human_readable_name (when (:name table)
-                             (delay (common/name->human-readable-name (:name table))))))
+    (map->TableInstance
+     (u/assoc* table
+       :db                  (or db (delay (sel :one db/Database :id db_id)))
+       :fields              (delay (sel :many Field :table_id id :active true (order :position :ASC) (order :name :ASC)))
+       :field_values        (delay
+                             (let [field-ids (sel :many :field [Field :id]
+                                                  :table_id id
+                                                  :active true
+                                                  :field_type [not= "sensitive"]
+                                                  (order :position :asc)
+                                                  (order :name :asc))]
+                               (sel :many :field->field [FieldValues :field_id :values] :field_id [in field-ids])))
+       :description         (u/jdbc-clob->str description)
+       :pk_field            (delay (:id (sel :one :fields [Field :id] :table_id id (where {:special_type "id"}))))
+       :human_readable_name (when (:name table)
+                              (delay (common/name->human-readable-name (:name table)))))))
 
   (pre-cascade-delete [_ {:keys [id] :as table}]
     (cascade-delete Field :table_id id)))
+
+(extend-ICanReadWrite TableEntity :read :always, :write :superuser)