-
-
Notifications
You must be signed in to change notification settings - Fork 42
/
test.cljc
121 lines (100 loc) · 4.86 KB
/
test.cljc
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
(ns martian.test
(:require [martian.core :as martian]
[martian.interceptors :as interceptors]
[schema-generators.generators :as g]
[clojure.test.check.generators :as tcg]
[schema.core :as s]
[tripod.context :as tc]
#?(:clj [martian.httpkit :refer [go-async]]
:cljs [cljs.core.async :as a])))
(defn- status-range [from to]
(fn [{:keys [status]}]
(<= from (g/generate status) to)))
(defn- filter-response-schema [response-type response-schemas]
(let [filter-fn (get {:random (constantly true)
:success (status-range 200 399)
:error (status-range 400 599)}
response-type)]
(filter filter-fn response-schemas)))
(defn- make-generator [response-type response-schemas]
(some->> response-schemas
(filter-response-schema response-type)
(map g/generator)
(tcg/one-of)))
(defn- make-response [response-type response-schemas]
(some-> (make-generator response-type response-schemas)
(tcg/generate)))
(defn generate-responses [response-types]
{:name ::generate-responses
:leave (fn [{:keys [handler] :as ctx}]
(let [response-type (get response-types (:route-name handler) :random)]
(assoc ctx :response (make-response response-type (:response-schemas handler)))))})
(defn always-generate-response [response-type]
{:name ::always-generate-response
:leave (fn [{:keys [handler] :as ctx}]
(assoc ctx :response (make-response response-type (:response-schemas handler))))})
(def generate-response (always-generate-response :random))
(def generate-error-response (always-generate-response :error))
(def generate-success-response (always-generate-response :success))
(defn constant-responses [responses]
{:name ::constant-responses
:leave (fn [{:keys [handler] :as ctx}]
(assoc ctx :response (get responses (:route-name handler))))})
(defn response-generator [{:keys [handlers]} route-name]
(let [{:keys [response-schemas]} (martian/find-handler handlers route-name)]
(make-generator :random response-schemas)))
#?(:clj
(def httpkit-responder
{:name ::httpkit-responder
:leave (fn [ctx]
(-> ctx
go-async
(assoc :response (future (:response (tc/execute ctx))))))}))
#?(:clj
(def clj-http-responder
{:name ::clj-http-responder
:leave identity}))
#?(:cljs
(def cljs-http-responder
{:name ::cljs-http-responder
:leave (fn [ctx]
(let [c (a/chan)]
(a/put! c (:response ctx))
(assoc ctx :response c)))}))
(def ^:private http-interceptors
#?(:clj {"martian.httpkit" httpkit-responder
"martian.clj-http" clj-http-responder}
:cljs {"martian.cljs-http" cljs-http-responder}))
(defn- replace-http-interceptors [martian]
(update martian :interceptors
(fn [interceptors]
(->> interceptors
(map #(if-let [responder (and (= "perform-request" (name (:name %)))
(get http-interceptors (namespace (:name %))))]
responder
%))
(remove (comp (set (keys http-interceptors)) namespace :name))
(remove (comp #{::interceptors/encode-body ::interceptors/coerce-response} :name))))))
(defn respond-with-constant
"Adds an interceptor that simulates the server constantly responding with the supplied response.
Removes all interceptors that would perform real HTTP operations."
[martian responses]
(-> (replace-http-interceptors martian)
(update :interceptors concat [(constant-responses responses)])))
(defn respond-with-generated
"Adds an interceptor that simulates the server responding to operations by generating responses of the supplied response-type
from the handler response schemas.
Removes all interceptors that would perform real HTTP operations"
[martian response-types]
(-> (replace-http-interceptors martian)
(update :interceptors concat [(generate-responses response-types)])))
(defn respond-as
"You only need to call this if you have a martian which was created without martian's standard http-specific interceptors,
i.e. those found in martian.httpkit and so on.
Implementations of http requests - as provided by martian httpkit, clj-http and cljs-http - give
implementation-specific response types; promises, data and core.async channels respectively.
As your production code will expect these response types this interceptor lets you simulate those response wrappers.
Removes all interceptors that would perform real HTTP operations"
[martian implementation-name]
(-> (replace-http-interceptors martian)
(update :interceptors #(concat [(get http-interceptors (str "martian." (name implementation-name)))] %))))