packages feed

hjugement-cli 0.0.0.20190815 → 0.0.0.20191028

raw patch · 6 files changed

+77/−42 lines, 6 filesdep ~hjugement-protocoldep ~symantic-document

Dependency ranges changed: hjugement-protocol, symantic-document

Files

hjugement-cli.cabal view
@@ -2,7 +2,7 @@ -- PVP:  +-+------- breaking API changes --       | | +----- non-breaking API additions --       | | | +--- code changes with no API change-version: 0.0.0.20190815+version: 0.0.0.20191028 category: Politic synopsis: Majority Judgment and Helios-C command line tool description:@@ -74,7 +74,7 @@     -- -fhide-source-paths   build-depends:       hjugement >= 2.0.2-    , hjugement-protocol >= 0.0.7+    , hjugement-protocol >= 0.0.8     , aeson >= 1.3     , base >= 4.6 && < 5     , base64-bytestring >= 1.0@@ -98,7 +98,7 @@     , random >= 1.1     , reflection >= 2.1     , symantic-cli >= 2.4.2-    , symantic-document >= 1.5+    , symantic-document >= 1.5.1     , terminal-size >= 0.3     , text >= 1.2     , time >= 1.8
src/Hjugement/CLI/Administrator.hs view
@@ -59,6 +59,7 @@  ,   administratorElection_uuid         :: Maybe Text  ,   administratorElection_grades       :: [Text]  ,   administratorElection_defaultGrade :: Maybe Text+ ,   administratorElection_version      :: VP.Version  } deriving (Show)  api_administrator_election =@@ -75,7 +76,8 @@ 			 <*> api_param_description 			 <*> api_option_uuid 			 <*> api_param_grades-			 <*> api_param_defaultGrade)+			 <*> api_param_defaultGrade+			 <*> api_param_version) 		<?> api_quests 		<.> response @(Maybe ()) 	where@@ -112,7 +114,8 @@  glob@Global_Params{..}  AdministratorElection_Params{..}  quests =-	VP.reify administratorElection_crypto $ \(_crypto::Proxy c) -> runMaybeT $ do+	VP.reify administratorElection_version $ \(_v::Proxy v) ->+	VP.reify administratorElection_crypto $ \(_c::Proxy c) -> runMaybeT $ do 		election_uuid <- 			case administratorElection_uuid of 			 Nothing -> Pip.liftIO $ Rand.getStdRandom $ runState $ VP.randomUUID@@ -121,7 +124,7 @@ 				 Left err -> outputError glob $ Doc.from (show err) 				 Right uuid -> return uuid 		let trusteeKeysPath = global_dir FP.</> "public_keys.jsons"-		trusteeKeys :: [VP.TrusteePublicKey c] <- runPipeWithError glob $+		trusteeKeys :: [VP.TrusteePublicKey VP.FFC v c] <- runPipeWithError glob $ 			Pip.toListM' $ readJSON glob trusteeKeysPath 		forM_ trusteeKeys $ \trusteeKey -> 			case runExcept $ VP.verifyIndispensableTrusteePublicKey trusteeKey of@@ -138,22 +141,21 @@ 			fromMaybe (grades List.!!0) 			 administratorElection_defaultGrade 		 -- FIXME: put defaultGrade into election.json-		let elec =+		let elec :: VP.Election VP.FFC v c = 			VP.Election 			 { VP.election_name        = administratorElection_name 			 , VP.election_description = administratorElection_description-			 , VP.election_crypto      = VP.ElectionCrypto_FFC-				 { electionCrypto_FFC_params    = administratorElection_crypto-				 , electionCrypto_FFC_PublicKey = VP.combineIndispensableTrusteePublicKeys trusteeKeys-				 }-			 , VP.election_questions = (<$> quests) $ \quest -> VP.Question+			 , VP.election_crypto      = administratorElection_crypto+			 , VP.election_public_key  = VP.combineIndispensableTrusteePublicKeys trusteeKeys+			 , VP.election_questions   = (<$> quests) $ \quest -> VP.Question 				 { question_text    = quest 				 , question_choices = grades 				 , question_mini    = 1 				 , question_maxi    = 1 				 } 			 , VP.election_uuid-			 , VP.election_hash = VP.Base64SHA256 ""+			 , VP.election_version = Just administratorElection_version+			 , VP.election_hash    = VP.hashElection elec 			 } 		saveJSON glob (global_dir FP.</> "election.json") elec 		outputInfo glob $@@ -173,8 +175,8 @@  run_administrator_tally  glob@Global_Params{..} = runMaybeT $ do-	rawElec <- loadElection glob $ global_dir FP.</> "election.json"-	VP.reifyElection rawElec $ \(_elec :: VP.Election c) -> do+	loadElection glob (global_dir FP.</> "election.json") $+	 \(_elec :: VP.Election VP.FFC v c) -> do 		keys <- runPipeWithError glob $ Pip.toListM' $ 			readJSON glob $ global_dir FP.</> "public_keys.jsons" 		decs <- runPipeWithError glob $ Pip.toListM' $@@ -187,7 +189,7 @@ 				readJSON glob $ global_dir FP.</> "ballots.jsons" 		outputInfo glob $ "decrypting tally using trustees' decryption shares" 		case runExcept $ VP.proveTally-			 (encTally :: VP.EncryptedTally c, numBallots) decs+			 (encTally :: VP.EncryptedTally VP.FFC v c, numBallots) decs 			 (VP.combineIndispensableDecryptionShares (VP.trustee_PublicKey <$> keys)) of 		 Left err -> outputError glob $ Doc.from (show err) 		 Right tally -> do
src/Hjugement/CLI/Registrar.hs view
@@ -44,8 +44,9 @@  -- ** Type 'Registrar_Params' data Registrar_Params = Registrar_Params- {   registrar_election_crypto :: VP.FFC- ,   registrar_election_uuid   :: VP.UUID+ {   registrar_election_crypto  :: VP.FFC+ ,   registrar_election_version :: VP.Version+ ,   registrar_election_uuid    :: VP.UUID  } deriving (Show)  api_registrar =@@ -55,6 +56,7 @@ 		rule "PARAMS" 		 (Registrar_Params 			 <$> api_param_crypto+			 <*> api_param_version 			 <*> api_param_uuid) 		<?> ( 			api_registrar_credentials <!>@@ -80,7 +82,7 @@ 	return $ 		VP.reify registrar_election_crypto $ \(_::Proxy c) -> 			VP.nat $ VP.publicKey $-				VP.credentialSecretKey @c registrar_election_uuid cred+				VP.credentialSecretKey @VP.FFC @c registrar_election_uuid cred  api_registrar_credentials = 	"Generate voters' credentials, either "<>ref "COUNT"<>" sequential identities\@@ -148,7 +150,7 @@ 						 >-> writeFileLn glob 0o400 (baseFile FP.<.>"privcreds") 					 ) 					 >-> Pip.mapM (\(ident, cred) ->-						let secKey = VP.credentialSecretKey @c registrar_election_uuid cred in+						let secKey = VP.credentialSecretKey @VP.FFC @c registrar_election_uuid cred in 						let pubKey = VP.publicKey secKey in 						return (ident, pubKey)) 					 >-> Pip.tee (
src/Hjugement/CLI/Trustee.hs view
@@ -36,7 +36,8 @@  -- * trustee data Trustee_Params = Trustee_Params- { trustee_crypto :: VP.FFC+ { trustee_crypto  :: VP.FFC+ , trustee_version :: VP.Version  } deriving (Show)  api_trustee =@@ -46,6 +47,7 @@ 		rule "TrusteeParams" 		 (Trustee_Params 			 <$> api_param_crypto+			 <*> api_param_version 		 ) <?> ( 			api_trustee_generate <!> 			api_trustee_decrypt@@ -75,10 +77,12 @@ run_trustee_generate  glob@Global_Params{..}  Trustee_Params{..} =-	VP.reify trustee_crypto $ \(_crypto::Proxy c) -> do+	VP.reify trustee_version $ \(_v::Proxy v) -> do+	VP.reify trustee_crypto $ \(_c::Proxy c) -> do 		(secKey, pubKey) <- Pip.liftIO $ Rand.getStdRandom $ runState $ do-			secKey <- VP.randomSecretKey @c-			pubKey <- VP.proveIndispensableTrusteePublicKey secKey+			secKey <- VP.randomSecretKey @VP.FFC @c+			pubKey :: VP.TrusteePublicKey VP.FFC v c+			 <- VP.proveIndispensableTrusteePublicKey secKey 			return (secKey, pubKey) 		let pubIdent = 			T.unpack $ T.toUpper $ T.take 8 $@@ -108,7 +112,7 @@ 		 (TrusteeDecrypt_Params 			 <$> api_param_privkey 			 <*> api_param_url)-		<?> response @(Maybe (VP.DecryptionShare ()))+		<?> response @(Maybe (VP.DecryptionShare VP.FFC () ())) 	where 	api_param_privkey = 		"Read private key from file "<>ref"FILE"<>"."@@ -119,8 +123,9 @@  glob@Global_Params{..}  Trustee_Params{..}  TrusteeDecrypt_Params{..} =+	VP.reify trustee_version $ \(_v::Proxy v) -> do 	VP.reify trustee_crypto $ \(_crypto::Proxy c) -> runMaybeT $ do-		(secKey::VP.E c) <- loadJSON glob trusteeDecrypt_privkey+		(secKey::VP.E VP.FFC c) <- loadJSON glob trusteeDecrypt_privkey 		let pubKey = VP.publicKey secKey 		let trusteeKeysPath = trusteeDecrypt_url FP.</> "public_keys.jsons" 		outputInfo glob "check that the public key is amongst the public keys of the election"@@ -152,7 +157,8 @@ 				 (flip VP.insertEncryptedTally) 				 VP.emptyEncryptedTally id $ 					readJSON glob ballotsPath-			decShare <- Pip.liftIO $+			decShare :: VP.DecryptionShare VP.FFC v c+			 <- Pip.liftIO $ 				Rand.getStdRandom $ runState $ 					VP.proveDecryptionShare encTally secKey-			return (coerce decShare :: VP.DecryptionShare ())+			return (coerce decShare :: VP.DecryptionShare VP.FFC () ())
src/Hjugement/CLI/Utils.hs view
@@ -62,10 +62,26 @@ 	"Take cryptographic parameters from file "<>fileRef "FILE"<>"." 	`help` 	requiredTag "crypto" (var "FILE")+api_param_version =+	"Set the protocol version to use.\n"<>+	"Defaults to the \"stable\" version.\n"<>+	Doc.ul+	 [ "stable       == "<>Doc.from (show VP.stableVersion)+	 , "experimental == "<>Doc.from (show VP.experimentalVersion)+	 ]+	`help`+	defaultTag "version" VP.stableVersion (+		constant "stable" VP.stableVersion `alt`+		constant "experimental" VP.experimentalVersion `alt`+		var "VERSION"+	 )+instance CLI.IOType VP.Version+instance CLI.FromSegment VP.Version where+	fromSegment = return . maybe (Left "invalid version string") Right . VP.readVersion instance CLI.IOType VP.FFC instance CLI.FromSegment VP.FFC where 	fromSegment = JSON.eitherDecodeFileStrict'-instance VP.Reifies c VP.FFC => CLI.FromSegment (VP.E c) where+instance VP.Reifies c VP.FFC => CLI.FromSegment (VP.E VP.FFC c) where 	fromSegment = JSON.eitherDecodeFileStrict' api_param_uuid = 	"UUID of the election."@@ -77,8 +93,8 @@ instance CLI.IOType VP.Credential instance CLI.FromSegment VP.Credential where 	fromSegment = return . left show . VP.readCredential . Text.pack-instance IOType (VP.DecryptionShare ())-instance Outputable (VP.DecryptionShare ()) where+instance IOType (VP.DecryptionShare VP.FFC () ())+instance Outputable (VP.DecryptionShare VP.FFC () ()) where 	output decShare = output $ JSON.encode decShare<>"\n"  api_help full =@@ -280,19 +296,28 @@ 		Doc.from err<>"\n" 	 Right a -> return a +-- | TODO: abstract over @crypto@ in the continuation. loadElection ::+ VP.ReifyCrypto crypto =>+ JSON.FromJSON crypto =>  Pip.MonadIO m =>  Global_Params ->- IO.FilePath -> MaybeT m (VP.Election ())-loadElection glob filePath =+ IO.FilePath ->+ (forall v c.+  VP.Reifies v VP.Version =>+  VP.Reifies c crypto =>+  VP.FieldElementConstraints crypto c =>+  VP.Election crypto v c -> MaybeT m r) ->+ MaybeT m r+loadElection glob filePath k = 	Pip.liftIO ( do 		outputDebug glob $ "loading " <> Doc.from filePath-		runExceptT $ VP.readElection filePath+		runExceptT $ VP.readElection filePath k 	 ) >>= \case 	 Left err -> outputError glob $ 		Doc.from filePath<>": "<> 		Doc.from err<>"\n"-	 Right a -> return a+	 Right r -> r  {- readJSON' ::
src/Hjugement/CLI/Voter.hs view
@@ -90,8 +90,8 @@ run_voter_vote  glob@Global_Params{..}  VoterVote_Params{..} = runMaybeT $ do-	rawElec <- loadElection glob $ voterVote_url FP.</> "election.json"-	VP.reifyElection rawElec $ \(elec@VP.Election{..} :: VP.Election c) -> do+	loadElection glob (voterVote_url FP.</> "election.json") $+	 \(elec@VP.Election{..} :: VP.Election VP.FFC v c) -> do 		outputInfo glob $ "Voted"<>Doc.from (show voterVote_grades) 		votes <- VP.isoZipWithM 		 (outputError glob $ "Mismatching number of cast grades ("<>@@ -110,7 +110,7 @@ 		 election_questions 		 voterVote_grades 		outputInfo glob $ Doc.from (show votes)-		let (secKey :: VP.SecretKey c) =+		let (secKey :: VP.SecretKey VP.FFC c) = 			VP.credentialSecretKey election_uuid voterVote_privcred 		ballot <- join $ Pip.liftIO $ 			Rand.getStdRandom $ \gen ->@@ -137,10 +137,10 @@ run_voter_verify  glob@Global_Params{..}  VoterVerify_Params{..} = runMaybeT $ do-	rawElec <- loadElection glob $ voterVerify_url FP.</> "election.json"-	VP.reifyElection rawElec $ \(elec@VP.Election{..} :: VP.Election c) -> do+	loadElection glob (voterVerify_url FP.</> "election.json") $+	 \(elec@VP.Election{..} :: VP.Election VP.FFC v c) -> do 		outputInfo glob $ "verifying ballots"-		(fails :: Natural, (encTally :: VP.EncryptedTally c, _numBallots)) <- runPipeWithError glob $+		(fails :: Natural, (encTally :: VP.EncryptedTally VP.FFC v c, _numBallots)) <- runPipeWithError glob $ 			Pip.foldM' 			 (\(fails, acc@(_, numBallots)) ballot@VP.Ballot{..} -> do 				let ballotNum = numBallots + fails@@ -175,7 +175,7 @@ 		 then do 			outputWarning glob "no tally to check" 		 else do-			tally :: VP.Tally c <- loadJSON glob resultPath+			tally :: VP.Tally VP.FFC v c <- loadJSON glob resultPath 			outputInfo glob $ "decrypting tally using trustees' decryption shares" 			trustees <- runPipeWithError glob $ Pip.toListM' $ 				readJSON glob $ voterVerify_url FP.</> "public_keys.jsons"