{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}

-- | Support for using concrete votes and certificates with multiple voting
-- committee implementations.
module Ouroboros.Consensus.Peras.Voting.Committee
  ( -- * Peras support for multiple voting committee implementations
    PerasConversionError (..)
  , PerasVoteCompatibleWithVotingCommittee (..)
  , PerasCertCompatibleWithVotingCommittee (..)
  ) where

import Data.Containers.NonEmpty (HasNonEmpty (..))
import qualified Data.List.NonEmpty as NonEmpty
import Data.Map (Map)
import qualified Data.Map as Map
import qualified Data.Map.NonEmpty as NEMap
import Data.Maybe (isJust)
import Data.Word (Word16, Word64)
import Ouroboros.Consensus.Block.SupportsPeras (PerasSeatIndex (..))
import qualified Ouroboros.Consensus.Committee.Class as Committee
import Ouroboros.Consensus.Committee.Crypto (CryptoSupportsVRF (..))
import Ouroboros.Consensus.Committee.EveryoneVotes
  ( Cert (..)
  , EveryoneVotes
  , Vote (..)
  )
import Ouroboros.Consensus.Committee.WFA (SeatIndex (..))
import Ouroboros.Consensus.Committee.WFALS (Cert (..), Vote (..), WFALS)
import qualified Ouroboros.Consensus.Peras.Cert.V1 as V1
import Ouroboros.Consensus.Peras.Crypto.BLS (PerasBLSCrypto)
import qualified Ouroboros.Consensus.Peras.Vote.V1 as V1

-- * Peras support for multiple voting committee implementations

-- | Errors that can occur when converting between Peras and committee types
data PerasConversionError
  = EveryoneVotesButFoundNonPersistentVoterInVote SeatIndex
  | EveryoneVotesButFoundNonPersistentVotersInCert (NE [SeatIndex])
  | SeatIndexOverflowError Word64
  | CryptoError String
  deriving stock (PerasConversionError -> PerasConversionError -> Bool
(PerasConversionError -> PerasConversionError -> Bool)
-> (PerasConversionError -> PerasConversionError -> Bool)
-> Eq PerasConversionError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PerasConversionError -> PerasConversionError -> Bool
== :: PerasConversionError -> PerasConversionError -> Bool
$c/= :: PerasConversionError -> PerasConversionError -> Bool
/= :: PerasConversionError -> PerasConversionError -> Bool
Eq, Int -> PerasConversionError -> ShowS
[PerasConversionError] -> ShowS
PerasConversionError -> String
(Int -> PerasConversionError -> ShowS)
-> (PerasConversionError -> String)
-> ([PerasConversionError] -> ShowS)
-> Show PerasConversionError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PerasConversionError -> ShowS
showsPrec :: Int -> PerasConversionError -> ShowS
$cshow :: PerasConversionError -> String
show :: PerasConversionError -> String
$cshowList :: [PerasConversionError] -> ShowS
showList :: [PerasConversionError] -> ShowS
Show)

-- | Conversion between (concrete) Peras votes and (abstract) committee votes.
--
-- NOTE: the functional dependency @vote -> crypto@ explicitly ties each
-- concrete Peras vote type to a specific crypto scheme.
class
  PerasVoteCompatibleWithVotingCommittee vote crypto committee
    | vote -> crypto
  where
  toPerasVote ::
    Committee.Vote crypto committee ->
    Either PerasConversionError vote
  fromPerasVote ::
    vote ->
    Either PerasConversionError (Committee.Vote crypto committee)

-- | Conversion between (concrete) Peras certificates and (abstract) committee
-- certificates.
--
-- NOTE: the functional dependency @cert -> crypto@ explicitly ties each
-- concrete Peras certificate type to a specific crypto scheme.
class
  PerasCertCompatibleWithVotingCommittee cert crypto committee
    | cert -> crypto
  where
  toPerasCert ::
    Committee.Cert crypto committee ->
    Either PerasConversionError cert
  fromPerasCert ::
    cert ->
    Either PerasConversionError (Committee.Cert crypto committee)

-- 'V1.PerasVote's are compatible with 'WFALS' as long as we make sure to avoid
-- overflowing their `Word16` seat index.
instance
  PerasVoteCompatibleWithVotingCommittee
    V1.PerasVote
    PerasBLSCrypto
    WFALS
  where
  toPerasVote :: Vote PerasBLSCrypto WFALS -> Either PerasConversionError PerasVote
toPerasVote = \case
    WFALSPersistentVote SeatIndex
seatIndex ElectionId PerasBLSCrypto
electionId VoteCandidate PerasBLSCrypto
candidate VoteSignature PerasBLSCrypto
sig -> do
      perasSeatIndex <- SeatIndex -> Either PerasConversionError PerasSeatIndex
toPerasSeatIndex SeatIndex
seatIndex
      pure $
        V1.PerasVote
          { V1.pvRoundNo = electionId
          , V1.pvBoostedBlock = candidate
          , V1.pvSeatIndex = perasSeatIndex
          , V1.pvEligibilityProof = V1.PersistentPerasVoteEligibilityProof
          , V1.pvSignature = sig
          }
    WFALSNonPersistentVote SeatIndex
seatIndex ElectionId PerasBLSCrypto
electionId VoteCandidate PerasBLSCrypto
candidate VRFOutput PerasBLSCrypto
vrfOutput VoteSignature PerasBLSCrypto
sig -> do
      perasSeatIndex <- SeatIndex -> Either PerasConversionError PerasSeatIndex
toPerasSeatIndex SeatIndex
seatIndex
      let proof = VRFOutput PerasBLSCrypto -> PerasVoteEligibilityProof
V1.NonPersistentPerasVoteEligibilityProof VRFOutput PerasBLSCrypto
vrfOutput
      pure $
        V1.PerasVote
          { V1.pvRoundNo = electionId
          , V1.pvBoostedBlock = candidate
          , V1.pvSeatIndex = perasSeatIndex
          , V1.pvEligibilityProof = proof
          , V1.pvSignature = sig
          }

  fromPerasVote :: PerasVote
-> Either PerasConversionError (Vote PerasBLSCrypto WFALS)
fromPerasVote = \case
    V1.PerasVote PerasRoundNo
electionId PerasBoostedBlock
candidate PerasSeatIndex
seatIndex PerasVoteEligibilityProof
proof VoteSignature PerasBLSCrypto
sig -> do
      let seatIndex' :: SeatIndex
seatIndex' = PerasSeatIndex -> SeatIndex
fromPerasSeatIndex PerasSeatIndex
seatIndex
      case PerasVoteEligibilityProof
proof of
        PerasVoteEligibilityProof
V1.PersistentPerasVoteEligibilityProof ->
          Vote PerasBLSCrypto WFALS
-> Either PerasConversionError (Vote PerasBLSCrypto WFALS)
forall a. a -> Either PerasConversionError a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Vote PerasBLSCrypto WFALS
 -> Either PerasConversionError (Vote PerasBLSCrypto WFALS))
-> Vote PerasBLSCrypto WFALS
-> Either PerasConversionError (Vote PerasBLSCrypto WFALS)
forall a b. (a -> b) -> a -> b
$
            SeatIndex
-> ElectionId PerasBLSCrypto
-> VoteCandidate PerasBLSCrypto
-> VoteSignature PerasBLSCrypto
-> Vote PerasBLSCrypto WFALS
forall crypto.
SeatIndex
-> ElectionId crypto
-> VoteCandidate crypto
-> VoteSignature crypto
-> Vote crypto WFALS
WFALSPersistentVote
              SeatIndex
seatIndex'
              ElectionId PerasBLSCrypto
PerasRoundNo
electionId
              VoteCandidate PerasBLSCrypto
PerasBoostedBlock
candidate
              VoteSignature PerasBLSCrypto
sig
        V1.NonPersistentPerasVoteEligibilityProof VRFOutput PerasBLSCrypto
vrfOutput ->
          Vote PerasBLSCrypto WFALS
-> Either PerasConversionError (Vote PerasBLSCrypto WFALS)
forall a. a -> Either PerasConversionError a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Vote PerasBLSCrypto WFALS
 -> Either PerasConversionError (Vote PerasBLSCrypto WFALS))
-> Vote PerasBLSCrypto WFALS
-> Either PerasConversionError (Vote PerasBLSCrypto WFALS)
forall a b. (a -> b) -> a -> b
$
            SeatIndex
-> ElectionId PerasBLSCrypto
-> VoteCandidate PerasBLSCrypto
-> VRFOutput PerasBLSCrypto
-> VoteSignature PerasBLSCrypto
-> Vote PerasBLSCrypto WFALS
forall crypto.
SeatIndex
-> ElectionId crypto
-> VoteCandidate crypto
-> VRFOutput crypto
-> VoteSignature crypto
-> Vote crypto WFALS
WFALSNonPersistentVote
              SeatIndex
seatIndex'
              ElectionId PerasBLSCrypto
PerasRoundNo
electionId
              VoteCandidate PerasBLSCrypto
PerasBoostedBlock
candidate
              VRFOutput PerasBLSCrypto
vrfOutput
              VoteSignature PerasBLSCrypto
sig

-- 'V1.PerasCert's are compatible with 'WFALS' as long as we make sure to avoid
-- overflowing the `Word16` seat index of each voter.
instance
  PerasCertCompatibleWithVotingCommittee
    V1.PerasCert
    PerasBLSCrypto
    WFALS
  where
  toPerasCert :: Cert PerasBLSCrypto WFALS -> Either PerasConversionError PerasCert
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 $
        V1.PerasCert
          { V1.pcRoundNo = electionId
          , V1.pcBoostedBlock = candidate
          , V1.pcVoters = voters'
          , V1.pcSignature = sig
          }

  fromPerasCert :: PerasCert
-> Either PerasConversionError (Cert PerasBLSCrypto WFALS)
fromPerasCert = \case
    V1.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

-- 'V1.PerasVote's are compatible with 'EveryoneVotes' as long as we make sure
-- to only accept votes with persistent eligibility proofs (in addition to
-- avoiding overflowing their `Word16` seat index).
instance
  PerasVoteCompatibleWithVotingCommittee
    V1.PerasVote
    PerasBLSCrypto
    EveryoneVotes
  where
  toPerasVote :: Vote PerasBLSCrypto EveryoneVotes
-> Either PerasConversionError PerasVote
toPerasVote = \case
    EveryoneVotesVote SeatIndex
seatIndex ElectionId PerasBLSCrypto
electionId VoteCandidate PerasBLSCrypto
candidate VoteSignature PerasBLSCrypto
sig -> do
      perasSeatIndex <- SeatIndex -> Either PerasConversionError PerasSeatIndex
toPerasSeatIndex SeatIndex
seatIndex
      pure $
        V1.PerasVote
          { V1.pvRoundNo = electionId
          , V1.pvBoostedBlock = candidate
          , V1.pvSeatIndex = perasSeatIndex
          , V1.pvEligibilityProof = V1.PersistentPerasVoteEligibilityProof
          , V1.pvSignature = sig
          }

  fromPerasVote :: PerasVote
-> Either PerasConversionError (Vote PerasBLSCrypto EveryoneVotes)
fromPerasVote = \case
    V1.PerasVote PerasRoundNo
electionId PerasBoostedBlock
candidate PerasSeatIndex
seatIndex PerasVoteEligibilityProof
proof VoteSignature PerasBLSCrypto
sig -> do
      let seatIndex' :: SeatIndex
seatIndex' = PerasSeatIndex -> SeatIndex
fromPerasSeatIndex PerasSeatIndex
seatIndex
      case PerasVoteEligibilityProof
proof of
        PerasVoteEligibilityProof
V1.PersistentPerasVoteEligibilityProof ->
          Vote PerasBLSCrypto EveryoneVotes
-> Either PerasConversionError (Vote PerasBLSCrypto EveryoneVotes)
forall a. a -> Either PerasConversionError a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Vote PerasBLSCrypto EveryoneVotes
 -> Either PerasConversionError (Vote PerasBLSCrypto EveryoneVotes))
-> Vote PerasBLSCrypto EveryoneVotes
-> Either PerasConversionError (Vote PerasBLSCrypto EveryoneVotes)
forall a b. (a -> b) -> a -> b
$
            SeatIndex
-> ElectionId PerasBLSCrypto
-> VoteCandidate PerasBLSCrypto
-> VoteSignature PerasBLSCrypto
-> Vote PerasBLSCrypto EveryoneVotes
forall crypto.
SeatIndex
-> ElectionId crypto
-> VoteCandidate crypto
-> VoteSignature crypto
-> Vote crypto EveryoneVotes
EveryoneVotesVote
              SeatIndex
seatIndex'
              ElectionId PerasBLSCrypto
PerasRoundNo
electionId
              VoteCandidate PerasBLSCrypto
PerasBoostedBlock
candidate
              VoteSignature PerasBLSCrypto
sig
        V1.NonPersistentPerasVoteEligibilityProof VRFOutput PerasBLSCrypto
_ ->
          PerasConversionError
-> Either PerasConversionError (Vote PerasBLSCrypto EveryoneVotes)
forall a b. a -> Either a b
Left (PerasConversionError
 -> Either PerasConversionError (Vote PerasBLSCrypto EveryoneVotes))
-> PerasConversionError
-> Either PerasConversionError (Vote PerasBLSCrypto EveryoneVotes)
forall a b. (a -> b) -> a -> b
$
            SeatIndex -> PerasConversionError
EveryoneVotesButFoundNonPersistentVoterInVote SeatIndex
seatIndex'

-- 'V1.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
    V1.PerasCert
    PerasBLSCrypto
    EveryoneVotes
  where
  toPerasCert :: Cert PerasBLSCrypto EveryoneVotes
-> Either PerasConversionError PerasCert
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 $
        V1.PerasCert
          { V1.pcRoundNo = electionId
          , V1.pcBoostedBlock = candidate
          , V1.pcVoters = voters'
          , V1.pcSignature = sig
          }

  fromPerasCert :: PerasCert
-> Either PerasConversionError (Cert PerasBLSCrypto EveryoneVotes)
fromPerasCert = \case
    V1.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)

-- * Helpers

-- | Convert a Peras seat index to a committee seat index.
fromPerasSeatIndex ::
  PerasSeatIndex ->
  SeatIndex
fromPerasSeatIndex :: PerasSeatIndex -> SeatIndex
fromPerasSeatIndex (PerasSeatIndex Word16
seatIndex) =
  Word64 -> SeatIndex
SeatIndex (forall a b. (Integral a, Num b) => a -> b
fromIntegral @Word16 @Word64 Word16
seatIndex)

-- | Convert a committee seat index to a Peras seat index
--
-- NOTE: this can fail if the seat index in the committee vote or certificate
-- overflows the smaller 'Word16' type used by Peras votes and certificates.
-- In practice, this should never happen unless there is a bug in the voting
-- committee logic.
toPerasSeatIndex ::
  SeatIndex ->
  Either PerasConversionError PerasSeatIndex
toPerasSeatIndex :: SeatIndex -> Either PerasConversionError PerasSeatIndex
toPerasSeatIndex (SeatIndex Word64
seatIndex)
  | Word64
seatIndex Word64 -> Word64 -> Bool
forall a. Ord a => a -> a -> Bool
<= forall a b. (Integral a, Num b) => a -> b
fromIntegral @Word16 @Word64 Word16
forall a. Bounded a => a
maxBound =
      PerasSeatIndex -> Either PerasConversionError PerasSeatIndex
forall a b. b -> Either a b
Right (Word16 -> PerasSeatIndex
PerasSeatIndex (forall a b. (Integral a, Num b) => a -> b
fromIntegral @Word64 @Word16 Word64
seatIndex))
  | Bool
otherwise =
      PerasConversionError -> Either PerasConversionError PerasSeatIndex
forall a b. a -> Either a b
Left (Word64 -> PerasConversionError
SeatIndexOverflowError Word64
seatIndex)

-- | Convert concrete Peras certificate voters to abstract committee voters
fromPerasCertVoters ::
  V1.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)
V1.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
V1.PersistentPerasVoteEligibilityProof -> Maybe (VRFOutput PerasBLSCrypto)
forall a. Maybe a
Nothing
    V1.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 V1.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
V1.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
V1.PersistentPerasVoteEligibilityProof
    Just VRFOutput PerasBLSCrypto
vrfOutput -> VRFOutput PerasBLSCrypto -> PerasVoteEligibilityProof
V1.NonPersistentPerasVoteEligibilityProof VRFOutput PerasBLSCrypto
vrfOutput