Handler should take clj body w/ optional headers & env as context

.github/workflows/faas_fn_build_invoke.yml

@@ -52,9 +52,13 @@ jobs:
               exit 3
           fi
           docker run -i ghcr.io/${{ github.repository_owner }}/bb-streaming-lib:latest function/handler-test.clj
-          (docker stop bb-http-hello || exit 0)
-          (docker rm bb-http-hello || exit 0)
-          docker run -d --name bb-http-hello ghcr.io/${{ github.repository_owner }}/bb-http-hello:latest ./index.clj
-          if [ "$(docker exec bb-http-hello curl -X POST --data-raw "world" --retry 3 --retry-delay 2 --retry-connrefused http://127.0.0.1:8082)" != "Hello, world" ]; then
+          (docker stop bb-http || exit 0)
+          (docker rm bb-http || exit 0)
+          docker run -d --name bb-http ghcr.io/${{ github.repository_owner }}/bb-http:latest ./index.clj
+          if [ "$(docker exec bb-http curl -X POST --data-raw "world" --retry 3 --retry-delay 2 --retry-connrefused http://127.0.0.1:8082)" != "Hello, world" ]; then
             exit 5
           fi
+          # 1. one arg: text -> text, string with environment var
+          # 2. two args: json -> json, update map with header
+          #   2.1. keywords=false
+          #   2.2. keywords=true

examples/http/bb-map/bb.edn

@@ -0,0 +1 @@
+{:paths ["."]}

examples/http/bb-map/handler.clj

@@ -0,0 +1,6 @@
+(ns function.handler)
+
+(defn handler [content context]
+  (println "content" content)
+  (println "context" context)
+  (update content :bar str "spam"))

examples/stack.yml

@@ -15,3 +15,9 @@ functions:
     lang: bb
     handler: ./http/bb-hello
     image: ${DOCKER_REGISTRY_IMG_ORG_PATH}/bb-http-hello
+  bb-http-map:
+    lang: bb
+    handler: ./http/bb-map
+    image: ${DOCKER_REGISTRY_IMG_ORG_PATH}/bb-http-map
+    environment:
+      keywords: true

template/bb/Dockerfile

@@ -19,6 +19,7 @@ USER app
 WORKDIR $HOME
 
 COPY index.clj function/bb.edn ./
+COPY ring ./ring
 COPY function function
 
 RUN bb prepare

template/bb/bb.edn

@@ -0,0 +1,4 @@
+{:paths ["."]
+ :deps {eg/eg {:mvn/version "0.5.6-alpha"}
+        tortue/spy {:mvn/version "2.14.0"}
+        plumula/mimolette {:mvn/version "0.2.1"}}}

template/bb/index.clj

@@ -1,9 +1,57 @@
-#!/usr/bin/env bb
+(ns index
+  (:require
+    [function.handler :as function]
+    [org.httpkit.server :refer [run-server]]
+    [ring.middleware.json :as json-middleware]
+    ;[spy.core :refer [spy]]
+    [clojure.walk :refer [keywordize-keys]]
+    [clojure.string :as str :refer [lower-case]]
+    [clojure.edn :as edn]))
 
-(require
-  '[function.handler :as function]
-  '[org.httpkit.server :refer [run-server]])
+(defn read-string [s]
+  (try (edn/read-string s)
+    (catch Exception _
+      s)))
 
-(run-server function/handler {:port 8082})
+(defn keywords? [env-val]
+  (if-some [keywords (edn/read-string env-val)]
+    keywords
+    true))
 
-@(promise)
+(defn ->kebab-case [s]
+  (lower-case (str/replace s #"_" "-")))
+
+(def fn-arg-cnt (comp count first :arglists meta))
+
+(defn format-context [m]
+  (->> m
+    (map (fn [[k v]] [(->kebab-case k) (read-string v)]))
+    (into {})
+    (keywordize-keys)))
+
+(defn ->context [{:keys [headers]} env]
+  {:headers (format-context headers)
+   :env (format-context env)})
+
+(def response {:status 200})
+
+(defn ->handler [f env]
+  (fn [request]
+    (let [faas-fn (case (fn-arg-cnt f)
+                    1 (comp function/handler :body)
+                    2 #(function/handler (:body %)
+                                         (->context (:headers %) env)))]
+      (println "request" request)
+      ; TODO replace {} with request, but need to remove troublesome keys
+      (merge (assoc {} :body (faas-fn request))
+             response))))
+
+(defn ->app [f env]
+  (-> (->handler f env)
+    (json-middleware/wrap-json-body {:keywords? (keywords? (get env "keywords"))})
+    (json-middleware/wrap-json-response)))
+
+(defn -main []
+  (run-server (->app #'function/handler (System/getenv))
+              {:port 8082})
+  @(promise))

template/bb/ring/middleware/json.clj

@@ -0,0 +1,170 @@
+(ns ring.middleware.json
+  "Ring middleware for parsing JSON requests and generating JSON responses."
+  (:require [cheshire.core :as json]
+            [clojure.java.io :as io])
+  (:import [java.io InputStream]))
+
+(def ^{:doc "HTTP token: 1*<any CHAR except CTLs or tspecials>. See RFC2068"}
+  re-token
+  #"[!#$%&'*\-+.0-9A-Z\^_`a-z\|~]+")
+
+(def ^{:doc "HTTP quoted-string: <\"> *<any TEXT except \"> <\">. See RFC2068."}
+  re-quoted
+  #"\"((?:\\\"|[^\"])*)\"")
+
+(def ^{:doc "HTTP value: token | quoted-string. See RFC2109"}
+  re-value
+  (str "(" re-token ")|" re-quoted))
+
+(def ^{:doc "Pattern for pulling the charset out of the content-type header"}
+  re-charset
+  (re-pattern (str ";(?:.*\\s)?(?i:charset)=(?:" re-value ")\\s*(?:;|$)")))
+
+(defn find-content-type-charset
+  "Return the charset of a given a content-type string."
+  [s]
+  (when-let [m (re-find re-charset s)]
+    (or (m 1) (m 2))))
+
+(defn character-encoding
+  "Return the character encoding for the request, or nil if it is not set."
+  [request]
+  (some-> (get-in request [:headers "content-type"])
+          find-content-type-charset))
+
+(defn header
+  "Returns an updated Ring response with the specified header added."
+  [resp name value]
+  (assoc-in resp [:headers name] (str value)))
+
+(defn content-type
+  "Returns an updated Ring response with the a Content-Type header corresponding
+  to the given content-type."
+  [resp content-type]
+  (header resp "Content-Type" content-type))
+
+(defn- json-request? [request]
+  (if-let [type (get-in request [:headers "content-type"])]
+    (not (empty? (re-find #"^application/(.+\+)?json" type)))))
+
+(defn- read-json [request & [{:keys [keywords? key-fn]}]]
+  (if (json-request? request)
+    (if-let [^InputStream body (:body request)]
+      (let [^String encoding (or (character-encoding request)
+                                 "UTF-8")
+            body-reader (java.io.InputStreamReader. body encoding)]
+        (try
+          [true (json/parse-stream body-reader (or key-fn keywords?))]
+          (catch Exception ex
+            (println "Error parsing json stream")
+            [false nil]))))))
+
+(def ^{:doc "The default response to return when a JSON request is malformed."}
+  default-malformed-response
+  {:status  400
+   :headers {"Content-Type" "text/plain"}
+   :body    "Malformed JSON in request body."})
+
+(defn json-body-request
+  "Parse a JSON request body and assoc it back into the :body key. Returns nil
+  if the JSON is malformed. See: wrap-json-body."
+  [request options]
+  (if-let [[valid? json] (read-json request options)]
+    (if valid? (assoc request :body json))
+    request))
+
+(defn wrap-json-body
+  "Middleware that parses the body of JSON request maps, and replaces the :body
+  key with the parsed data structure. Requests without a JSON content type are
+  unaffected.
+
+  Accepts the following options:
+
+  :key-fn             - function that will be applied to each key
+  :keywords?          - true if the keys of maps should be turned into keywords
+  :bigdecimals?       - true if BigDecimals should be used instead of Doubles
+  :malformed-response - a response map to return when the JSON is malformed"
+  {:arglists '([handler] [handler options])}
+  [handler & [{:keys [malformed-response]
+               :or {malformed-response default-malformed-response}
+               :as options}]]
+  (fn
+    ([request]
+     (if-let [request (json-body-request request options)]
+       (handler request)
+       malformed-response))
+    ([request respond raise]
+     (if-let [request (json-body-request request options)]
+       (handler request respond raise)
+       (respond malformed-response)))))
+
+(defn- assoc-json-params [request json]
+  (if (map? json)
+    (-> request
+        (assoc :json-params json)
+        (update-in [:params] merge json))
+    request))
+
+(defn json-params-request
+  "Parse the body of JSON requests into a map of parameters, which are added
+  to the request map on the :json-params and :params keys. Returns nil if the
+  JSON is malformed. See: wrap-json-params."
+  [request options]
+  (if-let [[valid? json] (read-json request options)]
+    (if valid? (assoc-json-params request json))
+    request))
+
+(defn wrap-json-params
+  "Middleware that parses the body of JSON requests into a map of parameters,
+  which are added to the request map on the :json-params and :params keys.
+
+  Accepts the following options:
+
+  :key-fn             - function that will be applied to each key
+  :bigdecimals?       - true if BigDecimals should be used instead of Doubles
+  :malformed-response - a response map to return when the JSON is malformed
+
+  Use the standard Ring middleware, ring.middleware.keyword-params, to
+  convert the parameters into keywords."
+  {:arglists '([handler] [handler options])}
+  [handler & [{:keys [malformed-response]
+               :or {malformed-response default-malformed-response}
+               :as options}]]
+  (fn
+    ([request]
+     (if-let [request (json-params-request request options)]
+       (handler request)
+       malformed-response))
+    ([request respond raise]
+     (if-let [request (json-params-request request options)]
+       (handler request respond raise)
+       (respond malformed-response)))))
+
+(defn json-response
+  "Converts responses with a map or a vector for a body into a JSON response.
+  See: wrap-json-response."
+  [response options]
+  (if (coll? (:body response))
+    (let [json-resp (update-in response [:body] json/generate-string options)]
+      (if (contains? (:headers response) "Content-Type")
+        json-resp
+        (content-type json-resp "application/json; charset=utf-8")))
+    response))
+
+(defn wrap-json-response
+  "Middleware that converts responses with a map or a vector for a body into a
+  JSON response.
+
+  Accepts the following options:
+
+  :key-fn            - function that will be applied to each key
+  :pretty            - true if the JSON should be pretty-printed
+  :escape-non-ascii  - true if non-ASCII characters should be escaped with \\u
+  :stream?           - true to create JSON body as stream rather than string"
+  {:arglists '([handler] [handler options])}
+  [handler & [{:as options}]]
+  (fn
+    ([request]
+     (json-response (handler request) options))
+    ([request respond raise]
+     (handler request (fn [response] (respond (json-response response options))) raise))))

template/bb/template.yml

@@ -1,4 +1,4 @@
 language: bb
-fprocess: ./index.clj
+fprocess: bb --main index
 welcome_message: |
-  You have created a new Function which uses Babashka
+  You have created a new HTTP Function which uses Babashka

template/bb/tests.clj

@@ -0,0 +1,79 @@
+(ns tests
+  (:require
+    [index]
+    [clojure.test :refer [deftest is run-tests]]
+    [clojure.spec.alpha :as spec]
+    [clojure.spec.test.alpha :as spec-test]
+    [eg :refer [eg]]
+    [plumula.mimolette.alpha :refer [defspec-test]]))
+
+;(deftest foo-test
+;  (is (= )))
+;(spec/def ::keywords? (nilable #{true false}))
+;(spec/def ::response (map-of keyword? string?))
+; fn-arg-cnt:  (-> #'function/handler (meta) :arglists (first) (count))
+
+(spec/def :str/headers (spec/map-of string? string?))
+(eg :str/headers {"foo" "bar"})
+(spec/def :edn/headers (spec/map-of keyword? any?))
+(eg :edn/headers {:foo 3})
+
+(spec/def ::body (spec/map-of (spec/or :kw keyword? :str string?) any?))
+(eg ::body {"foo" "bar"})
+(eg ::body {:foo "bar"})
+
+(spec/def :str/env (spec/map-of string? string?))
+(eg :str/env {"foo" "bar"})
+(spec/def :edn/env (spec/map-of keyword? any?))
+(eg :edn/env {:foo "bar"})
+
+(spec/def ::request (spec/keys :req-un [:str/headers ::body]))
+(eg ::request {:headers {"foo" "bar"}
+               :body {"foo" "bar"}})
+
+(spec/def ::response (spec/keys :req-un [:kw/headers ::body]))
+(eg ::response {:headers {:foo "bar"}
+                :body {:foo "bar"}})
+
+(spec/def ::handler #{identity #(conj [%1] %2)})
+
+(spec/fdef index/read-string
+  :args (spec/cat :str string?)
+  :ret any?)
+
+(spec/fdef index/keywords?
+  :args (spec/cat :str (spec/nilable #{"true" "false"}))
+  :ret boolean?)
+
+(eg index/read-string
+  "0A" => "0A"
+  "0"  => 0)
+
+(spec/fdef index/->kebab-case
+  :args (spec/cat :str string?)
+  :ret string?)
+
+(spec/fdef index/format-context
+  :args (spec/cat :context-map (spec/map-of string? string?))
+  :ret (spec/map-of keyword? any?))
+
+(spec/fdef index/->context
+  :args (spec/cat :request :str/headers
+                  :env :edn/env)
+  :ret (spec/keys :req-un [:edn/headers :edn/env]))
+
+(spec/fdef index/->handler
+  :args (spec/cat :fn ::handler
+                  :env :str/env)
+  :ret fn?)
+
+(spec/fdef index/->app
+  :args (spec/cat :fn ::handler
+                  :env :str/env)
+  :ret fn?)
+
+; ring tests
+
+(defspec-test spec-check-index (spec-test/enumerate-namespace 'index))
+
+(clojure.test/run-tests 'tests)