{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE NumericUnderscores #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE QuantifiedConstraints #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneKindSignatures #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}
module Ouroboros.Consensus.Storage.LedgerDB.Args
( LedgerDbArgs (..)
, LedgerDbFlavorArgs (..)
, QueryBatchSize (..)
, defaultArgs
, defaultQueryBatchSize
, GetVolatileSuffix (..)
, praosGetVolatileSuffix
) where
import Cardano.Ledger.BaseTypes (unNonZero)
import Control.ResourceRegistry
import Control.Tracer
import Data.Kind
import Data.Word
import GHC.Generics (Generic)
import NoThunks.Class
import Ouroboros.Consensus.Block
import Ouroboros.Consensus.Config.SecurityParam
import Ouroboros.Consensus.Ledger.Abstract
import Ouroboros.Consensus.Ledger.Extended
import Ouroboros.Consensus.Storage.LedgerDB.API
import Ouroboros.Consensus.Storage.LedgerDB.Snapshots
import Ouroboros.Consensus.Storage.LedgerDB.TraceEvent
import qualified Ouroboros.Consensus.Storage.LedgerDB.V1.Args as V1
import qualified Ouroboros.Consensus.Storage.LedgerDB.V2.Args as V2
import Ouroboros.Consensus.Util.Args
import Ouroboros.Consensus.Util.IOLike
import Ouroboros.Network.AnchoredSeq (AnchoredSeq)
import qualified Ouroboros.Network.AnchoredSeq as AS
import System.FS.API
type LedgerDbArgs ::
(Type -> Type) ->
(Type -> Type) ->
Type ->
Type
data LedgerDbArgs f m blk = LedgerDbArgs
{ forall (f :: * -> *) (m :: * -> *) blk.
LedgerDbArgs f m blk -> SnapshotPolicyArgs
lgrSnapshotPolicyArgs :: SnapshotPolicyArgs
, forall (f :: * -> *) (m :: * -> *) blk.
LedgerDbArgs f m blk -> HKD f (m (ExtLedgerState blk ValuesMK))
lgrGenesis :: HKD f (m (ExtLedgerState blk ValuesMK))
, forall (f :: * -> *) (m :: * -> *) blk.
LedgerDbArgs f m blk -> HKD f (SomeHasFS m)
lgrHasFS :: HKD f (SomeHasFS m)
, forall (f :: * -> *) (m :: * -> *) blk.
LedgerDbArgs f m blk -> LedgerDbCfgF f (ExtLedgerState blk)
lgrConfig :: LedgerDbCfgF f (ExtLedgerState blk)
, forall (f :: * -> *) (m :: * -> *) blk.
LedgerDbArgs f m blk -> Tracer m (TraceEvent blk)
lgrTracer :: Tracer m (TraceEvent blk)
, forall (f :: * -> *) (m :: * -> *) blk.
LedgerDbArgs f m blk -> LedgerDbFlavorArgs f m
lgrFlavorArgs :: LedgerDbFlavorArgs f m
, forall (f :: * -> *) (m :: * -> *) blk.
LedgerDbArgs f m blk -> HKD f (ResourceRegistry m)
lgrRegistry :: HKD f (ResourceRegistry m)
, forall (f :: * -> *) (m :: * -> *) blk.
LedgerDbArgs f m blk -> QueryBatchSize
lgrQueryBatchSize :: QueryBatchSize
, forall (f :: * -> *) (m :: * -> *) blk.
LedgerDbArgs f m blk -> Maybe DiskSnapshot
lgrStartSnapshot :: Maybe DiskSnapshot
}
defaultArgs ::
Applicative m =>
Incomplete LedgerDbArgs m blk
defaultArgs :: forall (m :: * -> *) blk.
Applicative m =>
Incomplete LedgerDbArgs m blk
defaultArgs =
LedgerDbArgs
{ lgrSnapshotPolicyArgs :: SnapshotPolicyArgs
lgrSnapshotPolicyArgs = SnapshotPolicyArgs
defaultSnapshotPolicyArgs
, lgrGenesis :: HKD Defaults (m (ExtLedgerState blk ValuesMK))
lgrGenesis = HKD Defaults (m (ExtLedgerState blk ValuesMK))
Defaults (m (ExtLedgerState blk ValuesMK))
forall {k} (t :: k). Defaults t
NoDefault
, lgrHasFS :: HKD Defaults (SomeHasFS m)
lgrHasFS = HKD Defaults (SomeHasFS m)
Defaults (SomeHasFS m)
forall {k} (t :: k). Defaults t
NoDefault
, lgrConfig :: LedgerDbCfgF Defaults (ExtLedgerState blk)
lgrConfig = HKD Defaults SecurityParam
-> HKD Defaults (LedgerCfg (ExtLedgerState blk))
-> ComputeLedgerEvents
-> LedgerDbCfgF Defaults (ExtLedgerState blk)
forall (f :: * -> *) (l :: LedgerStateKind).
HKD f SecurityParam
-> HKD f (LedgerCfg l) -> ComputeLedgerEvents -> LedgerDbCfgF f l
LedgerDbCfg HKD Defaults SecurityParam
Defaults SecurityParam
forall {k} (t :: k). Defaults t
NoDefault HKD Defaults (LedgerCfg (ExtLedgerState blk))
Defaults (ExtLedgerCfg blk)
forall {k} (t :: k). Defaults t
NoDefault ComputeLedgerEvents
OmitLedgerEvents
, lgrQueryBatchSize :: QueryBatchSize
lgrQueryBatchSize = QueryBatchSize
DefaultQueryBatchSize
, lgrTracer :: Tracer m (TraceEvent blk)
lgrTracer = Tracer m (TraceEvent blk)
forall (m :: * -> *) a. Applicative m => Tracer m a
nullTracer
,
lgrFlavorArgs :: LedgerDbFlavorArgs Defaults m
lgrFlavorArgs = LedgerDbFlavorArgs Defaults m -> LedgerDbFlavorArgs Defaults m
forall (f :: * -> *) (m :: * -> *).
LedgerDbFlavorArgs f m -> LedgerDbFlavorArgs f m
LedgerDbFlavorArgsV2 (HandleArgs Defaults m -> LedgerDbFlavorArgs Defaults m
forall {k} {k1} (f :: k) (m :: k1).
HandleArgs f m -> LedgerDbFlavorArgs f m
V2.V2Args HandleArgs Defaults m
forall {k} {k1} (f :: k) (m :: k1). HandleArgs f m
V2.InMemoryHandleArgs)
, lgrRegistry :: HKD Defaults (ResourceRegistry m)
lgrRegistry = HKD Defaults (ResourceRegistry m)
Defaults (ResourceRegistry m)
forall {k} (t :: k). Defaults t
NoDefault
, lgrStartSnapshot :: Maybe DiskSnapshot
lgrStartSnapshot = Maybe DiskSnapshot
forall a. Maybe a
Nothing
}
data LedgerDbFlavorArgs f m
= LedgerDbFlavorArgsV1 (V1.LedgerDbFlavorArgs f m)
| LedgerDbFlavorArgsV2 (V2.LedgerDbFlavorArgs f m)
data QueryBatchSize
=
DefaultQueryBatchSize
|
RequestedQueryBatchSize Word64
deriving (Int -> QueryBatchSize -> ShowS
[QueryBatchSize] -> ShowS
QueryBatchSize -> String
(Int -> QueryBatchSize -> ShowS)
-> (QueryBatchSize -> String)
-> ([QueryBatchSize] -> ShowS)
-> Show QueryBatchSize
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> QueryBatchSize -> ShowS
showsPrec :: Int -> QueryBatchSize -> ShowS
$cshow :: QueryBatchSize -> String
show :: QueryBatchSize -> String
$cshowList :: [QueryBatchSize] -> ShowS
showList :: [QueryBatchSize] -> ShowS
Show, QueryBatchSize -> QueryBatchSize -> Bool
(QueryBatchSize -> QueryBatchSize -> Bool)
-> (QueryBatchSize -> QueryBatchSize -> Bool) -> Eq QueryBatchSize
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: QueryBatchSize -> QueryBatchSize -> Bool
== :: QueryBatchSize -> QueryBatchSize -> Bool
$c/= :: QueryBatchSize -> QueryBatchSize -> Bool
/= :: QueryBatchSize -> QueryBatchSize -> Bool
Eq, (forall x. QueryBatchSize -> Rep QueryBatchSize x)
-> (forall x. Rep QueryBatchSize x -> QueryBatchSize)
-> Generic QueryBatchSize
forall x. Rep QueryBatchSize x -> QueryBatchSize
forall x. QueryBatchSize -> Rep QueryBatchSize x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. QueryBatchSize -> Rep QueryBatchSize x
from :: forall x. QueryBatchSize -> Rep QueryBatchSize x
$cto :: forall x. Rep QueryBatchSize x -> QueryBatchSize
to :: forall x. Rep QueryBatchSize x -> QueryBatchSize
Generic)
deriving anyclass Context -> QueryBatchSize -> IO (Maybe ThunkInfo)
Proxy QueryBatchSize -> String
(Context -> QueryBatchSize -> IO (Maybe ThunkInfo))
-> (Context -> QueryBatchSize -> IO (Maybe ThunkInfo))
-> (Proxy QueryBatchSize -> String)
-> NoThunks QueryBatchSize
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
$cnoThunks :: Context -> QueryBatchSize -> IO (Maybe ThunkInfo)
noThunks :: Context -> QueryBatchSize -> IO (Maybe ThunkInfo)
$cwNoThunks :: Context -> QueryBatchSize -> IO (Maybe ThunkInfo)
wNoThunks :: Context -> QueryBatchSize -> IO (Maybe ThunkInfo)
$cshowTypeOf :: Proxy QueryBatchSize -> String
showTypeOf :: Proxy QueryBatchSize -> String
NoThunks
defaultQueryBatchSize :: QueryBatchSize -> Word64
defaultQueryBatchSize :: QueryBatchSize -> Word64
defaultQueryBatchSize QueryBatchSize
requestedQueryBatchSize = case QueryBatchSize
requestedQueryBatchSize of
RequestedQueryBatchSize Word64
value -> Word64
value
QueryBatchSize
DefaultQueryBatchSize -> Word64
100_000
newtype GetVolatileSuffix m blk = GetVolatileSuffix
{ forall {k} (m :: * -> *) (blk :: k).
GetVolatileSuffix m blk
-> forall s.
Anchorable (WithOrigin SlotNo) s s =>
STM
m
(AnchoredSeq (WithOrigin SlotNo) s s
-> AnchoredSeq (WithOrigin SlotNo) s s)
getVolatileSuffix ::
forall s.
AS.Anchorable (WithOrigin SlotNo) s s =>
STM
m
( AnchoredSeq (WithOrigin SlotNo) s s ->
AnchoredSeq (WithOrigin SlotNo) s s
)
}
deriving Context -> GetVolatileSuffix m blk -> IO (Maybe ThunkInfo)
Proxy (GetVolatileSuffix m blk) -> String
(Context -> GetVolatileSuffix m blk -> IO (Maybe ThunkInfo))
-> (Context -> GetVolatileSuffix m blk -> IO (Maybe ThunkInfo))
-> (Proxy (GetVolatileSuffix m blk) -> String)
-> NoThunks (GetVolatileSuffix m blk)
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
forall (m :: * -> *) k (blk :: k).
Context -> GetVolatileSuffix m blk -> IO (Maybe ThunkInfo)
forall (m :: * -> *) k (blk :: k).
Proxy (GetVolatileSuffix m blk) -> String
$cnoThunks :: forall (m :: * -> *) k (blk :: k).
Context -> GetVolatileSuffix m blk -> IO (Maybe ThunkInfo)
noThunks :: Context -> GetVolatileSuffix m blk -> IO (Maybe ThunkInfo)
$cwNoThunks :: forall (m :: * -> *) k (blk :: k).
Context -> GetVolatileSuffix m blk -> IO (Maybe ThunkInfo)
wNoThunks :: Context -> GetVolatileSuffix m blk -> IO (Maybe ThunkInfo)
$cshowTypeOf :: forall (m :: * -> *) k (blk :: k).
Proxy (GetVolatileSuffix m blk) -> String
showTypeOf :: Proxy (GetVolatileSuffix m blk) -> String
NoThunks via OnlyCheckWhnfNamed "GetVolatileSuffix" (GetVolatileSuffix m blk)
praosGetVolatileSuffix :: IOLike m => SecurityParam -> GetVolatileSuffix m blk
praosGetVolatileSuffix :: forall {k} (m :: * -> *) (blk :: k).
IOLike m =>
SecurityParam -> GetVolatileSuffix m blk
praosGetVolatileSuffix SecurityParam
secParam =
(forall s.
Anchorable (WithOrigin SlotNo) s s =>
STM
m
(AnchoredSeq (WithOrigin SlotNo) s s
-> AnchoredSeq (WithOrigin SlotNo) s s))
-> GetVolatileSuffix m blk
forall {k} (m :: * -> *) (blk :: k).
(forall s.
Anchorable (WithOrigin SlotNo) s s =>
STM
m
(AnchoredSeq (WithOrigin SlotNo) s s
-> AnchoredSeq (WithOrigin SlotNo) s s))
-> GetVolatileSuffix m blk
GetVolatileSuffix ((forall s.
Anchorable (WithOrigin SlotNo) s s =>
STM
m
(AnchoredSeq (WithOrigin SlotNo) s s
-> AnchoredSeq (WithOrigin SlotNo) s s))
-> GetVolatileSuffix m blk)
-> (forall s.
Anchorable (WithOrigin SlotNo) s s =>
STM
m
(AnchoredSeq (WithOrigin SlotNo) s s
-> AnchoredSeq (WithOrigin SlotNo) s s))
-> GetVolatileSuffix m blk
forall a b. (a -> b) -> a -> b
$ (AnchoredSeq (WithOrigin SlotNo) s s
-> AnchoredSeq (WithOrigin SlotNo) s s)
-> STM
m
(AnchoredSeq (WithOrigin SlotNo) s s
-> AnchoredSeq (WithOrigin SlotNo) s s)
forall a. a -> STM m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((AnchoredSeq (WithOrigin SlotNo) s s
-> AnchoredSeq (WithOrigin SlotNo) s s)
-> STM
m
(AnchoredSeq (WithOrigin SlotNo) s s
-> AnchoredSeq (WithOrigin SlotNo) s s))
-> (AnchoredSeq (WithOrigin SlotNo) s s
-> AnchoredSeq (WithOrigin SlotNo) s s)
-> STM
m
(AnchoredSeq (WithOrigin SlotNo) s s
-> AnchoredSeq (WithOrigin SlotNo) s s)
forall a b. (a -> b) -> a -> b
$ Word64
-> AnchoredSeq (WithOrigin SlotNo) s s
-> AnchoredSeq (WithOrigin SlotNo) s s
forall v a b.
Anchorable v a b =>
Word64 -> AnchoredSeq v a b -> AnchoredSeq v a b
AS.anchorNewest Word64
k
where
k :: Word64
k = NonZero Word64 -> Word64
forall a. NonZero a -> a
unNonZero (NonZero Word64 -> Word64) -> NonZero Word64 -> Word64
forall a b. (a -> b) -> a -> b
$ SecurityParam -> NonZero Word64
maxRollbacks SecurityParam
secParam