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.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 Import.Ing.Shared
  ( DebitCredit (Credit, Debit),
    maybeCP,
    parseDateM,
    parseDecimalM,
    parseIbanM,
    parseTimestampM,
    scsvOptions,
  )
import System.IO (Handle)
import Text.Regex.TDFA ((=~~))

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
  { ptxDate :: !Day,
    ptxDescription :: !T.Text,
    ptxAccount :: !Iban,
    ptxCounterparty :: !(Maybe Iban),
    ptxTransactionType :: !TransactionType,
    ptxDebitCredit :: !DebitCredit,
    ptxAmount :: !Decimal,
    ptxNotifications :: !T.Text,
    ptxResBal :: !Decimal,
    ptxTag :: !T.Text
  }
  deriving (Show)

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 {ptxDate = expected} = assertValueDate expected

specificsFromPrim :: TZ -> PrimTx -> Res String TxSpecifics
specificsFromPrim amsTz ptx@PrimTx {ptxTransactionType = PaymentTerminalType, ptxDebitCredit = 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])
  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
      }
specificsFromPrim amsTz ptx@PrimTx {ptxTransactionType = PaymentTerminalType, ptxDebitCredit = 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])
  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
      }
specificsFromPrim amsTz ptx@PrimTx {ptxTransactionType = OnlineBankingType, ptxDebitCredit = 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])
  assertValueDatePtx ptx valDateTxt
  iban <- parseIbanM ibanTxt
  timestamp <- parseTimestampM "%d-%m-%Y %H:%M:%S" amsTz timestampTxt
  when (name /= ptxDescription ptx) $
    fail "Expected counterparty name for online banking credit to match primitive description"
  when (Just iban /= ptxCounterparty ptx) $
    fail "Expected IBAN for online banking credit to match and primitive counterparty IBAN"
  return $
    OnlineBankingCredit
      { obcCounterpartyName = name,
        obcCounterpartyIban = iban,
        obcDescription = desc,
        obcTimestamp = timestamp
      }
specificsFromPrim amsTz ptx@PrimTx {ptxTransactionType = OnlineBankingType, ptxDebitCredit = 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])
  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) $
    fail "Expected counterparty name for online banking debit to match primitive description"
  when (Just iban /= ptxCounterparty ptx) $
    fail "Expected IBAN for online banking debit to match and primitive counterparty IBAN"
  return $
    OnlineBankingDebit
      { obdCounterpartyIban = iban,
        obdCounterpartyName = name,
        obdDescription = desc,
        obdTimestamp = timestamp
      }
specificsFromPrim _ ptx@PrimTx {ptxTransactionType = DirectDebitType, ptxDebitCredit = 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])
      assertValueDatePtx ptx valDateTxt
      iban <- parseIbanM ibanTxt
      when (name /= ptxDescription ptx) $
        fail "Expected counterparty name for direct debit to match primitive description"
      when (Just iban /= ptxCounterparty ptx) $
        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
          }
    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])
      iban <- parseIbanM ibanTxt
      when (name /= ptxDescription ptx) $
        fail "Expected counterparty name for direct debit to match primitive description"
      when (Just iban /= ptxCounterparty ptx) $
        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
          }
specificsFromPrim _ ptx@PrimTx {ptxTransactionType = TransferType, ptxDebitCredit = 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])
  assertValueDatePtx ptx valDateTxt
  iban <- parseIbanM ibanTxt
  when (name /= ptxDescription ptx) $
    fail "Expected counterparty name for deposit transfer to match primitive description"
  when (Just iban /= ptxCounterparty ptx) $
    fail "Expected IBAN for deposit transfer to match and primitive counterparty IBAN"
  return $
    DepositTransfer
      { dtCounterpartyName = name,
        dtCounterpartyIban = iban,
        dtDescription = desc,
        dtReference = ref
      }
specificsFromPrim _ ptx@PrimTx {ptxTransactionType = TransferType, ptxDebitCredit = 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])
  assertValueDatePtx ptx valDateTxt
  return $ RoundingSavingsDeposit {rsdSavingsAccount = savingsAccount}
specificsFromPrim amsTz ptx@PrimTx {ptxTransactionType = IdealType, ptxDebitCredit = 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])
  assertValueDatePtx ptx valDateTxt
  timestamp <- parseTimestampM "%d-%m-%Y %H:%M" amsTz timestampTxt
  iban <- parseIbanM ibanTxt
  when (name /= ptxDescription ptx) $
    fail "Expected counterparty name for iDEAL payment to match primitive description"
  when (Just iban /= ptxCounterparty ptx) $
    fail "Expected IBAN for iDEAL payment to match and primitive counterparty IBAN"
  return $
    IdealDebit
      { idCounterpartyName = name,
        idCounterpartyIban = iban,
        idDescription = desc,
        idTimestamp = timestamp,
        idReference = ref
      }
specificsFromPrim _ ptx@PrimTx {ptxTransactionType = BatchPaymentType, ptxDebitCredit = 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])
  assertValueDatePtx ptx valDateTxt
  iban <- parseIbanM ibanTxt
  when (name /= ptxDescription ptx) $
    fail "Expected counterparty name for batch payment to match primitive description"
  when (Just iban /= ptxCounterparty ptx) $
    fail "Expected IBAN for batch payment to match and primitive counterparty IBAN"
  return $
    BatchPayment
      { bpCounterpartyName = name,
        bpCounterpartyIban = iban,
        bpDescription = desc,
        bpReference = ref
      }
specificsFromPrim _ ptx =
  fail $
    "Could not extract data from transaction ("
      ++ show (ptxTransactionType ptx)
      ++ " / "
      ++ show (ptxDebitCredit 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)

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