{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneKindSignatures #-}

module Ouroboros.Consensus.Storage.PerasCertDB.Impl
  ( -- * Opening
    PerasCertDbArgs (..)
  , defaultArgs
  , openDB

    -- * Trace types
  , TraceEvent (..)

    -- * Exceptions
  , PerasCertDbError (..)
  ) where

import Control.Monad (when)
import Control.Monad.Except (throwError)
import Control.Tracer (Tracer, nullTracer, traceWith)
import Data.Foldable (for_)
import Data.Functor ((<&>))
import Data.Kind (Type)
import Data.Map.Strict (Map)
import qualified Data.Map.Strict as Map
import qualified Data.Set as Set
import GHC.Generics (Generic)
import NoThunks.Class
import Ouroboros.Consensus.Block
import Ouroboros.Consensus.Peras.Weight
import Ouroboros.Consensus.Storage.PerasCertDB.API
import Ouroboros.Consensus.Util.Args
import Ouroboros.Consensus.Util.CallStack
import Ouroboros.Consensus.Util.IOLike
import Ouroboros.Consensus.Util.STM

{------------------------------------------------------------------------------
  Opening the database
------------------------------------------------------------------------------}

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

defaultArgs :: Applicative m => Incomplete PerasCertDbArgs m blk
defaultArgs :: forall (m :: * -> *) blk.
Applicative m =>
Incomplete PerasCertDbArgs m blk
defaultArgs =
  PerasCertDbArgs
    { pcdbaTracer :: Tracer m (TraceEvent blk)
pcdbaTracer = Tracer m (TraceEvent blk)
forall (m :: * -> *) a. Applicative m => Tracer m a
nullTracer
    }

openDB ::
  forall m blk.
  ( IOLike m
  , StandardHash blk
  ) =>
  Complete PerasCertDbArgs m blk ->
  m (PerasCertDB m blk)
openDB :: forall (m :: * -> *) blk.
(IOLike m, StandardHash blk) =>
Complete PerasCertDbArgs m blk -> m (PerasCertDB m blk)
openDB Complete PerasCertDbArgs m blk
args = do
  pcdbVolatileState <-
    (WithFingerprint (PerasVolatileCertState blk) -> Maybe String)
-> WithFingerprint (PerasVolatileCertState blk)
-> m (StrictTVar m (WithFingerprint (PerasVolatileCertState 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 (PerasVolatileCertState blk)
    -> Either String ())
-> WithFingerprint (PerasVolatileCertState blk)
-> Maybe String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WithFingerprint (PerasVolatileCertState blk) -> Either String ()
forall blk.
StandardHash blk =>
WithFingerprint (PerasVolatileCertState blk) -> Either String ()
invariantForPerasVolatileCertState)
      WithFingerprint (PerasVolatileCertState blk)
forall blk. WithFingerprint (PerasVolatileCertState blk)
initialPerasVolatileCertState
  let env =
        PerasCertDbEnv
          { Tracer m (TraceEvent blk)
pcdbTracer :: Tracer m (TraceEvent blk)
pcdbTracer :: Tracer m (TraceEvent blk)
pcdbTracer
          , StrictTVar m (WithFingerprint (PerasVolatileCertState blk))
pcdbVolatileState :: StrictTVar m (WithFingerprint (PerasVolatileCertState blk))
pcdbVolatileState :: StrictTVar m (WithFingerprint (PerasVolatileCertState blk))
pcdbVolatileState
          }
  h <- PerasCertDbHandle <$> newTVarIO (PerasCertDbOpen env)
  traceWith pcdbTracer OpenedPerasCertDB
  pure
    PerasCertDB
      { addCert = getEnv1 h implAddCert
      , getWeightSnapshot = getEnvSTM h implGetWeightSnapshot
      , getCertSnapshot = getEnvSTM h implGetCertSnapshot
      , garbageCollect = getEnv1 h implGarbageCollect
      , closeDB = implCloseDB h
      }
 where
  PerasCertDbArgs
    { pcdbaTracer :: forall (f :: * -> *) (m :: * -> *) blk.
PerasCertDbArgs f m blk -> Tracer m (TraceEvent blk)
pcdbaTracer = Tracer m (TraceEvent blk)
pcdbTracer
    } = Complete PerasCertDbArgs m blk
args

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

newtype PerasCertDbHandle m blk = PerasCertDbHandle (StrictTVar m (PerasCertDbState m blk))

data PerasCertDbState m blk
  = PerasCertDbOpen !(PerasCertDbEnv m blk)
  | PerasCertDbClosed
  deriving stock (forall x.
 PerasCertDbState m blk -> Rep (PerasCertDbState m blk) x)
-> (forall x.
    Rep (PerasCertDbState m blk) x -> PerasCertDbState m blk)
-> Generic (PerasCertDbState m blk)
forall x. Rep (PerasCertDbState m blk) x -> PerasCertDbState m blk
forall x. PerasCertDbState m blk -> Rep (PerasCertDbState m blk) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (m :: * -> *) blk x.
Rep (PerasCertDbState m blk) x -> PerasCertDbState m blk
forall (m :: * -> *) blk x.
PerasCertDbState m blk -> Rep (PerasCertDbState m blk) x
$cfrom :: forall (m :: * -> *) blk x.
PerasCertDbState m blk -> Rep (PerasCertDbState m blk) x
from :: forall x. PerasCertDbState m blk -> Rep (PerasCertDbState m blk) x
$cto :: forall (m :: * -> *) blk x.
Rep (PerasCertDbState m blk) x -> PerasCertDbState m blk
to :: forall x. Rep (PerasCertDbState m blk) x -> PerasCertDbState m blk
Generic
  deriving anyclass Context -> PerasCertDbState m blk -> IO (Maybe ThunkInfo)
Proxy (PerasCertDbState m blk) -> String
(Context -> PerasCertDbState m blk -> IO (Maybe ThunkInfo))
-> (Context -> PerasCertDbState m blk -> IO (Maybe ThunkInfo))
-> (Proxy (PerasCertDbState m blk) -> String)
-> NoThunks (PerasCertDbState m blk)
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
forall (m :: * -> *) blk.
Context -> PerasCertDbState m blk -> IO (Maybe ThunkInfo)
forall (m :: * -> *) blk. Proxy (PerasCertDbState m blk) -> String
$cnoThunks :: forall (m :: * -> *) blk.
Context -> PerasCertDbState m blk -> IO (Maybe ThunkInfo)
noThunks :: Context -> PerasCertDbState m blk -> IO (Maybe ThunkInfo)
$cwNoThunks :: forall (m :: * -> *) blk.
Context -> PerasCertDbState m blk -> IO (Maybe ThunkInfo)
wNoThunks :: Context -> PerasCertDbState m blk -> IO (Maybe ThunkInfo)
$cshowTypeOf :: forall (m :: * -> *) blk. Proxy (PerasCertDbState m blk) -> String
showTypeOf :: Proxy (PerasCertDbState m blk) -> String
NoThunks

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

getEnv ::
  (IOLike m, HasCallStack) =>
  PerasCertDbHandle m blk ->
  (PerasCertDbEnv m blk -> m r) ->
  m r
getEnv :: forall (m :: * -> *) blk r.
(IOLike m, HasCallStack) =>
PerasCertDbHandle m blk -> (PerasCertDbEnv m blk -> m r) -> m r
getEnv (PerasCertDbHandle StrictTVar m (PerasCertDbState m blk)
varState) PerasCertDbEnv m blk -> m r
f =
  StrictTVar m (PerasCertDbState m blk) -> m (PerasCertDbState m blk)
forall (m :: * -> *) a. MonadSTM m => StrictTVar m a -> m a
readTVarIO StrictTVar m (PerasCertDbState m blk)
varState m (PerasCertDbState m blk)
-> (PerasCertDbState m blk -> m r) -> m r
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    PerasCertDbOpen PerasCertDbEnv m blk
env -> PerasCertDbEnv m blk -> m r
f PerasCertDbEnv m blk
env
    PerasCertDbState m blk
PerasCertDbClosed -> PerasCertDbError -> m r
forall e a. Exception e => e -> m a
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwIO (PerasCertDbError -> m r) -> PerasCertDbError -> m r
forall a b. (a -> b) -> a -> b
$ PrettyCallStack -> PerasCertDbError
ClosedDBError PrettyCallStack
HasCallStack => PrettyCallStack
prettyCallStack

getEnv1 ::
  (IOLike m, HasCallStack) =>
  PerasCertDbHandle m blk ->
  (PerasCertDbEnv m blk -> a -> m r) ->
  a ->
  m r
getEnv1 :: forall (m :: * -> *) blk a r.
(IOLike m, HasCallStack) =>
PerasCertDbHandle m blk
-> (PerasCertDbEnv m blk -> a -> m r) -> a -> m r
getEnv1 PerasCertDbHandle m blk
h PerasCertDbEnv m blk -> a -> m r
f a
a = PerasCertDbHandle m blk -> (PerasCertDbEnv m blk -> m r) -> m r
forall (m :: * -> *) blk r.
(IOLike m, HasCallStack) =>
PerasCertDbHandle m blk -> (PerasCertDbEnv m blk -> m r) -> m r
getEnv PerasCertDbHandle m blk
h (\PerasCertDbEnv m blk
env -> PerasCertDbEnv m blk -> a -> m r
f PerasCertDbEnv m blk
env a
a)

getEnvSTM ::
  (IOLike m, HasCallStack) =>
  PerasCertDbHandle m blk ->
  (PerasCertDbEnv m blk -> STM m r) ->
  STM m r
getEnvSTM :: forall (m :: * -> *) blk r.
(IOLike m, HasCallStack) =>
PerasCertDbHandle m blk
-> (PerasCertDbEnv m blk -> STM m r) -> STM m r
getEnvSTM (PerasCertDbHandle StrictTVar m (PerasCertDbState m blk)
varState) PerasCertDbEnv m blk -> STM m r
f =
  StrictTVar m (PerasCertDbState m blk)
-> STM m (PerasCertDbState m blk)
forall (m :: * -> *) a. MonadSTM m => StrictTVar m a -> STM m a
readTVar StrictTVar m (PerasCertDbState m blk)
varState STM m (PerasCertDbState m blk)
-> (PerasCertDbState m blk -> STM m r) -> STM m r
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
    PerasCertDbOpen PerasCertDbEnv m blk
env -> PerasCertDbEnv m blk -> STM m r
f PerasCertDbEnv m blk
env
    PerasCertDbState m blk
PerasCertDbClosed -> PerasCertDbError -> STM m r
forall e a. Exception e => e -> STM m a
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwIO (PerasCertDbError -> STM m r) -> PerasCertDbError -> STM m r
forall a b. (a -> b) -> a -> b
$ PrettyCallStack -> PerasCertDbError
ClosedDBError PrettyCallStack
HasCallStack => PrettyCallStack
prettyCallStack

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

implCloseDB :: IOLike m => PerasCertDbHandle m blk -> m ()
implCloseDB :: forall (m :: * -> *) blk.
IOLike m =>
PerasCertDbHandle m blk -> m ()
implCloseDB (PerasCertDbHandle StrictTVar m (PerasCertDbState m blk)
varState) =
  STM m (PerasCertDbState m blk) -> m (PerasCertDbState m blk)
forall a. HasCallStack => STM m a -> m a
forall (m :: * -> *) a.
(MonadSTM m, HasCallStack) =>
STM m a -> m a
atomically (StrictTVar m (PerasCertDbState m blk)
-> PerasCertDbState m blk -> STM m (PerasCertDbState m blk)
forall (m :: * -> *) a.
MonadSTM m =>
StrictTVar m a -> a -> STM m a
swapTVar StrictTVar m (PerasCertDbState m blk)
varState PerasCertDbState m blk
forall (m :: * -> *) blk. PerasCertDbState m blk
PerasCertDbClosed) m (PerasCertDbState m blk)
-> (PerasCertDbState m blk -> m ()) -> m ()
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    PerasCertDbOpen PerasCertDbEnv{Tracer m (TraceEvent blk)
pcdbTracer :: forall (m :: * -> *) blk.
PerasCertDbEnv m blk -> Tracer m (TraceEvent blk)
pcdbTracer :: Tracer m (TraceEvent blk)
pcdbTracer} -> do
      Tracer m (TraceEvent blk) -> TraceEvent blk -> m ()
forall (m :: * -> *) a. Tracer m a -> a -> m ()
traceWith Tracer m (TraceEvent blk)
pcdbTracer TraceEvent blk
forall blk. TraceEvent blk
ClosedPerasCertDB
    -- DB was already closed.
    PerasCertDbState m blk
PerasCertDbClosed -> () -> m ()
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

-- TODO: we will need to update this method with non-trivial validation logic
-- see https://github.com/tweag/cardano-peras/issues/120
implAddCert ::
  ( IOLike m
  , StandardHash blk
  ) =>
  PerasCertDbEnv m blk ->
  ValidatedPerasCert blk ->
  m AddPerasCertResult
implAddCert :: forall (m :: * -> *) blk.
(IOLike m, StandardHash blk) =>
PerasCertDbEnv m blk
-> ValidatedPerasCert blk -> m AddPerasCertResult
implAddCert PerasCertDbEnv m blk
env ValidatedPerasCert blk
cert = do
  Tracer m (TraceEvent blk) -> TraceEvent blk -> m ()
forall (m :: * -> *) a. Tracer m a -> a -> m ()
traceWith Tracer m (TraceEvent blk)
pcdbTracer (TraceEvent blk -> m ()) -> TraceEvent blk -> m ()
forall a b. (a -> b) -> a -> b
$ PerasRoundNo -> Point blk -> TraceEvent blk
forall blk. PerasRoundNo -> Point blk -> TraceEvent blk
AddingPerasCert PerasRoundNo
roundNo Point blk
boostedPt
  res <- STM m AddPerasCertResult -> m AddPerasCertResult
forall a. HasCallStack => STM m a -> m a
forall (m :: * -> *) a.
(MonadSTM m, HasCallStack) =>
STM m a -> m a
atomically (STM m AddPerasCertResult -> m AddPerasCertResult)
-> STM m AddPerasCertResult -> m AddPerasCertResult
forall a b. (a -> b) -> a -> b
$ do
    WithFingerprint
      PerasVolatileCertState
        { pvcsCerts
        , pvcsWeightByPoint
        , pvcsCertsByTicket
        , pvcsLastTicketNo
        }
      fp <-
      StrictTVar m (WithFingerprint (PerasVolatileCertState blk))
-> STM m (WithFingerprint (PerasVolatileCertState blk))
forall (m :: * -> *) a. MonadSTM m => StrictTVar m a -> STM m a
readTVar StrictTVar m (WithFingerprint (PerasVolatileCertState blk))
pcdbVolatileState
    if Map.member roundNo pvcsCerts
      then pure PerasCertAlreadyInDB
      else do
        let pvcsLastTicketNo' = PerasCertTicketNo -> PerasCertTicketNo
forall a. Enum a => a -> a
succ PerasCertTicketNo
pvcsLastTicketNo
        writeTVar pcdbVolatileState $
          WithFingerprint
            PerasVolatileCertState
              { pvcsCerts =
                  Map.insert roundNo cert pvcsCerts
              , -- Note that the same block might be boosted by multiple points.
                pvcsWeightByPoint =
                  addToPerasWeightSnapshot boostedPt (getPerasCertBoost cert) pvcsWeightByPoint
              , pvcsCertsByTicket =
                  Map.insert pvcsLastTicketNo' cert pvcsCertsByTicket
              , pvcsLastTicketNo = pvcsLastTicketNo'
              }
            (succ fp)
        pure AddedPerasCertToDB
  traceWith pcdbTracer $ case res of
    AddPerasCertResult
AddedPerasCertToDB -> PerasRoundNo -> Point blk -> TraceEvent blk
forall blk. PerasRoundNo -> Point blk -> TraceEvent blk
AddedPerasCert PerasRoundNo
roundNo Point blk
boostedPt
    AddPerasCertResult
PerasCertAlreadyInDB -> PerasRoundNo -> Point blk -> TraceEvent blk
forall blk. PerasRoundNo -> Point blk -> TraceEvent blk
IgnoredCertAlreadyInDB PerasRoundNo
roundNo Point blk
boostedPt
  pure res
 where
  PerasCertDbEnv
    { Tracer m (TraceEvent blk)
pcdbTracer :: forall (m :: * -> *) blk.
PerasCertDbEnv m blk -> Tracer m (TraceEvent blk)
pcdbTracer :: Tracer m (TraceEvent blk)
pcdbTracer
    , StrictTVar m (WithFingerprint (PerasVolatileCertState blk))
pcdbVolatileState :: forall (m :: * -> *) blk.
PerasCertDbEnv m blk
-> StrictTVar m (WithFingerprint (PerasVolatileCertState blk))
pcdbVolatileState :: StrictTVar m (WithFingerprint (PerasVolatileCertState blk))
pcdbVolatileState
    } = PerasCertDbEnv m blk
env

  boostedPt :: Point blk
boostedPt = ValidatedPerasCert blk -> Point blk
forall (cert :: * -> *) blk.
HasPerasCert cert blk =>
cert blk -> Point blk
getPerasCertBoostedBlock ValidatedPerasCert blk
cert
  roundNo :: PerasRoundNo
roundNo = ValidatedPerasCert blk -> PerasRoundNo
forall (cert :: * -> *) blk.
HasPerasCert cert blk =>
cert blk -> PerasRoundNo
getPerasCertRound ValidatedPerasCert blk
cert

implGetWeightSnapshot ::
  IOLike m =>
  PerasCertDbEnv m blk -> STM m (WithFingerprint (PerasWeightSnapshot blk))
implGetWeightSnapshot :: forall (m :: * -> *) blk.
IOLike m =>
PerasCertDbEnv m blk
-> STM m (WithFingerprint (PerasWeightSnapshot blk))
implGetWeightSnapshot PerasCertDbEnv{StrictTVar m (WithFingerprint (PerasVolatileCertState blk))
pcdbVolatileState :: forall (m :: * -> *) blk.
PerasCertDbEnv m blk
-> StrictTVar m (WithFingerprint (PerasVolatileCertState blk))
pcdbVolatileState :: StrictTVar m (WithFingerprint (PerasVolatileCertState blk))
pcdbVolatileState} =
  (PerasVolatileCertState blk -> PerasWeightSnapshot blk)
-> WithFingerprint (PerasVolatileCertState blk)
-> WithFingerprint (PerasWeightSnapshot blk)
forall a b. (a -> b) -> WithFingerprint a -> WithFingerprint b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap PerasVolatileCertState blk -> PerasWeightSnapshot blk
forall blk. PerasVolatileCertState blk -> PerasWeightSnapshot blk
pvcsWeightByPoint (WithFingerprint (PerasVolatileCertState blk)
 -> WithFingerprint (PerasWeightSnapshot blk))
-> STM m (WithFingerprint (PerasVolatileCertState blk))
-> STM m (WithFingerprint (PerasWeightSnapshot blk))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StrictTVar m (WithFingerprint (PerasVolatileCertState blk))
-> STM m (WithFingerprint (PerasVolatileCertState blk))
forall (m :: * -> *) a. MonadSTM m => StrictTVar m a -> STM m a
readTVar StrictTVar m (WithFingerprint (PerasVolatileCertState blk))
pcdbVolatileState

implGetCertSnapshot ::
  IOLike m =>
  PerasCertDbEnv m blk -> STM m (PerasCertSnapshot blk)
implGetCertSnapshot :: forall (m :: * -> *) blk.
IOLike m =>
PerasCertDbEnv m blk -> STM m (PerasCertSnapshot blk)
implGetCertSnapshot PerasCertDbEnv{StrictTVar m (WithFingerprint (PerasVolatileCertState blk))
pcdbVolatileState :: forall (m :: * -> *) blk.
PerasCertDbEnv m blk
-> StrictTVar m (WithFingerprint (PerasVolatileCertState blk))
pcdbVolatileState :: StrictTVar m (WithFingerprint (PerasVolatileCertState blk))
pcdbVolatileState} =
  StrictTVar m (WithFingerprint (PerasVolatileCertState blk))
-> STM m (WithFingerprint (PerasVolatileCertState blk))
forall (m :: * -> *) a. MonadSTM m => StrictTVar m a -> STM m a
readTVar StrictTVar m (WithFingerprint (PerasVolatileCertState blk))
pcdbVolatileState
    STM m (WithFingerprint (PerasVolatileCertState blk))
-> (WithFingerprint (PerasVolatileCertState blk)
    -> PerasVolatileCertState blk)
-> STM m (PerasVolatileCertState blk)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> WithFingerprint (PerasVolatileCertState blk)
-> PerasVolatileCertState blk
forall a. WithFingerprint a -> a
forgetFingerprint
    STM m (PerasVolatileCertState blk)
-> (PerasVolatileCertState blk -> PerasCertSnapshot blk)
-> STM m (PerasCertSnapshot blk)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \PerasVolatileCertState
           { Map PerasRoundNo (ValidatedPerasCert blk)
pvcsCerts :: forall blk.
PerasVolatileCertState blk
-> Map PerasRoundNo (ValidatedPerasCert blk)
pvcsCerts :: Map PerasRoundNo (ValidatedPerasCert blk)
pvcsCerts
           , Map PerasCertTicketNo (ValidatedPerasCert blk)
pvcsCertsByTicket :: forall blk.
PerasVolatileCertState blk
-> Map PerasCertTicketNo (ValidatedPerasCert blk)
pvcsCertsByTicket :: Map PerasCertTicketNo (ValidatedPerasCert blk)
pvcsCertsByTicket
           } ->
        PerasCertSnapshot
          { containsCert :: PerasRoundNo -> Bool
containsCert = \PerasRoundNo
r -> PerasRoundNo -> Map PerasRoundNo (ValidatedPerasCert blk) -> Bool
forall k a. Ord k => k -> Map k a -> Bool
Map.member PerasRoundNo
r Map PerasRoundNo (ValidatedPerasCert blk)
pvcsCerts
          , getCertsAfter :: PerasCertTicketNo -> Map PerasCertTicketNo (ValidatedPerasCert blk)
getCertsAfter = \PerasCertTicketNo
ticketNo ->
              (Map PerasCertTicketNo (ValidatedPerasCert blk),
 Map PerasCertTicketNo (ValidatedPerasCert blk))
-> Map PerasCertTicketNo (ValidatedPerasCert blk)
forall a b. (a, b) -> b
snd ((Map PerasCertTicketNo (ValidatedPerasCert blk),
  Map PerasCertTicketNo (ValidatedPerasCert blk))
 -> Map PerasCertTicketNo (ValidatedPerasCert blk))
-> (Map PerasCertTicketNo (ValidatedPerasCert blk),
    Map PerasCertTicketNo (ValidatedPerasCert blk))
-> Map PerasCertTicketNo (ValidatedPerasCert blk)
forall a b. (a -> b) -> a -> b
$ PerasCertTicketNo
-> Map PerasCertTicketNo (ValidatedPerasCert blk)
-> (Map PerasCertTicketNo (ValidatedPerasCert blk),
    Map PerasCertTicketNo (ValidatedPerasCert blk))
forall k a. Ord k => k -> Map k a -> (Map k a, Map k a)
Map.split PerasCertTicketNo
ticketNo Map PerasCertTicketNo (ValidatedPerasCert blk)
pvcsCertsByTicket
          }

implGarbageCollect ::
  forall m blk.
  (IOLike m, StandardHash blk) =>
  PerasCertDbEnv m blk -> SlotNo -> m ()
implGarbageCollect :: forall (m :: * -> *) blk.
(IOLike m, StandardHash blk) =>
PerasCertDbEnv m blk -> SlotNo -> m ()
implGarbageCollect PerasCertDbEnv{StrictTVar m (WithFingerprint (PerasVolatileCertState blk))
pcdbVolatileState :: forall (m :: * -> *) blk.
PerasCertDbEnv m blk
-> StrictTVar m (WithFingerprint (PerasVolatileCertState blk))
pcdbVolatileState :: StrictTVar m (WithFingerprint (PerasVolatileCertState blk))
pcdbVolatileState} SlotNo
slot =
  -- No need to update the 'Fingerprint' as we only remove certificates that do
  -- not matter for comparing interesting chains.
  STM m () -> m ()
forall a. HasCallStack => STM m a -> m a
forall (m :: * -> *) a.
(MonadSTM m, HasCallStack) =>
STM m a -> m a
atomically (STM m () -> m ()) -> STM m () -> m ()
forall a b. (a -> b) -> a -> b
$ StrictTVar m (WithFingerprint (PerasVolatileCertState blk))
-> (WithFingerprint (PerasVolatileCertState blk)
    -> WithFingerprint (PerasVolatileCertState blk))
-> STM m ()
forall (m :: * -> *) a.
MonadSTM m =>
StrictTVar m a -> (a -> a) -> STM m ()
modifyTVar StrictTVar m (WithFingerprint (PerasVolatileCertState blk))
pcdbVolatileState ((PerasVolatileCertState blk -> PerasVolatileCertState blk)
-> WithFingerprint (PerasVolatileCertState blk)
-> WithFingerprint (PerasVolatileCertState blk)
forall a b. (a -> b) -> WithFingerprint a -> WithFingerprint b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap PerasVolatileCertState blk -> PerasVolatileCertState blk
gc)
 where
  gc :: PerasVolatileCertState blk -> PerasVolatileCertState blk
  gc :: PerasVolatileCertState blk -> PerasVolatileCertState blk
gc
    PerasVolatileCertState
      { Map PerasRoundNo (ValidatedPerasCert blk)
pvcsCerts :: forall blk.
PerasVolatileCertState blk
-> Map PerasRoundNo (ValidatedPerasCert blk)
pvcsCerts :: Map PerasRoundNo (ValidatedPerasCert blk)
pvcsCerts
      , PerasWeightSnapshot blk
pvcsWeightByPoint :: forall blk. PerasVolatileCertState blk -> PerasWeightSnapshot blk
pvcsWeightByPoint :: PerasWeightSnapshot blk
pvcsWeightByPoint
      , PerasCertTicketNo
pvcsLastTicketNo :: forall blk. PerasVolatileCertState blk -> PerasCertTicketNo
pvcsLastTicketNo :: PerasCertTicketNo
pvcsLastTicketNo
      , Map PerasCertTicketNo (ValidatedPerasCert blk)
pvcsCertsByTicket :: forall blk.
PerasVolatileCertState blk
-> Map PerasCertTicketNo (ValidatedPerasCert blk)
pvcsCertsByTicket :: Map PerasCertTicketNo (ValidatedPerasCert blk)
pvcsCertsByTicket
      } =
      PerasVolatileCertState
        { pvcsCerts :: Map PerasRoundNo (ValidatedPerasCert blk)
pvcsCerts = (ValidatedPerasCert blk -> Bool)
-> Map PerasRoundNo (ValidatedPerasCert blk)
-> Map PerasRoundNo (ValidatedPerasCert blk)
forall a k. (a -> Bool) -> Map k a -> Map k a
Map.filter ValidatedPerasCert blk -> Bool
forall {cert :: * -> *} {block}.
HasPerasCert cert block =>
cert block -> Bool
keepCert Map PerasRoundNo (ValidatedPerasCert blk)
pvcsCerts
        , pvcsWeightByPoint :: PerasWeightSnapshot blk
pvcsWeightByPoint = SlotNo -> PerasWeightSnapshot blk -> PerasWeightSnapshot blk
forall blk.
SlotNo -> PerasWeightSnapshot blk -> PerasWeightSnapshot blk
prunePerasWeightSnapshot SlotNo
slot PerasWeightSnapshot blk
pvcsWeightByPoint
        , pvcsCertsByTicket :: Map PerasCertTicketNo (ValidatedPerasCert blk)
pvcsCertsByTicket = (ValidatedPerasCert blk -> Bool)
-> Map PerasCertTicketNo (ValidatedPerasCert blk)
-> Map PerasCertTicketNo (ValidatedPerasCert blk)
forall a k. (a -> Bool) -> Map k a -> Map k a
Map.filter ValidatedPerasCert blk -> Bool
forall {cert :: * -> *} {block}.
HasPerasCert cert block =>
cert block -> Bool
keepCert Map PerasCertTicketNo (ValidatedPerasCert blk)
pvcsCertsByTicket
        , pvcsLastTicketNo :: PerasCertTicketNo
pvcsLastTicketNo = PerasCertTicketNo
pvcsLastTicketNo
        }
     where
      keepCert :: cert block -> Bool
keepCert cert block
cert =
        Point block -> WithOrigin SlotNo
forall {k} (block :: k). Point block -> WithOrigin SlotNo
pointSlot (cert block -> Point block
forall (cert :: * -> *) blk.
HasPerasCert cert blk =>
cert blk -> Point blk
getPerasCertBoostedBlock cert block
cert) WithOrigin SlotNo -> WithOrigin SlotNo -> Bool
forall a. Ord a => a -> a -> Bool
>= SlotNo -> WithOrigin SlotNo
forall t. t -> WithOrigin t
NotOrigin SlotNo
slot

{-------------------------------------------------------------------------------
  Implementation-internal types
-------------------------------------------------------------------------------}

-- | Volatile Peras certificate state, i.e. certificates that could influence
-- chain selection by boosting a volatile block.
--
-- INVARIANT: See 'invariantForPerasVolatileCertState'.
data PerasVolatileCertState blk = PerasVolatileCertState
  { forall blk.
PerasVolatileCertState blk
-> Map PerasRoundNo (ValidatedPerasCert blk)
pvcsCerts :: !(Map PerasRoundNo (ValidatedPerasCert blk))
  -- ^ The boosted blocks by 'RoundNo' of all certificates currently in the db.
  , forall blk. PerasVolatileCertState blk -> PerasWeightSnapshot blk
pvcsWeightByPoint :: !(PerasWeightSnapshot blk)
  -- ^ The weight of boosted blocks w.r.t. the certificates currently in the db.
  , forall blk.
PerasVolatileCertState blk
-> Map PerasCertTicketNo (ValidatedPerasCert blk)
pvcsCertsByTicket :: !(Map PerasCertTicketNo (ValidatedPerasCert blk))
  -- ^ The certificates by 'PerasCertTicketNo'.
  , forall blk. PerasVolatileCertState blk -> PerasCertTicketNo
pvcsLastTicketNo :: !PerasCertTicketNo
  -- ^ The most recent 'PerasCertTicketNo' (or 'zeroPerasCertTicketNo'
  -- otherwise).
  }
  deriving stock (Int -> PerasVolatileCertState blk -> ShowS
[PerasVolatileCertState blk] -> ShowS
PerasVolatileCertState blk -> String
(Int -> PerasVolatileCertState blk -> ShowS)
-> (PerasVolatileCertState blk -> String)
-> ([PerasVolatileCertState blk] -> ShowS)
-> Show (PerasVolatileCertState blk)
forall blk.
StandardHash blk =>
Int -> PerasVolatileCertState blk -> ShowS
forall blk.
StandardHash blk =>
[PerasVolatileCertState blk] -> ShowS
forall blk.
StandardHash blk =>
PerasVolatileCertState blk -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall blk.
StandardHash blk =>
Int -> PerasVolatileCertState blk -> ShowS
showsPrec :: Int -> PerasVolatileCertState blk -> ShowS
$cshow :: forall blk.
StandardHash blk =>
PerasVolatileCertState blk -> String
show :: PerasVolatileCertState blk -> String
$cshowList :: forall blk.
StandardHash blk =>
[PerasVolatileCertState blk] -> ShowS
showList :: [PerasVolatileCertState blk] -> ShowS
Show, (forall x.
 PerasVolatileCertState blk -> Rep (PerasVolatileCertState blk) x)
-> (forall x.
    Rep (PerasVolatileCertState blk) x -> PerasVolatileCertState blk)
-> Generic (PerasVolatileCertState blk)
forall x.
Rep (PerasVolatileCertState blk) x -> PerasVolatileCertState blk
forall x.
PerasVolatileCertState blk -> Rep (PerasVolatileCertState blk) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall blk x.
Rep (PerasVolatileCertState blk) x -> PerasVolatileCertState blk
forall blk x.
PerasVolatileCertState blk -> Rep (PerasVolatileCertState blk) x
$cfrom :: forall blk x.
PerasVolatileCertState blk -> Rep (PerasVolatileCertState blk) x
from :: forall x.
PerasVolatileCertState blk -> Rep (PerasVolatileCertState blk) x
$cto :: forall blk x.
Rep (PerasVolatileCertState blk) x -> PerasVolatileCertState blk
to :: forall x.
Rep (PerasVolatileCertState blk) x -> PerasVolatileCertState blk
Generic)
  deriving anyclass Context -> PerasVolatileCertState blk -> IO (Maybe ThunkInfo)
Proxy (PerasVolatileCertState blk) -> String
(Context -> PerasVolatileCertState blk -> IO (Maybe ThunkInfo))
-> (Context -> PerasVolatileCertState blk -> IO (Maybe ThunkInfo))
-> (Proxy (PerasVolatileCertState blk) -> String)
-> NoThunks (PerasVolatileCertState blk)
forall blk.
StandardHash blk =>
Context -> PerasVolatileCertState blk -> IO (Maybe ThunkInfo)
forall blk.
StandardHash blk =>
Proxy (PerasVolatileCertState blk) -> String
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
$cnoThunks :: forall blk.
StandardHash blk =>
Context -> PerasVolatileCertState blk -> IO (Maybe ThunkInfo)
noThunks :: Context -> PerasVolatileCertState blk -> IO (Maybe ThunkInfo)
$cwNoThunks :: forall blk.
StandardHash blk =>
Context -> PerasVolatileCertState blk -> IO (Maybe ThunkInfo)
wNoThunks :: Context -> PerasVolatileCertState blk -> IO (Maybe ThunkInfo)
$cshowTypeOf :: forall blk.
StandardHash blk =>
Proxy (PerasVolatileCertState blk) -> String
showTypeOf :: Proxy (PerasVolatileCertState blk) -> String
NoThunks

initialPerasVolatileCertState :: WithFingerprint (PerasVolatileCertState blk)
initialPerasVolatileCertState :: forall blk. WithFingerprint (PerasVolatileCertState blk)
initialPerasVolatileCertState =
  PerasVolatileCertState blk
-> Fingerprint -> WithFingerprint (PerasVolatileCertState blk)
forall a. a -> Fingerprint -> WithFingerprint a
WithFingerprint
    PerasVolatileCertState
      { pvcsCerts :: Map PerasRoundNo (ValidatedPerasCert blk)
pvcsCerts = Map PerasRoundNo (ValidatedPerasCert blk)
forall k a. Map k a
Map.empty
      , pvcsWeightByPoint :: PerasWeightSnapshot blk
pvcsWeightByPoint = PerasWeightSnapshot blk
forall blk. PerasWeightSnapshot blk
emptyPerasWeightSnapshot
      , pvcsCertsByTicket :: Map PerasCertTicketNo (ValidatedPerasCert blk)
pvcsCertsByTicket = Map PerasCertTicketNo (ValidatedPerasCert blk)
forall k a. Map k a
Map.empty
      , pvcsLastTicketNo :: PerasCertTicketNo
pvcsLastTicketNo = PerasCertTicketNo
zeroPerasCertTicketNo
      }
    (Word64 -> Fingerprint
Fingerprint Word64
0)

-- | Check that the fields of 'PerasVolatileCertState' are in sync.
invariantForPerasVolatileCertState ::
  forall blk.
  StandardHash blk =>
  WithFingerprint (PerasVolatileCertState blk) -> Either String ()
invariantForPerasVolatileCertState :: forall blk.
StandardHash blk =>
WithFingerprint (PerasVolatileCertState blk) -> Either String ()
invariantForPerasVolatileCertState WithFingerprint (PerasVolatileCertState blk)
pvcs = do
  [(PerasRoundNo, ValidatedPerasCert blk)]
-> ((PerasRoundNo, ValidatedPerasCert blk) -> Either String ())
-> Either String ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ (Map PerasRoundNo (ValidatedPerasCert blk)
-> [(PerasRoundNo, ValidatedPerasCert blk)]
forall k a. Map k a -> [(k, a)]
Map.toList Map PerasRoundNo (ValidatedPerasCert blk)
pvcsCerts) (((PerasRoundNo, ValidatedPerasCert blk) -> Either String ())
 -> Either String ())
-> ((PerasRoundNo, ValidatedPerasCert blk) -> Either String ())
-> Either String ()
forall a b. (a -> b) -> a -> b
$ \(PerasRoundNo
roundNo, ValidatedPerasCert blk
vpc) ->
    String -> PerasRoundNo -> PerasRoundNo -> Either String ()
forall a. (Eq a, Show a) => String -> a -> a -> Either String ()
checkEqual String
"pvcsCerts rounds" PerasRoundNo
roundNo (ValidatedPerasCert blk -> PerasRoundNo
forall (cert :: * -> *) blk.
HasPerasCert cert blk =>
cert blk -> PerasRoundNo
getPerasCertRound ValidatedPerasCert blk
vpc)
  String
-> PerasWeightSnapshot blk
-> PerasWeightSnapshot blk
-> Either String ()
forall a. (Eq a, Show a) => String -> a -> a -> Either String ()
checkEqual String
"pvcsWeightByPoint" PerasWeightSnapshot blk
pvcsWeightByPoint PerasWeightSnapshot blk
expectedWeightByPoint
  String -> Set PerasRoundNo -> Set PerasRoundNo -> Either String ()
forall a. (Eq a, Show a) => String -> a -> a -> Either String ()
checkEqual
    String
"pvcsCertsByTicket"
    ([PerasRoundNo] -> Set PerasRoundNo
forall a. Ord a => [a] -> Set a
Set.fromList (ValidatedPerasCert blk -> PerasRoundNo
forall (cert :: * -> *) blk.
HasPerasCert cert blk =>
cert blk -> PerasRoundNo
getPerasCertRound (ValidatedPerasCert blk -> PerasRoundNo)
-> [ValidatedPerasCert blk] -> [PerasRoundNo]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map PerasCertTicketNo (ValidatedPerasCert blk)
-> [ValidatedPerasCert blk]
forall k a. Map k a -> [a]
Map.elems Map PerasCertTicketNo (ValidatedPerasCert blk)
pvcsCertsByTicket))
    ([PerasRoundNo] -> Set PerasRoundNo
forall a. Ord a => [a] -> Set a
Set.fromList (ValidatedPerasCert blk -> PerasRoundNo
forall (cert :: * -> *) blk.
HasPerasCert cert blk =>
cert blk -> PerasRoundNo
getPerasCertRound (ValidatedPerasCert blk -> PerasRoundNo)
-> [ValidatedPerasCert blk] -> [PerasRoundNo]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map PerasRoundNo (ValidatedPerasCert blk)
-> [ValidatedPerasCert blk]
forall k a. Map k a -> [a]
Map.elems Map PerasRoundNo (ValidatedPerasCert blk)
pvcsCerts))
  [PerasCertTicketNo]
-> (PerasCertTicketNo -> Either String ()) -> Either String ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ (Map PerasCertTicketNo (ValidatedPerasCert blk)
-> [PerasCertTicketNo]
forall k a. Map k a -> [k]
Map.keys Map PerasCertTicketNo (ValidatedPerasCert blk)
pvcsCertsByTicket) ((PerasCertTicketNo -> Either String ()) -> Either String ())
-> (PerasCertTicketNo -> Either String ()) -> Either String ()
forall a b. (a -> b) -> a -> b
$ \PerasCertTicketNo
ticketNo ->
    Bool -> Either String () -> Either String ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (PerasCertTicketNo
ticketNo PerasCertTicketNo -> PerasCertTicketNo -> Bool
forall a. Ord a => a -> a -> Bool
> PerasCertTicketNo
pvcsLastTicketNo) (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
<> PerasCertTicketNo -> String
forall a. Show a => a -> String
show PerasCertTicketNo
ticketNo
          String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" > "
          String -> ShowS
forall a. Semigroup a => a -> a -> a
<> PerasCertTicketNo -> String
forall a. Show a => a -> String
show PerasCertTicketNo
pvcsLastTicketNo
 where
  PerasVolatileCertState Map PerasRoundNo (ValidatedPerasCert blk)
_ PerasWeightSnapshot blk
_ Map PerasCertTicketNo (ValidatedPerasCert blk)
_ PerasCertTicketNo
_keep = WithFingerprint (PerasVolatileCertState blk)
-> PerasVolatileCertState blk
forall a. WithFingerprint a -> a
forgetFingerprint WithFingerprint (PerasVolatileCertState blk)
pvcs
  PerasVolatileCertState
    { Map PerasRoundNo (ValidatedPerasCert blk)
pvcsCerts :: forall blk.
PerasVolatileCertState blk
-> Map PerasRoundNo (ValidatedPerasCert blk)
pvcsCerts :: Map PerasRoundNo (ValidatedPerasCert blk)
pvcsCerts
    , PerasWeightSnapshot blk
pvcsWeightByPoint :: forall blk. PerasVolatileCertState blk -> PerasWeightSnapshot blk
pvcsWeightByPoint :: PerasWeightSnapshot blk
pvcsWeightByPoint
    , Map PerasCertTicketNo (ValidatedPerasCert blk)
pvcsCertsByTicket :: forall blk.
PerasVolatileCertState blk
-> Map PerasCertTicketNo (ValidatedPerasCert blk)
pvcsCertsByTicket :: Map PerasCertTicketNo (ValidatedPerasCert blk)
pvcsCertsByTicket
    , PerasCertTicketNo
pvcsLastTicketNo :: forall blk. PerasVolatileCertState blk -> PerasCertTicketNo
pvcsLastTicketNo :: PerasCertTicketNo
pvcsLastTicketNo
    } = WithFingerprint (PerasVolatileCertState blk)
-> PerasVolatileCertState blk
forall a. WithFingerprint a -> a
forgetFingerprint WithFingerprint (PerasVolatileCertState blk)
pvcs

  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

  expectedWeightByPoint :: PerasWeightSnapshot blk
expectedWeightByPoint =
    [(Point blk, PerasWeight)] -> PerasWeightSnapshot blk
forall blk.
StandardHash blk =>
[(Point blk, PerasWeight)] -> PerasWeightSnapshot blk
mkPerasWeightSnapshot
      [ (ValidatedPerasCert blk -> Point blk
forall (cert :: * -> *) blk.
HasPerasCert cert blk =>
cert blk -> Point blk
getPerasCertBoostedBlock ValidatedPerasCert blk
vpc, ValidatedPerasCert blk -> PerasWeight
forall blk. ValidatedPerasCert blk -> PerasWeight
getPerasCertBoost ValidatedPerasCert blk
vpc)
      | ValidatedPerasCert blk
vpc <- Map PerasRoundNo (ValidatedPerasCert blk)
-> [ValidatedPerasCert blk]
forall k a. Map k a -> [a]
Map.elems Map PerasRoundNo (ValidatedPerasCert blk)
pvcsCerts
      ]

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

data TraceEvent blk
  = OpenedPerasCertDB
  | ClosedPerasCertDB
  | AddingPerasCert PerasRoundNo (Point blk)
  | AddedPerasCert PerasRoundNo (Point blk)
  | IgnoredCertAlreadyInDB PerasRoundNo (Point blk)
  deriving stock (Int -> TraceEvent blk -> ShowS
[TraceEvent blk] -> ShowS
TraceEvent blk -> String
(Int -> TraceEvent blk -> ShowS)
-> (TraceEvent blk -> String)
-> ([TraceEvent blk] -> ShowS)
-> Show (TraceEvent blk)
forall blk. StandardHash blk => Int -> TraceEvent blk -> ShowS
forall blk. StandardHash blk => [TraceEvent blk] -> ShowS
forall blk. StandardHash blk => TraceEvent blk -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall blk. StandardHash blk => Int -> TraceEvent blk -> ShowS
showsPrec :: Int -> TraceEvent blk -> ShowS
$cshow :: forall blk. StandardHash blk => TraceEvent blk -> String
show :: TraceEvent blk -> String
$cshowList :: forall blk. StandardHash blk => [TraceEvent blk] -> ShowS
showList :: [TraceEvent blk] -> ShowS
Show, TraceEvent blk -> TraceEvent blk -> Bool
(TraceEvent blk -> TraceEvent blk -> Bool)
-> (TraceEvent blk -> TraceEvent blk -> Bool)
-> Eq (TraceEvent blk)
forall blk.
StandardHash blk =>
TraceEvent blk -> TraceEvent blk -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall blk.
StandardHash blk =>
TraceEvent blk -> TraceEvent blk -> Bool
== :: TraceEvent blk -> TraceEvent blk -> Bool
$c/= :: forall blk.
StandardHash blk =>
TraceEvent blk -> TraceEvent blk -> Bool
/= :: TraceEvent blk -> TraceEvent blk -> Bool
Eq, (forall x. TraceEvent blk -> Rep (TraceEvent blk) x)
-> (forall x. Rep (TraceEvent blk) x -> TraceEvent blk)
-> Generic (TraceEvent blk)
forall x. Rep (TraceEvent blk) x -> TraceEvent blk
forall x. TraceEvent blk -> Rep (TraceEvent blk) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall blk x. Rep (TraceEvent blk) x -> TraceEvent blk
forall blk x. TraceEvent blk -> Rep (TraceEvent blk) x
$cfrom :: forall blk x. TraceEvent blk -> Rep (TraceEvent blk) x
from :: forall x. TraceEvent blk -> Rep (TraceEvent blk) x
$cto :: forall blk x. Rep (TraceEvent blk) x -> TraceEvent blk
to :: forall x. Rep (TraceEvent blk) x -> TraceEvent blk
Generic)

{-------------------------------------------------------------------------------
  Exceptions
-------------------------------------------------------------------------------}

data PerasCertDbError
  = ClosedDBError PrettyCallStack
  deriving stock Int -> PerasCertDbError -> ShowS
[PerasCertDbError] -> ShowS
PerasCertDbError -> String
(Int -> PerasCertDbError -> ShowS)
-> (PerasCertDbError -> String)
-> ([PerasCertDbError] -> ShowS)
-> Show PerasCertDbError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PerasCertDbError -> ShowS
showsPrec :: Int -> PerasCertDbError -> ShowS
$cshow :: PerasCertDbError -> String
show :: PerasCertDbError -> String
$cshowList :: [PerasCertDbError] -> ShowS
showList :: [PerasCertDbError] -> ShowS
Show
  deriving anyclass Show PerasCertDbError
Typeable PerasCertDbError
(Typeable PerasCertDbError, Show PerasCertDbError) =>
(PerasCertDbError -> SomeException)
-> (SomeException -> Maybe PerasCertDbError)
-> (PerasCertDbError -> String)
-> (PerasCertDbError -> Bool)
-> Exception PerasCertDbError
SomeException -> Maybe PerasCertDbError
PerasCertDbError -> Bool
PerasCertDbError -> String
PerasCertDbError -> SomeException
forall e.
(Typeable e, Show e) =>
(e -> SomeException)
-> (SomeException -> Maybe e)
-> (e -> String)
-> (e -> Bool)
-> Exception e
$ctoException :: PerasCertDbError -> SomeException
toException :: PerasCertDbError -> SomeException
$cfromException :: SomeException -> Maybe PerasCertDbError
fromException :: SomeException -> Maybe PerasCertDbError
$cdisplayException :: PerasCertDbError -> String
displayException :: PerasCertDbError -> String
$cbacktraceDesired :: PerasCertDbError -> Bool
backtraceDesired :: PerasCertDbError -> Bool
Exception