adds detailed tracing for ledger loads.
This commit is contained in:
@@ -19,6 +19,7 @@
|
|||||||
[com.walmartlabs.lacinia.util :refer [attach-resolvers]]
|
[com.walmartlabs.lacinia.util :refer [attach-resolvers]]
|
||||||
[datomic.api :as d]
|
[datomic.api :as d]
|
||||||
[mount.core :as mount]
|
[mount.core :as mount]
|
||||||
|
[com.brunobonacci.mulog :as mu]
|
||||||
[unilog.context :as lc]
|
[unilog.context :as lc]
|
||||||
[yang.scheduler :as scheduler]
|
[yang.scheduler :as scheduler]
|
||||||
[auto-ap.graphql.utils :refer [attach-tracing-resolvers]])
|
[auto-ap.graphql.utils :refer [attach-tracing-resolvers]])
|
||||||
@@ -291,175 +292,186 @@
|
|||||||
|
|
||||||
(defn import-ledger [context args _]
|
(defn import-ledger [context args _]
|
||||||
(assert-admin (:id context))
|
(assert-admin (:id context))
|
||||||
(lc/with-context {:area "import ledger"}
|
(let [all-vendors (mu/trace ::get-all-vendors
|
||||||
(let [all-vendors (->> (d/q '[:find [?e ...]
|
[]
|
||||||
:in $
|
(->> (d/q '[:find [?e ...]
|
||||||
:where [?e :vendor/name]]
|
:in $
|
||||||
(d/db conn))
|
:where [?e :vendor/name]]
|
||||||
(d/pull-many (d/db conn) d-vendors/default-read)
|
(d/db conn))
|
||||||
(by :vendor/name))
|
(d/pull-many (d/db conn) d-vendors/default-read)
|
||||||
all-clients (by :client/code (d-clients/get-all ))
|
(by :vendor/name)))
|
||||||
all-client-bank-accounts (reduce
|
all-clients (by :client/code (d-clients/get-all ))
|
||||||
(fn [acc client]
|
all-client-bank-accounts (reduce
|
||||||
(assoc acc (:client/code client)
|
(fn [acc client]
|
||||||
(set (->> (:client/bank-accounts client)
|
(assoc acc (:client/code client)
|
||||||
(map :bank-account/code)
|
(set (->> (:client/bank-accounts client)
|
||||||
))))
|
(map :bank-account/code)
|
||||||
{}
|
))))
|
||||||
(d-clients/get-all))
|
{}
|
||||||
all-client-locations (reduce
|
(d-clients/get-all))
|
||||||
(fn [acc client]
|
all-client-locations (reduce
|
||||||
(assoc acc (:client/code client)
|
(fn [acc client]
|
||||||
(-> (set (:client/locations client))
|
(assoc acc (:client/code client)
|
||||||
(conj "HQ")
|
(-> (set (:client/locations client))
|
||||||
(conj "A"))))
|
(conj "HQ")
|
||||||
{}
|
(conj "A"))))
|
||||||
(d-clients/get-all))
|
{}
|
||||||
new-hidden-vendors (reduce
|
(d-clients/get-all))
|
||||||
(fn [new-vendors {:keys [vendor_name]}]
|
new-hidden-vendors (reduce
|
||||||
(if (or (all-vendors vendor_name)
|
(fn [new-vendors {:keys [vendor_name]}]
|
||||||
(new-vendors vendor_name))
|
(if (or (all-vendors vendor_name)
|
||||||
new-vendors
|
(new-vendors vendor_name))
|
||||||
(assoc new-vendors vendor_name
|
new-vendors
|
||||||
{:vendor/name vendor_name
|
(assoc new-vendors vendor_name
|
||||||
:vendor/hidden true
|
{:vendor/name vendor_name
|
||||||
:db/id vendor_name})))
|
:vendor/hidden true
|
||||||
{}
|
:db/id vendor_name})))
|
||||||
(:entries args))
|
{}
|
||||||
_ (audit-transact-batch (vec (vals new-hidden-vendors)) (:id context))
|
(:entries args))
|
||||||
all-vendors (->> (d/q '[:find [?e ...]
|
_ (mu/trace ::upsert-new-vendors
|
||||||
:in $
|
[]
|
||||||
:where [?e :vendor/name]]
|
(audit-transact-batch (vec (vals new-hidden-vendors)) (:id context)))
|
||||||
(d/db conn))
|
all-vendors (->> (d/q '[:find [?e ...]
|
||||||
(d/pull-many (d/db conn) d-vendors/default-read)
|
:in $
|
||||||
(by :vendor/name))
|
:where [?e :vendor/name]]
|
||||||
all-accounts (transduce (map (comp str :account/numeric-code)) conj #{} (a/get-accounts))
|
(d/db conn))
|
||||||
transaction (doall (map
|
(d/pull-many (d/db conn) d-vendors/default-read)
|
||||||
(assoc-error (fn [entry]
|
(by :vendor/name))
|
||||||
(let [vendor (all-vendors (:vendor_name entry))]
|
all-accounts (transduce (map (comp str :account/numeric-code)) conj #{} (a/get-accounts))
|
||||||
(when-not (all-clients (:client_code entry))
|
transaction (mu/trace ::build-transaction
|
||||||
(throw (ex-info (str "Client '" (:client_code entry )"' not found.") {:status :error}) ))
|
[:count (count (:entries args))]
|
||||||
(when-not vendor
|
(doall (map
|
||||||
(throw (ex-info (str "Vendor '" (:vendor_name entry) "' not found.") {:status :error})))
|
(assoc-error (fn [entry]
|
||||||
(when-not (re-find #"\d{1,2}/\d{1,2}/\d{4}" (:date entry))
|
(let [vendor (all-vendors (:vendor_name entry))]
|
||||||
(throw (ex-info (str "Date must be MM/dd/yyyy") {:status :error})))
|
(when-not (all-clients (:client_code entry))
|
||||||
(when-let [locked-until (:client/locked-until (all-clients (:client_code entry)))]
|
(throw (ex-info (str "Client '" (:client_code entry )"' not found.") {:status :error}) ))
|
||||||
(when (and (not (t/after? (coerce/to-date-time (coerce/to-date (parse/parse-value :clj-time "MM/dd/yyyy" (:date entry))))
|
(when-not vendor
|
||||||
(coerce/to-date-time locked-until)))
|
(throw (ex-info (str "Vendor '" (:vendor_name entry) "' not found.") {:status :error})))
|
||||||
(not (t/equal? (coerce/to-date-time (coerce/to-date (parse/parse-value :clj-time "MM/dd/yyyy" (:date entry))))
|
(when-not (re-find #"\d{1,2}/\d{1,2}/\d{4}" (:date entry))
|
||||||
(coerce/to-date-time locked-until))))
|
(throw (ex-info (str "Date must be MM/dd/yyyy") {:status :error})))
|
||||||
(throw (ex-info (str "Client's data is locked until " locked-until) {:status :error}))))
|
(when-let [locked-until (:client/locked-until (all-clients (:client_code entry)))]
|
||||||
|
(when (and (not (t/after? (coerce/to-date-time (coerce/to-date (parse/parse-value :clj-time "MM/dd/yyyy" (:date entry))))
|
||||||
(when-not (dollars= (reduce (fnil + 0.0 0.0) 0.0 (map :debit (:line_items entry)))
|
(coerce/to-date-time locked-until)))
|
||||||
(reduce (fnil + 0.0 0.0) 0.0 (map :credit (:line_items entry))))
|
(not (t/equal? (coerce/to-date-time (coerce/to-date (parse/parse-value :clj-time "MM/dd/yyyy" (:date entry))))
|
||||||
(throw (ex-info (str "Debits '"
|
(coerce/to-date-time locked-until))))
|
||||||
(reduce (fnil + 0.0 0.0) 0 (map :debit (:line_items entry)))
|
(throw (ex-info (str "Client's data is locked until " locked-until) {:status :error}))))
|
||||||
"' and credits '"
|
|
||||||
(reduce (fnil + 0.0 0.0) 0 (map :credit (:line_items entry)))
|
(when-not (dollars= (reduce (fnil + 0.0 0.0) 0.0 (map :debit (:line_items entry)))
|
||||||
"' do not add up.")
|
(reduce (fnil + 0.0 0.0) 0.0 (map :credit (:line_items entry))))
|
||||||
{:status :error})))
|
(throw (ex-info (str "Debits '"
|
||||||
(when (dollars= (reduce (fnil + 0.0 0.0) 0.0 (map :debit (:line_items entry)))
|
(reduce (fnil + 0.0 0.0) 0 (map :debit (:line_items entry)))
|
||||||
0.0)
|
"' and credits '"
|
||||||
(throw (ex-info (str "Cannot have ledger entries that total $0.00")
|
(reduce (fnil + 0.0 0.0) 0 (map :credit (:line_items entry)))
|
||||||
{:status :ignored})))
|
"' do not add up.")
|
||||||
(assoc entry
|
{:status :error})))
|
||||||
:status :success
|
(when (dollars= (reduce (fnil + 0.0 0.0) 0.0 (map :debit (:line_items entry)))
|
||||||
:tx
|
0.0)
|
||||||
(remove-nils
|
(throw (ex-info (str "Cannot have ledger entries that total $0.00")
|
||||||
{:journal-entry/source (:source entry)
|
{:status :ignored})))
|
||||||
:journal-entry/client [:client/code (:client_code entry)]
|
(assoc entry
|
||||||
:journal-entry/date (coerce/to-date (parse/parse-value :clj-time "MM/dd/yyyy" (:date entry)))
|
:status :success
|
||||||
:journal-entry/external-id (:external_id entry)
|
:tx
|
||||||
:journal-entry/vendor (:db/id (all-vendors (:vendor_name entry)))
|
(remove-nils
|
||||||
:journal-entry/amount (:amount entry)
|
{:journal-entry/source (:source entry)
|
||||||
:journal-entry/note (:note entry)
|
:journal-entry/client [:client/code (:client_code entry)]
|
||||||
:journal-entry/cleared-against (:cleared_against entry)
|
:journal-entry/date (coerce/to-date (parse/parse-value :clj-time "MM/dd/yyyy" (:date entry)))
|
||||||
|
:journal-entry/external-id (:external_id entry)
|
||||||
|
:journal-entry/vendor (:db/id (all-vendors (:vendor_name entry)))
|
||||||
|
:journal-entry/amount (:amount entry)
|
||||||
|
:journal-entry/note (:note entry)
|
||||||
|
:journal-entry/cleared-against (:cleared_against entry)
|
||||||
|
|
||||||
:journal-entry/line-items
|
:journal-entry/line-items
|
||||||
(mapv (fn [ea]
|
(mapv (fn [ea]
|
||||||
(let [debit (or (:debit ea) 0.0)
|
(let [debit (or (:debit ea) 0.0)
|
||||||
credit (or (:credit ea) 0.0)]
|
credit (or (:credit ea) 0.0)]
|
||||||
(when (and (not (get
|
(when (and (not (get
|
||||||
(get all-client-locations (:client_code entry))
|
(get all-client-locations (:client_code entry))
|
||||||
(:location ea)))
|
(:location ea)))
|
||||||
(not= "A" (:location ea)))
|
(not= "A" (:location ea)))
|
||||||
(throw (ex-info (str "Location '" (:location ea) "' not found.")
|
(throw (ex-info (str "Location '" (:location ea) "' not found.")
|
||||||
{:status :error})))
|
{:status :error})))
|
||||||
(when (and (<= debit 0.0)
|
(when (and (<= debit 0.0)
|
||||||
(<= credit 0.0))
|
(<= credit 0.0))
|
||||||
(throw (ex-info (str "Line item amount " (or debit credit) " must be greater than 0.")
|
(throw (ex-info (str "Line item amount " (or debit credit) " must be greater than 0.")
|
||||||
{:status :error})))
|
{:status :error})))
|
||||||
(when (and (not (all-accounts (:account_identifier ea)))
|
(when (and (not (all-accounts (:account_identifier ea)))
|
||||||
(not (get
|
(not (get
|
||||||
(get all-client-bank-accounts (:client_code entry))
|
(get all-client-bank-accounts (:client_code entry))
|
||||||
(:account_identifier ea))))
|
(:account_identifier ea))))
|
||||||
(throw (ex-info (str "Account '" (:account_identifier ea) "' not found.")
|
(throw (ex-info (str "Account '" (:account_identifier ea) "' not found.")
|
||||||
{:status :error})))
|
{:status :error})))
|
||||||
(let [matching-account (when (re-matches #"^[0-9]+$" (:account_identifier ea))
|
(let [matching-account (when (re-matches #"^[0-9]+$" (:account_identifier ea))
|
||||||
(a/get-account-by-numeric-code-and-sets (Integer/parseInt (:account_identifier ea)) ["default"]))]
|
(a/get-account-by-numeric-code-and-sets (Integer/parseInt (:account_identifier ea)) ["default"]))]
|
||||||
(when (and matching-account
|
(when (and matching-account
|
||||||
(:account/location matching-account)
|
(:account/location matching-account)
|
||||||
(not= (:account/location matching-account)
|
(not= (:account/location matching-account)
|
||||||
(:location ea)))
|
(:location ea)))
|
||||||
(throw (ex-info (str "Account '"
|
(throw (ex-info (str "Account '"
|
||||||
(:account/numeric-code matching-account)
|
(:account/numeric-code matching-account)
|
||||||
"' requires location '"
|
"' requires location '"
|
||||||
(:account/location matching-account)
|
(:account/location matching-account)
|
||||||
"' but got '"
|
"' but got '"
|
||||||
(:location ea)
|
(:location ea)
|
||||||
"'")
|
"'")
|
||||||
{:status :error})))
|
{:status :error})))
|
||||||
|
|
||||||
(when (and matching-account
|
(when (and matching-account
|
||||||
(not (:account/location matching-account))
|
(not (:account/location matching-account))
|
||||||
(= "A" (:location ea)))
|
(= "A" (:location ea)))
|
||||||
(throw (ex-info (str "Account '"
|
(throw (ex-info (str "Account '"
|
||||||
(:account/numeric-code matching-account)
|
(:account/numeric-code matching-account)
|
||||||
"' cannot use location '"
|
"' cannot use location '"
|
||||||
(:location ea)
|
(:location ea)
|
||||||
"'")
|
"'")
|
||||||
{:status :error})))
|
{:status :error})))
|
||||||
(remove-nils (cond-> {:journal-entry-line/location (:location ea)
|
(remove-nils (cond-> {:journal-entry-line/location (:location ea)
|
||||||
:journal-entry-line/debit (when (> debit 0)
|
:journal-entry-line/debit (when (> debit 0)
|
||||||
debit)
|
debit)
|
||||||
:journal-entry-line/credit (when (> credit 0)
|
:journal-entry-line/credit (when (> credit 0)
|
||||||
credit)}
|
credit)}
|
||||||
matching-account (assoc :journal-entry-line/account (:db/id matching-account))
|
matching-account (assoc :journal-entry-line/account (:db/id matching-account))
|
||||||
(not matching-account) (assoc :journal-entry-line/account [:bank-account/code (:account_identifier ea)]))))))
|
(not matching-account) (assoc :journal-entry-line/account [:bank-account/code (:account_identifier ea)]))))))
|
||||||
(:line_items entry))
|
(:line_items entry))
|
||||||
|
|
||||||
:journal-entry/cleared true})))))
|
:journal-entry/cleared true})))))
|
||||||
(:entries args)))
|
(:entries args))))
|
||||||
errors (filter #(= (:status %) :error) transaction)
|
errors (filter #(= (:status %) :error) transaction)
|
||||||
ignored (filter #(= (:status %) :ignored) transaction)
|
ignored (filter #(= (:status %) :ignored) transaction)
|
||||||
success (filter #(= (:status %) :success) transaction)
|
success (filter #(= (:status %) :success) transaction)
|
||||||
retraction (mapv (fn [x] [:db/retractEntity [:journal-entry/external-id (:external_id x)]])
|
retraction (mapv (fn [x] [:db/retractEntity [:journal-entry/external-id (:external_id x)]])
|
||||||
success)
|
success)
|
||||||
ignore-retraction (->> ignored
|
ignore-retraction (->> ignored
|
||||||
(map :external_id )
|
(map :external_id )
|
||||||
(d/q '[:find [?je ...]
|
(d/q '[:find [?je ...]
|
||||||
:in $ [?ei ...]
|
:in $ [?ei ...]
|
||||||
:where [?je :journal-entry/external-id ?ei]]
|
:where [?je :journal-entry/external-id ?ei]]
|
||||||
(d/db conn)
|
(d/db conn)
|
||||||
)
|
)
|
||||||
(map (fn [je] [:db/retractEntity je])))]
|
(map (fn [je] [:db/retractEntity je])))]
|
||||||
(log/info "manual ledger import has " (count success) " new rows")
|
(log/info "manual ledger import has " (count success) " new rows")
|
||||||
(log/info errors)
|
(log/info errors)
|
||||||
|
|
||||||
|
|
||||||
(audit-transact-batch retraction (:id context))
|
(mu/trace ::retraction-tx
|
||||||
|
[:count (count retraction)]
|
||||||
|
(audit-transact-batch retraction (:id context)))
|
||||||
|
(mu/trace ::ignore-retraction-tx
|
||||||
|
[:count (count ignore-retraction)]
|
||||||
(when (seq ignore-retraction)
|
(when (seq ignore-retraction)
|
||||||
(audit-transact-batch ignore-retraction (:id context)))
|
(audit-transact-batch ignore-retraction (:id context))))
|
||||||
#_(log/info (map :tx success))
|
#_(log/info (map :tx success))
|
||||||
(audit-transact-batch (map :tx success) (:id context))
|
(mu/trace ::success-tx
|
||||||
|
[:count (count success)]
|
||||||
{:successful (map (fn [x] {:external_id (:external_id x)}) success)
|
(audit-transact-batch (map :tx success) (:id context)))
|
||||||
:ignored (map (fn [x]
|
|
||||||
{:external_id (:external_id x)})
|
{:successful (map (fn [x] {:external_id (:external_id x)}) success)
|
||||||
ignored)
|
:ignored (map (fn [x]
|
||||||
:existing []
|
{:external_id (:external_id x)})
|
||||||
:errors (map (fn [x] {:external_id (:external_id x)
|
ignored)
|
||||||
:error (:error x)}) errors)})))
|
:existing []
|
||||||
|
:errors (map (fn [x] {:external_id (:external_id x)
|
||||||
|
:error (:error x)}) errors)}))
|
||||||
|
|
||||||
(defn build-running-balance
|
(defn build-running-balance
|
||||||
([lookup-account all-ledger-entries]
|
([lookup-account all-ledger-entries]
|
||||||
|
|||||||
Reference in New Issue
Block a user