From 0fb7656ce1b4a59e2311864ef98dcab6e99e353f Mon Sep 17 00:00:00 2001 From: Adrian Sieber Date: Mon, 12 Feb 2024 18:02:30 +0000 Subject: [PATCH] Reactivate account verification and ledger balance verification --- src/Main.purs | 32 +++++++++++++++++++++++++++----- src/Transity/Data/Ledger.purs | 25 ++++++++----------------- test/Main.purs | 28 +++++++++++++++++++--------- test/fixtures/journal1.yaml | 35 +++++++++++++++++++++++++++++++++++ test/fixtures/journal2.yaml | 29 +++++++++++++++++++++++++++++ 5 files changed, 118 insertions(+), 31 deletions(-) create mode 100644 test/fixtures/journal1.yaml create mode 100644 test/fixtures/journal2.yaml diff --git a/src/Main.purs b/src/Main.purs index fda0fcf..42f8068 100644 --- a/src/Main.purs +++ b/src/Main.purs @@ -13,6 +13,7 @@ import Prelude , (<#>) , (<>) , (>) + , (>>=) ) import Ansi.Codes (Color(..)) @@ -40,7 +41,12 @@ import Node.FS.Sync as Sync import Node.Path as Path import Node.Process (cwd, setExitCode) import Transity.Data.Config (ColorFlag(..), config) -import Transity.Data.Ledger (Ledger(..), BalanceFilter(..)) +import Transity.Data.Ledger + ( BalanceFilter(..) + , Ledger(..) + , verifyAccounts + , verifyLedgerBalances + ) import Transity.Data.Ledger as Ledger import Transity.Data.Transaction (Transaction(..)) import Transity.Plot as Plot @@ -191,9 +197,25 @@ buildLedgerAndRun currentDir journalPathRel extraJournalPaths callback = do Error message -> errorAndExit config message Ok paths -> do combineRes <- combineJournals currentDir paths - case combineRes of - Error message -> errorAndExit config message - Ok ledger -> callback ledger + case + combineRes + >>= verifyAccounts + >>= verifyLedgerBalances + of + Error msg -> pure $ Error msg + Ok ledger -> ledger # callback + +buildRunExit + :: String + -> String + -> Array CliArgPrim + -> (Ledger -> Effect (Result String Unit)) + -> Effect (Result String Unit) +buildRunExit currentDir journalPathRel extraJournalPaths callback = do + buildLedgerAndRun currentDir journalPathRel extraJournalPaths callback + >>= \res -> case res of + Ok val -> pure $ Ok val + Error msg -> errorAndExit config msg executor :: String -> String -> Array CliArgument -> Effect (Result String Unit) executor cmdName usageString args = do @@ -204,7 +226,7 @@ executor cmdName usageString args = do , ValArgList extraJournalPaths ] -> do currentDir <- cwd - buildLedgerAndRun currentDir jourPathRel extraJournalPaths $ + buildRunExit currentDir jourPathRel extraJournalPaths $ \ledger@(Ledger { transactions }) -> do let journalDir = diff --git a/src/Transity/Data/Ledger.purs b/src/Transity/Data/Ledger.purs index c77a7bd..2cf133f 100644 --- a/src/Transity/Data/Ledger.purs +++ b/src/Transity/Data/Ledger.purs @@ -33,7 +33,7 @@ import Data.Argonaut.Parser (jsonParser) import Data.Array (concat, groupBy, sort, sortBy, uncons, (!!), length) import Data.Array as Array import Data.DateTime (DateTime) -import Data.Foldable (all, find) +import Data.Foldable (all, find, foldMap) import Data.Function (flip) import Data.Generic.Rep (class Generic) import Data.HeytingAlgebra (not) @@ -188,7 +188,7 @@ verifyBalances balanceMap balancingTransfers = in if tfHeadRec.note == Just "___BALANCE___" then if not $ isAmountInMapZero newBal tfHeadRec.from targetCom then Error - ( "Error:\nThe verification balance of account '" <> tfHeadRec.from + ( "ERROR:\nThe verification balance of account '" <> tfHeadRec.from <> "' on '" <> (fromMaybe "" $ tfHeadRec.utc <#> dateShowPretty) <> "'\nis off by " @@ -241,28 +241,19 @@ fromJson json = do ledger <- stringifyJsonDecodeError $ fromEither $ decodeJson jsonObj pure ledger --- TODO: >>= verifyAccounts --- TODO: >>= verifyLedgerBalances --- TODO: >>= addInitalBalance - fromYaml :: String -> Result String Ledger -fromYaml yaml = +fromYaml yaml = do let result = yaml # parseYAMLToJson # runExcept # fromEither - unverified = case result of - Error error -> Error - ( "Could not parse YAML: " - <> fold (map renderForeignError error) - ) - Ok json -> stringifyJsonDecodeError $ fromEither $ decodeJson json - in - unverified --- TODO: >>= verifyAccounts --- TODO: >>= verifyLedgerBalances + case result of + Error error -> + Error $ "Could not parse YAML: " <> foldMap renderForeignError error + Ok json -> + stringifyJsonDecodeError $ fromEither $ decodeJson json showPretty :: Ledger -> String showPretty = showPrettyAligned ColorNo diff --git a/test/Main.purs b/test/Main.purs index 2561afe..1aeed04 100644 --- a/test/Main.purs +++ b/test/Main.purs @@ -1,7 +1,8 @@ module Test.Main where -import Test.Fixtures +import Prelude (Unit, (==)) +import CliSpec.Types (CliArgPrim(..)) import Control.Applicative (pure) import Control.Bind (discard, bind, (>>=)) import Data.Argonaut.Core (stringify) @@ -32,16 +33,19 @@ import Data.Tuple (Tuple(..)) import Data.Unit (unit) import Effect (Effect) import Effect.Aff (Aff, launchAff_) +import Effect.Class (liftEffect) import JS.BigInt (fromString) as BigInt import Partial.Unsafe (unsafePartial) -import Prelude (Unit, (==)) -import Test.CliSpec as Test.CliSpec -import Test.Fixtures as Fixtures import Test.Spec (describe, it) -import Test.Spec.Assertions (expectError, fail, shouldEqual) +import Test.Spec.Assertions (expectError, fail, shouldEqual, shouldSatisfy) import Test.Spec.Assertions.String (shouldContain) import Test.Spec.Reporter.Console (consoleReporter) import Test.Spec.Runner (runSpec) + +import Main (buildLedgerAndRun) +import Test.CliSpec as Test.CliSpec +import Test.Fixtures +import Test.Fixtures as Fixtures import Transity.Data.Account (Account(..)) import Transity.Data.Account as Account import Transity.Data.Amount (Amount(..), Commodity(..)) @@ -553,13 +557,10 @@ main = launchAff_ $ runSpec [ consoleReporter ] do (show actual) `shouldEqualString` (show expected) describe "Verification" do - it "ledger without verification balances is valid" do let verification = Ledger.verifyLedgerBalances ledger - (isOk verification) `shouldEqual` true - -- TODO: Use instead following with purescript-spec@v3.1.0 - -- verification `shouldSatisfy` isOk + verification `shouldSatisfy` isOk it "fails if verification balances are incorrect" do let @@ -813,6 +814,15 @@ main = launchAff_ $ runSpec [ consoleReporter ] do (isOk verification) `shouldEqual` true + it "verifies balances for combined journals" do + execResult <- liftEffect $ buildLedgerAndRun + "." + "test/fixtures/journal1.yaml" + [ TextArg "test/fixtures/journal2.yaml" ] + (\_ledger -> pure $ Ok unit) + + (isError execResult) `shouldEqual` true + it "subtracts a transfer from a balance map" do let result = balanceMap `Ledger.subtractTransfer` transferSimple diff --git a/test/fixtures/journal1.yaml b/test/fixtures/journal1.yaml new file mode 100644 index 0000000..88621da --- /dev/null +++ b/test/fixtures/journal1.yaml @@ -0,0 +1,35 @@ +owner: john + +entities: + - + id: anna + accounts: + - id: wallet + balances: + - utc: '2000-01-01 12:00' + amounts: [] + - utc: '2006-01-01 12:00' + amounts: [3 €] + - utc: '2010-01-01 12:00' + amounts: [3 €, 4 $] + - + id: ben + accounts: [id: wallet] + + - + id: john + accounts: [id: wallet] + +transactions: + - + utc: '2005-01-01 12:00' + transfers: + - from: ben:wallet + to: anna:wallet + amount: 3 € + - + utc: '2007-01-01 12:00' + transfers: + - from: ben:wallet + to: anna:wallet + amount: 4 $ diff --git a/test/fixtures/journal2.yaml b/test/fixtures/journal2.yaml new file mode 100644 index 0000000..f3201ff --- /dev/null +++ b/test/fixtures/journal2.yaml @@ -0,0 +1,29 @@ +owner: John Doe + +entities: + - + id: lisa + accounts: + - id: wallet + balances: + - utc: '2020-01-01 12:00' + amounts: [] + - utc: '2023-01-01 12:00' + amounts: [4 €, 7 $] + - + id: marc + accounts: [id: wallet] + +transactions: + - + utc: '2022-01-01 12:00' + transfers: + - from: lisa:wallet + to: marc:wallet + amount: 3 € + - + utc: '2023-01-01 12:00' + transfers: + - from: marc:wallet + to: john:wallet + amount: 8 $