path: root/app/Import/Ing/CurrentAccountCsv.hs

{-# LANGUAGE OverloadedLists #-}
{-# LANGUAGE OverloadedStrings #-}

module Import.Ing.CurrentAccountCsv where

import Control.Applicative ((<|>))
import Control.Monad (when)
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
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,
    parseDateM,
    parseDecimalM,
    parseIbanM,
    parseTimestampM,
    scsvOptions,
  )
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)
  | BatchPaymentType -- VZ (verzamelbetaling); 'Batch payment'
  | BranchPostingType -- FL (filiaalboeking)
  | DepositType -- ST (storting)
  | DirectDebitType -- IC (incasso); 'SEPA direct debit'
  | IdealType -- ID (iDEAL); 'iDEAL'
  | OnlineBankingType -- GT (internetbankieren, Girotel); 'Online Banking'
  | OfficeWithdrawalType -- PK (opname kantoor, postkantoor)
  | PaymentTerminalType -- BA (betaalautomaat); 'Payment terminal'
  | PeriodicTransferType -- PO (periodieke overschrijving)
  | PhoneBankingType -- GF (telefonisch bankieren, Girofoon)
  | TransferType -- OV (overboeking); 'Transfer'
  | VariousType -- DV (diversen)
  deriving (Eq, Show)

parseCode :: T.Text -> C.Parser TransactionType
parseCode "AC" = return AcceptGiroType
parseCode "GM" = return AtmWithdrawalType
parseCode "VZ" = return BatchPaymentType
parseCode "FL" = return BranchPostingType
parseCode "ST" = return DepositType
parseCode "IC" = return DirectDebitType
parseCode "ID" = return IdealType
parseCode "GT" = return OnlineBankingType
parseCode "PK" = return OfficeWithdrawalType
parseCode "BA" = return PaymentTerminalType
parseCode "PO" = return PeriodicTransferType
parseCode "GF" = return PhoneBankingType
parseCode "OV" = return TransferType
parseCode "DV" = return VariousType
parseCode t = fail $ "Unknown transaction code '" ++ T.unpack t ++ "'"

parseType :: T.Text -> C.Parser TransactionType
parseType "SEPA direct debit" = return DirectDebitType
parseType "Batch payment" = return BatchPaymentType
parseType "Online Banking" = return OnlineBankingType
parseType "Payment terminal" = return PaymentTerminalType
parseType "Transfer" = return TransferType
parseType "iDEAL" = return IdealType
parseType t = fail $ "Unknown transaction type '" ++ T.unpack t ++ "'"

data PrimTx = PrimTx
  { 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, Generic)

debitCreditCP :: T.Text -> C.Parser DebitCredit
debitCreditCP "Debit" = return Debit
debitCreditCP "Credit" = return Credit
debitCreditCP t = fail ("Unknown debit/credit value '" ++ T.unpack t ++ "'")

instance C.FromNamedRecord PrimTx where
  parseNamedRecord m = do
    code <- m .: "Code" >>= parseCode
    txType <- m .: "Transaction type" >>= parseType
    if code /= txType
      then fail "Expected code and transaction type to agree"
      else
        PrimTx
          <$> (m .: "Date" >>= parseDateM "%0Y%m%d")
          <*> m .: "Name / Description"
          <*> (m .: "Account" >>= parseIbanM)
          <*> (m .: "Counterparty" >>= maybeCP parseIbanM)
          <*> return txType
          <*> (m .: "Debit/credit" >>= debitCreditCP)
          <*> (m .: "Amount (EUR)" >>= parseDecimalM)
          <*> m .: "Notifications"
          <*> (m .: "Resulting balance" >>= parseDecimalM)
          <*> m .: "Tag"

processPrimTx :: TZ -> PrimTx -> Res String Tx
processPrimTx amsTz ptx = Tx (txBaseFromPrim ptx) <$> specificsFromPrim amsTz ptx

parseValueDate :: T.Text -> Res String Day
parseValueDate = parseDateM "%d/%m/%Y"

assertValueDate :: Day -> T.Text -> Res String ()
assertValueDate expected t = do
  valDate <- parseDateM "%d/%m/%Y" t
  when (valDate /= expected) $
    fail "Expected transaction date and value date to be the same"

assertValueDatePtx :: PrimTx -> T.Text -> Res String ()
assertValueDatePtx PrimTx {date = expected} = assertValueDate expected

specificsFromPrim :: TZ -> PrimTx -> Res String TxSpecifics
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]) <-
    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
      { 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 {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]) <-
    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
      { counterpartyName = ptx.description,
        cardSequenceNo = cardSeqNo,
        timestamp = timestamp,
        transaction = transaction,
        terminal = term
      }
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]) <-
    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 /= ptx.description) $
    fail "Expected counterparty name for online banking credit to match primitive description"
  when (Just iban /= ptx.counterparty) $
    fail "Expected IBAN for online banking credit to match and primitive counterparty IBAN"
  return $
    OnlineBankingCredit
      { counterpartyName = name,
        counterpartyIban = iban,
        description = desc,
        timestamp = timestamp
      }
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]) <-
    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 /= ptx.description) $
    fail "Expected counterparty name for online banking debit to match primitive description"
  when (Just iban /= ptx.counterparty) $
    fail "Expected IBAN for online banking debit to match and primitive counterparty IBAN"
  return $
    OnlineBankingDebit
      { counterpartyIban = iban,
        counterpartyName = name,
        description = desc,
        mtimestamp = timestamp
      }
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]) <-
        notifications ptx =~~ regex :: Res String (T.Text, T.Text, T.Text, [T.Text])
      assertValueDatePtx ptx valDateTxt
      iban <- parseIbanM ibanTxt
      when (name /= ptx.description) $
        fail "Expected counterparty name for direct debit to match primitive description"
      when (Just iban /= ptx.counterparty) $
        fail "Expected IBAN for direct debit to match and primitive counterparty IBAN"
      return $
        RecurrentDirectDebit
          { 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]) <-
        notifications ptx =~~ regex :: Res String (T.Text, T.Text, T.Text, [T.Text])
      iban <- parseIbanM ibanTxt
      when (name /= ptx.description) $
        fail "Expected counterparty name for direct debit to match primitive description"
      when (Just iban /= ptx.counterparty) $
        fail "Expected IBAN for direct debit to match and primitive counterparty IBAN"
      return $
        RecurrentDirectDebit
          { counterpartyName = name,
            counterpartyIban = iban,
            description = desc,
            reference = ref,
            mandateId = mandateId,
            creditorId = creditorId,
            otherParty = Nothing
          }
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]) <-
    notifications ptx =~~ regex :: Res String (T.Text, T.Text, T.Text, [T.Text])
  assertValueDatePtx ptx valDateTxt
  iban <- parseIbanM ibanTxt
  when (name /= ptx.description) $
    fail "Expected counterparty name for deposit transfer to match primitive description"
  when (Just iban /= ptx.counterparty) $
    fail "Expected IBAN for deposit transfer to match and primitive counterparty IBAN"
  return $
    DepositTransfer
      { counterpartyName = name,
        counterpartyIban = iban,
        description = desc,
        reference = ref
      }
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]) <-
    ptx.notifications =~~ regex :: Res String (T.Text, T.Text, T.Text, [T.Text])
  assertValueDatePtx ptx valDateTxt
  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]) <-
    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 /= ptx.description) $
    fail "Expected counterparty name for iDEAL payment to match primitive description"
  when (Just iban /= ptx.counterparty) $
    fail "Expected IBAN for iDEAL payment to match and primitive counterparty IBAN"
  return $
    IdealDebit
      { counterpartyName = name,
        counterpartyIban = iban,
        description = desc,
        timestamp = timestamp,
        reference = ref
      }
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]) <-
    notifications ptx =~~ regex :: Res String (T.Text, T.Text, T.Text, [T.Text])
  assertValueDatePtx ptx valDateTxt
  iban <- parseIbanM ibanTxt
  when (name /= ptx.description) $
    fail "Expected counterparty name for batch payment to match primitive description"
  when (Just iban /= ptx.counterparty) $
    fail "Expected IBAN for batch payment to match and primitive counterparty IBAN"
  return $
    BatchPayment
      { counterpartyName = name,
        counterpartyIban = iban,
        description = desc,
        reference = ref
      }
specificsFromPrim _ ptx =
  fail $
    "Could not extract data from transaction ("
      ++ show (transactionType ptx)
      ++ " / "
      ++ show (debitCredit ptx)
      ++ ")"

txBaseFromPrim :: PrimTx -> TxBase
txBaseFromPrim = upcast

readFile :: Handle -> IO (V.Vector Tx)
readFile h = do
  tz <- loadTZFromDB "Europe/Amsterdam"
  contents <- BS.hGetContents h
  primTxs <- case C.decodeByNameWith scsvOptions contents of
    Left err -> fail err
    Right
      ( [ "Date",
          "Name / Description",
          "Account",
          "Counterparty",
          "Code",
          "Debit/credit",
          "Amount (EUR)",
          "Transaction type",
          "Notifications",
          "Resulting balance",
          "Tag"
          ],
        txs
        ) ->
        return txs
    Right _ ->
      fail "Headers do not match expected pattern"
  case V.mapM (processPrimTx tz) primTxs of
    Err err -> fail err
    Ok txs -> return txs