(ns auto-ap.ssr.utils (:require [auto-ap.datomic :refer [all-schema conn]] [auto-ap.logging :as alog] [clojure.string :as str] [config.core :refer [env]] [datomic.api :as dc] [hiccup2.core :as hiccup] [malli.core :as mc] [malli.error :as me] [malli.transform :as mt2] [slingshot.slingshot :refer [throw+ try+]])) (defn html-response [hiccup & {:keys [status headers oob] :or {status 200 headers {} oob []}}] {:status status :headers (into {"Content-Type" "text/html"} headers) :body (str (hiccup/html {} hiccup) "\n" (str/join "\n" (map (fn [o] (hiccup/html {} o)) oob)))}) (defn modal-response [hiccup & {:as opts}] (apply html-response (into [hiccup] (mapcat identity (-> opts (assoc-in [:headers "hx-trigger"] "modalopen") (assoc-in [:headers "hx-retarget"] "#modal-content") (assoc-in [:headers "hx-reswap"] "innerHTML")))))) (defn next-step-modal-response [hiccup & {:as opts}] (apply html-response (into [hiccup] (mapcat identity (-> opts (assoc-in [:headers "hx-retarget"] "#modal-content") (assoc-in [:headers "hx-reswap"] "innerHTML")))))) (defn form-data->map [form-data] (reduce-kv (fn [acc k v] (cond (and (string? v) (empty? v)) acc :else (assoc-in acc (->> (str/split k #"_") (mapv #(apply keyword (str/split % #"/")))) v))) {} form-data)) (defn path->name [k] (cond (keyword? k) (str (namespace k) "/" (name k)) (seq k) (str/join "_" (map path->name k)) :else k)) (defn forced-vector [x] [:vector {:decode/json {:enter (fn [x] (if (sequential? x) x [x]))}} x]) (defn empty->nil [v] (if (and (string? v) (clojure.string/blank? v)) nil v)) (defn parse-empty-as-nil [] (mt2/transformer {:decoders {:map (fn [m] (if (not (seq (filter identity (vals m)))) nil m)) :string empty->nil :double empty->nil :int empty->nil :long empty->nil 'nat-int? empty->nil}})) (def entity-id (mc/schema [nat-int? {:error/message "required" :decode/arbitrary (fn [e] (if (and (map? e) (:db/id e)) (:db/id e) e))}])) (def temp-id (mc/schema [:string {:min 1}])) (def money (mc/schema [:double])) (def percentage (mc/schema [:double {:decode/string {:enter (fn [x] (if (and (string? x) (re-find #"^\d+(\.\d+)?$" x)) (-> x (Double/parseDouble) (* 0.01)) x))} :max 1.0 :error/message "1-100"}])) (def regex (mc/schema [:fn {:error/message "not a regex"} (fn check-regx [x] (try (and (string? x) (. java.util.regex.Pattern (compile x java.util.regex.Pattern/CASE_INSENSITIVE))) true (catch Exception _ false)))])) (def map->db-id-decoder {:enter (fn [x] (if (sequential? x) x (into [] (for [[k v] (sort-by (comp #(Long/parseLong %) name first) x)] v))))}) (defn many-entity [params & keys] (mc/schema [:vector (merge params {:decode/json map->db-id-decoder :decode/arbitrary (fn [x] (if (sequential? x) x [x]))}) (into [:map] keys)])) (defn str->keyword [s] (if (string? s) (let [[ns k] (str/split s #"/")] (if (and ns k) (keyword ns k) (keyword s))) s)) (defn keyword->str [k] (subs (str k) 1)) ;; TODO make this bubble the form data automatically (defn field-validation-error [m path & {:as data}] (throw+ (ex-info m (merge data {:type :field-validation :form-errors (assoc-in {} path [m])})))) (defn form-validation-error [m & {:as data}] (throw+ (ex-info m (merge data {:type :form-validation :form-validation-errors [m]})))) (def main-transformer (mt2/transformer parse-empty-as-nil (mt2/key-transformer {:encode keyword->str :decode str->keyword}) mt2/string-transformer mt2/json-transformer (mt2/transformer {:name :arbitrary}) mt2/default-value-transformer)) (defn strip [s] (cond (and (string? s) (str/blank? s)) nil (string? s) (str/trim s) :else s)) (defn assert-schema [schema entity] (when-not (mc/validate schema entity) (throw (ex-info #_(->> (-> (mc/explain schema entity) (me/humanize {:errors (assoc me/default-errors ::mc/missing-key {:error/message {:en "required"}})})) (map (fn [[k v]] (str (if (keyword? k) (name k) k) ": " (str/join ", " v)))) (str/join ", ")) "validation failed" {:type :schema-validation :decoded entity :error {:explain (mc/explain schema entity)}})))) (defn schema-enforce-request [{:keys [form-params query-params params] :as request} & {:keys [form-schema query-schema route-schema params-schema]}] (let [request (try (cond-> request (and (:params request) params-schema) (assoc :params (mc/coerce params-schema (:params request) main-transformer)) (and (:route-params request) route-schema) (assoc :route-params (mc/coerce route-schema (:route-params request) main-transformer)) (and form-schema form-params) (assoc :form-params (mc/coerce form-schema form-params main-transformer)) (and query-schema query-params) (assoc :query-params (mc/coerce query-schema query-params main-transformer))) (catch Exception e (alog/warn ::validation-error :error e) (throw (ex-info (->> (-> e (ex-data) :data :explain (me/humanize {:errors (assoc me/default-errors ::mc/missing-key {:error/message {:en "required"}})})) (map (fn [[k v]] (str (if (keyword? k) (name k) k) ": " (str/join ", " v)))) (str/join ", ")) {:type :schema-validation :decoded (:value (:data (ex-data e))) :error (:data (ex-data e))}))))] request)) (defn wrap-schema-enforce [handler & {:keys [form-schema query-schema route-schema params-schema]}] (fn [request] (handler (schema-enforce-request request :form-schema form-schema :query-schema query-schema :route-schema route-schema :params-schema params-schema)))) (defn schema-decode-request [{:keys [form-params query-params params] :as request} & {:keys [form-schema query-schema route-schema params-schema]}] (let [request (cond-> request (and (:params request) params-schema) (assoc :params (mc/decode params-schema (:params request) main-transformer)) (and (:route-params request) route-schema) (assoc :route-params (mc/decode route-schema (:route-params request) main-transformer)) (and form-schema form-params) (assoc :form-params (mc/decode form-schema form-params main-transformer)) (and query-schema query-params) (assoc :query-params (mc/decode query-schema query-params main-transformer)))] request)) (defn wrap-schema-decode [handler & {:keys [form-schema query-schema route-schema params-schema]}] (fn [request] (handler (schema-decode-request request :form-schema form-schema :query-schema query-schema :route-schema route-schema :params-schema params-schema)))) (defn ref->enum-schema [n] (into [:enum {:decode/string #(if (keyword? %) % (when (not-empty %) (keyword n %)))}] (for [{:db/keys [ident]} (all-schema) :when (= n (namespace ident))] ident))) (defn ref->select-options [n & {:keys [allow-nil?]}] (into (if allow-nil? [["" ""]] []) (for [{:db/keys [ident]} (all-schema) :when (= n (namespace ident))] [(name ident) (str/replace (str/capitalize (name ident)) "-" " ")]))) (defn ref->radio-options [n & {:keys [allow-nil?]}] (into (if allow-nil? [{:value nil :content ""}] []) (for [{:db/keys [ident]} (all-schema) :when (= n (namespace ident))] {:value (name ident) :content (str/replace (str/capitalize (name ident)) "-" " ")}))) (defn wrap-form-4xx-2 [handler form-handler] (fn [request] (try+ (handler request) (catch [:type :schema-validation] e (let [humanized (-> e :error :explain (me/humanize {:errors (assoc me/default-errors ::mc/missing-key {:error/message {:en "required"}})})) errors (map (fn [e] {:path (:in e) :message (get-in humanized (:in e))}) (:errors (:explain (:error e))))] (alog/warn ::form-4xx :errors errors) (form-handler (assoc request :form-params (:decoded e) :field-validation-errors errors :form-errors humanized))) #_(html-response [:span.error-content.text-red-500 (:message &throw-context)] :status 400)) (catch [:type :field-validation] e (form-handler (assoc request :form-params (:form e) :form-errors (:form-errors e)))) (catch [:type :form-validation] e (form-handler (assoc request :form-params (:form e) :form-validation-errors (:form-validation-errors e) :form-errors {:errors (:form-validation-errors e)})))))) (defn apply-middleware-to-all-handlers [key->handler f] (->> key->handler (reduce (fn [key-handler [k v]] (assoc key-handler k (f v))) key->handler))) (defn path->name2 [k & rest] (let [k->n (fn [k] (if (keyword? k) (str (when (namespace k) (str (namespace k) "/")) (name k)) k))] (str (k->n k) (str/join "" (map (fn [k] (str "[" (k->n k) "]")) rest))))) (defn wrap-entity [handler path read] (fn wrap-entity-request [request] (let [entity (some->> (get-in request path) (#(if (string? %) (Long/parseLong %) %)) (dc/pull (dc/db conn) read))] (handler (if entity (assoc request :entity entity) request)))))