{-# LANGUAGE OverloadedStrings #-}
module Election where

import qualified Data.List as List
import qualified Data.Text as Text

import Voting.Protocol
import Utils

makeElection :: SubGroup q => Int -> Int -> Election q
makeElection nQuests nChoices = Election
 { election_name = Text.pack $ "elec"<>show nQuests<>show nChoices
 , election_description = "benchmarkable election"
 , election_uuid
 , election_publicKey =
	let secKey = credentialSecretKey election_uuid (Credential "xLcs7ev6Jy6FHHE") in
	publicKey secKey
 , election_hash = Hash "" -- FIXME: when implemented
 , election_questions =
	(<$> [1..nQuests]) $ \quest -> Question
	 { question_text = Text.pack $ "quest"<>show quest
	 , question_choices = (<$> [1..nChoices]) $ \choice -> Text.pack $ "choice"<>show choice
	 , question_mini = zero
	 , question_maxi = sum $ List.replicate nChoices one
	 }
 } where election_uuid = UUID "xLcs7ev6Jy6FHH"

makeVotes :: Election q -> [[Bool]]
makeVotes Election{..} =
	[ [ True | _choice <- question_choices quest ]
	| quest <- election_questions
	]

makeBallot :: forall q. SubGroup q => Election q -> Ballot q
makeBallot elec =
	case runExcept $ (`evalStateT` mkStdGen seed) $ do
		ballotSecKey :: SecretKey q <- randomSecretKey
		encryptBallot elec (Just ballotSecKey) $
			makeVotes elec of
	 Right ballot -> ballot
	 Left err -> error ("encryptBallot: "<>show err)
	where
	seed = 0

benchEncryptBallot :: forall q. Params q => Int -> Int -> Benchmark
benchEncryptBallot nQuests nChoices =
	env setupEnv $ \ ~elec ->
		bench ("(nQuests="<>show nQuests<>")*(nChoices="<>show nChoices<>")=="<>show (nQuests * nChoices)) $
			nf makeBallot elec
	where
	setupEnv = do
		let elec :: Election q = makeElection nQuests nChoices
		return elec

benchVerifyBallot :: forall q. Params q => Int -> Int -> Benchmark
benchVerifyBallot nQuests nChoices =
	env setupEnv $ \ ~(elec,ballot) ->
		bench ("(nQuests="<>show nQuests<>")*(nChoices="<>show nChoices<>")=="<>show (nQuests * nChoices)) $
			nf (verifyBallot elec) ballot
	where
	setupEnv = do
		let elec :: Election q = makeElection nQuests nChoices
		let ballot = makeBallot elec
		return (elec,ballot)

benchmarks :: [Benchmark]
benchmarks =
 -- let inputs = [(1,2), (5,5), (10,5), (5,10){-, (10,6), (10,7), (15,5)-}] in
 let inputs =
	 [ (nQ,nC)
	 | nQ <- [1,5,10,15{-,20,25-}]
	 , nC <- [5..7]
	 ] in
 [ bgroup "WeakParams"
	 [ bgroup "encryptBallot"
		 [ benchEncryptBallot @WeakParams nQuests nChoices
		 | (nQuests,nChoices) <- inputs
		 ]
	 , bgroup "verifyBallot"
		 [ benchVerifyBallot @BeleniosParams nQuests nChoices
		 | (nQuests,nChoices) <- inputs
		 ]
	 ]
 , bgroup "BeleniosParams"
	 [ bgroup "encryptBallot"
		 [ benchEncryptBallot @BeleniosParams nQuests nChoices
		 | (nQuests,nChoices) <- inputs
		 ]
	 , bgroup "verifyBallot"
		 [ benchVerifyBallot @BeleniosParams nQuests nChoices
		 | (nQuests,nChoices) <- inputs
		 ]
	 ]
 ]