;; 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) KALEIDOS INC Sucursal en España SL (ns app.http.middleware (:require [app.common.exceptions :as ex] [app.common.json :as json] [app.common.logging :as l] [app.common.schema :as-alias sm] [app.common.transit :as t] [app.config :as cf] [app.http :as-alias http] [app.http.errors :as errors] [app.tokens :as tokens] [app.util.pointer-map :as pmap] [cuerdas.core :as str] [yetti.adapter :as yt] [yetti.middleware :as ymw] [yetti.request :as yreq] [yetti.response :as yres]) (:import io.undertow.server.RequestTooBigException java.io.InputStream java.io.OutputStream java.security.MessageDigest)) (set! *warn-on-reflection* true) (def server-timing {:name ::server-timing :compile (constantly ymw/wrap-server-timing)}) (def params {:name ::params :compile (constantly ymw/wrap-params)}) (defn- get-reader ^java.io.BufferedReader [request] (let [^InputStream body (yreq/body request)] (java.io.BufferedReader. (java.io.InputStreamReader. body)))) (defn wrap-parse-request [handler] (letfn [(process-request [request] (let [header (yreq/get-header request "content-type")] (cond (str/starts-with? header "application/transit+json") (with-open [^InputStream is (yreq/body request)] (let [params (t/read! (t/reader is))] (-> request (assoc :body-params params) (update :params merge params)))) (str/starts-with? header "application/json") (with-open [reader (get-reader request)] (let [params (json/read reader :key-fn json/read-kebab-key)] (-> request (assoc :body-params params) (update :params merge params)))) :else request))) ;; The specific-exception branches below (IAE, ;; RequestTooBigException, EOFException) raise with ;; `ex/raise` rather than calling `errors/handle` directly. ;; This is intentional: the throw is caught by the ;; top-level error handler in `app.http/router-handler` ;; (`backend/src/app/http.clj`), which routes every ;; uncaught exception through `errors/handle`. The ;; per-route `wrap-errors` middleware in the route list ;; is a defensive layer; correctness does not depend on ;; it. Raising here keeps the cond uniform with the ;; existing RequestTooBigException / EOFException ;; branches. (handle-error [cause request] (cond (instance? IllegalArgumentException cause) (ex/raise :type :validation :code :malformed-json :hint (ex-message cause) :cause cause) (instance? RequestTooBigException cause) (ex/raise :type :validation :code :request-body-too-large :hint (ex-message cause)) (instance? java.io.EOFException cause) (ex/raise :type :validation :code :malformed-json :hint (ex-message cause) :cause cause) (instance? RuntimeException cause) (if-let [cause (ex-cause cause)] (handle-error cause request) (errors/handle cause request)) :else (errors/handle cause request)))] (fn [request] (if (= (yreq/method request) :post) (try (-> request process-request handler) (catch Throwable cause (handle-error cause request))) (handler request))))) (def parse-request {:name ::parse-request :compile (constantly wrap-parse-request)}) (defn buffered-output-stream "Returns a buffered output stream that ignores flush calls. This is needed because transit-java calls flush very aggresivelly on each object write." [^java.io.OutputStream os ^long chunk-size] (yetti.util.BufferedOutputStream. os (int chunk-size))) (def ^:const buffer-size (:xnio/buffer-size yt/defaults)) (defn- write-json-value [_ val] (if (pmap/pointer-map? val) [(pmap/get-id val) (meta val)] val)) (defn wrap-format-response [handler] (letfn [(transit-streamable-body [data opts _ output-stream] (try (with-open [^OutputStream bos (buffered-output-stream output-stream buffer-size)] (let [tw (t/writer bos opts)] (t/write! tw data))) (catch java.io.IOException _) (catch Throwable cause (binding [l/*context* {:value data}] (l/error :hint "unexpected error on encoding response" :cause cause))) (finally (.close ^OutputStream output-stream)))) (json-streamable-body [data _ output-stream] (try (let [encode (or (-> data meta :encode/json) identity) data (encode data)] (with-open [^OutputStream bos (buffered-output-stream output-stream buffer-size)] (with-open [^java.io.OutputStreamWriter writer (java.io.OutputStreamWriter. bos)] (json/write writer data :key-fn json/write-camel-key :value-fn write-json-value)))) (catch java.io.IOException _) (catch Throwable cause (binding [l/*context* {:value data}] (l/error :hint "unexpected error on encoding response" :cause cause))) (finally (.close ^OutputStream output-stream)))) (format-response-with-json [response _] (let [body (::yres/body response)] (if (or (boolean? body) (coll? body)) (-> response (update ::yres/headers assoc "content-type" "application/json") (assoc ::yres/body (yres/stream-body (partial json-streamable-body body)))) response))) (format-response-with-transit [response request] (let [body (::yres/body response)] (if (or (boolean? body) (coll? body)) (let [qs (yreq/query request) opts (if (or (contains? cf/flags :transit-readable-response) (str/includes? qs "transit_verbose")) {:type :json-verbose} {:type :json})] (-> response (update ::yres/headers assoc "content-type" "application/transit+json") (assoc ::yres/body (yres/stream-body (partial transit-streamable-body body opts))))) response))) (format-from-params [{:keys [query-params] :as request}] (and (= "json" (get query-params :_fmt)) "application/json")) (format-response [response request] (let [accept (or (format-from-params request) (yreq/get-header request "accept"))] (cond (or (= accept "application/transit+json") (str/includes? accept "application/transit+json")) (format-response-with-transit response request) (or (= accept "application/json") (str/includes? accept "application/json")) (format-response-with-json response request) :else (format-response-with-transit response request)))) (process-response [response request] (cond-> response (map? response) (format-response request)))] (fn [request] (let [response (handler request)] (process-response response request))))) (def format-response {:name ::format-response :compile (constantly wrap-format-response)}) (defn wrap-errors [handler on-error] (fn [request] (try (handler request) (catch Throwable cause (on-error cause request))))) (def errors {:name ::errors :compile (constantly wrap-errors)}) (defn- with-cors-headers "Build CORS response headers. Only emits permissive headers when the request `origin` is present on the configured `allowed` allowlist; otherwise returns the headers unchanged except for `Vary: Origin` so shared caches don't leak per-origin responses." [headers origin allowed] (cond-> (assoc headers "vary" "Origin") (and (some? origin) (contains? allowed origin)) (-> (assoc "access-control-allow-origin" origin) (assoc "access-control-allow-credentials" "true") (assoc "access-control-allow-methods" "GET,POST,DELETE,OPTIONS,PUT,HEAD,PATCH") (assoc "access-control-expose-headers" "content-type") (assoc "access-control-allow-headers" "x-frontend-version, x-client, content-type, accept")))) (defn wrap-cors [handler allowed] (fn [request] (let [response (if (= (yreq/method request) :options) {::yres/status 204} (handler request)) origin (yreq/get-header request "origin")] (update response ::yres/headers with-cors-headers origin allowed)))) (def cors {:name ::cors :compile (fn [& _] (when (contains? cf/flags :cors) (let [allowed (not-empty (cf/get :allowed-origins))] (if allowed (fn [handler] (wrap-cors handler allowed)) (do (l/wrn :hint (str "cors flag is enabled but :allowed-origins is empty; " "CORS middleware disabled (fail-closed). " "Configure PENPOT_ALLOWED_ORIGINS with a comma-separated list of trusted origins.")) nil)))))}) (def restrict-methods {:name ::restrict-methods :compile (fn [data _] (when-let [allowed (:allowed-methods data)] (fn [handler] (fn [request] (let [method (yreq/method request)] (if (contains? allowed method) (handler request) {::yres/status 405}))))))}) (defn- wrap-auth [handler decoders] (let [token-re #"(?i)^(Token|Bearer)\s+(.*)" get-token-from-authorization (fn [request] (when-let [[_ token-type token] (some->> (yreq/get-header request "authorization") (re-matches token-re))] (if (= "token" (str/lower token-type)) {:type :token :token token} {:type :bearer :token token}))) get-token-from-cookie (fn [request] (let [cname (cf/get :auth-token-cookie-name) token (some-> (yreq/get-cookie request cname) :value)] (when-not (str/empty? token) {:type :cookie :token token}))) get-token (some-fn get-token-from-cookie get-token-from-authorization) process-request (fn [request] (if-let [{:keys [type token] :as auth} (get-token request)] (let [decode-fn (get decoders type)] (if (or (= type :cookie) (= type :bearer)) (let [metadata (tokens/decode-header token)] ;; NOTE: we only proceed to decode claims on new ;; cookie tokens. The old cookies dont need to be ;; decoded because they use the token string as ID (if (and (= (:kid metadata) 1) (= (:ver metadata) 1) (some? decode-fn)) (assoc request ::http/auth-data (assoc auth :claims (decode-fn token) :metadata metadata)) (assoc request ::http/auth-data (assoc auth :metadata {:ver 0})))) (if decode-fn (assoc request ::http/auth-data (assoc auth :claims (decode-fn token))) (assoc request ::http/auth-data auth)))) request))] (fn [request] (-> request process-request handler)))) (def auth {:name ::auth :compile (constantly wrap-auth)}) (defn- constant-time-eq? "Compare strings in constant time to prevent timing attacks." [^String a ^String b] (MessageDigest/isEqual (.getBytes a "UTF-8") (.getBytes b "UTF-8"))) (defn- wrap-shared-key-auth [handler keys] (if (seq keys) (fn [request] (if-let [[key-id key] (some-> (yreq/get-header request "x-shared-key") (str/split #"\s+" 2))] (let [key-id (-> key-id str/lower keyword)] (if (and (string? key) (contains? keys key-id) (constant-time-eq? key (get keys key-id))) (-> request (assoc ::http/auth-key-id key-id) (handler)) {::yres/status 403})) {::yres/status 403})) (fn [_ _] {::yres/status 403}))) (def shared-key-auth {:name ::shared-key-auth :compile (constantly wrap-shared-key-auth)})