migrates accounts to new dialog, adds client search to user

This commit is contained in:
2023-10-17 10:14:02 -07:00
parent 3d9d02f76a
commit 346ece787a
10 changed files with 302 additions and 124 deletions

View File

@@ -147,7 +147,7 @@
[com.bhauman/rebel-readline-cljs "0.1.4" :exclusions [org.clojure/clojurescript]] [com.bhauman/rebel-readline-cljs "0.1.4" :exclusions [org.clojure/clojurescript]]
[javax.servlet/servlet-api "2.5"]] [javax.servlet/servlet-api "2.5"]]
:plugins [[lein-pdo "0.1.1"]] :plugins [[lein-pdo "0.1.1"]]
:jvm-opts ["-Dconfig=config/dev.edn" "-Dlogback.configurationFile=logback.xml" "-Xms4G" "-Xmx20G" ]} :jvm-opts ["-Dconfig=config/dev.edn" "-Dlogback.configurationFile=logback.xml" "-Xms4G" "-Xmx20G" "-XX:-OmitStackTraceInFastThrow" ]}
:uberjar :uberjar
{:java-cmd "/usr/lib/jvm/java-11-openjdk/bin/java" {:java-cmd "/usr/lib/jvm/java-11-openjdk/bin/java"

View File

@@ -84,7 +84,7 @@
(merge auth/match->handler) (merge auth/match->handler)
(merge invoices/match->handler) (merge invoices/match->handler)
(merge exports/match->handler) (merge exports/match->handler)
(merge (merge
(into {} (into {}
(map (map

View File

@@ -16,24 +16,26 @@
[auto-ap.ssr-routes :as ssr-routes] [auto-ap.ssr-routes :as ssr-routes]
[auto-ap.ssr.components :as com] [auto-ap.ssr.components :as com]
[auto-ap.ssr.grid-page-helper :as helper] [auto-ap.ssr.grid-page-helper :as helper]
[auto-ap.ssr.nested-form-params :refer [wrap-nested-form-params]]
[auto-ap.ssr.svg :as svg] [auto-ap.ssr.svg :as svg]
[auto-ap.ssr.utils [auto-ap.ssr.utils
:refer [entity-id :refer [apply-middleware-to-all-handlers
entity-id
forced-vector forced-vector
html-response html-response
map->db-id-decoder map->db-id-decoder
ref->enum-schema ref->enum-schema
ref->select-options ref->select-options
temp-id temp-id
validation-error
wrap-form-4xx
wrap-schema-decode]] wrap-schema-decode]]
[bidi.bidi :as bidi] [bidi.bidi :as bidi]
[clojure.string :as str] [clojure.string :as str]
[datomic.api :as dc] [datomic.api :as dc]
[hiccup2.core :as hiccup] [hiccup2.core :as hiccup]
[malli.core :as mc] [malli.core :as mc]))
[ring.middleware.nested-params :refer [wrap-nested-params]]))
;; TODO support for new account
(defn filters [request] (defn filters [request]
[:form {"hx-trigger" "change delay:500ms, keyup changed from:.hot-filter delay:1000ms" [:form {"hx-trigger" "change delay:500ms, keyup changed from:.hot-filter delay:1000ms"
"hx-get" (bidi/path-for ssr-routes/only-routes "hx-get" (bidi/path-for ssr-routes/only-routes
@@ -80,7 +82,6 @@
(:sort query-params) (add-sorter-fields {"name" ['[?e :account/name ?n] (:sort query-params) (add-sorter-fields {"name" ['[?e :account/name ?n]
'[(clojure.string/upper-case ?n) ?sort-name]] '[(clojure.string/upper-case ?n) ?sort-name]]
"code" ['[(get-else $ ?e :account/numeric-code 0) ?sort-code]] "code" ['[(get-else $ ?e :account/numeric-code 0) ?sort-code]]
"type" ['[?e :account/type ?t] "type" ['[?e :account/type ?t]
'[?t :db/ident ?ti] '[?t :db/ident ?ti]
'[(name ?ti) ?sort-type]]} '[(name ?ti) ?sort-type]]}
@@ -104,7 +105,6 @@
(merge-query {:query {:find ['?sort-default '?e] (merge-query {:query {:find ['?sort-default '?e]
:where ['[?e :account/code ?un] :where ['[?e :account/code ?un]
'[(clojure.string/upper-case ?un) ?sort-default]]}}))] '[(clojure.string/upper-case ?un) ?sort-default]]}}))]
(cond->> (query2 query) (cond->> (query2 query)
true (apply-sort-3 query-params) true (apply-sort-3 query-params)
true (apply-pagination query-params)))) true (apply-pagination query-params))))
@@ -132,10 +132,17 @@
:parse-query-params (comp :parse-query-params (comp
(query-params/parse-key :code query-params/parse-long) (query-params/parse-key :code query-params/parse-long)
(helper/default-parse-query-params grid-page)) (helper/default-parse-query-params grid-page))
:action-buttons (fn [request]
[(com/button {:hx-get (str (bidi/path-for ssr-routes/only-routes
:admin-account-new-dialog))
:hx-target "#modal-holder"
:hx-swap "outerHTML"
:color :primary}
"New Account")])
:row-buttons (fn [request entity] :row-buttons (fn [request entity]
[(com/icon-button {:hx-get (str (bidi/path-for ssr-routes/only-routes [(com/icon-button {:hx-get (str (bidi/path-for ssr-routes/only-routes
:admin-account-edit-dialog :admin-account-edit-dialog
:db/id (doto (:db/id entity) println))) :db/id (:db/id entity)))
:hx-target "#modal-holder" :hx-target "#modal-holder"
:hx-swap "outerHTML"} :hx-swap "outerHTML"}
svg/pencil)]) svg/pencil)])
@@ -153,7 +160,6 @@
:name "Code" :name "Code"
:sort-key "code" :sort-key "code"
:render :account/numeric-code} :render :account/numeric-code}
{:key "name" {:key "name"
:name "Name" :name "Name"
:sort-key "name" :sort-key "name"
@@ -170,11 +176,18 @@
(def row* (partial helper/row* grid-page)) (def row* (partial helper/row* grid-page))
(def table* (partial helper/table* grid-page)) (def table* (partial helper/table* grid-page))
(defn account-edit-save [{:keys [params route-params] :as request}] (defn account-save [{:keys [form-params request-method] :as request}]
(let [_ (audit-transact [[:upsert-entity (-> params (assoc :db/id (:db/id route-params)) (dissoc :id))]] (let [entity (cond-> form-params
(:identity request)) (= :post request-method) (assoc :db/id "new"))
updated-account (some-> route-params :db/id (#(dc/pull (dc/db conn) default-read %)))] _ (cond (= :post request-method)
(when-let [extant (seq (dc/q '[:find ?x :in $ ?nc :where [?x :account/numeric-code ?nc]] (dc/db conn) (:account/numeric-code entity)))]
(validation-error (format "The code %d is already in use." (:account/numeric-code entity)))))
{:keys [tempids]} (audit-transact [[:upsert-entity (cond-> entity
(:account/numeric-code entity) (assoc :account/code (str (:account/numeric-code entity))))]]
(:identity request))
updated-account (dc/pull (dc/db conn)
default-read
(or (get tempids (:db/id entity)) (:db/id entity)))]
(solr/index-documents-raw solr/impl (solr/index-documents-raw solr/impl
"accounts" "accounts"
(into [{"id" (:db/id updated-account) (into [{"id" (:db/id updated-account)
@@ -182,7 +195,7 @@
"name" (:account/name updated-account) "name" (:account/name updated-account)
"numeric_code" (:account/numeric-code updated-account) "numeric_code" (:account/numeric-code updated-account)
"location" (:account/location updated-account) "location" (:account/location updated-account)
"applicability" (clojure.core/name (:account/applicability updated-account))}] "applicability" (some-> updated-account :account/applicability clojure.core/name)}]
(for [o (:account/client-overrides updated-account)] (for [o (:account/client-overrides updated-account)]
{"id" (:db/id o) {"id" (:db/id o)
"account_id" (:db/id updated-account) "account_id" (:db/id updated-account)
@@ -191,14 +204,13 @@
"location" (:account/location updated-account) "location" (:account/location updated-account)
"applicability" (clojure.core/name (:account/applicability updated-account)) "applicability" (clojure.core/name (:account/applicability updated-account))
"client_id" (:db/id (:account-client-override/client o)) "client_id" (:db/id (:account-client-override/client o))
"account_client_override_id" (:db/id o)})) "account_client_override_id" (:db/id o)})))
) (html-response
(html-response
(row* identity updated-account {:flash? true}) (row* identity updated-account {:flash? true})
:headers {"hx-trigger" "closeModal" :headers {"hx-trigger" "closeModal"
"hx-retarget" (format "#account-table tr[data-id=\"%d\"]" (:db/id updated-account))}))) "hx-retarget" (format "#account-table tr[data-id=\"%d\"]" (:db/id updated-account))})))
(defn client-override* [override] (defn client-override* [override]
[:div.flex.gap-2.mb-2.client-override [:div.flex.gap-2.mb-2.client-override
[:div.w-96 [:div.w-96
@@ -215,24 +227,28 @@
:value (:account-client-override/name override)})] :value (:account-client-override/name override)})]
[:div (com/a-icon-button {"_" (hiccup/raw "on click halt the event then transition the closest <.client-override />'s opacity to 0 then remove closest <.client-override />") } svg/x)]]) [:div (com/a-icon-button {"_" (hiccup/raw "on click halt the event then transition the closest <.client-override />'s opacity to 0 then remove closest <.client-override />") } svg/x)]])
(defn account-edit-dialog [request]
(prn (:route-params request)) (defn dialog* [& {:keys [ account form-params]}]
(let [account (some-> request :route-params :db/id (#(dc/pull (dc/db conn) default-read %)))] (com/modal
(html-response
(com/modal
{:modal-class "max-w-4xl"} {:modal-class "max-w-4xl"}
[:form#edit-form {:hx-ext "response-targets" [:form#edit-form (merge {:hx-ext "response-targets"
:hx-post (str (bidi/path-for ssr-routes/only-routes :hx-swap "outerHTML swap:300ms"
:admin-account-edit-save :hx-target-400 "#form-errors .error-content"}
:request-method :post form-params)
:db/id (:db/id account )))
:hx-swap "outerHTML swap:300ms"
:hx-target-400 "#form-errors .error-content"}
[:fieldset {:class "hx-disable"} [:fieldset {:class "hx-disable"}
(com/modal-card (com/modal-card
{} {}
[:div.flex [:div.p-2 "Account"] [:p.ml-2.rounded.bg-gray-200.p-2.dark:bg-gray-600 (:account/numeric-code account) " - " (:account/name account)]] [:div.flex [:div.p-2 "Account"] [:p.ml-2.rounded.bg-gray-200.p-2.dark:bg-gray-600 (:account/numeric-code account) " - " (:account/name account)]]
[:div.space-y-6 [:div.space-y-6
(when-let [id (:db/id account)]
(com/hidden {:name "db/id"
:value id}))
(when (nil? account)
(com/field {:label "Numeric code"}
(com/text-input {:name "account/numeric-code"
:autofocus true
:class "w-32"})))
(com/field {:label "Name"} (com/field {:label "Name"}
(com/text-input {:name "account/name" (com/text-input {:name "account/name"
:autofocus true :autofocus true
@@ -251,18 +267,18 @@
(com/field {:label "Invoice Allowance"} (com/field {:label "Invoice Allowance"}
(com/select {:name "account/invoice-allowance" (com/select {:name "account/invoice-allowance"
:value (name (:account/invoice-allowance account)) :value (some-> account :account/invoice-allowance name)
:class "w-36" :class "w-36"
:options (ref->select-options "allowance")})) :options (ref->select-options "allowance")}))
(com/field {:label "Vendor Allowance"} (com/field {:label "Vendor Allowance"}
(com/select {:name "account/vendor-allowance" (com/select {:name "account/vendor-allowance"
:class "w-36" :class "w-36"
:value (name (:account/vendor-allowance account)) :value (some-> account :account/vendor-allowance name)
:options (ref->select-options "allowance")})) :options (ref->select-options "allowance")}))
(com/field {:label "Applicability"} (com/field {:label "Applicability"}
(com/select {:name "account/applicability" (com/select {:name "account/applicability"
:class "w-36" :class "w-36"
:value (name (:account/applicability account)) :value (some-> account :account/applicability name)
:options (ref->select-options "account-applicability")})) :options (ref->select-options "account-applicability")}))
(com/field {:label "Client Overrides" :id "client-overrides"} (com/field {:label "Client Overrides" :id "client-overrides"}
@@ -276,37 +292,56 @@
[:div#form-errors [:span.error-content]] [:div#form-errors [:span.error-content]]
(com/button {:color :primary :form "edit-form" :type "submit"} (com/button {:color :primary :form "edit-form" :type "submit"}
"Save")] "Save")]
[:div])]])))) [:div])]]))
(defn new-client-override [request] (defn new-client-override [_]
(html-response (html-response
(client-override* {:db/id (str (java.util.UUID/randomUUID))}))) (client-override* {:db/id (str (java.util.UUID/randomUUID))})))
(defn account-edit-dialog [request]
(let [account (some-> request :route-params :db/id (#(dc/pull (dc/db conn) default-read %)))]
(html-response (dialog* :account account
:form-params {:hx-put (str (bidi/path-for ssr-routes/only-routes
:admin-account-edit-save))}))))
(defn account-new-dialog [_]
(html-response (dialog* :account nil
:form-params {:hx-post (str (bidi/path-for ssr-routes/only-routes
:admin-account-new-save))})))
(def account-schema (mc/schema
[:map
[:db/id {:optional true} [:maybe entity-id]]
[:account/numeric-code {:optional true} [:maybe :int]]
[:account/name [:string {:min 1}]]
[:account/location [:maybe :string]]
[:account/type (ref->enum-schema "account-type")]
[:account/applicability (ref->enum-schema "account-applicability")]
[:account/invoice-allowance (ref->enum-schema "allowance")]
[:account/vendor-allowance (ref->enum-schema "allowance")]
[:account/client-overrides {:decode/json map->db-id-decoder
:optional true}
[:maybe
(forced-vector [:map
[:db/id [:or entity-id temp-id]]
[:account-client-override/client [:or entity-id :string]]
[:account-client-override/name :string]])]]]))
(def key->handler (def key->handler
{:admin-accounts (wrap-admin (helper/page-route grid-page)) (apply-middleware-to-all-handlers
:admin-account-table (wrap-admin (helper/table-route grid-page)) (->>
:admin-account-client-override-new (-> new-client-override wrap-admin wrap-client-redirect-unauthenticated) {:admin-accounts (helper/page-route grid-page)
:admin-account-edit-save (-> account-edit-save :admin-account-table (helper/table-route grid-page)
wrap-admin :admin-account-client-override-new (-> new-client-override wrap-admin wrap-client-redirect-unauthenticated)
wrap-client-redirect-unauthenticated :admin-account-save (-> account-save
(wrap-schema-decode (wrap-schema-decode :form-schema account-schema)
:route-schema (mc/schema [:map [:db/id entity-id]]) (wrap-nested-form-params)
:params-schema (mc/schema (wrap-form-4xx))
[:map :admin-account-edit-dialog (-> account-edit-dialog
[:account/name :string] (wrap-schema-decode :route-schema [:map [:db/id entity-id]]))
[:account/location [:maybe :string]] :admin-account-new-dialog account-new-dialog})
[:account/type (ref->enum-schema "account-type")] (fn [h]
[:account/applicability (ref->enum-schema "account-applicability")] (-> h
[:account/invoice-allowance (ref->enum-schema "allowance")] (wrap-admin)
[:account/vendor-allowance (ref->enum-schema "allowance")] (wrap-client-redirect-unauthenticated)))))
[:account/client-overrides {:decode/json map->db-id-decoder}
(forced-vector [:map
[:db/id [:or entity-id temp-id]]
[:account-client-override/client [:or entity-id :string]]
[:account-client-override/name :string]])]]))
(wrap-nested-params))
:admin-account-edit-dialog (-> account-edit-dialog
wrap-admin
wrap-client-redirect-unauthenticated
(wrap-schema-decode
:route-schema (mc/schema [:map [:db/id entity-id]])))})

View File

@@ -27,6 +27,7 @@
(def text-input inputs/text-input-) (def text-input inputs/text-input-)
(def money-input inputs/money-input-) (def money-input inputs/money-input-)
(def date-input inputs/date-input-) (def date-input inputs/date-input-)
(def hidden inputs/hidden-)
(def select inputs/select-) (def select inputs/select-)
(def typeahead inputs/typeahead-) (def typeahead inputs/typeahead-)
(def field inputs/field-) (def field inputs/field-)

View File

@@ -98,3 +98,7 @@ c.clearChoices();
[:div {:id (:id params)} [:div {:id (:id params)}
[:label {:class "block mb-2 text-sm font-medium text-gray-900 dark:text-white"} (:label params)]] [:label {:class "block mb-2 text-sm font-medium text-gray-900 dark:text-white"} (:label params)]]
rest)) rest))
(defn hidden- [{:keys [name value]}]
[:input {:type "hidden" :value value :name name}]
)

View File

@@ -157,6 +157,10 @@
(keyword? value) (keyword? value)
(name value) (name value)
(and (map? value)
(:db/id value))
(:db/id value)
:else :else
value))) value)))
query-params query-params

View File

@@ -0,0 +1,92 @@
(ns auto-ap.ssr.nested-form-params
(:require [ring.util.codec :refer [assoc-conj]]))
;; ADAPTED FROM ring.middleware.nested-params
(defn parse-nested-keys
"Parse a parameter name into a list of keys using a 'C'-like index
notation.
For example:
\"foo[bar][][baz]\"
=> [\"foo\" \"bar\" \"\" \"baz\"]"
[param-name]
(let [[_ k ks] (re-matches #"(?s)(.*?)((?:\[.*?\])*)" (name param-name))
keys (if ks (map second (re-seq #"\[(.*?)\]" ks)))]
(cons k keys)))
(defn- assoc-vec [m k v]
(let [m (if (contains? m k) m (assoc m k []))]
(assoc-conj m k v)))
(defn- assoc-nested
"Similar to assoc-in, but treats values of blank keys as elements in a
list."
[m [k & ks] v]
(if k
(if ks
(let [[j & js] ks]
(if (= j "")
(assoc-vec m k (assoc-nested {} js v))
(assoc m k (assoc-nested (get m k {}) ks v))))
(if (map? m)
(assoc-conj m k v)
{k v}))
v))
(defn- param-pairs
"Return a list of name-value pairs for a parameter map."
[params]
(mapcat
(fn [[name value]]
(if (and (sequential? value) (not (coll? (first value))))
(for [v value] [name v])
[[name value]]))
params))
(defn- nest-params
"Takes a flat map of parameters and turns it into a nested map of
parameters, using the function parse to split the parameter names
into keys."
[params parse]
(reduce
(fn [m [k v]]
(assoc-nested m (parse k) v))
{}
(param-pairs params)))
(defn nested-params-request
"Converts a request with a flat map of parameters to a nested map.
See: wrap-nested-params."
{:added "1.2"}
([request]
(nested-params-request request {}))
([request options]
(let [parse (:key-parser options parse-nested-keys)]
(update-in request [:form-params] nest-params parse))))
(defn wrap-nested-form-params
"Middleware to converts a flat map of parameters into a nested map.
Accepts the following options:
:key-parser - the function to use to parse the parameter names into a list
of keys. Keys that are empty strings are treated as elements in
a vector, non-empty keys are treated as elements in a map.
Defaults to the parse-nested-keys function.
For example:
{\"foo[bar]\" \"baz\"}
=> {\"foo\" {\"bar\" \"baz\"}}
{\"foo[]\" \"bar\"}
=> {\"foo\" [\"bar\"]}"
([handler]
(wrap-nested-params handler {}))
([handler options]
(fn
([request]
(handler (nested-params-request request options)))
([request respond raise]
(handler (nested-params-request request options) respond raise)))))

View File

@@ -17,7 +17,8 @@
[auto-ap.ssr.grid-page-helper :as helper] [auto-ap.ssr.grid-page-helper :as helper]
[auto-ap.ssr.svg :as svg] [auto-ap.ssr.svg :as svg]
[auto-ap.ssr.utils [auto-ap.ssr.utils
:refer [entity-id :refer [apply-middleware-to-all-handlers
entity-id
forced-vector forced-vector
html-response html-response
ref->enum-schema ref->enum-schema
@@ -68,7 +69,15 @@
{:value "user" {:value "user"
:content "User"} :content "User"}
{:value "none" {:value "none"
:content "None"}]}))]]) :content "None"}]}))
(com/field {:label "Client"}
(com/typeahead {:name "client"
:placeholder "Search..."
:url (bidi/path-for ssr-routes/only-routes
:company-search)
:id (str "client-search")
:value [(:db/id (:client (:parsed-query-params request)))
(:client/name (:client (:parsed-query-params request)))]}))]])
(def default-read '[:db/id (def default-read '[:db/id
:user/name :user/name
@@ -110,6 +119,12 @@
'[(clojure.string/includes? ?upper-se ?es)]]} '[(clojure.string/includes? ?upper-se ?es)]]}
:args [(str/upper-case (:email query-params))]}) :args [(str/upper-case (:email query-params))]})
(some->> query-params :client :db/id)
(merge-query {:query {:find []
:in ['?c]
:where ['[?e :user/clients ?c]]}
:args [(some->> query-params :client :db/id)]})
(some->> query-params :role) (some->> query-params :role)
(merge-query {:query {:find [] (merge-query {:query {:find []
:in ['?r] :in ['?r]
@@ -171,6 +186,10 @@
(com/pill {:color :white} (com/pill {:color :white}
(format "%d more" remainder))))]) (format "%d more" remainder))))])
(defn parse-client [client]
(let [client-id (Long/parseLong client)]
(dc/pull (dc/db conn) '[:client/name :db/id] client-id)))
(def grid-page (def grid-page
(helper/build {:id "user-table" (helper/build {:id "user-table"
:nav (com/admin-aside-nav) :nav (com/admin-aside-nav)
@@ -178,8 +197,7 @@
:fetch-page fetch-page :fetch-page fetch-page
:parse-query-params (comp :parse-query-params (comp
(query-params/parse-key :role #(query-params/parse-keyword "user-role" %)) (query-params/parse-key :role #(query-params/parse-keyword "user-role" %))
(query-params/parse-key :total-gte query-params/parse-double) (query-params/parse-key :client parse-client)
(query-params/parse-key :total-lte query-params/parse-double)
(helper/default-parse-query-params grid-page)) (helper/default-parse-query-params grid-page))
:row-buttons (fn [request entity] :row-buttons (fn [request entity]
[(com/button {:hx-post (str (bidi/path-for ssr-routes/only-routes [(com/button {:hx-post (str (bidi/path-for ssr-routes/only-routes
@@ -241,9 +259,9 @@
:session {:identity (dissoc (auth/user->jwt user "FAKE_TOKEN") :session {:identity (dissoc (auth/user->jwt user "FAKE_TOKEN")
:exp)}})) :exp)}}))
(defn user-edit-save [{:keys [params route-params] :as request}] (defn user-edit-save [{:keys [form-params identity] :as request}]
(let [_ @(dc/transact conn [[:upsert-entity (-> params (assoc :db/id (:db/id route-params)) (dissoc :id))]]) (let [_ @(dc/transact conn [[:upsert-entity form-params]])
user (some-> request :route-params :db/id (#(dc/pull (dc/db conn) default-read %)))] user (some-> form-params :db/id (#(dc/pull (dc/db conn) default-read %)))]
(html-response (html-response
(row* identity user {:flash? true}) (row* identity user {:flash? true})
@@ -259,10 +277,9 @@
(com/modal (com/modal
{} {}
[:form {:hx-ext "response-targets" [:form {:hx-ext "response-targets"
:hx-post (str (bidi/path-for ssr-routes/only-routes :hx-put (str (bidi/path-for ssr-routes/only-routes
:user-edit-save :user-edit-save
:request-method :post :request-method :put))
:db/id (:db/id user )))
:hx-swap "outerHTML swap:300ms" :hx-swap "outerHTML swap:300ms"
:hx-target-400 "#form-errors .error-content"} :hx-target-400 "#form-errors .error-content"}
[:fieldset {:class "hx-disable"} [:fieldset {:class "hx-disable"}
@@ -270,6 +287,8 @@
{} {}
[:div.flex [:div.p-2 "User"] [:p.ml-2.rounded.bg-gray-200.p-2.dark:bg-gray-600 (:user/name user)]] [:div.flex [:div.p-2 "User"] [:p.ml-2.rounded.bg-gray-200.p-2.dark:bg-gray-600 (:user/name user)]]
[:div.space-y-6 [:div.space-y-6
(com/hidden {:name "db/id"
:value (:db/id user)})
(com/field {:label "Role"} (com/field {:label "Role"}
(com/select {:name "user/role" (com/select {:name "user/role"
:class "w-36" :class "w-36"
@@ -280,8 +299,7 @@
["power-user" "Power user"] ["power-user" "Power user"]
["manager" "Manager"] ["manager" "Manager"]
["admin" "Admin"] ["admin" "Admin"]
["user" "User"]] ["user" "User"]]}))
:size :small}))
(com/field {:label "Clients"} (com/field {:label "Clients"}
(com/typeahead {:name "user/clients" (com/typeahead {:name "user/clients"
:class "w-full" :class "w-full"
@@ -300,25 +318,24 @@
[:div])]])))) [:div])]]))))
(def key->handler (def key->handler
{:users (wrap-admin (helper/page-route grid-page)) (apply-middleware-to-all-handlers
:user-table (wrap-admin (helper/table-route grid-page)) {:users (helper/page-route grid-page)
:user-edit-save (-> user-edit-save :user-table (helper/table-route grid-page)
wrap-admin :user-edit-save (-> user-edit-save
wrap-client-redirect-unauthenticated (wrap-schema-decode
(wrap-schema-decode :form-schema (mc/schema
:route-schema (mc/schema [:map [:db/id entity-id]]) [:map
:params-schema (mc/schema [:db/id entity-id]
[:map [:user/clients (forced-vector entity-id)]
[:user/clients (forced-vector entity-id)] [:user/role (ref->enum-schema "user-role")]])))
[:user/role (ref->enum-schema "user-role")]]))) :user-edit-dialog (-> user-edit-dialog
:user-edit-dialog (-> user-edit-dialog (wrap-schema-decode
wrap-admin :route-schema (mc/schema [:map [:db/id entity-id]])))
wrap-client-redirect-unauthenticated :user-impersonate (-> impersonate
(wrap-schema-decode (wrap-schema-decode
:route-schema (mc/schema [:map [:db/id entity-id]]))) :params-schema (mc/schema [:map [:db/id entity-id]])))}
:user-impersonate (-> impersonate (fn [h]
wrap-admin (-> h
wrap-client-redirect-unauthenticated (wrap-admin)
(wrap-schema-decode (wrap-client-redirect-unauthenticated)))))
:params-schema (mc/schema [:map [:db/id entity-id]])))})

View File

@@ -8,7 +8,7 @@
[malli.core :as mc] [malli.core :as mc]
[malli.error :as me] [malli.error :as me]
[malli.transform :as mt2] [malli.transform :as mt2]
[ring.middleware.nested-params :refer [parse-nested-keys]])) [slingshot.slingshot :refer [throw+ try+]]))
(defn html-response [hiccup & {:keys [status headers oob] :or {status 200 headers {} oob []}}] (defn html-response [hiccup & {:keys [status headers oob] :or {status 200 headers {} oob []}}]
{:status status {:status status
@@ -97,11 +97,13 @@
(defn keyword->str [k] (defn keyword->str [k]
(subs (str k) 1)) (subs (str k) 1))
(defn validation-error [m & [data]]
(throw+ (ex-info m (merge data {:type :validation}))))
(defn wrap-schema-decode [handler & {:keys [form-schema query-schema route-schema params-schema]}] (defn wrap-schema-decode [handler & {:keys [form-schema query-schema route-schema params-schema]}]
(fn [{:keys [form-params query-params params] :as request}] (fn [{:keys [form-params query-params params] :as request}]
(try (let [request (try
(cond-> request
(handler (cond-> request
(and (:params request) params-schema) (and (:params request) params-schema)
(assoc :params (assoc :params
(mc/coerce (mc/coerce
@@ -123,7 +125,7 @@
mt2/json-transformer) )) mt2/json-transformer) ))
(and form-schema form-params) (and form-schema form-params)
(assoc :parsed-form-params (assoc :form-params
(mc/coerce (mc/coerce
form-schema form-schema
form-params form-params
@@ -140,23 +142,24 @@
(mt2/transformer (mt2/transformer
(mt2/key-transformer {:encode name :decode keyword}) (mt2/key-transformer {:encode name :decode keyword})
mt2/string-transformer mt2/string-transformer
mt2/json-transformer) )))) mt2/json-transformer) )))
(catch Exception e (catch Exception e
(alog/warn ::validation-error :error e) (alog/warn ::validation-error :error e)
(html-response [:span.error-content.text-red-500 (str/join ", " (validation-error (str/join ", "
(mapcat identity (->> e
(-> e (ex-data )
(ex-data ) :data
:data :explain
:explain me/humanize
me/humanize (map (fn [[k v]]
vals)))] (str (if (keyword? k)
:status 400))))) (name k)
k) ": " (str/join ", " v))
)))))))] (handler request))))
(defn ref->enum-schema [n] (defn ref->enum-schema [n]
(into [:enum {:decode/string #(keyword n %)}] (into [:enum {:decode/string #(keyword n %)}]
(for [{:db/keys [ident]} (all-schema) (for [{:db/keys [ident]} (all-schema)
:when (= n (namespace ident))] :when (= n (namespace ident))]
ident))) ident)))
(defn ref->select-options [n & {:keys [allow-nil?]}] (defn ref->select-options [n & {:keys [allow-nil?]}]
@@ -178,7 +181,7 @@
:else :else
k)))))}) k)))))})
(defn namespaceize-decoder [n] #_(defn namespaceize-decoder [n]
{:exit (fn [m] {:exit (fn [m]
(when m (when m
(reduce (reduce
@@ -189,3 +192,23 @@
m m
m)))}) m)))})
(defn wrap-form-4xx [handler]
(fn [request]
(try+
(handler request)
(catch [:type :validation] e
(alog/warn ::form-4xx :error e)
(html-response [:span.error-content.text-red-500 (:message &throw-context)]
:status 400))))
)
(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)
))

View File

@@ -13,16 +13,18 @@
#"/search/?" :admin-history-search #"/search/?" :admin-history-search
["/" [#"\d+" :entity-id] #"/?"] :admin-history ["/" [#"\d+" :entity-id] #"/?"] :admin-history
["/inspect/" [#"\d+" :entity-id] #"/?"] :admin-history-inspect} ["/inspect/" [#"\d+" :entity-id] #"/?"] :admin-history-inspect}
"/user" {"" :users "/user" {"" {:get :users
:put :user-edit-save}
"/table" :user-table "/table" :user-table
"/impersonate" :user-impersonate "/impersonate" :user-impersonate
[[#"\d+" :db/id] "/edit"] {:get :user-edit-dialog [[#"\d+" :db/id] "/edit"] {:get :user-edit-dialog}}
:post :user-edit-save}} "/account" {"" {:get :admin-accounts
"/account" {"" :admin-accounts :put :admin-account-save
:post :admin-account-save}
"/table" :admin-account-table "/table" :admin-account-table
"/override/new" :admin-account-client-override-new "/new" {:get :admin-account-new-dialog}
["/" [#"\d+" :db/id] "/edit"] {:get :admin-account-edit-dialog [[#"\d+" :db/id] "/edit"] :admin-account-edit-dialog
:post :admin-account-edit-save}} "/override/new" :admin-account-client-override-new}
"/ezcater-xls" :admin-ezcater-xls} "/ezcater-xls" :admin-ezcater-xls}
"transaction" {"/insights" {"" :transaction-insights "transaction" {"/insights" {"" :transaction-insights
"/table" :transaction-insight-table "/table" :transaction-insight-table