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