fix(sales-summaries): stop days falling out of balance
Four faults were leaving restaurant days out of balance — one in the data, three in the arithmetic. Measured over ninety days on a restored copy of production (210 clients, 18,900 client-days): 1,258 days out of balance and $69,560.10 becomes 123 days and $2,970.35, of which only 33 are above ten cents. 1,135 days repaired, none knocked out of balance, and not one already-balanced day altered — verified line by line (category, side, amount to the cent, account), not just on each day's bottom line. THE DATA FAULT Ten Square locations were configured against two client records each. Sales orders scoped their identifier by client; refunds, card payments, payouts and cash-drawer shifts used the bare Square id. Those attributes are :db.unique/identity, so both clients' imports resolved to a single entity and the last writer won — 3,387 refunds, 4,069 payouts and 2,628 cash-drawer shifts changed hands over time, across 19 client pairs of which only 10 are visible in today's configuration. Worse, one payment could belong to two orders. :sales-order/charges is :db/isComponent, so removing a voided order cascaded into payments the other client still needed. Fixes: client-scope the four key schemes; look the record up under both schemes so the change deploys before the migration finishes; and a migration that gives every order its own payment. Run over the whole database that is 19,040,785 orders walked, 9,100,314 payments re-keyed and 200,027 copied, ending with 17,047,142 payments scoped, none left to rename, none unscopable, and no payment owned by more than one order. Idempotent and resumable; about thirteen minutes. THE ARITHMETIC FAULTS - Refunded tips stayed on the books. get-tip summed tips by joining through :sales-order/charges, so a return-only order — no tender to join through — contributed nothing while its reversal sat unread on :sales-order/tip. Additive, not substitutive: where an order does have a tender the tender is the correct source. - Service charges were collected but never earned. Nothing read :sales-order/service-charge. Now credited for Square orders only, both signs, behind summary-service-charges. - A refund on a day with no sales had nothing to offset it. Refunds are credited on the day the money goes back; the return that offsets them is read from that day's orders. get-returns now falls back to the day's refunded total, but only where the client recorded no sales orders at all — with no orders there is no order-derived return to double-count and no trading day can be moved. Behind summary-refund-only-returns. Both flags are off by default, so deploying this changes nothing until a client is opted in. docs/2026-08-15-sales-summary-rollout-plan.md has the steps. SUPPORTING - Install schema attributes before the tuples that compose them. A tuple in schema.edn is built from an attribute in cloud-migration-schema.edn, so every test fixture died in setup — very likely why sales summaries had no tests before this. - Log each day's imbalance and its suspect lines. - Bound the dirty-summary scan to one client: 1,321 ms to 5.6 ms. - compare-sales-summaries lives in test/clj as auto-ap.tools.* — it is a verification harness, not part of the running application. Its docstring now warns that d/as-of cannot be used to compare summary amounts: :ledger-mapped/amount, ledger-side and account are :db/noHistory, so a recomputed summary reads back with its amounts absent and looks like a legitimate balanced day. 28 tests, 65 assertions. Co-Authored-By: Claude Opus 5 <noreply@anthropic.com>
This commit is contained in:
149
test/clj/auto_ap/jobs/rekey_square_external_ids_test.clj
Normal file
149
test/clj/auto_ap/jobs/rekey_square_external_ids_test.clj
Normal file
@@ -0,0 +1,149 @@
|
||||
(ns auto-ap.jobs.rekey-square-external-ids-test
|
||||
(:require
|
||||
[auto-ap.datomic :refer [conn]]
|
||||
[auto-ap.integration.util :refer [setup-test-data wrap-setup]]
|
||||
[auto-ap.jobs.rekey-square-external-ids :as sut]
|
||||
[clojure.string]
|
||||
[clojure.test :refer [deftest is testing use-fixtures]]
|
||||
[datomic.api :as dc]))
|
||||
|
||||
(use-fixtures :each wrap-setup)
|
||||
|
||||
(def sales-date #inst "2026-08-01T07:00:00.000-00:00")
|
||||
|
||||
(defn- charge-count []
|
||||
(count (dc/q '[:find ?e :where [?e :charge/external-id]] (dc/db conn))))
|
||||
|
||||
(defn- charges-of [order]
|
||||
(->> (dc/datoms (dc/db conn) :eavt order :sales-order/charges)
|
||||
(map :v)
|
||||
(map (fn [c] {:eid c
|
||||
:key (:v (first (dc/datoms (dc/db conn) :eavt c :charge/external-id)))
|
||||
:total (:v (first (dc/datoms (dc/db conn) :eavt c :charge/total)))
|
||||
:tip (:v (first (dc/datoms (dc/db conn) :eavt c :charge/tip)))}))
|
||||
vec))
|
||||
|
||||
(defn- parents-of [charge]
|
||||
(reduce (fn [n _] (inc n)) 0 (dc/datoms (dc/db conn) :vaet charge :sales-order/charges)))
|
||||
|
||||
(defn- two-orders-sharing-one-charge []
|
||||
(let [{:strs [test-client-id]} (setup-test-data [])
|
||||
other (get-in @(dc/transact conn [{:db/id "other" :client/code "NGCC"}]) [:tempids "other"])
|
||||
tx @(dc/transact conn [{:db/id "charge"
|
||||
:charge/external-id "square/charge/shared1"
|
||||
:charge/type-name "CARD"
|
||||
:charge/total 120.0
|
||||
:charge/tip 20.0}
|
||||
{:db/id "order-a"
|
||||
:sales-order/external-id "square/order/NGCD-CD-o1"
|
||||
:sales-order/client test-client-id
|
||||
:sales-order/location "CD"
|
||||
:sales-order/date sales-date
|
||||
:sales-order/charges ["charge"]}
|
||||
{:db/id "order-b"
|
||||
:sales-order/external-id "square/order/NGCC-CC-o1"
|
||||
:sales-order/client other
|
||||
:sales-order/location "CC"
|
||||
:sales-order/date sales-date
|
||||
:sales-order/charges ["charge"]}])]
|
||||
{:order-a (get-in tx [:tempids "order-a"])
|
||||
:order-b (get-in tx [:tempids "order-b"])
|
||||
:charge (get-in tx [:tempids "charge"])
|
||||
:code-a (:client/code (dc/entity (dc/db conn) test-client-id))
|
||||
:code-b "NGCC"}))
|
||||
|
||||
(deftest a-shared-charge-starts-with-two-parents
|
||||
(testing "the condition under test really exists before the split runs"
|
||||
(let [{:keys [charge]} (two-orders-sharing-one-charge)]
|
||||
(is (= 1 (charge-count)))
|
||||
(is (= 2 (parents-of charge))
|
||||
"one charge entity, referenced by both clients' orders"))))
|
||||
|
||||
(deftest split-gives-each-order-its-own-charge
|
||||
(testing "each order ends up with its own charge, scoped to its own client, carrying the same
|
||||
amounts — so the component relationship means what it says and retracting one order
|
||||
cannot delete the other's payment"
|
||||
(let [{:keys [order-a order-b code-a code-b]} (two-orders-sharing-one-charge)
|
||||
result (sut/split-and-rekey-charges! [order-a order-b] 100)]
|
||||
(is (= {:rekeyed 1 :cloned 1} result) "first order keeps it, second gets a copy")
|
||||
(is (= 2 (charge-count)) "exactly one new entity was created")
|
||||
|
||||
(let [a (charges-of order-a)
|
||||
b (charges-of order-b)]
|
||||
(is (= 1 (count a)))
|
||||
(is (= 1 (count b)))
|
||||
(is (= (str "square/charge/" code-a "-CD-shared1") (:key (first a))))
|
||||
(is (= (str "square/charge/" code-b "-CC-shared1") (:key (first b))))
|
||||
(is (not= (:eid (first a)) (:eid (first b))) "two distinct entities")
|
||||
(is (= 120.0 (:total (first a)) (:total (first b))) "amounts copied")
|
||||
(is (= 20.0 (:tip (first a)) (:tip (first b))) "tips copied")
|
||||
(is (= 1 (parents-of (:eid (first a)))))
|
||||
(is (= 1 (parents-of (:eid (first b))))
|
||||
"no charge has more than one parent order any more")))))
|
||||
|
||||
(deftest split-leaves-an-unshared-charge-alone
|
||||
(testing "an order that already owns its charge outright is only re-keyed, never cloned"
|
||||
(let [{:strs [test-client-id]} (setup-test-data [])
|
||||
tx @(dc/transact conn [{:db/id "charge"
|
||||
:charge/external-id "square/charge/solo1"
|
||||
:charge/total 50.0}
|
||||
{:db/id "order"
|
||||
:sales-order/external-id "square/order/NGCD-CD-o2"
|
||||
:sales-order/client test-client-id
|
||||
:sales-order/location "CD"
|
||||
:sales-order/date sales-date
|
||||
:sales-order/charges ["charge"]}])
|
||||
order (get-in tx [:tempids "order"])
|
||||
code (:client/code (dc/entity (dc/db conn) test-client-id))]
|
||||
(is (= {:rekeyed 1 :cloned 0} (sut/split-and-rekey-charges! [order] 100)))
|
||||
(is (= 1 (charge-count)) "nothing was created")
|
||||
(is (= (str "square/charge/" code "-CD-solo1") (:key (first (charges-of order))))))))
|
||||
|
||||
(deftest split-is-idempotent
|
||||
(testing "re-running over an already-split database changes nothing further"
|
||||
(let [{:keys [order-a order-b]} (two-orders-sharing-one-charge)]
|
||||
(sut/split-and-rekey-charges! [order-a order-b] 100)
|
||||
(let [after-first (charge-count)]
|
||||
(is (= {:rekeyed 0 :cloned 0} (sut/split-and-rekey-charges! [order-a order-b] 100))
|
||||
"every charge already carries the key its order expects, so there is nothing to do")
|
||||
(is (= after-first (charge-count)) "and no further entities appear")))))
|
||||
|
||||
(deftest clone-is-not-double-scoped-across-batches
|
||||
(testing "with a batch size of one, the second order sees a charge already carrying the first
|
||||
client's scope. It must clone using the underlying Square id, not re-scope the scoped
|
||||
key — otherwise the entity ends up keyed NGCD-CD-NGCC-CC-<id>, the importer computes
|
||||
the correct key, misses, and creates a second charge that doubles the tender."
|
||||
(let [{:keys [order-a order-b code-a code-b]} (two-orders-sharing-one-charge)]
|
||||
(sut/split-and-rekey-charges! [order-a order-b] 1)
|
||||
(let [ka (:key (first (charges-of order-a)))
|
||||
kb (:key (first (charges-of order-b)))]
|
||||
(is (= (str "square/charge/" code-a "-CD-shared1") ka))
|
||||
(is (= (str "square/charge/" code-b "-CC-shared1") kb))
|
||||
(is (not (clojure.string/includes? kb (str code-a "-CD")))
|
||||
"the clone carries one scope, not two")
|
||||
(is (= 2 (charge-count)))))))
|
||||
|
||||
(deftest two-orders-of-the-same-client-keep-sharing
|
||||
(testing "one payment covering two of the SAME client's orders is left shared, on purpose.
|
||||
|
||||
There is no second name to give a copy — both orders compute the same one — and a copy
|
||||
would double that client's takings for the day. The component cascade still reaches
|
||||
these, which is why remove-voided-orders needs its own guard."
|
||||
(let [{:strs [test-client-id]} (setup-test-data [])
|
||||
tx @(dc/transact conn [{:db/id "charge"
|
||||
:charge/external-id "square/charge/same1"
|
||||
:charge/total 75.0}
|
||||
{:db/id "o1" :sales-order/external-id "square/order/x-1"
|
||||
:sales-order/client test-client-id :sales-order/location "CD"
|
||||
:sales-order/date sales-date :sales-order/charges ["charge"]}
|
||||
{:db/id "o2" :sales-order/external-id "square/order/x-2"
|
||||
:sales-order/client test-client-id :sales-order/location "CD"
|
||||
:sales-order/date sales-date :sales-order/charges ["charge"]}])
|
||||
o1 (get-in tx [:tempids "o1"]) o2 (get-in tx [:tempids "o2"])
|
||||
code (:client/code (dc/entity (dc/db conn) test-client-id))]
|
||||
(is (= {:rekeyed 1 :cloned 0} (sut/split-and-rekey-charges! [o1 o2] 100))
|
||||
"renamed once, not copied")
|
||||
(is (= 1 (charge-count)) "no copy was made, so the takings are not doubled")
|
||||
(is (= (str "square/charge/" code "-CD-same1") (:key (first (charges-of o1)))))
|
||||
(is (= (:eid (first (charges-of o1))) (:eid (first (charges-of o2))))
|
||||
"both orders still point at the one payment"))))
|
||||
204
test/clj/auto_ap/jobs/sales_summaries_test.clj
Normal file
204
test/clj/auto_ap/jobs/sales_summaries_test.clj
Normal file
@@ -0,0 +1,204 @@
|
||||
(ns auto-ap.jobs.sales-summaries-test
|
||||
(:require
|
||||
[auto-ap.datomic :refer [conn]]
|
||||
[auto-ap.datomic.sales-summaries :as d-ss]
|
||||
[auto-ap.integration.util :refer [setup-test-data wrap-setup]]
|
||||
[auto-ap.jobs.sales-summaries :as sut]
|
||||
[clojure.test :refer [deftest is testing use-fixtures]]
|
||||
[datomic.api :as dc]))
|
||||
|
||||
(use-fixtures :each wrap-setup)
|
||||
|
||||
(def sales-date #inst "2026-08-01T07:00:00.000-00:00")
|
||||
|
||||
(defn- order
|
||||
"A sales order on `sales-date`, carrying whatever the case under test needs. The external id
|
||||
is Square-shaped by default because `get-service-charges` falls back to it when an order has
|
||||
no `:sales-order/vendor`."
|
||||
[client id attrs]
|
||||
(merge {:db/id (str "order-" id)
|
||||
:sales-order/external-id (str "square/order/TEST-" id)
|
||||
:sales-order/client client
|
||||
:sales-order/date sales-date
|
||||
:sales-order/total 100.0}
|
||||
attrs))
|
||||
|
||||
(defn- charge [id attrs]
|
||||
(merge {:db/id (str "charge-" id)
|
||||
:charge/external-id (str "square/charge/" id)
|
||||
:charge/type-name "CARD"
|
||||
:charge/total 100.0}
|
||||
attrs))
|
||||
|
||||
(defn- tip-for [client]
|
||||
(:ledger-mapped/amount (#'sut/get-tip client sales-date)))
|
||||
|
||||
(defn- service-charges-for [client]
|
||||
(#'sut/get-service-charges client sales-date))
|
||||
|
||||
(defn- enable-service-charges! [client]
|
||||
@(dc/transact conn [{:db/id client
|
||||
:client/feature-flags [sut/service-charges-flag]}]))
|
||||
|
||||
(deftest tip-counts-a-reversal-on-an-untendered-order
|
||||
(testing "a return-only order has no tender to join through, so its negative tip must come
|
||||
from the order or the day credits a tip that was handed back"
|
||||
(let [{:strs [test-client-id]} (setup-test-data [])]
|
||||
@(dc/transact conn [(order test-client-id "return-only" {:sales-order/tip -12.0})])
|
||||
(is (= -12.0 (tip-for test-client-id))))))
|
||||
|
||||
(deftest tip-on-a-tendered-order-still-comes-from-the-tender
|
||||
(testing "the tender carries a tip the order does not — auto-gratuity booked as a service
|
||||
charge. Reading the order instead of the tender would drop it."
|
||||
(let [{:strs [test-client-id]} (setup-test-data [])]
|
||||
@(dc/transact conn [(order test-client-id "tendered"
|
||||
{:sales-order/tip 0.0
|
||||
:sales-order/charges [(charge "tendered" {:charge/tip 50.0})]})])
|
||||
(is (= 50.0 (tip-for test-client-id))))))
|
||||
|
||||
(deftest tip-on-an-ordinary-order-is-counted-once
|
||||
(testing "an order that agrees with its tender is not double counted by the additive form"
|
||||
(let [{:strs [test-client-id]} (setup-test-data [])]
|
||||
@(dc/transact conn [(order test-client-id "ordinary"
|
||||
{:sales-order/tip 5.0
|
||||
:sales-order/charges [(charge "ordinary" {:charge/tip 5.0})]})])
|
||||
(is (= 5.0 (tip-for test-client-id))))))
|
||||
|
||||
(deftest service-charges-need-the-feature-flag
|
||||
(testing "without the flag the summary behaves exactly as it does today"
|
||||
(let [{:strs [test-client-id]} (setup-test-data [])]
|
||||
@(dc/transact conn [(order test-client-id "square-sc"
|
||||
{:sales-order/vendor :vendor/ccp-square
|
||||
:sales-order/service-charge 50.0})])
|
||||
(is (nil? (service-charges-for test-client-id))))))
|
||||
|
||||
(deftest service-charges-credit-square-orders
|
||||
(testing "a service charge rides along in the tender, so it needs a credit to match"
|
||||
(let [{:strs [test-client-id]} (setup-test-data [])]
|
||||
(enable-service-charges! test-client-id)
|
||||
@(dc/transact conn [(order test-client-id "square-sc"
|
||||
{:sales-order/vendor :vendor/ccp-square
|
||||
:sales-order/service-charge 50.0})])
|
||||
(let [item (service-charges-for test-client-id)]
|
||||
(is (= 50.0 (:ledger-mapped/amount item)))
|
||||
(is (= :ledger-side/credit (:ledger-mapped/ledger-side item)))
|
||||
(is (= "Service Charges" (:sales-summary-item/category item)))))))
|
||||
|
||||
(deftest service-charges-count-both-signs
|
||||
(testing "a returned catering fee arrives as a negative service charge and is subtracted back
|
||||
out of returns, so dropping negatives loses the reversal"
|
||||
(let [{:strs [test-client-id]} (setup-test-data [])]
|
||||
(enable-service-charges! test-client-id)
|
||||
@(dc/transact conn [(order test-client-id "refunded-fee"
|
||||
{:sales-order/vendor :vendor/ccp-square
|
||||
:sales-order/service-charge -140.0})])
|
||||
(is (= -140.0 (:ledger-mapped/amount (service-charges-for test-client-id)))))))
|
||||
|
||||
(deftest service-charges-exclude-non-square-vendors
|
||||
(testing "ezCater service charges are commission deducted from the restaurant rather than
|
||||
collected from the diner, so crediting them would make the day worse"
|
||||
(let [{:strs [test-client-id]} (setup-test-data [])]
|
||||
(enable-service-charges! test-client-id)
|
||||
@(dc/transact conn [(order test-client-id "ezcater-sc"
|
||||
{:sales-order/external-id "ezcater/order/TEST-ezcater-sc"
|
||||
:sales-order/vendor :vendor/ccp-ezcater
|
||||
:sales-order/service-charge -75.0})])
|
||||
(is (nil? (service-charges-for test-client-id))))))
|
||||
|
||||
(deftest service-charges-recognise-square-orders-that-carry-no-vendor
|
||||
(testing "whole eras of Square orders have no :sales-order/vendor at all; a gate on vendor
|
||||
alone would silently credit nothing"
|
||||
(let [{:strs [test-client-id]} (setup-test-data [])]
|
||||
(enable-service-charges! test-client-id)
|
||||
@(dc/transact conn [(order test-client-id "vendorless" {:sales-order/service-charge 12.5})])
|
||||
(is (= 12.5 (:ledger-mapped/amount (service-charges-for test-client-id)))))))
|
||||
|
||||
(deftest service-charges-ignore-vendorless-orders-from-other-sources
|
||||
(testing "the external id fallback is Square-specific, not a catch-all for missing vendors"
|
||||
(let [{:strs [test-client-id]} (setup-test-data [])]
|
||||
(enable-service-charges! test-client-id)
|
||||
@(dc/transact conn [(order test-client-id "ezcater-vendorless"
|
||||
{:sales-order/external-id "ezcater/order/TEST-ezcater-vendorless"
|
||||
:sales-order/service-charge -75.0})])
|
||||
(is (nil? (service-charges-for test-client-id))))))
|
||||
|
||||
(defn- refund
|
||||
"A card refund on `sales-date`. The client+date tuple is set explicitly because
|
||||
`scan-sales-refunds` walks that index rather than the plain attributes."
|
||||
[client id total]
|
||||
{:db/id (str "refund-" id)
|
||||
:sales-refund/external-id (str "square/refund/TEST-" id)
|
||||
:sales-refund/client client
|
||||
:sales-refund/date sales-date
|
||||
:sales-refund/client+date [client sales-date]
|
||||
:sales-refund/type "CARD"
|
||||
:sales-refund/total total})
|
||||
|
||||
(defn- enable-refund-only-returns! [client]
|
||||
@(dc/transact conn [{:db/id client
|
||||
:client/feature-flags [sut/refund-only-returns-flag]}]))
|
||||
|
||||
(defn- returns-for [client]
|
||||
(#'sut/get-returns client sales-date))
|
||||
|
||||
(deftest refund-only-day-needs-the-feature-flag
|
||||
(testing "without the flag a day of refunds and no sales books no return, as it does today"
|
||||
(let [{:strs [test-client-id]} (setup-test-data [])]
|
||||
@(dc/transact conn [(refund test-client-id "unflagged" 40.0)])
|
||||
(is (nil? (returns-for test-client-id))))))
|
||||
|
||||
(deftest refund-only-day-books-a-return_and_balances
|
||||
(testing "a refund credited on a day with no sales has nothing to offset it, so the day is out
|
||||
by the refunded amount until a return is recognised against it"
|
||||
(let [{:strs [test-client-id]} (setup-test-data [])]
|
||||
(enable-refund-only-returns! test-client-id)
|
||||
@(dc/transact conn [(refund test-client-id "orphan-a" 30.0)
|
||||
(refund test-client-id "orphan-b" 10.0)])
|
||||
(let [returns (returns-for test-client-id)]
|
||||
(is (= 40.0 (:ledger-mapped/amount returns)))
|
||||
(is (= :ledger-side/debit (:ledger-mapped/ledger-side returns)))
|
||||
(is (= 0.0 (d-ss/imbalance (cons returns (sut/get-refund-items test-client-id sales-date))))
|
||||
"the refund credits and the return debit cancel exactly")))))
|
||||
|
||||
(deftest a-day-that-traded-keeps-its-order-derived-return
|
||||
(testing "the guard is what makes this safe: a day with sales is left entirely alone, so no
|
||||
trading day can have its return moved by an unmatched refund"
|
||||
(let [{:strs [test-client-id]} (setup-test-data [])]
|
||||
(enable-refund-only-returns! test-client-id)
|
||||
@(dc/transact conn [(order test-client-id "traded" {:sales-order/returns 7.0})
|
||||
(refund test-client-id "same-day" 40.0)])
|
||||
(is (= 7.0 (:ledger-mapped/amount (returns-for test-client-id)))
|
||||
"the order's own return, not the refunded total"))))
|
||||
|
||||
(deftest a-day-that-traded-and-returned-nothing-books-no-return
|
||||
(testing "sales with no returns must not pick up the refunded total either — the guard is on
|
||||
whether the client traded, not on whether the order-derived figure happened to be nil"
|
||||
(let [{:strs [test-client-id]} (setup-test-data [])]
|
||||
(enable-refund-only-returns! test-client-id)
|
||||
@(dc/transact conn [(order test-client-id "traded-no-returns" {})
|
||||
(refund test-client-id "unmatched" 40.0)])
|
||||
(is (nil? (returns-for test-client-id))))))
|
||||
|
||||
(deftest dirty-summaries-stop-at-the-client-boundary
|
||||
(testing "every dirty day for the client is returned, and none belonging to another client.
|
||||
|
||||
:sales-summary/client+dirty sorts by client, so an unbounded index scan would walk
|
||||
every later client's summaries too — correct, but quadratic in the summary count."
|
||||
(let [{:strs [test-client-id]} (setup-test-data [])
|
||||
other (get-in @(dc/transact conn [{:db/id "other" :client/code (str "OTHER" (rand-int 100000))}])
|
||||
[:tempids "other"])
|
||||
day (fn [client d dirty?]
|
||||
{:sales-summary/client client
|
||||
:sales-summary/date d
|
||||
:sales-summary/dirty dirty?})]
|
||||
@(dc/transact conn [(day test-client-id #inst "2026-08-01T07:00:00.000-00:00" true)
|
||||
(day test-client-id #inst "2026-08-02T07:00:00.000-00:00" true)
|
||||
(day test-client-id #inst "2026-08-03T07:00:00.000-00:00" false)
|
||||
(day other #inst "2026-08-01T07:00:00.000-00:00" true)
|
||||
(day other #inst "2026-08-02T07:00:00.000-00:00" true)])
|
||||
(let [mine (sut/dirty-sales-summaries test-client-id)]
|
||||
(is (= 2 (count mine)) "both dirty days, and not the clean one")
|
||||
(is (every? #(= test-client-id (:db/id (:sales-summary/client %))) mine)
|
||||
"and nothing belonging to the other client"))
|
||||
(is (= 2 (count (sut/dirty-sales-summaries other)))
|
||||
"the other client's own dirty days are still found"))))
|
||||
118
test/clj/auto_ap/square/core3_test.clj
Normal file
118
test/clj/auto_ap/square/core3_test.clj
Normal file
@@ -0,0 +1,118 @@
|
||||
(ns auto-ap.square.core3-test
|
||||
(:require
|
||||
[auto-ap.datomic :refer [conn]]
|
||||
[auto-ap.integration.util :refer [setup-test-data wrap-setup]]
|
||||
[auto-ap.square.core3 :as sut]
|
||||
[clojure.test :refer [deftest is testing use-fixtures]]
|
||||
[datomic.api :as dc]))
|
||||
|
||||
(use-fixtures :each wrap-setup)
|
||||
|
||||
(def client {:client/code "NGCD"})
|
||||
(def location {:square-location/client-location "CD"})
|
||||
|
||||
(defn- refund-count []
|
||||
(count (dc/q '[:find ?e :where [?e :sales-refund/external-id]] (dc/db conn))))
|
||||
|
||||
(defn- resolve-refund [id]
|
||||
(sut/existing-id (dc/db conn) :sales-refund/external-id "square/refund/" client location id))
|
||||
|
||||
(deftest scoped-key-carries-client-and-location
|
||||
(testing "the same shape sales order keys already use, so a shared location cannot contend"
|
||||
(is (= "square/refund/NGCD-CD-abc" (sut/scoped-key "square/refund/" client location "abc")))
|
||||
(is (= "square/charge/NGCD-CD-xyz" (sut/scoped-key "square/charge/" client location "xyz")))))
|
||||
|
||||
(deftest legacy-keyed-entity-is-updated-not-duplicated
|
||||
(testing "an entity still carrying its unscoped key is found and re-keyed in place.
|
||||
|
||||
This is the sharpest hazard in the migration: these external ids are
|
||||
:db.unique/identity, so writing the new key without resolving the old one first
|
||||
matches nothing and creates a second entity, orphaning the original."
|
||||
(setup-test-data [])
|
||||
@(dc/transact conn [{:db/id "r"
|
||||
:sales-refund/external-id "square/refund/abc"
|
||||
:sales-refund/total 10.0}])
|
||||
(is (= 1 (refund-count)))
|
||||
(let [eid (resolve-refund "abc")]
|
||||
(is (some? eid) "resolves an entity carrying the legacy key")
|
||||
@(dc/transact conn [{:db/id eid
|
||||
:sales-refund/external-id (sut/scoped-key "square/refund/" client location "abc")
|
||||
:sales-refund/total 10.0}])
|
||||
(is (= 1 (refund-count)) "no second entity was created")
|
||||
(is (= eid (dc/entid (dc/db conn) [:sales-refund/external-id "square/refund/NGCD-CD-abc"]))
|
||||
"the same entity now answers to the scoped key")
|
||||
(is (nil? (dc/entid (dc/db conn) [:sales-refund/external-id "square/refund/abc"]))
|
||||
"and no longer to the legacy one"))))
|
||||
|
||||
(deftest already-scoped-entity-resolves-by-its-new-key
|
||||
(testing "re-running the importer after migration finds the entity by the scoped key, so the
|
||||
migration is not undone and nothing is duplicated"
|
||||
(setup-test-data [])
|
||||
@(dc/transact conn [{:db/id "r"
|
||||
:sales-refund/external-id "square/refund/NGCD-CD-abc"
|
||||
:sales-refund/total 10.0}])
|
||||
(is (= (dc/entid (dc/db conn) [:sales-refund/external-id "square/refund/NGCD-CD-abc"])
|
||||
(resolve-refund "abc")))
|
||||
(is (= 1 (refund-count)))))
|
||||
|
||||
(deftest unknown-id-resolves-to-nothing
|
||||
(testing "a refund never seen before has no id to pin, so the importer creates it fresh"
|
||||
(setup-test-data [])
|
||||
(is (nil? (resolve-refund "never-seen")))))
|
||||
|
||||
(deftest two-clients-on-one-location-get-their-own-entities
|
||||
(testing "the point of the re-key: with the client in the key, a second client importing the
|
||||
same Square refund creates its own entity instead of taking ownership of the first"
|
||||
(setup-test-data [])
|
||||
(let [other {:client/code "NGCC"}
|
||||
other-loc {:square-location/client-location "CC"}]
|
||||
@(dc/transact conn [{:db/id "r"
|
||||
:sales-refund/external-id (sut/scoped-key "square/refund/" client location "shared")
|
||||
:sales-refund/total 10.0}])
|
||||
(is (nil? (sut/existing-id (dc/db conn) :sales-refund/external-id "square/refund/" other other-loc "shared"))
|
||||
"the second client does not resolve onto the first client's entity")
|
||||
@(dc/transact conn [{:db/id "r2"
|
||||
:sales-refund/external-id (sut/scoped-key "square/refund/" other other-loc "shared")
|
||||
:sales-refund/total 10.0}])
|
||||
(is (= 2 (refund-count)) "two stable entities, one per client, rather than one that flips"))))
|
||||
|
||||
(deftest payouts-and-shifts-are-client-scoped-too
|
||||
(testing "expected deposits and cash drawer shifts are fetched per location, so two clients on
|
||||
one location collide on them exactly as refunds and charges did"
|
||||
(is (= "square/payout/NGCD-CD-po1"
|
||||
(sut/scoped-key "square/payout/" client location "po1")))
|
||||
(is (= "square/cash-drawer-shift/NGCD-CD-sh1"
|
||||
(sut/scoped-key "square/cash-drawer-shift/" client location "sh1")))))
|
||||
|
||||
(deftest legacy-keyed-deposit-is-updated-not-duplicated
|
||||
(testing "a payout still carrying its unscoped key is found and re-keyed in place"
|
||||
(setup-test-data [])
|
||||
@(dc/transact conn [{:db/id "d"
|
||||
:expected-deposit/external-id "square/payout/po1"
|
||||
:expected-deposit/total 100.0}])
|
||||
(let [eid (sut/existing-id (dc/db conn) :expected-deposit/external-id "square/payout/" client location "po1")]
|
||||
(is (some? eid) "resolves the entity carrying the legacy key")
|
||||
@(dc/transact conn [{:db/id eid
|
||||
:expected-deposit/external-id (sut/scoped-key "square/payout/" client location "po1")
|
||||
:expected-deposit/total 100.0}])
|
||||
(is (= 1 (count (dc/q '[:find ?e :where [?e :expected-deposit/external-id]] (dc/db conn))))
|
||||
"no second deposit was created")
|
||||
(is (nil? (dc/entid (dc/db conn) [:expected-deposit/external-id "square/payout/po1"]))
|
||||
"the legacy key is gone"))))
|
||||
|
||||
(deftest two-clients-get-their-own-deposit
|
||||
(testing "with the client in the key, a second client importing the same Square payout creates
|
||||
its own entity instead of taking ownership of the first"
|
||||
(setup-test-data [])
|
||||
(let [other {:client/code "NGCC"}
|
||||
other-loc {:square-location/client-location "CC"}]
|
||||
@(dc/transact conn [{:db/id "d"
|
||||
:expected-deposit/external-id (sut/scoped-key "square/payout/" client location "shared")
|
||||
:expected-deposit/total 100.0}])
|
||||
(is (nil? (sut/existing-id (dc/db conn) :expected-deposit/external-id "square/payout/" other other-loc "shared"))
|
||||
"the second client does not resolve onto the first client's deposit")
|
||||
@(dc/transact conn [{:db/id "d2"
|
||||
:expected-deposit/external-id (sut/scoped-key "square/payout/" other other-loc "shared")
|
||||
:expected-deposit/total 100.0}])
|
||||
(is (= 2 (count (dc/q '[:find ?e :where [?e :expected-deposit/external-id]] (dc/db conn))))
|
||||
"two stable entities, one per client, rather than one that flips"))))
|
||||
153
test/clj/auto_ap/tools/compare_sales_summaries.clj
Normal file
153
test/clj/auto_ap/tools/compare_sales_summaries.clj
Normal file
@@ -0,0 +1,153 @@
|
||||
(ns auto-ap.tools.compare-sales-summaries
|
||||
"Compares sales summaries between two points in the same database.
|
||||
|
||||
A verification tool, not part of the running application: it lives on the test/dev classpath so
|
||||
nothing in production can depend on it. Load it from a REPL when auditing a recompute.
|
||||
|
||||
The question this exists to answer is narrower than \"did the totals improve\": it is *which
|
||||
days changed, and were any of them already balanced*. A day that was balanced before and still
|
||||
balances after can still have had its line amounts move, and that is a real change to the
|
||||
books even though no red turns green. Counting only balanced/unbalanced transitions would hide
|
||||
it entirely.
|
||||
|
||||
DO NOT USE `compare-against` — OR ANY `d/as-of` DATABASE — TO COMPARE AMOUNTS. The obvious
|
||||
reading is that Datomic keeps every past value, so a recompute can be audited against what was
|
||||
there before with no snapshot. That does not hold here: `:ledger-mapped/amount`,
|
||||
`:ledger-mapped/ledger-side` and `:ledger-mapped/account` are all `:db/noHistory true`, so
|
||||
superseded values are discarded rather than retained. A summary that has since been recomputed
|
||||
reads back through `as-of` with its categories intact and its amounts *absent* — which is
|
||||
indistinguishable from a legitimate all-zero day, and quietly turns every rewritten summary
|
||||
into a false \"was balanced, still balances\".
|
||||
|
||||
To compare amounts, capture `summaries-in` from a live `(d/db conn)` immediately after each
|
||||
run, keep the two captures outside the database, and diff those. `compare-window` is safe when
|
||||
both arguments are live database values; only the historical read is unsound. Categories and
|
||||
which-days-changed do survive `as-of`, since `:sales-summary-item/category` retains history."
|
||||
(:require
|
||||
[auto-ap.datomic :refer [conn]]
|
||||
[auto-ap.datomic.sales-summaries :as d-ss]
|
||||
[clj-time.coerce :as c]
|
||||
[datomic.api :as dc]))
|
||||
|
||||
(def item-read
|
||||
[:sales-summary-item/category
|
||||
:sales-summary-item/manual?
|
||||
:ledger-mapped/amount
|
||||
{:ledger-mapped/ledger-side [:db/ident]}
|
||||
{:ledger-mapped/account [:account/numeric-code]}])
|
||||
|
||||
(defn- cents
|
||||
"Amounts are doubles carrying float noise, so compare them at the cent — the unit the books are
|
||||
actually kept in. Without this, 182.87000000000003 and 182.87 read as a change."
|
||||
[x]
|
||||
(Math/round (* 100.0 (double (or x 0.0)))))
|
||||
|
||||
(defn- line
|
||||
"One item reduced to what a reader would call \"the number\": category, side, amount, account."
|
||||
[item]
|
||||
{:category (:sales-summary-item/category item)
|
||||
:side (get-in item [:ledger-mapped/ledger-side :db/ident])
|
||||
:cents (cents (:ledger-mapped/amount item))
|
||||
:account (get-in item [:ledger-mapped/account :account/numeric-code])})
|
||||
|
||||
(defn summaries-in
|
||||
"`{[client-code date] {:lines … :imbalance … :balanced?}}` for every summary in `[start end)`.
|
||||
|
||||
Keyed by client code and date rather than entity id so the two sides line up even if an entity
|
||||
were recreated between the points being compared."
|
||||
[db start end]
|
||||
(->> (dc/q {:find [(list 'pull '?s [:sales-summary/date
|
||||
{:sales-summary/client [:client/code]}
|
||||
{:sales-summary/items item-read}])]
|
||||
:in '[$ ?start ?end]
|
||||
:where '[[?s :sales-summary/date ?d]
|
||||
[(>= ?d ?start)]
|
||||
[(< ?d ?end)]]}
|
||||
db (c/to-date start) (c/to-date end))
|
||||
(map first)
|
||||
(reduce (fn [acc s]
|
||||
(let [items (map d-ss/<-pulled-item (:sales-summary/items s))]
|
||||
(assoc acc
|
||||
[(get-in s [:sales-summary/client :client/code]) (:sales-summary/date s)]
|
||||
{:lines (frequencies (map line (:sales-summary/items s)))
|
||||
:imbalance (d-ss/imbalance items)
|
||||
:balanced? (d-ss/balanced? items)})))
|
||||
{})))
|
||||
|
||||
(defn- classify
|
||||
"How one client-day differs. `:numbers-changed` is the interesting one — the lines themselves
|
||||
moved, whether or not the day's balance status did."
|
||||
[before after]
|
||||
(cond
|
||||
(nil? before) :added
|
||||
(nil? after) :removed
|
||||
(= (:lines before) (:lines after)) :identical
|
||||
:else :numbers-changed))
|
||||
|
||||
(defn compare-window
|
||||
"Compares every summary in `[start end)` between two database values.
|
||||
|
||||
Returns per-day rows plus the tallies worth reporting, including the one that is easy to miss:
|
||||
days that were **already balanced** and whose numbers moved anyway."
|
||||
[before-db after-db start end]
|
||||
(let [before (summaries-in before-db start end)
|
||||
after (summaries-in after-db start end)
|
||||
rows (for [k (distinct (concat (keys before) (keys after)))
|
||||
:let [b (get before k) a (get after k)]]
|
||||
{:client (first k)
|
||||
:date (second k)
|
||||
:change (classify b a)
|
||||
:was-balanced? (:balanced? b)
|
||||
:now-balanced? (:balanced? a)
|
||||
:before-imbalance (:imbalance b)
|
||||
:after-imbalance (:imbalance a)
|
||||
:lines-before (:lines b)
|
||||
:lines-after (:lines a)})
|
||||
rows (vec rows)
|
||||
changed (filter #(= :numbers-changed (:change %)) rows)]
|
||||
{:rows rows
|
||||
:tally {:compared (count rows)
|
||||
:identical (count (filter #(= :identical (:change %)) rows))
|
||||
:numbers-changed (count changed)
|
||||
:added (count (filter #(= :added (:change %)) rows))
|
||||
:removed (count (filter #(= :removed (:change %)) rows))}
|
||||
:balance-transitions
|
||||
{:unbalanced->balanced (count (filter #(and (false? (:was-balanced? %)) (true? (:now-balanced? %))) rows))
|
||||
:balanced->unbalanced (count (filter #(and (true? (:was-balanced? %)) (false? (:now-balanced? %))) rows))
|
||||
:stayed-balanced (count (filter #(and (true? (:was-balanced? %)) (true? (:now-balanced? %))) rows))
|
||||
:stayed-unbalanced (count (filter #(and (false? (:was-balanced? %)) (false? (:now-balanced? %))) rows))}
|
||||
:previously-balanced-and-changed
|
||||
(->> changed (filter :was-balanced?) vec)}))
|
||||
|
||||
(defn line-diff
|
||||
"Which categories actually moved on one row, as `{category [before-cents after-cents]}`. For
|
||||
reading a handful of rows by hand once the tallies point at them."
|
||||
[row]
|
||||
(let [by-cat (fn [lines] (reduce (fn [m [l n]] (assoc m (:category l) (* n (:cents l)))) {} lines))
|
||||
b (by-cat (:lines-before row))
|
||||
a (by-cat (:lines-after row))]
|
||||
(->> (distinct (concat (keys b) (keys a)))
|
||||
(keep (fn [cat]
|
||||
(let [x (get b cat 0) y (get a cat 0)]
|
||||
(when (not= x y) [cat [(/ x 100.0) (/ y 100.0)]]))))
|
||||
(into {}))))
|
||||
|
||||
(defn compare-against
|
||||
"Compare the current database against its own past value at basis `t`.
|
||||
|
||||
UNSOUND FOR AMOUNTS — see the namespace docstring. The amount, side and account attributes are
|
||||
`:db/noHistory`, so any summary rewritten since `t` reads back with no amounts and appears
|
||||
balanced. Kept only for comparing categories and identifying which days changed."
|
||||
[t start end]
|
||||
(let [db (dc/db conn)]
|
||||
(compare-window (dc/as-of db t) db start end)))
|
||||
|
||||
(comment
|
||||
;; the restore point, i.e. production's own summaries before any of this work
|
||||
(def result (compare-against 209608347
|
||||
(clj-time.core/date-time 2026 7 15)
|
||||
(clj-time.core/date-time 2026 8 14)))
|
||||
(:tally result)
|
||||
(:balance-transitions result)
|
||||
(count (:previously-balanced-and-changed result))
|
||||
(map line-diff (take 3 (:previously-balanced-and-changed result))))
|
||||
Reference in New Issue
Block a user