{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE EmptyDataDeriving #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}

-- | 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.Binary
  ( FromCBOR (..)
  , ToCBOR (..)
  , decodeListLenOf
  , encodeListLen
  )
import Cardano.Ledger.BaseTypes (NonZero (..), Nonce, nonZero)
import Control.Exception (Exception, assert)
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 Data.Typeable (Typeable)
import GHC.Generics (Generic)
import NoThunks.Class (NoThunks)
import Ouroboros.Consensus.Committee.Class
  ( CryptoSupportsVotingCommittee (..)
  , UniqueVotesWithSameTarget
  , VotingCommittee
  , 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
  deriving (Int -> WFALS -> ShowS
[WFALS] -> ShowS
WFALS -> String
(Int -> WFALS -> ShowS)
-> (WFALS -> String) -> ([WFALS] -> ShowS) -> Show WFALS
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> WFALS -> ShowS
showsPrec :: Int -> WFALS -> ShowS
$cshow :: WFALS -> String
show :: WFALS -> String
$cshowList :: [WFALS] -> ShowS
showList :: [WFALS] -> ShowS
Show, WFALS -> WFALS -> Bool
(WFALS -> WFALS -> Bool) -> (WFALS -> WFALS -> Bool) -> Eq WFALS
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: WFALS -> WFALS -> Bool
== :: WFALS -> WFALS -> Bool
$c/= :: WFALS -> WFALS -> Bool
/= :: WFALS -> WFALS -> Bool
Eq, (forall x. WFALS -> Rep WFALS x)
-> (forall x. Rep WFALS x -> WFALS) -> Generic WFALS
forall x. Rep WFALS x -> WFALS
forall x. WFALS -> Rep WFALS x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. WFALS -> Rep WFALS x
from :: forall x. WFALS -> Rep WFALS x
$cto :: forall x. Rep WFALS x -> WFALS
to :: forall x. Rep WFALS x -> WFALS
Generic, Context -> WFALS -> IO (Maybe ThunkInfo)
Proxy WFALS -> String
(Context -> WFALS -> IO (Maybe ThunkInfo))
-> (Context -> WFALS -> IO (Maybe ThunkInfo))
-> (Proxy WFALS -> String)
-> NoThunks WFALS
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
$cnoThunks :: Context -> WFALS -> IO (Maybe ThunkInfo)
noThunks :: Context -> WFALS -> IO (Maybe ThunkInfo)
$cwNoThunks :: Context -> WFALS -> IO (Maybe ThunkInfo)
wNoThunks :: Context -> WFALS -> IO (Maybe ThunkInfo)
$cshowTypeOf :: Proxy WFALS -> String
showTypeOf :: Proxy WFALS -> String
NoThunks)

-- 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 instance 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
  }

instance
  ( Typeable crypto
  , FromCBOR (PublicKey crypto)
  ) =>
  FromCBOR (VotingCommittee crypto WFALS)
  where
  fromCBOR :: forall s. Decoder s (VotingCommittee crypto WFALS)
fromCBOR = do
    Int -> Decoder s ()
forall s. Int -> Decoder s ()
decodeListLenOf Int
7
    extWFAStakeDistr <- Decoder s (ExtWFAStakeDistr (PublicKey crypto))
forall s. Decoder s (ExtWFAStakeDistr (PublicKey crypto))
forall a s. FromCBOR a => Decoder s a
fromCBOR
    candidateSeats <- fromCBOR
    persistentCommitteeSize <- fromCBOR
    nonPersistentCommitteeSize <- fromCBOR
    totalPersistentStake <- fromCBOR
    totalNonPersistentStake <- fromCBOR
    epochNonce <- fromCBOR
    pure
      WFALSVotingCommittee
        { extWFAStakeDistr
        , candidateSeats
        , persistentCommitteeSize
        , nonPersistentCommitteeSize
        , totalPersistentStake
        , totalNonPersistentStake
        , epochNonce
        }

instance
  ( Typeable crypto
  , ToCBOR (PublicKey crypto)
  ) =>
  ToCBOR (VotingCommittee crypto WFALS)
  where
  toCBOR :: VotingCommittee crypto WFALS -> Encoding
toCBOR
    WFALSVotingCommittee
      { ExtWFAStakeDistr (PublicKey crypto)
extWFAStakeDistr :: forall crypto.
VotingCommittee crypto WFALS -> ExtWFAStakeDistr (PublicKey crypto)
extWFAStakeDistr :: ExtWFAStakeDistr (PublicKey crypto)
extWFAStakeDistr
      , Map PoolId SeatIndex
candidateSeats :: forall crypto. VotingCommittee crypto WFALS -> Map PoolId SeatIndex
candidateSeats :: Map PoolId SeatIndex
candidateSeats
      , PersistentCommitteeSize
persistentCommitteeSize :: forall crypto.
VotingCommittee crypto WFALS -> PersistentCommitteeSize
persistentCommitteeSize :: PersistentCommitteeSize
persistentCommitteeSize
      , NonPersistentCommitteeSize
nonPersistentCommitteeSize :: forall crypto.
VotingCommittee crypto WFALS -> NonPersistentCommitteeSize
nonPersistentCommitteeSize :: NonPersistentCommitteeSize
nonPersistentCommitteeSize
      , TotalPersistentStake
totalPersistentStake :: forall crypto. VotingCommittee crypto WFALS -> TotalPersistentStake
totalPersistentStake :: TotalPersistentStake
totalPersistentStake
      , TotalNonPersistentStake
totalNonPersistentStake :: forall crypto.
VotingCommittee crypto WFALS -> TotalNonPersistentStake
totalNonPersistentStake :: TotalNonPersistentStake
totalNonPersistentStake
      , Nonce
epochNonce :: forall crypto. VotingCommittee crypto WFALS -> Nonce
epochNonce :: Nonce
epochNonce
      } =
      Word -> Encoding
encodeListLen Word
7
        Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> ExtWFAStakeDistr (PublicKey crypto) -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR ExtWFAStakeDistr (PublicKey crypto)
extWFAStakeDistr
        Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Map PoolId SeatIndex -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR Map PoolId SeatIndex
candidateSeats
        Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> PersistentCommitteeSize -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR PersistentCommitteeSize
persistentCommitteeSize
        Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> NonPersistentCommitteeSize -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR NonPersistentCommitteeSize
nonPersistentCommitteeSize
        Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> TotalPersistentStake -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR TotalPersistentStake
totalPersistentStake
        Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> TotalNonPersistentStake -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR TotalNonPersistentStake
totalNonPersistentStake
        Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Nonce -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR Nonce
epochNonce

instance
  ( CryptoSupportsAggregateVoteSigning crypto
  , CryptoSupportsBatchVRFVerification crypto
  , Ord (ElectionId crypto)
  ) =>
  CryptoSupportsVotingCommittee crypto WFALS
  where
  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

  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

  voteTarget :: Vote crypto WFALS -> (ElectionId crypto, VoteCandidate crypto)
voteTarget = \case
    WFALSPersistentVote SeatIndex
_ ElectionId crypto
electionId VoteCandidate crypto
candidate VoteSignature crypto
_ ->
      (ElectionId crypto
electionId, VoteCandidate crypto
candidate)
    WFALSNonPersistentVote SeatIndex
_ ElectionId crypto
electionId VoteCandidate crypto
candidate VRFOutput crypto
_ VoteSignature crypto
_ ->
      (ElectionId crypto
electionId, VoteCandidate crypto
candidate)
  compareVotesById :: Vote crypto WFALS -> Vote crypto WFALS -> Ordering
compareVotesById Vote crypto WFALS
vote1 Vote crypto WFALS
vote2 = (SeatIndex, ElectionId crypto)
-> (SeatIndex, ElectionId crypto) -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Vote crypto WFALS -> (SeatIndex, ElectionId crypto)
forall {crypto}.
Vote crypto WFALS -> (SeatIndex, ElectionId crypto)
getVoteId Vote crypto WFALS
vote1) (Vote crypto WFALS -> (SeatIndex, ElectionId crypto)
forall {crypto}.
Vote crypto WFALS -> (SeatIndex, ElectionId crypto)
getVoteId Vote crypto WFALS
vote2)
   where
    getVoteId :: Vote crypto WFALS -> (SeatIndex, ElectionId crypto)
getVoteId = \case
      WFALSPersistentVote SeatIndex
seatIndex ElectionId crypto
electionId VoteCandidate crypto
_ VoteSignature crypto
_ ->
        (SeatIndex
seatIndex, ElectionId crypto
electionId)
      WFALSNonPersistentVote SeatIndex
seatIndex ElectionId crypto
electionId VoteCandidate crypto
_ VRFOutput crypto
_ VoteSignature crypto
_ ->
        (SeatIndex
seatIndex, ElectionId crypto
electionId)

deriving instance
  Show (PublicKey crypto) =>
  Show (VotingCommittee crypto WFALS)
deriving instance
  Eq (PublicKey crypto) =>
  Eq (VotingCommittee crypto WFALS)
deriving instance
  NoThunks (PublicKey crypto) =>
  NoThunks (VotingCommittee crypto WFALS)
deriving instance
  Generic (VotingCommittee crypto WFALS)

deriving instance
  Show (PublicKey crypto) =>
  Show (VotingCommitteeInput crypto WFALS)
deriving instance
  Eq (PublicKey crypto) =>
  Eq (VotingCommitteeInput crypto WFALS)
deriving instance
  NoThunks (PublicKey crypto) =>
  NoThunks (VotingCommitteeInput crypto WFALS)
deriving instance
  Generic (VotingCommitteeInput crypto WFALS)

deriving instance
  Show (VotingCommitteeError crypto WFALS)
deriving instance
  Eq (VotingCommitteeError crypto WFALS)
deriving instance
  NoThunks (VotingCommitteeError crypto WFALS)
deriving instance
  Generic (VotingCommitteeError crypto WFALS)
deriving instance
  Typeable crypto =>
  Exception (VotingCommitteeError crypto WFALS)

-- | 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
--
-- In this voting committee scheme, the vote weight of a member depends on their
-- membership type:
--   * for a persistent committee member, their vote weight is equal to their
--     (normalised) ledger stake throughout their entire tenure in the
--     committee, whereas
--   * for a non-persistent committee member, their vote weight is equal to
--     their (normalised) non-persistent vote weight. This is computed as the
--     number of seats granted to them by local sortition, scaled by their
--     relative non-persistent stake w.r.t. other non-persistent voters.
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 Ratio Integer
stake) ->
      Ratio Integer -> VoteWeight
mkVoteWeight Ratio Integer
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 Ratio Integer
stake)
    VRFOutput crypto
_vrfOutput
    NonZero LocalSortitionNumSeats
numSeats ->
      Ratio Integer -> VoteWeight
mkVoteWeight (Ratio Integer -> VoteWeight) -> Ratio Integer -> VoteWeight
forall a b. (a -> b) -> a -> b
$
        Word64 -> Ratio Integer
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))
          Ratio Integer -> Ratio Integer -> Ratio Integer
forall a. Num a => a -> a -> a
* Ratio Integer
stake
          Ratio Integer -> Ratio Integer -> Ratio Integer
forall a. Fractional a => a -> a -> a
/ Ratio Integer
nonPersistentStake
 where
  TotalPersistentStake (Cumulative (LedgerStake Ratio Integer
persistentStake)) =
    VotingCommittee crypto WFALS -> TotalPersistentStake
forall crypto. VotingCommittee crypto WFALS -> TotalPersistentStake
totalPersistentStake VotingCommittee crypto WFALS
committee
  TotalNonPersistentStake (Cumulative (LedgerStake Ratio Integer
nonPersistentStake)) =
    VotingCommittee crypto WFALS -> TotalNonPersistentStake
forall crypto.
VotingCommittee crypto WFALS -> TotalNonPersistentStake
totalNonPersistentStake VotingCommittee crypto WFALS
committee

  mkVoteWeight :: Ratio Integer -> VoteWeight
mkVoteWeight Ratio Integer
absoluteStake =
    Ratio Integer -> VoteWeight
VoteWeight (Ratio Integer
absoluteStake Ratio Integer -> Ratio Integer -> Ratio Integer
forall a. Fractional a => a -> a -> a
/ (Ratio Integer
persistentStake Ratio Integer -> Ratio Integer -> Ratio Integer
forall a. Num a => a -> a -> a
+ Ratio Integer
nonPersistentStake))

-- | 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 =
  Bool
-> Either (VotingCommitteeError crypto WFALS) (Cert crypto WFALS)
-> Either (VotingCommitteeError crypto WFALS) (Cert crypto WFALS)
forall a. (?callStack::CallStack) => Bool -> a -> a
assert Bool
allUniqueVoterSeats (Either (VotingCommitteeError crypto WFALS) (Cert crypto WFALS)
 -> Either (VotingCommitteeError crypto WFALS) (Cert crypto WFALS))
-> Either (VotingCommitteeError crypto WFALS) (Cert crypto WFALS)
-> Either (VotingCommitteeError crypto WFALS) (Cert crypto WFALS)
forall a b. (a -> b) -> a -> b
$ 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)
        voterMap
        aggSig
 where
  -- We want to fail fast in case if the number of votes is not the same
  -- as voters representation in WFALSCert. This assumption may be
  -- violated in case if implementation uses incorrect ordering function
  -- in the `ensureUniqueVotesWithSameTarget`
  allUniqueVoterSeats :: Bool
allUniqueVoterSeats =
    NEMap SeatIndex (Maybe (VRFOutput crypto)) -> Int
forall k a. NEMap k a -> Int
NEMap.size NEMap SeatIndex (Maybe (VRFOutput crypto))
voterMap Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== NonEmpty (SeatIndex, Maybe (VRFOutput crypto)) -> Int
forall a. NonEmpty a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length NonEmpty (SeatIndex, Maybe (VRFOutput crypto))
voters
      Bool -> Bool -> Bool
&& NEMap SeatIndex (Maybe (VRFOutput crypto)) -> Int
forall k a. NEMap k a -> Int
NEMap.size NEMap SeatIndex (Maybe (VRFOutput crypto))
voterMap Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== NonEmpty (VoteSignature crypto) -> Int
forall a. NonEmpty a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length NonEmpty (VoteSignature crypto)
voteSignatures
  voterMap :: NEMap SeatIndex (Maybe (VRFOutput crypto))
voterMap = NonEmpty (SeatIndex, Maybe (VRFOutput crypto))
-> NEMap SeatIndex (Maybe (VRFOutput crypto))
forall k a. Eq k => NonEmpty (k, a) -> NEMap k a
NEMap.fromAscList NonEmpty (SeatIndex, Maybe (VRFOutput crypto))
voters
  (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. (?callStack::CallStack) => [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