API endpoint dox generation should resolve schemas from the registry (#47634)

* API endpoint dox generation should resolve schemas from the registry #46799

* Update Kondo config

* Fix formatting

.clj-kondo/config.edn

@@ -837,6 +837,7 @@
    metabase.api.common/defendpoint                                                                                           hooks.metabase.api.common/defendpoint
    metabase.api.common/defendpoint-async                                                                                     hooks.metabase.api.common/defendpoint
    metabase.api.common/defendpoint-async-schema                                                                              hooks.metabase.api.common/defendpoint
+   metabase.api.common.internal-test/with-jetty-server                                                                       hooks.common/with-one-binding
    metabase.api.dashboard-test/with-chain-filter-fixtures                                                                    hooks.common/let-one-with-optional-value
    metabase.api.dashboard-test/with-simple-dashboard-with-tabs                                                               hooks.common/with-one-binding
    metabase.api.embed-test/do-response-formats                                                                               hooks.common/with-two-bindings

src/metabase/util/malli/describe.cljc

@@ -3,7 +3,8 @@
   (:require
    [clojure.string :as str]
    [malli.core :as mc]
-   [malli.experimental.describe :as med]))
+   [malli.experimental.describe :as med]
+   [metabase.util.malli.registry :as mr]))
 
 (defn describe
   "Given a schema, returns a string explaining the required shape in English"
@@ -14,7 +15,11 @@
                         {::mc/walk-entry-vals true
                          ::med/definitions    (atom {})
                          ::med/describe       med/-describe})]
-     (str/trim (str (med/-describe ?schema options))))))
+     (-> ?schema
+         mr/resolve-schema
+         (med/-describe options)
+         str
+         str/trim))))
 
 ;;; This is a fix for upstream issue https://github.com/metosin/malli/issues/924 (the generated descriptions for
 ;;; `:min` and `:max` were backwards). We can remove this when that issue is fixed upstream.

src/metabase/util/malli/registry.cljc

@@ -74,6 +74,8 @@
   [type]
   (malli.registry/schema registry type))
 
+;;; TODO -- we should change `:doc/message` to `:description` so it's inline
+;;; with [[metabase.util.malli.describe/describe]] and [[malli.experimental.describe/describe]]
 (defn -with-doc
   "Add a `:doc/message` option to a `schema`. Tries to merge it in existing vector schemas to avoid unnecessary
   indirection."
@@ -100,7 +102,40 @@
       `(metabase.util.malli.registry/def ~type
          (-with-doc ~schema ~docstring)))))
 
+(defn- deref-all-preserving-properties
+  "Like [[mc/deref-all]] but preserves properties attached to a `:ref` by wrapping the result in `:schema`."
+  [schema]
+  (letfn [(with-properties [schema properties]
+            (-> schema
+                (mc/-set-properties (merge (mc/properties schema) properties))))
+          (deref* [schema]
+            (let [dereffed   (-> schema mc/deref deref-all-preserving-properties)
+                  properties (mc/properties schema)]
+              (cond-> dereffed
+                (seq properties) (with-properties properties))))]
+    (cond-> schema
+      (mc/-ref-schema? schema) deref*)))
+
 (defn resolve-schema
-  "For REPL/test usage: get the definition of a registered schema from the registry."
+  "For REPL/test/documentation generation usage: get the definition of a registered schema from the registry.
+  Recursively resolves the top-level schema (e.g. a `:ref` to another `:ref`), but does not recursively resolve
+  children of the schema e.g. the value schemas for a `:map`.
+
+  I was going to use [[mc/deref-recursive]] here but it tosses out properties attached to `:ref`s or `:schemas` which
+  are sorta important when they contain stuff like `:description` -- so this version uses the
+  custom [[deref-all-preserving-properties]] function above which merges them in. -- Cam"
   [schema]
-  (mc/deref-all (mc/schema schema)))
+  (let [schema (-> schema mc/schema deref-all-preserving-properties)]
+    (mc/walk schema
+             (fn [schema _path children _options]
+               (cond (= (mc/type schema) :ref)
+                     schema
+
+                     (mc/-ref-schema? schema)
+                     (deref-all-preserving-properties (mc/-set-children schema children))
+
+                     :else
+                     (mc/-set-children schema children)))
+             ;; not sure this option is really needed, but [[mc/deref-recursive]] sets it... turning it off doesn't
+             ;; seem to make any of our tests fail so maybe I'm not capturing something
+             {::mc/walk-schema-refs true})))

test/metabase/api/card_test.clj

@@ -724,6 +724,11 @@
 ;;; |                                        CREATING A CARD (POST /api/card)                                        |
 ;;; +----------------------------------------------------------------------------------------------------------------+
 
+(deftest ^:parallel docstring-test
+  (testing "Make sure generated docstring resolves Malli schemas in the registry correctly (#46799)"
+    (is (str/includes? (-> #'api.card/POST_ meta :doc)
+                       "-  **`type`** nullable enum of :question, question, :metric, metric, :model, model."))))
+
 (deftest create-a-card
   (testing "POST /api/card"
     (testing "Test that we can create a new Card"

test/metabase/api/common/internal_test.clj

@@ -14,6 +14,7 @@
    [metabase.server.middleware.exceptions :as mw.exceptions]
    [metabase.test :as mt]
    [metabase.util :as u]
+   [metabase.util.malli.registry :as mr]
    [metabase.util.malli.schema :as ms]
    [ring.adapter.jetty :as jetty]
    [ring.middleware.params :refer [wrap-params]])
@@ -22,7 +23,19 @@
 
 (set! *warn-on-reflection* true)
 
-(def TestAddress
+(mr/def ::card-type
+  [:enum :question :model :metric])
+
+(deftest ^:parallel dox-for-schema-test
+  (testing "We should resolve schemas in the Malli registry when generating documentation (#46799)\n"
+    (are [schema] (= "nullable enum of :question, :model, :metric"
+                     (#'internal/dox-for-schema schema nil))
+      [:maybe [:enum :question :model :metric]]
+      [:maybe ::card-type]
+      [:maybe [:schema ::card-type]]
+      [:maybe [:schema [:schema ::card-type]]])))
+
+(def ^:private TestAddress
   [:map
    {:title "Address"}
    [:id :string]
@@ -34,7 +47,7 @@
      [:zip :int]
      [:lonlat [:tuple :double :double]]]]])
 
-(def ClosedTestAddress
+(def ^:private ClosedTestAddress
   (mut/closed-schema TestAddress))
 
 (api/defendpoint POST "/post/any" [:as {body :body :as _request}]
@@ -123,30 +136,40 @@
               (handler req)
               (catch Exception e (mw.exceptions/api-exception-response e)))))
 
-(deftest defendpoint-query-params-test
+(defn- do-with-jetty-server [f]
   (let [^Server server (jetty/run-jetty (json-mw
                                          (exception-mw
                                           (wrap-params #'routes))) {:port 0 :join? false})
         port (.. server getURI getPort)
-        get! (fn [route]
-               (http/get (str "http://localhost:" port route)
-                         {:throw-exceptions false
-                          :accept           :json
-                          :as               :json
-                          :coerce           :always}))]
+        get (fn [route]
+              (http/get (str "http://localhost:" port route)
+                        {:throw-exceptions false
+                         :accept           :json
+                         :as               :json
+                         :coerce           :always}))
+        post (fn [route body]
+               (http/post (str "http://localhost:" port route)
+                          {:throw-exceptions false
+                           :accept           :json
+                           :as               :json
+                           :coerce           :always
+                           :body             (json/generate-string body)}))]
+    (try
+      (testing (format "With temp Jetty server on port %d" port)
+        (f {:get get, :post! post}))
+      (finally
+        (.stop server)))))
+
+(defmacro ^:private with-jetty-server [bindings & body]
+  `(do-with-jetty-server (fn ~bindings ~@body)))
+
+(deftest defendpoint-query-params-test
+  (with-jetty-server [{:keys [get]}]
     (is (= "{:bool-key true, :string-key \"abc\", :enum-key :a, :kw-key :abc}"
-           (:body (get! "/with-query-params/?bool-key=true&string-key=abc&enum-key=a&kw-key=abc"))))))
-
-(deftest defendpoint-test
-  (let [^Server server (jetty/run-jetty (json-mw (exception-mw #'routes)) {:port 0 :join? false})
-        port   (.. server getURI getPort)
-        post!  (fn [route body]
-                 (http/post (str "http://localhost:" port route)
-                            {:throw-exceptions false
-                             :accept           :json
-                             :as               :json
-                             :coerce           :always
-                             :body             (json/generate-string body)}))]
+           (:body (get "/with-query-params/?bool-key=true&string-key=abc&enum-key=a&kw-key=abc"))))))
+
+(deftest defendpoint-validation-test
+  (with-jetty-server [{:keys [post!]}]
     (testing "validation"
       (is (= {:a 1 :b 2} (:body (post! "/post/any" {:a 1 :b 2}))))
 
@@ -206,20 +229,25 @@
                {:address ["missing required key, received: nil"],
                 :a ["disallowed key, received: 1"],
                 :b ["disallowed key, received: 2"]}}}
-             (:body (post! "/post/closed-test-address" {:id "1" :tags [] :a 1 :b 2}))))
+             (:body (post! "/post/closed-test-address" {:id "1" :tags [] :a 1 :b 2})))))))
 
+(deftest defendpoint-validation-localiazed-errors-test
+  (with-jetty-server [{:keys [post!]}]
+    (testing "validation"
       (testing "malli schema message are localized"
-        (mt/with-mock-i18n-bundles!  {"es" {:messages
-                                            {"value must be a non-blank string."
-                                             "el valor debe ser una cadena que no esté en blanco."}}}
+        (mt/with-mock-i18n-bundles! {"es" {:messages
+                                           {"value must be a non-blank string."
+                                            "el valor debe ser una cadena que no esté en blanco."}}}
           (mt/with-temporary-setting-values [site-locale "es"]
             (is (= {:errors {:address "el valor debe ser una cadena que no esté en blanco."},
-                                                                                            ;; TODO remove .'s from ms schemas
-                                                                                            ;; TODO translate received (?)
+                    ;; TODO remove .'s from ms schemas
+                    ;; TODO translate received (?)
                     :specific-errors
                     {:address ["should be a string, received: {:address \"\"}" "non-blank string, received: {:address \"\"}"]}}
-                   (:body (post! "/test-localized-error" {:address ""}))))))))
+                   (:body (post! "/test-localized-error" {:address ""}))))))))))
 
+(deftest defendpoint-auto-coercion-test
+  (with-jetty-server [{:keys [post!]}]
     (testing "auto-coercion"
 
       (is (= 16 (:body (post! "/auto-coerce-pos-square/4" {}))))
@@ -271,8 +299,10 @@
                                        :rchipelago ["should be spelled :archipelago, received: \"my archipelago\""]}}}
              (:body (post! "/closed-map-spellcheck" {:ser-state "my state"
                                                      :o-box "my po-box"
-                                                     :rchipelago "my archipelago"})))))
+                                                     :rchipelago "my archipelago"})))))))
 
+(deftest defendpoint-arbitrary-routes-test
+  (with-jetty-server [{:keys [post!]}]
     (testing "routes need to not be arbitrarily chosen"
       (is (= "hit route for a." (:body (post! "/accept-thing/a123" {}))))
       (is (= "hit route for b." (:body (post! "/accept-thing/b123" {}))))
@@ -281,7 +311,7 @@
       (is (= "hit route for e." (:body (post! "/accept-thing/e123" {}))))
       (is (= nil (:body (post! "/accept-thing/f123" {})))))))
 
-(deftest route-fn-name-test
+(deftest ^:parallel route-fn-name-test
   (are [method route expected] (= expected
                                   (internal/route-fn-name method route))
     'GET "/"                    'GET_
@@ -289,7 +319,7 @@
     ;; check that internal/route-fn-name can handle routes with regex conditions
     'GET ["/:id" :id #"[0-9]+"] 'GET_:id))
 
-(deftest arg-type-test
+(deftest ^:parallel arg-type-test
   (are [param expected] (= expected
                            (internal/arg-type param))
     :fish    nil
@@ -307,7 +337,7 @@
                                                      internal/*auto-parse-types*)]
      ~@body))
 
-(deftest route-param-regex-test
+(deftest ^:parallel route-param-regex-test
   (no-route-regexes
     (are [param expected] (= expected
                              (internal/route-param-regex param))
@@ -315,7 +345,7 @@
       :id      [:id "#[0-9]+"]
       :card-id [:card-id "#[0-9]+"])))
 
-(deftest route-arg-keywords-test
+(deftest ^:parallel route-arg-keywords-test
   (no-route-regexes
     (are [route expected] (= expected
                              (internal/route-arg-keywords route))
@@ -325,7 +355,7 @@
       "/:id/etc/:org" [:id :org]
       "/:card-id"     [:card-id])))
 
-(deftest add-route-param-schema-test
+(deftest ^:parallel add-route-param-schema-test
   (are [route expected] (= expected
                            (let [result (internal/add-route-param-schema
                                          {'id ms/PositiveInt
@@ -352,7 +382,7 @@
     "/:id/:card-id"                        ["/:id/:card-id" :id "#[0-9]+" :card-id "#[0-9]+"]
     "/:unlisted/:card-id"                  ["/:unlisted/:card-id" :card-id "#[0-9]+"]))
 
-(deftest let-form-for-arg-test
+(deftest ^:parallel let-form-for-arg-test
   (are [arg expected] (= expected
                          (internal/let-form-for-arg arg))
     'id           '[id (clojure.core/when id (metabase.api.common.internal/parse-int id))]
@@ -362,7 +392,7 @@
     :as           nil
     '{body :body} nil))
 
-(deftest auto-parse-test
+(deftest ^:parallel auto-parse-test
   (are [args expected] (= expected
                           (macroexpand-1 `(internal/auto-parse ~args '~'body)))
     ;; when auto-parse gets an args form where arg is present in *autoparse-types*
@@ -391,7 +421,7 @@
     '[id :as {body :body}]
     '(clojure.core/let [id (clojure.core/when id (metabase.api.common.internal/parse-int id))] 'body)))
 
-(deftest enterprise-endpoint-name-test
+(deftest ^:parallel enterprise-endpoint-name-test
   (when config/ee-available?
     (testing "Make sure the route name for enterprise API endpoints is somewhat correct"
       (require 'metabase-enterprise.advanced-permissions.api.application)

test/metabase/util/malli/describe_test.cljc

 (ns metabase.util.malli.describe-test
   "Additional tests for this live in [[metabase.util.malli-test]]."
   (:require
-   #?@(:clj
-       ([clojure.test :refer [are deftest testing]]
-        [metabase.util.malli.describe :as umd]))))
+   [clojure.test :refer [are deftest is testing]]
+   [metabase.util.malli.describe :as umd]
+   [metabase.util.malli.registry :as mr]))
 
 ;;; this is only fixed in Clojure
 
@@ -14,3 +14,34 @@
                                  (umd/describe schema))
          [:string {:min 5}] "string with length >= 5"
          [:string {:max 5}] "string with length <= 5"))))
+
+(mr/def ::card-type*
+  [:enum :question :metric :model])
+
+(mr/def ::card-type
+  ::card-type*)
+
+(deftest ^:parallel describe-registry-schema-test
+  (testing "describe should work for schemas in our registry (#46799)"
+    (is (= "nullable enum of :question, :metric, :model"
+           (umd/describe [:maybe ::card-type])))))
+
+(mr/def ::positive-int*
+  [:int {:min 0}])
+
+(mr/def ::positive-int
+  [:schema
+   {:description "value must be an integer greater than zero."}
+   ::positive-int*])
+
+(deftest ^:parallel preserve-resolved-descriptions-test
+  (are [schema] (= "value must be an integer greater than zero."
+                   (umd/describe schema))
+    ::positive-int
+    [:ref ::positive-int]
+    [:schema ::positive-int])
+  (let [PositiveInt [:schema
+                     {:description "value must be an integer greater than zero."}
+                     ::positive-int*]]
+    (is (= "value must be an integer greater than zero."
+           (umd/describe PositiveInt)))))

test/metabase/util/malli/registry_test.cljc

 (ns metabase.util.malli.registry-test
   (:require
-   [clojure.test :refer [deftest is testing]]
+   #?@(:clj
+       ([metabase.util.i18n :as i18n]))
+   [clojure.test :refer [are deftest is testing]]
    [malli.core :as mc]
    [malli.error :as me]
    [metabase.util.malli.registry :as mr]))
@@ -23,3 +25,64 @@
      (is (= ":int"
             (pr-str (mr/resolve-schema ::int))
             (pr-str (mr/resolve-schema [:ref ::int]))))))
+
+#?(:clj
+   (deftest ^:parallel resolve-should-not-realize-i18n-strings-test
+     (testing "resolving a schema should not cause deferred i18n strings to get realized."
+       (let [schema [:int {:min 0, :description (i18n/deferred-tru "value must be an integer greater than zero.")}]]
+         (letfn [(description [schema]
+                   (-> schema mc/properties :description))]
+           (is (i18n/localized-string?
+                (description schema)))
+           (is (i18n/localized-string?
+                (description (mr/resolve-schema schema)))))))))
+
+(deftest ^:parallel preserve-schemas-with-properties-test
+  (testing "Preserve properties attached to a `:schema` when unwrapping it"
+    (is (= [:int {:description "value must be an integer greater than zero.", :min 1}]
+           (mc/form (mr/resolve-schema [:schema
+                                        {:description "value must be an integer greater than zero."}
+                                        [:int {:min 1}]]))))))
+
+(mr/def ::positive-int
+  [:int {:min 1}])
+
+(deftest ^:parallel resolve-ref-with-properties-test
+  (testing "We should preserve properties attached to a `:ref` when resolving it"
+    (is (= [:int {:description "wow", :min 1}]
+           (mc/form (mr/resolve-schema [:ref {:description "wow"} ::positive-int]))))))
+
+(mr/def ::positive-int-2
+  [:schema {:description "neat"} [:int {:min 1}]])
+
+(deftest ^:parallel recursive-ref-and-schema-resolution-test
+  (testing "recursive resolution of refs and schemas with properties -- merge higher-level properties"
+    (is (= [:int {:description "wow", :min 1}]
+           (mc/form (mr/resolve-schema [:ref {:description "wow"} ::positive-int-2]))))
+    (is (= [:int {:description "neat", :min 1}]
+           (mc/form (mr/resolve-schema ::positive-int-2))))))
+
+(deftest ^:parallel ok-to-unwrap-schemas-without-properties-test
+  (testing "It's ok to unwrap :schema or :ref if properties are empty"
+    (are [schema] (= [:int {:min 1}]
+                     (mc/form (mr/resolve-schema schema)))
+      [:schema [:int {:min 1}]]
+      [:ref ::positive-int])))
+
+(mr/def ::location
+  [:map
+   [:parent {:optional true} [:ref ::location]]
+   [:name :string]
+   [:id ::positive-int]
+   [:id-2 [:schema {:description "another ID"} ::positive-int]]])
+
+(deftest ^:parallel deref-circular-refs-test
+  (testing "Don't resolve circular refs"
+    (are [schema] (= [:map
+                      [:parent {:optional true} [:ref ::location]]
+                      [:name :string]
+                      [:id [:int {:min 1}]]
+                      [:id-2 [:int {:description "another ID", :min 1}]]]
+                     (mc/form (mr/resolve-schema schema)))
+      ::location
+      [:ref ::location])))