penpot/exporter/src/app/http.cljs

;; This Source Code Form is subject to the terms of the Mozilla Public
;; License, v. 2.0. If a copy of the MPL was not distributed with this
;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
;;
;; Copyright (c) UXBOX Labs SL

(ns app.http
  (:require
   ["cookies" :as Cookies]
   ["http" :as http]
   ["inflation" :as inflate]
   ["raw-body" :as raw-body]
   ["stream" :as stream]
   [app.common.logging :as l]
   [app.common.spec :as us]
   [app.common.transit :as t]
   [app.config :as cf]
   [app.handlers :as handlers]
   [cuerdas.core :as str]
   [lambdaisland.uri :as u]
   [promesa.core :as p]))

(l/set-level! :info)

(defprotocol IStreamableResponseBody
  (write-body! [_ response]))

(extend-protocol IStreamableResponseBody
  string
  (write-body! [data response]
    (.write ^js response data)
    (.end ^js response))

  js/Buffer
  (write-body! [data response]
    (.write ^js response data)
    (.end ^js response))

  stream/Stream
  (write-body! [data response]
    (.pipe ^js data response)
    (.on ^js data "error" (fn [cause]
                            (js/console.error cause)
                            (.end response)))))

(defn- handle-response
  [{:keys [:response/body
           :response/headers
           :response/status
           response]
    :as exchange}]
  (let [status  (or status 200)
        headers (clj->js headers)
        body    (or body "")]
    (.writeHead ^js response status headers)
    (write-body! body response)))

(defn- parse-headers
  [req]
  (let [orig (unchecked-get req "headers")]
    (persistent!
     (reduce #(assoc! %1 (str/lower %2) (unchecked-get orig %2))
             (transient {})
             (js/Object.keys orig)))))

(defn- wrap-body-params
  [handler]
  (let [opts #js {:limit "2mb" :encoding "utf8"}]
    (fn [{:keys [:request/method :request/headers request] :as exchange}]
      (let [ctype (get headers "content-type")]
        (if (= method "post")
          (-> (raw-body (inflate request) opts)
              (p/then (fn [data]
                        (cond-> data
                          (= ctype "application/transit+json")
                          (t/decode-str))))
              (p/then (fn [data]
                        (handler (assoc exchange :request/body-params data)))))
          (handler exchange))))))

(defn- wrap-params
  [handler]
  (fn [{:keys [:request/body-params :request/query-params] :as exchange}]
    (handler (assoc exchange :request/params (merge query-params body-params)))))

(defn- wrap-response-format
  [handler]
  (fn [exchange]
    (p/then
     (handler exchange)
     (fn [{:keys [:response/body :response/status] :as exchange}]
       (cond
         (map? body)
         (let [data (t/encode-str body {:type :json-verbose})]
           (-> exchange
               (assoc :response/body data)
               (assoc :response/status 200)
               (update :response/headers assoc "content-type" "application/transit+json")
               (update :response/headers assoc "content-length" (count data))))

         (and (nil? body)
              (= 200 status))
         (-> exchange
             (assoc :response/body "")
             (assoc :response/status 204)
             (assoc :response/headers {"content-length" 0}))

         :else
         exchange)))))

(defn- wrap-query-params
  [handler]
  (fn [{:keys [:request/uri] :as exchange}]
    (handler (assoc exchange :request/query-params (u/query-string->map (:query uri))))))

(defn- wrap-error
  [handler on-error]
  (fn [exchange]
    (-> (p/do (handler exchange))
        (p/catch (fn [cause] (on-error cause exchange))))))

(defn- wrap-auth
  [handler cookie-name]
  (fn [{:keys [:request/cookies] :as exchange}]
    (let [token (.get ^js cookies cookie-name)]
      (handler (cond-> exchange token (assoc :request/auth-token token))))))

(defn- create-adapter
  [handler]
  (fn [req res]
    (let [cookies  (Cookies. req res)
          headers  (parse-headers req)
          uri      (u/uri (unchecked-get req "url"))
          exchange {:request/method (str/lower (unchecked-get req "method"))
                    :request/path (:path uri)
                    :request/uri uri
                    :request/headers headers
                    :request/cookies cookies
                    :request req
                    :response res}]
      (-> (p/do (handler exchange))
          (p/then handle-response)))))

(defn- create-server
  [handler]
  (.createServer ^js http (create-adapter handler)))

(def instance (atom nil))

(defn init
  []
  (let [handler (-> handlers/handler
                    (wrap-auth "auth-token")
                    (wrap-response-format)
                    (wrap-params)
                    (wrap-query-params)
                    (wrap-body-params)
                    (wrap-error handlers/on-error))
        server  (create-server handler)
        port    (cf/get :http-server-port 6061)]
    (.listen server port)
    (l/info :msg "welcome to penpot"
            :module "exporter"
            :version (:full @cf/version))
    (l/info :msg "starting http server" :port port)
    (reset! instance server)))

(defn stop
  []
  (if-let [server @instance]
    (p/create (fn [resolve]
                (.close server (fn []
                                 (l/info :msg "shutdown http server")
                                 (resolve)))))
    (p/resolved nil)))