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  , trustee_version :: VP.Version
  41  } deriving (Show)
  42
  43 api_trustee =
  44         "Commands for a trustee."
  45         `helps`
  46         command "trustee" $
  47                 rule "TrusteeParams"
  48                  (Trustee_Params
  49                          <$> api_param_crypto
  50                          <*> api_param_version
  51                  ) <?> (
  52                         api_trustee_generate <!>
  53                         api_trustee_decrypt
  54                  )
  55                 <!> api_help False
  56
  57 run_trustee globParams =
  58         (\params ->
  59                 run_trustee_generate globParams params :!:
  60                 run_trustee_decrypt  globParams params
  61          ) :!:
  62         run_help api_trustee
  63
  64 -- ** generate
  65 api_trustee_generate =
  66  "Run by a trustee to generate a share of an election key.\
  67  \ Such a share consists of a private key and a public key with a certificate.\
  68  \ Generated files are stored in the current directory with\
  69  \ a name that starts with "<>fileRef "ID"<>",\
  70  \ where "<>fileRef "ID"<>" is a short fingerprint of the public key.\
  71  \ The private key is stored in "<>fileRef "ID.privkey"<>" and must be\
  72  \ secured by the trustee. The public key is stored in "<>fileRef "ID.pubkey"<>" and must\
  73  \ be sent to the election administrator."
  74         `helps`
  75         command "generate" $
  76                 response @()
  77 run_trustee_generate
  78  glob@Global_Params{..}
  79  Trustee_Params{..} =
  80         VP.reify trustee_version $ \(_v::Proxy v) -> do
  81         VP.reify trustee_crypto $ \(_c::Proxy c) -> do
  82                 (secKey, pubKey) <- Pip.liftIO $ Rand.getStdRandom $ runState $ do
  83                         secKey <- VP.randomSecretKey @VP.FFC @c
  84                         pubKey :: VP.TrusteePublicKey VP.FFC v c
  85                          <- VP.proveIndispensableTrusteePublicKey secKey
  86                         return (secKey, pubKey)
  87                 let pubIdent =
  88                         T.unpack $ T.toUpper $ T.take 8 $
  89                         VP.hexSHA256 $ VP.bytesNat $
  90                         VP.trustee_PublicKey pubKey
  91                 runPipe $ do
  92                         Pip.each [pubIdent] >-> pipeInfo glob (\ident ->
  93                                 Doc.from $
  94                                 "generated trustee keypair "<>ident<>
  95                                 " in "<>(global_dir FP.</> ident)<>".{privkey,pubkey}"
  96                          ) >-> Pip.drain
  97                         Pip.each [secKey] >-> writeJSON glob 0o400 (global_dir FP.</> pubIdent FP.<.>"privkey")
  98                         Pip.each [pubKey] >-> writeJSON glob 0o444 (global_dir FP.</> pubIdent FP.<.>"pubkey")
  99                 return ()
 100
 101 -- ** decrypt
 102 data TrusteeDecrypt_Params = TrusteeDecrypt_Params
 103  {   trusteeDecrypt_privkey :: FilePath
 104  ,   trusteeDecrypt_url     :: FilePath
 105  } deriving (Show)
 106
 107 api_trustee_decrypt =
 108         "This command is run by each trustee to perform a partial decryption."
 109         `helps`
 110         command "decrypt" $
 111                 rule "TrusteeDecryptParams"
 112                  (TrusteeDecrypt_Params
 113                          <$> api_param_privkey
 114                          <*> api_param_url)
 115                 <?> response @(Maybe (VP.DecryptionShare VP.FFC () ()))
 116         where
 117         api_param_privkey =
 118                 "Read private key from file "<>ref"FILE"<>"."
 119                 `helps`
 120                 requiredTag "privkey" (var "FILE")
 121
 122 run_trustee_decrypt
 123  glob@Global_Params{..}
 124  Trustee_Params{..}
 125  TrusteeDecrypt_Params{..} =
 126         VP.reify trustee_version $ \(_v::Proxy v) -> do
 127         VP.reify trustee_crypto $ \(_crypto::Proxy c) -> runMaybeT $ do
 128                 (secKey::VP.E VP.FFC c) <- loadJSON glob trusteeDecrypt_privkey
 129                 let pubKey = VP.publicKey secKey
 130                 let trusteeKeysPath = trusteeDecrypt_url FP.</> "public_keys.jsons"
 131                 outputInfo glob "check that the public key is amongst the public keys of the election"
 132                 keys <- runPipeWithError glob $
 133                         Pip.toListM' $
 134                                 readJSON glob trusteeKeysPath
 135                                  >-> Pip.filter ((pubKey ==) . VP.trustee_PublicKey)
 136                 case () of
 137                  () | null keys -> outputError glob $
 138                         "the public key associated with the given secret key "<>
 139                         "is not within the list of public trustee keys of the election.\n"<>
 140                         Doc.ul
 141                          [ "List of trustees' public keys: "<>Doc.from trusteeKeysPath
 142                          , "Trustee's public key: "<>Doc.from (show (VP.nat pubKey))
 143                          ]<>"\n"
 144                  () | List.length keys > 1 -> outputError glob $
 145                         "the public key associated with the given secret key "<>
 146                         "appears more than one time in the list of public trustee keys of the election.\n"<>
 147                         Doc.ul
 148                          [ "List of trustees' public keys: "<>Doc.from trusteeKeysPath
 149                          , "Trustee's public key: "<>Doc.from (show (VP.nat pubKey))
 150                          ]<>"\n"
 151                  () -> do
 152                         outputInfo glob "tally the encrypted ballots"
 153                         -- FIXME: actually support fetching through an URL
 154                         let ballotsPath = trusteeDecrypt_url FP.</> "ballots.jsons"
 155                         (encTally, _numBallots) <- runPipeWithError glob $
 156                                 Pip.fold'
 157                                  (flip VP.insertEncryptedTally)
 158                                  VP.emptyEncryptedTally id $
 159                                         readJSON glob ballotsPath
 160                         decShare :: VP.DecryptionShare VP.FFC v c
 161                          <- Pip.liftIO $
 162                                 Rand.getStdRandom $ runState $
 163                                         VP.proveDecryptionShare encTally secKey
 164                         return (coerce decShare :: VP.DecryptionShare VP.FFC () ())