summaryrefslogtreecommitdiffstats
path: root/app/Data/Iban.hs
diff options
context:
space:
mode:
authorRutger Broekhoff2025-03-21 09:45:22 +0100
committerRutger Broekhoff2025-03-21 09:45:22 +0100
commite40e290ef216656d304f4f3095dbef223e94191d (patch)
tree925951d353ac81e122a8d34683ae7b7093930f44 /app/Data/Iban.hs
parent86c8896ee69b068368b4ef9a4c3923285907c328 (diff)
downloadrdcapsis-e40e290ef216656d304f4f3095dbef223e94191d.tar.gz
rdcapsis-e40e290ef216656d304f4f3095dbef223e94191d.zip
Changes
Diffstat (limited to 'app/Data/Iban.hs')
-rw-r--r--app/Data/Iban.hs49
1 files changed, 27 insertions, 22 deletions
diff --git a/app/Data/Iban.hs b/app/Data/Iban.hs
index a42e192..45343ec 100644
--- a/app/Data/Iban.hs
+++ b/app/Data/Iban.hs
@@ -15,26 +15,31 @@ mkIban :: T.Text -> Either String Iban
15mkIban t = validateIban t >> return (Iban t) 15mkIban t = validateIban t >> return (Iban t)
16 16
17validateIban :: T.Text -> Either String () 17validateIban :: T.Text -> Either String ()
18validateIban t = AP.parseOnly ibanP t 18validateIban = AP.parseOnly $ do
19 countryCode <- AP.count 2 AP.letter
20 checkDigits <- AP.count 2 AP.digit
21 chars <- AP.many1 (AP.letter <|> AP.digit)
22 endOfInput
23 if length chars < 30
24 then
25 if valid countryCode checkDigits chars
26 then return ()
27 else fail $ "IBAN checksum does not match (" <> countryCode <> checkDigits <> chars <> ")"
28 else fail "IBAN has more than 34 characters"
19 where 29 where
20 ibanP = do 30 letterToInt c = ord (toUpper c) - ord 'A' + 10
21 countryCode <- AP.count 2 ibanLetter 31 charsToInteger =
22 checkDigits <- AP.count 2 ibanDigit 32 foldl'
23 chars <- AP.many1 ibanChar 33 ( \acc -> \case
24 endOfInput 34 d
25 if length chars < 30 35 | '0' <= d && d <= '9' -> acc * 10 + toInteger (digitToInt d)
26 then 36 | 'A' <= d && d <= 'Z'
27 if valid countryCode checkDigits chars 37 || 'a' <= d && d <= 'z' ->
28 then return () 38 acc * 100 + toInteger (letterToInt d)
29 else fail $ "IBAN checksum does not match (" ++ T.unpack t ++ ")" 39 | otherwise -> error "unreachable"
30 else fail "IBAN has more than 34 characters" 40 )
31 where 41 0
32 ibanChar = ibanDigit <|> ibanLetter 42 ibanToInteger countryCode checkDigits chars =
33 ibanDigit = toInteger . digitToInt <$> AP.digit 43 charsToInteger chars * 1000000 + charsToInteger countryCode * 100 + charsToInteger checkDigits
34 ibanLetter = letterToInt <$> AP.letter 44 valid countryCode checkDigits chars =
35 letterToInt c = toInteger (ord (toUpper c) - ord 'A' + 10) 45 ibanToInteger countryCode checkDigits chars `mod` 97 == 1
36 charsToInteger = foldl' (\acc d -> if d >= 10 then acc * 100 + d else acc * 10 + d) 0
37 ibanToInteger countryCode checkDigits chars =
38 charsToInteger chars * 1000000 + charsToInteger countryCode * 100 + charsToInteger checkDigits
39 valid countryCode checkDigits chars =
40 ibanToInteger countryCode checkDigits chars `mod` 97 == 1