diff options
Diffstat (limited to 'app/Data')
| -rw-r--r-- | app/Data/Iban.hs | 49 |
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 | |||
| 15 | mkIban t = validateIban t >> return (Iban t) | 15 | mkIban t = validateIban t >> return (Iban t) |
| 16 | 16 | ||
| 17 | validateIban :: T.Text -> Either String () | 17 | validateIban :: T.Text -> Either String () |
| 18 | validateIban t = AP.parseOnly ibanP t | 18 | validateIban = 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 | ||