summaryrefslogtreecommitdiff
path: root/src/Voting/Protocol/Credential.hs
diff options
context:
space:
mode:
Diffstat (limited to 'src/Voting/Protocol/Credential.hs')
-rw-r--r--src/Voting/Protocol/Credential.hs69
1 files changed, 50 insertions, 19 deletions
diff --git a/src/Voting/Protocol/Credential.hs b/src/Voting/Protocol/Credential.hs
index 39ac87b..9ad56ce 100644
--- a/src/Voting/Protocol/Credential.hs
+++ b/src/Voting/Protocol/Credential.hs
@@ -1,26 +1,30 @@
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE DerivingStrategies #-}
module Voting.Protocol.Credential where
import Control.DeepSeq (NFData)
-import Control.Monad (Monad(..), replicateM)
+import Control.Monad (Monad(..), forM_, replicateM)
import Data.Bits
import Data.Bool
import Data.Char (Char)
-import Data.Either (Either(..))
+import Data.Either (Either(..), either)
import Data.Eq (Eq(..))
import Data.Function (($))
import Data.Functor ((<$>))
import Data.Int (Int)
import Data.Maybe (maybe)
import Data.Ord (Ord(..))
+import Data.Semigroup (Semigroup(..))
import Data.Text (Text)
import GHC.Generics (Generic)
import Numeric.Natural (Natural)
import Prelude (Integral(..), fromIntegral, div)
-import Text.Show (Show)
+import Text.Show (Show(..))
import qualified Control.Monad.Trans.State.Strict as S
import qualified Crypto.KDF.PBKDF2 as Crypto
+import qualified Data.Aeson as JSON
+import qualified Data.Aeson.Types as JSON
import qualified Data.ByteArray as ByteArray
import qualified Data.ByteString as BS
import qualified Data.Char as Char
@@ -29,7 +33,7 @@ import qualified Data.Text as Text
import qualified Data.Text.Encoding as Text
import qualified System.Random as Random
-import Voting.Protocol.Arithmetic
+import Voting.Protocol.FFC
-- * Type 'Credential'
-- | A 'Credential' is a word of @('tokenLength'+1 '==' 15)@-characters
@@ -39,7 +43,14 @@ import Voting.Protocol.Arithmetic
-- The last character is a checksum.
-- The entropy is: @('tokenLength' * log 'tokenBase' / log 2) '==' 82.01… bits@.
newtype Credential = Credential Text
- deriving (Eq,Show,Generic,NFData)
+ deriving (Eq,Show,Generic)
+ deriving newtype NFData
+ deriving newtype JSON.ToJSON
+instance JSON.FromJSON Credential where
+ parseJSON json@(JSON.String s) =
+ either (\err -> JSON.typeMismatch ("Credential: "<>show err) json) return $
+ readCredential s
+ parseJSON json = JSON.typeMismatch "Credential" json
credentialAlphabet :: [Char] -- TODO: make this an array
credentialAlphabet = "123456789ABCDEFGHJKLMNPQRSTUVWXYZabcdefghijkmnopqrstuvwxyz"
@@ -63,9 +74,9 @@ randomCredential = do
-- | @'readCredential'@ reads and check the well-formedness of a 'Credential'
-- from raw 'Text'.
-readCredential :: Text -> Either CredentialError Credential
+readCredential :: Text -> Either ErrorToken Credential
readCredential s
- | Text.length s /= tokenLength + 1 = Left CredentialError_Length
+ | Text.length s /= tokenLength + 1 = Left ErrorToken_Length
| otherwise = do
tot <- Text.foldl'
(\acc c -> acc >>= \a -> ((a * tokenBase) +) <$> digitOfChar c)
@@ -74,22 +85,29 @@ readCredential s
checksum <- digitOfChar (Text.last s)
if (tot + checksum) `mod` 53 == 0
then Right (Credential s)
- else Left CredentialError_Checksum
+ else Left ErrorToken_Checksum
where
digitOfChar c =
- maybe (Left $ CredentialError_BadChar c) Right $
+ maybe (Left $ ErrorToken_BadChar c) Right $
List.elemIndex c credentialAlphabet
--- ** Type 'CredentialError'
-data CredentialError
- = CredentialError_BadChar Char.Char
- | CredentialError_Checksum
- | CredentialError_Length
+-- ** Type 'ErrorToken'
+data ErrorToken
+ = ErrorToken_BadChar Char.Char
+ | ErrorToken_Checksum
+ | ErrorToken_Length
deriving (Eq,Show,Generic,NFData)
-- ** Type 'UUID'
newtype UUID = UUID Text
- deriving (Eq,Ord,Show,Generic,NFData)
+ deriving (Eq,Ord,Show,Generic)
+ deriving anyclass (JSON.ToJSON)
+ deriving newtype NFData
+instance JSON.FromJSON UUID where
+ parseJSON json@(JSON.String s) =
+ either (\err -> JSON.typeMismatch ("UUID: "<>show err) json) return $
+ readUUID s
+ parseJSON json = JSON.typeMismatch "UUID" json
-- | @'randomUUID'@ generates a random 'UUID'.
randomUUID ::
@@ -102,16 +120,29 @@ randomUUID = do
where
charOfDigit = (credentialAlphabet List.!!)
+-- | @'readCredential'@ reads and check the well-formedness of a 'Credential'
+-- from raw 'Text'.
+readUUID :: Text -> Either ErrorToken UUID
+readUUID s
+ | Text.length s /= tokenLength = Left ErrorToken_Length
+ | otherwise = do
+ forM_ (Text.unpack s) digitOfChar
+ return (UUID s)
+ where
+ digitOfChar c =
+ maybe (Left $ ErrorToken_BadChar c) Right $
+ List.elemIndex c credentialAlphabet
+
-- ** Type 'SecretKey'
type SecretKey = E
-randomSecretKey :: Monad m => RandomGen r => SubGroup q => S.StateT r m (SecretKey q)
+randomSecretKey :: Reifies c FFC => Monad m => RandomGen r => S.StateT r m (SecretKey c)
randomSecretKey = random
-- | @('credentialSecretKey' uuid cred)@ returns the 'SecretKey'
-- derived from given 'uuid' and 'cred'
-- using 'Crypto.fastPBKDF2_SHA256'.
-credentialSecretKey :: SubGroup q => UUID -> Credential -> SecretKey q
+credentialSecretKey :: Reifies c FFC => UUID -> Credential -> (SecretKey c)
credentialSecretKey (UUID uuid) (Credential cred) =
fromNatural $ BS.foldl'
(\acc b -> acc`shiftL`3 + fromIntegral b)
@@ -132,6 +163,6 @@ credentialSecretKey (UUID uuid) (Credential cred) =
type PublicKey = G
-- | @('publicKey' secKey)@ returns the 'PublicKey'
--- derived from given 'SecretKey'.
-publicKey :: SubGroup q => SecretKey q -> PublicKey q
+-- derived from given 'SecretKey' @secKey@.
+publicKey :: Reifies c FFC => SecretKey c -> PublicKey c
publicKey = (groupGen ^)