{-# LANGUAGE GADTs #-}
{-# LANGUAGE StandaloneDeriving #-}

-- | Instantiate 'ObjectPoolReader' and 'ObjectPoolWriter' using Peras
-- votes from the 'PerasVoteDB' (or the 'ChainDB' which is wrapping the
-- 'PerasVoteDB').
module Ouroboros.Consensus.MiniProtocol.ObjectDiffusion.ObjectPool.PerasVote
  ( makePerasVotePoolReaderFromVoteDB
  , makePerasVotePoolWriterFromVoteDB
  , makePerasVotePoolReaderFromChainDB
  , makePerasVotePoolWriterFromChainDB
  ) where

import Control.Monad (join)
import Data.Either (partitionEithers)
import Data.Functor (void)
import Data.Map (Map)
import qualified Data.Map as Map
import Data.Set (Set)
import qualified Data.Set as Set
import GHC.Exception (throw)
import Ouroboros.Consensus.Block
import Ouroboros.Consensus.BlockchainTime.WallClock.Types
  ( SystemTime (..)
  , WithArrivalTime (..)
  )
import Ouroboros.Consensus.MiniProtocol.ObjectDiffusion.ObjectPool.API
import Ouroboros.Consensus.Storage.ChainDB.API (ChainDB)
import qualified Ouroboros.Consensus.Storage.ChainDB.API as ChainDB
import Ouroboros.Consensus.Storage.PerasVoteDB.API
  ( PerasVoteDB
  , PerasVoteTicketNo
  , zeroPerasVoteTicketNo
  )
import qualified Ouroboros.Consensus.Storage.PerasVoteDB.API as PerasVoteDB
import Ouroboros.Consensus.Util.IOLike

-- | TODO: replace by `Data.Map.take` as soon as we move to GHC 9.8
takeAscMap :: Int -> Map k v -> Map k v
takeAscMap :: forall k v. Int -> Map k v -> Map k v
takeAscMap Int
n = [(k, v)] -> Map k v
forall k a. [(k, a)] -> Map k a
Map.fromDistinctAscList ([(k, v)] -> Map k v)
-> (Map k v -> [(k, v)]) -> Map k v -> Map k v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [(k, v)] -> [(k, v)]
forall a. Int -> [a] -> [a]
take Int
n ([(k, v)] -> [(k, v)])
-> (Map k v -> [(k, v)]) -> Map k v -> [(k, v)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map k v -> [(k, v)]
forall k a. Map k a -> [(k, a)]
Map.toAscList

-------------------------------------------------------------------------------
-- Readers
-------------------------------------------------------------------------------

-- | Internal helper: create a pool reader from a @getVotesAfter@ function.
makePerasVotePoolReader ::
  IOLike m =>
  ( PerasVoteTicketNo ->
    STM m (Map PerasVoteTicketNo (WithArrivalTime (ValidatedPerasVote blk)))
  ) ->
  ObjectPoolReader PerasVoteId (PerasVote blk) PerasVoteTicketNo m
makePerasVotePoolReader :: forall (m :: * -> *) blk.
IOLike m =>
(PerasVoteTicketNo
 -> STM
      m
      (Map PerasVoteTicketNo (WithArrivalTime (ValidatedPerasVote blk))))
-> ObjectPoolReader PerasVoteId (PerasVote blk) PerasVoteTicketNo m
makePerasVotePoolReader PerasVoteTicketNo
-> STM
     m
     (Map PerasVoteTicketNo (WithArrivalTime (ValidatedPerasVote blk)))
getVotesAfterSTM =
  ObjectPoolReader
    { oprObjectId :: PerasVote' blk -> PerasVoteId
oprObjectId = PerasVote' blk -> PerasVoteId
forall vote blk. IsPerasVote vote blk => vote -> PerasVoteId
getPerasVoteId
    , oprZeroTicketNo :: PerasVoteTicketNo
oprZeroTicketNo = PerasVoteTicketNo
zeroPerasVoteTicketNo
    , oprObjectsAfter :: PerasVoteTicketNo
-> Word64
-> STM m (Maybe (m (Map PerasVoteTicketNo (PerasVote' blk))))
oprObjectsAfter = \PerasVoteTicketNo
lastKnown Word64
limit -> do
        votesAfterLastKnownNoLimit <- PerasVoteTicketNo
-> STM
     m
     (Map PerasVoteTicketNo (WithArrivalTime (ValidatedPerasVote blk)))
getVotesAfterSTM PerasVoteTicketNo
lastKnown
        if Map.null votesAfterLastKnownNoLimit
          then pure Nothing
          else pure . Just $ do
            let votesAfterLastKnown = Int
-> Map PerasVoteTicketNo (WithArrivalTime (ValidatedPerasVote blk))
-> Map PerasVoteTicketNo (WithArrivalTime (ValidatedPerasVote blk))
forall k v. Int -> Map k v -> Map k v
takeAscMap (Word64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
limit) Map PerasVoteTicketNo (WithArrivalTime (ValidatedPerasVote blk))
votesAfterLastKnownNoLimit
            pure $ Map.map (vpvVote . forgetArrivalTime) votesAfterLastKnown
    }

makePerasVotePoolReaderFromVoteDB ::
  IOLike m =>
  PerasVoteDB m blk ->
  ObjectPoolReader PerasVoteId (PerasVote blk) PerasVoteTicketNo m
makePerasVotePoolReaderFromVoteDB :: forall (m :: * -> *) blk.
IOLike m =>
PerasVoteDB m blk
-> ObjectPoolReader PerasVoteId (PerasVote blk) PerasVoteTicketNo m
makePerasVotePoolReaderFromVoteDB PerasVoteDB m blk
perasVoteDB =
  (PerasVoteTicketNo
 -> STM
      m
      (Map PerasVoteTicketNo (WithArrivalTime (ValidatedPerasVote blk))))
-> ObjectPoolReader PerasVoteId (PerasVote blk) PerasVoteTicketNo m
forall (m :: * -> *) blk.
IOLike m =>
(PerasVoteTicketNo
 -> STM
      m
      (Map PerasVoteTicketNo (WithArrivalTime (ValidatedPerasVote blk))))
-> ObjectPoolReader PerasVoteId (PerasVote blk) PerasVoteTicketNo m
makePerasVotePoolReader
    (PerasVoteDB m blk
-> PerasVoteTicketNo
-> STM
     m
     (Map PerasVoteTicketNo (WithArrivalTime (ValidatedPerasVote blk)))
forall (m :: * -> *) blk.
PerasVoteDB m blk
-> PerasVoteTicketNo
-> STM
     m
     (Map PerasVoteTicketNo (WithArrivalTime (ValidatedPerasVote blk)))
PerasVoteDB.getVotesAfter PerasVoteDB m blk
perasVoteDB)

makePerasVotePoolReaderFromChainDB ::
  IOLike m =>
  ChainDB m blk ->
  ObjectPoolReader PerasVoteId (PerasVote blk) PerasVoteTicketNo m
makePerasVotePoolReaderFromChainDB :: forall (m :: * -> *) blk.
IOLike m =>
ChainDB m blk
-> ObjectPoolReader PerasVoteId (PerasVote blk) PerasVoteTicketNo m
makePerasVotePoolReaderFromChainDB ChainDB m blk
chainDB =
  (PerasVoteTicketNo
 -> STM
      m
      (Map PerasVoteTicketNo (WithArrivalTime (ValidatedPerasVote blk))))
-> ObjectPoolReader PerasVoteId (PerasVote blk) PerasVoteTicketNo m
forall (m :: * -> *) blk.
IOLike m =>
(PerasVoteTicketNo
 -> STM
      m
      (Map PerasVoteTicketNo (WithArrivalTime (ValidatedPerasVote blk))))
-> ObjectPoolReader PerasVoteId (PerasVote blk) PerasVoteTicketNo m
makePerasVotePoolReader
    (ChainDB m blk
-> PerasVoteTicketNo
-> STM
     m
     (Map PerasVoteTicketNo (WithArrivalTime (ValidatedPerasVote blk)))
forall (m :: * -> *) blk.
ChainDB m blk
-> PerasVoteTicketNo
-> STM
     m
     (Map PerasVoteTicketNo (WithArrivalTime (ValidatedPerasVote blk)))
ChainDB.getPerasVotesAfter ChainDB m blk
chainDB)

-------------------------------------------------------------------------------
-- Writers
-------------------------------------------------------------------------------

-- | Create a pool writer directly from a 'PerasVoteDB'.
-- In particular, the result of 'addVote' is ignored, so any produced cert will
-- have to be handled manually by another mean. This function is mostly meant
-- for tests against the 'PerasVoteDB' in isolation; for actual production use,
-- see 'makePerasVotePoolWriterFromChainDB' which creates a pool writer from the
-- 'ChainDB' and thus properly handles the produced certs.
makePerasVotePoolWriterFromVoteDB ::
  (StandardHash blk, IOLike m) =>
  SystemTime m ->
  -- | This is needed for validating votes (since it is during the validation of
  -- votes that we give them a verified weight. In the future, we won't read it
  -- from the stake distr directly, but rather use the committee selection data)
  STM m PerasVoteStakeDistr ->
  PerasVoteDB m blk ->
  ObjectPoolWriter PerasVoteId (PerasVote blk) m
makePerasVotePoolWriterFromVoteDB :: forall blk (m :: * -> *).
(StandardHash blk, IOLike m) =>
SystemTime m
-> STM m PerasVoteStakeDistr
-> PerasVoteDB m blk
-> ObjectPoolWriter PerasVoteId (PerasVote blk) m
makePerasVotePoolWriterFromVoteDB SystemTime m
systemTime STM m PerasVoteStakeDistr
getStakeDistrSTM PerasVoteDB m blk
perasVoteDB =
  ObjectPoolWriter
    { opwObjectId :: PerasVote' blk -> PerasVoteId
opwObjectId = PerasVote' blk -> PerasVoteId
forall vote blk. IsPerasVote vote blk => vote -> PerasVoteId
getPerasVoteId
    , opwAddObjects :: [PerasVote' blk] -> m ()
opwAddObjects = \[PerasVote' blk]
votes ->
        SystemTime m
-> STM m (Set PerasVoteId)
-> (PerasVote blk
    -> STM m (Either (PerasError blk) (ValidatedPerasVote blk)))
-> (WithArrivalTime (ValidatedPerasVote blk) -> m ())
-> [PerasVote blk]
-> m ()
forall (m :: * -> *) blk.
MonadSTM m =>
SystemTime m
-> STM m (Set PerasVoteId)
-> (PerasVote blk
    -> STM m (Either (PerasError blk) (ValidatedPerasVote blk)))
-> (WithArrivalTime (ValidatedPerasVote blk) -> m ())
-> [PerasVote blk]
-> m ()
processVotes
          SystemTime m
systemTime
          (PerasVoteDB m blk -> STM m (Set PerasVoteId)
forall (m :: * -> *) blk.
PerasVoteDB m blk -> STM m (Set PerasVoteId)
PerasVoteDB.getVoteIds PerasVoteDB m blk
perasVoteDB)
          -- TODO: in the future we won't need just the stake distribution for
          -- validating votes, but also the whole committee selection context
          -- (containing vote weights of committee members = voters)
          (\PerasVote blk
vote -> STM m PerasVoteStakeDistr
getStakeDistrSTM STM m PerasVoteStakeDistr
-> (PerasVoteStakeDistr
    -> STM m (Either (VoidPerasError blk) (ValidatedPerasVote blk)))
-> STM m (Either (VoidPerasError blk) (ValidatedPerasVote blk))
forall a b. STM m a -> (a -> STM m b) -> STM m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \PerasVoteStakeDistr
sd -> Either (VoidPerasError blk) (ValidatedPerasVote blk)
-> STM m (Either (VoidPerasError blk) (ValidatedPerasVote blk))
forall a. a -> STM m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either (VoidPerasError blk) (ValidatedPerasVote blk)
 -> STM m (Either (VoidPerasError blk) (ValidatedPerasVote blk)))
-> Either (VoidPerasError blk) (ValidatedPerasVote blk)
-> STM m (Either (VoidPerasError blk) (ValidatedPerasVote blk))
forall a b. (a -> b) -> a -> b
$ PerasParams blk
-> PerasVoteStakeDistr
-> PerasVote blk
-> Either (PerasError blk) (ValidatedPerasVote blk)
forall blk.
BlockSupportsPeras blk =>
PerasParams blk
-> PerasVoteStakeDistr
-> PerasVote blk
-> Either (PerasError blk) (ValidatedPerasVote blk)
validatePerasVote PerasParams blk
forall blk. PerasParams blk
defaultPerasParams PerasVoteStakeDistr
sd PerasVote blk
vote)
          (m (AddPerasVoteResult blk) -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (m (AddPerasVoteResult blk) -> m ())
-> (WithArrivalTime (ValidatedPerasVote blk)
    -> m (AddPerasVoteResult blk))
-> WithArrivalTime (ValidatedPerasVote blk)
-> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m (m (AddPerasVoteResult blk)) -> m (AddPerasVoteResult blk)
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (m (m (AddPerasVoteResult blk)) -> m (AddPerasVoteResult blk))
-> (WithArrivalTime (ValidatedPerasVote blk)
    -> m (m (AddPerasVoteResult blk)))
-> WithArrivalTime (ValidatedPerasVote blk)
-> m (AddPerasVoteResult blk)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. STM m (m (AddPerasVoteResult blk))
-> m (m (AddPerasVoteResult blk))
forall a. HasCallStack => STM m a -> m a
forall (m :: * -> *) a.
(MonadSTM m, HasCallStack) =>
STM m a -> m a
atomically (STM m (m (AddPerasVoteResult blk))
 -> m (m (AddPerasVoteResult blk)))
-> (WithArrivalTime (ValidatedPerasVote blk)
    -> STM m (m (AddPerasVoteResult blk)))
-> WithArrivalTime (ValidatedPerasVote blk)
-> m (m (AddPerasVoteResult blk))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PerasVoteDB m blk
-> WithArrivalTime (ValidatedPerasVote blk)
-> STM m (m (AddPerasVoteResult blk))
forall (m :: * -> *) blk.
PerasVoteDB m blk
-> WithArrivalTime (ValidatedPerasVote blk)
-> STM m (m (AddPerasVoteResult blk))
PerasVoteDB.addVote PerasVoteDB m blk
perasVoteDB)
          [PerasVote blk]
[PerasVote' blk]
votes
    , opwHasObject :: STM m (PerasVoteId -> Bool)
opwHasObject = do
        voteIds <- PerasVoteDB m blk -> STM m (Set PerasVoteId)
forall (m :: * -> *) blk.
PerasVoteDB m blk -> STM m (Set PerasVoteId)
PerasVoteDB.getVoteIds PerasVoteDB m blk
perasVoteDB
        pure $ \PerasVoteId
voteId -> PerasVoteId -> Set PerasVoteId -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.member PerasVoteId
voteId Set PerasVoteId
voteIds
    }

-- | Create a pool writer from the 'ChainDB'.
-- This properly handles the produced certs by letting the ChainDB take care
-- of them (see 'ChainDB.addPerasVoteWithAsyncCertHandling').
makePerasVotePoolWriterFromChainDB ::
  (StandardHash blk, IOLike m) =>
  SystemTime m ->
  -- | This is needed for validating votes (since its during the validation of
  -- votes that we give them a verified weight. In the future, we won't read it
  -- from the stake distr directly, but rather use the committee selection data)
  STM m PerasVoteStakeDistr ->
  ChainDB m blk ->
  ObjectPoolWriter PerasVoteId (PerasVote blk) m
makePerasVotePoolWriterFromChainDB :: forall blk (m :: * -> *).
(StandardHash blk, IOLike m) =>
SystemTime m
-> STM m PerasVoteStakeDistr
-> ChainDB m blk
-> ObjectPoolWriter PerasVoteId (PerasVote blk) m
makePerasVotePoolWriterFromChainDB SystemTime m
systemTime STM m PerasVoteStakeDistr
getStakeDistrSTM ChainDB m blk
chainDB =
  ObjectPoolWriter
    { opwObjectId :: PerasVote' blk -> PerasVoteId
opwObjectId = PerasVote' blk -> PerasVoteId
forall vote blk. IsPerasVote vote blk => vote -> PerasVoteId
getPerasVoteId
    , opwAddObjects :: [PerasVote' blk] -> m ()
opwAddObjects = \[PerasVote' blk]
votes ->
        SystemTime m
-> STM m (Set PerasVoteId)
-> (PerasVote blk
    -> STM m (Either (PerasError blk) (ValidatedPerasVote blk)))
-> (WithArrivalTime (ValidatedPerasVote blk) -> m ())
-> [PerasVote blk]
-> m ()
forall (m :: * -> *) blk.
MonadSTM m =>
SystemTime m
-> STM m (Set PerasVoteId)
-> (PerasVote blk
    -> STM m (Either (PerasError blk) (ValidatedPerasVote blk)))
-> (WithArrivalTime (ValidatedPerasVote blk) -> m ())
-> [PerasVote blk]
-> m ()
processVotes
          SystemTime m
systemTime
          (ChainDB m blk -> STM m (Set PerasVoteId)
forall (m :: * -> *) blk. ChainDB m blk -> STM m (Set PerasVoteId)
ChainDB.getPerasVoteIds ChainDB m blk
chainDB)
          -- TODO: in the future we won't need just the stake distribution for
          -- validating votes, but also the whole committee selection context
          -- (containing vote weights of committee members = voters)
          (\PerasVote blk
vote -> STM m PerasVoteStakeDistr
getStakeDistrSTM STM m PerasVoteStakeDistr
-> (PerasVoteStakeDistr
    -> STM m (Either (VoidPerasError blk) (ValidatedPerasVote blk)))
-> STM m (Either (VoidPerasError blk) (ValidatedPerasVote blk))
forall a b. STM m a -> (a -> STM m b) -> STM m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \PerasVoteStakeDistr
sd -> Either (VoidPerasError blk) (ValidatedPerasVote blk)
-> STM m (Either (VoidPerasError blk) (ValidatedPerasVote blk))
forall a. a -> STM m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either (VoidPerasError blk) (ValidatedPerasVote blk)
 -> STM m (Either (VoidPerasError blk) (ValidatedPerasVote blk)))
-> Either (VoidPerasError blk) (ValidatedPerasVote blk)
-> STM m (Either (VoidPerasError blk) (ValidatedPerasVote blk))
forall a b. (a -> b) -> a -> b
$ PerasParams blk
-> PerasVoteStakeDistr
-> PerasVote blk
-> Either (PerasError blk) (ValidatedPerasVote blk)
forall blk.
BlockSupportsPeras blk =>
PerasParams blk
-> PerasVoteStakeDistr
-> PerasVote blk
-> Either (PerasError blk) (ValidatedPerasVote blk)
validatePerasVote PerasParams blk
forall blk. PerasParams blk
defaultPerasParams PerasVoteStakeDistr
sd PerasVote blk
vote)
          -- We do not want to block the writer thread on waiting for ChainSel
          -- side-effects to complete, so we use the async version of adding
          -- votes to the ChainDB and ignore the returned promise.
          -- The async action (if any) is still launched and executed behind the
          -- scenes even though we drop the promise.
          (m (AddPerasVoteResult blk, Maybe (AddPerasCertPromise m)) -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (m (AddPerasVoteResult blk, Maybe (AddPerasCertPromise m)) -> m ())
-> (WithArrivalTime (ValidatedPerasVote blk)
    -> m (AddPerasVoteResult blk, Maybe (AddPerasCertPromise m)))
-> WithArrivalTime (ValidatedPerasVote blk)
-> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ChainDB m blk
-> WithArrivalTime (ValidatedPerasVote blk)
-> m (AddPerasVoteResult blk, Maybe (AddPerasCertPromise m))
forall (m :: * -> *) blk.
ChainDB m blk
-> WithArrivalTime (ValidatedPerasVote blk)
-> m (AddPerasVoteResult blk, Maybe (AddPerasCertPromise m))
ChainDB.addPerasVoteWithAsyncCertHandling ChainDB m blk
chainDB)
          [PerasVote blk]
[PerasVote' blk]
votes
    , opwHasObject :: STM m (PerasVoteId -> Bool)
opwHasObject = do
        voteIds <- ChainDB m blk -> STM m (Set PerasVoteId)
forall (m :: * -> *) blk. ChainDB m blk -> STM m (Set PerasVoteId)
ChainDB.getPerasVoteIds ChainDB m blk
chainDB
        pure $ \PerasVoteId
voteId -> PerasVoteId -> Set PerasVoteId -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.member PerasVoteId
voteId Set PerasVoteId
voteIds
    }

data PerasVoteInboundException
  = forall blk. PerasVoteValidationError [PerasError blk]

deriving instance Show PerasVoteInboundException

instance Exception PerasVoteInboundException

-- | Process a batch of inbound Peras votes received from a peer.
--
-- Votes whose ID is already present in the database (as determined by
-- @alreadyInDbSTM@) are silently skipped. The remaining votes are validated;
-- if /any/ vote in the batch fails validation, the entire batch is rejected
-- by throwing a 'PerasVoteInboundException' (which should make us disconnect
-- from the distant peer, see 'withPeer' bracket function from
-- `ouroboros-network`). Otherwise, each valid vote is timestamped with the
-- current wall-clock time and added to the database via @addVote@.
processVotes ::
  MonadSTM m =>
  SystemTime m ->
  STM m (Set PerasVoteId) ->
  (PerasVote blk -> STM m (Either (PerasError blk) (ValidatedPerasVote blk))) ->
  (WithArrivalTime (ValidatedPerasVote blk) -> m ()) ->
  [PerasVote blk] ->
  m ()
processVotes :: forall (m :: * -> *) blk.
MonadSTM m =>
SystemTime m
-> STM m (Set PerasVoteId)
-> (PerasVote blk
    -> STM m (Either (PerasError blk) (ValidatedPerasVote blk)))
-> (WithArrivalTime (ValidatedPerasVote blk) -> m ())
-> [PerasVote blk]
-> m ()
processVotes SystemTime m
systemTime STM m (Set PerasVoteId)
alreadyInDbSTM PerasVote blk
-> STM m (Either (PerasError blk) (ValidatedPerasVote blk))
validateVote WithArrivalTime (ValidatedPerasVote blk) -> m ()
addVote [PerasVote blk]
votes = do
  validationResults <- STM m [Either (VoidPerasError blk) (ValidatedPerasVote blk)]
-> m [Either (VoidPerasError blk) (ValidatedPerasVote blk)]
forall a. HasCallStack => STM m a -> m a
forall (m :: * -> *) a.
(MonadSTM m, HasCallStack) =>
STM m a -> m a
atomically (STM m [Either (VoidPerasError blk) (ValidatedPerasVote blk)]
 -> m [Either (VoidPerasError blk) (ValidatedPerasVote blk)])
-> STM m [Either (VoidPerasError blk) (ValidatedPerasVote blk)]
-> m [Either (VoidPerasError blk) (ValidatedPerasVote blk)]
forall a b. (a -> b) -> a -> b
$ do
    alreadyInDb <- STM m (Set PerasVoteId)
alreadyInDbSTM
    let votesNotAlreadyInDb = (PerasVote' blk -> Bool) -> [PerasVote' blk] -> [PerasVote' blk]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool)
-> (PerasVote' blk -> Bool) -> PerasVote' blk -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PerasVoteId -> Set PerasVoteId -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.member` Set PerasVoteId
alreadyInDb) (PerasVoteId -> Bool)
-> (PerasVote' blk -> PerasVoteId) -> PerasVote' blk -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PerasVote' blk -> PerasVoteId
forall vote blk. IsPerasVote vote blk => vote -> PerasVoteId
getPerasVoteId) [PerasVote blk]
[PerasVote' blk]
votes
    mapM validateVote votesNotAlreadyInDb
  now <- systemTimeCurrent systemTime
  case partitionEithers validationResults of
    -- All votes are valid => add them to the pool
    ([], [ValidatedPerasVote blk]
validatedVotes) ->
      (ValidatedPerasVote blk -> m ())
-> [ValidatedPerasVote blk] -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_
        (WithArrivalTime (ValidatedPerasVote blk) -> m ()
addVote (WithArrivalTime (ValidatedPerasVote blk) -> m ())
-> (ValidatedPerasVote blk
    -> WithArrivalTime (ValidatedPerasVote blk))
-> ValidatedPerasVote blk
-> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RelativeTime
-> ValidatedPerasVote blk
-> WithArrivalTime (ValidatedPerasVote blk)
forall a. RelativeTime -> a -> WithArrivalTime a
WithArrivalTime RelativeTime
now)
        [ValidatedPerasVote blk]
validatedVotes
    -- Some votes are invalid => reject the whole batch
    --
    -- N.B. it has been requested in PR review
    -- https://github.com/IntersectMBO/ouroboros-consensus/pull/1768#discussion_r2747873186
    -- to gather all validation errors and report them together in the exception
    -- rather than just report the first error encountered.
    -- This assumes that vote validation is cheap, which may not be true in
    -- practice depending on the actual crypto/committee selection scheme.
    -- Hence we may revisit this to lazily abort validation upon the first error
    -- encountered.
    ([VoidPerasError blk]
errs, [ValidatedPerasVote blk]
_) ->
      PerasVoteInboundException -> m ()
forall a e. (HasCallStack, Exception e) => e -> a
throw ([PerasError blk] -> PerasVoteInboundException
forall blk. [PerasError blk] -> PerasVoteInboundException
PerasVoteValidationError [VoidPerasError blk]
[PerasError blk]
errs)