module Protocol.Credential where

import Control.Monad (Monad(..), replicateM)
import Data.Bool
import Data.Eq (Eq(..))
import Data.Either (Either(..))
import Data.Function (($), (.))
import Data.Functor ((<$>))
import Data.Int (Int)
import Data.Ord (Ord(..))
import Data.Text (Text)
import Prelude (Integral(..), fromIntegral)
import Text.Show (Show)
import qualified Control.Monad.Trans.State.Strict as S
import qualified Data.Char as Char
import qualified Data.List as List
import qualified Data.Text as Text
import qualified System.Random as Random

import Protocol.Arith

-- * Type 'Credential'
-- | A 'Credential' is a word of 15-characters from the alphabet:
-- "123456789ABCDEFGHJKLMNPQRSTUVWXYZabcdefghijkmnopqrstuvwxyz".
-- The last character is a checksum.
-- The entropy is: @(14 * log (9+26+26) / log 2) ~ 83.03 bits@.
newtype Credential p = Credential Text
 deriving (Eq, Show)

tokenBase :: F p
tokenBase = F (9+26+26)
tokenLength ::Int
tokenLength = 14

random ::
 Monad m =>
 Random.RandomGen r =>
 Random.Random i =>
 Negable i =>
 Multiplicative i =>
 i -> S.StateT r m i
random i = S.StateT $ return . Random.randomR (zero, i-one)

-- | @'randomCredential'@ generates a random credential.
randomCredential ::
 forall m p r.
 Monad m =>
 PrimeField p =>
 Random.RandomGen r =>
 S.StateT r m (Credential p)
randomCredential = do
	rs <- replicateM tokenLength (random (fromIntegral (unF tokenBase)))
	let (tot, cs) = List.foldl' (\(acc,ds) d ->
			( acc * tokenBase + F (fromIntegral d)
			, charOfDigit d : ds
			)
		 ) (zero::F p, []) rs
	let checksum = 53 - fromIntegral (unF tot `mod` 53)
	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)

-- | @'readCredential'@ reads and check the well-formedness of a 'Credential'
-- from raw 'Text'.
readCredential ::
 forall p.
 PrimeField p =>
 Text -> Either CredentialError (Credential p)
readCredential s
 | Text.length s /= tokenLength + 1 = Left CredentialError_Length
 | otherwise = do
	tot <- Text.foldl'
	 (\acc c -> acc >>= \a -> ((a * tokenBase) +) <$> digitOfChar c)
	 (Right (zero::F p))
	 (Text.init s)
	checksum <- digitOfChar (Text.last s)
	if unF (tot + checksum) `mod` 53 == 0
	then Right (Credential s)
	else Left CredentialError_Checksum
	where
	digitOfChar c
	 | c <  '1'  = err
	 | c <= '9'  = Right (primeField $ Char.ord c - Char.ord '1')
	 | c <  'A'  = err
	 | c <= 'Z'  = Right (primeField $ Char.ord c - Char.ord 'A' + 9)
	 | c <  'a'  = err
	 | c <= 'z'  = Right (primeField $ Char.ord c - Char.ord 'a' + 9 + 26)
	 | otherwise = err
	 where err = Left $ CredentialError_BadChar c

-- ** Type 'CredentialError'
data CredentialError
 =   CredentialError_BadChar Char.Char
 |   CredentialError_Checksum
 |   CredentialError_Length
 deriving (Eq, Show)