{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE NamedFieldPuns #-}

module Cardano.Tools.DBAnalyser.Types (module Cardano.Tools.DBAnalyser.Types) where

import Data.Maybe (fromMaybe)
import Data.Word
import Ouroboros.Consensus.Block

data SelectDB
  = SelectImmutableDB (WithOrigin SlotNo)

data DBAnalyserConfig = DBAnalyserConfig
  { DBAnalyserConfig -> FilePath
dbDir :: FilePath
  , DBAnalyserConfig -> Bool
verbose :: Bool
  , DBAnalyserConfig -> SelectDB
selectDB :: SelectDB
  , DBAnalyserConfig -> Maybe ValidateBlocks
validation :: Maybe ValidateBlocks
  , DBAnalyserConfig -> AnalysisName
analysis :: AnalysisName
  , DBAnalyserConfig -> Limit
confLimit :: Limit
  , DBAnalyserConfig -> Maybe LedgerDBBackendFlags
ldbBackend :: Maybe LedgerDBBackendFlags
  -- ^ The LedgerDB backend selected on the command line. When 'Nothing', the
  -- backend and its settings are taken from the node configuration file
  -- instead; see 'selectLedgerDBBackend'.
  }

data AnalysisName
  = ShowSlotBlockNo
  | CountTxOutputs
  | ShowBlockHeaderSize
  | ShowBlockTxsSize
  | ShowEBBs
  | OnlyValidation
  | StoreLedgerStateAt SlotNo LedgerApplicationMode
  | CountBlocks
  | CheckNoThunksEvery Word64
  | TraceLedgerProcessing
  | BenchmarkLedgerOps (Maybe FilePath) LedgerApplicationMode
  | ReproMempoolAndForge Int
  | -- | Compute different block application metrics every 'NumberOfBlocks'.
    --
    -- The metrics will be written to the provided file path, or to
    -- the standard output if no file path is specified.
    GetBlockApplicationMetrics NumberOfBlocks (Maybe FilePath)
  deriving Int -> AnalysisName -> ShowS
[AnalysisName] -> ShowS
AnalysisName -> FilePath
(Int -> AnalysisName -> ShowS)
-> (AnalysisName -> FilePath)
-> ([AnalysisName] -> ShowS)
-> Show AnalysisName
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> AnalysisName -> ShowS
showsPrec :: Int -> AnalysisName -> ShowS
$cshow :: AnalysisName -> FilePath
show :: AnalysisName -> FilePath
$cshowList :: [AnalysisName] -> ShowS
showList :: [AnalysisName] -> ShowS
Show

data AnalysisResult
  = ResultCountBlock Int
  | ResultMaxHeaderSize Word16
  deriving (AnalysisResult -> AnalysisResult -> Bool
(AnalysisResult -> AnalysisResult -> Bool)
-> (AnalysisResult -> AnalysisResult -> Bool) -> Eq AnalysisResult
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: AnalysisResult -> AnalysisResult -> Bool
== :: AnalysisResult -> AnalysisResult -> Bool
$c/= :: AnalysisResult -> AnalysisResult -> Bool
/= :: AnalysisResult -> AnalysisResult -> Bool
Eq, Int -> AnalysisResult -> ShowS
[AnalysisResult] -> ShowS
AnalysisResult -> FilePath
(Int -> AnalysisResult -> ShowS)
-> (AnalysisResult -> FilePath)
-> ([AnalysisResult] -> ShowS)
-> Show AnalysisResult
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> AnalysisResult -> ShowS
showsPrec :: Int -> AnalysisResult -> ShowS
$cshow :: AnalysisResult -> FilePath
show :: AnalysisResult -> FilePath
$cshowList :: [AnalysisResult] -> ShowS
showList :: [AnalysisResult] -> ShowS
Show)

newtype NumberOfBlocks = NumberOfBlocks {NumberOfBlocks -> Word64
unNumberOfBlocks :: Word64}
  deriving (NumberOfBlocks -> NumberOfBlocks -> Bool
(NumberOfBlocks -> NumberOfBlocks -> Bool)
-> (NumberOfBlocks -> NumberOfBlocks -> Bool) -> Eq NumberOfBlocks
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: NumberOfBlocks -> NumberOfBlocks -> Bool
== :: NumberOfBlocks -> NumberOfBlocks -> Bool
$c/= :: NumberOfBlocks -> NumberOfBlocks -> Bool
/= :: NumberOfBlocks -> NumberOfBlocks -> Bool
Eq, Int -> NumberOfBlocks -> ShowS
[NumberOfBlocks] -> ShowS
NumberOfBlocks -> FilePath
(Int -> NumberOfBlocks -> ShowS)
-> (NumberOfBlocks -> FilePath)
-> ([NumberOfBlocks] -> ShowS)
-> Show NumberOfBlocks
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> NumberOfBlocks -> ShowS
showsPrec :: Int -> NumberOfBlocks -> ShowS
$cshow :: NumberOfBlocks -> FilePath
show :: NumberOfBlocks -> FilePath
$cshowList :: [NumberOfBlocks] -> ShowS
showList :: [NumberOfBlocks] -> ShowS
Show, Integer -> NumberOfBlocks
NumberOfBlocks -> NumberOfBlocks
NumberOfBlocks -> NumberOfBlocks -> NumberOfBlocks
(NumberOfBlocks -> NumberOfBlocks -> NumberOfBlocks)
-> (NumberOfBlocks -> NumberOfBlocks -> NumberOfBlocks)
-> (NumberOfBlocks -> NumberOfBlocks -> NumberOfBlocks)
-> (NumberOfBlocks -> NumberOfBlocks)
-> (NumberOfBlocks -> NumberOfBlocks)
-> (NumberOfBlocks -> NumberOfBlocks)
-> (Integer -> NumberOfBlocks)
-> Num NumberOfBlocks
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
$c+ :: NumberOfBlocks -> NumberOfBlocks -> NumberOfBlocks
+ :: NumberOfBlocks -> NumberOfBlocks -> NumberOfBlocks
$c- :: NumberOfBlocks -> NumberOfBlocks -> NumberOfBlocks
- :: NumberOfBlocks -> NumberOfBlocks -> NumberOfBlocks
$c* :: NumberOfBlocks -> NumberOfBlocks -> NumberOfBlocks
* :: NumberOfBlocks -> NumberOfBlocks -> NumberOfBlocks
$cnegate :: NumberOfBlocks -> NumberOfBlocks
negate :: NumberOfBlocks -> NumberOfBlocks
$cabs :: NumberOfBlocks -> NumberOfBlocks
abs :: NumberOfBlocks -> NumberOfBlocks
$csignum :: NumberOfBlocks -> NumberOfBlocks
signum :: NumberOfBlocks -> NumberOfBlocks
$cfromInteger :: Integer -> NumberOfBlocks
fromInteger :: Integer -> NumberOfBlocks
Num, ReadPrec [NumberOfBlocks]
ReadPrec NumberOfBlocks
Int -> ReadS NumberOfBlocks
ReadS [NumberOfBlocks]
(Int -> ReadS NumberOfBlocks)
-> ReadS [NumberOfBlocks]
-> ReadPrec NumberOfBlocks
-> ReadPrec [NumberOfBlocks]
-> Read NumberOfBlocks
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS NumberOfBlocks
readsPrec :: Int -> ReadS NumberOfBlocks
$creadList :: ReadS [NumberOfBlocks]
readList :: ReadS [NumberOfBlocks]
$creadPrec :: ReadPrec NumberOfBlocks
readPrec :: ReadPrec NumberOfBlocks
$creadListPrec :: ReadPrec [NumberOfBlocks]
readListPrec :: ReadPrec [NumberOfBlocks]
Read)

data Limit = Limit Int | Unlimited

data LedgerDBBackend
  = V2InMem
  | V2LSM LSMOptions

-- | The settings of the LSM-trees backend.
data LSMOptions = LSMOptions
  { LSMOptions -> FilePath
lsmDatabasePath :: FilePath
  -- ^ The directory, relative to the LedgerDB filesystem root, holding the
  -- working LSM database.
  , LSMOptions -> Maybe FilePath
lsmExportPath :: Maybe FilePath
  -- ^ The directory, relative to the LedgerDB filesystem root, into which the
  -- LSM backend exports snapshots as it takes them. When 'Nothing', snapshots
  -- are not exported.
  , LSMOptions -> Bool
lsmNoDiskCache :: Bool
  -- ^ Bypass the OS page cache for UTxO table reads/writes (instead of caching
  -- all). Intended for benchmarking.
  }

-- | The LedgerDB backend as the command line selects it: @--in-mem@, or @--lsm@
-- with its switches.
data LedgerDBBackendFlags
  = InMemFlag
  | LSMFlag LSMFlags

-- | The switches that accompany @--lsm@. Each can only turn its setting on, so
-- 'False' leaves the setting as the node configuration file has it.
data LSMFlags = LSMFlags
  { LSMFlags -> Bool
lsmExportFlag :: Bool
  -- ^ @--lsm-export@
  , LSMFlags -> Bool
lsmNoDiskCacheFlag :: Bool
  -- ^ @--lsm-no-cache@
  }

-- | The backend to use, from the one the command line selects and the one the
-- node configuration file selects. The command line wins, but @--lsm@ against
-- a configuration that also selects LSM overrides only what its switches set:
-- the paths come from the configuration, and @--lsm-export@ exports into the
-- configured @ExportPath@ when there is one. Against any other configuration,
-- @--lsm@ starts from the defaults.
selectLedgerDBBackend ::
  Maybe LedgerDBBackendFlags -> Maybe LedgerDBBackend -> Maybe LedgerDBBackend
selectLedgerDBBackend :: Maybe LedgerDBBackendFlags
-> Maybe LedgerDBBackend -> Maybe LedgerDBBackend
selectLedgerDBBackend Maybe LedgerDBBackendFlags
flags Maybe LedgerDBBackend
configBackend = case Maybe LedgerDBBackendFlags
flags of
  Maybe LedgerDBBackendFlags
Nothing -> Maybe LedgerDBBackend
configBackend
  Just LedgerDBBackendFlags
InMemFlag -> LedgerDBBackend -> Maybe LedgerDBBackend
forall a. a -> Maybe a
Just LedgerDBBackend
V2InMem
  Just (LSMFlag LSMFlags{Bool
lsmExportFlag :: LSMFlags -> Bool
lsmExportFlag :: Bool
lsmExportFlag, Bool
lsmNoDiskCacheFlag :: LSMFlags -> Bool
lsmNoDiskCacheFlag :: Bool
lsmNoDiskCacheFlag}) ->
    LedgerDBBackend -> Maybe LedgerDBBackend
forall a. a -> Maybe a
Just (LedgerDBBackend -> Maybe LedgerDBBackend)
-> LedgerDBBackend -> Maybe LedgerDBBackend
forall a b. (a -> b) -> a -> b
$
      LSMOptions -> LedgerDBBackend
V2LSM
        LSMOptions
base
          { lsmExportPath =
              if lsmExportFlag
                then Just (fromMaybe defaultLSMExportPath (lsmExportPath base))
                else lsmExportPath base
          , lsmNoDiskCache = lsmNoDiskCache base || lsmNoDiskCacheFlag
          }
 where
  base :: LSMOptions
base = case Maybe LedgerDBBackend
configBackend of
    Just (V2LSM LSMOptions
opts) -> LSMOptions
opts
    Maybe LedgerDBBackend
_ ->
      LSMOptions
        { lsmDatabasePath :: FilePath
lsmDatabasePath = FilePath
defaultLSMDatabasePath
        , lsmExportPath :: Maybe FilePath
lsmExportPath = Maybe FilePath
forall a. Maybe a
Nothing
        , lsmNoDiskCache :: Bool
lsmNoDiskCache = Bool
False
        }

-- | The directory holding the working LSM database, used when the node
-- configuration file does not set @LedgerDB.Backend.LSM.DatabasePath@.
defaultLSMDatabasePath :: FilePath
defaultLSMDatabasePath :: FilePath
defaultLSMDatabasePath = FilePath
"lsm"

-- | The directory that @--lsm-export@ exports snapshots into, when the node
-- configuration file does not set @LedgerDB.Backend.LSM.ExportPath@.
defaultLSMExportPath :: FilePath
defaultLSMExportPath :: FilePath
defaultLSMExportPath = FilePath
"lsm-exported"

-- | The extent of the ChainDB on-disk files validation. This is completely
-- unrelated to validation of the ledger rules.
data ValidateBlocks = ValidateAllBlocks | MinimumBlockValidation

-- | Whether to apply blocks to a ledger state via /reapplication/ (eg skipping
-- signature checks/Plutus scripts) or full /application/ (much slower).
data LedgerApplicationMode = LedgerReapply | LedgerApply
  deriving (LedgerApplicationMode -> LedgerApplicationMode -> Bool
(LedgerApplicationMode -> LedgerApplicationMode -> Bool)
-> (LedgerApplicationMode -> LedgerApplicationMode -> Bool)
-> Eq LedgerApplicationMode
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: LedgerApplicationMode -> LedgerApplicationMode -> Bool
== :: LedgerApplicationMode -> LedgerApplicationMode -> Bool
$c/= :: LedgerApplicationMode -> LedgerApplicationMode -> Bool
/= :: LedgerApplicationMode -> LedgerApplicationMode -> Bool
Eq, Int -> LedgerApplicationMode -> ShowS
[LedgerApplicationMode] -> ShowS
LedgerApplicationMode -> FilePath
(Int -> LedgerApplicationMode -> ShowS)
-> (LedgerApplicationMode -> FilePath)
-> ([LedgerApplicationMode] -> ShowS)
-> Show LedgerApplicationMode
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> LedgerApplicationMode -> ShowS
showsPrec :: Int -> LedgerApplicationMode -> ShowS
$cshow :: LedgerApplicationMode -> FilePath
show :: LedgerApplicationMode -> FilePath
$cshowList :: [LedgerApplicationMode] -> ShowS
showList :: [LedgerApplicationMode] -> ShowS
Show)