]> Git — Sourcephile - majurity.git/blob - hjugement-protocol/tests/HUnit/Credential.hs
protocol: add benchmarks
[majurity.git] / 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