protocol: Fix Credential

diff --git a/hjugement-protocol/Protocol/Credential.hs b/hjugement-protocol/Protocol/Credential.hs
index 07fa64f3087982c7c003540d0380fe7faaf84569..415397d1380a946c9c210b5fa2e44d8c78290bf8 100644 (file)
--- a/hjugement-protocol/Protocol/Credential.hs
+++ b/hjugement-protocol/Protocol/Credential.hs
@@ -2,11 +2,13 @@ module Protocol.Credential where
 
 import Control.Monad (Monad(..), replicateM)
 import Data.Bool
+import Data.Char (Char)
 import Data.Eq (Eq(..))
 import Data.Either (Either(..))
 import Data.Function (($), (.))
 import Data.Functor ((<$>))
 import Data.Int (Int)
+import Data.Maybe (maybe)
 import Data.Ord (Ord(..))
 import Data.Text (Text)
 import Prelude (Integral(..), fromIntegral)
@@ -20,15 +22,19 @@ import qualified System.Random as Random
 import Protocol.Arith
 
 -- * Type 'Credential'
--- | A 'Credential' is a word of 15-characters from the alphabet:
--- "123456789ABCDEFGHJKLMNPQRSTUVWXYZabcdefghijkmnopqrstuvwxyz".
+-- | A 'Credential' is a word of @('tokenLength'+1 '==' 15)@-characters
+-- from a base alphabet of (@'tokenBase' '==' 58)@ characters:
+-- "123456789ABCDEFGHJKLMNPQRSTUVWXYZabcdefghijkmnopqrstuvwxyz"
+-- (beware the absence of "0", "O", "I", and "l").
 -- The last character is a checksum.
--- The entropy is: @(14 * log (9+26+26) / log 2) ~ 83.03 bits@.
+-- The entropy is: @('tokenLength' * log 'tokenBase' / log 2) '==' 82.01… bits@.
 newtype Credential p = Credential Text
  deriving (Eq, Show)
 
-tokenBase :: F p
-tokenBase = F (9+26+26)
+tokenAlphabet :: [Char]
+tokenAlphabet = "123456789ABCDEFGHJKLMNPQRSTUVWXYZabcdefghijkmnopqrstuvwxyz"
+tokenBase :: Int
+tokenBase = List.length tokenAlphabet
 tokenLength ::Int
 tokenLength = 14
 
@@ -40,19 +46,15 @@ randomCredential ::
  Random.RandomGen r =>
  S.StateT r m (Credential p)
 randomCredential = do
-       rs <- replicateM tokenLength (randomR (fromIntegral (unF tokenBase)))
+       rs <- replicateM tokenLength (randomR (fromIntegral tokenBase))
        let (tot, cs) = List.foldl' (\(acc,ds) d ->
-                       ( acc * tokenBase + inF d
-                       , charOfDigit d : ds
-                       )
-                ) (zero::F p, []) rs
-       let checksum = 53 - fromIntegral (unF tot `mod` 53)
+                       ( acc * tokenBase + d
+                       , charOfDigit d : ds )
+                ) (zero::Int, []) rs
+       let checksum = (neg tot + 53) `mod` 53 -- NOTE: why 53 and not 'tokenBase' ?
        return $ Credential $ Text.reverse $ Text.pack (charOfDigit checksum:cs)
        where
-       charOfDigit d
-        | d < 9      = Char.chr (Char.ord '1'+d)
-        | d < (9+26) = Char.chr (Char.ord 'A'+d-9)
-        | otherwise  = Char.chr (Char.ord 'a'+d-9-26)
+       charOfDigit = (tokenAlphabet List.!!)
 
 -- | @'readCredential'@ reads and check the well-formedness of a 'Credential'
 -- from raw 'Text'.
@@ -65,22 +67,16 @@ readCredential s
  | otherwise = do
        tot <- Text.foldl'
         (\acc c -> acc >>= \a -> ((a * tokenBase) +) <$> digitOfChar c)
-        (Right (zero::F p))
+        (Right (zero::Int))
         (Text.init s)
        checksum <- digitOfChar (Text.last s)
-       if unF (tot + checksum) `mod` 53 == 0
+       if (tot + checksum) `mod` 53 == 0
        then Right (Credential s)
        else Left CredentialError_Checksum
        where
-       digitOfChar c
-        | c <  '1'  = err
-        | c <= '9'  = Right (inF $ Char.ord c - Char.ord '1')
-        | c <  'A'  = err
-        | c <= 'Z'  = Right (inF $ Char.ord c - Char.ord 'A' + 9)
-        | c <  'a'  = err
-        | c <= 'z'  = Right (inF $ Char.ord c - Char.ord 'a' + 9 + 26)
-        | otherwise = err
-        where err = Left $ CredentialError_BadChar c
+       digitOfChar c =
+               maybe (Left $ CredentialError_BadChar c) Right $
+               List.elemIndex c tokenAlphabet
 
 -- ** Type 'CredentialError'
 data CredentialError

diff --git a/hjugement-protocol/test/HUnit/Credential.hs b/hjugement-protocol/test/HUnit/Credential.hs
index d680189c6e792de76b4c76e73c90c9a5952621a0..f9077eda525c479ddcf36b9e22afb80b4c7f2d81 100644 (file)
--- a/hjugement-protocol/test/HUnit/Credential.hs
+++ b/hjugement-protocol/test/HUnit/Credential.hs
@@ -15,10 +15,10 @@ hunit = testGroup "Credential"
  [ testGroup "randomCredential"
         [ testCase "WeakParams" $
                S.evalState randomCredential (Random.mkStdGen 0) @?=
-                       Credential @WeakParams "RDfIgdmiCkU46pK"
+                       Credential @WeakParams "RDfIgdmiCkU46pD"
         , testCase "BeleniosParams" $
                S.evalState randomCredential (Random.mkStdGen 0) @?=
-                       Credential @BeleniosParams "RDfIgdmiCkU46pr"
+                       Credential @BeleniosParams "RDfIgdmiCkU46pD"
         ]
  , testGroup "readCredential"
         [ testGroup "WeakParams" $
@@ -26,18 +26,18 @@ hunit = testGroup "Credential"
                        testCase (show inp) $ readCredential inp @?= exp in
                [ "" ==> Left CredentialError_Length
                , "RDfIgdmiCkU46_K"  ==> Left (CredentialError_BadChar '_')
-               , "RDfIgdmiCkU462"   ==> Left CredentialError_Length
-               , "RDfIgdmiCkU46pKE" ==> Left CredentialError_Length
-               , "RDfIgdmiCkU46pJ"  ==> Left CredentialError_Checksum
-               , "RDfIgdmiCkU46pK"  ==> Right (Credential "RDfIgdmiCkU46pK")
+               , "RDfIgdmiCkU46f"   ==> Left CredentialError_Length
+               , "RDfIgdmiCkU46pK7" ==> Left CredentialError_Length
+               , "RDfIgdmiCkU46pE"  ==> Left CredentialError_Checksum
+               , "RDfIgdmiCkU46pD"  ==> Right (Credential "RDfIgdmiCkU46pD")
                ]
         , testGroup "BeleniosParams" $
                let (==>) inp (exp::Either CredentialError (Credential BeleniosParams))  =
                        testCase (show inp) $ readCredential inp @?= exp in
-               [ "RDfIgdmiCkU46R"   ==> Left CredentialError_Length
-               , "RDfIgdmiCkU46pKR" ==> Left CredentialError_Length
-               , "RDfIgdmiCkU46ps"  ==> Left CredentialError_Checksum
-               , "RDfIgdmiCkU46pr"  ==> Right (Credential "RDfIgdmiCkU46pr")
+               [ "RDfIgdmiCkU46f"   ==> Left CredentialError_Length
+               , "RDfIgdmiCkU46pK7" ==> Left CredentialError_Length
+               , "RDfIgdmiCkU46pE"  ==> Left CredentialError_Checksum
+               , "RDfIgdmiCkU46pD"  ==> Right (Credential "RDfIgdmiCkU46pD")
                ]
         ]
  ]