Codebase list comidi-clojure / 50341f6
(PE-8561) Initial code This commit creates the `puppetlabs.bidi` namespace. The namespace contains utility functions and macros that build off of the `bidi` web routing library. The major features are: * Compojure-like convenience macros for defining routes (e.g. GET, POST, ANY, etc.) * A `route-metadata` function that can walk the bidi route tree and generate some metadata that can be used to introspect the routes. * `routes->handler` function, which creates a ring handler from the bidi routes, attaching `:route-metadata` to the metadata of the function. Also adds `:route-info` key to request, so that middleware can be written that has access to information about the route that the request matched. Chris Price 9 years ago
6 changed file(s) with 584 addition(s) and 14 deletion(s). Raw diff Collapse all Expand all
88 .lein-repl-history
99 .lein-plugins/
1010 .lein-failures
11 .nrepl-port
00 (defproject puppetlabs/pl-bidi "0.1.0-SNAPSHOT"
11 :description "Puppet Labs utility functions for use with the bidi web routing library"
22 :url "https://github.com/puppetlabs/pl-bidi"
3 :dependencies [[org.clojure/clojure "1.6.0"]])
3 :dependencies [[org.clojure/clojure "1.6.0"]
4 [bidi "1.18.8-SNAPSHOT"]
5 [compojure "1.3.2"]
6 [prismatic/schema "0.2.2"]]
7
8 :profiles {:dev {:dependencies [[spyscope "0.1.4" :exclusions [clj-time]]]
9 :injections [(require 'spyscope.core)]}})
+0
-6
src/pl_bidi/core.clj less more
0 (ns pl-bidi.core)
1
2 (defn foo
3 "I don't do a whole lot."
4 [x]
5 (println x "Hello, World!"))
0 (ns puppetlabs.bidi
1 (:require [bidi.ring :as bidi-ring]
2 [bidi.bidi :as bidi]
3 [clojure.zip :as zip]
4 [compojure.core :as compojure]
5 [compojure.response :as compojure-response]
6 [ring.util.response :as ring-response]
7 [schema.core :as schema])
8 (:import (java.util.regex Pattern)))
9
10 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
11 ;;; Schemas
12
13 ;; NOTE: This function should be added to kitchensink soon; we
14 ;; can remove it from here once that's in a release.
15 (defn zipper?
16 "Checks to see if the object has zip/make-node metadata on it (confirming it
17 to be a zipper."
18 [obj]
19 (contains? (meta obj) :zip/make-node))
20
21 (defn pattern?
22 [x]
23 (instance? Pattern x))
24
25 (def Zipper
26 (schema/pred zipper?))
27
28 (def http-methods
29 #{:any :get :post :put :delete :head})
30
31 (def RequestMethod
32 (schema/enum :any :get :post :put :delete :head))
33
34 (def RegexPathElement
35 [(schema/one Pattern "regex") (schema/one schema/Keyword "variable")])
36
37 (def PathElement
38 (schema/conditional
39 string? schema/Str
40 keyword? schema/Keyword
41 vector? RegexPathElement))
42
43 (def RouteInfo
44 {:path [PathElement]
45 :request-method RequestMethod})
46
47 (def Handler
48 (schema/conditional
49 keyword? schema/Keyword
50 fn? (schema/pred fn?)
51 map? {RequestMethod (schema/recursive #'Handler)}))
52
53 (def RouteMetadata
54 {:routes [RouteInfo]
55 :handlers {Handler RouteInfo}})
56
57 (def BidiPattern
58 (schema/conditional
59 keyword? schema/Keyword
60 string? schema/Str
61 sequential? [PathElement]))
62
63 (def BidiRouteDestination
64 (schema/conditional
65 #(nil? (schema/check Handler %)) Handler
66 :else [[(schema/one BidiPattern "pattern")
67 (schema/one (schema/recursive #'BidiRouteDestination) "destination")]]))
68
69 (def BidiRoute
70 [(schema/one BidiPattern "pattern")
71 (schema/one BidiRouteDestination "destination")])
72
73
74 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
75 ;;; Private
76
77 (defmacro handler-fn*
78 "Helper macro, used by the compojure-like macros (GET/POST/etc.) to generate
79 a function that provides compojure's destructuring and rendering support."
80 [bindings body]
81 `(fn [request#]
82 (compojure-response/render
83 (compojure/let-request [~bindings request#] ~@body)
84 request#)))
85
86 (defn route-with-method*
87 "Helper function, used by the compojure-like macros (GET/POST/etc.) to generate
88 a bidi route that includes a wrapped handler function."
89 [method pattern bindings body]
90 `[~pattern {~method (handler-fn* ~bindings ~body)}])
91
92 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
93 ;;; Private - route metadata computation
94
95 (schema/defn ^:always-validate
96 update-route-info* :- RouteInfo
97 "Helper function, used to maintain a RouteInfo data structure that represents
98 the current path elements of a route as we traverse the Bidi route tree via
99 zipper."
100 [route-info :- RouteInfo
101 pattern :- BidiPattern]
102 (cond
103 (contains? http-methods pattern)
104 (assoc-in route-info [:request-method] pattern)
105
106 (nil? (schema/check RegexPathElement pattern))
107 (update-in route-info [:path] concat [pattern])
108
109 (sequential? pattern)
110 (if-let [next (first pattern)]
111 (update-route-info*
112 (update-in route-info [:path] conj next)
113 (rest pattern))
114 route-info)
115
116 :else
117 (update-in route-info [:path] conj pattern)))
118
119 (declare breadth-route-metadata*)
120
121 (schema/defn ^:always-validate
122 depth-route-metadata* :- RouteMetadata
123 "Helper function used to traverse branches of the Bidi route tree, depth-first."
124 [route-meta :- RouteMetadata
125 route-info :- RouteInfo
126 loc :- Zipper]
127 (let [[pattern matched] (zip/node loc)]
128 (cond
129 (map? matched)
130 (depth-route-metadata*
131 route-meta
132 route-info
133 (-> loc zip/down zip/right (zip/edit #(into [] %)) zip/up))
134
135 (vector? matched)
136 (breadth-route-metadata*
137 route-meta
138 (update-route-info* route-info pattern)
139 (-> loc zip/down zip/right zip/down))
140
141 :else
142 (let [route-info (update-route-info* route-info pattern)]
143 (-> route-meta
144 (update-in [:routes] conj route-info)
145 (assoc-in [:handlers matched] route-info))))))
146
147 (schema/defn ^:always-validate
148 breadth-route-metadata* :- RouteMetadata
149 "Helper function used to traverse branches of the Bidi route tree, breadth-first."
150 [route-meta :- RouteMetadata
151 route-info :- RouteInfo
152 loc :- Zipper]
153 (loop [route-meta route-meta
154 loc loc]
155 (let [routes (depth-route-metadata* route-meta route-info loc)]
156 (if-let [next (zip/right loc)]
157 (recur routes next)
158 routes))))
159
160 (schema/defn ^:always-validate
161 route-metadata :- RouteMetadata
162 "Traverses a Bidi route tree and returns route metadata, which includes a list
163 of RouteInfo objects (one per route), plus a mechanism to look up the
164 RouteInfo for a given handler."
165 [routes :- BidiRoute]
166 (let [route-info {:path []
167 :request-method :any}
168 loc (-> [routes] zip/vector-zip zip/down)]
169 (breadth-route-metadata* {:routes []
170 :handlers {}} route-info loc)))
171
172 (schema/defn ^:always-validate
173 make-handler :- (schema/pred fn?)
174 "Create a Ring handler from the route definition data structure. (This code
175 is largely borrowed from bidi core.) Arguments:
176
177 - route-meta: metadata about the routes; allows us to look up the route info
178 by handler. You can get this by calling `route-metadata`.
179 - routes: the Bidi route tree
180 - handler-fn: this fn will be called on all of the handlers found in the bidi
181 route tree; it is expected to return a ring handler fn for that
182 route. If you are using the compojure-like macros in this
183 namespace or have nested your ring handler functions in the bidi
184 tree by other means, you can just pass `identity` here, or pass
185 in some middleware fn to wrap around the nested ring handlers.
186 The handlers will have access to the `RouteInfo` of the matching
187 bidi route via the `:route-info` key in the request map."
188 [route-meta :- RouteMetadata
189 routes :- BidiRoute
190 handler-fn :- (schema/pred fn?)]
191 (assert routes "Cannot create a Ring handler with a nil Route(s) parameter")
192 (let [compiled-routes (bidi/compile-route routes)]
193 (fn [{:keys [uri path-info] :as req}]
194 (let [path (or path-info uri)
195 {:keys [handler route-params] :as match-context}
196 (apply bidi/match-route compiled-routes path (apply concat (seq req)))]
197 (when handler
198 (let [req (-> req
199 (update-in [:params] merge route-params)
200 (update-in [:route-params] merge route-params)
201 (assoc-in [:route-info] (get-in route-meta
202 [:handlers handler])))]
203 (bidi-ring/request
204 (handler-fn handler)
205 req
206 (apply dissoc match-context :handler (keys req)))))))))
207
208
209 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
210 ;;;; Public - core functions
211
212 (schema/defn ^:always-validate
213 routes :- BidiRoute
214 "Combines multiple bidi routes into a single data structure; this is largely
215 just a convenience function for grouping several routes together as a single
216 object that can be passed around."
217 [& routes :- [BidiRoute]]
218 ["" (vec routes)])
219
220 (schema/defn ^:always-validate
221 context :- BidiRoute
222 [url-prefix :- BidiPattern
223 & routes :- [BidiRoute]]
224 "Combines multiple bidi routes together into a single data structure, but nests
225 them all under the given url-prefix. This is similar to compojure's `context`
226 macro, but does not accept a binding form. You can still destructure variables
227 by passing a bidi pattern for `url-prefix`, and the variables will be available
228 to all nested routes."
229 [url-prefix (vec routes)])
230
231 (schema/defn ^:always-validate
232 routes->handler :- (schema/pred fn?)
233 "Given a bidi route tree, converts into a ring request handler function. You
234 may pass an optional middleware function that will be wrapped around the
235 request handling; the middleware fn will have access to the `RouteInfo` of the
236 matching bidi route via the `:route-info` key in the request map."
237 ([routes :- BidiRoute
238 route-middleware-fn :- (schema/maybe (schema/pred fn?))]
239 (let [route-meta (route-metadata routes)]
240 (with-meta
241 (make-handler route-meta
242 routes
243 route-middleware-fn)
244 {:route-metadata route-meta})))
245 ([routes]
246 (routes->handler routes identity)))
247
248 (schema/defn ^:always-validate
249 context-handler :- (schema/pred fn?)
250 "Convenience function that effectively composes `context` and `routes->handler`."
251 ([url-prefix :- BidiPattern
252 & routes :- [BidiRoute]]
253 (routes->handler
254 (apply context url-prefix routes))))
255
256
257 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
258 ;;; Public - compojure-like convenience macros
259
260 (defmacro ANY
261 [pattern bindings & body]
262 `[~pattern (handler-fn* ~bindings ~body)])
263
264 (defmacro GET
265 [pattern bindings & body]
266 (route-with-method* :get pattern bindings body))
267
268 (defmacro HEAD
269 [pattern bindings & body]
270 (route-with-method* :head pattern bindings body))
271
272 (defmacro PUT
273 [pattern bindings & body]
274 (route-with-method* :put pattern bindings body))
275
276 (defmacro POST
277 [pattern bindings & body]
278 (route-with-method* :post pattern bindings body))
279
280 (defmacro DELETE
281 [pattern bindings & body]
282 (route-with-method* :delete pattern bindings body))
283
284 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
285 ;;; Public - pre-built routes
286
287 (defn not-found
288 [body]
289 [[[#".*" :rest]] (fn [request]
290 (-> (compojure-response/render body request)
291 (ring-response/status 404)))])
+0
-7
test/pl_bidi/core_test.clj less more
0 (ns pl-bidi.core-test
1 (:require [clojure.test :refer :all]
2 [pl-bidi.core :refer :all]))
3
4 (deftest a-test
5 (testing "FIXME, I fail."
6 (is (= 1 1))))
0 (ns puppetlabs.bidi-test
1 (require [clojure.test :refer :all]
2 [puppetlabs.bidi :as pl-bidi]
3 [schema.test :as schema-test]
4 [puppetlabs.bidi :refer :all]
5 [schema.core :as schema]
6 [clojure.zip :as zip]))
7
8 (use-fixtures :once schema-test/validate-schemas)
9
10 (defn replace-regexes-for-equality-check
11 [xs]
12 (loop [loc (zip/vector-zip xs)]
13 (if (zip/end? loc)
14 (zip/root loc)
15 (recur
16 (let [node (zip/node loc)]
17 (if (pattern? node)
18 (zip/edit loc #(str "REGEX: " (.pattern %)))
19 (zip/next loc)))))))
20
21 (deftest handler-schema-test
22 (testing "handler schema"
23 (is (nil? (schema/check Handler :foo)))
24 (is (nil? (schema/check Handler (fn [] :foo))))
25 (is (nil? (schema/check Handler {:get (fn [] :foo)})))
26 (is (nil? (schema/check Handler {:post :foo})))))
27
28 (deftest pattern-schema-test
29 (testing "pattern schema"
30 (is (nil? (schema/check BidiPattern "/foo")))
31 (is (nil? (schema/check BidiPattern :foo)))
32 (is (nil? (schema/check BidiPattern ["/foo/" :foo "/foo"])))
33 (is (nil? (schema/check BidiPattern ["/foo/" [#".*" :rest]])))))
34
35 (deftest destination-schema-test
36 (testing "route destination schema"
37 (is (nil? (schema/check BidiRouteDestination :foo)))
38 (is (nil? (schema/check BidiRouteDestination (fn [] nil))))
39 (is (nil? (schema/check BidiRouteDestination {:get (fn [] nil)})))
40 (is (nil? (schema/check BidiRouteDestination {:get :my-handler})))
41 (is (nil? (schema/check BidiRouteDestination [[["/foo/" :foo "/foo"] :foo]])))
42 (is (not (nil? (schema/check BidiRouteDestination [["/foo/" :foo "/foo"] :foo]))))
43 (is (nil? (schema/check BidiRouteDestination [[["/foo/" :foo]
44 :foo-handler]
45 [["/bar/" :bar]
46 {:get :bar-handler}]])))))
47
48 (deftest route-schema-test
49 (testing "route schema"
50 (is (nil? (schema/check BidiRoute [:foo :foo])))
51 (is (nil? (schema/check BidiRoute ["/foo" [[:foo :foo]]])))
52 (is (not (nil? (schema/check BidiRoute ["/foo" [:foo :foo]]))))
53 (is (nil? (schema/check BidiRoute ["" [[["/foo/" :foo]
54 :foo-handler]
55 [["/bar/" :bar]
56 {:get :bar-handler}]]])))))
57
58 (deftest update-route-info-test
59 (let [orig-route-info {:path []
60 :request-method :any}]
61 (testing "HTTP verb keyword causes request-method to be updated"
62 (doseq [verb [:get :post :put :delete :head]]
63 (is (= {:path []
64 :request-method verb}
65 (update-route-info* orig-route-info verb)))))
66 (testing "string path elements get added to the path"
67 (is (= {:path ["/foo"]
68 :request-method :any}
69 (update-route-info* orig-route-info "/foo"))))
70 (testing "keyword path elements get added to the path"
71 (is (= {:path [:foo]
72 :request-method :any}
73 (update-route-info* orig-route-info :foo))))
74 (testing "vector path elements get flattened and added to the path"
75 (is (= {:path ["/foo/" :foo]
76 :request-method :any}
77 (update-route-info* orig-route-info ["/foo/" :foo]))))
78 (testing "regex path element gets added to the path"
79 (is (= {:path ["/foo/" ["REGEX: .*" :foo]]
80 :request-method :any}
81 (-> (update-route-info* orig-route-info ["/foo/" [#".*" :foo]])
82 (update-in [:path] replace-regexes-for-equality-check)))))))
83
84 (deftest route-metadata-test
85 (testing "route metadata includes ordered list of routes and lookup by handler"
86 (let [routes ["" [[["/foo/" :foo]
87 :foo-handler]
88 [["/bar/" :bar]
89 [["/baz" {:get :baz-handler}]
90 ["/bam" {:put :bam-handler}]
91 ["/bap" {:any :bap-handler}]]]
92 ["/buzz" {:post :buzz-handler}]]]
93 expected-foo-meta {:path '("" "/foo/" :foo)
94 :request-method :any}
95 expected-baz-meta {:path '("" "/bar/" :bar "/baz")
96 :request-method :get}
97 expected-bam-meta {:path '("" "/bar/" :bar "/bam")
98 :request-method :put}
99 expected-bap-meta {:path '("" "/bar/" :bar "/bap")
100 :request-method :any}
101 expected-buzz-meta {:path '("" "/buzz")
102 :request-method :post}]
103 (is (= (pl-bidi/route-metadata routes)
104 {:routes [expected-foo-meta
105 expected-baz-meta
106 expected-bam-meta
107 expected-bap-meta
108 expected-buzz-meta]
109 :handlers {:foo-handler expected-foo-meta
110 :baz-handler expected-baz-meta
111 :bam-handler expected-bam-meta
112 :bap-handler expected-bap-meta
113 :buzz-handler expected-buzz-meta}})))))
114
115 (deftest routes-test
116 (is (= ["" [["/foo" :foo-handler]
117 [["/bar/" :bar] :bar-handler]]]
118 (routes ["/foo" :foo-handler]
119 [["/bar/" :bar] :bar-handler]))))
120
121 (deftest context-test
122 (testing "simple context"
123 (is (= ["/foo" [["/bar" :bar-handler]
124 [["/baz" :baz] :baz-handler]]]
125 (context "/foo"
126 ["/bar" :bar-handler]
127 [["/baz" :baz] :baz-handler]))))
128 (testing "context with variable"
129 (is (= [["/foo" :foo] [["/bar" :bar-handler]
130 [["/baz" :baz] :baz-handler]]]
131 (context ["/foo" :foo]
132 ["/bar" :bar-handler]
133 [["/baz" :baz] :baz-handler])))))
134
135 (deftest routes->handler-test
136 (testing "routes are matched against a request properly, with route params"
137 (let [handler (routes->handler ["/foo"
138 [[""
139 [["/bar"
140 (fn [req] :bar)]
141 [["/baz/" :baz]
142 (fn [req]
143 {:endpoint :baz
144 :route-params (:route-params req)})]]]]])]
145 (is (= :bar (handler {:uri "/foo/bar"})))
146 (is (= {:endpoint :baz
147 :route-params {:baz "howdy"}}
148 (handler {:uri "/foo/baz/howdy"})))))
149 (testing "request-methods are honored"
150 (let [handler (routes->handler ["/foo" {:get (fn [req] :foo)}])]
151 (is (nil? (handler {:uri "/foo"})))
152 (is (= :foo (handler {:uri "/foo" :request-method :get})))))
153 (testing "contexts can bind route variables"
154 (let [handler (routes->handler
155 (context ["/foo/" :foo]
156 [["/bar/" :bar]
157 (fn [req] (:route-params req))]))]
158 (is (= {:foo "hi"
159 :bar "there"}
160 (handler {:uri "/foo/hi/bar/there"})))))
161 (testing "route metadata is added to fn metadata"
162 (let [foo-handler (fn [req] :foo)
163 handler (routes->handler ["/foo" {:get foo-handler}])]
164 (let [route-meta (:route-metadata (meta handler))]
165 (is (= {:routes [{:path ["/foo"]
166 :request-method :get}]
167 :handlers {foo-handler {:path ["/foo"]
168 :request-method :get}}}
169 route-meta))))))
170
171 (deftest routes->handler-middleware-test
172 (let [handler (routes->handler
173 (context ["/foo/" :foo]
174 [["/bar/" :bar]
175 (fn [req] (:route-params req))])
176 (fn [f]
177 (fn [req]
178 {:result (f req)
179 :route-info (:route-info req)})))]
180 (is (= {:result {:foo "hi"
181 :bar "there"}
182 :route-info {:path ["/foo/" :foo "/bar/" :bar]
183 :request-method :any}}
184 (handler {:uri "/foo/hi/bar/there"})))))
185
186 (deftest context-handler-test
187 (let [handler (context-handler ["/foo/" :foo]
188 [["/bar/" :bar]
189 (fn [req] (:route-params req))])]
190 (is (= {:foo "hi"
191 :bar "there"}
192 (handler {:uri "/foo/hi/bar/there"})))))
193
194
195 (deftest compojure-macros-test
196 (let [routes (context ["/foo/" :foo]
197 (ANY ["/any/" :any] [foo any]
198 (str "foo: " foo " any: " any))
199 (GET ["/get/" :get] [foo get]
200 (fn [req] {:foo foo
201 :get get}))
202 (HEAD ["/head/" :head] [foo head]
203 {:foo foo
204 :head head})
205 (PUT "/put" [foo]
206 {:status 500
207 :body foo})
208 (POST ["/post/" :post] [post]
209 post)
210 (DELETE ["/delete/" :delete] [foo delete]
211 (atom {:foo foo
212 :delete delete})))
213 handler (routes->handler routes)]
214 (is (nil? (handler {:uri "/foo/hi/get/there" :request-method :post})))
215 (is (nil? (handler {:uri "/foo/hi/head/there" :request-method :get})))
216 (is (nil? (handler {:uri "/foo/hi/put" :request-method :get})))
217 (is (nil? (handler {:uri "/foo/hi/post/there" :request-method :get})))
218 (is (nil? (handler {:uri "/foo/hi/delete/there" :request-method :get})))
219
220 (is (= "foo: hi any: there" (:body (handler {:uri "/foo/hi/any/there"}))))
221 (is (= {:foo "hi"
222 :get "there"}
223 (select-keys
224 (handler {:uri "/foo/hi/get/there" :request-method :get})
225 [:foo :get])))
226 (is (= {:foo "hi"
227 :head "there"}
228 (select-keys
229 (handler {:uri "/foo/hi/head/there" :request-method :head})
230 [:foo :head])))
231 (is (= {:status 500
232 :body "hi"}
233 (select-keys
234 (handler {:uri "/foo/hi/put" :request-method :put})
235 [:status :body])))
236 (is (= {:status 200
237 :body "there"}
238 (select-keys
239 (handler {:uri "/foo/hi/post/there" :request-method :post})
240 [:status :body])))
241 (is (= {:status 200
242 :foo "hi"
243 :delete "there"}
244 (select-keys
245 (handler {:uri "/foo/hi/delete/there" :request-method :delete})
246 [:status :foo :delete])))))
247
248 (deftest not-found-test
249 (testing "root not-found handler"
250 (let [handler (routes->handler (not-found "nobody's home, yo"))]
251 (is (= {:status 404
252 :body "nobody's home, yo"}
253 (select-keys
254 (handler {:uri "/hi/there"})
255 [:body :status])))))
256 (testing "nested not-found handler"
257 (let [handler (routes->handler
258 (routes
259 ["/bar" [["" (fn [req] :bar)]
260 (not-found "nothing else under bar!")]]
261 (not-found "nothing else under root!")))]
262 (is (= :bar (handler {:uri "/bar"})))
263 (is (= {:status 404
264 :body "nothing else under bar!"}
265 (select-keys
266 (handler {:uri "/bar/baz"})
267 [:status :body])))
268 (is (= {:status 404
269 :body "nothing else under root!"}
270 (select-keys
271 (handler {:uri "/yo/mang"})
272 [:status :body]))))))
273
274 (deftest regex-test
275 (let [handler (routes->handler
276 ["/foo" [[["/boo/" [#".*" :rest]]
277 (fn [req] (:rest (:route-params req)))]]])]
278 (is (= "hi/there"
279 (handler {:uri "/foo/boo/hi/there"})))))
280
281
282
283