Repository: oliyh/martian
Pull request #221 (2025-05-08 12:23:48)

Support setting coercion matchers via Martian `:opts`
@oliyh Hello again, Oliver!

This PR addresses a proposal made in #220.

The main part is essentially non-breaking (passing things through existing `:opts` to override the `default-coercion-matcher`), but I've also made a few minor relevant improvements here and there — improved readability/maintainability, exposed some useful schema internals (private -> public), reused `schema-tools` fns, and reordered `core` ns imports.

Thanks for such a neat tool!

oliyh: Hi,

This looks good to me, thank you for all your efforts - definitely some of the trickiest parts of the codebase that you've waded into, and done a good job!

I was thinking that I was sure I'd already done something like this, and then realised it was the en/decoding extension point which is analogous. I thought that perhaps a solution to this could be similar, but of course the coercion of data is spread out across multiple interceptors (perhaps needlessly?) and things like the aliasing further complicate matters.

So this is a good way of injecting this behaviour into the current stack. If I were ever to rewrite martian I think consolidating the schema coercion to a single interceptor, and making the schema library more pluggable (so that using malli would be possible) would probably be top of the list.

I will merge this now and try to get a release out (I have also been having a lot of issues with the lein submodule plugin which no longer works...)

Patch:
diff --git a/README.md b/README.md
index 427856f..2b6a6d7 100644
--- a/README.md
+++ b/README.md
@@ -1,4 +1,5 @@
 # Martian
+
 Calling HTTP endpoints can be complicated. You have to construct the right URL with the right route parameters, remember
 what the query parameters are, what method to use, how to encode the body and many other things that leak into your codebase.
 
@@ -56,6 +57,7 @@ Testing and other interop libraries:
 
 
 ## Features
+
 - Bootstrap an instance from just a OpenAPI/Swagger url, a local definition file or provide your own API mapping
 - Modular with support for many HTTP client libraries (see table above)
 - Build urls and request maps from code or generate and perform the request, returning the response
@@ -84,7 +86,7 @@ like that provided by [pedestal-api](https://github.com/oliyh/pedestal-api):
 (require '[martian.core :as martian]
          '[martian.clj-http :as martian-http])
 
-;; bootstrap the martian instance by simply providing the url serving the openapi/swagger description
+;; bootstrap the Martian instance by simply providing the url serving the openapi/swagger description
 (let [m (martian-http/bootstrap-openapi "https://pedestal-api.herokuapp.com/swagger.json")]
 
   ;; explore the endpoints
@@ -162,6 +164,7 @@ Here's an example:
 ```
 
 ## Testing with martian-test
+
 Testing code that calls external systems can be tricky - you either build often elaborate stubs which start
 to become as complex as the system you are calling, or else you ignore it all together with `(constantly true)`.
 
@@ -195,6 +198,7 @@ previously untestable code testable again.
 More documentation is available at [martian-test](https://github.com/oliyh/martian/tree/master/test).
 
 ## Recording and playback with martian-vcr
+
 martian-vcr allows you to record responses from real HTTP requests and play them back later, allowing you to build realistic test
 data quickly and easily.
 
@@ -252,6 +256,7 @@ You may wish to provide additional behaviour to requests. This can be done by pr
 which behave in the same way as pedestal interceptors.
 
 ### Global behaviour
+
 You can add interceptors to the stack that get executed on every request when bootstrapping martian.
 For example, if you wish to add an authentication header and a timer to all requests:
 
@@ -286,6 +291,29 @@ For example, if you wish to add an authentication header and a timer to all requ
         ;; => {:status 200 :body {:pets []}}
 ```
 
+There is also a way to augment/override the default coercion matcher that is used by a Martian instance for params coercion:
+
+```clojure
+;; adding an extra coercion instead/after the default one
+(martian-http/bootstrap-openapi
+  "https://pedestal-api.herokuapp.com/swagger.json"
+  {:coercion-matcher (fn [schema]
+                       (or (martian/default-coercion-matcher schema)
+                           (my-extra-coercion-matcher schema)))})
+
+;; switching to some coercion matcher from 'schema-tools'
+(require '[schema-tools.coerce :as stc])
+(martian/bootstrap
+  "https://api.org"
+  [{:route-name  :create-pet
+    :path-parts  ["/pets/"]
+    :method      :post
+    :body-schema {:pet {:PetId     s/Int
+                        :FirstName s/Str
+                        :LastName  s/Str}}}]
+  {:coercion-matcher stc/json-coercion-matcher})
+```
+
 ### Per route behaviour
 
 Sometimes individual routes require custom behaviour. This can be achieved by writing a
diff --git a/core/src/martian/core.cljc b/core/src/martian/core.cljc
index 0cc3cc6..5763f3e 100644
--- a/core/src/martian/core.cljc
+++ b/core/src/martian/core.cljc
@@ -1,18 +1,19 @@
 (ns martian.core
-  (:require [tripod.context :as tc]
-            [clojure.core.protocols]
+  (:require [clojure.core.protocols]
+            [clojure.spec.alpha :as spec]
             [clojure.string :as string]
             [clojure.walk :refer [keywordize-keys]]
+            [lambdaisland.uri :refer [map->query-string]]
             [martian.interceptors :as interceptors]
-            [martian.parameter-aliases :as parameter-aliases :refer [parameter-aliases alias-schema]]
-            [martian.swagger :refer [swagger->handlers]]
             [martian.openapi :refer [openapi->handlers openapi-schema?]]
-            [clojure.spec.alpha :as spec]
+            [martian.parameter-aliases :refer [parameter-aliases alias-schema]]
+            [martian.schema :as schema]
             [martian.spec :as mspec]
-            [lambdaisland.uri :refer [map->query-string]]))
+            [martian.swagger :refer [swagger->handlers]]
+            [tripod.context :as tc]))
 
 #?(:bb
-   ;; reflection issue in babasha -- TODO, submit patch upstream?
+   ;; reflection issue in babashka -- TODO, submit patch upstream?
    (do (defn- exception->ex-info [^Throwable exception execution-id interceptor stage]
          (ex-info (str "Interceptor Exception: " #?(:clj  (.getMessage exception)
                                                     :cljs (.-message exception)))
@@ -35,6 +36,8 @@
    interceptors/set-header-params
    interceptors/enqueue-route-specific-interceptors])
 
+(def default-coercion-matcher schema/default-coercion-matcher)
+
 (def ^:private parameter-schemas [:path-schema :query-schema :body-schema :form-schema :headers-schema])
 
 (defn- enrich-handler [handler]
diff --git a/core/src/martian/interceptors.cljc b/core/src/martian/interceptors.cljc
index 68ac26d..28a4cbc 100644
--- a/core/src/martian/interceptors.cljc
+++ b/core/src/martian/interceptors.cljc
@@ -36,16 +36,22 @@
             (update ctx :request create-only :url (url-for (:route-name handler) params)))})
 
 (defn coerce-data [{:keys [parameter-aliases] :as handler} schema-key params opts]
-  (schema/coerce-data (get handler schema-key) params (get parameter-aliases schema-key) (:use-defaults? opts)))
+  (let [coerce-opts (-> opts
+                        (select-keys [:coercion-matcher :use-defaults?])
+                        (assoc :parameter-aliases (get parameter-aliases schema-key)))]
+    (schema/coerce-data (get handler schema-key) params coerce-opts)))
 
 (def keywordize-params
   {:name ::keywordize-params
    :enter (fn [ctx] (update ctx :params keywordize-keys))})
 
+(defn- set-params [ctx req-key coerced-data]
+  (update ctx :request insert-or-merge req-key coerced-data))
+
 (def set-query-params
   {:name ::query-params
    :enter (fn [{:keys [params handler opts] :as ctx}]
-            (update ctx :request insert-or-merge :query-params (coerce-data handler :query-schema params opts)))})
+            (set-params ctx :query-params (coerce-data handler :query-schema params opts)))})
 
 (def set-body-params
   {:name ::body-params
@@ -56,18 +62,18 @@
                                     (get params body-key)
                                     (get params (->kebab-case-keyword body-key))
                                     params)]
-                (update ctx :request insert-or-merge :body (get (coerce-data handler :body-schema {body-key body-params} opts) body-key)))
+                (set-params ctx :body (get (coerce-data handler :body-schema {body-key body-params} opts) body-key)))
               ctx))})
 
 (def set-form-params
   {:name ::form-params
    :enter (fn [{:keys [params handler opts] :as ctx}]
-            (update ctx :request insert-or-merge :form-params (coerce-data handler :form-schema params opts)))})
+            (set-params ctx :form-params (coerce-data handler :form-schema params opts)))})
 
 (def set-header-params
   {:name ::header-params
    :enter (fn [{:keys [params handler opts] :as ctx}]
-            (update ctx :request insert-or-merge :headers (stringify-keys (coerce-data handler :headers-schema params opts))))})
+            (set-params ctx :headers (stringify-keys (coerce-data handler :headers-schema params opts))))})
 
 (def enqueue-route-specific-interceptors
   {:name ::enqueue-route-specific-interceptors
diff --git a/core/src/martian/schema.cljc b/core/src/martian/schema.cljc
index ccadcb2..7c1f6a0 100644
--- a/core/src/martian/schema.cljc
+++ b/core/src/martian/schema.cljc
@@ -9,50 +9,60 @@
             [martian.parameter-aliases :refer [unalias-data]])
   #?(:clj (:import [schema.core AnythingSchema Maybe EnumSchema EqSchema OptionalKey])))
 
-(defn- keyword->string [s]
-  (if (keyword? s) (name s) s))
-
-(defn- seq->string [schema]
-  (let [separator (get {"csv" ","
-                        "ssv" " "
-                        "tsv" "\t"
-                        "pipes" "|"}
-                       (-> schema meta :collection-format))]
-    (when separator
-      (fn [l]
-        (string/join separator l)))))
-
-(defn- string-enum-matcher [schema]
+(def format->separator
+  {"csv"   ","
+   "ssv"   " "
+   "tsv"   "\t"
+   "pipes" "|"})
+
+(defn seq->string [coll-fmt]
+  (when-some [separator (get format->separator coll-fmt)]
+    (fn [coll]
+      (string/join separator coll))))
+
+(defn format-coll-coercion-matcher [schema]
+  (when-some [coll-fmt (:collection-format (meta schema))]
+    (seq->string coll-fmt)))
+
+(defn keyword->string [x]
+  (if (keyword? x) (name x) x))
+
+(def +extra-string-coercions+
+  {s/Str keyword->string})
+
+(defn string-enum-matcher [schema]
   (when (or (and (instance? EnumSchema schema)
                  (every? string? (.-vs ^EnumSchema schema)))
             (and (instance? EqSchema schema)
                  (string? (.-v ^EqSchema schema))))
     keyword->string))
 
-(defn coercion-matchers [schema]
-  (or (sc/string-coercion-matcher schema)
-      (and (:collection-format (meta schema)) (seq->string schema))
-      ({s/Str keyword->string} schema)
-      (string-enum-matcher schema)))
-
-(defn build-coercion-matchers [use-defaults?]
+(def default-coercion-matcher
+  (stc/or-matcher sc/string-coercion-matcher
+                  format-coll-coercion-matcher
+                  +extra-string-coercions+
+                  string-enum-matcher))
+
+(defn build-coercion-matcher
+  [{:keys [coercion-matcher use-defaults?]
+    :or   {coercion-matcher default-coercion-matcher}}]
+  (when (nil? coercion-matcher)
+    (throw (ex-info "Coercion matcher must be a unary fn of schema" {})))
   (if use-defaults?
-    (fn [schema]
-      (or (stc/default-matcher schema)
-          (coercion-matchers schema)))
-    coercion-matchers))
+    (stc/or-matcher stc/default-matcher coercion-matcher)
+    coercion-matcher))
 
 (defn ->map-matcher
   "Builds a version of `stc/map-filter-matcher` that is optional and takes
-   into account custom `coercion-matchers` that may/not happen afterwards."
-  [coercion-matchers]
+   into account a custom `coercion-matcher` that may/not happen afterwards."
+  [coercion-matcher]
   (fn [schema]
-    (let [f (stc/map-filter-matcher schema)]
+    (let [f (stc/map-filter-matcher schema)
+          g (coercion-matcher schema)]
       (fn [x]
-        (let [x' (if (some? f) (f x) x)]
-          (if-some [g (coercion-matchers schema)]
-            (g x')
-            x'))))))
+        (cond-> x
+                (some? f) (f)
+                (some? g) (g))))))
 
 (defn- from-maybe [s]
   (if (instance? Maybe s)
@@ -61,26 +71,28 @@
 
 (defn coerce-data
   "Extracts the data referred to by the schema's keys and coerces it"
-  [schema data & [parameter-aliases use-defaults?]]
-  (let [coercion-matchers (build-coercion-matchers use-defaults?)]
-    (when-let [s (from-maybe schema)]
-      (cond
-        (instance? AnythingSchema s)
-        ((sc/coercer! schema coercion-matchers) data)
-
-        (map? s)
-        (let [map-matcher (->map-matcher coercion-matchers)]
-          (stc/coerce (unalias-data parameter-aliases data) s map-matcher))
-
-        (coll? s) ;; primitives, arrays, arrays of maps
-        ((sc/coercer! schema coercion-matchers)
-         (map #(if (map? %)
-                 (unalias-data parameter-aliases %)
-                 %)
-              data))
-
-        :else
-        ((sc/coercer! schema coercion-matchers) data)))))
+  ([schema data]
+   (coerce-data schema data nil))
+  ([schema data {:keys [parameter-aliases] :as opts}]
+   (let [matcher (build-coercion-matcher opts)]
+     (when-let [s (from-maybe schema)]
+       (cond
+         (instance? AnythingSchema s)
+         ((sc/coercer! schema matcher) data)
+
+         (map? s)
+         (let [map-matcher (->map-matcher matcher)]
+           (stc/coerce (unalias-data parameter-aliases data) s map-matcher))
+
+         (coll? s) ;; primitives, arrays, arrays of maps
+         ((sc/coercer! schema matcher)
+          (map #(if (map? %)
+                  (unalias-data parameter-aliases %)
+                  %)
+               data))
+
+         :else
+         ((sc/coercer! schema matcher) data))))))
 
 (declare make-schema)
 


Test patch:
diff --git a/core/test/martian/schema_test.cljc b/core/test/martian/schema_test.cljc
index 5871b93..934b167 100644
--- a/core/test/martian/schema_test.cljc
+++ b/core/test/martian/schema_test.cljc
@@ -3,10 +3,16 @@
             [matcher-combinators.test]
             [schema.core :as s]
             [schema-tools.core :as st]
+            [schema-tools.coerce :as stc]
             #?(:clj [clojure.test :refer [deftest testing is]]
                :cljs [cljs.test :refer-macros [deftest testing is]]))
   #?(:clj (:import [clojure.lang ExceptionInfo])))
 
+#?(:cljs
+   (def Throwable js/Error))
+
+(def cannot-coerce-pattern #"Could not coerce value to schema")
+
 (deftest free-form-object-test
   (let [schema (schema/make-schema {:definitions
                                     {:Body55523       {:type                 "object"
@@ -133,8 +139,7 @@
                    (schema/coerce-data schema
                                        {:name "Brachiosaurus"
                                         :address {:city "stavanger"}}
-                                       nil
-                                       true))))
+                                       {:use-defaults? true}))))
 
           (testing "adds missing values when there are defaults"
             (is (= {:name "Brachiosaurus"
@@ -142,8 +147,7 @@
                    (schema/coerce-data schema
                                        {:name "Brachiosaurus"
                                         :address {:city nil}}
-                                       nil
-                                       true))))
+                                       {:use-defaults? true}))))
 
           (testing "adds missing keys"
             (is (= {:name "Brachiosaurus"
@@ -151,8 +155,7 @@
                    (schema/coerce-data schema
                                        {:name "Brachiosaurus"
                                         :address {}}
-                                       nil
-                                       true))))
+                                       {:use-defaults? true}))))
 
           (testing "removing extra keys"
             (is (= {:name "Brachiosaurus"
@@ -161,8 +164,7 @@
                                        {:name "Brachiosaurus"
                                         :extra "key"
                                         :address {}}
-                                       nil
-                                       true))))
+                                       {:use-defaults? true}))))
 
           ;; doesn't work - a limitation of spec-tools?
           #_(testing "works inside arrays"
@@ -173,8 +175,7 @@
                                          {:name "Brachiosaurus"
                                           :address {:city "stavanger"}
                                           :tags [{:k nil}]}
-                                         nil
-                                         true)))))))))
+                                         {:use-defaults? true})))))))))
 
 ;; "int-or-string" (s/cond-pre s/Str s/Int)
 (deftest int-or-string-test
@@ -403,17 +404,41 @@
              (schema/coerce-data {s/Keyword s/Any} data)))))
 
   (testing "deeply nested aliasing"
-    (let [data {:aCamel {:anotherCamel {:camelsEverywhere 1}}}]
+    (let [data {:aCamel {:anotherCamel {:camelsEverywhere 1}}}
+          parameter-aliases {[]                        {:a-camel :aCamel}
+                             [:a-camel]                {:another-camel :anotherCamel}
+                             [:a-camel :another-camel] {:camels-everywhere :camelsEverywhere}}]
       (is (= data
              (schema/coerce-data
-              {s/Keyword s/Any}
-              {:a-camel {:another-camel {:camels-everywhere 1}}}
-              {[] {:a-camel :aCamel}
-               [:a-camel] {:another-camel :anotherCamel}
-               [:a-camel :another-camel] {:camels-everywhere :camelsEverywhere}})))))
+               {s/Keyword s/Any}
+               {:a-camel {:another-camel {:camels-everywhere 1}}}
+               {:parameter-aliases parameter-aliases})))))
 
   (testing "keywords to strings"
-    (is (= "foo" (schema/coerce-data s/Str :foo)))))
+    (is (= "foo" (schema/coerce-data s/Str :foo))))
+
+  (testing "custom coercion matcher"
+    (is (= {:bool false} (schema/coerce-data {:bool s/Bool}
+                                             {:bool "Test"}))
+        "Converts strings to booleans by default")
+    (is (thrown-with-msg? Throwable cannot-coerce-pattern
+                          (schema/coerce-data {:bool s/Bool}
+                                              {:bool "Test"}
+                                              {:coercion-matcher (constantly nil)}))
+        "Dropping the coercion matcher stops strings->boolean conversion")
+    (is (thrown-with-msg? Throwable cannot-coerce-pattern
+                          (schema/coerce-data {:bool s/Bool}
+                                              {:bool "Test"}
+                                              {:coercion-matcher stc/json-coercion-matcher}))
+        "Switching to 'schema-tools' coercion matcher stops strings->boolean conversion")
+    (let [un-false-value (fn [x] (if (false? x) true x))
+          custom-matcher (fn [schema]
+                           (when-some [dcm (schema/default-coercion-matcher schema)]
+                             (comp un-false-value dcm)))]
+      (is (= {:bool true} (schema/coerce-data {:bool s/Bool}
+                                              {:bool "Test"}
+                                              {:coercion-matcher custom-matcher}))
+          "Successfully applies a custom coercion matcher after applying the default one"))))
 
 (deftest recursive-schema-test
   (let [schema (schema/make-schema {:definitions {:A {:type       "object"