]> Git — Sourcephile - majurity.git/blob - hjugement-cli/src/Hjugement/CLI/Trustee.hs
protocol: no padding for Base64SHA256.
[majurity.git] / hjugement-cli / src / Hjugement / CLI / Trustee.hs
1 {-# LANGUAGE NoMonomorphismRestriction #-}
2 {-# LANGUAGE OverloadedStrings #-}
3 {-# LANGUAGE StrictData #-}
4 {-# LANGUAGE TypeApplications #-}
5 {-# OPTIONS_GHC -Wno-missing-signatures #-}
6 module Hjugement.CLI.Trustee where
7
8 import Control.Applicative (Applicative(..))
9 import Control.Monad (Monad(..))
10 import Control.Monad.Trans.Maybe (MaybeT(..))
11 import Control.Monad.Trans.State.Strict (runState)
12 import Data.Bool
13 import Data.Eq (Eq(..))
14 import Data.Foldable (null)
15 import Data.Function (($), (.), id, flip)
16 import Data.Functor ((<$>))
17 import Data.Maybe (Maybe(..))
18 import Data.Ord (Ord(..))
19 import Data.Proxy (Proxy(..))
20 import Data.Semigroup (Semigroup(..))
21 import GHC.Prim (coerce)
22 import Pipes ((>->))
23 import Symantic.CLI as CLI
24 import Text.Show (Show(..))
25 import System.IO (FilePath)
26 import qualified Data.List as List
27 import qualified Data.Text as T
28 import qualified Pipes as Pip
29 import qualified Pipes.Prelude as Pip
30 import qualified Symantic.Document as Doc
31 import qualified System.FilePath as FP
32 import qualified System.Random as Rand
33 import qualified Voting.Protocol as VP
34
35 import Hjugement.CLI.Utils
36
37 -- * trustee
38 data Trustee_Params = Trustee_Params
39 { trustee_crypto :: VP.FFC
40 } deriving (Show)
41
42 api_trustee =
43 "Commands for a trustee."
44 `helps`
45 command "trustee" $
46 rule "TrusteeParams"
47 (Trustee_Params
48 <$> api_param_crypto
49 ) <?> (
50 api_trustee_generate <!>
51 api_trustee_decrypt
52 )
53 <!> api_help False
54
55 run_trustee globParams =
56 (\params ->
57 run_trustee_generate globParams params :!:
58 run_trustee_decrypt globParams params
59 ) :!:
60 run_help api_trustee
61
62 -- ** generate
63 api_trustee_generate =
64 "Run by a trustee to generate a share of an election key.\
65 \ Such a share consists of a private key and a public key with a certificate.\
66 \ Generated files are stored in the current directory with\
67 \ a name that starts with "<>fileRef "ID"<>",\
68 \ where "<>fileRef "ID"<>" is a short fingerprint of the public key.\
69 \ The private key is stored in "<>fileRef "ID.privkey"<>" and must be\
70 \ secured by the trustee. The public key is stored in "<>fileRef "ID.pubkey"<>" and must\
71 \ be sent to the election administrator."
72 `helps`
73 command "generate" $
74 response @()
75 run_trustee_generate
76 glob@Global_Params{..}
77 Trustee_Params{..} =
78 VP.reify trustee_crypto $ \(_crypto::Proxy c) -> do
79 (secKey, pubKey) <- Pip.liftIO $ Rand.getStdRandom $ runState $ do
80 secKey <- VP.randomSecretKey @c
81 pubKey <- VP.proveIndispensableTrusteePublicKey secKey
82 return (secKey, pubKey)
83 let pubIdent =
84 T.unpack $ T.toUpper $ T.take 8 $
85 VP.hexSHA256 $ VP.bytesNat $
86 VP.trustee_PublicKey pubKey
87 runPipe $ do
88 Pip.each [pubIdent] >-> pipeInfo glob (\ident ->
89 Doc.from $
90 "generated trustee keypair "<>ident<>
91 " in "<>(global_dir FP.</> ident)<>".{privkey,pubkey}"
92 ) >-> Pip.drain
93 Pip.each [secKey] >-> writeJSON glob 0o400 (global_dir FP.</> pubIdent FP.<.>"privkey")
94 Pip.each [pubKey] >-> writeJSON glob 0o444 (global_dir FP.</> pubIdent FP.<.>"pubkey")
95 return ()
96
97 -- ** decrypt
98 data TrusteeDecrypt_Params = TrusteeDecrypt_Params
99 { trusteeDecrypt_privkey :: FilePath
100 , trusteeDecrypt_url :: FilePath
101 } deriving (Show)
102
103 api_trustee_decrypt =
104 "This command is run by each trustee to perform a partial decryption."
105 `helps`
106 command "decrypt" $
107 rule "TrusteeDecryptParams"
108 (TrusteeDecrypt_Params
109 <$> api_param_privkey
110 <*> api_param_url)
111 <?> response @(Maybe (VP.DecryptionShare ()))
112 where
113 api_param_privkey =
114 "Read private key from file "<>ref"FILE"<>"."
115 `helps`
116 requiredTag "privkey" (var "FILE")
117
118 run_trustee_decrypt
119 glob@Global_Params{..}
120 Trustee_Params{..}
121 TrusteeDecrypt_Params{..} =
122 VP.reify trustee_crypto $ \(_crypto::Proxy c) -> runMaybeT $ do
123 (secKey::VP.E c) <- loadJSON glob trusteeDecrypt_privkey
124 let pubKey = VP.publicKey secKey
125 let trusteeKeysPath = trusteeDecrypt_url FP.</> "public_keys.jsons"
126 outputInfo glob "check that the public key is amongst the public keys of the election"
127 keys <- runPipeWithError glob $
128 Pip.toListM' $
129 readJSON glob trusteeKeysPath
130 >-> Pip.filter ((pubKey ==) . VP.trustee_PublicKey)
131 case () of
132 () | null keys -> outputError glob $
133 "the public key associated with the given secret key "<>
134 "is not within the list of public trustee keys of the election.\n"<>
135 Doc.ul
136 [ "List of trustees' public keys: "<>Doc.from trusteeKeysPath
137 , "Trustee's public key: "<>Doc.from (show (VP.nat pubKey))
138 ]<>"\n"
139 () | List.length keys > 1 -> outputError glob $
140 "the public key associated with the given secret key "<>
141 "appears more than one time in the list of public trustee keys of the election.\n"<>
142 Doc.ul
143 [ "List of trustees' public keys: "<>Doc.from trusteeKeysPath
144 , "Trustee's public key: "<>Doc.from (show (VP.nat pubKey))
145 ]<>"\n"
146 () -> do
147 outputInfo glob "tally the encrypted ballots"
148 -- FIXME: actually support fetching through an URL
149 let ballotsPath = trusteeDecrypt_url FP.</> "ballots.jsons"
150 (encTally, _numBallots) <- runPipeWithError glob $
151 Pip.fold'
152 (flip VP.insertEncryptedTally)
153 VP.emptyEncryptedTally id $
154 readJSON glob ballotsPath
155 decShare <- Pip.liftIO $
156 Rand.getStdRandom $ runState $
157 VP.proveDecryptionShare encTally secKey
158 return (coerce decShare :: VP.DecryptionShare ())