hjugement-protocol/tests/HUnit/Credential.hs

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