From 56273cf3b371312f0e72fc2af95a9dcacc8228b8 Mon Sep 17 00:00:00 2001 From: Rutger Broekhoff Date: Wed, 23 Jul 2025 12:05:08 +0200 Subject: Slaying --- app/Import/Ing/CurrentAccountCsv.hs | 340 ++++++++++++++++++------------------ 1 file changed, 168 insertions(+), 172 deletions(-) (limited to 'app/Import/Ing/CurrentAccountCsv.hs') diff --git a/app/Import/Ing/CurrentAccountCsv.hs b/app/Import/Ing/CurrentAccountCsv.hs index d17221d..21ca53d 100644 --- a/app/Import/Ing/CurrentAccountCsv.hs +++ b/app/Import/Ing/CurrentAccountCsv.hs @@ -9,6 +9,7 @@ import Data.ByteString.Lazy qualified as BS import Data.Csv ((.:)) import Data.Csv qualified as C import Data.Decimal (Decimal) +import Data.Generics.Product.Subtype (upcast) import Data.Iban (Iban) import Data.Res (Res (Err, Ok)) import Data.Text qualified as T @@ -16,6 +17,7 @@ import Data.Time.Calendar (Day) import Data.Time.Clock (UTCTime) import Data.Time.Zones (TZ, loadTZFromDB) import Data.Vector qualified as V +import GHC.Generics import Import.Ing.Shared ( DebitCredit (Credit, Debit), maybeCP, @@ -28,6 +30,77 @@ import Import.Ing.Shared import System.IO (Handle) import Text.Regex.TDFA ((=~~)) +data Tx = Tx TxBase TxSpecifics deriving (Show) + +data TxBase = TxBase + { date :: !Day, + account :: !Iban, + amount :: !Decimal, + resBal :: !Decimal, + tag :: !T.Text + } + deriving (Show, Generic) + +data TxSpecifics + = PaymentTerminalPayment + { counterpartyName :: !T.Text, + cardSequenceNo :: !T.Text, + timestamp :: !UTCTime, + transaction :: !T.Text, + terminal :: !T.Text, + googlePay :: !Bool + } + | PaymentTerminalCashback + { counterpartyName :: !T.Text, + cardSequenceNo :: !T.Text, + timestamp :: !UTCTime, + transaction :: !T.Text, + terminal :: !T.Text + } + | OnlineBankingCredit + { counterpartyName :: !T.Text, + counterpartyIban :: !Iban, + description :: !T.Text, + timestamp :: !UTCTime + } + | OnlineBankingDebit + { counterpartyName :: !T.Text, + counterpartyIban :: !Iban, + description :: T.Text, + mtimestamp :: !(Maybe UTCTime) + } + | RecurrentDirectDebit + { counterpartyName :: !T.Text, + counterpartyIban :: !Iban, + description :: !T.Text, + reference :: !T.Text, + mandateId :: !T.Text, + creditorId :: !T.Text, + otherParty :: !(Maybe T.Text) + } + | RoundingSavingsDeposit + {savingsAccount :: !T.Text} + | DepositTransfer + { counterpartyName :: !T.Text, + counterpartyIban :: !Iban, + description :: !T.Text, + reference :: !T.Text + } + | IdealDebit + { counterpartyName :: !T.Text, + counterpartyIban :: !Iban, + description :: !T.Text, + timestamp :: !UTCTime, + reference :: !T.Text + } + | BatchPayment + { counterpartyName :: !T.Text, + counterpartyIban :: !Iban, + description :: !T.Text, + reference :: !T.Text + } + deriving (Show, Generic) + data TransactionType = AcceptGiroType -- AC (acceptgiro) | AtmWithdrawalType -- GM (geldautomaat, Giromaat) @@ -72,18 +145,18 @@ parseType "iDEAL" = return IdealType parseType t = fail $ "Unknown transaction type '" ++ T.unpack t ++ "'" data PrimTx = PrimTx - { ptxDate :: !Day, - ptxDescription :: !T.Text, - ptxAccount :: !Iban, - ptxCounterparty :: !(Maybe Iban), - ptxTransactionType :: !TransactionType, - ptxDebitCredit :: !DebitCredit, - ptxAmount :: !Decimal, - ptxNotifications :: !T.Text, - ptxResBal :: !Decimal, - ptxTag :: !T.Text + { date :: !Day, + description :: !T.Text, + account :: !Iban, + counterparty :: !(Maybe Iban), + transactionType :: !TransactionType, + debitCredit :: !DebitCredit, + amount :: !Decimal, + notifications :: !T.Text, + resBal :: !Decimal, + tag :: !T.Text } - deriving (Show) + deriving (Show, Generic) debitCreditCP :: T.Text -> C.Parser DebitCredit debitCreditCP "Debit" = return Debit @@ -122,265 +195,188 @@ assertValueDate expected t = do fail "Expected transaction date and value date to be the same" assertValueDatePtx :: PrimTx -> T.Text -> Res String () -assertValueDatePtx PrimTx {ptxDate = expected} = assertValueDate expected +assertValueDatePtx PrimTx {date = expected} = assertValueDate expected specificsFromPrim :: TZ -> PrimTx -> Res String TxSpecifics -specificsFromPrim amsTz ptx@PrimTx {ptxTransactionType = PaymentTerminalType, ptxDebitCredit = Debit} = do +specificsFromPrim amsTz ptx@PrimTx {transactionType = PaymentTerminalType, debitCredit = Debit} = do let regex = "^Card sequence no.: ([0-9]+) ? ([0-9]{2}/[0-9]{2}/[0-9]{4} [0-9]{2}:[0-9]{2}) Transaction: (.*) Term: ((.+) Google Pay|(.+)) Value date: ([0-9]{2}/[0-9]{2}/[0-9]{4})$" :: String (_, _, _, [cardSeqNo, timestampTxt, transaction, _, gpayTerm, noGpayTerm, valDateTxt]) <- - ptxNotifications ptx =~~ regex :: Res String (T.Text, T.Text, T.Text, [T.Text]) + ptx.notifications =~~ regex :: Res String (T.Text, T.Text, T.Text, [T.Text]) assertValueDatePtx ptx valDateTxt timestamp <- parseTimestampM "%d/%m/%Y %H:%M" amsTz timestampTxt return $ PaymentTerminalPayment - { ptpCounterpartyName = ptxDescription ptx, - ptpCardSequenceNo = cardSeqNo, - ptpTimestamp = timestamp, - ptpTransaction = transaction, - ptpTerminal = if T.null gpayTerm then noGpayTerm else gpayTerm, - ptpGooglePay = T.null noGpayTerm + { counterpartyName = ptx.description, + cardSequenceNo = cardSeqNo, + timestamp = timestamp, + transaction = transaction, + terminal = if T.null gpayTerm then noGpayTerm else gpayTerm, + googlePay = T.null noGpayTerm } -specificsFromPrim amsTz ptx@PrimTx {ptxTransactionType = PaymentTerminalType, ptxDebitCredit = Credit} = do +specificsFromPrim amsTz ptx@PrimTx {transactionType = PaymentTerminalType, debitCredit = Credit} = do let regex = "^Card sequence no.: ([0-9]+) ? ([0-9]{2}/[0-9]{2}/[0-9]{4} [0-9]{2}:[0-9]{2}) Transaction: (.*) Term: (.*) Cashback transaction Value date: ([0-9]{2}/[0-9]{2}/[0-9]{4})$" :: String (_, _, _, [cardSeqNo, timestampTxt, transaction, term, valDateTxt]) <- - ptxNotifications ptx =~~ regex :: Res String (T.Text, T.Text, T.Text, [T.Text]) + notifications ptx =~~ regex :: Res String (T.Text, T.Text, T.Text, [T.Text]) assertValueDatePtx ptx valDateTxt timestamp <- parseTimestampM "%d/%m/%Y %H:%M" amsTz timestampTxt return $ PaymentTerminalCashback - { ptcCounterpartyName = ptxDescription ptx, - ptcCardSequenceNo = cardSeqNo, - ptcTimestamp = timestamp, - ptcTransaction = transaction, - ptcTerminal = term + { counterpartyName = ptx.description, + cardSequenceNo = cardSeqNo, + timestamp = timestamp, + transaction = transaction, + terminal = term } -specificsFromPrim amsTz ptx@PrimTx {ptxTransactionType = OnlineBankingType, ptxDebitCredit = Credit} = do +specificsFromPrim amsTz ptx@PrimTx {transactionType = OnlineBankingType, debitCredit = Credit} = do let regex = "^Name: (.*) Description: (.*) IBAN: ([A-Z0-9]+) Date/time: ([0-9]{2}-[0-9]{2}-[0-9]{4} [0-9]{2}:[0-9]{2}:[0-9]{2}) Value date: ([0-9]{2}/[0-9]{2}/[0-9]{4})$" :: String (_, _, _, [name, desc, ibanTxt, timestampTxt, valDateTxt]) <- - ptxNotifications ptx =~~ regex :: Res String (T.Text, T.Text, T.Text, [T.Text]) + notifications ptx =~~ regex :: Res String (T.Text, T.Text, T.Text, [T.Text]) assertValueDatePtx ptx valDateTxt iban <- parseIbanM ibanTxt timestamp <- parseTimestampM "%d-%m-%Y %H:%M:%S" amsTz timestampTxt - when (name /= ptxDescription ptx) $ + when (name /= ptx.description) $ fail "Expected counterparty name for online banking credit to match primitive description" - when (Just iban /= ptxCounterparty ptx) $ + when (Just iban /= ptx.counterparty) $ fail "Expected IBAN for online banking credit to match and primitive counterparty IBAN" return $ OnlineBankingCredit - { obcCounterpartyName = name, - obcCounterpartyIban = iban, - obcDescription = desc, - obcTimestamp = timestamp + { counterpartyName = name, + counterpartyIban = iban, + description = desc, + timestamp = timestamp } -specificsFromPrim amsTz ptx@PrimTx {ptxTransactionType = OnlineBankingType, ptxDebitCredit = Debit} = do +specificsFromPrim amsTz ptx@PrimTx {transactionType = OnlineBankingType, debitCredit = Debit} = do let regex = "^Name: (.*) Description: (.*) IBAN: ([A-Z0-9]+) (Date/time: ([0-9]{2}-[0-9]{2}-[0-9]{4} [0-9]{2}:[0-9]{2}:[0-9]{2}) )?Value date: ([0-9]{2}/[0-9]{2}/[0-9]{4})$" :: String (_, _, _, [name, desc, ibanTxt, _, timestampTxt, valDateTxt]) <- - ptxNotifications ptx =~~ regex :: Res String (T.Text, T.Text, T.Text, [T.Text]) + notifications ptx =~~ regex :: Res String (T.Text, T.Text, T.Text, [T.Text]) assertValueDatePtx ptx valDateTxt iban <- parseIbanM ibanTxt timestamp <- if T.null timestampTxt then pure Nothing else Just <$> parseTimestampM "%d-%m-%Y %H:%M:%S" amsTz timestampTxt - when (name /= ptxDescription ptx) $ + when (name /= ptx.description) $ fail "Expected counterparty name for online banking debit to match primitive description" - when (Just iban /= ptxCounterparty ptx) $ + when (Just iban /= ptx.counterparty) $ fail "Expected IBAN for online banking debit to match and primitive counterparty IBAN" return $ OnlineBankingDebit - { obdCounterpartyIban = iban, - obdCounterpartyName = name, - obdDescription = desc, - obdTimestamp = timestamp + { counterpartyIban = iban, + counterpartyName = name, + description = desc, + mtimestamp = timestamp } -specificsFromPrim _ ptx@PrimTx {ptxTransactionType = DirectDebitType, ptxDebitCredit = Debit} = +specificsFromPrim _ ptx@PrimTx {transactionType = DirectDebitType, debitCredit = Debit} = normalRecurrentDirectDebit <|> ingInsurancePayment where normalRecurrentDirectDebit = do let regex = "^Name: (.*) Description: (.*) IBAN: ([A-Z0-9]+) Reference: (.*) Mandate ID: (.*) Creditor ID: (.*) Recurrent SEPA direct debit (Other party: (.*) )?Value date: ([0-9]{2}/[0-9]{2}/[0-9]{4})$" :: String (_, _, _, [name, desc, ibanTxt, ref, mandateId, creditorId, _, otherParty, valDateTxt]) <- - ptxNotifications ptx =~~ regex :: Res String (T.Text, T.Text, T.Text, [T.Text]) + notifications ptx =~~ regex :: Res String (T.Text, T.Text, T.Text, [T.Text]) assertValueDatePtx ptx valDateTxt iban <- parseIbanM ibanTxt - when (name /= ptxDescription ptx) $ + when (name /= ptx.description) $ fail "Expected counterparty name for direct debit to match primitive description" - when (Just iban /= ptxCounterparty ptx) $ + when (Just iban /= ptx.counterparty) $ fail "Expected IBAN for direct debit to match and primitive counterparty IBAN" return $ RecurrentDirectDebit - { rddCounterpartyName = name, - rddCounterpartyIban = iban, - rddDescription = desc, - rddReference = ref, - rddMandateId = mandateId, - rddCreditorId = creditorId, - rddOtherParty = if T.null otherParty then Nothing else Just otherParty + { counterpartyName = name, + counterpartyIban = iban, + description = desc, + reference = ref, + mandateId = mandateId, + creditorId = creditorId, + otherParty = if T.null otherParty then Nothing else Just otherParty } ingInsurancePayment = do let regex = "^Name: (.* ING Verzekeren) Description: (.*) IBAN: ([A-Z0-9]+) Reference: (.*) Mandate ID: (.*) Creditor ID: (.*) Recurrent SEPA direct debit$" :: String (_, _, _, [name, desc, ibanTxt, ref, mandateId, creditorId]) <- - ptxNotifications ptx =~~ regex :: Res String (T.Text, T.Text, T.Text, [T.Text]) + notifications ptx =~~ regex :: Res String (T.Text, T.Text, T.Text, [T.Text]) iban <- parseIbanM ibanTxt - when (name /= ptxDescription ptx) $ + when (name /= ptx.description) $ fail "Expected counterparty name for direct debit to match primitive description" - when (Just iban /= ptxCounterparty ptx) $ + when (Just iban /= ptx.counterparty) $ fail "Expected IBAN for direct debit to match and primitive counterparty IBAN" return $ RecurrentDirectDebit - { rddCounterpartyName = name, - rddCounterpartyIban = iban, - rddDescription = desc, - rddReference = ref, - rddMandateId = mandateId, - rddCreditorId = creditorId, - rddOtherParty = Nothing + { counterpartyName = name, + counterpartyIban = iban, + description = desc, + reference = ref, + mandateId = mandateId, + creditorId = creditorId, + otherParty = Nothing } -specificsFromPrim _ ptx@PrimTx {ptxTransactionType = TransferType, ptxDebitCredit = Credit} = do +specificsFromPrim _ ptx@PrimTx {transactionType = TransferType, debitCredit = Credit} = do let regex = "^Name: (.*) Description: (.*) IBAN: ([A-Z0-9]+) Reference: (.*) Value date: ([0-9]{2}/[0-9]{2}/[0-9]{4})$" :: String (_, _, _, [name, desc, ibanTxt, ref, valDateTxt]) <- - ptxNotifications ptx =~~ regex :: Res String (T.Text, T.Text, T.Text, [T.Text]) + notifications ptx =~~ regex :: Res String (T.Text, T.Text, T.Text, [T.Text]) assertValueDatePtx ptx valDateTxt iban <- parseIbanM ibanTxt - when (name /= ptxDescription ptx) $ + when (name /= ptx.description) $ fail "Expected counterparty name for deposit transfer to match primitive description" - when (Just iban /= ptxCounterparty ptx) $ + when (Just iban /= ptx.counterparty) $ fail "Expected IBAN for deposit transfer to match and primitive counterparty IBAN" return $ DepositTransfer - { dtCounterpartyName = name, - dtCounterpartyIban = iban, - dtDescription = desc, - dtReference = ref + { counterpartyName = name, + counterpartyIban = iban, + description = desc, + reference = ref } -specificsFromPrim _ ptx@PrimTx {ptxTransactionType = TransferType, ptxDebitCredit = Debit} = do +specificsFromPrim _ ptx@PrimTx {transactionType = TransferType, debitCredit = Debit} = do let regex = "^To Oranje spaarrekening ([A-Z0-9]+) Afronding Value date: ([0-9]{2}/[0-9]{2}/[0-9]{4})$" :: String (_, _, _, [savingsAccount, valDateTxt]) <- - ptxNotifications ptx =~~ regex :: Res String (T.Text, T.Text, T.Text, [T.Text]) + ptx.notifications =~~ regex :: Res String (T.Text, T.Text, T.Text, [T.Text]) assertValueDatePtx ptx valDateTxt - return $ RoundingSavingsDeposit {rsdSavingsAccount = savingsAccount} -specificsFromPrim amsTz ptx@PrimTx {ptxTransactionType = IdealType, ptxDebitCredit = Debit} = do + return $ RoundingSavingsDeposit {savingsAccount = savingsAccount} +specificsFromPrim amsTz ptx@PrimTx {transactionType = IdealType, debitCredit = Debit} = do let regex = "^Name: (.*) Description: (.*) IBAN: ([A-Z0-9]+) Reference: ([0-9]{2}-[0-9]{2}-[0-9]{4} [0-9]{2}:[0-9]{2}) ([0-9]+) Value date: ([0-9]{2}/[0-9]{2}/[0-9]{4})$" :: String (_, _, _, [name, desc, ibanTxt, timestampTxt, ref, valDateTxt]) <- - ptxNotifications ptx =~~ regex :: Res String (T.Text, T.Text, T.Text, [T.Text]) + notifications ptx =~~ regex :: Res String (T.Text, T.Text, T.Text, [T.Text]) assertValueDatePtx ptx valDateTxt timestamp <- parseTimestampM "%d-%m-%Y %H:%M" amsTz timestampTxt iban <- parseIbanM ibanTxt - when (name /= ptxDescription ptx) $ + when (name /= ptx.description) $ fail "Expected counterparty name for iDEAL payment to match primitive description" - when (Just iban /= ptxCounterparty ptx) $ + when (Just iban /= ptx.counterparty) $ fail "Expected IBAN for iDEAL payment to match and primitive counterparty IBAN" return $ IdealDebit - { idCounterpartyName = name, - idCounterpartyIban = iban, - idDescription = desc, - idTimestamp = timestamp, - idReference = ref + { counterpartyName = name, + counterpartyIban = iban, + description = desc, + timestamp = timestamp, + reference = ref } -specificsFromPrim _ ptx@PrimTx {ptxTransactionType = BatchPaymentType, ptxDebitCredit = Credit} = do +specificsFromPrim _ ptx@PrimTx {transactionType = BatchPaymentType, debitCredit = Credit} = do let regex = "^Name: (.*) Description: (.*) IBAN: ([A-Z0-9]+) Reference: (.*) Value date: ([0-9]{2}/[0-9]{2}/[0-9]{4})$" :: String (_, _, _, [name, desc, ibanTxt, ref, valDateTxt]) <- - ptxNotifications ptx =~~ regex :: Res String (T.Text, T.Text, T.Text, [T.Text]) + notifications ptx =~~ regex :: Res String (T.Text, T.Text, T.Text, [T.Text]) assertValueDatePtx ptx valDateTxt iban <- parseIbanM ibanTxt - when (name /= ptxDescription ptx) $ + when (name /= ptx.description) $ fail "Expected counterparty name for batch payment to match primitive description" - when (Just iban /= ptxCounterparty ptx) $ + when (Just iban /= ptx.counterparty) $ fail "Expected IBAN for batch payment to match and primitive counterparty IBAN" return $ BatchPayment - { bpCounterpartyName = name, - bpCounterpartyIban = iban, - bpDescription = desc, - bpReference = ref + { counterpartyName = name, + counterpartyIban = iban, + description = desc, + reference = ref } specificsFromPrim _ ptx = fail $ "Could not extract data from transaction (" - ++ show (ptxTransactionType ptx) + ++ show (transactionType ptx) ++ " / " - ++ show (ptxDebitCredit ptx) + ++ show (debitCredit ptx) ++ ")" txBaseFromPrim :: PrimTx -> TxBase -txBaseFromPrim = - TxBase - <$> ptxDate - <*> ptxAccount - <*> ptxAmount - <*> ptxResBal - <*> ptxTag - -data Tx = Tx TxBase TxSpecifics deriving (Show) - -data TxBase = TxBase - { txbDate :: !Day, - txbAccount :: !Iban, - txbAmount :: !Decimal, - txbResBal :: !Decimal, - txbTag :: !T.Text - } - deriving (Show) - -data TxSpecifics - = PaymentTerminalPayment - { ptpCounterpartyName :: !T.Text, - ptpCardSequenceNo :: !T.Text, - ptpTimestamp :: !UTCTime, - ptpTransaction :: !T.Text, - ptpTerminal :: !T.Text, - ptpGooglePay :: !Bool - } - | PaymentTerminalCashback - { ptcCounterpartyName :: !T.Text, - ptcCardSequenceNo :: !T.Text, - ptcTimestamp :: !UTCTime, - ptcTransaction :: !T.Text, - ptcTerminal :: !T.Text - } - | OnlineBankingCredit - { obcCounterpartyName :: !T.Text, - obcCounterpartyIban :: !Iban, - obcDescription :: !T.Text, - obcTimestamp :: !UTCTime - } - | OnlineBankingDebit - { obdCounterpartyName :: !T.Text, - obdCounterpartyIban :: !Iban, - obdDescription :: T.Text, - obdTimestamp :: !(Maybe UTCTime) - } - | RecurrentDirectDebit - { rddCounterpartyName :: !T.Text, - rddCounterpartyIban :: !Iban, - rddDescription :: !T.Text, - rddReference :: !T.Text, - rddMandateId :: !T.Text, - rddCreditorId :: !T.Text, - rddOtherParty :: !(Maybe T.Text) - } - | RoundingSavingsDeposit - {rsdSavingsAccount :: !T.Text} - | DepositTransfer - { dtCounterpartyName :: !T.Text, - dtCounterpartyIban :: !Iban, - dtDescription :: !T.Text, - dtReference :: !T.Text - } - | IdealDebit - { idCounterpartyName :: !T.Text, - idCounterpartyIban :: !Iban, - idDescription :: !T.Text, - idTimestamp :: !UTCTime, - idReference :: !T.Text - } - | BatchPayment - { bpCounterpartyName :: !T.Text, - bpCounterpartyIban :: !Iban, - bpDescription :: !T.Text, - bpReference :: !T.Text - } - deriving (Show) +txBaseFromPrim = upcast readFile :: Handle -> IO (V.Vector Tx) readFile h = do -- cgit v1.2.3