can run transaction rules

This commit is contained in:
2023-10-28 21:03:59 -07:00
parent e8a419fb3c
commit f0a7c378f7
4 changed files with 164 additions and 66 deletions

View File

@@ -9,13 +9,17 @@
merge-query merge-query
pull-attr pull-attr
pull-many pull-many
query2]] query2
remove-nils]]
[auto-ap.datomic.accounts :as d-accounts] [auto-ap.datomic.accounts :as d-accounts]
[auto-ap.datomic.transactions :as d-transactions]
[auto-ap.graphql.utils :refer [extract-client-ids]] [auto-ap.graphql.utils :refer [extract-client-ids]]
[auto-ap.query-params :as query-params] [auto-ap.query-params :as query-params]
[auto-ap.routes.admin.transaction-rules :as route] [auto-ap.routes.admin.transaction-rules :as route]
[auto-ap.routes.utils [auto-ap.routes.utils
:refer [wrap-admin wrap-client-redirect-unauthenticated]] :refer [wrap-admin wrap-client-redirect-unauthenticated]]
[auto-ap.rule-matching :as rm]
[auto-ap.solr :as solr]
[auto-ap.ssr-routes :as ssr-routes] [auto-ap.ssr-routes :as ssr-routes]
[auto-ap.ssr.company :refer [bank-account-typeahead*]] [auto-ap.ssr.company :refer [bank-account-typeahead*]]
[auto-ap.ssr.components :as com] [auto-ap.ssr.components :as com]
@@ -45,6 +49,8 @@
[auto-ap.time :as atime] [auto-ap.time :as atime]
[auto-ap.utils :refer [dollars=]] [auto-ap.utils :refer [dollars=]]
[bidi.bidi :as bidi] [bidi.bidi :as bidi]
[clj-time.coerce :as coerce]
[clojure.set :as set]
[clojure.string :as str] [clojure.string :as str]
[datomic.api :as dc] [datomic.api :as dc]
[malli.core :as mc])) [malli.core :as mc]))
@@ -306,73 +312,78 @@
:db/id :db/id
[:transaction/date :xform clj-time.coerce/from-date]]) [:transaction/date :xform clj-time.coerce/from-date]])
(defn transactions-matching-rule [{{:transaction-rule/keys [description client bank-account amount-lte amount-gte dom-lte dom-gte]}
(defn transaction-rule-test-table* [{{:transaction-rule/keys [description client bank-account amount-lte amount-gte dom-lte dom-gte yodlee-merchant]} :entity
:entity clients :clients
clients :clients only-uncoded? :only-uncoded?}]
checkboxes? :checkboxes?
only-uncoded? :only-uncoded?}]
(let [valid-clients (extract-client-ids clients (let [valid-clients (extract-client-ids clients
client) client)
query (cond-> {:query {:find ['(pull ?e read)] query (cond-> {:query {:find ['(pull ?e read)]
:in ['$ 'read] :in ['$ 'read]
:where []} :where []}
:args [(dc/db conn) transaction-read]} :args [(dc/db conn) transaction-read]}
description description
(merge-query {:query {:in ['?descr] (merge-query {:query {:in ['?descr]
:where ['[(iol-ion.query/->pattern ?descr) ?description-regex]]} :where ['[(iol-ion.query/->pattern ?descr) ?description-regex]]}
:args [description]}) :args [description]})
valid-clients valid-clients
(merge-query {:query {:in ['[?xx ...]] (merge-query {:query {:in ['[?xx ...]]
:where ['[?e :transaction/client ?xx]]} :where ['[?e :transaction/client ?xx]]}
:args [(set valid-clients)]}) :args [(set valid-clients)]})
bank-account bank-account
(merge-query {:query {:in ['?bank-account-id] (merge-query {:query {:in ['?bank-account-id]
:where ['[?e :transaction/bank-account ?bank-account-id]]} :where ['[?e :transaction/bank-account ?bank-account-id]]}
:args [bank-account]}) :args [bank-account]})
description description
(merge-query {:query {:where ['[?e :transaction/description-original ?do] (merge-query {:query {:where ['[?e :transaction/description-original ?do]
'[(re-find ?description-regex ?do)]]}}) '[(re-find ?description-regex ?do)]]}})
amount-gte amount-gte
(merge-query {:query {:in ['?amount-gte] (merge-query {:query {:in ['?amount-gte]
:where ['[?e :transaction/amount ?ta] :where ['[?e :transaction/amount ?ta]
'[(>= ?ta ?amount-gte)]]} '[(>= ?ta ?amount-gte)]]}
:args [amount-gte]}) :args [amount-gte]})
amount-lte amount-lte
(merge-query {:query {:in ['?amount-lte] (merge-query {:query {:in ['?amount-lte]
:where ['[?e :transaction/amount ?ta] :where ['[?e :transaction/amount ?ta]
'[(<= ?ta ?amount-lte)]]} '[(<= ?ta ?amount-lte)]]}
:args [amount-lte]}) :args [amount-lte]})
dom-lte dom-lte
(merge-query {:query {:in ['?dom-lte] (merge-query {:query {:in ['?dom-lte]
:where ['[?e :transaction/date ?transaction-date] :where ['[?e :transaction/date ?transaction-date]
'[(iol-ion.query/dom ?transaction-date) ?dom] '[(iol-ion.query/dom ?transaction-date) ?dom]
'[(<= ?dom ?dom-lte)]]} '[(<= ?dom ?dom-lte)]]}
:args [dom-lte]}) :args [dom-lte]})
dom-gte dom-gte
(merge-query {:query {:in ['?dom-gte] (merge-query {:query {:in ['?dom-gte]
:where ['[?e :transaction/date ?transaction-date] :where ['[?e :transaction/date ?transaction-date]
'[(iol-ion.query/dom ?transaction-date) ?dom] '[(iol-ion.query/dom ?transaction-date) ?dom]
'[(>= ?dom ?dom-gte)]]} '[(>= ?dom ?dom-gte)]]}
:args [dom-gte]}) :args [dom-gte]})
only-uncoded? only-uncoded?
(merge-query {:query {:where ['[or [?e :transaction/approval-status :transaction-approval-status/unapproved] (merge-query {:query {:where ['[or [?e :transaction/approval-status :transaction-approval-status/unapproved]
[(missing? $ ?e :transaction/approval-status)]]]}}) [(missing? $ ?e :transaction/approval-status)]]]}})
true true
(merge-query {:query {:where ['[?e :transaction/id]]}})) (merge-query {:query {:where ['[?e :transaction/id]]}}))
results (->> results (->>
(query2 query) (query2 query)
(map first))] (map first))]
results))
(defn transaction-rule-test-table* [{:keys [entity clients checkboxes? only-uncoded?]}]
(let [results (transactions-matching-rule
{:entity entity
:clients clients
:only-uncoded? only-uncoded?})]
[:div#transaction-test-results [:div#transaction-test-results
[:h2.my-4.text-lg.flex {:x-data (hx/json {:resultCount (count results)})} "Matching transactions" [:h2.my-4.text-lg.flex {:x-data (hx/json {:resultCount (count results)})} "Matching transactions"
@@ -710,6 +721,71 @@
client-id client-id
(some->> client-id (pull-attr (dc/db conn) :client/locations) client-id))))) (some->> client-id (pull-attr (dc/db conn) :client/locations) client-id)))))
(defn all-ids-not-locked [all-ids]
(->> all-ids
(dc/q '[:find ?t
:in $ [?t ...]
:where
[?t :transaction/client ?c]
[(get-else $ ?c :client/locked-until #inst "2000-01-01") ?lu]
[?t :transaction/date ?d]
[(>= ?d ?lu)]]
(dc/db conn))
(map first)))
(defn execute [{:keys [form-params clients entity identity]}]
(let [all-results (->> (transactions-matching-rule {:entity entity
:clients clients
:only-uncoded? true})
(map :db/id)
(into #{}))
ids (if (not-empty (:all form-params))
all-results
(set/intersection (into #{} (:transaction-id form-params))
all-results))
ids (all-ids-not-locked ids)
transactions (transduce
(comp
(map d-transactions/get-by-id)
(map #(update % :transaction/date coerce/to-date)))
conj
[]
ids)
entity (update entity :transaction-rule/description #(some-> % iol-ion.query/->pattern))
;; TODO
#_#_x (doseq [transaction transactions]
(when (not (rm/rule-applies? transaction entity))
(throw (ex-info "Transaction rule does not apply" {:validation-error "Transaction rule does not apply"
:transaction-rule entity
:transaction transaction})))
(when (:transaction/payment transaction)
(throw (ex-info "Transaction already associated with a payment" {:validation-error "Transaction already associated with a payment"}))))
]
(audit-transact (mapv (fn [t]
[:upsert-transaction
(remove-nils (rm/apply-rule {:db/id (:db/id t)
:transaction/amount (:transaction/amount t)}
entity
(or (-> t :transaction/bank-account :bank-account/locations)
(-> t :transaction/client :client/locations))))])
transactions)
identity)
(doseq [n transactions]
(solr/touch-with-ledger (:db/id n)))
(html-response [:div]
:headers {"hx-trigger" (hx/json {:modalclose ""
:notification (format "Successfully coded %d of %d transactions!"
(count ids)
(count all-results))})})))
(defn location-select [{{:keys [name account-id client-id value] :as qp} :query-params}] (defn location-select [{{:keys [name account-id client-id value] :as qp} :query-params}]
@@ -771,16 +847,20 @@
0 0
{} {}
[:div.p-2.flex.space-x-4 [:div "Transaction Rule"] [:div ">"] [:div "Results"]] [:div.p-2.flex.space-x-4 [:div "Transaction Rule"] [:div ">"] [:div "Results"]]
[:div#my-form [:form#my-form
{:hx-get (bidi/path-for ssr-routes/only-routes ::route/check-badges) {:hx-post (bidi/path-for ssr-routes/only-routes ::route/execute
:hx-trigger "change" :db/id (:db/id entity))
:hx-target "#transaction-test-results .gutter" :hx-indicator "#code"}
:hx-include "this"} [:div
(transaction-rule-test-table* {:entity entity {:hx-get (bidi/path-for ssr-routes/only-routes ::route/check-badges)
:clients clients :hx-trigger "change"
:checkboxes? true :hx-target "#transaction-test-results .gutter"
:only-uncoded? true})] :hx-include "this"}
[:div.flex.justify-end (com/validated-save-button {:form "my-form"} "Code transactions")])) (transaction-rule-test-table* {:entity entity
:clients clients
:checkboxes? true
:only-uncoded? true})]]
[:div.flex.justify-end (com/validated-save-button {:form "my-form" :id "code"} "Code transactions")]))
:headers (-> {} :headers (-> {}
(assoc "hx-trigger-after-settle" "modalnext") (assoc "hx-trigger-after-settle" "modalnext")
(assoc "hx-retarget" ".modal-stack") (assoc "hx-retarget" ".modal-stack")
@@ -821,6 +901,22 @@
(wrap-form-4xx-2 (-> edit-dialog (wrap-form-4xx-2 (-> edit-dialog
(wrap-entity [:form-params :db/id] default-read)))) (wrap-entity [:form-params :db/id] default-read))))
::route/execute (-> execute
(wrap-entity [:route-params :db/id] default-read)
(wrap-entity [:route-params :db/id] default-read)
(wrap-schema-decode :route-schema [:map [:db/id entity-id]])
(wrap-schema-decode :form-schema
[:map
[:transaction-id {:optional true}
[:maybe [:vector {:decode/arbitrary (fn [x] ;; TODO make this easier
(if (sequential? x)
x
[x]))}
entity-id]]]
[:all {:optional true} [:maybe :string]]])
#_(wrap-form-4xx-2 (-> edit-dialog ;; TODO for example not having a single one checked
(wrap-entity [:form-params :db/id] default-read))))
::route/test (-> test ::route/test (-> test
(wrap-entity [:form-params :db/id] default-read) (wrap-entity [:form-params :db/id] default-read)
(wrap-schema-decode :form-schema form-schema) (wrap-schema-decode :form-schema form-schema)

View File

@@ -5,6 +5,7 @@
[auto-ap.ssr-routes :as ssr-routes] [auto-ap.ssr-routes :as ssr-routes]
[auto-ap.client-routes :as client-routes] [auto-ap.client-routes :as client-routes]
[auto-ap.ssr.hx :as hx] [auto-ap.ssr.hx :as hx]
[auto-ap.routes.admin.transaction-rules :as transaction-rules]
[auto-ap.ssr.hiccup-helper :as hh])) [auto-ap.ssr.hiccup-helper :as hh]))
(defn menu-button- [params & children] (defn menu-button- [params & children]
@@ -214,7 +215,7 @@
[:li [:li
(menu-button- {:icon svg/cog (menu-button- {:icon svg/cog
:href (bidi/path-for ssr-routes/only-routes :admin-transaction-rules)} :href (bidi/path-for ssr-routes/only-routes ::transaction-rules/page)}
"Rules")] "Rules")]
[:li [:li

View File

@@ -8,7 +8,7 @@
(defn page- [{:keys [nav page-specific client client-selection identity app-params] :or {app-params {}}} & children] (defn page- [{:keys [nav page-specific client client-selection identity app-params] :or {app-params {}}} & children]
[:div#app {"_" (hiccup/raw " [:div#app {"_" (hiccup/raw "
on notification put event.detail.value into #notification-details then add .htmx-added to #notification-holder then remove .hidden from #notification-holder then wait 30ms then remove .htmx-added from #notification-holder on notification from body put event.detail.value into #notification-details then add .htmx-added to #notification-holder then remove .hidden from #notification-holder then wait 30ms then remove .htmx-added from #notification-holder
on htmx:responseError put event.detail.xhr.response into #error-details then add .htmx-added to #error-holder then remove .hidden from #error-holder then wait 30ms then remove .htmx-added from #error-holder" on htmx:responseError put event.detail.xhr.response into #error-details then add .htmx-added to #error-holder then remove .hidden from #error-holder then wait 30ms then remove .htmx-added from #error-holder"
) )
:x-data (hx/json {:leftNavShow true})} :x-data (hx/json {:leftNavShow true})}

View File

@@ -11,6 +11,7 @@
"/test" ::test "/test" ::test
"/new" {:get ::new-dialog} "/new" {:get ::new-dialog}
[[#"\d+" :db/id] "/edit"] ::edit-dialog [[#"\d+" :db/id] "/edit"] ::edit-dialog
[[#"\d+" :db/id] "/run"] ::execute-dialog [[#"\d+" :db/id] "/run"] {:get ::execute-dialog
:post ::execute}
"/check-badges" ::check-badges "/check-badges" ::check-badges
}) })