summaryrefslogtreecommitdiffstats
path: root/app/Import/Ing/CurrentAccountCsv.hs
diff options
context:
space:
mode:
Diffstat (limited to 'app/Import/Ing/CurrentAccountCsv.hs')
-rw-r--r--app/Import/Ing/CurrentAccountCsv.hs407
1 files changed, 0 insertions, 407 deletions
diff --git a/app/Import/Ing/CurrentAccountCsv.hs b/app/Import/Ing/CurrentAccountCsv.hs
deleted file mode 100644
index 21ca53d..0000000
--- a/app/Import/Ing/CurrentAccountCsv.hs
+++ /dev/null
@@ -1,407 +0,0 @@
1{-# LANGUAGE OverloadedLists #-}
2{-# LANGUAGE OverloadedStrings #-}
3
4module Import.Ing.CurrentAccountCsv where
5
6import Control.Applicative ((<|>))
7import Control.Monad (when)
8import Data.ByteString.Lazy qualified as BS
9import Data.Csv ((.:))
10import Data.Csv qualified as C
11import Data.Decimal (Decimal)
12import Data.Generics.Product.Subtype (upcast)
13import Data.Iban (Iban)
14import Data.Res (Res (Err, Ok))
15import Data.Text qualified as T
16import Data.Time.Calendar (Day)
17import Data.Time.Clock (UTCTime)
18import Data.Time.Zones (TZ, loadTZFromDB)
19import Data.Vector qualified as V
20import GHC.Generics
21import Import.Ing.Shared
22 ( DebitCredit (Credit, Debit),
23 maybeCP,
24 parseDateM,
25 parseDecimalM,
26 parseIbanM,
27 parseTimestampM,
28 scsvOptions,
29 )
30import System.IO (Handle)
31import Text.Regex.TDFA ((=~~))
32
33data Tx = Tx TxBase TxSpecifics deriving (Show)
34
35data TxBase = TxBase
36 { date :: !Day,
37 account :: !Iban,
38 amount :: !Decimal,
39 resBal :: !Decimal,
40 tag :: !T.Text
41 }
42 deriving (Show, Generic)
43
44data TxSpecifics
45 = PaymentTerminalPayment
46 { counterpartyName :: !T.Text,
47 cardSequenceNo :: !T.Text,
48 timestamp :: !UTCTime,
49 transaction :: !T.Text,
50 terminal :: !T.Text,
51 googlePay :: !Bool
52 }
53 | PaymentTerminalCashback
54 { counterpartyName :: !T.Text,
55 cardSequenceNo :: !T.Text,
56 timestamp :: !UTCTime,
57 transaction :: !T.Text,
58 terminal :: !T.Text
59 }
60 | OnlineBankingCredit
61 { counterpartyName :: !T.Text,
62 counterpartyIban :: !Iban,
63 description :: !T.Text,
64 timestamp :: !UTCTime
65 }
66 | OnlineBankingDebit
67 { counterpartyName :: !T.Text,
68 counterpartyIban :: !Iban,
69 description :: T.Text,
70 mtimestamp :: !(Maybe UTCTime)
71 }
72 | RecurrentDirectDebit
73 { counterpartyName :: !T.Text,
74 counterpartyIban :: !Iban,
75 description :: !T.Text,
76 reference :: !T.Text,
77 mandateId :: !T.Text,
78 creditorId :: !T.Text,
79 otherParty :: !(Maybe T.Text)
80 }
81 | RoundingSavingsDeposit
82 {savingsAccount :: !T.Text}
83 | DepositTransfer
84 { counterpartyName :: !T.Text,
85 counterpartyIban :: !Iban,
86 description :: !T.Text,
87 reference :: !T.Text
88 }
89 | IdealDebit
90 { counterpartyName :: !T.Text,
91 counterpartyIban :: !Iban,
92 description :: !T.Text,
93 timestamp :: !UTCTime,
94 reference :: !T.Text
95 }
96 | BatchPayment
97 { counterpartyName :: !T.Text,
98 counterpartyIban :: !Iban,
99 description :: !T.Text,
100 reference :: !T.Text
101 }
102 deriving (Show, Generic)
103
104data TransactionType
105 = AcceptGiroType -- AC (acceptgiro)
106 | AtmWithdrawalType -- GM (geldautomaat, Giromaat)
107 | BatchPaymentType -- VZ (verzamelbetaling); 'Batch payment'
108 | BranchPostingType -- FL (filiaalboeking)
109 | DepositType -- ST (storting)
110 | DirectDebitType -- IC (incasso); 'SEPA direct debit'
111 | IdealType -- ID (iDEAL); 'iDEAL'
112 | OnlineBankingType -- GT (internetbankieren, Girotel); 'Online Banking'
113 | OfficeWithdrawalType -- PK (opname kantoor, postkantoor)
114 | PaymentTerminalType -- BA (betaalautomaat); 'Payment terminal'
115 | PeriodicTransferType -- PO (periodieke overschrijving)
116 | PhoneBankingType -- GF (telefonisch bankieren, Girofoon)
117 | TransferType -- OV (overboeking); 'Transfer'
118 | VariousType -- DV (diversen)
119 deriving (Eq, Show)
120
121parseCode :: T.Text -> C.Parser TransactionType
122parseCode "AC" = return AcceptGiroType
123parseCode "GM" = return AtmWithdrawalType
124parseCode "VZ" = return BatchPaymentType
125parseCode "FL" = return BranchPostingType
126parseCode "ST" = return DepositType
127parseCode "IC" = return DirectDebitType
128parseCode "ID" = return IdealType
129parseCode "GT" = return OnlineBankingType
130parseCode "PK" = return OfficeWithdrawalType
131parseCode "BA" = return PaymentTerminalType
132parseCode "PO" = return PeriodicTransferType
133parseCode "GF" = return PhoneBankingType
134parseCode "OV" = return TransferType
135parseCode "DV" = return VariousType
136parseCode t = fail $ "Unknown transaction code '" ++ T.unpack t ++ "'"
137
138parseType :: T.Text -> C.Parser TransactionType
139parseType "SEPA direct debit" = return DirectDebitType
140parseType "Batch payment" = return BatchPaymentType
141parseType "Online Banking" = return OnlineBankingType
142parseType "Payment terminal" = return PaymentTerminalType
143parseType "Transfer" = return TransferType
144parseType "iDEAL" = return IdealType
145parseType t = fail $ "Unknown transaction type '" ++ T.unpack t ++ "'"
146
147data PrimTx = PrimTx
148 { date :: !Day,
149 description :: !T.Text,
150 account :: !Iban,
151 counterparty :: !(Maybe Iban),
152 transactionType :: !TransactionType,
153 debitCredit :: !DebitCredit,
154 amount :: !Decimal,
155 notifications :: !T.Text,
156 resBal :: !Decimal,
157 tag :: !T.Text
158 }
159 deriving (Show, Generic)
160
161debitCreditCP :: T.Text -> C.Parser DebitCredit
162debitCreditCP "Debit" = return Debit
163debitCreditCP "Credit" = return Credit
164debitCreditCP t = fail ("Unknown debit/credit value '" ++ T.unpack t ++ "'")
165
166instance C.FromNamedRecord PrimTx where
167 parseNamedRecord m = do
168 code <- m .: "Code" >>= parseCode
169 txType <- m .: "Transaction type" >>= parseType
170 if code /= txType
171 then fail "Expected code and transaction type to agree"
172 else
173 PrimTx
174 <$> (m .: "Date" >>= parseDateM "%0Y%m%d")
175 <*> m .: "Name / Description"
176 <*> (m .: "Account" >>= parseIbanM)
177 <*> (m .: "Counterparty" >>= maybeCP parseIbanM)
178 <*> return txType
179 <*> (m .: "Debit/credit" >>= debitCreditCP)
180 <*> (m .: "Amount (EUR)" >>= parseDecimalM)
181 <*> m .: "Notifications"
182 <*> (m .: "Resulting balance" >>= parseDecimalM)
183 <*> m .: "Tag"
184
185processPrimTx :: TZ -> PrimTx -> Res String Tx
186processPrimTx amsTz ptx = Tx (txBaseFromPrim ptx) <$> specificsFromPrim amsTz ptx
187
188parseValueDate :: T.Text -> Res String Day
189parseValueDate = parseDateM "%d/%m/%Y"
190
191assertValueDate :: Day -> T.Text -> Res String ()
192assertValueDate expected t = do
193 valDate <- parseDateM "%d/%m/%Y" t
194 when (valDate /= expected) $
195 fail "Expected transaction date and value date to be the same"
196
197assertValueDatePtx :: PrimTx -> T.Text -> Res String ()
198assertValueDatePtx PrimTx {date = expected} = assertValueDate expected
199
200specificsFromPrim :: TZ -> PrimTx -> Res String TxSpecifics
201specificsFromPrim amsTz ptx@PrimTx {transactionType = PaymentTerminalType, debitCredit = Debit} = do
202 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
203 (_, _, _, [cardSeqNo, timestampTxt, transaction, _, gpayTerm, noGpayTerm, valDateTxt]) <-
204 ptx.notifications =~~ regex :: Res String (T.Text, T.Text, T.Text, [T.Text])
205 assertValueDatePtx ptx valDateTxt
206 timestamp <- parseTimestampM "%d/%m/%Y %H:%M" amsTz timestampTxt
207 return $
208 PaymentTerminalPayment
209 { counterpartyName = ptx.description,
210 cardSequenceNo = cardSeqNo,
211 timestamp = timestamp,
212 transaction = transaction,
213 terminal = if T.null gpayTerm then noGpayTerm else gpayTerm,
214 googlePay = T.null noGpayTerm
215 }
216specificsFromPrim amsTz ptx@PrimTx {transactionType = PaymentTerminalType, debitCredit = Credit} = do
217 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
218 (_, _, _, [cardSeqNo, timestampTxt, transaction, term, valDateTxt]) <-
219 notifications ptx =~~ regex :: Res String (T.Text, T.Text, T.Text, [T.Text])
220 assertValueDatePtx ptx valDateTxt
221 timestamp <- parseTimestampM "%d/%m/%Y %H:%M" amsTz timestampTxt
222 return $
223 PaymentTerminalCashback
224 { counterpartyName = ptx.description,
225 cardSequenceNo = cardSeqNo,
226 timestamp = timestamp,
227 transaction = transaction,
228 terminal = term
229 }
230specificsFromPrim amsTz ptx@PrimTx {transactionType = OnlineBankingType, debitCredit = Credit} = do
231 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
232 (_, _, _, [name, desc, ibanTxt, timestampTxt, valDateTxt]) <-
233 notifications ptx =~~ regex :: Res String (T.Text, T.Text, T.Text, [T.Text])
234 assertValueDatePtx ptx valDateTxt
235 iban <- parseIbanM ibanTxt
236 timestamp <- parseTimestampM "%d-%m-%Y %H:%M:%S" amsTz timestampTxt
237 when (name /= ptx.description) $
238 fail "Expected counterparty name for online banking credit to match primitive description"
239 when (Just iban /= ptx.counterparty) $
240 fail "Expected IBAN for online banking credit to match and primitive counterparty IBAN"
241 return $
242 OnlineBankingCredit
243 { counterpartyName = name,
244 counterpartyIban = iban,
245 description = desc,
246 timestamp = timestamp
247 }
248specificsFromPrim amsTz ptx@PrimTx {transactionType = OnlineBankingType, debitCredit = Debit} = do
249 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
250 (_, _, _, [name, desc, ibanTxt, _, timestampTxt, valDateTxt]) <-
251 notifications ptx =~~ regex :: Res String (T.Text, T.Text, T.Text, [T.Text])
252 assertValueDatePtx ptx valDateTxt
253 iban <- parseIbanM ibanTxt
254 timestamp <-
255 if T.null timestampTxt
256 then pure Nothing
257 else Just <$> parseTimestampM "%d-%m-%Y %H:%M:%S" amsTz timestampTxt
258 when (name /= ptx.description) $
259 fail "Expected counterparty name for online banking debit to match primitive description"
260 when (Just iban /= ptx.counterparty) $
261 fail "Expected IBAN for online banking debit to match and primitive counterparty IBAN"
262 return $
263 OnlineBankingDebit
264 { counterpartyIban = iban,
265 counterpartyName = name,
266 description = desc,
267 mtimestamp = timestamp
268 }
269specificsFromPrim _ ptx@PrimTx {transactionType = DirectDebitType, debitCredit = Debit} =
270 normalRecurrentDirectDebit <|> ingInsurancePayment
271 where
272 normalRecurrentDirectDebit = do
273 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
274 (_, _, _, [name, desc, ibanTxt, ref, mandateId, creditorId, _, otherParty, valDateTxt]) <-
275 notifications ptx =~~ regex :: Res String (T.Text, T.Text, T.Text, [T.Text])
276 assertValueDatePtx ptx valDateTxt
277 iban <- parseIbanM ibanTxt
278 when (name /= ptx.description) $
279 fail "Expected counterparty name for direct debit to match primitive description"
280 when (Just iban /= ptx.counterparty) $
281 fail "Expected IBAN for direct debit to match and primitive counterparty IBAN"
282 return $
283 RecurrentDirectDebit
284 { counterpartyName = name,
285 counterpartyIban = iban,
286 description = desc,
287 reference = ref,
288 mandateId = mandateId,
289 creditorId = creditorId,
290 otherParty = if T.null otherParty then Nothing else Just otherParty
291 }
292 ingInsurancePayment = do
293 let regex = "^Name: (.* ING Verzekeren) Description: (.*) IBAN: ([A-Z0-9]+) Reference: (.*) Mandate ID: (.*) Creditor ID: (.*) Recurrent SEPA direct debit$" :: String
294 (_, _, _, [name, desc, ibanTxt, ref, mandateId, creditorId]) <-
295 notifications ptx =~~ regex :: Res String (T.Text, T.Text, T.Text, [T.Text])
296 iban <- parseIbanM ibanTxt
297 when (name /= ptx.description) $
298 fail "Expected counterparty name for direct debit to match primitive description"
299 when (Just iban /= ptx.counterparty) $
300 fail "Expected IBAN for direct debit to match and primitive counterparty IBAN"
301 return $
302 RecurrentDirectDebit
303 { counterpartyName = name,
304 counterpartyIban = iban,
305 description = desc,
306 reference = ref,
307 mandateId = mandateId,
308 creditorId = creditorId,
309 otherParty = Nothing
310 }
311specificsFromPrim _ ptx@PrimTx {transactionType = TransferType, debitCredit = Credit} = do
312 let regex = "^Name: (.*) Description: (.*) IBAN: ([A-Z0-9]+) Reference: (.*) Value date: ([0-9]{2}/[0-9]{2}/[0-9]{4})$" :: String
313 (_, _, _, [name, desc, ibanTxt, ref, valDateTxt]) <-
314 notifications ptx =~~ regex :: Res String (T.Text, T.Text, T.Text, [T.Text])
315 assertValueDatePtx ptx valDateTxt
316 iban <- parseIbanM ibanTxt
317 when (name /= ptx.description) $
318 fail "Expected counterparty name for deposit transfer to match primitive description"
319 when (Just iban /= ptx.counterparty) $
320 fail "Expected IBAN for deposit transfer to match and primitive counterparty IBAN"
321 return $
322 DepositTransfer
323 { counterpartyName = name,
324 counterpartyIban = iban,
325 description = desc,
326 reference = ref
327 }
328specificsFromPrim _ ptx@PrimTx {transactionType = TransferType, debitCredit = Debit} = do
329 let regex = "^To Oranje spaarrekening ([A-Z0-9]+) Afronding Value date: ([0-9]{2}/[0-9]{2}/[0-9]{4})$" :: String
330 (_, _, _, [savingsAccount, valDateTxt]) <-
331 ptx.notifications =~~ regex :: Res String (T.Text, T.Text, T.Text, [T.Text])
332 assertValueDatePtx ptx valDateTxt
333 return $ RoundingSavingsDeposit {savingsAccount = savingsAccount}
334specificsFromPrim amsTz ptx@PrimTx {transactionType = IdealType, debitCredit = Debit} = do
335 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
336 (_, _, _, [name, desc, ibanTxt, timestampTxt, ref, valDateTxt]) <-
337 notifications ptx =~~ regex :: Res String (T.Text, T.Text, T.Text, [T.Text])
338 assertValueDatePtx ptx valDateTxt
339 timestamp <- parseTimestampM "%d-%m-%Y %H:%M" amsTz timestampTxt
340 iban <- parseIbanM ibanTxt
341 when (name /= ptx.description) $
342 fail "Expected counterparty name for iDEAL payment to match primitive description"
343 when (Just iban /= ptx.counterparty) $
344 fail "Expected IBAN for iDEAL payment to match and primitive counterparty IBAN"
345 return $
346 IdealDebit
347 { counterpartyName = name,
348 counterpartyIban = iban,
349 description = desc,
350 timestamp = timestamp,
351 reference = ref
352 }
353specificsFromPrim _ ptx@PrimTx {transactionType = BatchPaymentType, debitCredit = Credit} = do
354 let regex = "^Name: (.*) Description: (.*) IBAN: ([A-Z0-9]+) Reference: (.*) Value date: ([0-9]{2}/[0-9]{2}/[0-9]{4})$" :: String
355 (_, _, _, [name, desc, ibanTxt, ref, valDateTxt]) <-
356 notifications ptx =~~ regex :: Res String (T.Text, T.Text, T.Text, [T.Text])
357 assertValueDatePtx ptx valDateTxt
358 iban <- parseIbanM ibanTxt
359 when (name /= ptx.description) $
360 fail "Expected counterparty name for batch payment to match primitive description"
361 when (Just iban /= ptx.counterparty) $
362 fail "Expected IBAN for batch payment to match and primitive counterparty IBAN"
363 return $
364 BatchPayment
365 { counterpartyName = name,
366 counterpartyIban = iban,
367 description = desc,
368 reference = ref
369 }
370specificsFromPrim _ ptx =
371 fail $
372 "Could not extract data from transaction ("
373 ++ show (transactionType ptx)
374 ++ " / "
375 ++ show (debitCredit ptx)
376 ++ ")"
377
378txBaseFromPrim :: PrimTx -> TxBase
379txBaseFromPrim = upcast
380
381readFile :: Handle -> IO (V.Vector Tx)
382readFile h = do
383 tz <- loadTZFromDB "Europe/Amsterdam"
384 contents <- BS.hGetContents h
385 primTxs <- case C.decodeByNameWith scsvOptions contents of
386 Left err -> fail err
387 Right
388 ( [ "Date",
389 "Name / Description",
390 "Account",
391 "Counterparty",
392 "Code",
393 "Debit/credit",
394 "Amount (EUR)",
395 "Transaction type",
396 "Notifications",
397 "Resulting balance",
398 "Tag"
399 ],
400 txs
401 ) ->
402 return txs
403 Right _ ->
404 fail "Headers do not match expected pattern"
405 case V.mapM (processPrimTx tz) primTxs of
406 Err err -> fail err
407 Ok txs -> return txs