maxArbitraryQuestions :: Natural
maxArbitraryQuestions = 2
-quickcheck :: TestTree
-quickcheck =
+quickcheck :: Reifies v Version => Proxy v -> TestTree
+quickcheck v =
testGroup "Election"
- [ testGroup "verifyBallot" $
- [ testElection weakFFC
- , testElection beleniosFFC
+ [ testGroup "verifyBallot" $
+ [ reify weakFFC $ quickcheckElection v
+ , reify beleniosFFC $ quickcheckElection v
]
]
-testElection :: FFC -> TestTree
-testElection ffc =
- reify ffc $ \(Proxy::Proxy c) ->
- testGroup (Text.unpack $ ffc_name ffc)
- [ testProperty "verifyBallot" $ \(seed, (elec::Election c) :> votes) ->
+quickcheckElection ::
+ Reifies v Version =>
+ CryptoParams crypto c =>
+ Key crypto => JSON.ToJSON crypto => Show crypto =>
+ Proxy v -> Proxy c -> TestTree
+quickcheckElection (_v::Proxy v) (c::Proxy c) =
+ testGroup (Text.unpack $ cryptoName (reflect c))
+ [ testProperty "verifyBallot" $ \(seed, (elec::Election crypto v c) :> votes) ->
isRight $ runExcept $
(`evalStateT` mkStdGen seed) $ do
-- ballotSecKey :: SecretKey c <- randomSecretKey
lift $ throwE $ ErrorBallot_Wrong
]
+{-
instance Reifies c FFC => Arbitrary (F c) where
arbitrary = F <$> choose (zero, fromJust $ fieldCharac @c `minusNaturalMaybe` one)
-instance Reifies c FFC => Arbitrary (G c) where
+-}
+instance CryptoParams crypto c => Arbitrary (G crypto c) where
arbitrary = do
m <- arbitrary
return (groupGen ^ m)
-instance Reifies c FFC => Arbitrary (E c) where
- arbitrary = E <$> choose (zero, fromJust $ groupOrder @c `minusNaturalMaybe` one)
+instance CryptoParams crypto c => Arbitrary (E crypto c) where
+ arbitrary = E <$> choose (zero, fromJust $ groupOrder @crypto (Proxy @c) `minusNaturalMaybe` one)
instance Arbitrary UUID where
arbitrary = do
seed <- arbitrary
(`evalStateT` mkStdGen seed) $
randomUUID
-instance Reifies c FFC => Arbitrary (Proof c) where
+instance
+ ( Reifies v Version
+ , CryptoParams crypto c
+ , Arbitrary (E crypto c)
+ ) => Arbitrary (Proof crypto v c) where
arbitrary = do
proof_challenge <- arbitrary
proof_response <- arbitrary
return Proof{..}
-instance Arbitrary Question where
+instance Reifies v Version => Arbitrary (Question v) where
arbitrary = do
let question_text = "question"
choices :: Natural <- choose (1, maxArbitraryChoices)
, question_mini <- shrinkIntegral $ min nChoices $ max zero $ question_mini quest
, question_maxi <- shrinkIntegral $ min nChoices $ max question_mini $ question_maxi quest
]
-instance Reifies c FFC => Arbitrary (Election c) where
+instance
+ ( Reifies v Version
+ , CryptoParams crypto c
+ , Key crypto
+ , JSON.ToJSON crypto
+ ) => Arbitrary (Election crypto v c) where
arbitrary = do
let election_name = "election"
let election_description = "description"
- election_crypto <- arbitrary
+ let election_crypto = reflect (Proxy @c)
+ election_secret_key <- arbitrary
+ let election_public_key = publicKey election_secret_key
election_questions <- resize (fromIntegral maxArbitraryQuestions) $ listOf1 arbitrary
election_uuid <- arbitrary
- let election_hash = hashJSON JSON.Null
- return Election{..}
+ let elec = Election
+ { election_hash = hashElection elec
+ , election_version = Just (reflect (Proxy @v))
+ , ..
+ }
+ return elec
shrink elec =
[ elec{election_questions}
| election_questions <- shrink $ election_questions elec
]
+{-
instance Reifies c FFC => Arbitrary (ElectionCrypto c) where
arbitrary = do
let electionCrypto_FFC_params = reflect (Proxy::Proxy c)
electionCrypto_FFC_PublicKey <- arbitrary
return ElectionCrypto_FFC{..}
+-}
-- | A type to declare an 'Arbitrary' instance where @b@ depends on @a@.
data (:>) a b = a :> b
deriving (Eq,Show)
-instance Arbitrary (Question :> [Bool]) where
+instance Reifies v Version => Arbitrary (Question v :> [Bool]) where
arbitrary = do
quest@Question{..} <- arbitrary
votes <- do
[ q :> shrinkVotes q votes
| q <- shrink quest
]
-instance Reifies c FFC => Arbitrary (Election c :> [[Bool]]) where
+instance
+ ( Reifies v Version
+ , CryptoParams crypto c
+ , Key crypto
+ , JSON.ToJSON crypto
+ ) => Arbitrary (Election crypto v c :> [[Bool]]) where
arbitrary = do
elec@Election{..} <- arbitrary
votes <- forM election_questions $ \Question{..} -> do
return $ boolsOfCombin numChoices numTrue rank
return (elec :> votes)
shrink (elec :> votes) =
- [ e :> List.zipWith shrinkVotes (election_questions e) votes
+ [ e :> List.zipWith shrinkVotes (election_questions e :: [Question v]) votes
| e <- shrink elec
]
-- | @('shrinkVotes' quest votes)@
-- returns a reduced version of the given @votes@
-- to fit the requirement of the given @quest@.
-shrinkVotes :: Question -> [Bool] -> [Bool]
+shrinkVotes :: Reifies v Version => Question v -> [Bool] -> [Bool]
shrinkVotes Question{..} votes =
(\(nTrue, b) -> nTrue <= nat question_maxi && b)
<$> List.zip (countTrue votes) votes
where
inc [] = [zero]
inc (n:ns) = (n+one):n:ns
-