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)
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.Arithmetic

-- * Type 'Credential'
-- | 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: @('tokenLength' * log 'tokenBase' / log 2) '==' 82.01… bits@.
newtype Credential = Credential Text
 deriving (Eq, Show)

credentialAlphabet :: [Char] -- TODO: make this an array
credentialAlphabet = "123456789ABCDEFGHJKLMNPQRSTUVWXYZabcdefghijkmnopqrstuvwxyz"
tokenBase :: Int
tokenBase = List.length credentialAlphabet
tokenLength ::Int
tokenLength = 14

-- | @'randomCredential'@ generates a random 'Credential'.
randomCredential ::
 Monad m =>
 Random.RandomGen r =>
 S.StateT r m Credential
randomCredential = do
	rs <- replicateM tokenLength (randomR (fromIntegral tokenBase))
	let (tot, cs) = List.foldl' (\(acc,ds) d ->
			( 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 = (credentialAlphabet List.!!)

-- | @'readCredential'@ reads and check the well-formedness of a 'Credential'
-- from raw 'Text'.
readCredential :: Text -> Either CredentialError Credential
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::Int))
	 (Text.init s)
	checksum <- digitOfChar (Text.last s)
	if (tot + checksum) `mod` 53 == 0
	then Right (Credential s)
	else Left CredentialError_Checksum
	where
	digitOfChar c =
		maybe (Left $ CredentialError_BadChar c) Right $
		List.elemIndex c credentialAlphabet

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