hjugement-protocol/tests/HUnit/Credential.hs

   1 {-# LANGUAGE OverloadedStrings #-}
   2 module HUnit.Credential where
   3
   4 import Control.Applicative (Applicative(..))
   5 import Test.Tasty.HUnit
   6 import qualified Control.Monad.Trans.State.Strict as S
   7 import qualified System.Random as Random
   8
   9 import Voting.Protocol
  10 import Utils
  11
  12 hunit :: TestTree
  13 hunit = testGroup "Credential"
  14  [ testGroup "randomCredential"
  15          [ testCase "0" $
  16                 S.evalState randomCredential (Random.mkStdGen 0) @?=
  17                         Credential "xLcs7ev6Jy6FHHE"
  18          ]
  19  , testGroup "randomUUID"
  20          [ testCase "0" $
  21                 S.evalState randomUUID (Random.mkStdGen 0) @?=
  22                         UUID "xLcs7ev6Jy6FHH"
  23          ]
  24  , testGroup "readCredential" $
  25                 let (==>) inp exp =
  26                         testCase (show inp) $ readCredential inp @?= exp in
  27          [ "" ==> Left ErrorToken_Length
  28          , "xLcs7ev6Jy6FH_E"  ==> Left (ErrorToken_BadChar '_')
  29          , "xLcs7ev6Jy6FHIE"  ==> Left (ErrorToken_BadChar 'I')
  30          , "xLcs7ev6Jy6FH0E"  ==> Left (ErrorToken_BadChar '0')
  31          , "xLcs7ev6Jy6FHOE"  ==> Left (ErrorToken_BadChar 'O')
  32          , "xLcs7ev6Jy6FHlE"  ==> Left (ErrorToken_BadChar 'l')
  33          , "xLcs7ev6Jy6FH6"   ==> Left ErrorToken_Length
  34          , "xLcs7ev6Jy6FHHy1" ==> Left ErrorToken_Length
  35          , "xLcs7ev6Jy6FHHF"  ==> Left ErrorToken_Checksum
  36          , "xLcs7ev6Jy6FHHE"  ==> Right (Credential "xLcs7ev6Jy6FHHE")
  37          ]
  38  , testGroup "credentialSecretKey" $
  39          [ testSecretKey weakFFC 0 122
  40          , testSecretKey weakFFC 1 35
  41          , testSecretKey beleniosFFC 0 2317630607062989137269685509390
  42          , testSecretKey beleniosFFC 1 1968146140481358915910346867611
  43          ]
  44  ]
  45
  46 testSecretKey :: FFC -> Int -> Natural -> TestTree
  47 testSecretKey ffc seed exp =
  48         reify ffc $ \(Proxy::Proxy c) ->
  49         let (uuid@(UUID u), cred@(Credential c)) =
  50                 (`S.evalState` Random.mkStdGen seed) $
  51                         (,) <$> randomUUID <*> randomCredential in
  52         testCase (show (u,c)) $
  53                 credentialSecretKey @c uuid cred @?= E exp