hjugement-protocol/test/HUnit/Credential.hs

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