payments ssr
voiding supports bulk void. exact match id linking voidnig payments works. minor tweak.
This commit is contained in:
@@ -1,15 +1,19 @@
|
||||
(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+]]))
|
||||
(:require [auto-ap.datomic :refer [all-schema conn]]
|
||||
[auto-ap.logging :as alog]
|
||||
[auto-ap.time :as atime]
|
||||
[clj-time.coerce :as coerce]
|
||||
[clj-time.core :as time]
|
||||
[clojure.string :as str]
|
||||
[datomic.api :as dc]
|
||||
[hiccup2.core :as hiccup]
|
||||
[malli.core :as mc]
|
||||
[malli.core :as m]
|
||||
[malli.error :as me]
|
||||
[malli.registry :as mr]
|
||||
[malli.transform :as mt2]
|
||||
[slingshot.slingshot :refer [throw+ try+]]
|
||||
[taoensso.encore :refer [filter-vals]]))
|
||||
|
||||
(defn html-response [hiccup & {:keys [status headers oob] :or {status 200 headers {} oob []}}]
|
||||
{:status status
|
||||
@@ -96,11 +100,17 @@
|
||||
: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 raw-entity-id [nat-int? {:error/message "required"
|
||||
:decode/arbitrary (fn [e]
|
||||
(if (and (map? e) (:db/id e))
|
||||
(:db/id e)
|
||||
e))}])
|
||||
|
||||
(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]))
|
||||
@@ -158,13 +168,134 @@
|
||||
(throw+ (ex-info m (merge data {:type :form-validation
|
||||
:form-validation-errors [m]}))))
|
||||
|
||||
(def clj-date-schema
|
||||
(mc/schema [inst? {:decode/arbitrary (fn [m]
|
||||
(alog/peek ::decode
|
||||
(if (string? m)
|
||||
(coerce/to-date-time (atime/parse m atime/normal-date))
|
||||
|
||||
m)))
|
||||
:encode/arbitrary (fn [m]
|
||||
(alog/peek ::encode
|
||||
(cond
|
||||
(inst? m)
|
||||
(atime/unparse-local (coerce/to-date-time m) atime/normal-date)
|
||||
|
||||
(instance? org.joda.time.DateTime m)
|
||||
(atime/unparse-local m atime/normal-date)
|
||||
|
||||
:else
|
||||
m)))}]))
|
||||
|
||||
|
||||
(def date-range-transformer
|
||||
(mt2/transformer {:decoders
|
||||
{:map {:compile (fn [schema _]
|
||||
(let [properties (mc/properties schema)]
|
||||
(fn [m]
|
||||
(if (:date-range properties)
|
||||
(let [[date-range-key start-date-key end-date-key] (:date-range properties)
|
||||
date-range-value (get m date-range-key)]
|
||||
(if date-range-value
|
||||
(-> (condp = date-range-value
|
||||
"week"
|
||||
(assoc m
|
||||
start-date-key (time/plus (time/now) (time/days -7))
|
||||
end-date-key (time/now))
|
||||
|
||||
"month"
|
||||
(assoc m
|
||||
start-date-key (time/plus (time/now) (time/months -1))
|
||||
end-date-key (time/now))
|
||||
|
||||
"year"
|
||||
(assoc m
|
||||
start-date-key (time/plus (time/now) (time/years -1))
|
||||
end-date-key (time/now))
|
||||
|
||||
"all"
|
||||
(assoc m start-date-key (time/plus (time/now) (time/years -3))
|
||||
end-date-key (time/now))
|
||||
|
||||
m)
|
||||
(dissoc date-range-key))
|
||||
m))
|
||||
m))))}}}))
|
||||
|
||||
(def pull-transformer
|
||||
(mt2/transformer {:decoders
|
||||
{:entity-map
|
||||
{:compile (fn [schema _]
|
||||
(let [pull-expr (:pull (mc/properties schema))]
|
||||
(if pull-expr
|
||||
(fn pull-data [m]
|
||||
(cond
|
||||
(nat-int? m)
|
||||
(dc/pull (dc/db conn) pull-expr m)
|
||||
(and (string? m) (not-empty m))
|
||||
(dc/pull (dc/db conn) pull-expr (Long/parseLong m))
|
||||
:else
|
||||
nil))
|
||||
identity)))}}
|
||||
:encoders
|
||||
{:entity-map
|
||||
{:compile (fn [schema _]
|
||||
(let [pull-expr (:pull (mc/properties schema))]
|
||||
(if pull-expr
|
||||
(fn pull-data [m]
|
||||
(cond
|
||||
(map? m)
|
||||
(:db/id m)
|
||||
(nat-int? m)
|
||||
m
|
||||
(and (string? m) (not-empty m))
|
||||
(Long/parseLong m)
|
||||
|
||||
:else
|
||||
m))
|
||||
identity)))}}}))
|
||||
|
||||
(def coerce-vector
|
||||
(mt2/transformer {:decoders {:vector {:compile (fn [schema _]
|
||||
(when (:coerce? (m/properties schema))
|
||||
(fn [data]
|
||||
(cond (sequential? data)
|
||||
data
|
||||
(nil? data)
|
||||
nil
|
||||
:else
|
||||
[data]))))}}}))
|
||||
|
||||
(defn wrap-merge-prior-hx [handler]
|
||||
;; TODO this should just be automatic
|
||||
(fn [request]
|
||||
(handler (update request :query-params (fn [qp]
|
||||
(->> (concat (:hx-query-params request) qp)
|
||||
(into {})))))))
|
||||
|
||||
|
||||
(def dissoc-nil-transformer
|
||||
(let [e {:map {:compile (fn [schema _]
|
||||
(fn [data]
|
||||
(if (map? data)
|
||||
(filter-vals
|
||||
(fn [x]
|
||||
(not (nil? x)))
|
||||
data)
|
||||
data)))}}]
|
||||
(mt2/transformer {:encoders e
|
||||
:decoders e})))
|
||||
|
||||
(def main-transformer
|
||||
(mt2/transformer
|
||||
parse-empty-as-nil
|
||||
(mt2/key-transformer {:encode keyword->str :decode str->keyword})
|
||||
(mt2/transformer {:name :arbitrary})
|
||||
mt2/string-transformer
|
||||
mt2/json-transformer
|
||||
(mt2/transformer {:name :arbitrary})
|
||||
coerce-vector
|
||||
date-range-transformer
|
||||
pull-transformer
|
||||
mt2/default-value-transformer))
|
||||
|
||||
(defn strip [s]
|
||||
@@ -192,7 +323,7 @@
|
||||
: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]}]
|
||||
(defn schema-enforce-request [{:keys [form-params query-params hx-query-params params] :as request} & {:keys [form-schema hx-schema query-schema route-schema params-schema]}]
|
||||
(let [request (try
|
||||
(cond-> request
|
||||
(and (:params request) params-schema)
|
||||
@@ -216,6 +347,14 @@
|
||||
form-params
|
||||
main-transformer))
|
||||
|
||||
(and hx-schema hx-query-params)
|
||||
(assoc :hx-query-params
|
||||
(mc/coerce
|
||||
hx-schema
|
||||
hx-query-params
|
||||
main-transformer))
|
||||
|
||||
|
||||
(and query-schema query-params)
|
||||
(assoc :query-params
|
||||
(mc/coerce
|
||||
@@ -241,9 +380,10 @@
|
||||
:error (:data (ex-data e))}))))]
|
||||
request))
|
||||
|
||||
(defn wrap-schema-enforce [handler & {:keys [form-schema query-schema route-schema params-schema]}]
|
||||
(defn wrap-schema-enforce [handler & {:keys [form-schema query-schema route-schema params-schema hx-schema]}]
|
||||
(fn [request]
|
||||
(handler (schema-enforce-request request
|
||||
:hx-schema hx-schema
|
||||
:form-schema form-schema
|
||||
:query-schema query-schema
|
||||
:route-schema route-schema
|
||||
@@ -293,7 +433,10 @@
|
||||
(into [:enum {:decode/string #(if (keyword? %)
|
||||
%
|
||||
(when (not-empty %)
|
||||
(keyword n %)))}]
|
||||
(keyword n %)))
|
||||
:encode/string #(if (keyword? %)
|
||||
(name %)
|
||||
%)}]
|
||||
(for [{:db/keys [ident]} (all-schema)
|
||||
:when (= n (namespace ident))]
|
||||
ident)))
|
||||
@@ -375,4 +518,25 @@
|
||||
(handler (if entity
|
||||
(assoc request
|
||||
:entity entity)
|
||||
request)))))
|
||||
request)))))
|
||||
|
||||
(mr/set-default-registry!
|
||||
(mr/composite-registry
|
||||
(mc/default-schemas)
|
||||
{:entity-id entity-id
|
||||
:entity-map
|
||||
(mc/-simple-schema {:type :entity-map
|
||||
:pred map?})
|
||||
#_[:map {:name :entity-map} [:db/id nat-int?]]}))
|
||||
|
||||
(comment
|
||||
|
||||
(mc/coerce [:map [:x {:optional true} [:maybe [:entity-map {:pull '[:db/id]}]]]]
|
||||
{:x nil :g 1}
|
||||
main-transformer)
|
||||
|
||||
(mc/decode [:map [:x [:entity-map {:pull '[:db/id :db/ident]}]]]
|
||||
{:x 87}
|
||||
main-transformer))
|
||||
|
||||
|
||||
|
||||
Reference in New Issue
Block a user