hjugement-cli/src/Hjugement/CLI/Trustee.hs

   1 {-# LANGUAGE NoMonomorphismRestriction #-}
   2 {-# LANGUAGE OverloadedStrings #-}
   3 {-# LANGUAGE StrictData #-}
   4 {-# OPTIONS_GHC -Wno-missing-signatures #-}
   5 module Hjugement.CLI.Trustee where
   6
   7 -- :main --dir /tmp/elec trust --crypto demo/groups/default.json gen
   8 -- cat /tmp/elec/*.pubkey >/tmp/elec/public_keys.jsons
   9
  10 import Control.Applicative (Applicative(..))
  11 import Control.Monad (Monad(..), forM, forM_, join, void)
  12 import Control.Monad.Trans.Class (MonadTrans(..))
  13 import Control.Monad.Trans.Maybe (MaybeT(..))
  14 import Control.Monad.Trans.State.Strict (runState, runStateT)
  15 import Data.Bits (setBit)
  16 import Data.Bool
  17 import Data.ByteString (ByteString)
  18 import Data.Either (Either(..))
  19 import Data.Eq (Eq(..))
  20 import Data.Foldable (Foldable, foldMap, length, null)
  21 import Data.Function (($), (.), id, flip)
  22 import Data.Functor ((<$>))
  23 import Data.Int (Int)
  24 import Data.Maybe (Maybe(..), maybe, fromMaybe)
  25 import Data.Monoid (Monoid(..))
  26 import Data.Ord (Ord(..))
  27 import Data.Proxy (Proxy(..))
  28 import Data.Semigroup (Semigroup(..))
  29 import Data.String (String)
  30 import Data.Text (Text)
  31 import GHC.Natural (minusNatural, minusNaturalMaybe)
  32 import GHC.Prim (coerce)
  33 import Numeric.Natural (Natural)
  34 import Pipes ((>->))
  35 import Prelude (logBase, ceiling, Num(..), (/), (^), fromIntegral, Double)
  36 import Symantic.CLI as CLI
  37 import Text.Show (Show(..))
  38 import System.IO (IO, FilePath)
  39 import qualified Crypto.Hash as Crypto
  40 import qualified Data.Aeson as JSON
  41 import qualified Data.ByteArray as ByteArray
  42 import qualified Data.ByteString as BS
  43 import qualified Data.ByteString.Char8 as BS8
  44 import qualified Data.ByteString.Lazy as BSL
  45 import qualified Data.List as List
  46 import qualified Data.Text as T
  47 import qualified Data.Text.Encoding as T
  48 import qualified Data.Text.Lazy as TL
  49 import qualified Data.Text.Lazy.Builder as TLB
  50 import qualified Data.Text.Lazy.Builder.Int as TLB
  51 import qualified Data.Text.Lazy.Encoding as TL
  52 import qualified Data.Text.Lazy.IO as TL
  53 import qualified Data.Time as Time
  54 import qualified Lens.Family as Lens
  55 import qualified Lens.Family.State.Strict as Lens
  56 import qualified Pipes as Pip
  57 import qualified Pipes.ByteString as PipBS
  58 import qualified Pipes.Group as Pip
  59 import qualified Pipes.Prelude as Pip
  60 import qualified Pipes.Aeson as PipJSON (DecodingError(..))
  61 import qualified Pipes.Aeson.Unchecked as PipJSON
  62 import qualified Pipes.Safe as Pip
  63 import qualified Pipes.Safe.Prelude as Pip
  64 import qualified Pipes.Text as PipText
  65 import qualified Pipes.Text.Encoding as PipText
  66 import qualified Pipes.Text.IO as PipText
  67 import qualified Symantic.Document as Doc
  68 import qualified System.FilePath as FP
  69 import qualified System.IO as IO
  70 import qualified System.Posix as Posix
  71 import qualified System.Random as Rand
  72 import qualified Voting.Protocol as VP
  73
  74 import Hjugement.CLI.Utils
  75
  76 -- * trustee
  77 data Trustee_Params = Trustee_Params
  78  { trustee_crypto :: VP.FFC
  79  } deriving (Show)
  80
  81 api_trustee =
  82         "Commands for a trustee."
  83         `helps`
  84         command "trustee" $
  85                 rule "TrusteeParams"
  86                  (Trustee_Params
  87                          <$> api_param_crypto
  88                  ) <?> (
  89                         api_trustee_generate <!>
  90                         api_trustee_decrypt
  91                  )
  92                 <!> api_help False
  93
  94 run_trustee globParams =
  95         (\params ->
  96                 run_trustee_generate globParams params :!:
  97                 run_trustee_decrypt  globParams params
  98          ) :!:
  99         run_help api_trustee
 100
 101 -- ** generate
 102 api_trustee_generate =
 103  "Run by a trustee to generate a share of an election key.\
 104  \ Such a share consists of a private key and a public key with a certificate.\
 105  \ Generated files are stored in the current directory with\
 106  \ a name that starts with "<>fileRef "ID"<>",\
 107  \ where "<>fileRef "ID"<>" is a short fingerprint of the public key.\
 108  \ The private key is stored in "<>fileRef "ID.privkey"<>" and must be\
 109  \ secured by the trustee. The public key is stored in "<>fileRef "ID.pubkey"<>" and must\
 110  \ be sent to the election administrator."
 111         `helps`
 112         command "generate" $
 113                 response @()
 114 run_trustee_generate
 115  Global_Params{..}
 116  o@Trustee_Params{..} =
 117         VP.reify trustee_crypto $ \(crypto::Proxy c) -> do
 118                 keys@(secKey, pubKey) <- Pip.liftIO $ Rand.getStdRandom $ runState $ do
 119                         secKey <- VP.randomSecretKey @c
 120                         pubKey <- VP.proveIndispensableTrusteePublicKey secKey
 121                         return (secKey, pubKey)
 122                 let pubIdent =
 123                         T.unpack $ T.toUpper $ T.take 8 $
 124                         VP.hexHash $ VP.bytesNat $
 125                         VP.trustee_PublicKey pubKey
 126                 runPipe $ do
 127                         Pip.each [pubIdent] >-> pipeInfo (\ident ->
 128                                 "Generated trustee keypair "<>ident<>
 129                                 " in "<>(global_dir FP.</> ident)<>".{privkey,pubkey}"
 130                          ) >-> Pip.drain
 131                         Pip.each [secKey] >-> writeJSON 0o400 (global_dir FP.</> pubIdent FP.<.>"privkey")
 132                         Pip.each [pubKey] >-> writeJSON 0o444 (global_dir FP.</> pubIdent FP.<.>"pubkey")
 133                 return ()
 134
 135 -- ** decrypt
 136 data TrusteeDecrypt_Params = TrusteeDecrypt_Params
 137  {   trusteeDecrypt_privkey :: FilePath
 138  ,   trusteeDecrypt_url     :: FilePath
 139  } deriving (Show)
 140
 141 api_trustee_decrypt =
 142         "This command is run by each trustee to perform a partial decryption."
 143         `helps`
 144         command "decrypt" $
 145                 rule "TrusteeDecryptParams"
 146                  (TrusteeDecrypt_Params
 147                          <$> api_param_privkey
 148                          <*> api_param_url)
 149                 <?> response @(Maybe (VP.DecryptionShare ()))
 150         where
 151         api_param_privkey =
 152                 "Read private key from file "<>ref"FILE"<>"."
 153                 `helps`
 154                 requiredTag "privkey" (var "FILE")
 155         api_param_url =
 156                 "Download election files from "<>ref"URL"<>"."<>
 157                 "\nDefaults to "<>fileRef "."<>"."
 158                 `helps`
 159                 defaultTag "url" "." (var "URL")
 160
 161 run_trustee_decrypt
 162  Global_Params{..}
 163  o@Trustee_Params{..}
 164  TrusteeDecrypt_Params{..} =
 165         VP.reify trustee_crypto $ \(crypto::Proxy c) -> runMaybeT $ do
 166                 (secKey::VP.E c) <- loadJSON trusteeDecrypt_privkey
 167                 let pubKey = VP.publicKey secKey
 168                 let trusteeKeysPath = trusteeDecrypt_url FP.</> "public_keys.jsons"
 169                 -- Check that the public key is amongst the public keys of the election
 170                 keys <- runPipeWithError $
 171                         Pip.toListM' $
 172                                 readJSON trusteeKeysPath
 173                                  >-> Pip.filter ((pubKey ==) . VP.trustee_PublicKey)
 174                 case () of
 175                  () | null keys -> outputError $
 176                         "the public key associated with the given secret key "<>
 177                         "is not within the list of public trustee keys of the election.\n"<>
 178                         Doc.ul
 179                          [ "List of trustees' public keys: "<>Doc.from trusteeKeysPath
 180                          , "Trustee's public key: "<>Doc.from (show (VP.nat pubKey))
 181                          ]<>"\n"
 182                  () | List.length keys > 1 -> outputError $
 183                         "the public key associated with the given secret key "<>
 184                         "appears more than one time in the list of public trustee keys of the election.\n"<>
 185                         Doc.ul
 186                          [ "List of trustees' public keys: "<>Doc.from trusteeKeysPath
 187                          , "Trustee's public key: "<>Doc.from (show (VP.nat pubKey))
 188                          ]<>"\n"
 189                  () -> do
 190                         -- Tally the encrypted ballots
 191                         -- FIXME: actually support fetching through an URL
 192                         let ballotsPath = trusteeDecrypt_url FP.</> "ballots.jsons"
 193                         (encTally, numBallots) <- runPipeWithError $
 194                                 Pip.fold'
 195                                  (flip VP.insertEncryptedTally)
 196                                  VP.emptyEncryptedTally id $
 197                                         readJSON ballotsPath
 198                         decShare <- Pip.liftIO $
 199                                 Rand.getStdRandom $ runState $
 200                                         VP.proveDecryptionShare encTally secKey
 201                         return (coerce decShare :: VP.DecryptionShare ())