Files
integreat/src/clj/auto_ap/ssr/users.clj
2024-07-12 21:45:48 -07:00

401 lines
19 KiB
Clojure

(ns auto-ap.ssr.users
(:require
[auto-ap.datomic
:refer [add-sorter-fields
apply-pagination
apply-sort-3
conn
merge-query
pull-attr
pull-many
query2]]
[auto-ap.query-params :as query-params]
[auto-ap.routes.auth :as auth]
[auto-ap.routes.utils
:refer [wrap-admin wrap-client-redirect-unauthenticated]]
[auto-ap.ssr-routes :as ssr-routes]
[auto-ap.ssr.components :as com]
[auto-ap.ssr.form-cursor :as fc]
[auto-ap.ssr.grid-page-helper :as helper]
[auto-ap.ssr.hx :as hx]
[auto-ap.ssr.nested-form-params :refer [wrap-nested-form-params]]
[auto-ap.ssr.svg :as svg]
[auto-ap.ssr.utils
:refer [apply-middleware-to-all-handlers
entity-id
html-response
main-transformer
many-entity
modal-response
ref->enum-schema
ref->select-options
wrap-entity
wrap-form-4xx-2
wrap-schema-enforce]]
[auto-ap.time :as atime]
[bidi.bidi :as bidi]
[buddy.sign.jwt :as jwt]
[clojure.string :as str]
[config.core :refer [env]]
[datomic.api :as dc]
[malli.core :as mc]
[auto-ap.logging :as alog]))
(defn filters [request]
[:form {"hx-trigger" "change delay:500ms, keyup changed from:.hot-filter delay:1000ms"
"hx-get" (bidi/path-for ssr-routes/only-routes
:user-table)
"hx-target" "#user-table"
"hx-indicator" "#user-table"}
[:fieldset.space-y-6
(com/field {:label "Name"}
(com/text-input {:name "name"
:id "name"
:class "hot-filter"
:value (:name (:parsed-query-params request))
:placeholder "Johnny Testerson"
:size :small}))
(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 (:client (:parsed-query-params request))
:value-fn :db/id
:content-fn :client/name}))
(com/field {:label "Email"}
(com/text-input {:name "email"
:id "email"
:class "hot-filter"
:value (:name (:parsed-query-params request))
:placeholder "hello@friend.com"
:size :small}))
(com/field {:label "Role"}
(com/radio-card {:size :small
:name "role"
:options [{:value ""
:content "All"}
{:value "admin"
:content "Admin"}
{:value "power-user"
:content "Power user"}
{:value "manager"
:content "Manager"}
{:value "user"
:content "User"}
{:value "read-only"
:content "Read Only"}
{:value "none"
:content "None"}]}))]])
(def default-read '[:db/id
:user/name
:user/email
:user/profile-image-url
[:user/last-login :xform clj-time.coerce/from-date]
{[:user/role :xform iol-ion.query/ident] [:db/ident]
:user/clients [:client/code :db/id :client/locations :client/name]}])
(defn fetch-ids [db request]
(let [query-params (:parsed-query-params request)
query (cond-> {:query {:find []
:in '[$ ]
:where '[]}
:args [db ]}
(:sort query-params) (add-sorter-fields {"name" ['[?e :user/name ?un]
'[(clojure.string/upper-case ?un) ?sort-name]]
"email" ['[(get-else $ ?e :user/email "") ?sort-email]]
"role" ['[?e :user/role ?r]
'[?r :db/ident ?ri]
'[(name ?ri) ?sort-role]]
"last-login" ['[?e :user/last-login ?sort-last-login]]}
query-params)
(some->> query-params :name not-empty)
(merge-query {:query {:find []
:in ['?ns]
:where ['[?e :user/name ?sn]
'[(clojure.string/upper-case ?sn) ?upper-sn]
'[(clojure.string/includes? ?upper-sn ?ns)]]}
:args [(str/upper-case (:name query-params))]})
(some->> query-params :email not-empty)
(merge-query {:query {:find []
:in ['?es]
:where ['[?e :user/email ?se]
'[(clojure.string/upper-case ?se) ?upper-se]
'[(clojure.string/includes? ?upper-se ?es)]]}
: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)
(merge-query {:query {:find []
:in ['?r]
:where ['[?e :user/role ?r]
'[?r :db/ident ?ri]]}
:args [(some->> query-params :role)]})
true
(merge-query {:query {:find ['?sort-default '?e]
:where ['[?e :user/name ?un]
'[(clojure.string/upper-case ?un) ?sort-default]]}}))]
(cond->> (query2 query)
true (apply-sort-3 query-params)
true (apply-pagination query-params))))
(defn hydrate-results [ids db _]
(let [results (->> (pull-many db default-read ids)
(group-by :db/id))
refunds (->> ids
(map results)
(map first))]
refunds))
(defn fetch-page [request]
(let [db (dc/db conn)
{ids-to-retrieve :ids matching-count :count} (fetch-ids db request)]
[(->> (hydrate-results ids-to-retrieve db request))
matching-count]))
(defn role->pill [role]
(com/pill {:color (cond (= :user-role/admin role)
:primary
(= :user-role/manager role)
:secondary
(= :user-role/power-user role)
:secondary
(= :user-role/user role)
:yellow
:else
:red)}
(name role)))
(defn user->client-pills [user]
[:div.flex.space-x-2
(for [{:client/keys [code]} (take 3 (:user/clients user))]
(com/pill {:color :primary}
code)
)
(let [remainder (- (count (:user/clients user)) 3)]
(when (> remainder 0)
(com/pill {:color :white}
(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
(helper/build {:id "user-table"
:nav com/admin-aside-nav
:page-specific-nav filters
:fetch-page fetch-page
:parse-query-params (comp
(query-params/parse-key :role #(query-params/parse-keyword "user-role" %))
(query-params/parse-key :client parse-client)
(helper/default-parse-query-params grid-page))
:row-buttons (fn [request entity]
[(com/button {:hx-post (str (bidi/path-for ssr-routes/only-routes
:user-impersonate))
:hx-vals (format "{\"db/id\": \"%s\"}" (:db/id entity))} "Impersonate")
(com/icon-button {:hx-get (str (bidi/path-for ssr-routes/only-routes
:user-edit-dialog
:db/id (:db/id entity)))}
svg/pencil)])
:breadcrumbs [[:a {:href (bidi/path-for ssr-routes/only-routes
:admin)}
"Admin"]
[:a {:href (bidi/path-for ssr-routes/only-routes
:users)}
"Users"]]
:title "Users"
:entity-name "User"
:route :user-table
:headers [{:key "name"
:name "Name"
:sort-key "name"
:render (fn [user]
[:div.flex.space-x-2.place-items-center
(when-let [profile-image (:user/profile-image-url user) ]
[:div.rounded-full.overflow-hidden.w-8.h-8.display-inline
[:img {:src profile-image }]])
[:span.inline-block ] (:user/name user)])}
{:key "email"
:name "Email"
:sort-key "email"
:render #(-> % :user/email)}
{:key "role"
:name "Role"
:sort-key "role"
:render #(some-> % :user/role role->pill)}
{:key "last-login"
:name "Last login"
:sort-key "last-login"
:render #(some-> % (:user/last-login) (atime/unparse-local atime/standard-time))}
{:key "clients"
:name "Clients"
:render user->client-pills}
]}))
(def row* (partial helper/row* grid-page))
(def table* (partial helper/table* grid-page))
(defn impersonate [request]
(if (:entity request)
{:status 200
:headers {"hx-redirect" (str "/?jwt=" (jwt/sign (auth/user->jwt (:entity request) "FAKE_TOKEN")
(:jwt-secret env)
{:alg :hs512}))}
:session {:identity (dissoc (auth/user->jwt (:entity request) "FAKE_TOKEN")
:exp)}}
{:status 404}))
(defn client-row* [client]
(com/data-grid-row (-> {:x-ref "p"
:data-key "show"
:x-data (hx/json {:show (boolean (not (fc/field-value (:new? client))))})}
hx/alpine-mount-then-appear)
(com/data-grid-cell {}
(com/validated-field {:errors (fc/field-errors (:db/id fc/*current*))}
(com/typeahead {:name (fc/field-name (:db/id fc/*current*))
:class "w-full"
:url (bidi/path-for ssr-routes/only-routes
:company-search)
:value (fc/field-value)
:value-fn :db/id
:content-fn #(pull-attr (dc/db conn) :client/name (:db/id %))
:size :small})))
(com/data-grid-cell {:class "align-top"}
(com/a-icon-button {"@click.prevent.stop" "show=false; setTimeout(() => $refs.p.remove(), 500)"} svg/x))))
(defn dialog* [{:keys [form-params form-errors entity]}]
(println "FORM PARMS" form-params)
(fc/start-form
form-params form-errors
(com/modal
{:hx-target "this"
:hx-indicator "this"}
[:form {:hx-ext "response-targets"
:hx-put (str (bidi/path-for ssr-routes/only-routes
:user-edit-save
:request-method :put))
:hx-swap "outerHTML swap:300ms"
:hx-target-400 "#form-errors .error-content"
:class "w-full h-full"}
[:fieldset {:class "hx-disable h-full"}
(com/modal-card
{:class "md:h-[800px] md:w-[750px]"}
[:div.flex [:div.p-2 "User"] [:p.ml-2.rounded.bg-gray-200.p-2.dark:bg-gray-600 (:user/name entity)]]
[:div.space-y-6.overflow-y-scroll
(fc/with-field :db/id
(com/hidden {:name (fc/field-name)
:value (fc/field-value)}))
(fc/with-field :user/role
(com/validated-field {:label "Role"
:errors (fc/field-errors)}
(com/select {:name (fc/field-name)
:class "w-36"
:autofocus true
:value (some->> (fc/field-value) name)
:options (ref->select-options "user-role")})))
(fc/with-field :user/clients
(com/validated-field {:label "Clients"}
(com/data-grid {:headers [(com/data-grid-header {} "Client")
(com/data-grid-header {})]
:id "client-table"}
(fc/cursor-map #(client-row* %))
(com/data-grid-new-row {:colspan 2
:index (count (fc/field-value))
:hx-get (bidi/path-for ssr-routes/only-routes
:user-client-new)}
"Assign new client"))))]
[:div
(com/form-errors {:errors (:errors fc/*form-errors*)})
(com/validated-save-button {:errors (seq form-errors)}
"Save user")])]])))
(defn user-edit-save [{:keys [form-params identity] :as request}]
(let [_ @(dc/transact conn [[:upsert-entity form-params]])
user (some-> form-params :db/id (#(dc/pull (dc/db conn) default-read %)))]
(html-response
(row* identity user {:flash? true})
:headers {"hx-trigger" "modalclose"
"hx-retarget" (format "#user-table tr[data-id=\"%d\"]" (:db/id user))})))
(def form-schema
(mc/schema
[:map
[:db/id entity-id]
[:user/clients {:optional true}
[:maybe
(many-entity {} [:db/id entity-id])]]
[:user/role (ref->enum-schema "user-role")]]))
(defn user-dialog [{:keys [form-params entity form-errors]}]
(modal-response
(dialog* {:form-params (or (when (seq form-params)
form-params)
(when entity
(mc/decode form-schema entity main-transformer))
{})
:entity entity
:form-errors form-errors})))
(defn new-client [{ {:keys [index]} :query-params}]
(html-response
(fc/start-form-with-prefix [:user/clients (or index 0)] {:db/id nil
:new? true} []
(client-row* fc/*current*))))
(def key->handler
(apply-middleware-to-all-handlers
{:users (helper/page-route grid-page)
:user-table (helper/table-route grid-page)
:user-edit-save (-> user-edit-save
(wrap-entity [:form-params :db/id] default-read)
(wrap-schema-enforce :form-schema form-schema)
(wrap-nested-form-params)
(wrap-form-4xx-2 (wrap-entity user-dialog [:form-params :db/id] default-read)))
:user-client-new (-> new-client
(wrap-schema-enforce :query-schema [:map
[:index {:optional true
:default 0} [nat-int? {:default 0}]]]))
:user-edit-dialog (-> user-dialog
(wrap-entity [:route-params :db/id] default-read)
(wrap-schema-enforce
:route-schema (mc/schema [:map [:db/id entity-id]])))
:user-impersonate (-> impersonate
(wrap-entity [:params :db/id] default-read)
(wrap-schema-enforce
:params-schema (mc/schema [:map [:db/id entity-id]])))}
(fn [h]
(-> h
(wrap-admin)
(wrap-client-redirect-unauthenticated)))))