IntoMiddleware is now any? => Middleware

Also, reitit/routes returns compiled results ftw!
This commit is contained in:
Tommi Reiman 2017-09-08 08:27:20 +03:00
parent 249a54f9bc
commit 881fb240bc
4 changed files with 157 additions and 114 deletions

View file

@ -89,9 +89,12 @@
(defn find-names [routes opts] (defn find-names [routes opts]
(into [] (keep #(-> % second :name)) routes)) (into [] (keep #(-> % second :name)) routes))
(defn compile-route [[p m :as route] {:keys [compile] :as opts}] (defn- compile-route [[p m :as route] {:keys [compile] :as opts}]
[p m (if compile (compile route opts))]) [p m (if compile (compile route opts))])
(defn- compile-routes [routes opts]
(into [] (keep #(compile-route % opts) routes)))
(defprotocol Router (defprotocol Router
(router-name [this]) (router-name [this])
(routes [this]) (routes [this])
@ -132,7 +135,7 @@
([routes] ([routes]
(linear-router routes {})) (linear-router routes {}))
([routes opts] ([routes opts]
(let [compiled (map #(compile-route % opts) routes) (let [compiled (compile-routes routes opts)
names (find-names routes opts) names (find-names routes opts)
[data lookup] (reduce [data lookup] (reduce
(fn [[data lookup] [p {:keys [name] :as meta} result]] (fn [[data lookup] [p {:keys [name] :as meta} result]]
@ -149,7 +152,7 @@
(router-name [_] (router-name [_]
:linear-router) :linear-router)
(routes [_] (routes [_]
routes) compiled)
(options [_] (options [_]
opts) opts)
(route-names [_] (route-names [_]
@ -179,7 +182,7 @@
(str "can't create LookupRouter with wildcard routes: " wilds) (str "can't create LookupRouter with wildcard routes: " wilds)
{:wilds wilds {:wilds wilds
:routes routes}))) :routes routes})))
(let [compiled (map #(compile-route % opts) routes) (let [compiled (compile-routes routes opts)
names (find-names routes opts) names (find-names routes opts)
[data lookup] (reduce [data lookup] (reduce
(fn [[data lookup] [p {:keys [name] :as meta} result]] (fn [[data lookup] [p {:keys [name] :as meta} result]]
@ -193,7 +196,7 @@
(router-name [_] (router-name [_]
:lookup-router) :lookup-router)
(routes [_] (routes [_]
routes) compiled)
(options [_] (options [_]
opts) opts)
(route-names [_] (route-names [_]

View file

@ -2,10 +2,11 @@
(:require [meta-merge.core :refer [meta-merge]] (:require [meta-merge.core :refer [meta-merge]]
[reitit.core :as reitit])) [reitit.core :as reitit]))
(defprotocol ExpandMiddleware (defprotocol IntoMiddleware
(expand-middleware [this meta opts])) (into-middleware [this meta opts]))
(defrecord Middleware [name wrap create]) (defrecord Middleware [name wrap])
(defrecord Endpoint [meta handler middleware])
(defn create [{:keys [name gen wrap] :as m}] (defn create [{:keys [name gen wrap] :as m}]
(when-not name (when-not name
@ -18,40 +19,42 @@
(str "Middleware can't both :wrap and :gen defined " m) m))) (str "Middleware can't both :wrap and :gen defined " m) m)))
(map->Middleware m)) (map->Middleware m))
(extend-protocol ExpandMiddleware (extend-protocol IntoMiddleware
#?(:clj clojure.lang.APersistentVector #?(:clj clojure.lang.APersistentVector
:cljs cljs.core.PersistentVector) :cljs cljs.core.PersistentVector)
(expand-middleware [[f & args] meta opts] (into-middleware [[f & args] meta opts]
(if-let [mw (expand-middleware f meta opts)] (if-let [{:keys [wrap] :as mw} (into-middleware f meta opts)]
(fn [handler] (assoc mw :wrap #(apply wrap % args))))
(apply mw handler args))))
#?(:clj clojure.lang.Fn #?(:clj clojure.lang.Fn
:cljs function) :cljs function)
(expand-middleware [this _ _] this) (into-middleware [this _ _]
(map->Middleware
{:wrap this}))
#?(:clj clojure.lang.PersistentArrayMap #?(:clj clojure.lang.PersistentArrayMap
:cljs cljs.core.PersistentArrayMap) :cljs cljs.core.PersistentArrayMap)
(expand-middleware [this meta opts] (into-middleware [this meta opts]
(expand-middleware (create this) meta opts)) (into-middleware (create this) meta opts))
#?(:clj clojure.lang.PersistentHashMap #?(:clj clojure.lang.PersistentHashMap
:cljs cljs.core.PersistentHashMap) :cljs cljs.core.PersistentHashMap)
(expand-middleware [this meta opts] (into-middleware [this meta opts]
(expand-middleware (create this) meta opts)) (into-middleware (create this) meta opts))
Middleware Middleware
(expand-middleware [{:keys [wrap gen]} meta opts] (into-middleware [{:keys [wrap gen] :as this} meta opts]
(if gen (if-not gen
this
(if-let [wrap (gen meta opts)] (if-let [wrap (gen meta opts)]
(fn [handler & args] (map->Middleware
(apply wrap handler args))) (-> this
(fn [handler & args] (dissoc :gen)
(apply wrap handler args)))) (assoc :wrap wrap))))))
nil nil
(expand-middleware [_ _ _])) (into-middleware [_ _ _]))
(defn- ensure-handler! [path meta scope] (defn- ensure-handler! [path meta scope]
(when-not (:handler meta) (when-not (:handler meta)
@ -61,23 +64,44 @@
(merge {:path path, :meta meta} (merge {:path path, :meta meta}
(if scope {:scope scope})))))) (if scope {:scope scope}))))))
(defn compose-middleware [middleware meta opts] (defn expand [middleware meta opts]
(->> middleware (->> middleware
(keep identity) (keep #(into-middleware % meta opts))
(map #(expand-middleware % meta opts)) (into [])))
(keep identity)
(apply comp identity)))
(defn compile-handler (defn compile-handler [middleware handler]
((apply comp identity (keep :wrap middleware)) handler))
(compile-handler
[(map->Middleware
{:wrap
(fn [handler]
(fn [request]
(handler request)))})] identity)
(defn compile-result
([route opts] ([route opts]
(compile-handler route opts nil)) (compile-result route opts nil))
([[path {:keys [middleware handler] :as meta}] opts scope] ([[path {:keys [middleware handler] :as meta}] opts scope]
(ensure-handler! path meta scope) (ensure-handler! path meta scope)
((compose-middleware middleware meta opts) handler))) (let [middleware (expand middleware meta opts)]
(map->Endpoint
{:handler (compile-handler middleware handler)
:middleware middleware
:meta meta}))))
(defn router (defn router
([data] ([data]
(router data nil)) (router data nil))
([data opts] ([data opts]
(let [opts (meta-merge {:compile compile-handler} opts)] (let [opts (meta-merge {:compile compile-result} opts)]
(reitit/router data opts)))) (reitit/router data opts))))
(defn middleware-handler [router]
(with-meta
(fn [path]
(some->> path
(reitit/match-by-path router)
:result
:handler))
{::router router}))

View file

@ -9,8 +9,8 @@
(testing "linear-router" (testing "linear-router"
(let [router (reitit/router ["/api" ["/ipa" ["/:size" ::beer]]])] (let [router (reitit/router ["/api" ["/ipa" ["/:size" ::beer]]])]
(is (= [["/api/ipa/:size" {:name ::beer}]]
(is (= :linear-router (reitit/router-name router))) (is (= :linear-router (reitit/router-name router)))
(is (= [["/api/ipa/:size" {:name ::beer} nil]]
(reitit/routes router))) (reitit/routes router)))
(is (= true (map? (reitit/options router)))) (is (= true (map? (reitit/options router))))
(is (= (reitit/map->Match (is (= (reitit/map->Match
@ -43,8 +43,8 @@
(testing "lookup-router" (testing "lookup-router"
(let [router (reitit/router ["/api" ["/ipa" ["/large" ::beer]]])] (let [router (reitit/router ["/api" ["/ipa" ["/large" ::beer]]])]
(is (= [["/api/ipa/large" {:name ::beer}]]
(is (= :lookup-router (reitit/router-name router))) (is (= :lookup-router (reitit/router-name router)))
(is (= [["/api/ipa/large" {:name ::beer} nil]]
(reitit/routes router))) (reitit/routes router)))
(is (= true (map? (reitit/options router)))) (is (= true (map? (reitit/options router))))
(is (= (reitit/map->Match (is (= (reitit/map->Match
@ -97,7 +97,8 @@
["/api/pong" {:name ::pong ["/api/pong" {:name ::pong
:path "/api/pong", :path "/api/pong",
:roles #{:admin}}]] :roles #{:admin}}]]
(reitit/routes router)))) (map butlast (reitit/routes router)))))
(testing "route match contains compiled handler" (testing "route match contains compiled handler"
(is (= 2 @compile-times)) (is (= 2 @compile-times))
(let [{:keys [result]} (reitit/match-by-path router "/api/pong")] (let [{:keys [result]} (reitit/match-by-path router "/api/pong")]

View file

@ -6,25 +6,6 @@
#?(:clj #?(:clj
(:import (clojure.lang ExceptionInfo)))) (:import (clojure.lang ExceptionInfo))))
(defn mw [handler name]
(fn
([request]
(-> request
(update ::mw (fnil conj []) name)
(handler)
(update :body (fnil conj []) name)))
([request respond raise]
(handler
(update request ::mw (fnil conj []) name)
#(respond (update % :body (fnil conj []) name))
raise))))
(defn handler
([{:keys [::mw]}]
{:status 200 :body (conj mw :ok)})
([request respond raise]
(respond (handler request))))
(deftest expand-middleware-test (deftest expand-middleware-test
(testing "middleware records" (testing "middleware records"
@ -46,78 +27,93 @@
:wrap identity :wrap identity
:gen (constantly identity)})))) :gen (constantly identity)}))))
(testing ":wrap" (testing "middleware"
(let [calls (atom 0) (let [calls (atom 0)
data {:name ::test wrap (fn [handler value]
:wrap (fn [handler value] (swap! calls inc)
(swap! calls inc) (fn [request]
(fn [request] [value request]))
[value request]))}] ->app (fn [ast handler]
(middleware/compile-handler
(middleware/expand ast :meta {})
handler))]
(testing "as middleware function"
(reset! calls 0)
(let [app (->app [[#(wrap % :value)]] identity)]
(dotimes [_ 10]
(is (= [:value :request] (app :request)))
(is (= 1 @calls)))))
(testing "as middleware vector"
(reset! calls 0)
(let [app (->app [[wrap :value]] identity)]
(dotimes [_ 10]
(is (= [:value :request] (app :request)))
(is (= 1 @calls)))))
(testing "as map" (testing "as map"
(reset! calls 0) (reset! calls 0)
(let [app ((middleware/compose-middleware [data] :meta {}) identity :value)] (let [app (->app [[{:wrap #(wrap % :value)}]] identity)]
(dotimes [_ 10] (dotimes [_ 10]
(is (= [:value :request] (app :request))) (is (= [:value :request] (app :request)))
(is (= 1 @calls))))) (is (= 1 @calls)))))
(testing "direct" (testing "as map vector"
(reset! calls 0) (reset! calls 0)
(let [app ((middleware/compose-middleware [(middleware/create data)] :meta {}) identity :value)] (let [app (->app [[{:wrap wrap} :value]] identity)]
(dotimes [_ 10] (dotimes [_ 10]
(is (= [:value :request] (app :request))) (is (= [:value :request] (app :request)))
(is (= 1 @calls))))) (is (= 1 @calls)))))
(testing "vector" (testing "as Middleware"
(reset! calls 0) (reset! calls 0)
(let [app ((middleware/compose-middleware [[(middleware/create data) :value]] :meta {}) identity)] (let [app (->app [[(middleware/create {:wrap #(wrap % :value)})]] identity)]
(dotimes [_ 10]
(is (= [:value :request] (app :request)))
(is (= 1 @calls)))))
(testing "as Middleware vector"
(reset! calls 0)
(let [app (->app [[(middleware/create {:wrap wrap}) :value]] identity)]
(dotimes [_ 10] (dotimes [_ 10]
(is (= [:value :request] (app :request))) (is (= [:value :request] (app :request)))
(is (= 1 @calls))))))) (is (= 1 @calls)))))))
(testing ":gen" (testing "compiled Middleware"
(let [calls (atom 0) (let [calls (atom 0)
data {:name ::test mw {:gen (fn [meta _]
:gen (fn [meta _] (swap! calls inc)
(fn [handler value]
(swap! calls inc) (swap! calls inc)
(fn [handler value] (fn [request]
(swap! calls inc) [meta value request])))}
(fn [request] ->app (fn [ast handler]
[meta value request])))}] (middleware/compile-handler
(middleware/expand ast :meta {})
handler))]
(testing "as map" (testing "as map"
(reset! calls 0) (reset! calls 0)
(let [app ((middleware/compose-middleware [data] :meta {}) identity :value)] (let [app (->app [[mw :value]] identity)]
(dotimes [_ 10] (dotimes [_ 10]
(is (= [:meta :value :request] (app :request))) (is (= [:meta :value :request] (app :request)))
(is (= 2 @calls))))) (is (= 2 @calls)))))
(testing "direct" (testing "as Middleware"
(reset! calls 0) (reset! calls 0)
(let [app ((middleware/compose-middleware [(middleware/create data)] :meta {}) identity :value)] (let [app (->app [[(middleware/create mw) :value]] identity)]
(dotimes [_ 10]
(is (= [:meta :value :request] (app :request)))
(is (= 2 @calls)))))
(testing "vector"
(reset! calls 0)
(let [app ((middleware/compose-middleware [[(middleware/create data) :value]] :meta {}) identity)]
(is (= [:meta :value :request] (app :request)))
(dotimes [_ 10] (dotimes [_ 10]
(is (= [:meta :value :request] (app :request))) (is (= [:meta :value :request] (app :request)))
(is (= 2 @calls))))) (is (= 2 @calls)))))
(testing "nil unmounts the middleware" (testing "nil unmounts the middleware"
(reset! calls 0) (let [app (->app [{:gen (constantly nil)}
(let [syntax [[(middleware/create {:gen (constantly nil)}] identity)]
{:name ::test
:gen (fn [meta _])}) :value]]
app ((middleware/compose-middleware syntax :meta {}) identity)]
(is (= :request (app :request)))
(dotimes [_ 10] (dotimes [_ 10]
(is (= :request (app :request)))))))))) (is (= :request (app :request))))))))))
(deftest middleware-router-test (deftest middleware-handler-test
(testing "all paths should have a handler" (testing "all paths should have a handler"
(is (thrown-with-msg? (is (thrown-with-msg?
@ -125,40 +121,59 @@
#"path \"/ping\" doesn't have a :handler defined" #"path \"/ping\" doesn't have a :handler defined"
(middleware/router ["/ping"])))) (middleware/router ["/ping"]))))
(testing "ring-handler" (testing "middleware-handler"
(let [api-mw #(mw % :api) (let [mw (fn [handler value]
(fn [request]
(conj (handler (conj request value)) value)))
api-mw #(mw % :api)
handler #(conj % :ok)
router (middleware/router router (middleware/router
[["/ping" handler] [["/ping" handler]
["/api" {:middleware [api-mw]} ["/api" {:middleware [api-mw]}
["/ping" handler] ["/ping" handler]
["/admin" {:middleware [[mw :admin]]} ["/admin" {:middleware [[mw :admin]]}
["/ping" handler]]]]) ["/ping" handler]]]])
app (fn ->app (fn [router]
([{:keys [uri] :as request}] (let [h (middleware/middleware-handler router)]
(if-let [handler (:result (reitit/match-by-path router uri))] (fn [path]
(handler request))) (if-let [f (h path)]
([{:keys [uri] :as request} respond raise] (f [])))))
(if-let [handler (:result (reitit/match-by-path router uri))] app (->app router)]
(handler request respond raise))))]
(testing "not found" (testing "not found"
(is (= nil (app {:uri "/favicon.ico"})))) (is (= nil (app "/favicon.ico"))))
(testing "normal handler" (testing "normal handler"
(is (= {:status 200, :body [:ok]} (is (= [:ok] (app "/ping"))))
(app {:uri "/ping"}))))
(testing "with middleware" (testing "with middleware"
(is (= {:status 200, :body [:api :ok :api]} (is (= [:api :ok :api] (app "/api/ping"))))
(app {:uri "/api/ping"}))))
(testing "with nested middleware" (testing "with nested middleware"
(is (= {:status 200, :body [:api :admin :ok :admin :api]} (is (= [:api :admin :ok :admin :api] (app "/api/admin/ping"))))
(app {:uri "/api/admin/ping"}))))
(testing "3-arity" (testing ":gen middleware can be unmounted at creation-time"
(let [result (atom nil) (let [mw1 {:name ::mw1, :gen (constantly #(mw % ::mw1))}
respond (partial reset! result), raise ::not-called] mw2 {:name ::mw2, :gen (constantly nil)}
(app {:uri "/api/admin/ping"} respond raise) mw3 {:name ::mw3, :wrap #(mw % ::mw3)}
(is (= {:status 200, :body [:api :admin :ok :admin :api]} router (middleware/router
@result))))))) ["/api" {:name ::api
:middleware [mw1 mw2 mw3 mw2]
:handler handler}])
app (->app router)]
(is (= [::mw1 ::mw3 :ok ::mw3 ::mw1] (app "/api")))
(testing "routes contain list of actually applied mw"
(is (= [::mw1 ::mw3] (->> (reitit/routes router)
first
last
:middleware
(map :name)))))
(testing "match contains list of actually applied mw"
(is (= [::mw1 ::mw3] (->> "/api"
(reitit/match-by-path router)
:result
:middleware
(map :name))))))))))