{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE NumericUnderscores #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE RecordWildCards #-}
module Ouroboros.Consensus.Storage.LedgerDB.DiskPolicy (
DiskPolicy (..)
, DiskPolicyArgs (..)
, NumOfDiskSnapshots (..)
, SnapshotInterval (..)
, TimeSinceLast (..)
, defaultDiskPolicyArgs
, mkDiskPolicy
, pattern DoDiskSnapshotChecksum
, pattern NoDoDiskSnapshotChecksum
, Flag (..)
) where
import Control.Monad.Class.MonadTime.SI
import Data.Time.Clock (secondsToDiffTime)
import Data.Word
import GHC.Generics
import NoThunks.Class (NoThunks, OnlyCheckWhnf (..))
import Ouroboros.Consensus.Config.SecurityParam
import Ouroboros.Consensus.Util (Flag (..))
data SnapshotInterval =
DefaultSnapshotInterval
| RequestedSnapshotInterval DiffTime
deriving stock (SnapshotInterval -> SnapshotInterval -> Bool
(SnapshotInterval -> SnapshotInterval -> Bool)
-> (SnapshotInterval -> SnapshotInterval -> Bool)
-> Eq SnapshotInterval
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SnapshotInterval -> SnapshotInterval -> Bool
== :: SnapshotInterval -> SnapshotInterval -> Bool
$c/= :: SnapshotInterval -> SnapshotInterval -> Bool
/= :: SnapshotInterval -> SnapshotInterval -> Bool
Eq, (forall x. SnapshotInterval -> Rep SnapshotInterval x)
-> (forall x. Rep SnapshotInterval x -> SnapshotInterval)
-> Generic SnapshotInterval
forall x. Rep SnapshotInterval x -> SnapshotInterval
forall x. SnapshotInterval -> Rep SnapshotInterval x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. SnapshotInterval -> Rep SnapshotInterval x
from :: forall x. SnapshotInterval -> Rep SnapshotInterval x
$cto :: forall x. Rep SnapshotInterval x -> SnapshotInterval
to :: forall x. Rep SnapshotInterval x -> SnapshotInterval
Generic, Int -> SnapshotInterval -> ShowS
[SnapshotInterval] -> ShowS
SnapshotInterval -> String
(Int -> SnapshotInterval -> ShowS)
-> (SnapshotInterval -> String)
-> ([SnapshotInterval] -> ShowS)
-> Show SnapshotInterval
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SnapshotInterval -> ShowS
showsPrec :: Int -> SnapshotInterval -> ShowS
$cshow :: SnapshotInterval -> String
show :: SnapshotInterval -> String
$cshowList :: [SnapshotInterval] -> ShowS
showList :: [SnapshotInterval] -> ShowS
Show)
data NumOfDiskSnapshots =
DefaultNumOfDiskSnapshots
| RequestedNumOfDiskSnapshots Word
deriving stock (NumOfDiskSnapshots -> NumOfDiskSnapshots -> Bool
(NumOfDiskSnapshots -> NumOfDiskSnapshots -> Bool)
-> (NumOfDiskSnapshots -> NumOfDiskSnapshots -> Bool)
-> Eq NumOfDiskSnapshots
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: NumOfDiskSnapshots -> NumOfDiskSnapshots -> Bool
== :: NumOfDiskSnapshots -> NumOfDiskSnapshots -> Bool
$c/= :: NumOfDiskSnapshots -> NumOfDiskSnapshots -> Bool
/= :: NumOfDiskSnapshots -> NumOfDiskSnapshots -> Bool
Eq, (forall x. NumOfDiskSnapshots -> Rep NumOfDiskSnapshots x)
-> (forall x. Rep NumOfDiskSnapshots x -> NumOfDiskSnapshots)
-> Generic NumOfDiskSnapshots
forall x. Rep NumOfDiskSnapshots x -> NumOfDiskSnapshots
forall x. NumOfDiskSnapshots -> Rep NumOfDiskSnapshots x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. NumOfDiskSnapshots -> Rep NumOfDiskSnapshots x
from :: forall x. NumOfDiskSnapshots -> Rep NumOfDiskSnapshots x
$cto :: forall x. Rep NumOfDiskSnapshots x -> NumOfDiskSnapshots
to :: forall x. Rep NumOfDiskSnapshots x -> NumOfDiskSnapshots
Generic, Int -> NumOfDiskSnapshots -> ShowS
[NumOfDiskSnapshots] -> ShowS
NumOfDiskSnapshots -> String
(Int -> NumOfDiskSnapshots -> ShowS)
-> (NumOfDiskSnapshots -> String)
-> ([NumOfDiskSnapshots] -> ShowS)
-> Show NumOfDiskSnapshots
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> NumOfDiskSnapshots -> ShowS
showsPrec :: Int -> NumOfDiskSnapshots -> ShowS
$cshow :: NumOfDiskSnapshots -> String
show :: NumOfDiskSnapshots -> String
$cshowList :: [NumOfDiskSnapshots] -> ShowS
showList :: [NumOfDiskSnapshots] -> ShowS
Show)
pattern DoDiskSnapshotChecksum, NoDoDiskSnapshotChecksum :: Flag "DoDiskSnapshotChecksum"
pattern $mDoDiskSnapshotChecksum :: forall {r}.
Flag "DoDiskSnapshotChecksum" -> ((# #) -> r) -> ((# #) -> r) -> r
$bDoDiskSnapshotChecksum :: Flag "DoDiskSnapshotChecksum"
DoDiskSnapshotChecksum = Flag True
pattern $mNoDoDiskSnapshotChecksum :: forall {r}.
Flag "DoDiskSnapshotChecksum" -> ((# #) -> r) -> ((# #) -> r) -> r
$bNoDoDiskSnapshotChecksum :: Flag "DoDiskSnapshotChecksum"
NoDoDiskSnapshotChecksum = Flag False
data DiskPolicyArgs = DiskPolicyArgs SnapshotInterval NumOfDiskSnapshots (Flag "DoDiskSnapshotChecksum")
data DiskPolicy = DiskPolicy {
DiskPolicy -> Word
onDiskNumSnapshots :: Word
, DiskPolicy -> TimeSinceLast DiffTime -> Word64 -> Bool
onDiskShouldTakeSnapshot :: TimeSinceLast DiffTime -> Word64 -> Bool
, DiskPolicy -> Flag "DoDiskSnapshotChecksum"
onDiskShouldChecksumSnapshots :: Flag "DoDiskSnapshotChecksum"
}
deriving Context -> DiskPolicy -> IO (Maybe ThunkInfo)
Proxy DiskPolicy -> String
(Context -> DiskPolicy -> IO (Maybe ThunkInfo))
-> (Context -> DiskPolicy -> IO (Maybe ThunkInfo))
-> (Proxy DiskPolicy -> String)
-> NoThunks DiskPolicy
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
$cnoThunks :: Context -> DiskPolicy -> IO (Maybe ThunkInfo)
noThunks :: Context -> DiskPolicy -> IO (Maybe ThunkInfo)
$cwNoThunks :: Context -> DiskPolicy -> IO (Maybe ThunkInfo)
wNoThunks :: Context -> DiskPolicy -> IO (Maybe ThunkInfo)
$cshowTypeOf :: Proxy DiskPolicy -> String
showTypeOf :: Proxy DiskPolicy -> String
NoThunks via OnlyCheckWhnf DiskPolicy
data TimeSinceLast time = NoSnapshotTakenYet | TimeSinceLast time
deriving ((forall a b. (a -> b) -> TimeSinceLast a -> TimeSinceLast b)
-> (forall a b. a -> TimeSinceLast b -> TimeSinceLast a)
-> Functor TimeSinceLast
forall a b. a -> TimeSinceLast b -> TimeSinceLast a
forall a b. (a -> b) -> TimeSinceLast a -> TimeSinceLast b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> TimeSinceLast a -> TimeSinceLast b
fmap :: forall a b. (a -> b) -> TimeSinceLast a -> TimeSinceLast b
$c<$ :: forall a b. a -> TimeSinceLast b -> TimeSinceLast a
<$ :: forall a b. a -> TimeSinceLast b -> TimeSinceLast a
Functor, Int -> TimeSinceLast time -> ShowS
[TimeSinceLast time] -> ShowS
TimeSinceLast time -> String
(Int -> TimeSinceLast time -> ShowS)
-> (TimeSinceLast time -> String)
-> ([TimeSinceLast time] -> ShowS)
-> Show (TimeSinceLast time)
forall time. Show time => Int -> TimeSinceLast time -> ShowS
forall time. Show time => [TimeSinceLast time] -> ShowS
forall time. Show time => TimeSinceLast time -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall time. Show time => Int -> TimeSinceLast time -> ShowS
showsPrec :: Int -> TimeSinceLast time -> ShowS
$cshow :: forall time. Show time => TimeSinceLast time -> String
show :: TimeSinceLast time -> String
$cshowList :: forall time. Show time => [TimeSinceLast time] -> ShowS
showList :: [TimeSinceLast time] -> ShowS
Show)
defaultDiskPolicyArgs :: DiskPolicyArgs
defaultDiskPolicyArgs :: DiskPolicyArgs
defaultDiskPolicyArgs = SnapshotInterval
-> NumOfDiskSnapshots
-> Flag "DoDiskSnapshotChecksum"
-> DiskPolicyArgs
DiskPolicyArgs SnapshotInterval
DefaultSnapshotInterval NumOfDiskSnapshots
DefaultNumOfDiskSnapshots Flag "DoDiskSnapshotChecksum"
DoDiskSnapshotChecksum
mkDiskPolicy :: SecurityParam -> DiskPolicyArgs -> DiskPolicy
mkDiskPolicy :: SecurityParam -> DiskPolicyArgs -> DiskPolicy
mkDiskPolicy (SecurityParam Word64
k) (DiskPolicyArgs SnapshotInterval
reqInterval NumOfDiskSnapshots
reqNumOfSnapshots Flag "DoDiskSnapshotChecksum"
onDiskShouldChecksumSnapshots) =
DiskPolicy {Word
Flag "DoDiskSnapshotChecksum"
TimeSinceLast DiffTime -> Word64 -> Bool
onDiskNumSnapshots :: Word
onDiskShouldTakeSnapshot :: TimeSinceLast DiffTime -> Word64 -> Bool
onDiskShouldChecksumSnapshots :: Flag "DoDiskSnapshotChecksum"
onDiskShouldChecksumSnapshots :: Flag "DoDiskSnapshotChecksum"
onDiskNumSnapshots :: Word
onDiskShouldTakeSnapshot :: TimeSinceLast DiffTime -> Word64 -> Bool
..}
where
onDiskNumSnapshots :: Word
onDiskNumSnapshots :: Word
onDiskNumSnapshots = case NumOfDiskSnapshots
reqNumOfSnapshots of
NumOfDiskSnapshots
DefaultNumOfDiskSnapshots -> Word
2
RequestedNumOfDiskSnapshots Word
value -> Word
value
onDiskShouldTakeSnapshot ::
TimeSinceLast DiffTime
-> Word64
-> Bool
onDiskShouldTakeSnapshot :: TimeSinceLast DiffTime -> Word64 -> Bool
onDiskShouldTakeSnapshot TimeSinceLast DiffTime
NoSnapshotTakenYet Word64
blocksSinceLast =
Word64
blocksSinceLast Word64 -> Word64 -> Bool
forall a. Ord a => a -> a -> Bool
>= Word64
k
onDiskShouldTakeSnapshot (TimeSinceLast DiffTime
timeSinceLast) Word64
blocksSinceLast =
DiffTime
timeSinceLast DiffTime -> DiffTime -> Bool
forall a. Ord a => a -> a -> Bool
>= DiffTime
snapshotInterval
Bool -> Bool -> Bool
|| Word64 -> DiffTime -> Bool
forall {a}. (Ord a, Num a) => a -> DiffTime -> Bool
substantialAmountOfBlocksWereProcessed Word64
blocksSinceLast DiffTime
timeSinceLast
substantialAmountOfBlocksWereProcessed :: a -> DiffTime -> Bool
substantialAmountOfBlocksWereProcessed a
blocksSinceLast DiffTime
timeSinceLast =
let minBlocksBeforeSnapshot :: a
minBlocksBeforeSnapshot = a
50_000
minTimeBeforeSnapshot :: DiffTime
minTimeBeforeSnapshot = DiffTime
6 DiffTime -> DiffTime -> DiffTime
forall a. Num a => a -> a -> a
* Integer -> DiffTime
secondsToDiffTime Integer
60
in a
blocksSinceLast a -> a -> Bool
forall a. Ord a => a -> a -> Bool
>= a
minBlocksBeforeSnapshot
Bool -> Bool -> Bool
&& DiffTime
timeSinceLast DiffTime -> DiffTime -> Bool
forall a. Ord a => a -> a -> Bool
>= DiffTime
minTimeBeforeSnapshot
snapshotInterval :: DiffTime
snapshotInterval = case SnapshotInterval
reqInterval of
RequestedSnapshotInterval DiffTime
value -> DiffTime
value
SnapshotInterval
DefaultSnapshotInterval -> Integer -> DiffTime
secondsToDiffTime (Integer -> DiffTime) -> Integer -> DiffTime
forall a b. (a -> b) -> a -> b
$ Word64 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64 -> Integer) -> Word64 -> Integer
forall a b. (a -> b) -> a -> b
$ Word64
k Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
* Word64
2