notid/integreat
1
0
Fork 0
Code Issues Pull Requests 2 Actions Packages Projects Releases Wiki Activity

(cloud) makes ledger correction mechanisms work again

Browse Source
This commit is contained in:
Bryce Covert
2023-03-31 16:07:30 -07:00
parent 6870aa416f
commit 55f941e07b
1 changed files with 114 additions and 89 deletions
Download Patch File Download Diff File Expand all files Collapse all files

203
src/clj/auto_ap/ledger.clj
View File

@@ -212,9 +212,9 @@
(defn touch-invoice [e] (defn touch-invoice [e]
(when-let [change (entity-change->ledger (dc/db conn) (when-let [change (entity-change->ledger (dc/db conn)
[:invoice e])] [:invoice e])]
(dc/transact conn [{:db/id "datomic.tx" (dc/transact conn {:tx-data [{:db/id "datomic.tx"
:db/doc "touching invoice to update ledger"} :db/doc "touching invoice to update ledger"}
`(upsert-ledger ~change)]))) `(upsert-ledger ~change)]})))
(defn lazy-tx-range (defn lazy-tx-range
([start end xf] (lazy-tx-range start end xf 0)) ([start end xf] (lazy-tx-range start end xf 0))
@@ -235,66 +235,70 @@
(defn recently-changed-entities [start end]
(set (map (fn [d]
(:e d))
(mapcat :data (dc/tx-range conn {:start start
:end end})))))
(defn entities-since-last-ledger-entry [] (defn recently-changed-entities [start end]
(count (dc/tx-range conn {:start (c/to-date (t/plus (t/now) (t/days -5))) (into #{}
:end (c/to-date (t/now))}))) (map first)
(dc/q '[:find ?e
:in $
:where (or [?e :transaction/date]
[?e :invoice/date])]
(dc/since (dc/db conn) start))))
(defn mismatched-transactions (defn mismatched-transactions
([] ([]
(mismatched-transactions (c/to-date (t/minus (t/now) (t/days 7))) (mismatched-transactions (c/to-date (t/minus (t/now) (t/days 7)))
(c/to-date (t/minus (t/now) (t/hours 1)))) ) (c/to-date (t/minus (t/now) (t/hours 1)))) )
([changed-between-start changed-between-end] ([changed-between-start changed-between-end]
(let [entities-to-consider (recently-changed-entities (mu/trace ::calculating-mismatched-transactions
changed-between-start [:range {:start changed-between-start
changed-between-end) :end changed-between-end}]
_ (log/info "checking" (count entities-to-consider) "transactions looking for mismatches between" changed-between-start changed-between-end) (let [entities-to-consider (recently-changed-entities
jel-accounts (reduce changed-between-start
(fn [acc [e lia]] changed-between-end)
(update acc e (fnil conj #{} ) lia)) _ (mu/log ::checking-mismatched-transactions
{} :count (count entities-to-consider))
(dc/q '[:find ?e ?lia jel-accounts (reduce
:in $ [?e ...] (fn [acc [e lia]]
:where (update acc e (fnil conj #{} ) lia))
[?je :journal-entry/original-entity ?e] {}
[?e :transaction/date] (dc/q '[:find ?e ?lia
[?je :journal-entry/line-items ?li] :in $ [?e ...]
[?li :journal-entry-line/account ?lia] :where
[?lia :account/name]] [?je :journal-entry/original-entity ?e]
(dc/db conn) [?e :transaction/date]
entities-to-consider)) [?je :journal-entry/line-items ?li]
transaction-accounts (reduce [?li :journal-entry-line/account ?lia]
(fn [acc [e lia]] [?lia :account/name]]
(update acc e (fnil conj #{} ) lia)) (dc/db conn)
{} entities-to-consider))
(dc/q '[:find ?e ?lia transaction-accounts (reduce
:in $ [?e ...] (fn [acc [e lia]]
:where (update acc e (fnil conj #{} ) lia))
[?e :transaction/date ?d] {}
[?e :transaction/accounts ?li] (dc/q '[:find ?e ?lia
(not [?e :transaction/approval-status :transaction-approval-status/excluded]) :in $ [?e ...]
(not [?e :transaction/approval-status :transaction-approval-status/suppressed]) :where
[?li :transaction-account/account ?lia] [?e :transaction/date ?d]
[?lia :account/name] [?e :transaction/accounts ?li]
[?e :transaction/amount ?amt] (not [?e :transaction/approval-status :transaction-approval-status/excluded])
[(not= ?amt 0.0)]] (not [?e :transaction/approval-status :transaction-approval-status/suppressed])
(dc/db conn) [?li :transaction-account/account ?lia]
entities-to-consider))] [?lia :account/name]
(->> transaction-accounts [?e :transaction/amount ?amt]
(filter [(not= ?amt 0.0)]]
(fn [[e accounts]] (not= accounts (get jel-accounts e)))))))) (dc/db conn)
entities-to-consider))]
(->> transaction-accounts
(filter
(fn [[e accounts]] (not= accounts (get jel-accounts e))))
(doall))))))
(defn unbalanced-transactions (defn unbalanced-transactions
([] (unbalanced-transactions (c/to-date (t/minus (t/now) (t/days 7))) ([] (unbalanced-transactions (c/to-date (t/minus (t/now) (t/days 7)))
(c/to-date (t/minus (t/now) (t/hours 1))))) (c/to-date (t/minus (t/now) (t/hours 1)))))
([changed-between-start changed-between-end] ([changed-between-start changed-between-end]
(let [entities-to-consider (recently-changed-entities changed-between-start changed-between-end)] (let [entities-to-consider (recently-changed-entities changed-between-start changed-between-end)]
(log/info "checking" (count entities-to-consider) "transaction journal entries looking for mismatches between" changed-between-start changed-between-end)
(->> (dc/q '[:find ?je ?a (sum ?debit) (sum ?credit) (->> (dc/q '[:find ?je ?a (sum ?debit) (sum ?credit)
:with ?jel :with ?jel
:in $ [?je ...] :in $ [?je ...]
@@ -321,7 +325,6 @@
(let [entities-to-consider (recently-changed-entities (let [entities-to-consider (recently-changed-entities
changed-between-start changed-between-start
changed-between-end)] changed-between-end)]
(log/info "checking" (count entities-to-consider) "invoice journal entries looking for mismatches between" changed-between-start changed-between-end)
(->> (dc/q '[:find ?je ?a (sum ?debit) (sum ?credit) (->> (dc/q '[:find ?je ?a (sum ?debit) (sum ?credit)
:with ?jel :with ?jel
:in $ [?je ...] :in $ [?je ...]
@@ -347,7 +350,6 @@
([changed-between-start changed-between-end] ([changed-between-start changed-between-end]
(let [entities-to-consider (recently-changed-entities changed-between-start changed-between-end) (let [entities-to-consider (recently-changed-entities changed-between-start changed-between-end)
_ (log/info (count entities-to-consider) "invoices have changed between" changed-between-start "and" changed-between-end)
jel-accounts (reduce jel-accounts (reduce
(fn [acc [e lia]] (fn [acc [e lia]]
(update acc e (fnil conj #{} ) lia)) (update acc e (fnil conj #{} ) lia))
@@ -391,44 +393,67 @@
:text "This process looks for unbalance ledger entries, or missing ledger entries" :text "This process looks for unbalance ledger entries, or missing ledger entries"
:priority :low} :priority :low}
nil) nil)
(log/info "Attempting to fix transactions that are in the ledger but are wrong") (mu/trace ::fixing-mismatched-transactions
(let [mismatched-ts (mismatched-transactions)] []
(if (seq mismatched-ts) (mu/log ::started-fixing-mismatched-transactions)
(do (let [mismatched-ts (mismatched-transactions)]
(log/warn (count mismatched-ts) " transactions exist but don't match ledger " (pr-str (take 10 mismatched-ts) )) (if (seq mismatched-ts)
(doseq [[m] mismatched-ts] (do
(touch-transaction m)) (mu/log ::found-mismatched-transactions
(statsd/gauge "data.mismatched_transactions" (count (mismatched-transactions)))) :status "WARN"
(statsd/gauge "data.mismatched_transactions" 0.0))) :count (count mismatched-ts)
(log/info "Attempting to fix transactions that are in the ledger but debits/credits don't add up") :sample (take 10 mismatched-ts))
(let [unbalanced-ts (unbalanced-transactions)] (doseq [[m] mismatched-ts]
(if (seq unbalanced-ts) (touch-transaction m))
(do (statsd/gauge "data.mismatched_transactions" (count (mismatched-transactions))))
(log/warn (count unbalanced-ts) " transactions exist but don't have matching debits/credits (" (pr-str (take 10 unbalanced-ts) ) ")") (statsd/gauge "data.mismatched_transactions" 0.0))))
(doseq [m unbalanced-ts]
(touch-transaction m)) (mu/trace ::fixing-unbalanced-transactions
(statsd/gauge "data.unbalanced_transactions" (count (unbalanced-transactions)))) []
(statsd/gauge "data.unbalanced_transactions" 0.0))) (mu/log ::started-fixing-unbalanced-transactions)
(log/info "Finished fixing transactions that are in the ledger but are wrong") (let [unbalanced-ts (unbalanced-transactions)]
(let [mismatched-is (mismatched-invoices)] (if (seq unbalanced-ts)
(if (seq mismatched-is) (do
(do (mu/log ::found-unbalanced-transactions
(log/warn (count mismatched-is) " invoice exist but don't match ledger ") :status "WARN"
(doseq [[m] mismatched-is] :count (count unbalanced-ts)
(touch-invoice m)) :sample (take 10 unbalanced-ts))
(statsd/gauge "data.mismatched_invoices" (count (mismatched-invoices)))) (doseq [m unbalanced-ts]
(statsd/gauge "data.mismatched_invoices" 0.0))) (touch-transaction m))
(log/info "Attempting to fix transactions that are in the ledger but debits/credits don't add up") (statsd/gauge "data.unbalanced_transactions" (count (unbalanced-transactions))))
(let [unbalanced-is (unbalanced-invoices)] (statsd/gauge "data.unbalanced_transactions" 0.0))))
(if (seq unbalanced-is)
(do
(log/warn (count unbalanced-is) " invoices exist but don't have matching debits/credits ") (mu/trace ::fixing-mismatched-invoices
(doseq [m unbalanced-is] []
(touch-invoice m)) (mu/log ::started-fixing-mismatched-invoices)
(statsd/gauge "data.unbalanced_invoices" (count (unbalanced-invoices)))) (let [mismatched-is (mismatched-invoices)]
(statsd/gauge "data.unbalanced_invoices" 0.0))) (if (seq mismatched-is)
(do
(mu/log ::found-mismatched-invoices
:status "WARN"
:count (count mismatched-is)
:sample (take 10 mismatched-is))
(doseq [[m] mismatched-is]
(touch-invoice m))
(statsd/gauge "data.mismatched_invoices" (count (mismatched-invoices))))
(statsd/gauge "data.mismatched_invoices" 0.0))))
(mu/trace ::fixing-unbalanced-invoices
[]
(mu/log ::started-fixing-unbalance-invoices)
(let [unbalanced-is (unbalanced-invoices)]
(if (seq unbalanced-is)
(do
(mu/log ::found-mismatched-invoices
:status "WARN"
:count (count unbalanced-is)
:sample (take 10 unbalanced-is))
(doseq [m unbalanced-is]
(touch-invoice m))
(statsd/gauge "data.unbalanced_invoices" (count (unbalanced-invoices))))
(statsd/gauge "data.unbalanced_invoices" 0.0))))
(log/info "Finish fixing invoices that are in the ledger but are wrong")
(statsd/event {:title "Finished Reconciling Ledger" (statsd/event {:title "Finished Reconciling Ledger"
:text "This process looks for unbalance ledger entries, or missing ledger entries" :text "This process looks for unbalance ledger entries, or missing ledger entries"
:priority :low} :priority :low}