webstack.clj

(ns lambdaisland.components.webstack
  (:require [com.stuartsierra.component :as component]))

(defn stack-tier-handler
  "Create the ring handler for a single stack tier"
  [component {:keys [make-handler middleware using]}]
  (reduce (fn [h mw]
            (if (vector? mw)
              (apply (first mw) h (rest mw))
              (mw h)))
          (make-handler (select-keys component using))
          middleware))

(defn inject-middleware-deps
  "Replace any ^:using [:foo :bar] in middleware specs with the actual
  dependencies."
  [component stack]
  (map (fn [tier]
         (update
          tier :middleware
          (fn [mws]
            (mapv (fn [mw]
                    (if (vector? mw )
                      (mapv (fn [arg]
                              (if (:using (meta arg))
                                (select-keys component arg)
                                arg))
                            mw)
                      mw))
                  mws))))
       stack))

(defn build-handler
  "Given the WebStack component and a list of tiers, return a ring handler."
  [component stack]
  (let [handlers (->> stack
                      (inject-middleware-deps component)
                      (map (partial stack-tier-handler component))
                      doall)]
    (fn [req]
      (some #(% req) handlers))))

(defn middleware-deps
  "Given a single middleware spec, return any dependencies specified
  with :using.

      -mw-spec-                    ;;=> -result-
      wrap-foo                     ;;=> ()
      [wrap-bar arg]               ;;=> ()
      [wrap-baz ^:using [:foo :bar] ;;=> (:foo :bar) "
  [mw-spec]
  (if (vector? mw-spec)
    (apply concat (filter (comp :using meta) mw-spec))
    ()))

(defn collect-dependencies
  "Given a full stack specification, return the list of components that are
  depended on, either by handlers or by middleware"
  [stack]
  (-> #{}
      (into cat (map :using stack))
      (into (comp (map :middleware) cat
                  (map middleware-deps) cat) stack)
      vec))

(defrecord WebStack [stack]
  component/Lifecycle
  (start [this]
    (assoc this :handler (build-handler this stack)))
  (stop [this]
    (dissoc this :handler)))

(defn new-web-stack
  "Create a new WebStack component. When creating a web stack you pass it a a
  list of tiers, a tier being a map with a :make-handler, and
  optionally :middleware and :using.

  - :make-handler : a function which takes a map of dependencies and returns a
    ring handler

  - :using : Specify which dependencies should be passed to :make-handler.

  - :middleware : a vector of middleware. Each entry is either a function, or a
    vector of function + arguments. The first argument to the middleware is always
    the handler to be wrapped, extra arguments are passed in after that. When an
    argument is of the form ^:using [:foo :bar], then the actual argument passed
    to the middleware will be a map with components :foo and :bar.

  Note that `new-web-stack` takes care of calling `component/using`, based on
  the dependencies of handlers and middleware.

  After starting the system the component will expose a :handler that you can
  plug into to your web server (ring adapter).

  When handling an incoming request this resulting handler will try each tier in
  turn, including each's specific middleware, until it gets a non-nil response.

  Example:

      (defn home-routes [{:keys [db]}]
        (fn [req]
          {:status 200}))

      (defn wrap-zzz [f {:keys [foo bar]}] ,,,)

      (component/system
        :db (new-db ,,,)
        :foo ,,,
        :bar ,,,

        :web-stack
        (new-web-stack [{:make-handler home-routes
                         :middleware [wrap-xxx
                                      [wrap-yyy \"second arg to wrap-yyy\"]
                                      [wrap-zzz ^:using [:foo :bar]]]
                         :using [:db]}
                        {:make-handler more-routes
                         :middleware [wrap-aaa}])

       :jetty
       (component/using (new-web-server) {:handler :web-stack}))
  "
  [stack]
  (component/using
   (->WebStack stack)
   (collect-dependencies stack)))

webstack_test.clj

(ns clj.lambdaisland.components.webstack-test
  (:require [lambdaisland.components.webstack :refer :all]
            [clojure.test :refer :all]
            [lambdaisland.test-util :refer [is=]]
            [com.stuartsierra.component :as component]))

(defn handle-root [_]
  (fn [{:keys [uri query-string]}]
    (if (= uri "/")
      {:status 200
       :body (cond-> "OK /"
               query-string (str "?" query-string))}
      nil)))

(defn handle-webhook [_]
  (fn [{:keys [uri query-string]}]
    (if (= uri "/webhook")
      {:status 200
       :body (cond-> "OK /webhook"
               query-string (str "?" query-string))}
      nil)))

(defn wrap-check-csrf [handler]
  (fn [req]
    (if (get-in req [:headers "authenticity_token"])
      (handler req)
      {:status 403
       :body "Missing CSRF token"})))

(defn wrap-add-query [handler]
  (fn [req]
    (handler (assoc req :query-string "query-string-added"))))

(deftest web-stack-test
  (let [stack (-> [{:make-handler handle-webhook}
                   {:make-handler handle-root
                    :middleware [wrap-check-csrf
                                 wrap-add-query]}]
                  new-web-stack
                  component/start)
        handler (:handler stack)]
    (is= (handler {:uri "/webhook"}) {:status 200, :body "OK /webhook"})
    (is= (handler {:uri "/"}) {:status 403, :body "Missing CSRF token"})))

{:status 200 :body "OK /webhook"}

(deftest stack-tier-handler-test
  (let [component {}
        tier {:make-handler (fn [deps] {:deps deps})
              :middleware []
              :using []}]
    (is= (stack-tier-handler component tier) {:deps {}}))

  (let [component {:db "db"
                   :api "api"
                   :unused "unused"}
        tier {:make-handler (fn [deps] {:deps deps})
              :middleware []
              :using [:db :api]}]
    (is= (stack-tier-handler component tier) {:deps {:db "db" :api "api"}}))

  (let [component {:db "db"
                   :api "api"
                   :unused "unused"}
        tier {:make-handler (fn [deps] {:deps deps})
              :middleware [(fn [x] (assoc x :wrapped true))]
              :using [:db :api]}]
    (is= (stack-tier-handler component tier) {:deps {:db "db" :api "api"}
                                              :wrapped true}))

  (let [component {:db "db"
                   :api "api"
                   :unused "unused"}
        tier {:make-handler (fn [deps] {:deps deps})
              :middleware [(fn [x] (assoc x :wrapped true))
                           (fn [x] (assoc x :wrapped "twice"))]
              :using [:db :api]}]
    (is= (stack-tier-handler component tier) {:deps {:db "db" :api "api"}
                                              :wrapped "twice"})))

(deftest middleware-deps-test
  (is= (middleware-deps "mw1") ())
  (is= (middleware-deps ["mw2" "arg"]) ())
  (is= (middleware-deps ["mw3" ^:using [:foo :bar]]) '(:foo :bar))
  (is= (middleware-deps ["mw3" "arg" ^:using [:foo :bar]]) '(:foo :bar)))

(deftest collect-dependencies-test
  (is= (collect-dependencies [{:using [:foo :bar]}
                              {:middleware ["mw1"
                                            ["mw2" ^:using [:baz]]]}])
       [:baz :bar :foo]))


(deftest inject-middleware-deps-test
  (is= (inject-middleware-deps {:foo "bar"} [{:middleware ["mw1"
                                                           ["mw2" ^:using [:foo]]]}])
       (list {:middleware ["mw1" ["mw2" {:foo "bar"}]]})))