{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}

-- | Concrete Peras certificate types using BLS signatures.
--
-- NOTE: this module is meant to be imported qualified.
--
-- NOTE: the validation performed during serialization is minimal, and does not
-- cover any of additional semantic and cryptographic checks that must be
-- performed on the certificate later on.
module Ouroboros.Consensus.Peras.Cert.V1
  ( PerasCert (..)
  , castPerasCert
  , PerasCertVoters (..)
  ) where

import Cardano.Binary
  ( FromCBOR (..)
  , ToCBOR (..)
  , decodeListLenOf
  , encodeListLen
  )
import Control.Monad (when)
import Control.Monad.Error.Class (MonadError (..))
import Data.Coerce (coerce)
import Data.Containers.NonEmpty (HasNonEmpty (..))
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, isJust)
import Data.Typeable (Proxy (..), Typeable)
import Data.Word (Word16)
import GHC.Generics (Generic)
import NoThunks.Class (NoThunks, OnlyCheckWhnfNamed (..))
import Ouroboros.Consensus.Block.Abstract (ConvertRawHash (..))
import Ouroboros.Consensus.Committee.Crypto
  ( CryptoSupportsAggregateVoteSigning (..)
  , CryptoSupportsVRF (..)
  )
import Ouroboros.Consensus.Committee.EveryoneVotes
  ( Cert (..)
  , EveryoneVotes
  )
import Ouroboros.Consensus.Committee.WFA (SeatIndex (..))
import Ouroboros.Consensus.Committee.WFALS (Cert (..), WFALS)
import Ouroboros.Consensus.Peras.Cert.Class (IsPerasCert (..))
import Ouroboros.Consensus.Peras.Crypto.BLS
  ( PerasBLSCrypto
  )
import Ouroboros.Consensus.Peras.Types
  ( BoostedBlock
  , PerasBoostedBlock (..)
  , PerasRoundNo
  , PerasSeatIndex (..)
  )
import Ouroboros.Consensus.Peras.Vote.V1 (PerasVoteEligibilityProof (..))
import Ouroboros.Consensus.Peras.Voting.Adapter
  ( PerasCertCompatibleWithVotingCommittee (..)
  , PerasConversionError (..)
  , fromPerasSeatIndex
  , toPerasSeatIndex
  )
import Ouroboros.Consensus.Util.Bitmap (Bitmap)
import qualified Ouroboros.Consensus.Util.Bitmap as Bitmap
import Ouroboros.Network.Util.ShowProxy (ShowProxy (..))

-- | Concrete Peras certificates using BLS signatures
--
-- NOTE: the 'blk' parameter is a phantom type used to track the block type that
-- the certificate is associated with, to ensure injectivity when 'V1.PerasCert'
-- is used as a type instance for 'BlockSupportsPeras' class.
data PerasCert blk
  = PerasCert
  { forall blk. PerasCert blk -> PerasRoundNo
pcRoundNo :: !PerasRoundNo
  -- ^ Election identifier
  , forall blk. PerasCert blk -> PerasBoostedBlock
pcBoostedBlock :: !PerasBoostedBlock
  -- ^ Certificate message, i.e., the hash of the block being boosted
  , forall blk. PerasCert blk -> PerasCertVoters
pcVoters :: !PerasCertVoters
  -- ^ Voters who contributed to this certificate
  , forall blk. PerasCert blk -> AggregateVoteSignature PerasBLSCrypto
pcSignature :: !(AggregateVoteSignature PerasBLSCrypto)
  -- ^ Aggregate BLS signature on the hash of the election identifier and
  -- the certificate message
  }
  deriving stock (Int -> PerasCert blk -> ShowS
[PerasCert blk] -> ShowS
PerasCert blk -> String
(Int -> PerasCert blk -> ShowS)
-> (PerasCert blk -> String)
-> ([PerasCert blk] -> ShowS)
-> Show (PerasCert blk)
forall blk. Int -> PerasCert blk -> ShowS
forall blk. [PerasCert blk] -> ShowS
forall blk. PerasCert blk -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall blk. Int -> PerasCert blk -> ShowS
showsPrec :: Int -> PerasCert blk -> ShowS
$cshow :: forall blk. PerasCert blk -> String
show :: PerasCert blk -> String
$cshowList :: forall blk. [PerasCert blk] -> ShowS
showList :: [PerasCert blk] -> ShowS
Show, PerasCert blk -> PerasCert blk -> Bool
(PerasCert blk -> PerasCert blk -> Bool)
-> (PerasCert blk -> PerasCert blk -> Bool) -> Eq (PerasCert blk)
forall blk. PerasCert blk -> PerasCert blk -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall blk. PerasCert blk -> PerasCert blk -> Bool
== :: PerasCert blk -> PerasCert blk -> Bool
$c/= :: forall blk. PerasCert blk -> PerasCert blk -> Bool
/= :: PerasCert blk -> PerasCert blk -> Bool
Eq, (forall x. PerasCert blk -> Rep (PerasCert blk) x)
-> (forall x. Rep (PerasCert blk) x -> PerasCert blk)
-> Generic (PerasCert blk)
forall x. Rep (PerasCert blk) x -> PerasCert blk
forall x. PerasCert blk -> Rep (PerasCert blk) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall blk x. Rep (PerasCert blk) x -> PerasCert blk
forall blk x. PerasCert blk -> Rep (PerasCert blk) x
$cfrom :: forall blk x. PerasCert blk -> Rep (PerasCert blk) x
from :: forall x. PerasCert blk -> Rep (PerasCert blk) x
$cto :: forall blk x. Rep (PerasCert blk) x -> PerasCert blk
to :: forall x. Rep (PerasCert blk) x -> PerasCert blk
Generic)
  deriving anyclass Context -> PerasCert blk -> IO (Maybe ThunkInfo)
Proxy (PerasCert blk) -> String
(Context -> PerasCert blk -> IO (Maybe ThunkInfo))
-> (Context -> PerasCert blk -> IO (Maybe ThunkInfo))
-> (Proxy (PerasCert blk) -> String)
-> NoThunks (PerasCert blk)
forall blk. Context -> PerasCert blk -> IO (Maybe ThunkInfo)
forall blk. Proxy (PerasCert blk) -> String
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
$cnoThunks :: forall blk. Context -> PerasCert blk -> IO (Maybe ThunkInfo)
noThunks :: Context -> PerasCert blk -> IO (Maybe ThunkInfo)
$cwNoThunks :: forall blk. Context -> PerasCert blk -> IO (Maybe ThunkInfo)
wNoThunks :: Context -> PerasCert blk -> IO (Maybe ThunkInfo)
$cshowTypeOf :: forall blk. Proxy (PerasCert blk) -> String
showTypeOf :: Proxy (PerasCert blk) -> String
NoThunks

-- | Retag a 'PerasCert' with a new phantom @blk@ type.
castPerasCert :: forall blk' blk. PerasCert blk -> PerasCert blk'
castPerasCert :: forall blk' blk. PerasCert blk -> PerasCert blk'
castPerasCert = PerasCert blk -> PerasCert blk'
forall a b. Coercible a b => a -> b
coerce

type instance BoostedBlock (PerasCert blk) = PerasBoostedBlock

instance
  ( ConvertRawHash blk
  , HashSize blk ~ 32
  ) =>
  IsPerasCert (PerasCert blk) blk
  where
  getPerasCertRound :: PerasCert blk -> PerasRoundNo
getPerasCertRound = PerasCert blk -> PerasRoundNo
forall blk. PerasCert blk -> PerasRoundNo
pcRoundNo
  getPerasCertBlock :: PerasCert blk -> BoostedBlock (PerasCert blk)
getPerasCertBlock = PerasCert blk -> BoostedBlock (PerasCert blk)
PerasCert blk -> PerasBoostedBlock
forall blk. PerasCert blk -> PerasBoostedBlock
pcBoostedBlock

instance
  Typeable blk =>
  FromCBOR (PerasCert blk)
  where
  fromCBOR :: forall s. Decoder s (PerasCert blk)
fromCBOR = do
    Int -> Decoder s ()
forall s. Int -> Decoder s ()
decodeListLenOf Int
4
    pcRoundNo <- Decoder s PerasRoundNo
forall s. Decoder s PerasRoundNo
forall a s. FromCBOR a => Decoder s a
fromCBOR
    pcBoostedBlock <- fromCBOR
    pcVoters <- fromCBOR
    pcSignature <- fromCBOR
    pure
      PerasCert
        { pcRoundNo
        , pcBoostedBlock
        , pcVoters
        , pcSignature
        }

instance
  Typeable blk =>
  ToCBOR (PerasCert blk)
  where
  toCBOR :: PerasCert blk -> Encoding
toCBOR
    PerasCert
      { PerasRoundNo
pcRoundNo :: forall blk. PerasCert blk -> PerasRoundNo
pcRoundNo :: PerasRoundNo
pcRoundNo
      , PerasBoostedBlock
pcBoostedBlock :: forall blk. PerasCert blk -> PerasBoostedBlock
pcBoostedBlock :: PerasBoostedBlock
pcBoostedBlock
      , PerasCertVoters
pcVoters :: forall blk. PerasCert blk -> PerasCertVoters
pcVoters :: PerasCertVoters
pcVoters
      , AggregateVoteSignature PerasBLSCrypto
pcSignature :: forall blk. PerasCert blk -> AggregateVoteSignature PerasBLSCrypto
pcSignature :: AggregateVoteSignature PerasBLSCrypto
pcSignature
      } =
      Word -> Encoding
encodeListLen Word
4
        Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> PerasRoundNo -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR PerasRoundNo
pcRoundNo
        Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> PerasBoostedBlock -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR PerasBoostedBlock
pcBoostedBlock
        Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> PerasCertVoters -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR PerasCertVoters
pcVoters
        Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> PerasBLSCryptoAggregateVoteSignature -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR AggregateVoteSignature PerasBLSCrypto
PerasBLSCryptoAggregateVoteSignature
pcSignature

instance ShowProxy blk => ShowProxy (PerasCert blk) where
  showProxy :: Proxy (PerasCert blk) -> String
showProxy Proxy (PerasCert blk)
_ = String
"PerasCert " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Proxy blk -> String
forall {k} (p :: k). ShowProxy p => Proxy p -> String
showProxy (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @blk)

-- | Voters contained in a certificate with their appropriate eligibility proof
newtype PerasCertVoters
  = PerasCertVoters
  { PerasCertVoters
-> NE (Map PerasSeatIndex PerasVoteEligibilityProof)
unPerasCertVoters ::
      NE (Map PerasSeatIndex PerasVoteEligibilityProof)
  }
  deriving stock (Int -> PerasCertVoters -> ShowS
[PerasCertVoters] -> ShowS
PerasCertVoters -> String
(Int -> PerasCertVoters -> ShowS)
-> (PerasCertVoters -> String)
-> ([PerasCertVoters] -> ShowS)
-> Show PerasCertVoters
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PerasCertVoters -> ShowS
showsPrec :: Int -> PerasCertVoters -> ShowS
$cshow :: PerasCertVoters -> String
show :: PerasCertVoters -> String
$cshowList :: [PerasCertVoters] -> ShowS
showList :: [PerasCertVoters] -> ShowS
Show, PerasCertVoters -> PerasCertVoters -> Bool
(PerasCertVoters -> PerasCertVoters -> Bool)
-> (PerasCertVoters -> PerasCertVoters -> Bool)
-> Eq PerasCertVoters
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PerasCertVoters -> PerasCertVoters -> Bool
== :: PerasCertVoters -> PerasCertVoters -> Bool
$c/= :: PerasCertVoters -> PerasCertVoters -> Bool
/= :: PerasCertVoters -> PerasCertVoters -> Bool
Eq, (forall x. PerasCertVoters -> Rep PerasCertVoters x)
-> (forall x. Rep PerasCertVoters x -> PerasCertVoters)
-> Generic PerasCertVoters
forall x. Rep PerasCertVoters x -> PerasCertVoters
forall x. PerasCertVoters -> Rep PerasCertVoters x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. PerasCertVoters -> Rep PerasCertVoters x
from :: forall x. PerasCertVoters -> Rep PerasCertVoters x
$cto :: forall x. Rep PerasCertVoters x -> PerasCertVoters
to :: forall x. Rep PerasCertVoters x -> PerasCertVoters
Generic)

deriving via
  OnlyCheckWhnfNamed "PerasCertVoters" PerasCertVoters
  instance
    NoThunks PerasCertVoters

instance FromCBOR PerasCertVoters where
  fromCBOR :: forall s. Decoder s PerasCertVoters
fromCBOR = do
    Int -> Decoder s ()
forall s. Int -> Decoder s ()
decodeListLenOf Int
2
    votersBitmap <- Decoder s (Bitmap Word16)
forall s. Decoder s (Bitmap Word16)
forall a s. FromCBOR a => Decoder s a
fromCBOR
    nonPersistentSigs <- fromCBOR

    either fail pure
      . fromCompactRepr
      $ CompactPerasCertVoters
        { votersBitmap
        , nonPersistentSigs
        }

instance ToCBOR PerasCertVoters where
  toCBOR :: PerasCertVoters -> Encoding
toCBOR PerasCertVoters
voters =
    Word -> Encoding
encodeListLen Word
2
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Bitmap Word16 -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR Bitmap Word16
votersBitmap
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> [VRFOutput PerasBLSCrypto] -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR [VRFOutput PerasBLSCrypto]
nonPersistentSigs
   where
    CompactPerasCertVoters
      { Bitmap Word16
votersBitmap :: CompactPerasCertVoters -> Bitmap Word16
votersBitmap :: Bitmap Word16
votersBitmap
      , [VRFOutput PerasBLSCrypto]
nonPersistentSigs :: CompactPerasCertVoters -> [VRFOutput PerasBLSCrypto]
nonPersistentSigs :: [VRFOutput PerasBLSCrypto]
nonPersistentSigs
      } =
        PerasCertVoters -> CompactPerasCertVoters
toCompactRepr PerasCertVoters
voters

-- | Compact representation of the voters in a Peras certificate.
--
-- This compact representation consists of a bitmap of voter seat indices and a
-- list of non-persistent eligibility proofs (VRF outputs). In this setup, the
-- last @np@ indices in the bitmap that are flipped to 1 correspond to
-- non-persistent voters, where @np@ is the length of the list of non-persistent
-- eligibility proofs. The remaining flipped indices in the bitmap correspond
-- to persistent voters.
--
-- @
--   fromCompactRepr
--      CompactPerasCertVoters {
--        votersBitmap = <01101011>,
--        nonPersistentSigs = [np1, np2, np3]
--      }
--   ==
--   PerasCertVoters {
--     1 => persistent
--     2 => persistent
--     4 => non-persistent(np1)
--     6 => non-persistent(np2)
--     7 => non-persistent(np3)
--   }
-- @
data CompactPerasCertVoters
  = CompactPerasCertVoters
  { CompactPerasCertVoters -> Bitmap Word16
votersBitmap :: !(Bitmap Word16)
  , CompactPerasCertVoters -> [VRFOutput PerasBLSCrypto]
nonPersistentSigs :: ![VRFOutput PerasBLSCrypto]
  }
  deriving (CompactPerasCertVoters -> CompactPerasCertVoters -> Bool
(CompactPerasCertVoters -> CompactPerasCertVoters -> Bool)
-> (CompactPerasCertVoters -> CompactPerasCertVoters -> Bool)
-> Eq CompactPerasCertVoters
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CompactPerasCertVoters -> CompactPerasCertVoters -> Bool
== :: CompactPerasCertVoters -> CompactPerasCertVoters -> Bool
$c/= :: CompactPerasCertVoters -> CompactPerasCertVoters -> Bool
/= :: CompactPerasCertVoters -> CompactPerasCertVoters -> Bool
Eq, Int -> CompactPerasCertVoters -> ShowS
[CompactPerasCertVoters] -> ShowS
CompactPerasCertVoters -> String
(Int -> CompactPerasCertVoters -> ShowS)
-> (CompactPerasCertVoters -> String)
-> ([CompactPerasCertVoters] -> ShowS)
-> Show CompactPerasCertVoters
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CompactPerasCertVoters -> ShowS
showsPrec :: Int -> CompactPerasCertVoters -> ShowS
$cshow :: CompactPerasCertVoters -> String
show :: CompactPerasCertVoters -> String
$cshowList :: [CompactPerasCertVoters] -> ShowS
showList :: [CompactPerasCertVoters] -> ShowS
Show)

-- | Decode 'PerasCertVoters' from their compact representation.
--
-- See 'CompactPerasCertVoters' for the encoding scheme used here.
fromCompactRepr ::
  CompactPerasCertVoters ->
  Either String PerasCertVoters
fromCompactRepr :: CompactPerasCertVoters -> Either String PerasCertVoters
fromCompactRepr
  CompactPerasCertVoters
    { Bitmap Word16
votersBitmap :: CompactPerasCertVoters -> Bitmap Word16
votersBitmap :: Bitmap Word16
votersBitmap
    , [VRFOutput PerasBLSCrypto]
nonPersistentSigs :: CompactPerasCertVoters -> [VRFOutput PerasBLSCrypto]
nonPersistentSigs :: [VRFOutput PerasBLSCrypto]
nonPersistentSigs
    } = do
    let voterSeatIndices :: [PerasSeatIndex]
voterSeatIndices =
          Word16 -> PerasSeatIndex
PerasSeatIndex (Word16 -> PerasSeatIndex) -> [Word16] -> [PerasSeatIndex]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Bitmap Word16 -> [Word16]
forall a. Integral a => Bitmap a -> [a]
Bitmap.toIndices Bitmap Word16
votersBitmap

    Bool -> Either String () -> Either String ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ([PerasSeatIndex] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [PerasSeatIndex]
voterSeatIndices) (Either String () -> Either String ())
-> Either String () -> Either String ()
forall a b. (a -> b) -> a -> b
$
      String -> Either String ()
forall a. String -> Either String a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError String
"Invalid Peras certificate: empty voters bitmap"

    Bool -> Either String () -> Either String ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ([VRFOutput PerasBLSCrypto] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [VRFOutput PerasBLSCrypto]
nonPersistentSigs Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> [PerasSeatIndex] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [PerasSeatIndex]
voterSeatIndices) (Either String () -> Either String ())
-> Either String () -> Either String ()
forall a b. (a -> b) -> a -> b
$
      String -> Either String ()
forall a. String -> Either String a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (String -> Either String ()) -> String -> Either String ()
forall a b. (a -> b) -> a -> b
$
        Context -> String
unlines
          [ String
"Invalid Peras certificate:"
              String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" more non-persistent voter eligibility proofs were provided"
              String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" than the number of voters in the certificate"
          , String
" * number of voters: "
              String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show ([PerasSeatIndex] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [PerasSeatIndex]
voterSeatIndices)
          , String
" * number of proofs: "
              String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show ([VRFOutput PerasBLSCrypto] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [VRFOutput PerasBLSCrypto]
nonPersistentSigs)
          ]

    let numPersistentVoters :: Int
numPersistentVoters =
          [PerasSeatIndex] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [PerasSeatIndex]
voterSeatIndices Int -> Int -> Int
forall a. Num a => a -> a -> a
- [VRFOutput PerasBLSCrypto] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [VRFOutput PerasBLSCrypto]
nonPersistentSigs
    let persistentProofs :: [PerasVoteEligibilityProof]
persistentProofs =
          Int -> [PerasVoteEligibilityProof] -> [PerasVoteEligibilityProof]
forall a. Int -> [a] -> [a]
take Int
numPersistentVoters (PerasVoteEligibilityProof -> [PerasVoteEligibilityProof]
forall a. a -> [a]
repeat PerasVoteEligibilityProof
PersistentPerasVoteEligibilityProof)
    let nonPersistentProofs :: [PerasVoteEligibilityProof]
nonPersistentProofs =
          (VRFOutput PerasBLSCrypto -> PerasVoteEligibilityProof)
-> [VRFOutput PerasBLSCrypto] -> [PerasVoteEligibilityProof]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap VRFOutput PerasBLSCrypto -> PerasVoteEligibilityProof
NonPersistentPerasVoteEligibilityProof [VRFOutput PerasBLSCrypto]
nonPersistentSigs
    let voters :: NEMap PerasSeatIndex PerasVoteEligibilityProof
voters =
          NonEmpty (PerasSeatIndex, PerasVoteEligibilityProof)
-> NEMap PerasSeatIndex PerasVoteEligibilityProof
forall k a. Eq k => NonEmpty (k, a) -> NEMap k a
NEMap.fromAscList
            (NonEmpty (PerasSeatIndex, PerasVoteEligibilityProof)
 -> NEMap PerasSeatIndex PerasVoteEligibilityProof)
-> ([PerasVoteEligibilityProof]
    -> NonEmpty (PerasSeatIndex, PerasVoteEligibilityProof))
-> [PerasVoteEligibilityProof]
-> NEMap PerasSeatIndex PerasVoteEligibilityProof
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(PerasSeatIndex, PerasVoteEligibilityProof)]
-> NonEmpty (PerasSeatIndex, PerasVoteEligibilityProof)
forall a. HasCallStack => [a] -> NonEmpty a
NonEmpty.fromList
            ([(PerasSeatIndex, PerasVoteEligibilityProof)]
 -> NonEmpty (PerasSeatIndex, PerasVoteEligibilityProof))
-> ([PerasVoteEligibilityProof]
    -> [(PerasSeatIndex, PerasVoteEligibilityProof)])
-> [PerasVoteEligibilityProof]
-> NonEmpty (PerasSeatIndex, PerasVoteEligibilityProof)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [PerasSeatIndex]
-> [PerasVoteEligibilityProof]
-> [(PerasSeatIndex, PerasVoteEligibilityProof)]
forall a b. [a] -> [b] -> [(a, b)]
zip [PerasSeatIndex]
voterSeatIndices
            ([PerasVoteEligibilityProof]
 -> NEMap PerasSeatIndex PerasVoteEligibilityProof)
-> [PerasVoteEligibilityProof]
-> NEMap PerasSeatIndex PerasVoteEligibilityProof
forall a b. (a -> b) -> a -> b
$ [PerasVoteEligibilityProof]
persistentProofs [PerasVoteEligibilityProof]
-> [PerasVoteEligibilityProof] -> [PerasVoteEligibilityProof]
forall a. Semigroup a => a -> a -> a
<> [PerasVoteEligibilityProof]
nonPersistentProofs

    PerasCertVoters -> Either String PerasCertVoters
forall a. a -> Either String a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (NE (Map PerasSeatIndex PerasVoteEligibilityProof)
-> PerasCertVoters
PerasCertVoters NEMap PerasSeatIndex PerasVoteEligibilityProof
NE (Map PerasSeatIndex PerasVoteEligibilityProof)
voters)

-- | Encode 'PerasCertVoters' into their compact representation.
--
-- See 'CompactPerasCertVoters' for the encoding scheme used here.
toCompactRepr ::
  PerasCertVoters ->
  CompactPerasCertVoters
toCompactRepr :: PerasCertVoters -> CompactPerasCertVoters
toCompactRepr (PerasCertVoters NE (Map PerasSeatIndex PerasVoteEligibilityProof)
voters) =
  CompactPerasCertVoters
    { Bitmap Word16
votersBitmap :: Bitmap Word16
votersBitmap :: Bitmap Word16
votersBitmap
    , [VRFOutput PerasBLSCrypto]
nonPersistentSigs :: [VRFOutput PerasBLSCrypto]
nonPersistentSigs :: [VRFOutput PerasBLSCrypto]
nonPersistentSigs
    }
 where
  logicalUpperBound :: Word16
logicalUpperBound =
    PerasSeatIndex -> Word16
unPerasSeatIndex ((PerasSeatIndex, PerasVoteEligibilityProof) -> PerasSeatIndex
forall a b. (a, b) -> a
fst (NEMap PerasSeatIndex PerasVoteEligibilityProof
-> (PerasSeatIndex, PerasVoteEligibilityProof)
forall k a. NEMap k a -> (k, a)
NEMap.findMax NEMap PerasSeatIndex PerasVoteEligibilityProof
NE (Map PerasSeatIndex PerasVoteEligibilityProof)
voters))
  votersByAscSeatIndex :: [(PerasSeatIndex, PerasVoteEligibilityProof)]
votersByAscSeatIndex =
    NonEmpty (PerasSeatIndex, PerasVoteEligibilityProof)
-> [(PerasSeatIndex, PerasVoteEligibilityProof)]
forall a. NonEmpty a -> [a]
NonEmpty.toList (NEMap PerasSeatIndex PerasVoteEligibilityProof
-> NonEmpty (PerasSeatIndex, PerasVoteEligibilityProof)
forall k a. NEMap k a -> NonEmpty (k, a)
NEMap.toAscList NEMap PerasSeatIndex PerasVoteEligibilityProof
NE (Map PerasSeatIndex PerasVoteEligibilityProof)
voters)
  votersSeatIndices :: [Word16]
votersSeatIndices =
    ((PerasSeatIndex, PerasVoteEligibilityProof) -> Word16)
-> [(PerasSeatIndex, PerasVoteEligibilityProof)] -> [Word16]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (PerasSeatIndex -> Word16
unPerasSeatIndex (PerasSeatIndex -> Word16)
-> ((PerasSeatIndex, PerasVoteEligibilityProof) -> PerasSeatIndex)
-> (PerasSeatIndex, PerasVoteEligibilityProof)
-> Word16
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PerasSeatIndex, PerasVoteEligibilityProof) -> PerasSeatIndex
forall a b. (a, b) -> a
fst) [(PerasSeatIndex, PerasVoteEligibilityProof)]
votersByAscSeatIndex
  votersBitmap :: Bitmap Word16
votersBitmap =
    Word16 -> [Word16] -> Bitmap Word16
forall a. Integral a => a -> [a] -> Bitmap a
Bitmap.fromIndices Word16
logicalUpperBound [Word16]
votersSeatIndices
  nonPersistentSigs :: [VRFOutput PerasBLSCrypto]
nonPersistentSigs =
    [Maybe (VRFOutput PerasBLSCrypto)] -> [VRFOutput PerasBLSCrypto]
forall a. [Maybe a] -> [a]
catMaybes (((PerasSeatIndex, PerasVoteEligibilityProof)
 -> Maybe (VRFOutput PerasBLSCrypto))
-> [(PerasSeatIndex, PerasVoteEligibilityProof)]
-> [Maybe (VRFOutput PerasBLSCrypto)]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (PerasSeatIndex, PerasVoteEligibilityProof)
-> Maybe (VRFOutput PerasBLSCrypto)
forall {a}.
(a, PerasVoteEligibilityProof) -> Maybe (VRFOutput PerasBLSCrypto)
getNonPersistentSig [(PerasSeatIndex, PerasVoteEligibilityProof)]
votersByAscSeatIndex)
  getNonPersistentSig :: (a, PerasVoteEligibilityProof) -> Maybe (VRFOutput PerasBLSCrypto)
getNonPersistentSig = \case
    (a
_, PerasVoteEligibilityProof
PersistentPerasVoteEligibilityProof) -> Maybe (VRFOutput PerasBLSCrypto)
forall a. Maybe a
Nothing
    (a
_, NonPersistentPerasVoteEligibilityProof VRFOutput PerasBLSCrypto
p) -> VRFOutput PerasBLSCrypto -> Maybe (VRFOutput PerasBLSCrypto)
forall a. a -> Maybe a
Just VRFOutput PerasBLSCrypto
p

-- * Compatibility with voting committee implementations

-- | Convert concrete Peras certificate voters to abstract committee voters
fromPerasCertVoters ::
  PerasCertVoters ->
  NE (Map SeatIndex (Maybe (VRFOutput PerasBLSCrypto)))
fromPerasCertVoters :: PerasCertVoters
-> NE (Map SeatIndex (Maybe (VRFOutput PerasBLSCrypto)))
fromPerasCertVoters PerasCertVoters
voters =
  NonEmpty (SeatIndex, Maybe (VRFOutput PerasBLSCrypto))
-> NEMap SeatIndex (Maybe (VRFOutput PerasBLSCrypto))
NonEmpty (SeatIndex, Maybe (VRFOutput PerasBLSCrypto))
-> NE (Map SeatIndex (Maybe (VRFOutput PerasBLSCrypto)))
forall k a. Eq k => NonEmpty (k, a) -> NEMap k a
NEMap.fromAscList
    (NonEmpty (SeatIndex, Maybe (VRFOutput PerasBLSCrypto))
 -> NE (Map SeatIndex (Maybe (VRFOutput PerasBLSCrypto))))
-> (PerasCertVoters
    -> NonEmpty (SeatIndex, Maybe (VRFOutput PerasBLSCrypto)))
-> PerasCertVoters
-> NE (Map SeatIndex (Maybe (VRFOutput PerasBLSCrypto)))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((PerasSeatIndex, PerasVoteEligibilityProof)
 -> (SeatIndex, Maybe (VRFOutput PerasBLSCrypto)))
-> NonEmpty (PerasSeatIndex, PerasVoteEligibilityProof)
-> NonEmpty (SeatIndex, Maybe (VRFOutput PerasBLSCrypto))
forall a b. (a -> b) -> NonEmpty a -> NonEmpty b
NonEmpty.map
      ( \(PerasSeatIndex
seatIndex, PerasVoteEligibilityProof
proof) ->
          ( PerasSeatIndex -> SeatIndex
fromPerasSeatIndex PerasSeatIndex
seatIndex
          , PerasVoteEligibilityProof -> Maybe (VRFOutput PerasBLSCrypto)
fromPerasVoteEligibilityProof PerasVoteEligibilityProof
proof
          )
      )
    (NonEmpty (PerasSeatIndex, PerasVoteEligibilityProof)
 -> NonEmpty (SeatIndex, Maybe (VRFOutput PerasBLSCrypto)))
-> (PerasCertVoters
    -> NonEmpty (PerasSeatIndex, PerasVoteEligibilityProof))
-> PerasCertVoters
-> NonEmpty (SeatIndex, Maybe (VRFOutput PerasBLSCrypto))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NEMap PerasSeatIndex PerasVoteEligibilityProof
-> NonEmpty (PerasSeatIndex, PerasVoteEligibilityProof)
forall k a. NEMap k a -> NonEmpty (k, a)
NEMap.toAscList
    (NEMap PerasSeatIndex PerasVoteEligibilityProof
 -> NonEmpty (PerasSeatIndex, PerasVoteEligibilityProof))
-> (PerasCertVoters
    -> NEMap PerasSeatIndex PerasVoteEligibilityProof)
-> PerasCertVoters
-> NonEmpty (PerasSeatIndex, PerasVoteEligibilityProof)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PerasCertVoters -> NEMap PerasSeatIndex PerasVoteEligibilityProof
PerasCertVoters
-> NE (Map PerasSeatIndex PerasVoteEligibilityProof)
unPerasCertVoters
    (PerasCertVoters
 -> NE (Map SeatIndex (Maybe (VRFOutput PerasBLSCrypto))))
-> PerasCertVoters
-> NE (Map SeatIndex (Maybe (VRFOutput PerasBLSCrypto)))
forall a b. (a -> b) -> a -> b
$ PerasCertVoters
voters
 where
  fromPerasVoteEligibilityProof :: PerasVoteEligibilityProof -> Maybe (VRFOutput PerasBLSCrypto)
fromPerasVoteEligibilityProof = \case
    PerasVoteEligibilityProof
PersistentPerasVoteEligibilityProof -> Maybe (VRFOutput PerasBLSCrypto)
forall a. Maybe a
Nothing
    NonPersistentPerasVoteEligibilityProof VRFOutput PerasBLSCrypto
vrfOutput -> VRFOutput PerasBLSCrypto -> Maybe (VRFOutput PerasBLSCrypto)
forall a. a -> Maybe a
Just VRFOutput PerasBLSCrypto
vrfOutput

-- | Convert abstract committee voters to concrete Peras certificate voters
toPerasCertVoters ::
  NE (Map SeatIndex (Maybe (VRFOutput PerasBLSCrypto))) ->
  Either PerasConversionError PerasCertVoters
toPerasCertVoters :: NE (Map SeatIndex (Maybe (VRFOutput PerasBLSCrypto)))
-> Either PerasConversionError PerasCertVoters
toPerasCertVoters NE (Map SeatIndex (Maybe (VRFOutput PerasBLSCrypto)))
voters =
  (NEMap PerasSeatIndex PerasVoteEligibilityProof -> PerasCertVoters)
-> Either
     PerasConversionError
     (NEMap PerasSeatIndex PerasVoteEligibilityProof)
-> Either PerasConversionError PerasCertVoters
forall a b.
(a -> b)
-> Either PerasConversionError a -> Either PerasConversionError b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap NEMap PerasSeatIndex PerasVoteEligibilityProof -> PerasCertVoters
NE (Map PerasSeatIndex PerasVoteEligibilityProof)
-> PerasCertVoters
PerasCertVoters
    (Either
   PerasConversionError
   (NEMap PerasSeatIndex PerasVoteEligibilityProof)
 -> Either PerasConversionError PerasCertVoters)
-> (NE (Map SeatIndex (Maybe (VRFOutput PerasBLSCrypto)))
    -> Either
         PerasConversionError
         (NEMap PerasSeatIndex PerasVoteEligibilityProof))
-> NE (Map SeatIndex (Maybe (VRFOutput PerasBLSCrypto)))
-> Either PerasConversionError PerasCertVoters
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (NonEmpty (PerasSeatIndex, PerasVoteEligibilityProof)
 -> NEMap PerasSeatIndex PerasVoteEligibilityProof)
-> Either
     PerasConversionError
     (NonEmpty (PerasSeatIndex, PerasVoteEligibilityProof))
-> Either
     PerasConversionError
     (NEMap PerasSeatIndex PerasVoteEligibilityProof)
forall a b.
(a -> b)
-> Either PerasConversionError a -> Either PerasConversionError b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap NonEmpty (PerasSeatIndex, PerasVoteEligibilityProof)
-> NEMap PerasSeatIndex PerasVoteEligibilityProof
forall k a. Eq k => NonEmpty (k, a) -> NEMap k a
NEMap.fromAscList
    (Either
   PerasConversionError
   (NonEmpty (PerasSeatIndex, PerasVoteEligibilityProof))
 -> Either
      PerasConversionError
      (NEMap PerasSeatIndex PerasVoteEligibilityProof))
-> (NEMap SeatIndex (Maybe (VRFOutput PerasBLSCrypto))
    -> Either
         PerasConversionError
         (NonEmpty (PerasSeatIndex, PerasVoteEligibilityProof)))
-> NEMap SeatIndex (Maybe (VRFOutput PerasBLSCrypto))
-> Either
     PerasConversionError
     (NEMap PerasSeatIndex PerasVoteEligibilityProof)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((SeatIndex, Maybe (VRFOutput PerasBLSCrypto))
 -> Either
      PerasConversionError (PerasSeatIndex, PerasVoteEligibilityProof))
-> NonEmpty (SeatIndex, Maybe (VRFOutput PerasBLSCrypto))
-> Either
     PerasConversionError
     (NonEmpty (PerasSeatIndex, PerasVoteEligibilityProof))
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
      ( \(SeatIndex
seatIndex, Maybe (VRFOutput PerasBLSCrypto)
proof) -> do
          seatIndex' <- SeatIndex -> Either PerasConversionError PerasSeatIndex
toPerasSeatIndex SeatIndex
seatIndex
          let proof' = Maybe (VRFOutput PerasBLSCrypto) -> PerasVoteEligibilityProof
toPerasVoteEligibilityProof Maybe (VRFOutput PerasBLSCrypto)
proof
          pure (seatIndex', proof')
      )
    (NonEmpty (SeatIndex, Maybe (VRFOutput PerasBLSCrypto))
 -> Either
      PerasConversionError
      (NonEmpty (PerasSeatIndex, PerasVoteEligibilityProof)))
-> (NEMap SeatIndex (Maybe (VRFOutput PerasBLSCrypto))
    -> NonEmpty (SeatIndex, Maybe (VRFOutput PerasBLSCrypto)))
-> NEMap SeatIndex (Maybe (VRFOutput PerasBLSCrypto))
-> Either
     PerasConversionError
     (NonEmpty (PerasSeatIndex, PerasVoteEligibilityProof))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NEMap SeatIndex (Maybe (VRFOutput PerasBLSCrypto))
-> NonEmpty (SeatIndex, Maybe (VRFOutput PerasBLSCrypto))
forall k a. NEMap k a -> NonEmpty (k, a)
NEMap.toAscList
    (NE (Map SeatIndex (Maybe (VRFOutput PerasBLSCrypto)))
 -> Either PerasConversionError PerasCertVoters)
-> NE (Map SeatIndex (Maybe (VRFOutput PerasBLSCrypto)))
-> Either PerasConversionError PerasCertVoters
forall a b. (a -> b) -> a -> b
$ NE (Map SeatIndex (Maybe (VRFOutput PerasBLSCrypto)))
voters
 where
  toPerasVoteEligibilityProof :: Maybe (VRFOutput PerasBLSCrypto) -> PerasVoteEligibilityProof
toPerasVoteEligibilityProof = \case
    Maybe (VRFOutput PerasBLSCrypto)
Nothing -> PerasVoteEligibilityProof
PersistentPerasVoteEligibilityProof
    Just VRFOutput PerasBLSCrypto
vrfOutput -> VRFOutput PerasBLSCrypto -> PerasVoteEligibilityProof
NonPersistentPerasVoteEligibilityProof VRFOutput PerasBLSCrypto
vrfOutput

-- 'PerasCert's are compatible with 'WFALS' as long as we make sure to avoid
-- overflowing the `Word16` seat index of each voter.
instance
  PerasCertCompatibleWithVotingCommittee
    (PerasCert blk)
    PerasBLSCrypto
    WFALS
  where
  toPerasCert :: Cert PerasBLSCrypto WFALS
-> Either PerasConversionError (PerasCert blk)
toPerasCert = \case
    WFALSCert ElectionId PerasBLSCrypto
electionId VoteCandidate PerasBLSCrypto
candidate NE (Map SeatIndex (Maybe (VRFOutput PerasBLSCrypto)))
voters AggregateVoteSignature PerasBLSCrypto
sig -> do
      voters' <- NE (Map SeatIndex (Maybe (VRFOutput PerasBLSCrypto)))
-> Either PerasConversionError PerasCertVoters
toPerasCertVoters NE (Map SeatIndex (Maybe (VRFOutput PerasBLSCrypto)))
voters
      pure $
        PerasCert
          { pcRoundNo = electionId
          , pcBoostedBlock = candidate
          , pcVoters = voters'
          , pcSignature = sig
          }

  fromPerasCert :: PerasCert blk
-> Either PerasConversionError (Cert PerasBLSCrypto WFALS)
fromPerasCert = \case
    PerasCert PerasRoundNo
electionId PerasBoostedBlock
candidate PerasCertVoters
voters AggregateVoteSignature PerasBLSCrypto
sig -> do
      let voters' :: NE (Map SeatIndex (Maybe (VRFOutput PerasBLSCrypto)))
voters' = PerasCertVoters
-> NE (Map SeatIndex (Maybe (VRFOutput PerasBLSCrypto)))
fromPerasCertVoters PerasCertVoters
voters
      Cert PerasBLSCrypto WFALS
-> Either PerasConversionError (Cert PerasBLSCrypto WFALS)
forall a. a -> Either PerasConversionError a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Cert PerasBLSCrypto WFALS
 -> Either PerasConversionError (Cert PerasBLSCrypto WFALS))
-> Cert PerasBLSCrypto WFALS
-> Either PerasConversionError (Cert PerasBLSCrypto WFALS)
forall a b. (a -> b) -> a -> b
$
        ElectionId PerasBLSCrypto
-> VoteCandidate PerasBLSCrypto
-> NE (Map SeatIndex (Maybe (VRFOutput PerasBLSCrypto)))
-> AggregateVoteSignature PerasBLSCrypto
-> Cert PerasBLSCrypto WFALS
forall crypto.
ElectionId crypto
-> VoteCandidate crypto
-> NE (Map SeatIndex (Maybe (VRFOutput crypto)))
-> AggregateVoteSignature crypto
-> Cert crypto WFALS
WFALSCert
          ElectionId PerasBLSCrypto
PerasRoundNo
electionId
          VoteCandidate PerasBLSCrypto
PerasBoostedBlock
candidate
          NE (Map SeatIndex (Maybe (VRFOutput PerasBLSCrypto)))
voters'
          AggregateVoteSignature PerasBLSCrypto
sig

-- 'PerasCert's are compatible with 'EveryoneVotes' as long as we make sure
-- to only accept certificates containing only persistent eligibility proofs
-- (in addition to avoiding overflowing the `Word16` seat index of each voter).
instance
  PerasCertCompatibleWithVotingCommittee
    (PerasCert blk)
    PerasBLSCrypto
    EveryoneVotes
  where
  toPerasCert :: Cert PerasBLSCrypto EveryoneVotes
-> Either PerasConversionError (PerasCert blk)
toPerasCert = \case
    EveryoneVotesCert ElectionId PerasBLSCrypto
electionId VoteCandidate PerasBLSCrypto
candidate NE (Set SeatIndex)
voters AggregateVoteSignature PerasBLSCrypto
sig -> do
      voters' <-
        NEMap SeatIndex (Maybe (VRFOutput PerasBLSCrypto))
-> Either PerasConversionError PerasCertVoters
NE (Map SeatIndex (Maybe (VRFOutput PerasBLSCrypto)))
-> Either PerasConversionError PerasCertVoters
toPerasCertVoters
          (NEMap SeatIndex (Maybe (VRFOutput PerasBLSCrypto))
 -> Either PerasConversionError PerasCertVoters)
-> (NE (Set SeatIndex)
    -> NEMap SeatIndex (Maybe (VRFOutput PerasBLSCrypto)))
-> NE (Set SeatIndex)
-> Either PerasConversionError PerasCertVoters
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SeatIndex -> Maybe (VRFOutput PerasBLSCrypto))
-> NESet SeatIndex
-> NEMap SeatIndex (Maybe (VRFOutput PerasBLSCrypto))
forall k a. (k -> a) -> NESet k -> NEMap k a
NEMap.fromSet (Maybe (VRFOutput PerasBLSCrypto)
-> SeatIndex -> Maybe (VRFOutput PerasBLSCrypto)
forall a b. a -> b -> a
const Maybe (VRFOutput PerasBLSCrypto)
forall a. Maybe a
Nothing)
          (NE (Set SeatIndex) -> Either PerasConversionError PerasCertVoters)
-> NE (Set SeatIndex)
-> Either PerasConversionError PerasCertVoters
forall a b. (a -> b) -> a -> b
$ NE (Set SeatIndex)
voters
      pure $
        PerasCert
          { pcRoundNo = electionId
          , pcBoostedBlock = candidate
          , pcVoters = voters'
          , pcSignature = sig
          }

  fromPerasCert :: PerasCert blk
-> Either PerasConversionError (Cert PerasBLSCrypto EveryoneVotes)
fromPerasCert = \case
    PerasCert PerasRoundNo
electionId PerasBoostedBlock
candidate PerasCertVoters
voters AggregateVoteSignature PerasBLSCrypto
sig -> do
      let voters' :: NE (Map SeatIndex (Maybe (VRFOutput PerasBLSCrypto)))
voters' = PerasCertVoters
-> NE (Map SeatIndex (Maybe (VRFOutput PerasBLSCrypto)))
fromPerasCertVoters PerasCertVoters
voters
      case NEMap SeatIndex (Maybe (VRFOutput PerasBLSCrypto))
-> Maybe (NonEmpty SeatIndex)
forall {a} {a}. NEMap a (Maybe a) -> Maybe (NonEmpty a)
nonPersistentVoters NEMap SeatIndex (Maybe (VRFOutput PerasBLSCrypto))
NE (Map SeatIndex (Maybe (VRFOutput PerasBLSCrypto)))
voters' of
        Maybe (NonEmpty SeatIndex)
Nothing ->
          Cert PerasBLSCrypto EveryoneVotes
-> Either PerasConversionError (Cert PerasBLSCrypto EveryoneVotes)
forall a. a -> Either PerasConversionError a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Cert PerasBLSCrypto EveryoneVotes
 -> Either PerasConversionError (Cert PerasBLSCrypto EveryoneVotes))
-> Cert PerasBLSCrypto EveryoneVotes
-> Either PerasConversionError (Cert PerasBLSCrypto EveryoneVotes)
forall a b. (a -> b) -> a -> b
$
            ElectionId PerasBLSCrypto
-> VoteCandidate PerasBLSCrypto
-> NE (Set SeatIndex)
-> AggregateVoteSignature PerasBLSCrypto
-> Cert PerasBLSCrypto EveryoneVotes
forall crypto.
ElectionId crypto
-> VoteCandidate crypto
-> NE (Set SeatIndex)
-> AggregateVoteSignature crypto
-> Cert crypto EveryoneVotes
EveryoneVotesCert
              ElectionId PerasBLSCrypto
PerasRoundNo
electionId
              VoteCandidate PerasBLSCrypto
PerasBoostedBlock
candidate
              (NEMap SeatIndex (Maybe (VRFOutput PerasBLSCrypto))
-> NESet SeatIndex
forall k a. NEMap k a -> NESet k
NEMap.keysSet NEMap SeatIndex (Maybe (VRFOutput PerasBLSCrypto))
NE (Map SeatIndex (Maybe (VRFOutput PerasBLSCrypto)))
voters')
              AggregateVoteSignature PerasBLSCrypto
sig
        Just NonEmpty SeatIndex
nonPersistentSeatIndices ->
          PerasConversionError
-> Either PerasConversionError (Cert PerasBLSCrypto EveryoneVotes)
forall a b. a -> Either a b
Left (PerasConversionError
 -> Either PerasConversionError (Cert PerasBLSCrypto EveryoneVotes))
-> PerasConversionError
-> Either PerasConversionError (Cert PerasBLSCrypto EveryoneVotes)
forall a b. (a -> b) -> a -> b
$
            NE [SeatIndex] -> PerasConversionError
EveryoneVotesButFoundNonPersistentVotersInCert
              NonEmpty SeatIndex
NE [SeatIndex]
nonPersistentSeatIndices
   where
    nonPersistentVoters :: NEMap a (Maybe a) -> Maybe (NonEmpty a)
nonPersistentVoters NEMap a (Maybe a)
voters' =
      case Map a (Maybe a) -> [a]
forall k a. Map k a -> [k]
Map.keys ((Maybe a -> Bool) -> NEMap a (Maybe a) -> Map a (Maybe a)
forall a k. (a -> Bool) -> NEMap k a -> Map k a
NEMap.filter Maybe a -> Bool
forall a. Maybe a -> Bool
isJust NEMap a (Maybe a)
voters') of
        [] ->
          Maybe (NonEmpty a)
forall a. Maybe a
Nothing
        [a]
nonPersistentSeats ->
          NonEmpty a -> Maybe (NonEmpty a)
forall a. a -> Maybe a
Just ([a] -> NonEmpty a
forall a. HasCallStack => [a] -> NonEmpty a
NonEmpty.fromList [a]
nonPersistentSeats)