{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE ImportQualifiedPost #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE StandaloneKindSignatures #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE UndecidableInstances #-}

module Ouroboros.Consensus.Storage.PerasVoteDB.Impl
  ( -- * Opening
    PerasVoteDbArgs (..)
  , defaultArgs
  , createDB

    -- * Trace types
  , TraceEvent (..)
  ) where

import Control.Monad (when)
import Control.Monad.Except (throwError)
import Control.Tracer (Tracer, nullTracer, traceWith)
import Data.Foldable (for_)
import Data.Foldable qualified as Foldable
import Data.Kind (Type)
import Data.Map.Strict (Map)
import Data.Map.Strict qualified as Map
import Data.Set (Set)
import Data.Set qualified as Set
import GHC.Generics (Generic)
import NoThunks.Class
import Ouroboros.Consensus.Block
import Ouroboros.Consensus.BlockchainTime (WithArrivalTime (..))
import Ouroboros.Consensus.Peras.Context
import Ouroboros.Consensus.Peras.Vote.Aggregation
import Ouroboros.Consensus.Storage.PerasVoteDB.API
import Ouroboros.Consensus.Util.Args
import Ouroboros.Consensus.Util.IOLike
import Ouroboros.Consensus.Util.STM

{-------------------------------------------------------------------------------
  Database state
-------------------------------------------------------------------------------}

data PerasVoteDbEnv m blk = PerasVoteDbEnv
  { forall (m :: * -> *) blk.
PerasVoteDbEnv m blk -> Tracer m (TraceEvent blk)
pvdeTracer :: !(Tracer m (TraceEvent blk))
  , forall (m :: * -> *) blk.
PerasVoteDbEnv m blk
-> StrictTVar m (WithFingerprint (PerasVoteDbState blk))
pvdeState :: !(StrictTVar m (WithFingerprint (PerasVoteDbState blk)))
  -- ^ The 'RoundNo's of all votes currently in the db.
  }
  deriving Context -> PerasVoteDbEnv m blk -> IO (Maybe ThunkInfo)
Proxy (PerasVoteDbEnv m blk) -> String
(Context -> PerasVoteDbEnv m blk -> IO (Maybe ThunkInfo))
-> (Context -> PerasVoteDbEnv m blk -> IO (Maybe ThunkInfo))
-> (Proxy (PerasVoteDbEnv m blk) -> String)
-> NoThunks (PerasVoteDbEnv m blk)
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
forall (m :: * -> *) blk.
Context -> PerasVoteDbEnv m blk -> IO (Maybe ThunkInfo)
forall (m :: * -> *) blk. Proxy (PerasVoteDbEnv m blk) -> String
$cnoThunks :: forall (m :: * -> *) blk.
Context -> PerasVoteDbEnv m blk -> IO (Maybe ThunkInfo)
noThunks :: Context -> PerasVoteDbEnv m blk -> IO (Maybe ThunkInfo)
$cwNoThunks :: forall (m :: * -> *) blk.
Context -> PerasVoteDbEnv m blk -> IO (Maybe ThunkInfo)
wNoThunks :: Context -> PerasVoteDbEnv m blk -> IO (Maybe ThunkInfo)
$cshowTypeOf :: forall (m :: * -> *) blk. Proxy (PerasVoteDbEnv m blk) -> String
showTypeOf :: Proxy (PerasVoteDbEnv m blk) -> String
NoThunks via OnlyCheckWhnfNamed "PerasVoteDbEnv" (PerasVoteDbEnv m blk)

-- INVARIANT: See 'invariantForPerasVoteDbState'.
data PerasVoteDbState blk = PerasVoteDbState
  { forall blk. PerasVoteDbState blk -> Set PerasVoteId
pvdsVoteIds :: !(Set PerasVoteId)
  , forall blk.
PerasVoteDbState blk -> Map PerasRoundNo (PerasRoundVoteState blk)
pvdsRoundVoteStates :: !(Map PerasRoundNo (PerasRoundVoteState blk))
  , forall blk.
PerasVoteDbState blk
-> Map PerasVoteTicketNo (WithArrivalTime (ValidatedPerasVote blk))
pvdsVotesByTicket :: !(Map PerasVoteTicketNo (WithArrivalTime (ValidatedPerasVote blk)))
  -- ^ The votes by 'PerasVoteTicketNo'.
  --
  -- INVARIANT: In sync with 'pvsRoundVoteStates'.
  , forall blk. PerasVoteDbState blk -> PerasVoteTicketNo
pvdsLastTicketNo :: !PerasVoteTicketNo
  -- ^ The most recent 'PerasVoteTicketNo' (or 'zeroPerasVoteTicketNo' otherwise).
  }

deriving instance
  ( StandardHash blk
  , Show (PerasVote blk)
  , Show (PerasCert blk)
  , Show (PerasVotingCommittee blk)
  ) =>
  Show (PerasVoteDbState blk)
deriving instance
  ( StandardHash blk
  , Eq (PerasVote blk)
  , Eq (PerasCert blk)
  , Eq (PerasVotingCommittee blk)
  ) =>
  Eq (PerasVoteDbState blk)
deriving instance
  ( StandardHash blk
  , NoThunks (PerasVote blk)
  , NoThunks (PerasCert blk)
  , NoThunks (PerasVotingCommittee blk)
  ) =>
  NoThunks (PerasVoteDbState blk)
deriving instance
  Generic (PerasVoteDbState blk)

initialPerasVoteDbState :: WithFingerprint (PerasVoteDbState blk)
initialPerasVoteDbState :: forall blk. WithFingerprint (PerasVoteDbState blk)
initialPerasVoteDbState =
  PerasVoteDbState blk
-> Fingerprint -> WithFingerprint (PerasVoteDbState blk)
forall a. a -> Fingerprint -> WithFingerprint a
WithFingerprint
    PerasVoteDbState
      { pvdsVoteIds :: Set PerasVoteId
pvdsVoteIds = Set PerasVoteId
forall a. Set a
Set.empty
      , pvdsRoundVoteStates :: Map PerasRoundNo (PerasRoundVoteState blk)
pvdsRoundVoteStates = Map PerasRoundNo (PerasRoundVoteState blk)
forall k a. Map k a
Map.empty
      , pvdsVotesByTicket :: Map PerasVoteTicketNo (WithArrivalTime (ValidatedPerasVote blk))
pvdsVotesByTicket = Map PerasVoteTicketNo (WithArrivalTime (ValidatedPerasVote blk))
forall k a. Map k a
Map.empty
      , pvdsLastTicketNo :: PerasVoteTicketNo
pvdsLastTicketNo = PerasVoteTicketNo
zeroPerasVoteTicketNo
      }
    (Word64 -> Fingerprint
Fingerprint Word64
0)

-- | Check that the fields of 'PerasVoteState' are in sync.
invariantForPerasVoteDbState ::
  IsPerasVote (PerasVote blk) blk =>
  WithFingerprint (PerasVoteDbState blk) -> Either String ()
invariantForPerasVoteDbState :: forall blk.
IsPerasVote (PerasVote blk) blk =>
WithFingerprint (PerasVoteDbState blk) -> Either String ()
invariantForPerasVoteDbState WithFingerprint (PerasVoteDbState blk)
pvs = do
  [(PerasRoundNo, PerasRoundVoteState blk)]
-> ((PerasRoundNo, PerasRoundVoteState blk) -> Either String ())
-> Either String ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ (Map PerasRoundNo (PerasRoundVoteState blk)
-> [(PerasRoundNo, PerasRoundVoteState blk)]
forall k a. Map k a -> [(k, a)]
Map.toList Map PerasRoundNo (PerasRoundVoteState blk)
pvdsRoundVoteStates) (((PerasRoundNo, PerasRoundVoteState blk) -> Either String ())
 -> Either String ())
-> ((PerasRoundNo, PerasRoundVoteState blk) -> Either String ())
-> Either String ()
forall a b. (a -> b) -> a -> b
$ \(PerasRoundNo
roundNo, PerasRoundVoteState blk
prvs) ->
    String -> PerasRoundNo -> PerasRoundNo -> Either String ()
forall a. (Eq a, Show a) => String -> a -> a -> Either String ()
checkEqual
      String
"pvcRoundVoteStates rounds"
      PerasRoundNo
roundNo
      (PerasRoundVoteState blk -> PerasRoundNo
forall blk. PerasRoundVoteState blk -> PerasRoundNo
getPerasRoundVoteStateRound PerasRoundVoteState blk
prvs)
  String -> Set PerasRoundNo -> Set PerasRoundNo -> Either String ()
forall a. (Eq a, Show a) => String -> a -> a -> Either String ()
checkEqual
    String
"pvcsVotesByTicket"
    ([PerasRoundNo] -> Set PerasRoundNo
forall a. Ord a => [a] -> Set a
Set.fromList (WithArrivalTime (ValidatedPerasVote blk) -> PerasRoundNo
forall vote blk. IsPerasVote vote blk => vote -> PerasRoundNo
getPerasVoteRound (WithArrivalTime (ValidatedPerasVote blk) -> PerasRoundNo)
-> [WithArrivalTime (ValidatedPerasVote blk)] -> [PerasRoundNo]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map PerasVoteTicketNo (WithArrivalTime (ValidatedPerasVote blk))
-> [WithArrivalTime (ValidatedPerasVote blk)]
forall k a. Map k a -> [a]
Map.elems Map PerasVoteTicketNo (WithArrivalTime (ValidatedPerasVote blk))
pvdsVotesByTicket))
    ([PerasRoundNo] -> Set PerasRoundNo
forall a. Ord a => [a] -> Set a
Set.fromList (PerasVoteId -> PerasRoundNo
pviRoundNo (PerasVoteId -> PerasRoundNo) -> [PerasVoteId] -> [PerasRoundNo]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Set PerasVoteId -> [PerasVoteId]
forall a. Set a -> [a]
Set.elems Set PerasVoteId
pvdsVoteIds))
  [PerasVoteTicketNo]
-> (PerasVoteTicketNo -> Either String ()) -> Either String ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ (Map PerasVoteTicketNo (WithArrivalTime (ValidatedPerasVote blk))
-> [PerasVoteTicketNo]
forall k a. Map k a -> [k]
Map.keys Map PerasVoteTicketNo (WithArrivalTime (ValidatedPerasVote blk))
pvdsVotesByTicket) ((PerasVoteTicketNo -> Either String ()) -> Either String ())
-> (PerasVoteTicketNo -> Either String ()) -> Either String ()
forall a b. (a -> b) -> a -> b
$ \PerasVoteTicketNo
ticketNo ->
    Bool -> Either String () -> Either String ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (PerasVoteTicketNo
ticketNo PerasVoteTicketNo -> PerasVoteTicketNo -> Bool
forall a. Ord a => a -> a -> Bool
> PerasVoteTicketNo
pvdsLastTicketNo) (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
$
        String
"Ticket number monotonicity violation: "
          String -> ShowS
forall a. Semigroup a => a -> a -> a
<> PerasVoteTicketNo -> String
forall a. Show a => a -> String
show PerasVoteTicketNo
ticketNo
          String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" > "
          String -> ShowS
forall a. Semigroup a => a -> a -> a
<> PerasVoteTicketNo -> String
forall a. Show a => a -> String
show PerasVoteTicketNo
pvdsLastTicketNo
 where
  PerasVoteDbState
    { Map PerasRoundNo (PerasRoundVoteState blk)
pvdsRoundVoteStates :: forall blk.
PerasVoteDbState blk -> Map PerasRoundNo (PerasRoundVoteState blk)
pvdsRoundVoteStates :: Map PerasRoundNo (PerasRoundVoteState blk)
pvdsRoundVoteStates
    , Map PerasVoteTicketNo (WithArrivalTime (ValidatedPerasVote blk))
pvdsVotesByTicket :: forall blk.
PerasVoteDbState blk
-> Map PerasVoteTicketNo (WithArrivalTime (ValidatedPerasVote blk))
pvdsVotesByTicket :: Map PerasVoteTicketNo (WithArrivalTime (ValidatedPerasVote blk))
pvdsVotesByTicket
    , Set PerasVoteId
pvdsVoteIds :: forall blk. PerasVoteDbState blk -> Set PerasVoteId
pvdsVoteIds :: Set PerasVoteId
pvdsVoteIds
    , PerasVoteTicketNo
pvdsLastTicketNo :: forall blk. PerasVoteDbState blk -> PerasVoteTicketNo
pvdsLastTicketNo :: PerasVoteTicketNo
pvdsLastTicketNo
    } = WithFingerprint (PerasVoteDbState blk) -> PerasVoteDbState blk
forall a. WithFingerprint a -> a
forgetFingerprint WithFingerprint (PerasVoteDbState blk)
pvs

  checkEqual :: (Eq a, Show a) => String -> a -> a -> Either String ()
  checkEqual :: forall a. (Eq a, Show a) => String -> a -> a -> Either String ()
checkEqual String
msg a
a a
b =
    Bool -> Either String () -> Either String ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (a
a a -> a -> Bool
forall a. Eq a => a -> a -> Bool
/= a
b) (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
$ String
msg String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
": Not equal: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> a -> String
forall a. Show a => a -> String
show a
a String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
", " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> a -> String
forall a. Show a => a -> String
show a
b

{-------------------------------------------------------------------------------
  Trace types
-------------------------------------------------------------------------------}

data TraceEvent blk
  = AddVote
      PerasVoteId
      (WithArrivalTime (ValidatedPerasVote blk))
      (AddPerasVoteResult blk)
  | GarbageCollected
      SlotNo

deriving instance
  ( Show (PerasVote blk)
  , Show (PerasCert blk)
  ) =>
  Show (TraceEvent blk)
deriving instance
  ( Eq (PerasVote blk)
  , Eq (PerasCert blk)
  ) =>
  Eq (TraceEvent blk)
deriving instance
  ( NoThunks (PerasVote blk)
  , NoThunks (PerasCert blk)
  ) =>
  NoThunks (TraceEvent blk)
deriving instance
  Generic (TraceEvent blk)

{------------------------------------------------------------------------------
  Creating the database
------------------------------------------------------------------------------}

type PerasVoteDbArgs :: (Type -> Type) -> (Type -> Type) -> Type -> Type
data PerasVoteDbArgs f m blk = PerasVoteDbArgs
  { forall (f :: * -> *) (m :: * -> *) blk.
PerasVoteDbArgs f m blk -> Tracer m (TraceEvent blk)
pvdbaTracer :: Tracer m (TraceEvent blk)
  }

defaultArgs :: Monad m => Incomplete PerasVoteDbArgs m blk
defaultArgs :: forall (m :: * -> *) blk.
Monad m =>
Incomplete PerasVoteDbArgs m blk
defaultArgs =
  PerasVoteDbArgs
    { pvdbaTracer :: Tracer m (TraceEvent blk)
pvdbaTracer = Tracer m (TraceEvent blk)
forall (m :: * -> *) a. Monad m => Tracer m a
nullTracer
    }

createDB ::
  forall m blk.
  ( IOLike m
  , BlockSupportsPeras blk
  ) =>
  Complete PerasVoteDbArgs m blk ->
  PerasEpochContextResolverHandle m blk ->
  m (PerasVoteDB m blk)
createDB :: forall (m :: * -> *) blk.
(IOLike m, BlockSupportsPeras blk) =>
Complete PerasVoteDbArgs m blk
-> PerasEpochContextResolverHandle m blk -> m (PerasVoteDB m blk)
createDB Complete PerasVoteDbArgs m blk
args PerasEpochContextResolverHandle m blk
perasEpochContextResolverHandle = do
  pvdeState <-
    (WithFingerprint (PerasVoteDbState blk) -> Maybe String)
-> WithFingerprint (PerasVoteDbState blk)
-> m (StrictTVar m (WithFingerprint (PerasVoteDbState blk)))
forall (m :: * -> *) a.
(HasCallStack, MonadSTM m, NoThunks a) =>
(a -> Maybe String) -> a -> m (StrictTVar m a)
newTVarWithInvariantIO
      ((String -> Maybe String)
-> (() -> Maybe String) -> Either String () -> Maybe String
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either String -> Maybe String
forall a. a -> Maybe a
Just (Maybe String -> () -> Maybe String
forall a b. a -> b -> a
const Maybe String
forall a. Maybe a
Nothing) (Either String () -> Maybe String)
-> (WithFingerprint (PerasVoteDbState blk) -> Either String ())
-> WithFingerprint (PerasVoteDbState blk)
-> Maybe String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WithFingerprint (PerasVoteDbState blk) -> Either String ()
forall blk.
IsPerasVote (PerasVote blk) blk =>
WithFingerprint (PerasVoteDbState blk) -> Either String ()
invariantForPerasVoteDbState)
      WithFingerprint (PerasVoteDbState blk)
forall blk. WithFingerprint (PerasVoteDbState blk)
initialPerasVoteDbState
  let env =
        PerasVoteDbEnv
          { Tracer m (TraceEvent blk)
pvdeTracer :: Tracer m (TraceEvent blk)
pvdeTracer :: Tracer m (TraceEvent blk)
pvdeTracer
          , StrictTVar m (WithFingerprint (PerasVoteDbState blk))
pvdeState :: StrictTVar m (WithFingerprint (PerasVoteDbState blk))
pvdeState :: StrictTVar m (WithFingerprint (PerasVoteDbState blk))
pvdeState
          }
  pure
    PerasVoteDB
      { addVote = implAddVote perasEpochContextResolverHandle env
      , getVoteIds = implGetVoteIds env
      , getVotesAfter = implGetVotesAfter env
      , getForgedCertForRound = implGetForgedCertForRound env
      , garbageCollect = implGarbageCollect env
      }
 where
  PerasVoteDbArgs
    { pvdbaTracer :: forall (f :: * -> *) (m :: * -> *) blk.
PerasVoteDbArgs f m blk -> Tracer m (TraceEvent blk)
pvdbaTracer = Tracer m (TraceEvent blk)
pvdeTracer
    } = Complete PerasVoteDbArgs m blk
args

{-------------------------------------------------------------------------------
  API implementation
-------------------------------------------------------------------------------}

-- TODO: we will need to update this method with non-trivial validation logic
-- see https://github.com/tweag/cardano-peras/issues/120
implAddVote ::
  forall m blk.
  ( IOLike m
  , BlockSupportsPeras blk
  ) =>
  PerasEpochContextResolverHandle m blk ->
  PerasVoteDbEnv m blk ->
  WithArrivalTime (ValidatedPerasVote blk) ->
  STM m (m (AddPerasVoteResult blk))
implAddVote :: forall (m :: * -> *) blk.
(IOLike m, BlockSupportsPeras blk) =>
PerasEpochContextResolverHandle m blk
-> PerasVoteDbEnv m blk
-> WithArrivalTime (ValidatedPerasVote blk)
-> STM m (m (AddPerasVoteResult blk))
implAddVote PerasEpochContextResolverHandle m blk
resolverHandle PerasVoteDbEnv{Tracer m (TraceEvent blk)
pvdeTracer :: forall (m :: * -> *) blk.
PerasVoteDbEnv m blk -> Tracer m (TraceEvent blk)
pvdeTracer :: Tracer m (TraceEvent blk)
pvdeTracer, StrictTVar m (WithFingerprint (PerasVoteDbState blk))
pvdeState :: forall (m :: * -> *) blk.
PerasVoteDbEnv m blk
-> StrictTVar m (WithFingerprint (PerasVoteDbState blk))
pvdeState :: StrictTVar m (WithFingerprint (PerasVoteDbState blk))
pvdeState} WithArrivalTime (ValidatedPerasVote blk)
vote = do
  let voteId :: PerasVoteId
voteId = WithArrivalTime (ValidatedPerasVote blk) -> PerasVoteId
forall vote blk. IsPerasVote vote blk => vote -> PerasVoteId
getPerasVoteId WithArrivalTime (ValidatedPerasVote blk)
vote
  addPerasVoteRes <- do
    WithFingerprint pvds fp <- StrictTVar m (WithFingerprint (PerasVoteDbState blk))
-> STM m (WithFingerprint (PerasVoteDbState blk))
forall (m :: * -> *) a. MonadSTM m => StrictTVar m a -> STM m a
readTVar StrictTVar m (WithFingerprint (PerasVoteDbState blk))
pvdeState
    (res, pvds') <- addOrIgnoreVote pvds voteId
    writeTVar pvdeState (WithFingerprint pvds' (succ fp))
    pure res
  pure $ do
    traceWith pvdeTracer (AddVote voteId vote addPerasVoteRes)
    return addPerasVoteRes
 where
  addOrIgnoreVote :: PerasVoteDbState blk
-> PerasVoteId
-> STM m (AddPerasVoteResult blk, PerasVoteDbState blk)
addOrIgnoreVote PerasVoteDbState blk
pvds PerasVoteId
voteId
    -- Vote is already in the DB => ignore it
    | PerasVoteId -> Set PerasVoteId -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.member PerasVoteId
voteId (PerasVoteDbState blk -> Set PerasVoteId
forall blk. PerasVoteDbState blk -> Set PerasVoteId
pvdsVoteIds PerasVoteDbState blk
pvds) = PerasVoteDbState blk
-> STM m (AddPerasVoteResult blk, PerasVoteDbState blk)
forall {f :: * -> *} {b} {blk}.
Applicative f =>
b -> f (AddPerasVoteResult blk, b)
voteAlreadyInDB PerasVoteDbState blk
pvds
    -- New vote => try to add it to the DB
    | Bool
otherwise = PerasVoteDbState blk
-> PerasVoteId
-> STM m (AddPerasVoteResult blk, PerasVoteDbState blk)
tryAddVote PerasVoteDbState blk
pvds PerasVoteId
voteId

  voteAlreadyInDB :: b -> f (AddPerasVoteResult blk, b)
voteAlreadyInDB b
pvds = (AddPerasVoteResult blk, b) -> f (AddPerasVoteResult blk, b)
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (AddPerasVoteResult blk
forall blk. AddPerasVoteResult blk
PerasVoteAlreadyInDB, b
pvds)

  tryAddVote :: PerasVoteDbState blk
-> PerasVoteId
-> STM m (AddPerasVoteResult blk, PerasVoteDbState blk)
tryAddVote PerasVoteDbState blk
pvds PerasVoteId
voteId = do
    let pvsVoteIds' :: Set PerasVoteId
pvsVoteIds' = PerasVoteId -> Set PerasVoteId -> Set PerasVoteId
forall a. Ord a => a -> Set a -> Set a
Set.insert PerasVoteId
voteId (PerasVoteDbState blk -> Set PerasVoteId
forall blk. PerasVoteDbState blk -> Set PerasVoteId
pvdsVoteIds PerasVoteDbState blk
pvds)
        pvsLastTicketNo' :: PerasVoteTicketNo
pvsLastTicketNo' = PerasVoteTicketNo -> PerasVoteTicketNo
forall a. Enum a => a -> a
succ (PerasVoteDbState blk -> PerasVoteTicketNo
forall blk. PerasVoteDbState blk -> PerasVoteTicketNo
pvdsLastTicketNo PerasVoteDbState blk
pvds)
        pvsVotesByTicket' :: Map PerasVoteTicketNo (WithArrivalTime (ValidatedPerasVote blk))
pvsVotesByTicket' = PerasVoteTicketNo
-> WithArrivalTime (ValidatedPerasVote blk)
-> Map PerasVoteTicketNo (WithArrivalTime (ValidatedPerasVote blk))
-> Map PerasVoteTicketNo (WithArrivalTime (ValidatedPerasVote blk))
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert PerasVoteTicketNo
pvsLastTicketNo' WithArrivalTime (ValidatedPerasVote blk)
vote (PerasVoteDbState blk
-> Map PerasVoteTicketNo (WithArrivalTime (ValidatedPerasVote blk))
forall blk.
PerasVoteDbState blk
-> Map PerasVoteTicketNo (WithArrivalTime (ValidatedPerasVote blk))
pvdsVotesByTicket PerasVoteDbState blk
pvds)

    (addPerasVoteRes, pvsRoundVoteStates') <-
      WithArrivalTime (ValidatedPerasVote blk)
-> PerasEpochContextResolverHandle m blk
-> Map PerasRoundNo (PerasRoundVoteState blk)
-> STM
     m
     (Either
        (UpdateRoundVoteStateError blk)
        (PerasRoundVoteState blk,
         Map PerasRoundNo (PerasRoundVoteState blk)))
forall (m :: * -> *) blk.
(BlockSupportsPeras blk, MonadSTM m) =>
WithArrivalTime (ValidatedPerasVote blk)
-> PerasEpochContextResolverHandle m blk
-> Map PerasRoundNo (PerasRoundVoteState blk)
-> STM
     m
     (Either
        (UpdateRoundVoteStateError blk)
        (PerasRoundVoteState blk,
         Map PerasRoundNo (PerasRoundVoteState blk)))
updatePerasRoundVoteStates WithArrivalTime (ValidatedPerasVote blk)
vote PerasEpochContextResolverHandle m blk
resolverHandle (PerasVoteDbState blk -> Map PerasRoundNo (PerasRoundVoteState blk)
forall blk.
PerasVoteDbState blk -> Map PerasRoundNo (PerasRoundVoteState blk)
pvdsRoundVoteStates PerasVoteDbState blk
pvds) STM
  m
  (Either
     (UpdateRoundVoteStateError blk)
     (PerasRoundVoteState blk,
      Map PerasRoundNo (PerasRoundVoteState blk)))
-> (Either
      (UpdateRoundVoteStateError blk)
      (PerasRoundVoteState blk,
       Map PerasRoundNo (PerasRoundVoteState blk))
    -> STM
         m
         (AddPerasVoteResult blk,
          Map PerasRoundNo (PerasRoundVoteState blk)))
-> STM
     m
     (AddPerasVoteResult blk,
      Map PerasRoundNo (PerasRoundVoteState 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
>>= \case
        -- Added vote and reached a quorum, forging a new certificate
        Right (VoteGeneratedNewCert ValidatedPerasCert blk
cert, Map PerasRoundNo (PerasRoundVoteState blk)
pvsRoundVoteStates') ->
          (AddPerasVoteResult blk,
 Map PerasRoundNo (PerasRoundVoteState blk))
-> STM
     m
     (AddPerasVoteResult blk,
      Map PerasRoundNo (PerasRoundVoteState blk))
forall a. a -> STM m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ValidatedPerasCert blk -> AddPerasVoteResult blk
forall blk. ValidatedPerasCert blk -> AddPerasVoteResult blk
AddedPerasVoteAndGeneratedNewCert ValidatedPerasCert blk
cert, Map PerasRoundNo (PerasRoundVoteState blk)
pvsRoundVoteStates')
        -- Added vote but did not generate a new certificate, either
        -- because quorum was not reached yet, or because this vote was
        -- cast upon a target that had already won so a certificate was
        -- forged in a previous step.
        Right (PerasRoundVoteState blk
VoteDidntGenerateNewCert, Map PerasRoundNo (PerasRoundVoteState blk)
pvsRoundVoteStates') ->
          (AddPerasVoteResult blk,
 Map PerasRoundNo (PerasRoundVoteState blk))
-> STM
     m
     (AddPerasVoteResult blk,
      Map PerasRoundNo (PerasRoundVoteState blk))
forall a. a -> STM m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (AddPerasVoteResult blk
forall blk. AddPerasVoteResult blk
AddedPerasVoteButDidntGenerateNewCert, Map PerasRoundNo (PerasRoundVoteState blk)
pvsRoundVoteStates')
        -- Adding the vote led to more than one winner => internal error
        Left (RoundVoteStateLoserAboveQuorum PerasTargetVoteState blk 'Winner
winnerState PerasTargetVoteState blk 'Loser
loserState) ->
          PerasVoteDbError blk
-> STM
     m
     (AddPerasVoteResult blk,
      Map PerasRoundNo (PerasRoundVoteState blk))
forall (m :: * -> *) e a.
(MonadSTM m, MonadThrow (STM m), Exception e) =>
e -> STM m a
throwSTM (PerasVoteDbError blk
 -> STM
      m
      (AddPerasVoteResult blk,
       Map PerasRoundNo (PerasRoundVoteState blk)))
-> PerasVoteDbError blk
-> STM
     m
     (AddPerasVoteResult blk,
      Map PerasRoundNo (PerasRoundVoteState blk))
forall a b. (a -> b) -> a -> b
$
            PerasRoundNo
-> ExistingPerasRoundWinner blk
-> BlockedPerasRoundWinner blk
-> PerasVoteDbError blk
forall blk.
PerasRoundNo
-> ExistingPerasRoundWinner blk
-> BlockedPerasRoundWinner blk
-> PerasVoteDbError blk
MultipleWinnersInRound
              (WithArrivalTime (ValidatedPerasVote blk) -> PerasRoundNo
forall vote blk. IsPerasVote vote blk => vote -> PerasRoundNo
getPerasVoteRound WithArrivalTime (ValidatedPerasVote blk)
vote)
              ( (Point blk, VoteWeight) -> ExistingPerasRoundWinner blk
forall blk. (Point blk, VoteWeight) -> ExistingPerasRoundWinner blk
ExistingPerasRoundWinner
                  ( PerasTargetVoteState blk 'Winner -> Point blk
forall blk (status :: PerasTargetVoteStatus).
PerasTargetVoteState blk status -> Point blk
getPerasTargetVoteStateBlock PerasTargetVoteState blk 'Winner
winnerState
                  , PerasTargetVoteState blk 'Winner -> VoteWeight
forall blk (status :: PerasTargetVoteStatus).
PerasTargetVoteState blk status -> VoteWeight
getPerasTargetVoteStateTotalWeight PerasTargetVoteState blk 'Winner
winnerState
                  )
              )
              ( (Point blk, VoteWeight) -> BlockedPerasRoundWinner blk
forall blk. (Point blk, VoteWeight) -> BlockedPerasRoundWinner blk
BlockedPerasRoundWinner
                  ( PerasTargetVoteState blk 'Loser -> Point blk
forall blk (status :: PerasTargetVoteStatus).
PerasTargetVoteState blk status -> Point blk
getPerasTargetVoteStateBlock PerasTargetVoteState blk 'Loser
loserState
                  , PerasTargetVoteState blk 'Loser -> VoteWeight
forall blk (status :: PerasTargetVoteStatus).
PerasTargetVoteState blk status -> VoteWeight
getPerasTargetVoteStateTotalWeight PerasTargetVoteState blk 'Loser
loserState
                  )
              )
        -- Reached quorum but failed to forge a certificate
        Left (RoundVoteStateForgingCertError PerasError blk
forgeErr) ->
          PerasVoteDbError blk
-> STM
     m
     (AddPerasVoteResult blk,
      Map PerasRoundNo (PerasRoundVoteState blk))
forall (m :: * -> *) e a.
(MonadSTM m, MonadThrow (STM m), Exception e) =>
e -> STM m a
throwSTM (PerasVoteDbError blk
 -> STM
      m
      (AddPerasVoteResult blk,
       Map PerasRoundNo (PerasRoundVoteState blk)))
-> PerasVoteDbError blk
-> STM
     m
     (AddPerasVoteResult blk,
      Map PerasRoundNo (PerasRoundVoteState blk))
forall a b. (a -> b) -> a -> b
$
            PerasError blk -> PerasVoteDbError blk
forall blk. PerasError blk -> PerasVoteDbError blk
ForgingCertError PerasError blk
forgeErr
        Left (RoundVoteStateEpochContextNotFound PerasEpochContextNotFoundForRound
resolverErr) ->
          PerasVoteDbError blk
-> STM
     m
     (AddPerasVoteResult blk,
      Map PerasRoundNo (PerasRoundVoteState blk))
forall (m :: * -> *) e a.
(MonadSTM m, MonadThrow (STM m), Exception e) =>
e -> STM m a
throwSTM (PerasVoteDbError blk
 -> STM
      m
      (AddPerasVoteResult blk,
       Map PerasRoundNo (PerasRoundVoteState blk)))
-> PerasVoteDbError blk
-> STM
     m
     (AddPerasVoteResult blk,
      Map PerasRoundNo (PerasRoundVoteState blk))
forall a b. (a -> b) -> a -> b
$
            forall blk.
PerasEpochContextNotFoundForRound -> PerasVoteDbError blk
EpochContextNotFoundForRound @blk PerasEpochContextNotFoundForRound
resolverErr

    pure
      ( addPerasVoteRes
      , PerasVoteDbState
          { pvdsVoteIds = pvsVoteIds'
          , pvdsRoundVoteStates = pvsRoundVoteStates'
          , pvdsVotesByTicket = pvsVotesByTicket'
          , pvdsLastTicketNo = pvsLastTicketNo'
          }
      )

implGetVoteIds ::
  IOLike m =>
  PerasVoteDbEnv m blk ->
  STM m (Set PerasVoteId)
implGetVoteIds :: forall (m :: * -> *) blk.
IOLike m =>
PerasVoteDbEnv m blk -> STM m (Set PerasVoteId)
implGetVoteIds PerasVoteDbEnv{StrictTVar m (WithFingerprint (PerasVoteDbState blk))
pvdeState :: forall (m :: * -> *) blk.
PerasVoteDbEnv m blk
-> StrictTVar m (WithFingerprint (PerasVoteDbState blk))
pvdeState :: StrictTVar m (WithFingerprint (PerasVoteDbState blk))
pvdeState} = do
  PerasVoteDbState{pvdsVoteIds} <-
    WithFingerprint (PerasVoteDbState blk) -> PerasVoteDbState blk
forall a. WithFingerprint a -> a
forgetFingerprint (WithFingerprint (PerasVoteDbState blk) -> PerasVoteDbState blk)
-> STM m (WithFingerprint (PerasVoteDbState blk))
-> STM m (PerasVoteDbState blk)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StrictTVar m (WithFingerprint (PerasVoteDbState blk))
-> STM m (WithFingerprint (PerasVoteDbState blk))
forall (m :: * -> *) a. MonadSTM m => StrictTVar m a -> STM m a
readTVar StrictTVar m (WithFingerprint (PerasVoteDbState blk))
pvdeState
  pure pvdsVoteIds

implGetVotesAfter ::
  IOLike m =>
  PerasVoteDbEnv m blk ->
  PerasVoteTicketNo ->
  STM m (Map PerasVoteTicketNo (WithArrivalTime (ValidatedPerasVote blk)))
implGetVotesAfter :: forall (m :: * -> *) blk.
IOLike m =>
PerasVoteDbEnv m blk
-> PerasVoteTicketNo
-> STM
     m
     (Map PerasVoteTicketNo (WithArrivalTime (ValidatedPerasVote blk)))
implGetVotesAfter PerasVoteDbEnv{StrictTVar m (WithFingerprint (PerasVoteDbState blk))
pvdeState :: forall (m :: * -> *) blk.
PerasVoteDbEnv m blk
-> StrictTVar m (WithFingerprint (PerasVoteDbState blk))
pvdeState :: StrictTVar m (WithFingerprint (PerasVoteDbState blk))
pvdeState} PerasVoteTicketNo
ticketNo = do
  PerasVoteDbState{pvdsVotesByTicket} <-
    WithFingerprint (PerasVoteDbState blk) -> PerasVoteDbState blk
forall a. WithFingerprint a -> a
forgetFingerprint (WithFingerprint (PerasVoteDbState blk) -> PerasVoteDbState blk)
-> STM m (WithFingerprint (PerasVoteDbState blk))
-> STM m (PerasVoteDbState blk)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StrictTVar m (WithFingerprint (PerasVoteDbState blk))
-> STM m (WithFingerprint (PerasVoteDbState blk))
forall (m :: * -> *) a. MonadSTM m => StrictTVar m a -> STM m a
readTVar StrictTVar m (WithFingerprint (PerasVoteDbState blk))
pvdeState
  pure $ snd $ Map.split ticketNo pvdsVotesByTicket

implGetForgedCertForRound ::
  IOLike m =>
  PerasVoteDbEnv m blk ->
  PerasRoundNo ->
  STM m (Maybe (ValidatedPerasCert blk))
implGetForgedCertForRound :: forall (m :: * -> *) blk.
IOLike m =>
PerasVoteDbEnv m blk
-> PerasRoundNo -> STM m (Maybe (ValidatedPerasCert blk))
implGetForgedCertForRound PerasVoteDbEnv{StrictTVar m (WithFingerprint (PerasVoteDbState blk))
pvdeState :: forall (m :: * -> *) blk.
PerasVoteDbEnv m blk
-> StrictTVar m (WithFingerprint (PerasVoteDbState blk))
pvdeState :: StrictTVar m (WithFingerprint (PerasVoteDbState blk))
pvdeState} PerasRoundNo
roundNo = do
  PerasVoteDbState{pvdsRoundVoteStates} <-
    WithFingerprint (PerasVoteDbState blk) -> PerasVoteDbState blk
forall a. WithFingerprint a -> a
forgetFingerprint (WithFingerprint (PerasVoteDbState blk) -> PerasVoteDbState blk)
-> STM m (WithFingerprint (PerasVoteDbState blk))
-> STM m (PerasVoteDbState blk)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StrictTVar m (WithFingerprint (PerasVoteDbState blk))
-> STM m (WithFingerprint (PerasVoteDbState blk))
forall (m :: * -> *) a. MonadSTM m => StrictTVar m a -> STM m a
readTVar StrictTVar m (WithFingerprint (PerasVoteDbState blk))
pvdeState
  case Map.lookup roundNo pvdsRoundVoteStates of
    Maybe (PerasRoundVoteState blk)
Nothing -> Maybe (ValidatedPerasCert blk)
-> STM m (Maybe (ValidatedPerasCert blk))
forall a. a -> STM m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (ValidatedPerasCert blk)
forall a. Maybe a
Nothing
    Just PerasRoundVoteState blk
aggr -> Maybe (ValidatedPerasCert blk)
-> STM m (Maybe (ValidatedPerasCert blk))
forall a. a -> STM m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PerasRoundVoteState blk -> Maybe (ValidatedPerasCert blk)
forall blk.
PerasRoundVoteState blk -> Maybe (ValidatedPerasCert blk)
getPerasRoundVoteStateCertMaybe PerasRoundVoteState blk
aggr)

implGarbageCollect ::
  forall m blk.
  ( IOLike m
  , IsPerasVote (PerasVote blk) blk
  ) =>
  PerasVoteDbEnv m blk ->
  SlotNo ->
  STM m (m ())
implGarbageCollect :: forall (m :: * -> *) blk.
(IOLike m, IsPerasVote (PerasVote blk) blk) =>
PerasVoteDbEnv m blk -> SlotNo -> STM m (m ())
implGarbageCollect PerasVoteDbEnv{Tracer m (TraceEvent blk)
pvdeTracer :: forall (m :: * -> *) blk.
PerasVoteDbEnv m blk -> Tracer m (TraceEvent blk)
pvdeTracer :: Tracer m (TraceEvent blk)
pvdeTracer, StrictTVar m (WithFingerprint (PerasVoteDbState blk))
pvdeState :: forall (m :: * -> *) blk.
PerasVoteDbEnv m blk
-> StrictTVar m (WithFingerprint (PerasVoteDbState blk))
pvdeState :: StrictTVar m (WithFingerprint (PerasVoteDbState blk))
pvdeState} SlotNo
slotNo = do
  -- No need to update the 'Fingerprint' as we only remove votes that do
  -- not matter for comparing interesting chains.
  StrictTVar m (WithFingerprint (PerasVoteDbState blk))
-> (WithFingerprint (PerasVoteDbState blk)
    -> WithFingerprint (PerasVoteDbState blk))
-> STM m ()
forall (m :: * -> *) a.
MonadSTM m =>
StrictTVar m a -> (a -> a) -> STM m ()
modifyTVar StrictTVar m (WithFingerprint (PerasVoteDbState blk))
pvdeState ((PerasVoteDbState blk -> PerasVoteDbState blk)
-> WithFingerprint (PerasVoteDbState blk)
-> WithFingerprint (PerasVoteDbState blk)
forall a b. (a -> b) -> WithFingerprint a -> WithFingerprint b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap PerasVoteDbState blk -> PerasVoteDbState blk
gc)
  m () -> STM m (m ())
forall a. a -> STM m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (m () -> STM m (m ())) -> m () -> STM m (m ())
forall a b. (a -> b) -> a -> b
$ do
    Tracer m (TraceEvent blk) -> TraceEvent blk -> m ()
forall (m :: * -> *) a. Monad m => Tracer m a -> a -> m ()
traceWith Tracer m (TraceEvent blk)
pvdeTracer (SlotNo -> TraceEvent blk
forall blk. SlotNo -> TraceEvent blk
GarbageCollected SlotNo
slotNo)
    () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
 where
  gc :: PerasVoteDbState blk -> PerasVoteDbState blk
  gc :: PerasVoteDbState blk -> PerasVoteDbState blk
gc
    PerasVoteDbState
      { Set PerasVoteId
pvdsVoteIds :: forall blk. PerasVoteDbState blk -> Set PerasVoteId
pvdsVoteIds :: Set PerasVoteId
pvdsVoteIds
      , Map PerasRoundNo (PerasRoundVoteState blk)
pvdsRoundVoteStates :: forall blk.
PerasVoteDbState blk -> Map PerasRoundNo (PerasRoundVoteState blk)
pvdsRoundVoteStates :: Map PerasRoundNo (PerasRoundVoteState blk)
pvdsRoundVoteStates
      , Map PerasVoteTicketNo (WithArrivalTime (ValidatedPerasVote blk))
pvdsVotesByTicket :: forall blk.
PerasVoteDbState blk
-> Map PerasVoteTicketNo (WithArrivalTime (ValidatedPerasVote blk))
pvdsVotesByTicket :: Map PerasVoteTicketNo (WithArrivalTime (ValidatedPerasVote blk))
pvdsVotesByTicket
      , PerasVoteTicketNo
pvdsLastTicketNo :: forall blk. PerasVoteDbState blk -> PerasVoteTicketNo
pvdsLastTicketNo :: PerasVoteTicketNo
pvdsLastTicketNo
      } =
      let
        -- First, determine which rounds to delete based on the round vote
        -- state: a round is deleted only when the youngest target of all its
        -- votes is strictly older than the GC threshold.
        --
        -- NOTE:
        -- This conservative approach could cause round states to be kept
        -- for a long time if an attacker keeps adding votes for a given
        -- round but with a target far into the future,
        -- see https://github.com/tweag/cardano-peras/issues/218
        (Map PerasRoundNo (PerasRoundVoteState blk)
roundsToDelete, Map PerasRoundNo (PerasRoundVoteState blk)
pvsRoundVoteStates') =
          (PerasRoundVoteState blk -> Bool)
-> Map PerasRoundNo (PerasRoundVoteState blk)
-> (Map PerasRoundNo (PerasRoundVoteState blk),
    Map PerasRoundNo (PerasRoundVoteState blk))
forall a k. (a -> Bool) -> Map k a -> (Map k a, Map k a)
Map.partition
            (\PerasRoundVoteState blk
rvs -> PerasRoundVoteState blk -> WithOrigin SlotNo
forall blk. PerasRoundVoteState blk -> WithOrigin SlotNo
getPerasRoundVoteStateMaxTargetedSlot PerasRoundVoteState blk
rvs WithOrigin SlotNo -> WithOrigin SlotNo -> Bool
forall a. Ord a => a -> a -> Bool
< SlotNo -> WithOrigin SlotNo
forall t. t -> WithOrigin t
NotOrigin SlotNo
slotNo)
            Map PerasRoundNo (PerasRoundVoteState blk)
pvdsRoundVoteStates
        deletedRoundNos :: Set PerasRoundNo
deletedRoundNos =
          Map PerasRoundNo (PerasRoundVoteState blk) -> Set PerasRoundNo
forall k a. Map k a -> Set k
Map.keysSet Map PerasRoundNo (PerasRoundVoteState blk)
roundsToDelete
        -- Then, remove all votes belonging to deleted rounds from the
        -- by-ticket index
        (Map PerasVoteTicketNo (WithArrivalTime (ValidatedPerasVote blk))
pvsVotesByTicket', Map PerasVoteTicketNo (WithArrivalTime (ValidatedPerasVote blk))
votesToRemove) =
          (WithArrivalTime (ValidatedPerasVote blk) -> Bool)
-> Map PerasVoteTicketNo (WithArrivalTime (ValidatedPerasVote blk))
-> (Map
      PerasVoteTicketNo (WithArrivalTime (ValidatedPerasVote blk)),
    Map PerasVoteTicketNo (WithArrivalTime (ValidatedPerasVote blk)))
forall a k. (a -> Bool) -> Map k a -> (Map k a, Map k a)
Map.partition
            (\WithArrivalTime (ValidatedPerasVote blk)
vote -> Bool -> Bool
not (PerasRoundNo -> Set PerasRoundNo -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.member (WithArrivalTime (ValidatedPerasVote blk) -> PerasRoundNo
forall vote blk. IsPerasVote vote blk => vote -> PerasRoundNo
getPerasVoteRound WithArrivalTime (ValidatedPerasVote blk)
vote) Set PerasRoundNo
deletedRoundNos))
            Map PerasVoteTicketNo (WithArrivalTime (ValidatedPerasVote blk))
pvdsVotesByTicket
        -- Finally, remove the corresponding ids from the set of vote ids
        pvsVoteIds' :: Set PerasVoteId
pvsVoteIds' =
          (Set PerasVoteId
 -> WithArrivalTime (ValidatedPerasVote blk) -> Set PerasVoteId)
-> Set PerasVoteId
-> Map PerasVoteTicketNo (WithArrivalTime (ValidatedPerasVote blk))
-> Set PerasVoteId
forall b a. (b -> a -> b) -> b -> Map PerasVoteTicketNo a -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
Foldable.foldl'
            (\Set PerasVoteId
set WithArrivalTime (ValidatedPerasVote blk)
vote -> PerasVoteId -> Set PerasVoteId -> Set PerasVoteId
forall a. Ord a => a -> Set a -> Set a
Set.delete (WithArrivalTime (ValidatedPerasVote blk) -> PerasVoteId
forall vote blk. IsPerasVote vote blk => vote -> PerasVoteId
getPerasVoteId WithArrivalTime (ValidatedPerasVote blk)
vote) Set PerasVoteId
set)
            Set PerasVoteId
pvdsVoteIds
            Map PerasVoteTicketNo (WithArrivalTime (ValidatedPerasVote blk))
votesToRemove
       in
        PerasVoteDbState
          { pvdsVoteIds :: Set PerasVoteId
pvdsVoteIds = Set PerasVoteId
pvsVoteIds'
          , pvdsRoundVoteStates :: Map PerasRoundNo (PerasRoundVoteState blk)
pvdsRoundVoteStates = Map PerasRoundNo (PerasRoundVoteState blk)
pvsRoundVoteStates'
          , pvdsVotesByTicket :: Map PerasVoteTicketNo (WithArrivalTime (ValidatedPerasVote blk))
pvdsVotesByTicket = Map PerasVoteTicketNo (WithArrivalTime (ValidatedPerasVote blk))
pvsVotesByTicket'
          , pvdsLastTicketNo :: PerasVoteTicketNo
pvdsLastTicketNo = PerasVoteTicketNo
pvdsLastTicketNo
          }