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

-- | Weighted Fait-Accompli with Local Sortition (wFA^LS) committee selection.
--
-- This module implements a generic committee selection scheme based the on
-- Weighted Fait-Accompli with Local Sortition (wFA^LS) algorithm
-- from the paper:
--
-- Peter Gaži, Aggelos Kiayias, and Alexander Russell. 2023. Fait Accompli
-- Committee Selection: Improving the Size-Security Tradeoff of Stake-Based
-- Committees. In Proceedings of the 2023 ACM SIGSAC Conference on Computer and
-- Communications Security (CCS '23). Association for Computing Machinery, New
-- York, NY, USA, 845–858. https://doi.org/10.1145/3576915.3623194
--
-- PDF: https://eprint.iacr.org/2023/1273.pdf
--
-- For this, we combine the deterministic portion of the weighted Fait-Accompli
-- scheme (defined in @Ouroboros.Consensus.Committee.WFA@) with local sortition
-- (defined in @Ouroboros.Consensus.Committee.LS@) as a fallback scheme.
module Ouroboros.Consensus.Committee.WFALS
  ( -- * Voting committee interface
    WFALS
  , VotingCommittee -- VotingCommittee internals are not exported
  , VotingCommitteeInput (..)
  , VotingCommitteeError (..)
  , EligibilityWitness (..)
  , Vote (..)
  , Cert (..)

    -- * Metrics about the voting committee composition
  , candidateSeats
  , persistentCommitteeSize
  , nonPersistentCommitteeSize
  , totalPersistentStake
  , totalNonPersistentStake
  ) where

import Cardano.Ledger.BaseTypes (NonZero (..), Nonce, nonZero)
import Control.Monad (void)
import Control.Monad.Zip (MonadZip (..))
import qualified Data.Array as Array
import Data.Bifunctor (Bifunctor (..))
import Data.Containers.NonEmpty (HasNonEmpty (..))
import Data.Data (Proxy (..))
import Data.List.NonEmpty (NonEmpty (..))
import qualified Data.List.NonEmpty as NonEmpty
import qualified Data.Map.NonEmpty as NEMap
import Data.Map.Strict (Map)
import qualified Data.Map.Strict as Map
import Data.Maybe (catMaybes)
import Ouroboros.Consensus.Committee.Class
  ( CryptoSupportsVotingCommittee (..)
  , UniqueVotesWithSameTarget
  , getElectionIdFromVotes
  , getRawVotes
  , getVoteCandidateFromVotes
  )
import Ouroboros.Consensus.Committee.Crypto
  ( CryptoSupportsAggregateVoteSigning (..)
  , CryptoSupportsBatchVRFVerification (..)
  , CryptoSupportsVRF (..)
  , CryptoSupportsVoteSigning (..)
  , ElectionId
  , PrivateKey
  , PublicKey
  , VRFPoolContext (..)
  , VoteCandidate
  )
import Ouroboros.Consensus.Committee.LS
  ( LocalSortitionNumSeats (..)
  , localSortitionNumSeats
  )
import Ouroboros.Consensus.Committee.Types
  ( Cumulative (..)
  , LedgerStake (..)
  , PoolId
  , TargetCommitteeSize (..)
  , VoteWeight (..)
  )
import Ouroboros.Consensus.Committee.WFA
  ( ExtWFAStakeDistr (..)
  , NonPersistentCommitteeSize
  , PersistentCommitteeSize (..)
  , SeatIndex (..)
  , TotalNonPersistentStake (..)
  , TotalPersistentStake
  , WFAError
  , getCandidateIfSeatWithinBounds
  , unsafeGetCandidateInSeat
  , weightedFaitAccompliSplitSeats
  )

-- | Tag for weighted Fait-Accompli with Local Sortition (wFA^LS)
data WFALS

instance
  ( CryptoSupportsAggregateVoteSigning crypto
  , CryptoSupportsBatchVRFVerification crypto
  ) =>
  CryptoSupportsVotingCommittee crypto WFALS
  where
  -- According to the weighted Fait-Accompli committee selection scheme, voting
  -- committees are composed of two parts:
  --  1. a deterministic set of "persistent" members that are assigned at the
  --   beginning of the epoch according to the weighted Fait-Accompli scheme, and
  --  2. a non-deterministic set of "non-persistent" members that are selected on
  --   each election within such epoch via local sortition among the candidates
  --   that were not granted a persistent seat.
  --
  -- Due to 1., this interface is temporarily anchored to a given epoch, allowing
  -- us partially apply much of the relevant information about the committee
  -- composition at the beginning of such epoch.
  data VotingCommittee crypto WFALS
    = WFALSVotingCommittee
    { -- Preaccumulated stake distribution used to compute committee composition
      forall crypto.
VotingCommittee crypto WFALS -> ExtWFAStakeDistr (PublicKey crypto)
extWFAStakeDistr :: !(ExtWFAStakeDistr (PublicKey crypto))
    , -- Index of a given candidate in the cumulative stake distribution
      forall crypto. VotingCommittee crypto WFALS -> Map PoolId SeatIndex
candidateSeats :: !(Map PoolId SeatIndex)
    , -- Number of persistent seats granted by the weighted Fait-Accompli scheme
      forall crypto.
VotingCommittee crypto WFALS -> PersistentCommitteeSize
persistentCommitteeSize :: !PersistentCommitteeSize
    , -- Expected number of non-persistent voters
      forall crypto.
VotingCommittee crypto WFALS -> NonPersistentCommitteeSize
nonPersistentCommitteeSize :: !NonPersistentCommitteeSize
    , --  Total stake of persistent voters
      forall crypto. VotingCommittee crypto WFALS -> TotalPersistentStake
totalPersistentStake :: !TotalPersistentStake
    , -- Total stake of non-persistent voters
      forall crypto.
VotingCommittee crypto WFALS -> TotalNonPersistentStake
totalNonPersistentStake :: !TotalNonPersistentStake
    , --  Epoch nonce of the epoch where this committee selection takes place
      forall crypto. VotingCommittee crypto WFALS -> Nonce
epochNonce :: !Nonce
    }

  data VotingCommitteeInput crypto WFALS
    = WFALSVotingCommitteeInput
        -- Epoch nonce for the epoch where this voting committee takes place
        !Nonce
        -- Expected committee size for this voting committee
        !TargetCommitteeSize
        -- Extended cumulative stake distribution of the potential voters
        !(ExtWFAStakeDistr (PublicKey crypto))

  data VotingCommitteeError crypto WFALS
    = -- An error occurred during the computation of the committee selection
      WFAError WFAError
    | -- Pool ID is missing from the voting committee
      MissingPoolId PoolId
    | -- Voter claims to be a persistent member of the committee, but it's not
      NotAPersistentMember SeatIndex
    | -- Voter claims to be a non-persistent member of the committee, but it's not
      NotANonPersistentMember SeatIndex
    | -- The VRF evaluation returned zero non-persistent seats
      ZeroNonPersistentSeats SeatIndex
    | -- The vote signature is invalid
      InvalidVoteSignature String
    | -- The voter eligibility is invalid
      InvalidVoterEligibilityProof String
    | -- The certificate signature is invalid
      InvalidCertSignature String
    | -- We triggered an unexpected cryptographic error
      CryptoError String
    deriving (Int -> VotingCommitteeError crypto WFALS -> ShowS
[VotingCommitteeError crypto WFALS] -> ShowS
VotingCommitteeError crypto WFALS -> String
(Int -> VotingCommitteeError crypto WFALS -> ShowS)
-> (VotingCommitteeError crypto WFALS -> String)
-> ([VotingCommitteeError crypto WFALS] -> ShowS)
-> Show (VotingCommitteeError crypto WFALS)
forall crypto. Int -> VotingCommitteeError crypto WFALS -> ShowS
forall crypto. [VotingCommitteeError crypto WFALS] -> ShowS
forall crypto. VotingCommitteeError crypto WFALS -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall crypto. Int -> VotingCommitteeError crypto WFALS -> ShowS
showsPrec :: Int -> VotingCommitteeError crypto WFALS -> ShowS
$cshow :: forall crypto. VotingCommitteeError crypto WFALS -> String
show :: VotingCommitteeError crypto WFALS -> String
$cshowList :: forall crypto. [VotingCommitteeError crypto WFALS] -> ShowS
showList :: [VotingCommitteeError crypto WFALS] -> ShowS
Show, VotingCommitteeError crypto WFALS
-> VotingCommitteeError crypto WFALS -> Bool
(VotingCommitteeError crypto WFALS
 -> VotingCommitteeError crypto WFALS -> Bool)
-> (VotingCommitteeError crypto WFALS
    -> VotingCommitteeError crypto WFALS -> Bool)
-> Eq (VotingCommitteeError crypto WFALS)
forall crypto.
VotingCommitteeError crypto WFALS
-> VotingCommitteeError crypto WFALS -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall crypto.
VotingCommitteeError crypto WFALS
-> VotingCommitteeError crypto WFALS -> Bool
== :: VotingCommitteeError crypto WFALS
-> VotingCommitteeError crypto WFALS -> Bool
$c/= :: forall crypto.
VotingCommitteeError crypto WFALS
-> VotingCommitteeError crypto WFALS -> Bool
/= :: VotingCommitteeError crypto WFALS
-> VotingCommitteeError crypto WFALS -> Bool
Eq)

  data EligibilityWitness crypto WFALS
    = -- A persistent member of the voting committee
      WFALSPersistentMember
        !SeatIndex
        !LedgerStake
    | -- A realized non-persistent member of the voting committee
      WFALSNonPersistentMember
        !SeatIndex
        !LedgerStake
        !(VRFOutput crypto)
        !(NonZero LocalSortitionNumSeats)

  data Vote crypto WFALS
    = WFALSPersistentVote
        !SeatIndex
        !(ElectionId crypto)
        !(VoteCandidate crypto)
        !(VoteSignature crypto)
    | WFALSNonPersistentVote
        !SeatIndex
        !(ElectionId crypto)
        !(VoteCandidate crypto)
        !(VRFOutput crypto)
        !(VoteSignature crypto)

  data Cert crypto WFALS
    = WFALSCert
        !(ElectionId crypto)
        !(VoteCandidate crypto)
        !(NE (Map SeatIndex (Maybe (VRFOutput crypto))))
        !(AggregateVoteSignature crypto)

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

-- | Construct a 'WFALSVotingCommittee' for a given epoch
mkWFALSVotingCommittee ::
  VotingCommitteeInput crypto WFALS ->
  Either
    (VotingCommitteeError crypto WFALS)
    (VotingCommittee crypto WFALS)
mkWFALSVotingCommittee :: forall crypto.
VotingCommitteeInput crypto WFALS
-> Either
     (VotingCommitteeError crypto WFALS) (VotingCommittee crypto WFALS)
mkWFALSVotingCommittee
  ( WFALSVotingCommitteeInput
      Nonce
nonce
      TargetCommitteeSize
totalSeats
      ExtWFAStakeDistr (PublicKey crypto)
stakeDistr
    ) = do
    ( numPersistentVoters
      , numNonPersistentVoters
      , persistentStake
      , nonPersistentStake
      ) <-
      (WFAError -> VotingCommitteeError crypto WFALS)
-> ((PersistentCommitteeSize, NonPersistentCommitteeSize,
     TotalPersistentStake, TotalNonPersistentStake)
    -> (PersistentCommitteeSize, NonPersistentCommitteeSize,
        TotalPersistentStake, TotalNonPersistentStake))
-> Either
     WFAError
     (PersistentCommitteeSize, NonPersistentCommitteeSize,
      TotalPersistentStake, TotalNonPersistentStake)
-> Either
     (VotingCommitteeError crypto WFALS)
     (PersistentCommitteeSize, NonPersistentCommitteeSize,
      TotalPersistentStake, TotalNonPersistentStake)
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 WFAError -> VotingCommitteeError crypto WFALS
forall crypto. WFAError -> VotingCommitteeError crypto WFALS
WFAError (PersistentCommitteeSize, NonPersistentCommitteeSize,
 TotalPersistentStake, TotalNonPersistentStake)
-> (PersistentCommitteeSize, NonPersistentCommitteeSize,
    TotalPersistentStake, TotalNonPersistentStake)
forall a. a -> a
id (Either
   WFAError
   (PersistentCommitteeSize, NonPersistentCommitteeSize,
    TotalPersistentStake, TotalNonPersistentStake)
 -> Either
      (VotingCommitteeError crypto WFALS)
      (PersistentCommitteeSize, NonPersistentCommitteeSize,
       TotalPersistentStake, TotalNonPersistentStake))
-> Either
     WFAError
     (PersistentCommitteeSize, NonPersistentCommitteeSize,
      TotalPersistentStake, TotalNonPersistentStake)
-> Either
     (VotingCommitteeError crypto WFALS)
     (PersistentCommitteeSize, NonPersistentCommitteeSize,
      TotalPersistentStake, TotalNonPersistentStake)
forall a b. (a -> b) -> a -> b
$
        ExtWFAStakeDistr (PublicKey crypto)
-> TargetCommitteeSize
-> Either
     WFAError
     (PersistentCommitteeSize, NonPersistentCommitteeSize,
      TotalPersistentStake, TotalNonPersistentStake)
forall c.
ExtWFAStakeDistr c
-> TargetCommitteeSize
-> Either
     WFAError
     (PersistentCommitteeSize, NonPersistentCommitteeSize,
      TotalPersistentStake, TotalNonPersistentStake)
weightedFaitAccompliSplitSeats
          ExtWFAStakeDistr (PublicKey crypto)
stakeDistr
          TargetCommitteeSize
totalSeats

    let seats =
          [(PoolId, SeatIndex)] -> Map PoolId SeatIndex
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
            [ (PoolId
poolId, SeatIndex
seatIndex)
            | (SeatIndex
seatIndex, (PoolId
poolId, PublicKey crypto
_, LedgerStake
_, Cumulative LedgerStake
_)) <-
                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 (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)
stakeDistr)
            ]

    pure $
      WFALSVotingCommittee
        { extWFAStakeDistr = stakeDistr
        , candidateSeats = seats
        , persistentCommitteeSize = numPersistentVoters
        , nonPersistentCommitteeSize = numNonPersistentVoters
        , totalPersistentStake = persistentStake
        , totalNonPersistentStake = nonPersistentStake
        , epochNonce = nonce
        }

-- | Check whether we should vote in a given election
implCheckShouldVote ::
  forall crypto.
  CryptoSupportsVRF crypto =>
  VotingCommittee crypto WFALS ->
  PoolId ->
  PrivateKey crypto ->
  ElectionId crypto ->
  Either
    (VotingCommitteeError crypto WFALS)
    (Maybe (EligibilityWitness crypto WFALS))
implCheckShouldVote :: forall crypto.
CryptoSupportsVRF crypto =>
VotingCommittee crypto WFALS
-> PoolId
-> PrivateKey crypto
-> ElectionId crypto
-> Either
     (VotingCommitteeError crypto WFALS)
     (Maybe (EligibilityWitness crypto WFALS))
implCheckShouldVote VotingCommittee crypto WFALS
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 WFALS -> Map PoolId SeatIndex
forall crypto. VotingCommittee crypto WFALS -> Map PoolId SeatIndex
candidateSeats VotingCommittee crypto WFALS
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 WFALS -> ExtWFAStakeDistr (PublicKey crypto)
forall crypto.
VotingCommittee crypto WFALS -> ExtWFAStakeDistr (PublicKey crypto)
extWFAStakeDistr VotingCommittee crypto WFALS
committee)
      let ourVRFSigningKey :: VRFSigningKey crypto
ourVRFSigningKey =
            Proxy crypto -> PrivateKey crypto -> VRFSigningKey crypto
forall crypto.
CryptoSupportsVRF crypto =>
Proxy crypto -> PrivateKey crypto -> VRFSigningKey crypto
getVRFSigningKey (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @crypto) PrivateKey crypto
ourPrivateKey
      case SeatIndex -> VotingCommittee crypto WFALS -> Bool
forall crypto. SeatIndex -> VotingCommittee crypto WFALS -> Bool
isPersistentMember SeatIndex
seatIndex VotingCommittee crypto WFALS
committee of
        Bool
True -> do
          Maybe (EligibilityWitness crypto WFALS)
-> Either
     (VotingCommitteeError crypto WFALS)
     (Maybe (EligibilityWitness crypto WFALS))
forall a. a -> Either (VotingCommitteeError crypto WFALS) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (EligibilityWitness crypto WFALS)
 -> Either
      (VotingCommitteeError crypto WFALS)
      (Maybe (EligibilityWitness crypto WFALS)))
-> Maybe (EligibilityWitness crypto WFALS)
-> Either
     (VotingCommitteeError crypto WFALS)
     (Maybe (EligibilityWitness crypto WFALS))
forall a b. (a -> b) -> a -> b
$
            EligibilityWitness crypto WFALS
-> Maybe (EligibilityWitness crypto WFALS)
forall a. a -> Maybe a
Just (EligibilityWitness crypto WFALS
 -> Maybe (EligibilityWitness crypto WFALS))
-> EligibilityWitness crypto WFALS
-> Maybe (EligibilityWitness crypto WFALS)
forall a b. (a -> b) -> a -> b
$
              SeatIndex -> LedgerStake -> EligibilityWitness crypto WFALS
forall crypto.
SeatIndex -> LedgerStake -> EligibilityWitness crypto WFALS
WFALSPersistentMember
                SeatIndex
seatIndex
                LedgerStake
ourStake
        Bool
False -> do
          let vrfContext :: VRFPoolContext crypto
vrfContext =
                VRFSigningKey crypto -> VRFPoolContext crypto
forall crypto. VRFSigningKey crypto -> VRFPoolContext crypto
VRFSignContext VRFSigningKey crypto
ourVRFSigningKey
          vrfOutput <-
            -- Here we are using @evalVRF@ to compute our own VRF output. If
            -- that fails, it means something went wrong on the crypto side.
            (String -> VotingCommitteeError crypto WFALS)
-> (VRFOutput crypto -> VRFOutput crypto)
-> Either String (VRFOutput crypto)
-> Either (VotingCommitteeError crypto WFALS) (VRFOutput 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 WFALS
forall crypto. String -> VotingCommitteeError crypto WFALS
CryptoError VRFOutput crypto -> VRFOutput crypto
forall a. a -> a
id (Either String (VRFOutput crypto)
 -> Either (VotingCommitteeError crypto WFALS) (VRFOutput crypto))
-> Either String (VRFOutput crypto)
-> Either (VotingCommitteeError crypto WFALS) (VRFOutput crypto)
forall a b. (a -> b) -> a -> b
$ do
              VRFPoolContext crypto
-> VRFElectionInput crypto -> Either String (VRFOutput crypto)
forall crypto.
CryptoSupportsVRF crypto =>
VRFPoolContext crypto
-> VRFElectionInput crypto -> Either String (VRFOutput crypto)
evalVRF
                VRFPoolContext crypto
vrfContext
                ( forall crypto.
CryptoSupportsVRF crypto =>
Nonce -> ElectionId crypto -> VRFElectionInput crypto
mkVRFElectionInput
                    @crypto
                    (VotingCommittee crypto WFALS -> Nonce
forall crypto. VotingCommittee crypto WFALS -> Nonce
epochNonce VotingCommittee crypto WFALS
committee)
                    ElectionId crypto
electionId
                )
          let numSeats =
                NonPersistentCommitteeSize
-> TotalNonPersistentStake
-> LedgerStake
-> NormalizedVRFOutput
-> LocalSortitionNumSeats
localSortitionNumSeats
                  (VotingCommittee crypto WFALS -> NonPersistentCommitteeSize
forall crypto.
VotingCommittee crypto WFALS -> NonPersistentCommitteeSize
nonPersistentCommitteeSize VotingCommittee crypto WFALS
committee)
                  (VotingCommittee crypto WFALS -> TotalNonPersistentStake
forall crypto.
VotingCommittee crypto WFALS -> TotalNonPersistentStake
totalNonPersistentStake VotingCommittee crypto WFALS
committee)
                  LedgerStake
ourStake
                  (VRFOutput crypto -> NormalizedVRFOutput
forall crypto.
CryptoSupportsVRF crypto =>
VRFOutput crypto -> NormalizedVRFOutput
normalizeVRFOutput VRFOutput crypto
vrfOutput)
          case nonZero numSeats of
            Maybe (NonZero LocalSortitionNumSeats)
Nothing ->
              Maybe (EligibilityWitness crypto WFALS)
-> Either
     (VotingCommitteeError crypto WFALS)
     (Maybe (EligibilityWitness crypto WFALS))
forall a. a -> Either (VotingCommitteeError crypto WFALS) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (EligibilityWitness crypto WFALS)
forall a. Maybe a
Nothing
            Just NonZero LocalSortitionNumSeats
nonZeroNumSeats ->
              Maybe (EligibilityWitness crypto WFALS)
-> Either
     (VotingCommitteeError crypto WFALS)
     (Maybe (EligibilityWitness crypto WFALS))
forall a. a -> Either (VotingCommitteeError crypto WFALS) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (EligibilityWitness crypto WFALS)
 -> Either
      (VotingCommitteeError crypto WFALS)
      (Maybe (EligibilityWitness crypto WFALS)))
-> Maybe (EligibilityWitness crypto WFALS)
-> Either
     (VotingCommitteeError crypto WFALS)
     (Maybe (EligibilityWitness crypto WFALS))
forall a b. (a -> b) -> a -> b
$
                EligibilityWitness crypto WFALS
-> Maybe (EligibilityWitness crypto WFALS)
forall a. a -> Maybe a
Just (EligibilityWitness crypto WFALS
 -> Maybe (EligibilityWitness crypto WFALS))
-> EligibilityWitness crypto WFALS
-> Maybe (EligibilityWitness crypto WFALS)
forall a b. (a -> b) -> a -> b
$
                  SeatIndex
-> LedgerStake
-> VRFOutput crypto
-> NonZero LocalSortitionNumSeats
-> EligibilityWitness crypto WFALS
forall crypto.
SeatIndex
-> LedgerStake
-> VRFOutput crypto
-> NonZero LocalSortitionNumSeats
-> EligibilityWitness crypto WFALS
WFALSNonPersistentMember
                    SeatIndex
seatIndex
                    LedgerStake
ourStake
                    VRFOutput crypto
vrfOutput
                    NonZero LocalSortitionNumSeats
nonZeroNumSeats
  | Bool
otherwise =
      VotingCommitteeError crypto WFALS
-> Either
     (VotingCommitteeError crypto WFALS)
     (Maybe (EligibilityWitness crypto WFALS))
forall a b. a -> Either a b
Left (PoolId -> VotingCommitteeError crypto WFALS
forall crypto. PoolId -> VotingCommitteeError crypto WFALS
MissingPoolId PoolId
ourId)

-- | Forge a vote for a given election and candidate
implForgeVote ::
  forall crypto.
  CryptoSupportsVoteSigning crypto =>
  EligibilityWitness crypto WFALS ->
  PrivateKey crypto ->
  ElectionId crypto ->
  VoteCandidate crypto ->
  Vote crypto WFALS
implForgeVote :: forall crypto.
CryptoSupportsVoteSigning crypto =>
EligibilityWitness crypto WFALS
-> PrivateKey crypto
-> ElectionId crypto
-> VoteCandidate crypto
-> Vote crypto WFALS
implForgeVote EligibilityWitness crypto WFALS
member PrivateKey crypto
ourPrivateKey ElectionId crypto
electionId VoteCandidate crypto
candidate =
  case EligibilityWitness crypto WFALS
member of
    WFALSPersistentMember SeatIndex
seatIndex LedgerStake
_ ->
      SeatIndex
-> ElectionId crypto
-> VoteCandidate crypto
-> VoteSignature crypto
-> Vote crypto WFALS
forall crypto.
SeatIndex
-> ElectionId crypto
-> VoteCandidate crypto
-> VoteSignature crypto
-> Vote crypto WFALS
WFALSPersistentVote SeatIndex
seatIndex ElectionId crypto
electionId VoteCandidate crypto
candidate VoteSignature crypto
sig
    WFALSNonPersistentMember SeatIndex
seatIndex LedgerStake
_ VRFOutput crypto
vrfOutput NonZero LocalSortitionNumSeats
_ ->
      SeatIndex
-> ElectionId crypto
-> VoteCandidate crypto
-> VRFOutput crypto
-> VoteSignature crypto
-> Vote crypto WFALS
forall crypto.
SeatIndex
-> ElectionId crypto
-> VoteCandidate crypto
-> VRFOutput crypto
-> VoteSignature crypto
-> Vote crypto WFALS
WFALSNonPersistentVote SeatIndex
seatIndex ElectionId crypto
electionId VoteCandidate crypto
candidate VRFOutput crypto
vrfOutput VoteSignature crypto
sig
 where
  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
  , CryptoSupportsVRF crypto
  ) =>
  VotingCommittee crypto WFALS ->
  Vote crypto WFALS ->
  Either
    (VotingCommitteeError crypto WFALS)
    (EligibilityWitness crypto WFALS)
implVerifyVote :: forall crypto.
(CryptoSupportsVoteSigning crypto, CryptoSupportsVRF crypto) =>
VotingCommittee crypto WFALS
-> Vote crypto WFALS
-> Either
     (VotingCommitteeError crypto WFALS)
     (EligibilityWitness crypto WFALS)
implVerifyVote VotingCommittee crypto WFALS
committee = \case
  WFALSPersistentVote 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 WFALS -> ExtWFAStakeDistr (PublicKey crypto)
forall crypto.
VotingCommittee crypto WFALS -> ExtWFAStakeDistr (PublicKey crypto)
extWFAStakeDistr VotingCommittee crypto WFALS
committee)
    , SeatIndex -> VotingCommittee crypto WFALS -> Bool
forall crypto. SeatIndex -> VotingCommittee crypto WFALS -> Bool
isPersistentMember SeatIndex
seatIndex VotingCommittee crypto WFALS
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
        VoteVerificationKey crypto
-> ElectionId crypto
-> VoteCandidate crypto
-> VoteSignature crypto
-> Either (VotingCommitteeError crypto WFALS) ()
forall crypto.
CryptoSupportsVoteSigning crypto =>
VoteVerificationKey crypto
-> ElectionId crypto
-> VoteCandidate crypto
-> VoteSignature crypto
-> Either (VotingCommitteeError crypto WFALS) ()
checkVoteSignature VoteVerificationKey crypto
voterVerificationKey ElectionId crypto
electionId VoteCandidate crypto
candidate VoteSignature crypto
sig
        EligibilityWitness crypto WFALS
-> Either
     (VotingCommitteeError crypto WFALS)
     (EligibilityWitness crypto WFALS)
forall a. a -> Either (VotingCommitteeError crypto WFALS) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (EligibilityWitness crypto WFALS
 -> Either
      (VotingCommitteeError crypto WFALS)
      (EligibilityWitness crypto WFALS))
-> EligibilityWitness crypto WFALS
-> Either
     (VotingCommitteeError crypto WFALS)
     (EligibilityWitness crypto WFALS)
forall a b. (a -> b) -> a -> b
$
          SeatIndex -> LedgerStake -> EligibilityWitness crypto WFALS
forall crypto.
SeatIndex -> LedgerStake -> EligibilityWitness crypto WFALS
WFALSPersistentMember
            SeatIndex
seatIndex
            LedgerStake
voterStake
    | Bool
otherwise -> do
        VotingCommitteeError crypto WFALS
-> Either
     (VotingCommitteeError crypto WFALS)
     (EligibilityWitness crypto WFALS)
forall a b. a -> Either a b
Left (SeatIndex -> VotingCommitteeError crypto WFALS
forall crypto. SeatIndex -> VotingCommitteeError crypto WFALS
NotAPersistentMember SeatIndex
seatIndex)
  WFALSNonPersistentVote SeatIndex
seatIndex ElectionId crypto
electionId VoteCandidate crypto
message VRFOutput crypto
vrfOutput 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 WFALS -> ExtWFAStakeDistr (PublicKey crypto)
forall crypto.
VotingCommittee crypto WFALS -> ExtWFAStakeDistr (PublicKey crypto)
extWFAStakeDistr VotingCommittee crypto WFALS
committee)
    , Bool -> Bool
not (SeatIndex -> VotingCommittee crypto WFALS -> Bool
forall crypto. SeatIndex -> VotingCommittee crypto WFALS -> Bool
isPersistentMember SeatIndex
seatIndex VotingCommittee crypto WFALS
committee) -> do
        let voterVoteVerificationKey :: VoteVerificationKey crypto
voterVoteVerificationKey =
              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 WFALS)
-> (() -> ())
-> Either String ()
-> Either (VotingCommitteeError crypto WFALS) ()
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 WFALS
forall crypto. String -> VotingCommitteeError crypto WFALS
InvalidVoteSignature () -> ()
forall a. a -> a
id (Either String () -> Either (VotingCommitteeError crypto WFALS) ())
-> Either String ()
-> Either (VotingCommitteeError crypto WFALS) ()
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
voterVoteVerificationKey
            ElectionId crypto
electionId
            VoteCandidate crypto
message
            VoteSignature crypto
sig
        let voterVRFVerificationKey :: VRFVerificationKey crypto
voterVRFVerificationKey =
              Proxy crypto -> PublicKey crypto -> VRFVerificationKey crypto
forall crypto.
CryptoSupportsVRF crypto =>
Proxy crypto -> PublicKey crypto -> VRFVerificationKey crypto
getVRFVerificationKey (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @crypto) PublicKey crypto
voterPublicKey
        let vrfContext :: VRFPoolContext crypto
vrfContext =
              VRFVerificationKey crypto
-> VRFOutput crypto -> VRFPoolContext crypto
forall crypto.
VRFVerificationKey crypto
-> VRFOutput crypto -> VRFPoolContext crypto
VRFVerifyContext VRFVerificationKey crypto
voterVRFVerificationKey VRFOutput crypto
vrfOutput
        Either (VotingCommitteeError crypto WFALS) (VRFOutput crypto)
-> Either (VotingCommitteeError crypto WFALS) ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Either (VotingCommitteeError crypto WFALS) (VRFOutput crypto)
 -> Either (VotingCommitteeError crypto WFALS) ())
-> Either (VotingCommitteeError crypto WFALS) (VRFOutput crypto)
-> Either (VotingCommitteeError crypto WFALS) ()
forall a b. (a -> b) -> a -> b
$ (String -> VotingCommitteeError crypto WFALS)
-> (VRFOutput crypto -> VRFOutput crypto)
-> Either String (VRFOutput crypto)
-> Either (VotingCommitteeError crypto WFALS) (VRFOutput 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 WFALS
forall crypto. String -> VotingCommitteeError crypto WFALS
InvalidVoterEligibilityProof VRFOutput crypto -> VRFOutput crypto
forall a. a -> a
id (Either String (VRFOutput crypto)
 -> Either (VotingCommitteeError crypto WFALS) (VRFOutput crypto))
-> Either String (VRFOutput crypto)
-> Either (VotingCommitteeError crypto WFALS) (VRFOutput crypto)
forall a b. (a -> b) -> a -> b
$ do
          VRFPoolContext crypto
-> VRFElectionInput crypto -> Either String (VRFOutput crypto)
forall crypto.
CryptoSupportsVRF crypto =>
VRFPoolContext crypto
-> VRFElectionInput crypto -> Either String (VRFOutput crypto)
evalVRF
            VRFPoolContext crypto
vrfContext
            ( forall crypto.
CryptoSupportsVRF crypto =>
Nonce -> ElectionId crypto -> VRFElectionInput crypto
mkVRFElectionInput
                @crypto
                (VotingCommittee crypto WFALS -> Nonce
forall crypto. VotingCommittee crypto WFALS -> Nonce
epochNonce VotingCommittee crypto WFALS
committee)
                ElectionId crypto
electionId
            )
        let numSeats :: LocalSortitionNumSeats
numSeats =
              NonPersistentCommitteeSize
-> TotalNonPersistentStake
-> LedgerStake
-> NormalizedVRFOutput
-> LocalSortitionNumSeats
localSortitionNumSeats
                (VotingCommittee crypto WFALS -> NonPersistentCommitteeSize
forall crypto.
VotingCommittee crypto WFALS -> NonPersistentCommitteeSize
nonPersistentCommitteeSize VotingCommittee crypto WFALS
committee)
                (VotingCommittee crypto WFALS -> TotalNonPersistentStake
forall crypto.
VotingCommittee crypto WFALS -> TotalNonPersistentStake
totalNonPersistentStake VotingCommittee crypto WFALS
committee)
                LedgerStake
voterStake
                (VRFOutput crypto -> NormalizedVRFOutput
forall crypto.
CryptoSupportsVRF crypto =>
VRFOutput crypto -> NormalizedVRFOutput
normalizeVRFOutput VRFOutput crypto
vrfOutput)
        case LocalSortitionNumSeats -> Maybe (NonZero LocalSortitionNumSeats)
forall a. HasZero a => a -> Maybe (NonZero a)
nonZero LocalSortitionNumSeats
numSeats of
          Maybe (NonZero LocalSortitionNumSeats)
Nothing ->
            VotingCommitteeError crypto WFALS
-> Either
     (VotingCommitteeError crypto WFALS)
     (EligibilityWitness crypto WFALS)
forall a b. a -> Either a b
Left (SeatIndex -> VotingCommitteeError crypto WFALS
forall crypto. SeatIndex -> VotingCommitteeError crypto WFALS
ZeroNonPersistentSeats SeatIndex
seatIndex)
          Just NonZero LocalSortitionNumSeats
nonZeroNumSeats ->
            EligibilityWitness crypto WFALS
-> Either
     (VotingCommitteeError crypto WFALS)
     (EligibilityWitness crypto WFALS)
forall a. a -> Either (VotingCommitteeError crypto WFALS) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (EligibilityWitness crypto WFALS
 -> Either
      (VotingCommitteeError crypto WFALS)
      (EligibilityWitness crypto WFALS))
-> EligibilityWitness crypto WFALS
-> Either
     (VotingCommitteeError crypto WFALS)
     (EligibilityWitness crypto WFALS)
forall a b. (a -> b) -> a -> b
$
              SeatIndex
-> LedgerStake
-> VRFOutput crypto
-> NonZero LocalSortitionNumSeats
-> EligibilityWitness crypto WFALS
forall crypto.
SeatIndex
-> LedgerStake
-> VRFOutput crypto
-> NonZero LocalSortitionNumSeats
-> EligibilityWitness crypto WFALS
WFALSNonPersistentMember
                SeatIndex
seatIndex
                LedgerStake
voterStake
                VRFOutput crypto
vrfOutput
                NonZero LocalSortitionNumSeats
nonZeroNumSeats
    | Bool
otherwise ->
        VotingCommitteeError crypto WFALS
-> Either
     (VotingCommitteeError crypto WFALS)
     (EligibilityWitness crypto WFALS)
forall a b. a -> Either a b
Left (SeatIndex -> VotingCommitteeError crypto WFALS
forall crypto. SeatIndex -> VotingCommitteeError crypto WFALS
NotANonPersistentMember SeatIndex
seatIndex)

-- | Compute the voting power of an eligible committee member
--
-- NOTE: there is a subtle difference between the "Ledger stake" and the "Vote
-- weight" of a given voter. On one hand, the ledger stake is the stake as
-- reflected directly by the ledger stake distribution under consideration. On
-- the other hand, the "Vote" weight refers to the voting power of that voter,
-- i.e., the stake that a voter can effectively contribute to an election,
-- which might be different from their ledger stake depending on their committee
-- membership type:
--   * for a persistent committee member, their vote weight is equal to their
--     ledger stake throughout their entire tenure in the committee, whereas
--   * for a non-persistent committee member, their vote weight (provided that
--     they are actually selected to vote via local sortition) is equal to their
--     ledger stake normalized by the total non-persistent stake.
implEligiblePartyVoteWeight ::
  VotingCommittee crypto WFALS ->
  EligibilityWitness crypto WFALS ->
  VoteWeight
implEligiblePartyVoteWeight :: forall crypto.
VotingCommittee crypto WFALS
-> EligibilityWitness crypto WFALS -> VoteWeight
implEligiblePartyVoteWeight VotingCommittee crypto WFALS
committee = \case
  -- Persistent members have their voting power equal to their stake
  WFALSPersistentMember
    SeatIndex
_seatIndex
    (LedgerStake Rational
stake) ->
      Rational -> VoteWeight
VoteWeight Rational
stake
  -- Non-persistent members have their voting power proportional to their
  -- number of seats granted by local sortition and their stake (normalized
  -- by the total non-persistent stake)
  WFALSNonPersistentMember
    SeatIndex
_seatIndex
    (LedgerStake Rational
stake)
    VRFOutput crypto
_vrfOutput
    NonZero LocalSortitionNumSeats
numSeats ->
      Rational -> VoteWeight
VoteWeight (Rational -> VoteWeight) -> Rational -> VoteWeight
forall a b. (a -> b) -> a -> b
$
        Word64 -> Rational
forall a b. (Integral a, Num b) => a -> b
fromIntegral (LocalSortitionNumSeats -> Word64
unLocalSortitionNumSeats (NonZero LocalSortitionNumSeats -> LocalSortitionNumSeats
forall a. NonZero a -> a
unNonZero NonZero LocalSortitionNumSeats
numSeats))
          Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
* Rational
stake
          Rational -> Rational -> Rational
forall a. Fractional a => a -> a -> a
/ Rational
nonPersistentStake
     where
      TotalNonPersistentStake (Cumulative (LedgerStake Rational
nonPersistentStake)) =
        VotingCommittee crypto WFALS -> TotalNonPersistentStake
forall crypto.
VotingCommittee crypto WFALS -> TotalNonPersistentStake
totalNonPersistentStake VotingCommittee crypto WFALS
committee

-- | Forge a certificate attesting the winner of a given election
implForgeCert ::
  forall crypto.
  CryptoSupportsAggregateVoteSigning crypto =>
  UniqueVotesWithSameTarget crypto WFALS ->
  Either
    (VotingCommitteeError crypto WFALS)
    (Cert crypto WFALS)
implForgeCert :: forall crypto.
CryptoSupportsAggregateVoteSigning crypto =>
UniqueVotesWithSameTarget crypto WFALS
-> Either (VotingCommitteeError crypto WFALS) (Cert crypto WFALS)
implForgeCert UniqueVotesWithSameTarget crypto WFALS
votes = do
  aggSig <-
    (String -> VotingCommitteeError crypto WFALS)
-> (AggregateVoteSignature crypto -> AggregateVoteSignature crypto)
-> Either String (AggregateVoteSignature crypto)
-> Either
     (VotingCommitteeError crypto WFALS) (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 WFALS
forall crypto. String -> VotingCommitteeError crypto WFALS
CryptoError AggregateVoteSignature crypto -> AggregateVoteSignature crypto
forall a. a -> a
id (Either String (AggregateVoteSignature crypto)
 -> Either
      (VotingCommitteeError crypto WFALS)
      (AggregateVoteSignature crypto))
-> Either String (AggregateVoteSignature crypto)
-> Either
     (VotingCommitteeError crypto WFALS) (AggregateVoteSignature crypto)
forall a b. (a -> b) -> a -> b
$
      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 $
    WFALSCert
      (getElectionIdFromVotes votes)
      (getVoteCandidateFromVotes votes)
      (NEMap.fromAscList voters)
      aggSig
 where
  (NonEmpty (SeatIndex, Maybe (VRFOutput crypto))
voters, NonEmpty (VoteSignature crypto)
voteSignatures) =
    NonEmpty
  ((SeatIndex, Maybe (VRFOutput crypto)), VoteSignature crypto)
-> (NonEmpty (SeatIndex, Maybe (VRFOutput crypto)),
    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, Maybe (VRFOutput crypto)), VoteSignature crypto)
 -> (NonEmpty (SeatIndex, Maybe (VRFOutput crypto)),
     NonEmpty (VoteSignature crypto)))
-> NonEmpty
     ((SeatIndex, Maybe (VRFOutput crypto)), VoteSignature crypto)
-> (NonEmpty (SeatIndex, Maybe (VRFOutput crypto)),
    NonEmpty (VoteSignature crypto))
forall a b. (a -> b) -> a -> b
$ ((Vote crypto WFALS
  -> ((SeatIndex, Maybe (VRFOutput crypto)), VoteSignature crypto))
 -> NonEmpty (Vote crypto WFALS)
 -> NonEmpty
      ((SeatIndex, Maybe (VRFOutput crypto)), VoteSignature crypto))
-> NonEmpty (Vote crypto WFALS)
-> (Vote crypto WFALS
    -> ((SeatIndex, Maybe (VRFOutput crypto)), VoteSignature crypto))
-> NonEmpty
     ((SeatIndex, Maybe (VRFOutput crypto)), VoteSignature crypto)
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Vote crypto WFALS
 -> ((SeatIndex, Maybe (VRFOutput crypto)), VoteSignature crypto))
-> NonEmpty (Vote crypto WFALS)
-> NonEmpty
     ((SeatIndex, Maybe (VRFOutput crypto)), 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 WFALS)
votesInAscendingSeatIndexOrder ((Vote crypto WFALS
  -> ((SeatIndex, Maybe (VRFOutput crypto)), VoteSignature crypto))
 -> NonEmpty
      ((SeatIndex, Maybe (VRFOutput crypto)), VoteSignature crypto))
-> (Vote crypto WFALS
    -> ((SeatIndex, Maybe (VRFOutput crypto)), VoteSignature crypto))
-> NonEmpty
     ((SeatIndex, Maybe (VRFOutput crypto)), VoteSignature crypto)
forall a b. (a -> b) -> a -> b
$ \case
      WFALSPersistentVote SeatIndex
seatIndex ElectionId crypto
_ VoteCandidate crypto
_ VoteSignature crypto
sig ->
        ( (SeatIndex
seatIndex, Maybe (VRFOutput crypto)
forall a. Maybe a
Nothing)
        , VoteSignature crypto
sig
        )
      WFALSNonPersistentVote SeatIndex
seatIndex ElectionId crypto
_ VoteCandidate crypto
_ VRFOutput crypto
vrfOutput VoteSignature crypto
sig ->
        ( (SeatIndex
seatIndex, VRFOutput crypto -> Maybe (VRFOutput crypto)
forall a. a -> Maybe a
Just VRFOutput crypto
vrfOutput)
        , 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 WFALS)
votesInAscendingSeatIndexOrder =
    ((Vote crypto WFALS -> SeatIndex)
 -> NonEmpty (Vote crypto WFALS) -> NonEmpty (Vote crypto WFALS))
-> NonEmpty (Vote crypto WFALS)
-> (Vote crypto WFALS -> SeatIndex)
-> NonEmpty (Vote crypto WFALS)
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Vote crypto WFALS -> SeatIndex)
-> NonEmpty (Vote crypto WFALS) -> NonEmpty (Vote crypto WFALS)
forall o a. Ord o => (a -> o) -> NonEmpty a -> NonEmpty a
NonEmpty.sortWith (UniqueVotesWithSameTarget crypto WFALS -> NE [Vote crypto WFALS]
forall crypto committee.
UniqueVotesWithSameTarget crypto committee
-> NE [Vote crypto committee]
getRawVotes UniqueVotesWithSameTarget crypto WFALS
votes) ((Vote crypto WFALS -> SeatIndex) -> NonEmpty (Vote crypto WFALS))
-> (Vote crypto WFALS -> SeatIndex) -> NonEmpty (Vote crypto WFALS)
forall a b. (a -> b) -> a -> b
$ \case
      WFALSPersistentVote SeatIndex
seatIndex ElectionId crypto
_ VoteCandidate crypto
_ VoteSignature crypto
_ -> SeatIndex
seatIndex
      WFALSNonPersistentVote SeatIndex
seatIndex ElectionId crypto
_ VoteCandidate crypto
_ VRFOutput crypto
_ VoteSignature crypto
_ -> SeatIndex
seatIndex

-- | Verify a certificate attesting the winner of a given election
implVerifyCert ::
  forall crypto.
  ( CryptoSupportsAggregateVoteSigning crypto
  , CryptoSupportsBatchVRFVerification crypto
  ) =>
  VotingCommittee crypto WFALS ->
  Cert crypto WFALS ->
  Either
    (VotingCommitteeError crypto WFALS)
    (NE [EligibilityWitness crypto WFALS])
implVerifyCert :: forall crypto.
(CryptoSupportsAggregateVoteSigning crypto,
 CryptoSupportsBatchVRFVerification crypto) =>
VotingCommittee crypto WFALS
-> Cert crypto WFALS
-> Either
     (VotingCommitteeError crypto WFALS)
     (NE [EligibilityWitness crypto WFALS])
implVerifyCert VotingCommittee crypto WFALS
committee = \case
  WFALSCert ElectionId crypto
electionId VoteCandidate crypto
candidate NE (Map SeatIndex (Maybe (VRFOutput crypto)))
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)
    -- 3. optionally, their VRF verification keys and outputs (to verify the
    --    aggregate VRF output for non-persistent voters, if any)
    (members, voteVerificationKeys, optionalVRFKeysAndOutputs) <-
      (NonEmpty
   (EligibilityWitness crypto WFALS, VoteVerificationKey crypto,
    Maybe (VRFVerificationKey crypto, VRFOutput crypto))
 -> (NonEmpty (EligibilityWitness crypto WFALS),
     NonEmpty (VoteVerificationKey crypto),
     NonEmpty (Maybe (VRFVerificationKey crypto, VRFOutput crypto))))
-> Either
     (VotingCommitteeError crypto WFALS)
     (NonEmpty
        (EligibilityWitness crypto WFALS, VoteVerificationKey crypto,
         Maybe (VRFVerificationKey crypto, VRFOutput crypto)))
-> Either
     (VotingCommitteeError crypto WFALS)
     (NonEmpty (EligibilityWitness crypto WFALS),
      NonEmpty (VoteVerificationKey crypto),
      NonEmpty (Maybe (VRFVerificationKey crypto, VRFOutput crypto)))
forall a b.
(a -> b)
-> Either (VotingCommitteeError crypto WFALS) a
-> Either (VotingCommitteeError crypto WFALS) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap NonEmpty
  (EligibilityWitness crypto WFALS, VoteVerificationKey crypto,
   Maybe (VRFVerificationKey crypto, VRFOutput crypto))
-> (NonEmpty (EligibilityWitness crypto WFALS),
    NonEmpty (VoteVerificationKey crypto),
    NonEmpty (Maybe (VRFVerificationKey crypto, VRFOutput crypto)))
NE
  [(EligibilityWitness crypto WFALS, VoteVerificationKey crypto,
    Maybe (VRFVerificationKey crypto, VRFOutput crypto))]
-> (NE [EligibilityWitness crypto WFALS],
    NE [VoteVerificationKey crypto],
    NE [Maybe (VRFVerificationKey crypto, VRFOutput crypto)])
forall a b c. NE [(a, b, c)] -> (NE [a], NE [b], NE [c])
nonEmptyUnzip3 (Either
   (VotingCommitteeError crypto WFALS)
   (NonEmpty
      (EligibilityWitness crypto WFALS, VoteVerificationKey crypto,
       Maybe (VRFVerificationKey crypto, VRFOutput crypto)))
 -> Either
      (VotingCommitteeError crypto WFALS)
      (NonEmpty (EligibilityWitness crypto WFALS),
       NonEmpty (VoteVerificationKey crypto),
       NonEmpty (Maybe (VRFVerificationKey crypto, VRFOutput crypto))))
-> (((SeatIndex, Maybe (VRFOutput crypto))
     -> Either
          (VotingCommitteeError crypto WFALS)
          (EligibilityWitness crypto WFALS, VoteVerificationKey crypto,
           Maybe (VRFVerificationKey crypto, VRFOutput crypto)))
    -> Either
         (VotingCommitteeError crypto WFALS)
         (NonEmpty
            (EligibilityWitness crypto WFALS, VoteVerificationKey crypto,
             Maybe (VRFVerificationKey crypto, VRFOutput crypto))))
-> ((SeatIndex, Maybe (VRFOutput crypto))
    -> Either
         (VotingCommitteeError crypto WFALS)
         (EligibilityWitness crypto WFALS, VoteVerificationKey crypto,
          Maybe (VRFVerificationKey crypto, VRFOutput crypto)))
-> Either
     (VotingCommitteeError crypto WFALS)
     (NonEmpty (EligibilityWitness crypto WFALS),
      NonEmpty (VoteVerificationKey crypto),
      NonEmpty (Maybe (VRFVerificationKey crypto, VRFOutput crypto)))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (((SeatIndex, Maybe (VRFOutput crypto))
  -> Either
       (VotingCommitteeError crypto WFALS)
       (EligibilityWitness crypto WFALS, VoteVerificationKey crypto,
        Maybe (VRFVerificationKey crypto, VRFOutput crypto)))
 -> NonEmpty (SeatIndex, Maybe (VRFOutput crypto))
 -> Either
      (VotingCommitteeError crypto WFALS)
      (NonEmpty
         (EligibilityWitness crypto WFALS, VoteVerificationKey crypto,
          Maybe (VRFVerificationKey crypto, VRFOutput crypto))))
-> NonEmpty (SeatIndex, Maybe (VRFOutput crypto))
-> ((SeatIndex, Maybe (VRFOutput crypto))
    -> Either
         (VotingCommitteeError crypto WFALS)
         (EligibilityWitness crypto WFALS, VoteVerificationKey crypto,
          Maybe (VRFVerificationKey crypto, VRFOutput crypto)))
-> Either
     (VotingCommitteeError crypto WFALS)
     (NonEmpty
        (EligibilityWitness crypto WFALS, VoteVerificationKey crypto,
         Maybe (VRFVerificationKey crypto, VRFOutput crypto)))
forall a b c. (a -> b -> c) -> b -> a -> c
flip ((SeatIndex, Maybe (VRFOutput crypto))
 -> Either
      (VotingCommitteeError crypto WFALS)
      (EligibilityWitness crypto WFALS, VoteVerificationKey crypto,
       Maybe (VRFVerificationKey crypto, VRFOutput crypto)))
-> NonEmpty (SeatIndex, Maybe (VRFOutput crypto))
-> Either
     (VotingCommitteeError crypto WFALS)
     (NonEmpty
        (EligibilityWitness crypto WFALS, VoteVerificationKey crypto,
         Maybe (VRFVerificationKey crypto, VRFOutput 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 (NEMap SeatIndex (Maybe (VRFOutput crypto))
-> NonEmpty (SeatIndex, Maybe (VRFOutput crypto))
forall k a. NEMap k a -> NonEmpty (k, a)
NEMap.toAscList NEMap SeatIndex (Maybe (VRFOutput crypto))
NE (Map SeatIndex (Maybe (VRFOutput crypto)))
voters) (((SeatIndex, Maybe (VRFOutput crypto))
  -> Either
       (VotingCommitteeError crypto WFALS)
       (EligibilityWitness crypto WFALS, VoteVerificationKey crypto,
        Maybe (VRFVerificationKey crypto, VRFOutput crypto)))
 -> Either
      (VotingCommitteeError crypto WFALS)
      (NonEmpty (EligibilityWitness crypto WFALS),
       NonEmpty (VoteVerificationKey crypto),
       NonEmpty (Maybe (VRFVerificationKey crypto, VRFOutput crypto))))
-> ((SeatIndex, Maybe (VRFOutput crypto))
    -> Either
         (VotingCommitteeError crypto WFALS)
         (EligibilityWitness crypto WFALS, VoteVerificationKey crypto,
          Maybe (VRFVerificationKey crypto, VRFOutput crypto)))
-> Either
     (VotingCommitteeError crypto WFALS)
     (NonEmpty (EligibilityWitness crypto WFALS),
      NonEmpty (VoteVerificationKey crypto),
      NonEmpty (Maybe (VRFVerificationKey crypto, VRFOutput crypto)))
forall a b. (a -> b) -> a -> b
$ \case
        -- Persistent voter
        (SeatIndex
seatIndex, Maybe (VRFOutput crypto)
Nothing)
          | 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 WFALS -> ExtWFAStakeDistr (PublicKey crypto)
forall crypto.
VotingCommittee crypto WFALS -> ExtWFAStakeDistr (PublicKey crypto)
extWFAStakeDistr VotingCommittee crypto WFALS
committee)
          , SeatIndex -> VotingCommittee crypto WFALS -> Bool
forall crypto. SeatIndex -> VotingCommittee crypto WFALS -> Bool
isPersistentMember SeatIndex
seatIndex VotingCommittee crypto WFALS
committee -> do
              let voterVoteVerificationKey :: VoteVerificationKey crypto
voterVoteVerificationKey =
                    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
              (EligibilityWitness crypto WFALS, VoteVerificationKey crypto,
 Maybe (VRFVerificationKey crypto, VRFOutput crypto))
-> Either
     (VotingCommitteeError crypto WFALS)
     (EligibilityWitness crypto WFALS, VoteVerificationKey crypto,
      Maybe (VRFVerificationKey crypto, VRFOutput crypto))
forall a. a -> Either (VotingCommitteeError crypto WFALS) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
                ( SeatIndex -> LedgerStake -> EligibilityWitness crypto WFALS
forall crypto.
SeatIndex -> LedgerStake -> EligibilityWitness crypto WFALS
WFALSPersistentMember
                    SeatIndex
seatIndex
                    LedgerStake
voterStake
                , VoteVerificationKey crypto
voterVoteVerificationKey
                , Maybe (VRFVerificationKey crypto, VRFOutput crypto)
forall a. Maybe a
Nothing
                )
          | Bool
otherwise ->
              VotingCommitteeError crypto WFALS
-> Either
     (VotingCommitteeError crypto WFALS)
     (EligibilityWitness crypto WFALS, VoteVerificationKey crypto,
      Maybe (VRFVerificationKey crypto, VRFOutput crypto))
forall a b. a -> Either a b
Left (SeatIndex -> VotingCommitteeError crypto WFALS
forall crypto. SeatIndex -> VotingCommitteeError crypto WFALS
NotAPersistentMember SeatIndex
seatIndex)
        -- Non-persistent voter
        (SeatIndex
seatIndex, Just VRFOutput crypto
vrfOutput)
          | 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 WFALS -> ExtWFAStakeDistr (PublicKey crypto)
forall crypto.
VotingCommittee crypto WFALS -> ExtWFAStakeDistr (PublicKey crypto)
extWFAStakeDistr VotingCommittee crypto WFALS
committee)
          , Bool -> Bool
not (SeatIndex -> VotingCommittee crypto WFALS -> Bool
forall crypto. SeatIndex -> VotingCommittee crypto WFALS -> Bool
isPersistentMember SeatIndex
seatIndex VotingCommittee crypto WFALS
committee) -> do
              let voterVoteVerificationKey :: VoteVerificationKey crypto
voterVoteVerificationKey =
                    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
              let voterVRFVerificationKey :: VRFVerificationKey crypto
voterVRFVerificationKey =
                    Proxy crypto -> PublicKey crypto -> VRFVerificationKey crypto
forall crypto.
CryptoSupportsVRF crypto =>
Proxy crypto -> PublicKey crypto -> VRFVerificationKey crypto
getVRFVerificationKey (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @crypto) PublicKey crypto
voterPublicKey
              let numSeats :: LocalSortitionNumSeats
numSeats =
                    NonPersistentCommitteeSize
-> TotalNonPersistentStake
-> LedgerStake
-> NormalizedVRFOutput
-> LocalSortitionNumSeats
localSortitionNumSeats
                      (VotingCommittee crypto WFALS -> NonPersistentCommitteeSize
forall crypto.
VotingCommittee crypto WFALS -> NonPersistentCommitteeSize
nonPersistentCommitteeSize VotingCommittee crypto WFALS
committee)
                      (VotingCommittee crypto WFALS -> TotalNonPersistentStake
forall crypto.
VotingCommittee crypto WFALS -> TotalNonPersistentStake
totalNonPersistentStake VotingCommittee crypto WFALS
committee)
                      LedgerStake
voterStake
                      (VRFOutput crypto -> NormalizedVRFOutput
forall crypto.
CryptoSupportsVRF crypto =>
VRFOutput crypto -> NormalizedVRFOutput
normalizeVRFOutput VRFOutput crypto
vrfOutput)
              case LocalSortitionNumSeats -> Maybe (NonZero LocalSortitionNumSeats)
forall a. HasZero a => a -> Maybe (NonZero a)
nonZero LocalSortitionNumSeats
numSeats of
                Maybe (NonZero LocalSortitionNumSeats)
Nothing ->
                  VotingCommitteeError crypto WFALS
-> Either
     (VotingCommitteeError crypto WFALS)
     (EligibilityWitness crypto WFALS, VoteVerificationKey crypto,
      Maybe (VRFVerificationKey crypto, VRFOutput crypto))
forall a b. a -> Either a b
Left (SeatIndex -> VotingCommitteeError crypto WFALS
forall crypto. SeatIndex -> VotingCommitteeError crypto WFALS
ZeroNonPersistentSeats SeatIndex
seatIndex)
                Just NonZero LocalSortitionNumSeats
nonZeroNumSeats ->
                  (EligibilityWitness crypto WFALS, VoteVerificationKey crypto,
 Maybe (VRFVerificationKey crypto, VRFOutput crypto))
-> Either
     (VotingCommitteeError crypto WFALS)
     (EligibilityWitness crypto WFALS, VoteVerificationKey crypto,
      Maybe (VRFVerificationKey crypto, VRFOutput crypto))
forall a. a -> Either (VotingCommitteeError crypto WFALS) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
                    ( SeatIndex
-> LedgerStake
-> VRFOutput crypto
-> NonZero LocalSortitionNumSeats
-> EligibilityWitness crypto WFALS
forall crypto.
SeatIndex
-> LedgerStake
-> VRFOutput crypto
-> NonZero LocalSortitionNumSeats
-> EligibilityWitness crypto WFALS
WFALSNonPersistentMember
                        SeatIndex
seatIndex
                        LedgerStake
voterStake
                        VRFOutput crypto
vrfOutput
                        NonZero LocalSortitionNumSeats
nonZeroNumSeats
                    , VoteVerificationKey crypto
voterVoteVerificationKey
                    , (VRFVerificationKey crypto, VRFOutput crypto)
-> Maybe (VRFVerificationKey crypto, VRFOutput crypto)
forall a. a -> Maybe a
Just (VRFVerificationKey crypto
voterVRFVerificationKey, VRFOutput crypto
vrfOutput)
                    )
          | Bool
otherwise ->
              VotingCommitteeError crypto WFALS
-> Either
     (VotingCommitteeError crypto WFALS)
     (EligibilityWitness crypto WFALS, VoteVerificationKey crypto,
      Maybe (VRFVerificationKey crypto, VRFOutput crypto))
forall a b. a -> Either a b
Left (SeatIndex -> VotingCommitteeError crypto WFALS
forall crypto. SeatIndex -> VotingCommitteeError crypto WFALS
NotANonPersistentMember SeatIndex
seatIndex)

    -- Verify aggregate signature
    aggVerificationKey <-
      bimap CryptoError id $
        aggregateVoteVerificationKeys
          (Proxy @crypto)
          voteVerificationKeys
    bimap InvalidCertSignature id $
      verifyAggregateVoteSignature
        (Proxy @crypto)
        aggVerificationKey
        electionId
        candidate
        aggSig

    -- Verify VRF outputs for non-persistent voters (if any)
    case catMaybes (NonEmpty.toList optionalVRFKeysAndOutputs) of
      -- No non-persistent voters => no VRF outputs to verify
      [] -> do
        () -> Either (VotingCommitteeError crypto WFALS) ()
forall a. a -> Either (VotingCommitteeError crypto WFALS) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
      -- Some non-persistent voters => verify their aggregate VRF outputs
      [(VRFVerificationKey crypto, VRFOutput crypto)]
vrfKeysAndOutputs -> do
        let (NonEmpty (VRFVerificationKey crypto)
vrfVerificationKeys, NonEmpty (VRFOutput crypto)
vrfOutputs) =
              NonEmpty (VRFVerificationKey crypto, VRFOutput crypto)
-> (NonEmpty (VRFVerificationKey crypto),
    NonEmpty (VRFOutput 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 (VRFVerificationKey crypto, VRFOutput crypto)
 -> (NonEmpty (VRFVerificationKey crypto),
     NonEmpty (VRFOutput crypto)))
-> ([(VRFVerificationKey crypto, VRFOutput crypto)]
    -> NonEmpty (VRFVerificationKey crypto, VRFOutput crypto))
-> [(VRFVerificationKey crypto, VRFOutput crypto)]
-> (NonEmpty (VRFVerificationKey crypto),
    NonEmpty (VRFOutput crypto))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(VRFVerificationKey crypto, VRFOutput crypto)]
-> NonEmpty (VRFVerificationKey crypto, VRFOutput crypto)
forall a. HasCallStack => [a] -> NonEmpty a
NonEmpty.fromList -- safe 'vrfKeysAndOutputs' /= []
                ([(VRFVerificationKey crypto, VRFOutput crypto)]
 -> (NonEmpty (VRFVerificationKey crypto),
     NonEmpty (VRFOutput crypto)))
-> [(VRFVerificationKey crypto, VRFOutput crypto)]
-> (NonEmpty (VRFVerificationKey crypto),
    NonEmpty (VRFOutput crypto))
forall a b. (a -> b) -> a -> b
$ [(VRFVerificationKey crypto, VRFOutput crypto)]
vrfKeysAndOutputs
        (String -> VotingCommitteeError crypto WFALS)
-> (() -> ())
-> Either String ()
-> Either (VotingCommitteeError crypto WFALS) ()
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 WFALS
forall crypto. String -> VotingCommitteeError crypto WFALS
InvalidCertSignature () -> ()
forall a. a -> a
id (Either String () -> Either (VotingCommitteeError crypto WFALS) ())
-> Either String ()
-> Either (VotingCommitteeError crypto WFALS) ()
forall a b. (a -> b) -> a -> b
$
          NE [VRFVerificationKey crypto]
-> VRFElectionInput crypto
-> NE [VRFOutput crypto]
-> Either String ()
forall crypto.
CryptoSupportsBatchVRFVerification crypto =>
NE [VRFVerificationKey crypto]
-> VRFElectionInput crypto
-> NE [VRFOutput crypto]
-> Either String ()
batchVerifyVRFOutputs
            NonEmpty (VRFVerificationKey crypto)
NE [VRFVerificationKey crypto]
vrfVerificationKeys
            ( forall crypto.
CryptoSupportsVRF crypto =>
Nonce -> ElectionId crypto -> VRFElectionInput crypto
mkVRFElectionInput
                @crypto
                (VotingCommittee crypto WFALS -> Nonce
forall crypto. VotingCommittee crypto WFALS -> Nonce
epochNonce VotingCommittee crypto WFALS
committee)
                ElectionId crypto
electionId
            )
            NonEmpty (VRFOutput crypto)
NE [VRFOutput crypto]
vrfOutputs

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

-- * Helpers

-- | Check if a voter is a persistent member of in a voting committee
isPersistentMember ::
  SeatIndex ->
  VotingCommittee crypto WFALS ->
  Bool
isPersistentMember :: forall crypto. SeatIndex -> VotingCommittee crypto WFALS -> Bool
isPersistentMember SeatIndex
seatIndex VotingCommittee crypto WFALS
committee =
  SeatIndex -> Word64
unSeatIndex SeatIndex
seatIndex
    Word64 -> Word64 -> Bool
forall a. Ord a => a -> a -> Bool
< PersistentCommitteeSize -> Word64
unPersistentCommitteeSize (VotingCommittee crypto WFALS -> PersistentCommitteeSize
forall crypto.
VotingCommittee crypto WFALS -> PersistentCommitteeSize
persistentCommitteeSize VotingCommittee crypto WFALS
committee)

-- | Check the validity of a vote signature
checkVoteSignature ::
  forall crypto.
  CryptoSupportsVoteSigning crypto =>
  VoteVerificationKey crypto ->
  ElectionId crypto ->
  VoteCandidate crypto ->
  VoteSignature crypto ->
  Either
    (VotingCommitteeError crypto WFALS)
    ()
checkVoteSignature :: forall crypto.
CryptoSupportsVoteSigning crypto =>
VoteVerificationKey crypto
-> ElectionId crypto
-> VoteCandidate crypto
-> VoteSignature crypto
-> Either (VotingCommitteeError crypto WFALS) ()
checkVoteSignature VoteVerificationKey crypto
verificationKey ElectionId crypto
electionId VoteCandidate crypto
message VoteSignature crypto
sig =
  (String -> VotingCommitteeError crypto WFALS)
-> (() -> ())
-> Either String ()
-> Either (VotingCommitteeError crypto WFALS) ()
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 WFALS
forall crypto. String -> VotingCommitteeError crypto WFALS
InvalidVoteSignature () -> ()
forall a. a -> a
id (Either String () -> Either (VotingCommitteeError crypto WFALS) ())
-> Either String ()
-> Either (VotingCommitteeError crypto WFALS) ()
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
verificationKey
      ElectionId crypto
electionId
      VoteCandidate crypto
message
      VoteSignature crypto
sig

-- | Extended unzip3 for 'NonEmpty' lists
nonEmptyUnzip3 ::
  NE [(a, b, c)] ->
  (NE [a], NE [b], NE [c])
nonEmptyUnzip3 :: forall a b c. NE [(a, b, c)] -> (NE [a], NE [b], NE [c])
nonEmptyUnzip3 ((a
a, b
b, c
c) :| [(a, b, c)]
rest) =
  ( a
a a -> [a] -> NonEmpty a
forall a. a -> [a] -> NonEmpty a
:| [a]
restA
  , b
b b -> [b] -> NonEmpty b
forall a. a -> [a] -> NonEmpty a
:| [b]
restB
  , c
c c -> [c] -> NonEmpty c
forall a. a -> [a] -> NonEmpty a
:| [c]
restC
  )
 where
  ([a]
restA, [b]
restB, [c]
restC) =
    [(a, b, c)] -> ([a], [b], [c])
forall a b c. [(a, b, c)] -> ([a], [b], [c])
unzip3 [(a, b, c)]
rest