judgmentphile-cli/src/Judgmentphile/CLI/Trustee.hs

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