diff --git a/core/src/martian/core.cljc b/core/src/martian/core.cljc index d2da6d6..46fe4a8 100644 --- a/core/src/martian/core.cljc +++ b/core/src/martian/core.cljc @@ -6,7 +6,7 @@ [lambdaisland.uri :refer [map->query-string]] [martian.interceptors :as interceptors] [martian.openapi :refer [openapi->handlers openapi-schema?]] - [martian.parameter-aliases :refer [parameter-aliases alias-schema]] + [martian.parameter-aliases :refer [registry alias-schema]] [martian.schema :as schema] [martian.spec :as mspec] [martian.swagger :refer [swagger->handlers]] @@ -133,7 +133,7 @@ (defn- collect-parameter-aliases [handler] (reduce (fn [aliases param-key] - (assoc aliases param-key (parameter-aliases (get handler param-key)))) + (assoc aliases param-key (registry (get handler param-key)))) {} parameter-schemas)) diff --git a/core/src/martian/parameter_aliases.cljc b/core/src/martian/parameter_aliases.cljc index 31525b4..ccec943 100644 --- a/core/src/martian/parameter_aliases.cljc +++ b/core/src/martian/parameter_aliases.cljc @@ -1,54 +1,127 @@ (ns martian.parameter-aliases - (:require [schema.core :as s] - [camel-snake-kebab.core :refer [->kebab-case]] - [clojure.set :refer [rename-keys]] - [martian.schema-tools :refer [key-seqs prewalk-with-path]])) + (:require [clojure.set :refer [rename-keys]] + [martian.schema-tools :as schema-tools] + [schema.core :as s])) -;; todo lean on schema-tools.core for some of this +(defn- aliases-at + "Internal helper. Given a `schema`, a path-local `cache` (atom), an `interner` + (atom), and a `path` (vector or seq), returns the alias map for that path. -(defn ->idiomatic [k] - (when (and k (s/specific-key? k) (not (and (keyword? k) (namespace k)))) - (->kebab-case (s/explicit-schema-key k)))) + - Delegates the actual computation to `compute-aliases-at`, which understands + schema wrappers (e.g. `:schema`, `:schemas`, etc.) and vector transparency. + - Caches results per-path in the provided `cache` to avoid recomputation. + - Interns identical alias maps across the paths via `interner`, so equal maps + share a single canonical instance (reduces memory churn in large APIs). + - Returns `nil` when there are no aliases at the given path." + [schema cache interner path] + (let [path' (if (vector? path) path (vec path))] + (or (get @cache path') + (let [m (schema-tools/compute-aliases-at schema path') + m' (when m + (or (get @interner m) + (-> interner + (swap! #(if (contains? % m) % (assoc % m m))) + (get m))))] + (swap! cache assoc path' m') + m')))) + +#?(:bb nil + + :clj + (deftype LazyRegistry [schema cache interner] + clojure.lang.ILookup + (valAt [_ k] + (aliases-at schema cache interner k)) + (valAt [_ k not-found] + (or (aliases-at schema cache interner k) not-found)) + Object + (toString [_] (str "#LazyRegistry (cached " (count @cache) ")"))) + + :cljs + (deftype LazyRegistry [schema cache interner] + cljs.core/ILookup + (-lookup [_ k] + (aliases-at schema cache interner k)) + (-lookup [_ k not-found] + (or (aliases-at schema cache interner k) not-found)) + cljs.core/IPrintWithWriter + (-pr-writer [_ writer _opts] + (-write writer (str "#LazyRegistry (cached " (count @cache) ")"))))) (defn- idiomatic-path [path] - (vec (keep ->idiomatic path))) + (vec (keep schema-tools/->idiomatic path))) -(defn parameter-aliases - "Produces a data structure for use with `unalias-data`" +(defn aliases-hash-map + "Eagerly computes the registry as a data structure for the given `schema`. + + Produces a plain hash map with idiomatic keys (aliases) mappings per path + in a (possibly, deeply nested) `schema` for all its unqualified keys. + + The result is then used with `alias-schema` and `unalias-data` functions." [schema] (reduce (fn [acc path] - (if-let [idiomatic-key (some-> path last ->idiomatic)] - (if-not (= (last path) idiomatic-key) - (update acc (idiomatic-path (drop-last path)) merge {idiomatic-key (last path)}) - acc) - acc)) + (let [leaf (peek path) + idiomatic-key (some-> leaf (schema-tools/->idiomatic))] + (if (and idiomatic-key (not= leaf idiomatic-key)) + (update acc (idiomatic-path (pop path)) assoc idiomatic-key leaf) + acc))) {} - (key-seqs schema))) + (schema-tools/key-seqs schema))) + +(defn registry + "Builds a lookupable registry of parameter alias maps for the given `schema`. + + - On JVM/CLJS: + Returns an instance of a lazy registry. + + Aliases are computed on demand (via `compute-aliases-at`), so materializing + massive alias maps upfront is avoided. Per-path results are memoized within + the registry. Identical alias maps are shared to cut memory usage. + + A returned value implements `ILookup` and is indexed by \"idiomatic paths\". + Looking up a path gives an alias map for that level, mapping idiomatic keys + (kebab-case, unqualified) to their original schema keys. + + - On Babashka: + Returns a plain hash map registry that is computed eagerly via `key-seqs`." + [schema] + (when schema + #?(:bb (aliases-hash-map schema) + :default (new LazyRegistry schema (atom {}) (atom {}))))) + +;; TODO: An alias for backward compatibility. Remove later on. +(def parameter-aliases registry) (defn unalias-data - "Takes parameter aliases and (deeply nested) data, returning data with deeply-nested keys renamed as described by parameter-aliases" - [parameter-aliases x] - (if parameter-aliases - (prewalk-with-path (fn [path x] - (if (map? x) - (rename-keys x (get parameter-aliases (idiomatic-path path))) - x)) - [] - x) - x)) + "Given a (possibly, deeply nested) `data` structure, returns it with all its + keys renamed from \"idiomatic\" (aliases) using the given parameter aliases + `registry`." + [registry data] + (if registry + (schema-tools/prewalk-with-path + (fn [path x] + (if (map? x) + (rename-keys x (get registry (idiomatic-path path))) + x)) + data) + data)) (defn alias-schema - "Walks a schema, transforming all keys into their aliases (idiomatic keys)" - [parameter-aliases schema] - (if parameter-aliases - (prewalk-with-path (fn [path x] - (if (map? x) - (let [kmap (reduce-kv (fn [kmap k v] - (assoc kmap v k (s/optional-key v) (s/optional-key k))) - {} - (get parameter-aliases (idiomatic-path path)))] - (rename-keys x kmap)) - x)) - [] - schema) + "Given a (possibly, deeply nested) `schema`, renames all keys (in it and its + subschemas) into corresponding \"idiomatic\" keys (aliases) using the given + parameter aliases `registry`." + [registry schema] + (if registry + (schema-tools/prewalk-with-path + (fn [path subschema] + (if (map? subschema) + (let [kmap (reduce-kv (fn [kmap idiomatic original] + (assoc kmap + original idiomatic + (s/optional-key original) (s/optional-key idiomatic))) + {} + (get registry (idiomatic-path path)))] + (rename-keys subschema kmap)) + subschema)) + schema) schema)) diff --git a/core/src/martian/schema_tools.cljc b/core/src/martian/schema_tools.cljc index 2d2bee5..4b2ed07 100644 --- a/core/src/martian/schema_tools.cljc +++ b/core/src/martian/schema_tools.cljc @@ -1,50 +1,370 @@ (ns martian.schema-tools - (:require [schema.core :as s #?@(:cljs [:refer [MapEntry EqSchema]])] - [schema.spec.core :as spec]) - #?(:clj (:import [schema.core MapEntry EqSchema]))) - -;; todo -;; write some tests and lean on schema-tools.core where possible - -(defn with-paths [path schema] - (keep (fn [schema] - (cond (and (instance? MapEntry schema) - (instance? EqSchema (:key-schema schema))) - {:path (conj path (:v (:key-schema schema))) - :schema (:val-schema schema)} - (map? schema) - {:path path - :schema schema})) - (spec/subschemas (s/spec schema)))) + (:require [camel-snake-kebab.core :refer [->kebab-case]] + [schema.core :as s] + [schema-tools.impl])) + +(defn explicit-key [k] + (if (s/specific-key? k) (s/explicit-schema-key k) k)) + +(defn concrete-key? + "Checks if the schema key `k` is not generic (`s/Any`, `s/Keyword`, etc.)." + [k] + (or (keyword? k) (s/specific-key? k) (string? k))) + +(defn- can-be-renamed? [k] + ;; NB: See `camel-snake-kebab.internals.alter-name` ns. + (or (and (keyword? k) (not (namespace k))) (string? k))) + +(defn ->idiomatic [k] + (when-some [k' (explicit-key k)] + (when (can-be-renamed? k') + (->kebab-case k')))) + +(defn map-entry-aliases + "Returns a map of idiomatic keys to original explicit keys for the immediate + entries of the given map schema `ms`. + + - Considers only keys that can be renamed: unqualified keywords or strings; + - Uses the `explicit-key` helper function to unwrap required/optional keys; + - Includes an entry only when the idiomatic form differs from the original; + - Returns `nil` when there are no aliasable entries at this level." + [ms] + (not-empty + (reduce-kv + (fn [acc k _] + (let [ek (explicit-key k) + ik (->idiomatic ek)] + (if (and ik (not= ik ek)) + (assoc acc ik ek) + acc))) + {} + ms))) + +(defn child-by-idiomatic + "Finds the child schema addressed by the next path segment `seg` in the map + schema `ms`. + + The `seg` is one idiomatic path segment (a kebab-case, unqualified keyword + or string). The function scans entries of `ms` and returns the value whose + key, after being idiomatized, equals `seg`." + [ms seg] + (some (fn [[k v]] (when (= seg (->idiomatic k)) v)) ms)) + +(defn- concat* [& xs] + (apply concat (remove nil? xs))) + +(def ^:dynamic *seen-recursion* + "Cycle/budget guard for `s/recursive` schema targets. Bound in `key-seqs` fn." + nil) + +(def ^:dynamic *max-recursions-per-target* + "Maximum number of times the same recursive schema target may be expanded + along a single path." + 3) + +(defmacro with-recursion-guard [rec-target form] + `(when ~rec-target + (let [n# (get @*seen-recursion* ~rec-target 0)] + (when (< n# *max-recursions-per-target*) + (vswap! *seen-recursion* update ~rec-target (fnil inc 0)) + (let [res# ~form] + (vswap! *seen-recursion* update ~rec-target #(max 0 (dec %))) + res#))))) + +(defprotocol PathAliases + "Internal traversal API used to locate alias maps inside Prismatic schemas." + (-paths [schema path include-self?] + "Returns a sequence of path vectors found within the given prefix `path`. + If `include-self?` is true, includes `path` itself as the first element.") + (-aliases-at [schema idiomatic-path] + "Returns the alias map available at `idiomatic-path` inside the `schema`, + or `nil` if that location is not a map level or has no aliasable keys. + + Implementations should walk `schema` along an `idiomatic-path` (a vector of + kebab-case, unqualified segments) and, when the path lands on a map schema, + return an alias map for that level; otherwise return `nil`. Do not traverse + past the target level or build whole-tree results.")) + +(defn combine-aliases-at + "Collects and merges alias maps from multiple `inner-schemas` at the single + idiomatic `path`. + + Calls `(-aliases-at s path)` for each inner schema, discards `nil` results, + and merges the remaining maps left-to-right with `merge` semantics. Returns + `nil` when nothing contributes, i.e. the merged result would be empty." + [path inner-schemas] + (not-empty (apply merge (keep #(-aliases-at % path) inner-schemas)))) + +(extend-protocol PathAliases + + #?(:clj clojure.lang.APersistentMap + :cljs cljs.core.PersistentArrayMap) + (-paths [schema path include-self?] + (concat* + (when include-self? (list path)) + (mapcat (fn [[k v]] + (when (concrete-key? k) + (let [k' (explicit-key k) + path' (conj path k')] + (cons path' (-paths v path' false))))) + schema))) + (-aliases-at [schema path] + (if (empty? path) + (map-entry-aliases schema) + (let [seg (first path)] + (when (or (keyword? seg) (string? seg)) + (when-some [child (child-by-idiomatic schema seg)] + (-aliases-at child (rest path))))))) + + ;; Vector schemas are transparent + #?(:clj clojure.lang.APersistentVector + :cljs cljs.core.PersistentVector) + (-paths [schema path include-self?] + (concat* + (when include-self? (list path)) + (mapcat #(-paths % path false) schema))) + (-aliases-at [schema path] + (combine-aliases-at path schema)) + + ;; Single-child wrappers + + schema.core.NamedSchema + (-paths [schema path include-self?] + (let [inner-schema (:schema schema)] + (concat* + (when include-self? (list path)) + (-paths inner-schema (conj path :schema) true) + (-paths inner-schema path false)))) + (-aliases-at [schema path] + (let [inner-schema (:schema schema)] + (cond + (empty? path) (-aliases-at inner-schema []) + (= :schema (first path)) (-aliases-at inner-schema (rest path)) + :else (-aliases-at inner-schema path)))) + + schema.core.Maybe + (-paths [schema path include-self?] + (let [inner-schema (:schema schema)] + (concat* + (when include-self? (list path)) + (-paths inner-schema (conj path :schema) true) + (-paths inner-schema path false)))) + (-aliases-at [schema path] + (let [inner-schema (:schema schema)] + (cond + (empty? path) (-aliases-at inner-schema []) + (= :schema (first path)) (-aliases-at inner-schema (rest path)) + :else (-aliases-at inner-schema path)))) + + schema.core.Constrained + (-paths [schema path include-self?] + (let [inner-schema (:schema schema)] + (concat* + (when include-self? (list path)) + (-paths inner-schema (conj path :schema) true) + (-paths inner-schema path false)))) + (-aliases-at [schema path] + (let [inner-schema (:schema schema)] + (cond + (empty? path) (-aliases-at inner-schema []) + (= :schema (first path)) (-aliases-at inner-schema (rest path)) + :else (-aliases-at inner-schema path)))) + + schema.core.One + (-paths [schema path include-self?] + (let [inner-schema (:schema schema)] + (concat* + (when include-self? (list path)) + (-paths inner-schema (conj path :schema) true) + (-paths inner-schema path false)))) + (-aliases-at [schema path] + (let [inner-schema (:schema schema)] + (cond + (empty? path) (-aliases-at inner-schema []) + (= :schema (first path)) (-aliases-at inner-schema (rest path)) + :else (-aliases-at inner-schema path)))) + + schema.core.Record + (-paths [schema path include-self?] + (let [inner-schema (:schema schema)] + (concat* + (when include-self? (list path)) + (-paths inner-schema (conj path :schema) true) + (-paths inner-schema path false)))) + (-aliases-at [schema path] + (let [inner-schema (:schema schema)] + (cond + (empty? path) (-aliases-at inner-schema []) + (= :schema (first path)) (-aliases-at inner-schema (rest path)) + :else (-aliases-at inner-schema path)))) + + ;; Recursive schemas + schema.core.Recursive + (-paths [schema path include-self?] + (let [target (:derefable schema)] + (concat* + (when include-self? (list path)) + (with-recursion-guard + target + (let [inner-schema @target] + (concat + (-paths inner-schema (conj path :derefable) true) + (-paths inner-schema path false))))))) + (-aliases-at [schema path] + (let [inner-schema @(:derefable schema)] + (cond + (empty? path) (-aliases-at inner-schema []) + (= :derefable (first path)) (-aliases-at inner-schema (rest path)) + :else (-aliases-at inner-schema path)))) + + ;; Multi-variant unions + + schema.core.Both + (-paths [schema path include-self?] + (let [inner-schemas (:schemas schema)] + (concat* + (when include-self? (list path)) + (mapcat #(-paths % (conj path :schemas) false) inner-schemas) + (mapcat #(-paths % path false) inner-schemas)))) + (-aliases-at [schema path] + (let [inner-schemas (:schemas schema)] + (cond + (empty? path) (combine-aliases-at [] inner-schemas) + (= :schemas (first path)) (combine-aliases-at (rest path) inner-schemas) + :else (combine-aliases-at path inner-schemas)))) + + schema.core.Either + (-paths [schema path include-self?] + (let [inner-schemas (:schemas schema)] + (concat* + (when include-self? (list path)) + (mapcat #(-paths % (conj path :schemas) false) inner-schemas) + (mapcat #(-paths % path false) inner-schemas)))) + (-aliases-at [schema path] + (let [inner-schemas (:schemas schema)] + (cond + (empty? path) (combine-aliases-at [] inner-schemas) + (= :schemas (first path)) (combine-aliases-at (rest path) inner-schemas) + :else (combine-aliases-at path inner-schemas)))) + + schema.core.CondPre + (-paths [schema path include-self?] + (let [inner-schemas (:schemas schema)] + (concat* + (when include-self? (list path)) + (mapcat #(-paths % (conj path :schemas) false) inner-schemas) + (mapcat #(-paths % path false) inner-schemas)))) + (-aliases-at [schema path] + (let [inner-schemas (:schemas schema)] + (cond + (empty? path) (combine-aliases-at [] inner-schemas) + (= :schemas (first path)) (combine-aliases-at (rest path) inner-schemas) + :else (combine-aliases-at path inner-schemas)))) + + schema.core.ConditionalSchema + (-paths [schema path include-self?] + (let [inner-schemas (map second (:preds-and-schemas schema))] + (concat* + (when include-self? (list path)) + (mapcat #(-paths % (conj path :preds-and-schemas) false) inner-schemas) + (mapcat #(-paths % path false) inner-schemas)))) + (-aliases-at [schema path] + (let [inner-schemas (map second (:preds-and-schemas schema))] + (cond + (empty? path) (combine-aliases-at [] inner-schemas) + (= :preds-and-schemas (first path)) (combine-aliases-at (rest path) inner-schemas) + :else (combine-aliases-at path inner-schemas)))) + + ;; Default schemas (from `schema-tools`) + schema_tools.impl.Default + (-paths [schema path include-self?] + (let [inner-schema (:schema schema)] + (concat* + (when include-self? (list path)) + (-paths inner-schema (conj path :schema) true) + (-paths inner-schema (conj path :value) true) + (-paths inner-schema path false)))) + (-aliases-at [schema path] + (let [inner-schema (:schema schema)] + (cond + (empty? path) (-aliases-at inner-schema []) + (= :schema (first path)) (-aliases-at inner-schema (rest path)) + (= :value (first path)) (-aliases-at inner-schema (rest path)) + :else (-aliases-at inner-schema path)))) + + #?(:clj Object :cljs default) + (-paths [_ path include-self?] + (when include-self? (list path))) + (-aliases-at [_ _] nil) + + nil + (-paths [_ _ _] nil) + (-aliases-at [_ _] nil)) (defn key-seqs - "Returns a collection of paths which would address all possible entries (using `get-in`) in data described by the schema" + "Returns a vec of unique key paths (key seqs) for `schema` and all subschemas + that will cover all possible entries in a data described by `schema` as well + as the `schema` itself." [schema] - (when (map? schema) - (loop [paths [[]] - paths-and-schemas (with-paths [] schema)] - (if-let [{:keys [path schema]} (first paths-and-schemas)] - (recur (conj paths path) (concat (rest paths-and-schemas) - (with-paths path schema))) - paths)))) + (->> (binding [*seen-recursion* (volatile! {})] + (-paths schema [] true)) + (distinct) + (vec))) + +(defn compute-aliases-at + "Given a `schema` and an `idiomatic-path` (a vector of kebab-case, unqualified + segments), returns a map which describes how the idiomatic keys at that exact + map level are translated back to the schema's original keys. + + - Segments and keys are considered idiomatic when they are unqualified and + kebab-case keywords/strings, e.g. `:foo-bar`. Qualified keywords/symbols + are ignored; generic map keys (e.g. `s/Any`, `s/Keyword`) do not produce + aliases. + - Only the addressed level. The result contains aliases for the entries of + that map, not for ancestors or nested child maps. + - Vectors are transparent. If the path walks through a vector, aliases are + merged from its element schemas. + - Inner schemas hops are understood. Structural hops introduced by wrapper + or union schemas are recognized (e.g. `:schema`, `:schemas`, etc.). + - Non-map endpoints yield `nil`. If the `idiomatic-path` doesn't land on a + map (or there are no aliasable keys), the function returns `nil`." + [schema idiomatic-path] + (-aliases-at schema idiomatic-path)) (defn walk-with-path - "Identical to `clojure.walk/walk` except keeps track of the path through the data structure (as per `get-in`) - as it goes, calling `inner` and `outer` with two args: the path and form" + "Similar to the `schema-tools.walk/walk` except it keeps track of the `path` + through the data structure as it goes, calling `inner` and `outer` with two + args: the `path` and the `form`. It also does not preserve any metadata." ([inner outer form] (walk-with-path inner outer [] form)) ([inner outer path form] (cond - (list? form) (outer path (apply list (map (partial inner path) form))) (map-entry? form) - (outer path #?(:clj (clojure.lang.MapEntry. (inner path (key form)) (inner (conj path (key form)) (val form))) - :cljs (cljs.core/MapEntry. (inner path (key form)) (inner (conj path (key form)) (val form)) nil))) - (seq? form) (outer path (doall (map (partial inner path) form))) - (record? form) (outer path (reduce (fn [r x] (conj r (inner path x))) form form)) - (coll? form) (outer path (into (empty form) (map (partial inner path) form))) + (outer path [(inner path (key form)) + (inner (conj path (key form)) (val form))]) + (record? form) + (outer path (reduce (fn [r x] (conj r (inner path x))) form form)) + (list? form) + (outer path (apply list (map #(inner path %) form))) + (seq? form) + (outer path (doall (map #(inner path %) form))) + (coll? form) + (outer path (into (empty form) (map #(inner path %) form))) :else (outer path form)))) -(defn postwalk-with-path [f path form] - (walk-with-path (partial postwalk-with-path f) f path form)) +(defn postwalk-with-path + ([f form] + (postwalk-with-path f [] form)) + ([f path form] + (walk-with-path (fn [path form] (postwalk-with-path f path form)) + f + path + form))) -(defn prewalk-with-path [f path form] - (walk-with-path (partial prewalk-with-path f) (fn [_path form] form) path (f path form))) +(defn prewalk-with-path + ([f form] + (prewalk-with-path f [] form)) + ([f path form] + (walk-with-path (fn [path form] (prewalk-with-path f path form)) + (fn [_path form] form) + path + (f path form)))) diff --git a/core/test/martian/core_test.cljc b/core/test/martian/core_test.cljc index 0006193..0cb360b 100644 --- a/core/test/martian/core_test.cljc +++ b/core/test/martian/core_test.cljc @@ -301,12 +301,12 @@ (let [add-default-headers-interceptor {:name ::add-default-headers :enter (fn [ctx] (update-in ctx [:request :headers] - assoc :x-api-key "ABC123"))} + assoc :X-API-key "ABC123"))} m (martian/bootstrap "https://defaultheaders.com" [{:route-name :get-item :produces ["application/json"] :consumes ["application/json"] - :headers-schema {:x-api-key s/Str} + :headers-schema {:X-API-key s/Str} :path-parts ["/api/" :id] :path-schema {:id s/Str} :method :get}] @@ -314,7 +314,7 @@ (is (= {:method :get :url "https://defaultheaders.com/api/123" - :headers {"x-api-key" "ABC123"}} + :headers {"X-API-key" "ABC123"}} (martian/request-for m :get-item {:id "123"}))))) (deftest any-body-test @@ -396,16 +396,19 @@ (deftest kebab-mapping-test (let [m (martian/bootstrap "https://camels.org" [{:route-name :create-camel - :path-parts ["/camels/" :camelId] - :method :put - :path-schema {:camelId s/Int} - :query-schema {:camelVersion s/Int} - :body-schema {:Camel {:camelName s/Str - :camelTrain {:leaderName s/Str - (s/optional-key :followerCamels) [{:followerName s/Str}]} - :anyCamel s/Any}} - :headers-schema {(s/optional-key :camelToken) s/Str} - :form-schema {:camelHumps (s/maybe s/Int)}}])] + :path-parts ["/camels/" :camelId] + :method :put + :path-schema {:camelId s/Int} + :query-schema {:camelVersion s/Int} + :body-schema {:Camel {:camelName s/Str + :camelTrain {:leaderName s/Str + (s/optional-key :followerCamels) [{:followerName s/Str}]} + :anyCamel s/Any}} + :headers-schema {(s/optional-key "Content-Security-Policy") s/Str + (s/optional-key "WWW-Authenticate") s/Str + (s/optional-key "X-XSS-Protection") s/Str + (s/optional-key :camelToken) s/Str} + :form-schema {:camelHumps (s/maybe s/Int)}}])] (is (= "https://camels.org/camels/1" (martian/url-for m :create-camel {:camel-id 1 @@ -416,27 +419,38 @@ :camel-version 2} {:include-query? true}))) - (is (= {:path-schema {[] {:camel-id :camelId}}, - :query-schema {[] {:camel-version :camelVersion}}, - :body-schema {[] {:camel :Camel}, - [:camel] {:camel-name :camelName, - :camel-train :camelTrain, - :any-camel :anyCamel}, - [:camel :camel-train] {:leader-name :leaderName, - :follower-camels :followerCamels}, - [:camel :camel-train :follower-camels] {:follower-name :followerName}}, - :form-schema {[] {:camel-humps :camelHumps}}, - :headers-schema {[] {:camel-token :camelToken}}} - (:parameter-aliases (martian/handler-for m :create-camel)))) - - (is (= {:method :put, - :url "https://camels.org/camels/1", - :query-params {:camelVersion 2}, + (let [param-aliases (:parameter-aliases (martian/handler-for m :create-camel))] + (is (= {:camel-id :camelId} + (get-in param-aliases [:path-schema []]))) + (is (= {:camel-version :camelVersion} + (get-in param-aliases [:query-schema []]))) + (is (= {:camel :Camel} + (get-in param-aliases [:body-schema []]))) + (is (= {:camel-name :camelName + :camel-train :camelTrain + :any-camel :anyCamel} + (get-in param-aliases [:body-schema [:camel]]))) + (is (= {:leader-name :leaderName + :follower-camels :followerCamels} + (get-in param-aliases [:body-schema [:camel :camel-train]]))) + (is (= {:follower-name :followerName} + (get-in param-aliases [:body-schema [:camel :camel-train :follower-camels]]))) + (is (= {:camel-humps :camelHumps} + (get-in param-aliases [:form-schema []]))) + (is (= {"content-security-policy" "Content-Security-Policy" + "www-authenticate" "WWW-Authenticate" + "x-xss-protection" "X-XSS-Protection" + :camel-token :camelToken} + (get-in param-aliases [:headers-schema []])))) + + (is (= {:method :put + :url "https://camels.org/camels/1" + :query-params {:camelVersion 2} :body {:camelName "kebab" :camelTrain {:leaderName "camel leader" :followerCamels [{:followerName "OCaml"}]} - :anyCamel {:camel-train "choo choo"}}, - :form-params {:camelHumps 2}, + :anyCamel {:camel-train "choo choo"}} + :form-params {:camelHumps 2} :headers {"camelToken" "cAmEl"}} ;; fully destructured @@ -480,16 +494,19 @@ :anyCamel {:camel-train "choo choo"}}}))) (testing "explore shows idiomatic kebab keys" - (is (= {:summary nil, + (is (= {:summary nil :parameters - {:camel-id s/Int, - :camel-version s/Int, - :camel {:camel-name s/Str - :camel-train {:leader-name s/Str - (s/optional-key :follower-camels) [{:follower-name s/Str}]} - :any-camel s/Any}, - :camel-humps (s/maybe s/Int) - (s/optional-key :camel-token) s/Str}, + {:camel-id s/Int + :camel-version s/Int + :camel {:camel-name s/Str + :camel-train {:leader-name s/Str + (s/optional-key :follower-camels) [{:follower-name s/Str}]} + :any-camel s/Any} + :camel-humps (s/maybe s/Int) + (s/optional-key "content-security-policy") s/Str + (s/optional-key "www-authenticate") s/Str + (s/optional-key "x-xss-protection") s/Str + (s/optional-key :camel-token) s/Str} :returns {}} (martian/explore m :create-camel)))))) diff --git a/core/test/martian/parameter_aliases_test.cljc b/core/test/martian/parameter_aliases_test.cljc index ab69854..a458e50 100644 --- a/core/test/martian/parameter_aliases_test.cljc +++ b/core/test/martian/parameter_aliases_test.cljc @@ -1,66 +1,766 @@ (ns martian.parameter-aliases-test - (:require [martian.parameter-aliases :refer [parameter-aliases unalias-data alias-schema]] + (:require [clojure.string :as str] + [martian.parameter-aliases :refer [registry unalias-data alias-schema]] [schema-tools.core :as st] [schema.core :as s] - #?(:clj [clojure.test :refer [deftest testing is]] + #?(:clj [clojure.test :refer [deftest testing is]] :cljs [cljs.test :refer-macros [deftest testing is]]))) -(deftest parameter-aliases-test +(defn select-aliases-from-registry + "Given a (possibly, lazy) registry and an expected map whose keys are paths, + pull exactly those paths and return a plain {path -> alias-map}." + [registry expected] + (into {} + (map (fn [path] [path (get registry path)])) + (keys expected))) + +(defmacro =aliases + [expected schema] + `(let [reg# (registry ~schema)] + (= ~expected (select-aliases-from-registry reg# ~expected)))) + +(defn not-blank? [s] + (not (str/blank? s))) + +(defn foo-map? [x] + (and (map? x) + (let [str-keys (map (comp str/lower-case name) (keys x))] + (boolean (some #(str/starts-with? % "foo") str-keys))))) + +(def not-foo-map? (complement foo-map?)) + +(declare schema-b) +(def schema-a {:FOO s/Str + :Bar (s/recursive #'schema-b)}) +(def schema-b {:BAZ s/Str + :Quu (s/recursive #'schema-a)}) + +(deftest registry-test (testing "produces idiomatic aliases for all keys in a schema" - (is (= {[] {:foo-bar :fooBar - :bar :BAR - :baz :Baz}} - (parameter-aliases {:fooBar s/Str - (s/optional-key :BAR) s/Str - :Baz s/Str})))) - - (testing "works on nested maps and sequences" - (is (= {[] {:foo-bar :fooBar - :bar :BAR - :baz :Baz} - [:baz] {:quu :QUU - :quux :Quux} - [:baz :quux] {:fizz :Fizz}} - (parameter-aliases {:fooBar s/Str - (s/optional-key :BAR) s/Str - :Baz {:QUU s/Str - :Quux [{:Fizz s/Str}]}})))) - - (testing "works on nested maps and sequences" - (is (= {[] {:foo-bar :fooBar - :bar :BAR - :baz :Baz} - [:baz] {:quu :QUU - :quux :Quux} - [:baz :quux] {:fizz :Fizz}} - (parameter-aliases {:fooBar s/Str - (s/optional-key :BAR) s/Str - :Baz (st/default {:QUU s/Str - :Quux [{:Fizz s/Str}]} - {:QUU "hi" - :Quux []})}))))) + (testing "map schemas (with all sorts of keys)" + (is (=aliases + {[] {:foo-bar :fooBar + :bar :BAR + :baz :Baz}} + {:fooBar s/Str + (s/optional-key :BAR) s/Str + (s/required-key :Baz) s/Str}))) + + (testing "nested map and vector schemas" + (is (=aliases + {[] {:foo-bar :fooBar + :bar :BAR + :baz :Baz} + [:baz] {:quu :QUU + :quux :Quux} + [:baz :quux] {:fizz :Fizz}} + {:fooBar s/Str + (s/optional-key :BAR) s/Str + :Baz {:QUU s/Str + :Quux [{:Fizz s/Str}]}}))) + + (testing "deeply nested vector schemas" + (is (=aliases + {[] {:foo :FOO} + [:foo] {:bar :Bar} + [:foo :bar] {:bar-doo :barDoo + :bar-dee :barDee}} + {(s/optional-key :FOO) + {:Bar [[{:barDoo s/Str + (s/optional-key :barDee) s/Str}]]}}))) + + (testing "default schemas" + (is (=aliases + {[] {:foo-bar :fooBar + :bar :BAR + :baz :Baz} + [:baz] {:quu :QUU + :quux :Quux} + [:baz :quux] {:fizz :Fizz} + [:baz :schema] {:quu :QUU + :quux :Quux} + [:baz :schema :quux] {:fizz :Fizz} + [:baz :value] {:quu :QUU + :quux :Quux} + [:baz :value :quux] {:fizz :Fizz}} + {:fooBar s/Str + (s/optional-key :BAR) s/Str + :Baz (st/default {:QUU s/Str + :Quux [{:Fizz s/Str}]} + {:QUU "hi" + :Quux []})}) + "Must contain aliases for both the schema and a data described by it") + (is (=aliases + {[] {:quu :QUU + :quux :Quux} + [:quux] {:fizz :Fizz} + [:schema] {:quu :QUU + :quux :Quux} + [:schema :quux] {:fizz :Fizz} + [:value] {:quu :QUU + :quux :Quux} + [:value :quux] {:fizz :Fizz}} + (st/default {:QUU s/Str + :Quux [{:Fizz s/Str}]} + {:QUU "hi" + :Quux []})) + "Must contain aliases for both the schema and a data described by it")) + + (testing "named schemas" + (is (=aliases + {[] {:foo-bar :fooBar} + [:schema] {:foo-bar :fooBar}} + (s/named {:fooBar s/Str} "FooBar")) + "Must contain aliases for both the schema and a data described by it")) + + (testing "maybe schemas" + (is (=aliases + {[] {:foo-bar :fooBar} + [:foo-bar] {:baz :Baz} + [:foo-bar :schema] {:baz :Baz}} + {:fooBar (s/maybe {:Baz s/Str})}) + "Must contain aliases for both the schema and a data described by it") + (is (=aliases + {[] {:foo-bar :fooBar} + [:schema] {:foo-bar :fooBar}} + (s/maybe {:fooBar s/Str})) + "Must contain aliases for both the schema and a data described by it")) + + (testing "constrained schemas" + (is (=aliases + {[] {:foo-bar :fooBar}} + {:fooBar (s/constrained s/Str not-blank?)})) + (is (=aliases + {[] {:foo-bar :fooBar} + [:foo-bar :schema] {:baz :Baz} + [:foo-bar] {:baz :Baz}} + {:fooBar (s/constrained {:Baz s/Str} some?)}) + "Must contain aliases for both the schema and a data described by it")) + + (testing "both schemas" + (is (=aliases + {[] {:foo-bar :fooBar + :bar :BAR + :baz :Baz + :quu :QUU + :quux :Quux} + [:quux] {:fizz :Fizz} + [:schemas] {:foo-bar :fooBar + :bar :BAR + :baz :Baz + :quu :QUU + :quux :Quux} + [:schemas :quux] {:fizz :Fizz}} + (s/both {:fooBar s/Str + (s/optional-key :BAR) s/Str + (s/required-key :Baz) s/Str} + {:QUU s/Str + :Quux [{:Fizz s/Str}]})) + "Must contain aliases for both the schema and a data described by it") + (is (=aliases + {[] {:foo :FOO} + [:foo] {:foo-bar :fooBar + :bar :BAR + :baz :Baz + :quu :QUU + :quux :Quux} + [:foo :quux] {:fizz :Fizz} + [:foo :schemas] {:foo-bar :fooBar + :bar :BAR + :baz :Baz + :quu :QUU + :quux :Quux} + [:foo :schemas :quux] {:fizz :Fizz}} + {:FOO (s/both {:fooBar s/Str + (s/optional-key :BAR) s/Str + (s/required-key :Baz) s/Str} + {:QUU s/Str + :Quux [{:Fizz s/Str}]})}) + "Must contain aliases for both the schema and a data described by it")) + + (testing "either schemas" + (is (=aliases + {[] {:foo-bar :fooBar + :bar :BAR + :baz :Baz + :quu :QUU + :quux :Quux} + [:quux] {:fizz :Fizz} + [:schemas] {:foo-bar :fooBar + :bar :BAR + :baz :Baz + :quu :QUU + :quux :Quux} + [:schemas :quux] {:fizz :Fizz}} + (s/either {:fooBar s/Str + (s/optional-key :BAR) s/Str + (s/required-key :Baz) s/Str} + {:QUU s/Str + :Quux [{:Fizz s/Str}]})) + "Must contain aliases for both the schema and a data described by it") + (is (=aliases + {[] {:foo :FOO} + [:foo] {:foo-bar :fooBar + :bar :BAR + :baz :Baz + :quu :QUU + :quux :Quux} + [:foo :quux] {:fizz :Fizz} + [:foo :schemas] {:foo-bar :fooBar + :bar :BAR + :baz :Baz + :quu :QUU + :quux :Quux} + [:foo :schemas :quux] {:fizz :Fizz}} + {:FOO (s/either {:fooBar s/Str + (s/optional-key :BAR) s/Str + (s/required-key :Baz) s/Str} + {:QUU s/Str + :Quux [{:Fizz s/Str}]})}) + "Must contain aliases for both the schema and a data described by it")) + + (testing "cond-pre schemas" + (is (=aliases + {[] {:foo-bar :fooBar} + [:schemas] {:foo-bar :fooBar}} + (s/cond-pre {:fooBar s/Str} s/Str)) + "Must contain paths for both the schema and a data described by it") + (is (=aliases + {[] {:foo :FOO} + [:foo] {:foo-bar :fooBar} + [:foo :schemas] {:foo-bar :fooBar}} + {:FOO (s/cond-pre {:fooBar s/Str} s/Str)}) + "Must contain paths for both the schema and a data described by it")) + + (testing "conditional schemas" + (is (=aliases + {[] {:foo-bar :fooBar + :bar :BAR + :baz :Baz + :quu :QUU + :quux :Quux} + [:quux] {:fizz :Fizz} + [:preds-and-schemas] {:foo-bar :fooBar + :bar :BAR + :baz :Baz + :quu :QUU + :quux :Quux} + [:preds-and-schemas :quux] {:fizz :Fizz}} + (s/conditional + foo-map? + {:fooBar s/Str + (s/optional-key :BAR) s/Str + (s/required-key :Baz) s/Str} + :else + {:QUU s/Str + :Quux [{:Fizz s/Str}]})) + "Must contain paths for both the schema and a data described by it") + (is (=aliases + {[] {:foo :FOO} + [:foo] {:foo-bar :fooBar + :bar :BAR + :baz :Baz + :quu :QUU + :quux :Quux} + [:foo :quux] {:fizz :Fizz} + [:foo :preds-and-schemas] {:foo-bar :fooBar + :bar :BAR + :baz :Baz + :quu :QUU + :quux :Quux} + [:foo :preds-and-schemas :quux] {:fizz :Fizz}} + {:FOO (s/conditional + foo-map? + {:fooBar s/Str + (s/optional-key :BAR) s/Str + (s/required-key :Baz) s/Str} + :else + {:QUU s/Str + :Quux [{:Fizz s/Str}]})}) + "Must contain paths for both the schema and a data described by it")) + + (testing "recursive schemas" + (is (=aliases + {[] {:foo :FOO, :bar :Bar} + [:bar] {:baz :BAZ, :quu :Quu} + [:bar :quu] {:foo :FOO, :bar :Bar} + [:bar :quu :bar] {:baz :BAZ, :quu :Quu} + [:bar :quu :bar :derefable] {:baz :BAZ, :quu :Quu} + [:bar :quu :derefable] {:foo :FOO, :bar :Bar} + [:bar :quu :derefable :bar] {:baz :BAZ, :quu :Quu} + [:bar :quu :derefable :bar :derefable] {:baz :BAZ, :quu :Quu} + [:bar :derefable] {:baz :BAZ, :quu :Quu} + [:bar :derefable :quu] {:foo :FOO, :bar :Bar} + [:bar :derefable :quu :derefable] {:foo :FOO, :bar :Bar} + #_"..."} + schema-a) + "Must contain paths for both the schema and a data described by it"))) + + (testing "non-keyword keys" + (is (=aliases + {[] {"foo-bar" "fooBar"}} + {"fooBar" s/Str + 'bazQuux s/Str}) + "Symbols are excluded for performance purposes, could work as well")) + + (testing "qualified keys are not aliased" + (is (=aliases + {} + {:foo/Bar s/Str + :Baz/DOO s/Str}))) + + (testing "generic keys are not aliased" + (is (=aliases + {} + {s/Str {:fooBar s/Str}})) + (is (=aliases + {} + {s/Keyword {:fooBar s/Str}})) + (is (=aliases + {} + (st/any-keys))))) (deftest unalias-data-test (testing "renames idiomatic keys back to original" - (let [schema {:FOO s/Str - :fooBar s/Str - (s/optional-key :Bar) s/Str}] - (is (= {:FOO "a" - :fooBar "b" - :Bar "c"} - (unalias-data (parameter-aliases schema) {:foo "a" :foo-bar "b" :bar "c"}))))) + (testing "map schemas (with all sorts of keys)" + (is (= {:fooBar "a" + :BAR "b" + :Baz "c"} + (let [schema {:fooBar s/Str + (s/optional-key :BAR) s/Str + (s/required-key :Baz) s/Str}] + (unalias-data (registry schema) {:foo-bar "a" + :bar "b" + :baz "c"}))))) - (testing "works on nested maps and sequences" - (let [schema {:FOO {:fooBar s/Str - (s/optional-key :Bar) [{:BAZ s/Str}]}}] + (testing "nested map and vector schemas" (is (= {:FOO {:fooBar "b" :Bar [{:BAZ "c"}]}} - (unalias-data (parameter-aliases schema) {:foo {:foo-bar "b" :bar [{:baz "c"}]}})))))) + (let [schema {:FOO {:fooBar s/Str + (s/optional-key :Bar) [{:BAZ s/Str}]}}] + (unalias-data (registry schema) {:foo {:foo-bar "b" + :bar [{:baz "c"}]}}))))) + + (testing "deeply nested vector schemas" + (is (= {:FOO {:Bar [[{:barDoo "a" + :barDee "b"}]]}} + (let [schema {(s/optional-key :FOO) + {:Bar [[{:barDoo s/Str + (s/optional-key :barDee) s/Str}]]}}] + (unalias-data (registry schema) {:foo {:bar [[{:bar-doo "a" + :bar-dee "b"}]]}}))))) + + (testing "default schemas" + (is (= {:fooBar "a" + :BAR "b" + :Baz {:QUU "x" + :Quux [{:Fizz "y"}]}} + (let [schema {:fooBar s/Str + (s/optional-key :BAR) s/Str + :Baz (st/default {:QUU s/Str + :Quux [{:Fizz s/Str}]} + {:QUU "hi" + :Quux []})}] + (unalias-data (registry schema) {:foo-bar "a" + :bar "b" + :baz {:quu "x" + :quux [{:fizz "y"}]}})))) + (is (= {:QUU "x" + :Quux [{:Fizz "y"}]} + (let [schema (st/default {:QUU s/Str + :Quux [{:Fizz s/Str}]} + {:QUU "hi" + :Quux []})] + (unalias-data (registry schema) {:quu "x" + :quux [{:fizz "y"}]}))))) + + (testing "named schemas" + (is (= {:fooBar "a"} + (let [schema (s/named {:fooBar s/Str} "FooBar")] + (unalias-data (registry schema) {:foo-bar "a"}))))) + + (testing "maybe schemas" + (is (= {:fooBar {:Baz "a"}} + (let [schema {:fooBar (s/maybe {:Baz s/Str})}] + (unalias-data (registry schema) {:foo-bar {:baz "a"}})))) + (is (= {:fooBar "a"} + (let [schema (s/maybe {:fooBar s/Str})] + (unalias-data (registry schema) {:foo-bar "a"}))))) + + (testing "constrained schemas" + (is (= {:fooBar "a"} + (let [schema {:fooBar (s/constrained s/Str not-blank?)}] + (unalias-data (registry schema) {:foo-bar "a"})))) + (is (= {:fooBar {:Baz "b"}} + (let [schema {:fooBar (s/constrained {:Baz s/Str} some?)}] + (unalias-data (registry schema) {:foo-bar {:baz "b"}}))))) + + (testing "both schemas" + (is (= {:fooBar "a" + :BAR "b" + :Baz "c" + :QUU "x" + :Quux [{:Fizz "y"}]} + (let [schema (s/both {:fooBar s/Str + (s/optional-key :BAR) s/Str + (s/required-key :Baz) s/Str} + {:QUU s/Str + :Quux [{:Fizz s/Str}]})] + (unalias-data (registry schema) {:foo-bar "a" + :bar "b" + :baz "c" + :quu "x" + :quux [{:fizz "y"}]})))) + (is (= {:FOO {:fooBar "a" + :BAR "b" + :Baz "c" + :QUU "x" + :Quux [{:Fizz "y"}]}} + (let [schema {:FOO (s/both {:fooBar s/Str + (s/optional-key :BAR) s/Str + (s/required-key :Baz) s/Str} + {:QUU s/Str + :Quux [{:Fizz s/Str}]})}] + (unalias-data (registry schema) {:foo {:foo-bar "a" + :bar "b" + :baz "c" + :quu "x" + :quux [{:fizz "y"}]}}))))) + + (testing "either schemas" + (let [schema (s/either {:fooBar s/Str + (s/optional-key :BAR) s/Str + (s/required-key :Baz) s/Str} + {:QUU s/Str + :Quux [{:Fizz s/Str}]})] + (is (= {:fooBar "a" + :BAR "b" + :Baz "c"} + (unalias-data (registry schema) {:foo-bar "a" + :bar "b" + :baz "c"}))) + (is (= {:QUU "x" + :Quux [{:Fizz "y"}]} + (unalias-data (registry schema) {:quu "x" + :quux [{:fizz "y"}]})))) + (let [schema {:FOO (s/either {:fooBar s/Str + (s/optional-key :BAR) s/Str + (s/required-key :Baz) s/Str} + {:QUU s/Str + :Quux [{:Fizz s/Str}]})}] + (is (= {:FOO {:fooBar "a" + :BAR "b" + :Baz "c"}} + (unalias-data (registry schema) {:foo {:foo-bar "a" + :bar "b" + :baz "c"}}))) + (is (= {:FOO {:QUU "x" + :Quux [{:Fizz "y"}]}} + (unalias-data (registry schema) {:foo {:quu "x" + :quux [{:fizz "y"}]}}))))) + + (testing "cond-pre schemas" + (let [schema (s/cond-pre {:fooBar s/Str} s/Str)] + (is (= {:fooBar "a"} + (unalias-data (registry schema) {:foo-bar "a"}))) + (is (= "b" + (unalias-data (registry schema) "b")))) + (let [schema {:FOO (s/cond-pre {:fooBar s/Str} s/Str)}] + (is (= {:FOO {:fooBar "a"}} + (unalias-data (registry schema) {:foo {:foo-bar "a"}}))) + (is (= {:FOO "b"} + (unalias-data (registry schema) {:foo "b"}))))) + + (testing "conditional schemas" + (let [schema (s/conditional + foo-map? + {:fooBar s/Str + (s/optional-key :BAR) s/Str + (s/required-key :Baz) s/Str} + not-foo-map? + {:QUU s/Str + :Quux [{:Fizz s/Str}]})] + (is (= {:fooBar "a" + :BAR "b" + :Baz "c"} + (unalias-data (registry schema) {:foo-bar "a" + :bar "b" + :baz "c"}))) + (is (= {:QUU "x" + :Quux [{:Fizz "y"}]} + (unalias-data (registry schema) {:quu "x" + :quux [{:fizz "y"}]})))) + (let [schema {:FOO (s/conditional + foo-map? + {:fooBar s/Str + (s/optional-key :BAR) s/Str + (s/required-key :Baz) s/Str} + not-foo-map? + {:QUU s/Str + :Quux [{:Fizz s/Str}]})}] + (is (= {:FOO {:fooBar "a" + :BAR "b" + :Baz "c"}} + (unalias-data (registry schema) {:foo {:foo-bar "a" + :bar "b" + :baz "c"}}))) + (is (= {:FOO {:QUU "x" + :Quux [{:Fizz "y"}]}} + (unalias-data (registry schema) {:foo {:quu "x" + :quux [{:fizz "y"}]}}))))) + + (testing "recursive schemas" + (is (= {:FOO "a" + :Bar nil} + (unalias-data (registry schema-a) {:foo "a" + :bar nil}))) + (is (= {:FOO "a" + :Bar {:BAZ "b" + :Quu nil}} + (unalias-data (registry schema-a) {:foo "a" + :bar {:baz "b" + :quu nil}}))) + (is (= {:FOO "a1" + :Bar {:BAZ "b1" + :Quu {:FOO "a2" + :Bar nil}}} + (unalias-data (registry schema-a) {:foo "a1" + :bar {:baz "b1" + :quu {:foo "a2" + :bar nil}}}))) + (is (= {:FOO "a1" + :Bar {:BAZ "b1" + :Quu {:FOO "a2" + :Bar {:BAZ "b2" + :Quu nil}}}} + (unalias-data (registry schema-a) {:foo "a1" + :bar {:baz "b1" + :quu {:foo "a2" + :bar {:baz "b2" + :quu nil}}}}))))) + + (testing "non-keyword keys" + (is (= {"fooBar" "a" + 'baz-quux "b"} + (let [schema {"fooBar" s/Str + 'bazQuux s/Str}] + (unalias-data (registry schema) {"foo-bar" "a" + 'baz-quux "b"}))) + "Symbols are excluded for performance purposes, could work as well")) + + (testing "qualified keys are not renamed" + (is (= {:foo/Bar "a" + :Baz/DOO "b"} + (let [schema {:foo/Bar s/Str + :Baz/DOO s/Str}] + (unalias-data (registry schema) {:foo/Bar "a" + :Baz/DOO "b"}))))) + + (testing "generic keys are not renamed" + (is (= {"a" {:foo-bar "b"}} + (let [schema {s/Str {:fooBar s/Str}}] + (unalias-data (registry schema) {"a" {:foo-bar "b"}})))) + (is (= {:a {:foo-bar "b"}} + (let [schema {s/Keyword {:fooBar s/Str}}] + (unalias-data (registry schema) {:a {:foo-bar "b"}})))) + (is (= {:foo-bar "a"} + (let [schema (st/any-keys)] + (unalias-data (registry schema) {:foo-bar "a"})))))) (deftest alias-schema-test - (testing "renames the keys in the schema to give an idiomatic input schema" - (let [schema {:FOO {:fooBar s/Str - (s/optional-key :Bar) [{:BAZ s/Str}]}}] + (testing "renames schema keys into idiomatic keys" + (testing "map schemas (with all sorts of keys)" + (is (= {:foo-bar s/Str + (s/optional-key :bar) s/Str + (s/required-key :baz) s/Str} + (let [schema {:fooBar s/Str + (s/optional-key :BAR) s/Str + (s/required-key :Baz) s/Str}] + (alias-schema (registry schema) schema))))) + + (testing "nested map and vector schemas" (is (= {:foo {:foo-bar s/Str (s/optional-key :bar) [{:baz s/Str}]}} - (alias-schema (parameter-aliases schema) schema)))))) + (let [schema {:FOO {:fooBar s/Str + (s/optional-key :Bar) [{:BAZ s/Str}]}}] + (alias-schema (registry schema) schema))))) + + (testing "deeply nested vector schemas" + (is (= {(s/optional-key :foo) + {:bar [[{:bar-doo s/Str + (s/optional-key :bar-dee) s/Str}]]}} + (let [schema {(s/optional-key :FOO) + {:Bar [[{:barDoo s/Str + (s/optional-key :barDee) s/Str}]]}}] + (alias-schema (registry schema) schema))))) + + (testing "default schemas" + (is (= {:foo-bar s/Str + (s/optional-key :bar) s/Str + :baz (st/default {:quu s/Str + :quux [{:fizz s/Str}]} + {:quu "hi" + :quux []})} + (let [schema {:fooBar s/Str + (s/optional-key :BAR) s/Str + :Baz (st/default {:QUU s/Str + :Quux [{:Fizz s/Str}]} + {:QUU "hi" + :Quux []})}] + (alias-schema (registry schema) schema)))) + (is (= (st/default {:quu s/Str + :quux [{:fizz s/Str}]} + {:quu "hi" + :quux []}) + (let [schema (st/default {:QUU s/Str + :Quux [{:Fizz s/Str}]} + {:QUU "hi" + :Quux []})] + (alias-schema (registry schema) schema))))) + + (testing "named schemas" + (is (= (s/named {:foo-bar s/Str} "FooBar") + (let [schema (s/named {:fooBar s/Str} "FooBar")] + (alias-schema (registry schema) schema))))) + + (testing "maybe schemas" + (is (= {:foo-bar (s/maybe {:baz s/Str})} + (let [schema {:fooBar (s/maybe {:Baz s/Str})}] + (alias-schema (registry schema) schema)))) + (is (= (s/maybe {:foo-bar s/Str}) + (let [schema (s/maybe {:fooBar s/Str})] + (alias-schema (registry schema) schema))))) + + (testing "constrained schemas" + (is (= {:foo-bar (s/constrained s/Str not-blank?)} + (let [schema {:fooBar (s/constrained s/Str not-blank?)}] + (alias-schema (registry schema) schema)))) + (is (= {:foo-bar (s/constrained {:baz s/Str} some?)} + (let [schema {:fooBar (s/constrained {:Baz s/Str} some?)}] + (alias-schema (registry schema) schema))))) + + (testing "both schemas" + (is (= (s/both {:foo-bar s/Str + (s/optional-key :bar) s/Str + (s/required-key :baz) s/Str} + {:quu s/Str + :quux [{:fizz s/Str}]}) + (let [schema (s/both {:fooBar s/Str + (s/optional-key :BAR) s/Str + (s/required-key :Baz) s/Str} + {:QUU s/Str + :Quux [{:Fizz s/Str}]})] + (alias-schema (registry schema) schema)))) + (is (= {:foo (s/both {:foo-bar s/Str + (s/optional-key :bar) s/Str + (s/required-key :baz) s/Str} + {:quu s/Str + :quux [{:fizz s/Str}]})} + (let [schema {:FOO (s/both {:fooBar s/Str + (s/optional-key :BAR) s/Str + (s/required-key :Baz) s/Str} + {:QUU s/Str + :Quux [{:Fizz s/Str}]})}] + (alias-schema (registry schema) schema))))) + + (testing "either schemas" + (is (= (s/either {:foo-bar s/Str + (s/optional-key :bar) s/Str + (s/required-key :baz) s/Str} + {:quu s/Str + :quux [{:fizz s/Str}]}) + (let [schema (s/either {:fooBar s/Str + (s/optional-key :BAR) s/Str + (s/required-key :Baz) s/Str} + {:QUU s/Str + :Quux [{:Fizz s/Str}]})] + (alias-schema (registry schema) schema)))) + (is (= {:foo (s/either {:foo-bar s/Str + (s/optional-key :bar) s/Str + (s/required-key :baz) s/Str} + {:quu s/Str + :quux [{:fizz s/Str}]})} + (let [schema {:FOO (s/either {:fooBar s/Str + (s/optional-key :BAR) s/Str + (s/required-key :Baz) s/Str} + {:QUU s/Str + :Quux [{:Fizz s/Str}]})}] + (alias-schema (registry schema) schema))))) + + (testing "cond-pre schemas" + (is (= (s/cond-pre {:foo-bar s/Str} s/Str) + (let [schema (s/cond-pre {:fooBar s/Str} s/Str)] + (alias-schema (registry schema) schema)))) + (is (= {:foo (s/cond-pre {:foo-bar s/Str} s/Str)} + (let [schema {:FOO (s/cond-pre {:fooBar s/Str} s/Str)}] + (alias-schema (registry schema) schema))))) + + (testing "conditional schemas" + (is (= (s/conditional + foo-map? + {:foo-bar s/Str + (s/optional-key :bar) s/Str + (s/required-key :baz) s/Str} + not-foo-map? + {:quu s/Str + :quux [{:fizz s/Str}]}) + (let [schema (s/conditional + foo-map? + {:fooBar s/Str + (s/optional-key :BAR) s/Str + (s/required-key :Baz) s/Str} + not-foo-map? + {:QUU s/Str + :Quux [{:Fizz s/Str}]})] + (alias-schema (registry schema) schema)))) + (is (= {:foo (s/conditional + foo-map? + {:foo-bar s/Str + (s/optional-key :bar) s/Str + (s/required-key :baz) s/Str} + not-foo-map? + {:quu s/Str + :quux [{:fizz s/Str}]})} + (let [schema {:FOO (s/conditional + foo-map? + {:fooBar s/Str + (s/optional-key :BAR) s/Str + (s/required-key :Baz) s/Str} + not-foo-map? + {:QUU s/Str + :Quux [{:Fizz s/Str}]})}] + (alias-schema (registry schema) schema))))) + + (testing "recursive schemas" + (is (= {:foo s/Str + :bar (s/recursive #'schema-b)} + (alias-schema (registry schema-a) schema-a))) + (is (= {:baz s/Str + :quu (s/recursive #'schema-a)} + (alias-schema (registry schema-b) schema-b))))) + + (testing "non-keyword keys" + (is (= {"foo-bar" s/Str + 'bazQuux s/Str} + (let [schema {"fooBar" s/Str + 'bazQuux s/Str}] + (alias-schema (registry schema) schema))) + "Symbols are excluded for performance purposes, could work as well")) + + (testing "qualified keys are not renamed" + (is (= {:foo/Bar s/Str + :Baz/DOO s/Str} + (let [schema {:foo/Bar s/Str + :Baz/DOO s/Str}] + (alias-schema (registry schema) schema))))) + + (testing "generic keys are not renamed" + (is (= {s/Str {:fooBar s/Str}} + (let [schema {s/Str {:fooBar s/Str}}] + (alias-schema (registry schema) schema)))) + (is (= {s/Keyword {:fooBar s/Str}} + (let [schema {s/Keyword {:fooBar s/Str}}] + (alias-schema (registry schema) schema)))) + (is (= (st/any-keys) + (let [schema (st/any-keys)] + (alias-schema (registry schema) schema)))))) diff --git a/core/test/martian/schema_tools_test.cljc b/core/test/martian/schema_tools_test.cljc new file mode 100644 index 0000000..8f39321 --- /dev/null +++ b/core/test/martian/schema_tools_test.cljc @@ -0,0 +1,223 @@ +(ns martian.schema-tools-test + (:require [martian.schema-tools :as schema-tools] + [schema.core :as s] + [schema-tools.core :as st] + #?(:clj [clojure.test :refer [deftest testing is]] + :cljs [cljs.test :refer-macros [deftest testing is]]))) + +(deftest compute-aliases-at-test + (testing "basic usage" + (let [schema {:fooBar s/Str + (s/optional-key :BAR) s/Str + :Baz {:QUU s/Str + :Quux [{:Fizz s/Str}]}}] + (is (= {:foo-bar :fooBar + :bar :BAR + :baz :Baz} + (schema-tools/compute-aliases-at + schema + []))) + (is (nil? (schema-tools/compute-aliases-at + schema + [:foo-bar]))) + (is (nil? (schema-tools/compute-aliases-at + schema + [:bar]))) + (is (= {:quu :QUU + :quux :Quux} + (schema-tools/compute-aliases-at + schema + [:baz]))) + (is (nil? (schema-tools/compute-aliases-at + schema + [:baz :quu]))) + (is (= {:fizz :Fizz} + (schema-tools/compute-aliases-at + schema + [:baz :quux]))) + (is (nil? (schema-tools/compute-aliases-at + schema + [:baz :quux :fizz]))))) + + (testing "non-keyword keys" + (is (= {"foo-bar" "fooBar" + :bar-baz :Bar-Baz} + (schema-tools/compute-aliases-at + {"fooBar" s/Str + :Bar-Baz s/Str + 'bazQuux s/Str} + [])) + "Symbols are excluded for performance purposes, could work as well")) + + (testing "qualified keys" + (is (nil? (schema-tools/compute-aliases-at + {:foo/Bar s/Str + :Baz/DOO s/Str} + [])))) + + (testing "generic keys" + (is (nil? (schema-tools/compute-aliases-at + {s/Str {:foo s/Str}} + []))) + (is (nil? (schema-tools/compute-aliases-at + {s/Keyword {:foo s/Str}} + []))) + (is (nil? (schema-tools/compute-aliases-at + (st/any-keys) + []))))) + +(deftest prewalk-with-path-test + (testing "map schemas (with all sorts of keys)" + (let [paths+forms (atom [])] + (schema-tools/prewalk-with-path + (fn [path form] + (swap! paths+forms conj [path form]) + form) + [] + {:fooBar s/Str + (s/optional-key :BAR) s/Str + (s/required-key :Baz) s/Str}) + (is (= [[[] {:fooBar s/Str, (s/optional-key :BAR) s/Str, :Baz s/Str}] + [[] [:fooBar s/Str]] + [[] :fooBar] + [[:fooBar] s/Str] + [[] [(s/optional-key :BAR) s/Str]] + [[] (s/optional-key :BAR)] + [[] [:k :BAR]] + [[] :k] + [[:k] :BAR] + [[(s/optional-key :BAR)] s/Str] + [[] [:Baz s/Str]] + [[] :Baz] + [[:Baz] s/Str]] + @paths+forms)))) + + (testing "nested map and vector schemas" + (let [paths+forms (atom [])] + (schema-tools/prewalk-with-path + (fn [path form] + (swap! paths+forms conj [path form]) + form) + [] + {:fooBar s/Str + (s/optional-key :BAR) s/Str + :Baz {:QUU s/Str + :Quux [{:Fizz s/Str}]}}) + (is (= [[[] {:fooBar s/Str, + (s/optional-key :BAR) s/Str, + :Baz {:QUU s/Str, :Quux [{:Fizz s/Str}]}}] + [[] [:fooBar s/Str]] + [[] :fooBar] + [[:fooBar] s/Str] + [[] [(s/optional-key :BAR) s/Str]] + [[] (s/optional-key :BAR)] + [[] [:k :BAR]] + [[] :k] + [[:k] :BAR] + [[(s/optional-key :BAR)] s/Str] + [[] [:Baz {:QUU s/Str, :Quux [{:Fizz s/Str}]}]] + [[] :Baz] + [[:Baz] {:QUU s/Str, :Quux [{:Fizz s/Str}]}] + [[:Baz] [:QUU s/Str]] + [[:Baz] :QUU] + [[:Baz :QUU] s/Str] + [[:Baz] [:Quux [{:Fizz s/Str}]]] + [[:Baz] :Quux] + [[:Baz :Quux] [{:Fizz s/Str}]] + [[:Baz :Quux] {:Fizz s/Str}] + [[:Baz :Quux] [:Fizz s/Str]] + [[:Baz :Quux] :Fizz] + [[:Baz :Quux :Fizz] s/Str]] + @paths+forms)))) + + (testing "deeply nested vector schemas" + (let [paths+forms (atom [])] + (schema-tools/prewalk-with-path + (fn [path form] + (swap! paths+forms conj [path form]) + form) + [] + {(s/optional-key :FOO) + {:Bar [[{:barDoo s/Str + (s/optional-key :barDee) s/Str}]]}}) + (is (= [[[] {(s/optional-key :FOO) {:Bar [[{:barDoo s/Str, + (s/optional-key :barDee) s/Str}]]}}] + [[] [(s/optional-key :FOO) + {:Bar [[{:barDoo s/Str, (s/optional-key :barDee) s/Str}]]}]] + [[] (s/optional-key :FOO)] + [[] [:k :FOO]] + [[] :k] + [[:k] :FOO] + [[(s/optional-key :FOO)] + {:Bar [[{:barDoo s/Str, (s/optional-key :barDee) s/Str}]]}] + [[(s/optional-key :FOO)] + [:Bar [[{:barDoo s/Str, (s/optional-key :barDee) s/Str}]]]] + [[(s/optional-key :FOO)] :Bar] + [[(s/optional-key :FOO) :Bar] + [[{:barDoo s/Str, (s/optional-key :barDee) s/Str}]]] + [[(s/optional-key :FOO) :Bar] + [{:barDoo s/Str, (s/optional-key :barDee) s/Str}]] + [[(s/optional-key :FOO) :Bar] + {:barDoo s/Str, (s/optional-key :barDee) s/Str}] + [[(s/optional-key :FOO) :Bar] [:barDoo s/Str]] + [[(s/optional-key :FOO) :Bar] :barDoo] + [[(s/optional-key :FOO) :Bar :barDoo] s/Str] + [[(s/optional-key :FOO) :Bar] [(s/optional-key :barDee) s/Str]] + [[(s/optional-key :FOO) :Bar] (s/optional-key :barDee)] + [[(s/optional-key :FOO) :Bar] [:k :barDee]] + [[(s/optional-key :FOO) :Bar] :k] + [[(s/optional-key :FOO) :Bar :k] :barDee] + [[(s/optional-key :FOO) :Bar (s/optional-key :barDee)] s/Str]] + @paths+forms)))) + + (testing "default schemas" + (let [paths+forms (atom [])] + (schema-tools/prewalk-with-path + (fn [path form] + (swap! paths+forms conj [path form]) + form) + [] + {:fooBar s/Str + (s/optional-key :BAR) s/Str + :Baz (st/default {:QUU s/Str + :Quux [{:Fizz s/Str}]} + {:QUU "hi" + :Quux []})}) + (is (= [[[] {:fooBar s/Str, + (s/optional-key :BAR) s/Str, + :Baz (st/default {:QUU s/Str, :Quux [{:Fizz s/Str}]} {:QUU "hi", :Quux []})}] + [[] [:fooBar s/Str]] + [[] :fooBar] + [[:fooBar] s/Str] + [[] [(s/optional-key :BAR) s/Str]] + [[] (s/optional-key :BAR)] + [[] [:k :BAR]] + [[] :k] + [[:k] :BAR] + [[(s/optional-key :BAR)] s/Str] + [[] [:Baz (st/default {:QUU s/Str, :Quux [{:Fizz s/Str}]} {:QUU "hi", :Quux []})]] + [[] :Baz] + [[:Baz] (st/default {:QUU s/Str, :Quux [{:Fizz s/Str}]} {:QUU "hi", :Quux []})] + [[:Baz] [:schema {:QUU s/Str, :Quux [{:Fizz s/Str}]}]] + [[:Baz] :schema] + [[:Baz :schema] {:QUU s/Str, :Quux [{:Fizz s/Str}]}] + [[:Baz :schema] [:QUU s/Str]] + [[:Baz :schema] :QUU] + [[:Baz :schema :QUU] s/Str] + [[:Baz :schema] [:Quux [{:Fizz s/Str}]]] + [[:Baz :schema] :Quux] + [[:Baz :schema :Quux] [{:Fizz s/Str}]] + [[:Baz :schema :Quux] {:Fizz s/Str}] + [[:Baz :schema :Quux] [:Fizz s/Str]] + [[:Baz :schema :Quux] :Fizz] + [[:Baz :schema :Quux :Fizz] s/Str] + [[:Baz] [:value {:QUU "hi", :Quux []}]] + [[:Baz] :value] + [[:Baz :value] {:QUU "hi", :Quux []}] + [[:Baz :value] [:QUU "hi"]] + [[:Baz :value] :QUU] + [[:Baz :value :QUU] "hi"] + [[:Baz :value] [:Quux []]] + [[:Baz :value] :Quux] + [[:Baz :value :Quux] []]] + @paths+forms)))))