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