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