{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}

-- | A simple voting committee where pools with positive stake can vote.
module Ouroboros.Consensus.Committee.EveryoneVotes
  ( -- * Voting committee interface
    EveryoneVotes
  , VotingCommittee -- VotingCommittee internals are not exported
  , VotingCommitteeInput (..)
  , VotingCommitteeError (..)
  , EligibilityWitness (..)
  , Vote (..)
  , Cert (..)

    -- * Metrics about the voting committee composition
  , candidateSeats
  , numActiveVoters
  ) where

import Cardano.Ledger.BaseTypes (NonZero)
import Cardano.Ledger.BaseTypes.NonZero (NonZero (..), nonZero)
import Control.Monad.Zip (MonadZip (..))
import qualified Data.Array as Array
import Data.Bifunctor (Bifunctor (..))
import Data.Containers.NonEmpty (HasNonEmpty (..))
import qualified Data.List.NonEmpty as NonEmpty
import Data.Map.Strict (Map)
import qualified Data.Map.Strict as Map
import Data.Proxy (Proxy (..))
import Data.Set (Set)
import qualified Data.Set.NonEmpty as NESet
import Ouroboros.Consensus.Committee.Class
  ( CryptoSupportsVotingCommittee (..)
  , UniqueVotesWithSameTarget
  , getElectionIdFromVotes
  , getRawVotes
  , getVoteCandidateFromVotes
  )
import Ouroboros.Consensus.Committee.Crypto
  ( CryptoSupportsAggregateVoteSigning (..)
  , CryptoSupportsVoteSigning (..)
  , ElectionId
  , PrivateKey
  , PublicKey
  , VoteCandidate
  )
import Ouroboros.Consensus.Committee.Types
  ( LedgerStake (..)
  , PoolId
  , VoteWeight (..)
  )
import Ouroboros.Consensus.Committee.WFA
  ( ExtWFAStakeDistr (..)
  , NumPoolsWithPositiveStake (..)
  , SeatIndex
  , WFAError
  , getCandidateIfSeatWithinBounds
  , unsafeGetCandidateInSeat
  )

-- | Tag for a simple voting committee where pools with positive stake can vote.
data EveryoneVotes

instance
  CryptoSupportsAggregateVoteSigning crypto =>
  CryptoSupportsVotingCommittee crypto EveryoneVotes
  where
  data VotingCommittee crypto EveryoneVotes
    = EveryoneVotesVotingCommittee
    { -- Preaccumulated stake distribution used to compute committee composition
      forall crypto.
VotingCommittee crypto EveryoneVotes
-> ExtWFAStakeDistr (PublicKey crypto)
extWFAStakeDistr :: !(ExtWFAStakeDistr (PublicKey crypto))
    , -- Index of a given candidate in the cumulative stake distribution
      forall crypto.
VotingCommittee crypto EveryoneVotes -> Map PoolId SeatIndex
candidateSeats :: !(Map PoolId SeatIndex)
    , -- Number of active voters (i.e., those with non-zero stake)
      forall crypto.
VotingCommittee crypto EveryoneVotes -> NumPoolsWithPositiveStake
numActiveVoters :: !NumPoolsWithPositiveStake
    }

  data VotingCommitteeInput crypto EveryoneVotes
    = EveryoneVotesVotingCommitteeInput
        -- Extended cumulative stake distribution of the potential voters
        !(ExtWFAStakeDistr (PublicKey crypto))

  data VotingCommitteeError crypto EveryoneVotes
    = -- An error occurred during the computation of the committee selection
      WFAError WFAError
    | -- Pool ID is missing from the voting committee
      MissingPoolId PoolId
    | -- Seat index is out of bounds for the voting committee
      MissingSeatIndex SeatIndex
    | -- Pool has no stake and thus is not entitled to vote
      PoolHasNoStake SeatIndex
    | -- The vote signature is invalid
      InvalidVoteSignature String
    | -- The certificate signature is invalid
      InvalidCertSignature String
    | -- We triggered an unexpected cryptographic error
      CryptoError String
    deriving (Int -> VotingCommitteeError crypto EveryoneVotes -> ShowS
[VotingCommitteeError crypto EveryoneVotes] -> ShowS
VotingCommitteeError crypto EveryoneVotes -> String
(Int -> VotingCommitteeError crypto EveryoneVotes -> ShowS)
-> (VotingCommitteeError crypto EveryoneVotes -> String)
-> ([VotingCommitteeError crypto EveryoneVotes] -> ShowS)
-> Show (VotingCommitteeError crypto EveryoneVotes)
forall crypto.
Int -> VotingCommitteeError crypto EveryoneVotes -> ShowS
forall crypto. [VotingCommitteeError crypto EveryoneVotes] -> ShowS
forall crypto. VotingCommitteeError crypto EveryoneVotes -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall crypto.
Int -> VotingCommitteeError crypto EveryoneVotes -> ShowS
showsPrec :: Int -> VotingCommitteeError crypto EveryoneVotes -> ShowS
$cshow :: forall crypto. VotingCommitteeError crypto EveryoneVotes -> String
show :: VotingCommitteeError crypto EveryoneVotes -> String
$cshowList :: forall crypto. [VotingCommitteeError crypto EveryoneVotes] -> ShowS
showList :: [VotingCommitteeError crypto EveryoneVotes] -> ShowS
Show, VotingCommitteeError crypto EveryoneVotes
-> VotingCommitteeError crypto EveryoneVotes -> Bool
(VotingCommitteeError crypto EveryoneVotes
 -> VotingCommitteeError crypto EveryoneVotes -> Bool)
-> (VotingCommitteeError crypto EveryoneVotes
    -> VotingCommitteeError crypto EveryoneVotes -> Bool)
-> Eq (VotingCommitteeError crypto EveryoneVotes)
forall crypto.
VotingCommitteeError crypto EveryoneVotes
-> VotingCommitteeError crypto EveryoneVotes -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall crypto.
VotingCommitteeError crypto EveryoneVotes
-> VotingCommitteeError crypto EveryoneVotes -> Bool
== :: VotingCommitteeError crypto EveryoneVotes
-> VotingCommitteeError crypto EveryoneVotes -> Bool
$c/= :: forall crypto.
VotingCommitteeError crypto EveryoneVotes
-> VotingCommitteeError crypto EveryoneVotes -> Bool
/= :: VotingCommitteeError crypto EveryoneVotes
-> VotingCommitteeError crypto EveryoneVotes -> Bool
Eq)

  data EligibilityWitness crypto EveryoneVotes
    = EveryoneVotesMember
        !SeatIndex
        !(NonZero LedgerStake)

  data Vote crypto EveryoneVotes
    = EveryoneVotesVote
        !SeatIndex
        !(ElectionId crypto)
        !(VoteCandidate crypto)
        !(VoteSignature crypto)

  data Cert crypto EveryoneVotes
    = EveryoneVotesCert
        !(ElectionId crypto)
        !(VoteCandidate crypto)
        !(NE (Set SeatIndex))
        !(AggregateVoteSignature crypto)

  mkVotingCommittee :: VotingCommitteeInput crypto EveryoneVotes
-> Either
     (VotingCommitteeError crypto EveryoneVotes)
     (VotingCommittee crypto EveryoneVotes)
mkVotingCommittee = VotingCommitteeInput crypto EveryoneVotes
-> Either
     (VotingCommitteeError crypto EveryoneVotes)
     (VotingCommittee crypto EveryoneVotes)
forall crypto.
VotingCommitteeInput crypto EveryoneVotes
-> Either
     (VotingCommitteeError crypto EveryoneVotes)
     (VotingCommittee crypto EveryoneVotes)
mkEveryoneVotesVotingCommittee
  checkShouldVote :: VotingCommittee crypto EveryoneVotes
-> PoolId
-> PrivateKey crypto
-> ElectionId crypto
-> Either
     (VotingCommitteeError crypto EveryoneVotes)
     (Maybe (EligibilityWitness crypto EveryoneVotes))
checkShouldVote = VotingCommittee crypto EveryoneVotes
-> PoolId
-> PrivateKey crypto
-> ElectionId crypto
-> Either
     (VotingCommitteeError crypto EveryoneVotes)
     (Maybe (EligibilityWitness crypto EveryoneVotes))
forall crypto.
VotingCommittee crypto EveryoneVotes
-> PoolId
-> PrivateKey crypto
-> ElectionId crypto
-> Either
     (VotingCommitteeError crypto EveryoneVotes)
     (Maybe (EligibilityWitness crypto EveryoneVotes))
implCheckShouldVote
  forgeVote :: EligibilityWitness crypto EveryoneVotes
-> PrivateKey crypto
-> ElectionId crypto
-> VoteCandidate crypto
-> Vote crypto EveryoneVotes
forgeVote = EligibilityWitness crypto EveryoneVotes
-> PrivateKey crypto
-> ElectionId crypto
-> VoteCandidate crypto
-> Vote crypto EveryoneVotes
forall crypto.
CryptoSupportsVoteSigning crypto =>
EligibilityWitness crypto EveryoneVotes
-> PrivateKey crypto
-> ElectionId crypto
-> VoteCandidate crypto
-> Vote crypto EveryoneVotes
implForgeVote
  verifyVote :: VotingCommittee crypto EveryoneVotes
-> Vote crypto EveryoneVotes
-> Either
     (VotingCommitteeError crypto EveryoneVotes)
     (EligibilityWitness crypto EveryoneVotes)
verifyVote = VotingCommittee crypto EveryoneVotes
-> Vote crypto EveryoneVotes
-> Either
     (VotingCommitteeError crypto EveryoneVotes)
     (EligibilityWitness crypto EveryoneVotes)
forall crypto.
CryptoSupportsVoteSigning crypto =>
VotingCommittee crypto EveryoneVotes
-> Vote crypto EveryoneVotes
-> Either
     (VotingCommitteeError crypto EveryoneVotes)
     (EligibilityWitness crypto EveryoneVotes)
implVerifyVote
  eligiblePartyVoteWeight :: VotingCommittee crypto EveryoneVotes
-> EligibilityWitness crypto EveryoneVotes -> VoteWeight
eligiblePartyVoteWeight = VotingCommittee crypto EveryoneVotes
-> EligibilityWitness crypto EveryoneVotes -> VoteWeight
forall crypto.
VotingCommittee crypto EveryoneVotes
-> EligibilityWitness crypto EveryoneVotes -> VoteWeight
implEligiblePartyVoteWeight
  forgeCert :: UniqueVotesWithSameTarget crypto EveryoneVotes
-> Either
     (VotingCommitteeError crypto EveryoneVotes)
     (Cert crypto EveryoneVotes)
forgeCert = UniqueVotesWithSameTarget crypto EveryoneVotes
-> Either
     (VotingCommitteeError crypto EveryoneVotes)
     (Cert crypto EveryoneVotes)
forall crypto.
CryptoSupportsAggregateVoteSigning crypto =>
UniqueVotesWithSameTarget crypto EveryoneVotes
-> Either
     (VotingCommitteeError crypto EveryoneVotes)
     (Cert crypto EveryoneVotes)
implForgeCert
  verifyCert :: VotingCommittee crypto EveryoneVotes
-> Cert crypto EveryoneVotes
-> Either
     (VotingCommitteeError crypto EveryoneVotes)
     (NE [EligibilityWitness crypto EveryoneVotes])
verifyCert = VotingCommittee crypto EveryoneVotes
-> Cert crypto EveryoneVotes
-> Either
     (VotingCommitteeError crypto EveryoneVotes)
     (NE [EligibilityWitness crypto EveryoneVotes])
forall crypto.
CryptoSupportsAggregateVoteSigning crypto =>
VotingCommittee crypto EveryoneVotes
-> Cert crypto EveryoneVotes
-> Either
     (VotingCommitteeError crypto EveryoneVotes)
     (NE [EligibilityWitness crypto EveryoneVotes])
implVerifyCert

-- | Construct a 'EveryoneVotesVotingCommittee' for a given epoch
mkEveryoneVotesVotingCommittee ::
  VotingCommitteeInput crypto EveryoneVotes ->
  Either
    (VotingCommitteeError crypto EveryoneVotes)
    (VotingCommittee crypto EveryoneVotes)
mkEveryoneVotesVotingCommittee :: forall crypto.
VotingCommitteeInput crypto EveryoneVotes
-> Either
     (VotingCommitteeError crypto EveryoneVotes)
     (VotingCommittee crypto EveryoneVotes)
mkEveryoneVotesVotingCommittee
  ( EveryoneVotesVotingCommitteeInput
      ExtWFAStakeDistr (PublicKey crypto)
stakeDistr
    ) = do
    let seats :: Map PoolId SeatIndex
seats =
          [(PoolId, SeatIndex)] -> Map PoolId SeatIndex
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
            ([(PoolId, SeatIndex)] -> Map PoolId SeatIndex)
-> (ExtWFAStakeDistr (PublicKey crypto) -> [(PoolId, SeatIndex)])
-> ExtWFAStakeDistr (PublicKey crypto)
-> Map PoolId SeatIndex
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((SeatIndex,
  (PoolId, PublicKey crypto, LedgerStake, Cumulative LedgerStake))
 -> (PoolId, SeatIndex))
-> [(SeatIndex,
     (PoolId, PublicKey crypto, LedgerStake, Cumulative LedgerStake))]
-> [(PoolId, SeatIndex)]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(SeatIndex
seatIndex, (PoolId
poolId, PublicKey crypto
_, LedgerStake
_, Cumulative LedgerStake
_)) -> (PoolId
poolId, SeatIndex
seatIndex))
            ([(SeatIndex,
   (PoolId, PublicKey crypto, LedgerStake, Cumulative LedgerStake))]
 -> [(PoolId, SeatIndex)])
-> (ExtWFAStakeDistr (PublicKey crypto)
    -> [(SeatIndex,
         (PoolId, PublicKey crypto, LedgerStake, Cumulative LedgerStake))])
-> ExtWFAStakeDistr (PublicKey crypto)
-> [(PoolId, SeatIndex)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Array
  SeatIndex
  (PoolId, PublicKey crypto, LedgerStake, Cumulative LedgerStake)
-> [(SeatIndex,
     (PoolId, PublicKey crypto, LedgerStake, Cumulative LedgerStake))]
forall i e. Ix i => Array i e -> [(i, e)]
Array.assocs
            (Array
   SeatIndex
   (PoolId, PublicKey crypto, LedgerStake, Cumulative LedgerStake)
 -> [(SeatIndex,
      (PoolId, PublicKey crypto, LedgerStake, Cumulative LedgerStake))])
-> (ExtWFAStakeDistr (PublicKey crypto)
    -> Array
         SeatIndex
         (PoolId, PublicKey crypto, LedgerStake, Cumulative LedgerStake))
-> ExtWFAStakeDistr (PublicKey crypto)
-> [(SeatIndex,
     (PoolId, PublicKey crypto, LedgerStake, Cumulative LedgerStake))]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ExtWFAStakeDistr (PublicKey crypto)
-> Array
     SeatIndex
     (PoolId, PublicKey crypto, LedgerStake, Cumulative LedgerStake)
forall a.
ExtWFAStakeDistr a
-> Array SeatIndex (PoolId, a, LedgerStake, Cumulative LedgerStake)
unExtWFAStakeDistr
            (ExtWFAStakeDistr (PublicKey crypto) -> Map PoolId SeatIndex)
-> ExtWFAStakeDistr (PublicKey crypto) -> Map PoolId SeatIndex
forall a b. (a -> b) -> a -> b
$ ExtWFAStakeDistr (PublicKey crypto)
stakeDistr

    VotingCommittee crypto EveryoneVotes
-> Either
     (VotingCommitteeError crypto EveryoneVotes)
     (VotingCommittee crypto EveryoneVotes)
forall a. a -> Either (VotingCommitteeError crypto EveryoneVotes) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (VotingCommittee crypto EveryoneVotes
 -> Either
      (VotingCommitteeError crypto EveryoneVotes)
      (VotingCommittee crypto EveryoneVotes))
-> VotingCommittee crypto EveryoneVotes
-> Either
     (VotingCommitteeError crypto EveryoneVotes)
     (VotingCommittee crypto EveryoneVotes)
forall a b. (a -> b) -> a -> b
$
      EveryoneVotesVotingCommittee
        { extWFAStakeDistr :: ExtWFAStakeDistr (PublicKey crypto)
extWFAStakeDistr = ExtWFAStakeDistr (PublicKey crypto)
stakeDistr
        , candidateSeats :: Map PoolId SeatIndex
candidateSeats = Map PoolId SeatIndex
seats
        , numActiveVoters :: NumPoolsWithPositiveStake
numActiveVoters = ExtWFAStakeDistr (PublicKey crypto) -> NumPoolsWithPositiveStake
forall a. ExtWFAStakeDistr a -> NumPoolsWithPositiveStake
numPoolsWithPositiveStake ExtWFAStakeDistr (PublicKey crypto)
stakeDistr
        }

-- | Check whether we should vote in a given election
implCheckShouldVote ::
  forall crypto.
  VotingCommittee crypto EveryoneVotes ->
  PoolId ->
  PrivateKey crypto ->
  ElectionId crypto ->
  Either
    (VotingCommitteeError crypto EveryoneVotes)
    (Maybe (EligibilityWitness crypto EveryoneVotes))
implCheckShouldVote :: forall crypto.
VotingCommittee crypto EveryoneVotes
-> PoolId
-> PrivateKey crypto
-> ElectionId crypto
-> Either
     (VotingCommitteeError crypto EveryoneVotes)
     (Maybe (EligibilityWitness crypto EveryoneVotes))
implCheckShouldVote VotingCommittee crypto EveryoneVotes
committee PoolId
ourId PrivateKey crypto
_ourPrivateKey ElectionId crypto
_electionId
  | Just SeatIndex
seatIndex <- PoolId -> Map PoolId SeatIndex -> Maybe SeatIndex
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup PoolId
ourId (VotingCommittee crypto EveryoneVotes -> Map PoolId SeatIndex
forall crypto.
VotingCommittee crypto EveryoneVotes -> Map PoolId SeatIndex
candidateSeats VotingCommittee crypto EveryoneVotes
committee) = do
      let (PoolId
_, PublicKey crypto
_, LedgerStake
ourStake, Cumulative LedgerStake
_) =
            SeatIndex
-> ExtWFAStakeDistr (PublicKey crypto)
-> (PoolId, PublicKey crypto, LedgerStake, Cumulative LedgerStake)
forall a.
SeatIndex
-> ExtWFAStakeDistr a
-> (PoolId, a, LedgerStake, Cumulative LedgerStake)
unsafeGetCandidateInSeat SeatIndex
seatIndex (VotingCommittee crypto EveryoneVotes
-> ExtWFAStakeDistr (PublicKey crypto)
forall crypto.
VotingCommittee crypto EveryoneVotes
-> ExtWFAStakeDistr (PublicKey crypto)
extWFAStakeDistr VotingCommittee crypto EveryoneVotes
committee)
      case LedgerStake -> Maybe (NonZero LedgerStake)
forall a. HasZero a => a -> Maybe (NonZero a)
nonZero LedgerStake
ourStake of
        Maybe (NonZero LedgerStake)
Nothing ->
          Maybe (EligibilityWitness crypto EveryoneVotes)
-> Either
     (VotingCommitteeError crypto EveryoneVotes)
     (Maybe (EligibilityWitness crypto EveryoneVotes))
forall a b. b -> Either a b
Right (Maybe (EligibilityWitness crypto EveryoneVotes)
 -> Either
      (VotingCommitteeError crypto EveryoneVotes)
      (Maybe (EligibilityWitness crypto EveryoneVotes)))
-> Maybe (EligibilityWitness crypto EveryoneVotes)
-> Either
     (VotingCommitteeError crypto EveryoneVotes)
     (Maybe (EligibilityWitness crypto EveryoneVotes))
forall a b. (a -> b) -> a -> b
$
            Maybe (EligibilityWitness crypto EveryoneVotes)
forall a. Maybe a
Nothing
        Just NonZero LedgerStake
nonZeroOurStake ->
          Maybe (EligibilityWitness crypto EveryoneVotes)
-> Either
     (VotingCommitteeError crypto EveryoneVotes)
     (Maybe (EligibilityWitness crypto EveryoneVotes))
forall a b. b -> Either a b
Right (Maybe (EligibilityWitness crypto EveryoneVotes)
 -> Either
      (VotingCommitteeError crypto EveryoneVotes)
      (Maybe (EligibilityWitness crypto EveryoneVotes)))
-> Maybe (EligibilityWitness crypto EveryoneVotes)
-> Either
     (VotingCommitteeError crypto EveryoneVotes)
     (Maybe (EligibilityWitness crypto EveryoneVotes))
forall a b. (a -> b) -> a -> b
$
            EligibilityWitness crypto EveryoneVotes
-> Maybe (EligibilityWitness crypto EveryoneVotes)
forall a. a -> Maybe a
Just (EligibilityWitness crypto EveryoneVotes
 -> Maybe (EligibilityWitness crypto EveryoneVotes))
-> EligibilityWitness crypto EveryoneVotes
-> Maybe (EligibilityWitness crypto EveryoneVotes)
forall a b. (a -> b) -> a -> b
$
              SeatIndex
-> NonZero LedgerStake -> EligibilityWitness crypto EveryoneVotes
forall crypto.
SeatIndex
-> NonZero LedgerStake -> EligibilityWitness crypto EveryoneVotes
EveryoneVotesMember
                SeatIndex
seatIndex
                NonZero LedgerStake
nonZeroOurStake
  | Bool
otherwise =
      VotingCommitteeError crypto EveryoneVotes
-> Either
     (VotingCommitteeError crypto EveryoneVotes)
     (Maybe (EligibilityWitness crypto EveryoneVotes))
forall a b. a -> Either a b
Left (PoolId -> VotingCommitteeError crypto EveryoneVotes
forall crypto. PoolId -> VotingCommitteeError crypto EveryoneVotes
MissingPoolId PoolId
ourId)

-- | Forge a vote for a given election and candidate
implForgeVote ::
  forall crypto.
  CryptoSupportsVoteSigning crypto =>
  EligibilityWitness crypto EveryoneVotes ->
  PrivateKey crypto ->
  ElectionId crypto ->
  VoteCandidate crypto ->
  Vote crypto EveryoneVotes
implForgeVote :: forall crypto.
CryptoSupportsVoteSigning crypto =>
EligibilityWitness crypto EveryoneVotes
-> PrivateKey crypto
-> ElectionId crypto
-> VoteCandidate crypto
-> Vote crypto EveryoneVotes
implForgeVote EligibilityWitness crypto EveryoneVotes
member PrivateKey crypto
ourPrivateKey ElectionId crypto
electionId VoteCandidate crypto
candidate =
  SeatIndex
-> ElectionId crypto
-> VoteCandidate crypto
-> VoteSignature crypto
-> Vote crypto EveryoneVotes
forall crypto.
SeatIndex
-> ElectionId crypto
-> VoteCandidate crypto
-> VoteSignature crypto
-> Vote crypto EveryoneVotes
EveryoneVotesVote SeatIndex
seatIndex ElectionId crypto
electionId VoteCandidate crypto
candidate VoteSignature crypto
sig
 where
  EveryoneVotesMember SeatIndex
seatIndex NonZero LedgerStake
_ =
    EligibilityWitness crypto EveryoneVotes
member
  ourVoteSigningKey :: VoteSigningKey crypto
ourVoteSigningKey =
    Proxy crypto -> PrivateKey crypto -> VoteSigningKey crypto
forall crypto.
CryptoSupportsVoteSigning crypto =>
Proxy crypto -> PrivateKey crypto -> VoteSigningKey crypto
getVoteSigningKey (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @crypto) PrivateKey crypto
ourPrivateKey
  sig :: VoteSignature crypto
sig =
    VoteSigningKey crypto
-> ElectionId crypto
-> VoteCandidate crypto
-> VoteSignature crypto
forall crypto.
CryptoSupportsVoteSigning crypto =>
VoteSigningKey crypto
-> ElectionId crypto
-> VoteCandidate crypto
-> VoteSignature crypto
signVote VoteSigningKey crypto
ourVoteSigningKey ElectionId crypto
electionId VoteCandidate crypto
candidate

-- | Verify a vote cast by a committee member in a given election
implVerifyVote ::
  forall crypto.
  CryptoSupportsVoteSigning crypto =>
  VotingCommittee crypto EveryoneVotes ->
  Vote crypto EveryoneVotes ->
  Either
    (VotingCommitteeError crypto EveryoneVotes)
    (EligibilityWitness crypto EveryoneVotes)
implVerifyVote :: forall crypto.
CryptoSupportsVoteSigning crypto =>
VotingCommittee crypto EveryoneVotes
-> Vote crypto EveryoneVotes
-> Either
     (VotingCommitteeError crypto EveryoneVotes)
     (EligibilityWitness crypto EveryoneVotes)
implVerifyVote VotingCommittee crypto EveryoneVotes
committee = \case
  EveryoneVotesVote SeatIndex
seatIndex ElectionId crypto
electionId VoteCandidate crypto
candidate VoteSignature crypto
sig
    | Just (PoolId
_, PublicKey crypto
voterPublicKey, LedgerStake
voterStake, Cumulative LedgerStake
_) <-
        SeatIndex
-> ExtWFAStakeDistr (PublicKey crypto)
-> Maybe
     (PoolId, PublicKey crypto, LedgerStake, Cumulative LedgerStake)
forall a.
SeatIndex
-> ExtWFAStakeDistr a
-> Maybe (PoolId, a, LedgerStake, Cumulative LedgerStake)
getCandidateIfSeatWithinBounds SeatIndex
seatIndex (VotingCommittee crypto EveryoneVotes
-> ExtWFAStakeDistr (PublicKey crypto)
forall crypto.
VotingCommittee crypto EveryoneVotes
-> ExtWFAStakeDistr (PublicKey crypto)
extWFAStakeDistr VotingCommittee crypto EveryoneVotes
committee) -> do
        let voterVerificationKey :: VoteVerificationKey crypto
voterVerificationKey =
              Proxy crypto -> PublicKey crypto -> VoteVerificationKey crypto
forall crypto.
CryptoSupportsVoteSigning crypto =>
Proxy crypto -> PublicKey crypto -> VoteVerificationKey crypto
getVoteVerificationKey (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @crypto) PublicKey crypto
voterPublicKey
        (String -> VotingCommitteeError crypto EveryoneVotes)
-> (() -> ())
-> Either String ()
-> Either (VotingCommitteeError crypto EveryoneVotes) ()
forall a b c d. (a -> b) -> (c -> d) -> Either a c -> Either b d
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap String -> VotingCommitteeError crypto EveryoneVotes
forall crypto. String -> VotingCommitteeError crypto EveryoneVotes
InvalidVoteSignature () -> ()
forall a. a -> a
id (Either String ()
 -> Either (VotingCommitteeError crypto EveryoneVotes) ())
-> Either String ()
-> Either (VotingCommitteeError crypto EveryoneVotes) ()
forall a b. (a -> b) -> a -> b
$ do
          VoteVerificationKey crypto
-> ElectionId crypto
-> VoteCandidate crypto
-> VoteSignature crypto
-> Either String ()
forall crypto.
CryptoSupportsVoteSigning crypto =>
VoteVerificationKey crypto
-> ElectionId crypto
-> VoteCandidate crypto
-> VoteSignature crypto
-> Either String ()
verifyVoteSignature
            VoteVerificationKey crypto
voterVerificationKey
            ElectionId crypto
electionId
            VoteCandidate crypto
candidate
            VoteSignature crypto
sig
        case LedgerStake -> Maybe (NonZero LedgerStake)
forall a. HasZero a => a -> Maybe (NonZero a)
nonZero LedgerStake
voterStake of
          Maybe (NonZero LedgerStake)
Nothing ->
            VotingCommitteeError crypto EveryoneVotes
-> Either
     (VotingCommitteeError crypto EveryoneVotes)
     (EligibilityWitness crypto EveryoneVotes)
forall a b. a -> Either a b
Left (SeatIndex -> VotingCommitteeError crypto EveryoneVotes
forall crypto.
SeatIndex -> VotingCommitteeError crypto EveryoneVotes
PoolHasNoStake SeatIndex
seatIndex)
          Just NonZero LedgerStake
nonZeroVoterStake ->
            EligibilityWitness crypto EveryoneVotes
-> Either
     (VotingCommitteeError crypto EveryoneVotes)
     (EligibilityWitness crypto EveryoneVotes)
forall a. a -> Either (VotingCommitteeError crypto EveryoneVotes) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (EligibilityWitness crypto EveryoneVotes
 -> Either
      (VotingCommitteeError crypto EveryoneVotes)
      (EligibilityWitness crypto EveryoneVotes))
-> EligibilityWitness crypto EveryoneVotes
-> Either
     (VotingCommitteeError crypto EveryoneVotes)
     (EligibilityWitness crypto EveryoneVotes)
forall a b. (a -> b) -> a -> b
$
              SeatIndex
-> NonZero LedgerStake -> EligibilityWitness crypto EveryoneVotes
forall crypto.
SeatIndex
-> NonZero LedgerStake -> EligibilityWitness crypto EveryoneVotes
EveryoneVotesMember
                SeatIndex
seatIndex
                NonZero LedgerStake
nonZeroVoterStake
    | Bool
otherwise ->
        VotingCommitteeError crypto EveryoneVotes
-> Either
     (VotingCommitteeError crypto EveryoneVotes)
     (EligibilityWitness crypto EveryoneVotes)
forall a b. a -> Either a b
Left (SeatIndex -> VotingCommitteeError crypto EveryoneVotes
forall crypto.
SeatIndex -> VotingCommitteeError crypto EveryoneVotes
MissingSeatIndex SeatIndex
seatIndex)

-- | Compute the voting power of an eligible committee member.
--
-- In this simple voting committee, the vote weight of a member is equal to
-- their ledger stake, as long as it is positive.
implEligiblePartyVoteWeight ::
  VotingCommittee crypto EveryoneVotes ->
  EligibilityWitness crypto EveryoneVotes ->
  VoteWeight
implEligiblePartyVoteWeight :: forall crypto.
VotingCommittee crypto EveryoneVotes
-> EligibilityWitness crypto EveryoneVotes -> VoteWeight
implEligiblePartyVoteWeight VotingCommittee crypto EveryoneVotes
_committee EligibilityWitness crypto EveryoneVotes
member =
  Rational -> VoteWeight
VoteWeight (LedgerStake -> Rational
unLedgerStake (NonZero LedgerStake -> LedgerStake
forall a. NonZero a -> a
unNonZero NonZero LedgerStake
voterStake))
 where
  EveryoneVotesMember SeatIndex
_ NonZero LedgerStake
voterStake = EligibilityWitness crypto EveryoneVotes
member

-- | Forge a certificate attesting the winner of a given election
implForgeCert ::
  forall crypto.
  CryptoSupportsAggregateVoteSigning crypto =>
  UniqueVotesWithSameTarget crypto EveryoneVotes ->
  Either
    (VotingCommitteeError crypto EveryoneVotes)
    (Cert crypto EveryoneVotes)
implForgeCert :: forall crypto.
CryptoSupportsAggregateVoteSigning crypto =>
UniqueVotesWithSameTarget crypto EveryoneVotes
-> Either
     (VotingCommitteeError crypto EveryoneVotes)
     (Cert crypto EveryoneVotes)
implForgeCert UniqueVotesWithSameTarget crypto EveryoneVotes
votes = do
  aggSig <-
    (String -> VotingCommitteeError crypto EveryoneVotes)
-> (AggregateVoteSignature crypto -> AggregateVoteSignature crypto)
-> Either String (AggregateVoteSignature crypto)
-> Either
     (VotingCommitteeError crypto EveryoneVotes)
     (AggregateVoteSignature crypto)
forall a b c d. (a -> b) -> (c -> d) -> Either a c -> Either b d
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap String -> VotingCommitteeError crypto EveryoneVotes
forall crypto. String -> VotingCommitteeError crypto EveryoneVotes
CryptoError AggregateVoteSignature crypto -> AggregateVoteSignature crypto
forall a. a -> a
id (Either String (AggregateVoteSignature crypto)
 -> Either
      (VotingCommitteeError crypto EveryoneVotes)
      (AggregateVoteSignature crypto))
-> Either String (AggregateVoteSignature crypto)
-> Either
     (VotingCommitteeError crypto EveryoneVotes)
     (AggregateVoteSignature crypto)
forall a b. (a -> b) -> a -> b
$ do
      Proxy crypto
-> NE [VoteSignature crypto]
-> Either String (AggregateVoteSignature crypto)
forall crypto.
CryptoSupportsAggregateVoteSigning crypto =>
Proxy crypto
-> NE [VoteSignature crypto]
-> Either String (AggregateVoteSignature crypto)
aggregateVoteSignatures
        (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @crypto)
        NonEmpty (VoteSignature crypto)
NE [VoteSignature crypto]
voteSignatures
  pure $
    EveryoneVotesCert
      (getElectionIdFromVotes votes)
      (getVoteCandidateFromVotes votes)
      (NESet.fromList voters)
      aggSig
 where
  (NonEmpty SeatIndex
voters, NonEmpty (VoteSignature crypto)
voteSignatures) =
    NonEmpty (SeatIndex, VoteSignature crypto)
-> (NonEmpty SeatIndex, NonEmpty (VoteSignature crypto))
forall a b. NonEmpty (a, b) -> (NonEmpty a, NonEmpty b)
forall (m :: * -> *) a b. MonadZip m => m (a, b) -> (m a, m b)
munzip (NonEmpty (SeatIndex, VoteSignature crypto)
 -> (NonEmpty SeatIndex, NonEmpty (VoteSignature crypto)))
-> NonEmpty (SeatIndex, VoteSignature crypto)
-> (NonEmpty SeatIndex, NonEmpty (VoteSignature crypto))
forall a b. (a -> b) -> a -> b
$ ((Vote crypto EveryoneVotes -> (SeatIndex, VoteSignature crypto))
 -> NonEmpty (Vote crypto EveryoneVotes)
 -> NonEmpty (SeatIndex, VoteSignature crypto))
-> NonEmpty (Vote crypto EveryoneVotes)
-> (Vote crypto EveryoneVotes -> (SeatIndex, VoteSignature crypto))
-> NonEmpty (SeatIndex, VoteSignature crypto)
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Vote crypto EveryoneVotes -> (SeatIndex, VoteSignature crypto))
-> NonEmpty (Vote crypto EveryoneVotes)
-> NonEmpty (SeatIndex, VoteSignature crypto)
forall a b. (a -> b) -> NonEmpty a -> NonEmpty b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap NonEmpty (Vote crypto EveryoneVotes)
votesInAscendingSeatIndexOrder ((Vote crypto EveryoneVotes -> (SeatIndex, VoteSignature crypto))
 -> NonEmpty (SeatIndex, VoteSignature crypto))
-> (Vote crypto EveryoneVotes -> (SeatIndex, VoteSignature crypto))
-> NonEmpty (SeatIndex, VoteSignature crypto)
forall a b. (a -> b) -> a -> b
$ \case
      EveryoneVotesVote SeatIndex
seatIndex ElectionId crypto
_ VoteCandidate crypto
_ VoteSignature crypto
sig ->
        ( SeatIndex
seatIndex
        , VoteSignature crypto
sig
        )

  -- Make sure we have votes in ascending seat index order, which is something
  -- 'VotesWithSameTarget' cannot guarantee by itself, since seat indices are
  -- an implementation detail of this voting committee scheme.
  votesInAscendingSeatIndexOrder :: NonEmpty (Vote crypto EveryoneVotes)
votesInAscendingSeatIndexOrder =
    ((Vote crypto EveryoneVotes -> SeatIndex)
 -> NonEmpty (Vote crypto EveryoneVotes)
 -> NonEmpty (Vote crypto EveryoneVotes))
-> NonEmpty (Vote crypto EveryoneVotes)
-> (Vote crypto EveryoneVotes -> SeatIndex)
-> NonEmpty (Vote crypto EveryoneVotes)
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Vote crypto EveryoneVotes -> SeatIndex)
-> NonEmpty (Vote crypto EveryoneVotes)
-> NonEmpty (Vote crypto EveryoneVotes)
forall o a. Ord o => (a -> o) -> NonEmpty a -> NonEmpty a
NonEmpty.sortWith (UniqueVotesWithSameTarget crypto EveryoneVotes
-> NE [Vote crypto EveryoneVotes]
forall crypto committee.
UniqueVotesWithSameTarget crypto committee
-> NE [Vote crypto committee]
getRawVotes UniqueVotesWithSameTarget crypto EveryoneVotes
votes) ((Vote crypto EveryoneVotes -> SeatIndex)
 -> NonEmpty (Vote crypto EveryoneVotes))
-> (Vote crypto EveryoneVotes -> SeatIndex)
-> NonEmpty (Vote crypto EveryoneVotes)
forall a b. (a -> b) -> a -> b
$ \case
      EveryoneVotesVote SeatIndex
seatIndex ElectionId crypto
_ VoteCandidate crypto
_ VoteSignature crypto
_ -> SeatIndex
seatIndex

-- | Verify a certificate attesting the winner of a given election
implVerifyCert ::
  forall crypto.
  CryptoSupportsAggregateVoteSigning crypto =>
  VotingCommittee crypto EveryoneVotes ->
  Cert crypto EveryoneVotes ->
  Either
    (VotingCommitteeError crypto EveryoneVotes)
    (NE [EligibilityWitness crypto EveryoneVotes])
implVerifyCert :: forall crypto.
CryptoSupportsAggregateVoteSigning crypto =>
VotingCommittee crypto EveryoneVotes
-> Cert crypto EveryoneVotes
-> Either
     (VotingCommitteeError crypto EveryoneVotes)
     (NE [EligibilityWitness crypto EveryoneVotes])
implVerifyCert VotingCommittee crypto EveryoneVotes
committee = \case
  EveryoneVotesCert ElectionId crypto
electionId VoteCandidate crypto
candidate NE (Set SeatIndex)
voters AggregateVoteSignature crypto
aggSig -> do
    -- Traverse the list of voters in ascending seat index order, collecting:
    -- 1. their membership status
    -- 2. their vote verification keys (to verify the aggregate vote signature)
    (members, voteVerificationKeys) <-
      (NonEmpty
   (EligibilityWitness crypto EveryoneVotes,
    VoteVerificationKey crypto)
 -> (NonEmpty (EligibilityWitness crypto EveryoneVotes),
     NonEmpty (VoteVerificationKey crypto)))
-> Either
     (VotingCommitteeError crypto EveryoneVotes)
     (NonEmpty
        (EligibilityWitness crypto EveryoneVotes,
         VoteVerificationKey crypto))
-> Either
     (VotingCommitteeError crypto EveryoneVotes)
     (NonEmpty (EligibilityWitness crypto EveryoneVotes),
      NonEmpty (VoteVerificationKey crypto))
forall a b.
(a -> b)
-> Either (VotingCommitteeError crypto EveryoneVotes) a
-> Either (VotingCommitteeError crypto EveryoneVotes) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap NonEmpty
  (EligibilityWitness crypto EveryoneVotes,
   VoteVerificationKey crypto)
-> (NonEmpty (EligibilityWitness crypto EveryoneVotes),
    NonEmpty (VoteVerificationKey crypto))
forall a b. NonEmpty (a, b) -> (NonEmpty a, NonEmpty b)
forall (m :: * -> *) a b. MonadZip m => m (a, b) -> (m a, m b)
munzip (Either
   (VotingCommitteeError crypto EveryoneVotes)
   (NonEmpty
      (EligibilityWitness crypto EveryoneVotes,
       VoteVerificationKey crypto))
 -> Either
      (VotingCommitteeError crypto EveryoneVotes)
      (NonEmpty (EligibilityWitness crypto EveryoneVotes),
       NonEmpty (VoteVerificationKey crypto)))
-> ((SeatIndex
     -> Either
          (VotingCommitteeError crypto EveryoneVotes)
          (EligibilityWitness crypto EveryoneVotes,
           VoteVerificationKey crypto))
    -> Either
         (VotingCommitteeError crypto EveryoneVotes)
         (NonEmpty
            (EligibilityWitness crypto EveryoneVotes,
             VoteVerificationKey crypto)))
-> (SeatIndex
    -> Either
         (VotingCommitteeError crypto EveryoneVotes)
         (EligibilityWitness crypto EveryoneVotes,
          VoteVerificationKey crypto))
-> Either
     (VotingCommitteeError crypto EveryoneVotes)
     (NonEmpty (EligibilityWitness crypto EveryoneVotes),
      NonEmpty (VoteVerificationKey crypto))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((SeatIndex
  -> Either
       (VotingCommitteeError crypto EveryoneVotes)
       (EligibilityWitness crypto EveryoneVotes,
        VoteVerificationKey crypto))
 -> NonEmpty SeatIndex
 -> Either
      (VotingCommitteeError crypto EveryoneVotes)
      (NonEmpty
         (EligibilityWitness crypto EveryoneVotes,
          VoteVerificationKey crypto)))
-> NonEmpty SeatIndex
-> (SeatIndex
    -> Either
         (VotingCommitteeError crypto EveryoneVotes)
         (EligibilityWitness crypto EveryoneVotes,
          VoteVerificationKey crypto))
-> Either
     (VotingCommitteeError crypto EveryoneVotes)
     (NonEmpty
        (EligibilityWitness crypto EveryoneVotes,
         VoteVerificationKey crypto))
forall a b c. (a -> b -> c) -> b -> a -> c
flip (SeatIndex
 -> Either
      (VotingCommitteeError crypto EveryoneVotes)
      (EligibilityWitness crypto EveryoneVotes,
       VoteVerificationKey crypto))
-> NonEmpty SeatIndex
-> Either
     (VotingCommitteeError crypto EveryoneVotes)
     (NonEmpty
        (EligibilityWitness crypto EveryoneVotes,
         VoteVerificationKey crypto))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> NonEmpty a -> f (NonEmpty b)
traverse (NESet SeatIndex -> NonEmpty SeatIndex
forall a. NESet a -> NonEmpty a
NESet.toAscList NESet SeatIndex
NE (Set SeatIndex)
voters) ((SeatIndex
  -> Either
       (VotingCommitteeError crypto EveryoneVotes)
       (EligibilityWitness crypto EveryoneVotes,
        VoteVerificationKey crypto))
 -> Either
      (VotingCommitteeError crypto EveryoneVotes)
      (NonEmpty (EligibilityWitness crypto EveryoneVotes),
       NonEmpty (VoteVerificationKey crypto)))
-> (SeatIndex
    -> Either
         (VotingCommitteeError crypto EveryoneVotes)
         (EligibilityWitness crypto EveryoneVotes,
          VoteVerificationKey crypto))
-> Either
     (VotingCommitteeError crypto EveryoneVotes)
     (NonEmpty (EligibilityWitness crypto EveryoneVotes),
      NonEmpty (VoteVerificationKey crypto))
forall a b. (a -> b) -> a -> b
$ \case
        SeatIndex
seatIndex
          | Just (PoolId
_, PublicKey crypto
voterPublicKey, LedgerStake
voterStake, Cumulative LedgerStake
_) <-
              SeatIndex
-> ExtWFAStakeDistr (PublicKey crypto)
-> Maybe
     (PoolId, PublicKey crypto, LedgerStake, Cumulative LedgerStake)
forall a.
SeatIndex
-> ExtWFAStakeDistr a
-> Maybe (PoolId, a, LedgerStake, Cumulative LedgerStake)
getCandidateIfSeatWithinBounds SeatIndex
seatIndex (VotingCommittee crypto EveryoneVotes
-> ExtWFAStakeDistr (PublicKey crypto)
forall crypto.
VotingCommittee crypto EveryoneVotes
-> ExtWFAStakeDistr (PublicKey crypto)
extWFAStakeDistr VotingCommittee crypto EveryoneVotes
committee) -> do
              let voterVerificationKey :: VoteVerificationKey crypto
voterVerificationKey =
                    Proxy crypto -> PublicKey crypto -> VoteVerificationKey crypto
forall crypto.
CryptoSupportsVoteSigning crypto =>
Proxy crypto -> PublicKey crypto -> VoteVerificationKey crypto
getVoteVerificationKey (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @crypto) PublicKey crypto
voterPublicKey
              case LedgerStake -> Maybe (NonZero LedgerStake)
forall a. HasZero a => a -> Maybe (NonZero a)
nonZero LedgerStake
voterStake of
                Maybe (NonZero LedgerStake)
Nothing ->
                  VotingCommitteeError crypto EveryoneVotes
-> Either
     (VotingCommitteeError crypto EveryoneVotes)
     (EligibilityWitness crypto EveryoneVotes,
      VoteVerificationKey crypto)
forall a b. a -> Either a b
Left (SeatIndex -> VotingCommitteeError crypto EveryoneVotes
forall crypto.
SeatIndex -> VotingCommitteeError crypto EveryoneVotes
PoolHasNoStake SeatIndex
seatIndex)
                Just NonZero LedgerStake
nonZeroVoterStake ->
                  (EligibilityWitness crypto EveryoneVotes,
 VoteVerificationKey crypto)
-> Either
     (VotingCommitteeError crypto EveryoneVotes)
     (EligibilityWitness crypto EveryoneVotes,
      VoteVerificationKey crypto)
forall a. a -> Either (VotingCommitteeError crypto EveryoneVotes) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
                    ( SeatIndex
-> NonZero LedgerStake -> EligibilityWitness crypto EveryoneVotes
forall crypto.
SeatIndex
-> NonZero LedgerStake -> EligibilityWitness crypto EveryoneVotes
EveryoneVotesMember
                        SeatIndex
seatIndex
                        NonZero LedgerStake
nonZeroVoterStake
                    , VoteVerificationKey crypto
voterVerificationKey
                    )
          | Bool
otherwise ->
              VotingCommitteeError crypto EveryoneVotes
-> Either
     (VotingCommitteeError crypto EveryoneVotes)
     (EligibilityWitness crypto EveryoneVotes,
      VoteVerificationKey crypto)
forall a b. a -> Either a b
Left (SeatIndex -> VotingCommitteeError crypto EveryoneVotes
forall crypto.
SeatIndex -> VotingCommitteeError crypto EveryoneVotes
MissingSeatIndex SeatIndex
seatIndex)
    -- Verify aggregate signature
    aggVerificationKey <-
      bimap CryptoError id $ do
        aggregateVoteVerificationKeys
          (Proxy @crypto)
          voteVerificationKeys
    bimap InvalidCertSignature id $
      verifyAggregateVoteSignature
        (Proxy @crypto)
        aggVerificationKey
        electionId
        candidate
        aggSig

    -- Return the list of voters attesting the election winner
    pure members