diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,30 @@ +Copyright (c) 2018, Henning Thielemann + +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + * Redistributions in binary form must reproduce the above + copyright notice, this list of conditions and the following + disclaimer in the documentation and/or other materials provided + with the distribution. + + * Neither the name of Henning Thielemann nor the names of other + contributors may be used to endorse or promote products derived + from this software without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT +LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR +A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT +OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT +LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, +DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY +THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. diff --git a/Setup.lhs b/Setup.lhs new file mode 100644 --- /dev/null +++ b/Setup.lhs @@ -0,0 +1,3 @@ +#!/usr/bin/env runhaskell +> import Distribution.Simple +> main = defaultMain diff --git a/checksum.cabal b/checksum.cabal new file mode 100644 --- /dev/null +++ b/checksum.cabal @@ -0,0 +1,39 @@ +Name: checksum +Version: 0.0 +Synopsis: Compute and verify checksums of ISBN, IBAN, etc. +Description: + Compute and verify checksums of various identifiers, + such as IBAN, ISBN, EAN, Germany's Citizen Card. +Homepage: http://hub.darcs.net/thielema/checksum +License: BSD3 +License-File: LICENSE +Author: Henning Thielemann +Maintainer: haskell@henning-thielemann.de +Category: Math +Build-Type: Simple +Cabal-Version: >=1.10 + +Source-Repository this + Tag: 0.0 + Type: darcs + Location: http://hub.darcs.net/thielema/checksum + +Source-Repository head + Type: darcs + Location: http://hub.darcs.net/thielema/checksum + +Library + Exposed-Modules: + Math.Checksum.CitizenCard.Germany + Math.Checksum.IBAN + Math.Checksum.ISBN + Math.Checksum.EAN + Other-Modules: + Math.Checksum.Utility + Build-Depends: + explicit-exception >= 0.1.9 && <0.2, + utility-ht >=0.0.11 && <0.1, + base >=4.5 && <5 + Hs-Source-Dirs: src + Default-Language: Haskell2010 + GHC-Options: -Wall diff --git a/src/Math/Checksum/CitizenCard/Germany.hs b/src/Math/Checksum/CitizenCard/Germany.hs new file mode 100644 --- /dev/null +++ b/src/Math/Checksum/CitizenCard/Germany.hs @@ -0,0 +1,36 @@ +{- | +Personalausweisnummer + + +-} +module Math.Checksum.CitizenCard.Germany (construct) where + +import qualified Data.List.HT as ListHT +import Math.Checksum.Utility (decomposePositional) + + +digits :: Int -> Int -> [Int] +digits n x = reverse $ ListHT.padRight 0 n $ decomposePositional 10 x + +check3 :: [Int] -> Int +check3 = flip mod 10 . sum . zipWith (*) (cycle [7,3,1]) + +addCheck3 :: [Int] -> [Int] +addCheck3 xs = xs ++ [check3 xs] + +string :: [Int] -> String +string = concatMap show + +{- | +> construct city no birthDate expiration +> construct 1234 56789 980706 180706 == "1234567897D<<9807062<1807066<<<<<<<8" +-} +construct :: Int -> Int -> Int -> Int -> String +construct city no birth expire = + let dno = addCheck3 $ digits 4 city ++ digits 5 no + dbirth = addCheck3 $ digits 6 birth + dexpire = addCheck3 $ digits 6 expire + in string dno ++ "D<<" ++ + string dbirth ++ "<" ++ + string dexpire ++ replicate 7 '<' ++ + show (check3 $ dno ++ dbirth ++ dexpire) diff --git a/src/Math/Checksum/EAN.hs b/src/Math/Checksum/EAN.hs new file mode 100644 --- /dev/null +++ b/src/Math/Checksum/EAN.hs @@ -0,0 +1,47 @@ +{- | +European Article Number + + +-} +module Math.Checksum.EAN (checksum, valid) where + +import qualified Math.Checksum.Utility as Util + +import Control.Monad.Exception.Synchronous (Exceptional) + +import qualified Data.List as List + + +{- | +> checksum "400638129240" == Success 5 +-} +checksum :: String -> Exceptional String Int +checksum xs = do + ws <- mapM Util.intFromDigit xs + return $ 9 - remainder (ws++[9]) + +{- | +> valid "4006381292405" == Nothing +> valid "4006381292406" == Just "check sum does not match" +-} +valid :: String -> Maybe String +valid xs = Util.processValid $ do + ws <- mapM Util.intFromDigit xs + return (0 == remainder ws) + +{- +Not stream-friendly way, but more declarative. +-} +_remainder :: [Int] -> Int +_remainder ws = mod (sum $ zipWith (*) (cycle [1,3]) (reverse ws)) 10 + +remainder :: [Int] -> Int +remainder ws = + let (x,y) = sum2 ws + in mod (3*x+y) 10 + +sum2 :: (Num a) => [a] -> (a,a) +sum2 = List.foldl' (\(a,b) x -> strictPair b (a+x)) (0,0) + +strictPair :: a -> b -> (a,b) +strictPair a b = ((,) $! a) $! b diff --git a/src/Math/Checksum/IBAN.hs b/src/Math/Checksum/IBAN.hs new file mode 100644 --- /dev/null +++ b/src/Math/Checksum/IBAN.hs @@ -0,0 +1,65 @@ +{- | +International Bank Account Number + + +-} +module Math.Checksum.IBAN (checksum, valid) where + +import qualified Math.Checksum.Utility as Util + +import qualified Control.Monad.Exception.Synchronous as ME +import Control.Monad.Exception.Synchronous (Exceptional(Success), throw) +import Control.Applicative (Applicative, liftA2, pure, (<$>)) + +import Data.Ix (inRange, index) +import Data.Bool.HT (if') + + +{- | +> checksum "DE" "210501700012345678" == Success 68 +-} +checksum :: String -> String -> Exceptional String Int +checksum country bban = + (98-) . remainder <$> + mapM intFromAlphaNum bban +++ + mapM intFromAlpha country +++ pure [(100,0)] + +{- | +> valid "DE68210501700012345678" == Nothing +> valid "DE68210501700012345679" == Just "check sum does not match" +-} +valid :: String -> Maybe String +valid (country0:country1:sum0:sum1:bban) = Util.processValid $ do + k <- + remainder <$> + mapM intFromAlphaNum bban +++ + mapM intFromAlpha [country0,country1] +++ + mapM intFromDigit [sum0,sum1] + return (k==1) +valid _ = Just "too few characters" + +infixr 5 +++ + +(+++) :: (Applicative f) => f [a] -> f [a] -> f [a] +(+++) = liftA2 (++) + +remainder :: [(Int,Int)] -> Int +remainder = divide 97 + +divide :: Int -> [(Int,Int)] -> Int +divide divisor = foldl (\r (base,x) -> mod (base*r+x) divisor) 0 + +intFromDigit :: Char -> Exceptional String (Int,Int) +intFromDigit c = (,) 10 <$> Util.intFromDigit c + +intFromAlpha :: Char -> Exceptional String (Int,Int) +intFromAlpha c = + fmap ((,) 100 . (10+)) $ + if' (inRange ('a','z') c) (Success $ index ('a','z') c) $ + if' (inRange ('A','Z') c) (Success $ index ('A','Z') c) $ + throw $ "not a letter: " ++ [c] + +intFromAlphaNum :: Char -> Exceptional String (Int,Int) +intFromAlphaNum c = + ME.mapException (const $ "invalid alphanumeric character: " ++ [c]) $ + ME.alternative (intFromDigit c) (intFromAlpha c) diff --git a/src/Math/Checksum/ISBN.hs b/src/Math/Checksum/ISBN.hs new file mode 100644 --- /dev/null +++ b/src/Math/Checksum/ISBN.hs @@ -0,0 +1,46 @@ +{- | +International Standard Book Number + + + +Covers only ISBN-10. For ISBN-13 simply use "Math.Checksum.EAN". +-} +module Math.Checksum.ISBN (checksum, valid) where + +import qualified Math.Checksum.Utility as Util + +import qualified Control.Monad.Exception.Synchronous as ME +import Control.Monad.Exception.Synchronous (Exceptional) +import Control.Monad (zipWithM) +import Control.Applicative ((<$>)) + + +{- | +> checksum "346811124" == Success 10 +-} +checksum :: String -> Exceptional String Int +checksum xs = remainder [1..] <$> mapM Util.intFromDigit xs + +{- | +> valid "346811124X" == Nothing +> valid "3468111240" == Just "check sum does not match" +-} +valid :: String -> Maybe String +valid xs = Util.processValid $ do + ds <- + zipWithM id + (replicate 9 (Util.intFromDigit=<<) ++ (intFromCheckdigit=<<) : + [ME.switch + (const $ return 0) (const $ ME.throw "more than 10 characters")]) + (map return xs ++ [ME.throw "less than 10 characters"]) + return $ 0 == remainder weights ds + +intFromCheckdigit :: Char -> Exceptional String Int +intFromCheckdigit 'X' = return 10 +intFromCheckdigit c = Util.intFromDigit c + +remainder :: [Int] -> [Int] -> Int +remainder ws ds = mod (sum (zipWith (*) ws ds)) 11 + +weights :: [Int] +weights = [1..10] ++ [-1] diff --git a/src/Math/Checksum/Utility.hs b/src/Math/Checksum/Utility.hs new file mode 100644 --- /dev/null +++ b/src/Math/Checksum/Utility.hs @@ -0,0 +1,25 @@ +module Math.Checksum.Utility where + +import qualified Control.Monad.Exception.Synchronous as ME +import Control.Monad.Exception.Synchronous (Exceptional(Success), throw) + +import Data.Ix (inRange, index) + +import Data.List (unfoldr) +import Data.Maybe.HT (toMaybe) +import Data.Tuple.HT (swap) + + +decomposePositional :: Integral a => a -> a -> [a] +decomposePositional b = + unfoldr (\n -> toMaybe (n/=0) $ swap (divMod n b)) + +intFromDigit :: Char -> Exceptional String Int +intFromDigit c = + if inRange ('0','9') c + then Success $ index ('0','9') c + else throw $ "not a digit: " ++ [c] + +processValid :: Exceptional String Bool -> Maybe String +processValid = + ME.switch Just (\b -> toMaybe (not b) "check sum does not match")