Compare commits
3 Commits
integreat-
...
58f6714399
| Author | SHA1 | Date | |
|---|---|---|---|
| 58f6714399 | |||
| ab27d3a4da | |||
| 19d936693a |
@@ -209,6 +209,37 @@
|
||||
;; 3. CSVs
|
||||
;; 4. better date range / advanced mode for dialog
|
||||
|
||||
(defn- accounts-sharing-code
|
||||
"The searched account, plus any of `clients`' bank accounts on the same numeric
|
||||
code. :journal-entry-line/account points at either entity, so a search for the
|
||||
financial account has to match lines posted to the bank account too."
|
||||
[db clients account-id]
|
||||
(into [account-id]
|
||||
(when-let [code (:account/numeric-code (dc/entity db account-id))]
|
||||
(dc/q '[:find [?ba ...]
|
||||
|
||||
:in $ [?client ...] ?code
|
||||
|
||||
:where
|
||||
[?client :client/bank-accounts ?ba]
|
||||
[?ba :bank-account/numeric-code ?code]]
|
||||
db clients code))))
|
||||
|
||||
(defn- account-filter-query
|
||||
"Ledger clause for the Account search. Stays a scalar binding when nothing
|
||||
shares the account's code, so the common case costs what it always did."
|
||||
[db clients account-id]
|
||||
(let [ids (accounts-sharing-code db clients account-id)]
|
||||
(if (second ids)
|
||||
{:query {:in ['[?a3 ...]]
|
||||
|
||||
:where ['[?li :journal-entry-line/account ?a3]]}
|
||||
:args [ids]}
|
||||
{:query {:in ['?a3]
|
||||
|
||||
:where ['[?li :journal-entry-line/account ?a3]]}
|
||||
:args [account-id]})))
|
||||
|
||||
(defn fetch-ids [db {:keys [query-params route-params] :as request}]
|
||||
(let [valid-clients (extract-client-ids (:clients request)
|
||||
(:client-id request)
|
||||
@@ -288,9 +319,7 @@
|
||||
'[(<= ?c ?to-numeric-code)]]}
|
||||
:args [(map (juxt :from :to) (:numeric-code args))]})
|
||||
(seq (:account args))
|
||||
(merge-query {:query {:in ['?a3]
|
||||
:where ['[?li :journal-entry-line/account ?a3]]}
|
||||
:args [(:db/id (:account args))]})
|
||||
(merge-query (account-filter-query db valid-clients (:db/id (:account args))))
|
||||
|
||||
(:amount-gte args)
|
||||
(merge-query {:query {:in ['?amount-gte]
|
||||
|
||||
@@ -132,7 +132,13 @@
|
||||
valid-clients]}
|
||||
(cond-> {:query {:find []
|
||||
:in ['$ '[?clients ?start ?end]]
|
||||
:where '[[(iol-ion.query/scan-transactions $ ?clients ?start ?end) [[?e _ ?sort-default] ...]]]}
|
||||
;; Suppressed transactions are never listed -- the GraphQL page has
|
||||
;; always dropped them (auto-ap.datomic.transactions/graphql-results),
|
||||
;; as do the ledger queries. The three status routes (approved,
|
||||
;; unapproved, requires-feedback) constrain the status themselves, and
|
||||
;; there is no suppressed route, so this never hides a page's own rows.
|
||||
:where '[[(iol-ion.query/scan-transactions $ ?clients ?start ?end) [[?e _ ?sort-default] ...]]
|
||||
(not [?e :transaction/approval-status :transaction-approval-status/suppressed])]}
|
||||
:args [db
|
||||
[valid-clients
|
||||
(some-> (:start-date query-params) coerce/to-date)
|
||||
|
||||
68
test/clj/auto_ap/ssr/transaction/common_test.clj
Normal file
68
test/clj/auto_ap/ssr/transaction/common_test.clj
Normal file
@@ -0,0 +1,68 @@
|
||||
(ns auto-ap.ssr.transaction.common-test
|
||||
(:require
|
||||
[auto-ap.datomic :refer [conn]]
|
||||
[auto-ap.integration.util :refer [setup-test-data test-bank-account test-client
|
||||
test-transaction wrap-setup]]
|
||||
[auto-ap.ssr.transaction.common :as sut]
|
||||
[clojure.test :refer [deftest is testing use-fixtures]]
|
||||
[datomic.api :as dc]))
|
||||
|
||||
(use-fixtures :each wrap-setup)
|
||||
|
||||
(defn- fetch
|
||||
"Runs the transactions page query the way the page does, over a range wide
|
||||
enough to cover the fixture data."
|
||||
[client-id & {:keys [route-params query-params]}]
|
||||
(sut/fetch-ids (dc/db conn)
|
||||
{:clients [client-id]
|
||||
:route-params (or route-params {})
|
||||
:query-params (merge {:start-date "2021-01-01"
|
||||
:end-date "2023-12-31"}
|
||||
query-params)}))
|
||||
|
||||
(deftest fetch-ids-suppressed-test
|
||||
(let [{:strs [suppressed-client kept-tx suppressed-tx]}
|
||||
(setup-test-data
|
||||
[(test-bank-account :db/id "suppressed-bank")
|
||||
(test-client :db/id "suppressed-client"
|
||||
:client/bank-accounts ["suppressed-bank"])
|
||||
(test-transaction :db/id "kept-tx"
|
||||
:transaction/client "suppressed-client"
|
||||
:transaction/bank-account "suppressed-bank"
|
||||
:transaction/date #inst "2022-06-01"
|
||||
:transaction/amount 100.0
|
||||
:transaction/approval-status :transaction-approval-status/approved)
|
||||
(test-transaction :db/id "suppressed-tx"
|
||||
:transaction/client "suppressed-client"
|
||||
:transaction/bank-account "suppressed-bank"
|
||||
:transaction/date #inst "2022-06-02"
|
||||
:transaction/amount 250.0
|
||||
:transaction/approval-status :transaction-approval-status/suppressed)])]
|
||||
|
||||
(testing "Should leave a suppressed transaction out of the transactions page"
|
||||
(let [{:keys [ids all-ids count]} (fetch suppressed-client)]
|
||||
(is (= [kept-tx] (vec ids)))
|
||||
(is (not (contains? (set all-ids) suppressed-tx))
|
||||
"a suppressed transaction must not reach the amount total either")
|
||||
(is (= 1 count)
|
||||
"the row count has to match what the page renders, not the unfiltered scan")))
|
||||
|
||||
(testing "Should still list a transaction on an explicit status route"
|
||||
(let [{:keys [ids]} (fetch suppressed-client
|
||||
:route-params {:status :transaction-approval-status/approved})]
|
||||
(is (= [kept-tx] (vec ids)))))
|
||||
|
||||
(testing "Should return nothing for a client whose transactions are all suppressed"
|
||||
(let [{:strs [empty-client]}
|
||||
(setup-test-data
|
||||
[(test-bank-account :db/id "empty-bank")
|
||||
(test-client :db/id "empty-client"
|
||||
:client/bank-accounts ["empty-bank"])
|
||||
(test-transaction :db/id "only-tx"
|
||||
:transaction/client "empty-client"
|
||||
:transaction/bank-account "empty-bank"
|
||||
:transaction/date #inst "2022-06-03"
|
||||
:transaction/approval-status :transaction-approval-status/suppressed)])
|
||||
{:keys [ids count]} (fetch empty-client)]
|
||||
(is (empty? ids))
|
||||
(is (= 0 count))))))
|
||||
Reference in New Issue
Block a user