{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE StandaloneDeriving #-}

module Ouroboros.Consensus.Storage.VolatileDB.Impl.Types (
    -- * Blocks per file
    mkBlocksPerFile
  , unBlocksPerFile
    -- ** opaque
  , BlocksPerFile
    -- * Block validation policy
  , BlockValidationPolicy (..)
    -- * Parse error
  , ParseError (..)
    -- * Tracing
  , TraceEvent (..)
    -- * Internal indices
  , BlockOffset (..)
  , BlockSize (..)
  , FileId
  , InternalBlockInfo (..)
  , ReverseIndex
  , SuccessorsIndex
  ) where


import           Data.Map.Strict (Map)
import           Data.Set (Set)
import           Data.Word (Word32, Word64)
import           GHC.Generics (Generic)
import           NoThunks.Class (NoThunks)
import           Ouroboros.Consensus.Block
import           Ouroboros.Consensus.Storage.VolatileDB.API (BlockInfo)
import           Ouroboros.Consensus.Util.CBOR (ReadIncrementalErr (..))
import           System.FS.API.Types (FsPath)

{------------------------------------------------------------------------------
  Blocks per file
------------------------------------------------------------------------------}

-- | The maximum number of blocks to store per file.
newtype BlocksPerFile = BlocksPerFile { BlocksPerFile -> Word32
unBlocksPerFile :: Word32 }
    deriving ((forall x. BlocksPerFile -> Rep BlocksPerFile x)
-> (forall x. Rep BlocksPerFile x -> BlocksPerFile)
-> Generic BlocksPerFile
forall x. Rep BlocksPerFile x -> BlocksPerFile
forall x. BlocksPerFile -> Rep BlocksPerFile x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. BlocksPerFile -> Rep BlocksPerFile x
from :: forall x. BlocksPerFile -> Rep BlocksPerFile x
$cto :: forall x. Rep BlocksPerFile x -> BlocksPerFile
to :: forall x. Rep BlocksPerFile x -> BlocksPerFile
Generic, Int -> BlocksPerFile -> ShowS
[BlocksPerFile] -> ShowS
BlocksPerFile -> String
(Int -> BlocksPerFile -> ShowS)
-> (BlocksPerFile -> String)
-> ([BlocksPerFile] -> ShowS)
-> Show BlocksPerFile
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> BlocksPerFile -> ShowS
showsPrec :: Int -> BlocksPerFile -> ShowS
$cshow :: BlocksPerFile -> String
show :: BlocksPerFile -> String
$cshowList :: [BlocksPerFile] -> ShowS
showList :: [BlocksPerFile] -> ShowS
Show)

-- | Create a 'BlocksPerFile'.
--
-- PRECONDITION: the given number must be greater than 0, if not, this
-- function will throw an 'error'.
mkBlocksPerFile :: Word32 -> BlocksPerFile
mkBlocksPerFile :: Word32 -> BlocksPerFile
mkBlocksPerFile Word32
0 = String -> BlocksPerFile
forall a. HasCallStack => String -> a
error String
"BlocksPerFile must be positive"
mkBlocksPerFile Word32
n = Word32 -> BlocksPerFile
BlocksPerFile Word32
n

{------------------------------------------------------------------------------
  Block validation policy
------------------------------------------------------------------------------}

-- | When block validation is enabled, the parser checks for each block a
-- number of properties and stops parsing if it finds any invalid blocks.
data BlockValidationPolicy =
    NoValidation
  | ValidateAll
  deriving (BlockValidationPolicy -> BlockValidationPolicy -> Bool
(BlockValidationPolicy -> BlockValidationPolicy -> Bool)
-> (BlockValidationPolicy -> BlockValidationPolicy -> Bool)
-> Eq BlockValidationPolicy
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: BlockValidationPolicy -> BlockValidationPolicy -> Bool
== :: BlockValidationPolicy -> BlockValidationPolicy -> Bool
$c/= :: BlockValidationPolicy -> BlockValidationPolicy -> Bool
/= :: BlockValidationPolicy -> BlockValidationPolicy -> Bool
Eq)

{------------------------------------------------------------------------------
  Parse error
------------------------------------------------------------------------------}

-- | Note that we recover from the error, and thus never throw it as an
-- 'Exception'.
--
-- Defined here instead of in the @Parser@ module because 'TraceEvent' depends
-- on it.
data ParseError blk =
    BlockReadErr ReadIncrementalErr
    -- ^ A block could not be parsed.
  | BlockCorruptedErr (HeaderHash blk)
    -- ^ A block was corrupted, e.g., checking its signature and/or hash
    -- failed.
  | DuplicatedBlock (HeaderHash blk) FsPath FsPath
    -- ^ A block with the same hash occurred twice in the VolatileDB files.
    --
    -- We include the file in which it occurred first and the file in which it
    -- occured the second time. The two files can be the same.

deriving instance StandardHash blk => Eq   (ParseError blk)
deriving instance StandardHash blk => Show (ParseError blk)

{------------------------------------------------------------------------------
  Tracing
------------------------------------------------------------------------------}

data TraceEvent blk
    = DBAlreadyClosed
    | BlockAlreadyHere (HeaderHash blk)
    | Truncate (ParseError blk) FsPath BlockOffset
    | InvalidFileNames [FsPath]
    | DBClosed
  deriving (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, 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)

{------------------------------------------------------------------------------
  Internal indices
------------------------------------------------------------------------------}

-- | The 'FileId' is the unique identifier of each file found in the db.
-- For example, the file @blocks-42.dat@ has 'FileId' @42@.
type FileId = Int

-- | We map the header hash of each block to the 'InternalBlockInfo'.
type ReverseIndex blk = Map (HeaderHash blk) (InternalBlockInfo blk)

-- | For each block, we store the set of all blocks which have this block as
-- a predecessor (set of successors).
type SuccessorsIndex blk = Map (ChainHash blk) (Set (HeaderHash blk))

newtype BlockSize = BlockSize { BlockSize -> Word32
unBlockSize :: Word32 }
  deriving (BlockSize -> BlockSize -> Bool
(BlockSize -> BlockSize -> Bool)
-> (BlockSize -> BlockSize -> Bool) -> Eq BlockSize
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: BlockSize -> BlockSize -> Bool
== :: BlockSize -> BlockSize -> Bool
$c/= :: BlockSize -> BlockSize -> Bool
/= :: BlockSize -> BlockSize -> Bool
Eq, Int -> BlockSize -> ShowS
[BlockSize] -> ShowS
BlockSize -> String
(Int -> BlockSize -> ShowS)
-> (BlockSize -> String)
-> ([BlockSize] -> ShowS)
-> Show BlockSize
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> BlockSize -> ShowS
showsPrec :: Int -> BlockSize -> ShowS
$cshow :: BlockSize -> String
show :: BlockSize -> String
$cshowList :: [BlockSize] -> ShowS
showList :: [BlockSize] -> ShowS
Show, (forall x. BlockSize -> Rep BlockSize x)
-> (forall x. Rep BlockSize x -> BlockSize) -> Generic BlockSize
forall x. Rep BlockSize x -> BlockSize
forall x. BlockSize -> Rep BlockSize x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. BlockSize -> Rep BlockSize x
from :: forall x. BlockSize -> Rep BlockSize x
$cto :: forall x. Rep BlockSize x -> BlockSize
to :: forall x. Rep BlockSize x -> BlockSize
Generic, Context -> BlockSize -> IO (Maybe ThunkInfo)
Proxy BlockSize -> String
(Context -> BlockSize -> IO (Maybe ThunkInfo))
-> (Context -> BlockSize -> IO (Maybe ThunkInfo))
-> (Proxy BlockSize -> String)
-> NoThunks BlockSize
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
$cnoThunks :: Context -> BlockSize -> IO (Maybe ThunkInfo)
noThunks :: Context -> BlockSize -> IO (Maybe ThunkInfo)
$cwNoThunks :: Context -> BlockSize -> IO (Maybe ThunkInfo)
wNoThunks :: Context -> BlockSize -> IO (Maybe ThunkInfo)
$cshowTypeOf :: Proxy BlockSize -> String
showTypeOf :: Proxy BlockSize -> String
NoThunks)

-- | The offset at which a block is stored in a file.
newtype BlockOffset = BlockOffset { BlockOffset -> Word64
unBlockOffset :: Word64 }
  deriving (BlockOffset -> BlockOffset -> Bool
(BlockOffset -> BlockOffset -> Bool)
-> (BlockOffset -> BlockOffset -> Bool) -> Eq BlockOffset
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: BlockOffset -> BlockOffset -> Bool
== :: BlockOffset -> BlockOffset -> Bool
$c/= :: BlockOffset -> BlockOffset -> Bool
/= :: BlockOffset -> BlockOffset -> Bool
Eq, Int -> BlockOffset -> ShowS
[BlockOffset] -> ShowS
BlockOffset -> String
(Int -> BlockOffset -> ShowS)
-> (BlockOffset -> String)
-> ([BlockOffset] -> ShowS)
-> Show BlockOffset
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> BlockOffset -> ShowS
showsPrec :: Int -> BlockOffset -> ShowS
$cshow :: BlockOffset -> String
show :: BlockOffset -> String
$cshowList :: [BlockOffset] -> ShowS
showList :: [BlockOffset] -> ShowS
Show, (forall x. BlockOffset -> Rep BlockOffset x)
-> (forall x. Rep BlockOffset x -> BlockOffset)
-> Generic BlockOffset
forall x. Rep BlockOffset x -> BlockOffset
forall x. BlockOffset -> Rep BlockOffset x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. BlockOffset -> Rep BlockOffset x
from :: forall x. BlockOffset -> Rep BlockOffset x
$cto :: forall x. Rep BlockOffset x -> BlockOffset
to :: forall x. Rep BlockOffset x -> BlockOffset
Generic, Context -> BlockOffset -> IO (Maybe ThunkInfo)
Proxy BlockOffset -> String
(Context -> BlockOffset -> IO (Maybe ThunkInfo))
-> (Context -> BlockOffset -> IO (Maybe ThunkInfo))
-> (Proxy BlockOffset -> String)
-> NoThunks BlockOffset
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
$cnoThunks :: Context -> BlockOffset -> IO (Maybe ThunkInfo)
noThunks :: Context -> BlockOffset -> IO (Maybe ThunkInfo)
$cwNoThunks :: Context -> BlockOffset -> IO (Maybe ThunkInfo)
wNoThunks :: Context -> BlockOffset -> IO (Maybe ThunkInfo)
$cshowTypeOf :: Proxy BlockOffset -> String
showTypeOf :: Proxy BlockOffset -> String
NoThunks)

-- | The internal information the db keeps for each block.
data InternalBlockInfo blk = InternalBlockInfo {
      forall blk. InternalBlockInfo blk -> FsPath
ibiFile        :: !FsPath
    , forall blk. InternalBlockInfo blk -> BlockOffset
ibiBlockOffset :: !BlockOffset
    , forall blk. InternalBlockInfo blk -> BlockSize
ibiBlockSize   :: !BlockSize
    , forall blk. InternalBlockInfo blk -> BlockInfo blk
ibiBlockInfo   :: !(BlockInfo blk)
    , forall blk.
InternalBlockInfo blk -> SomeSecond (NestedCtxt Header) blk
ibiNestedCtxt  :: !(SomeSecond (NestedCtxt Header) blk)
    }
  deriving ((forall x. InternalBlockInfo blk -> Rep (InternalBlockInfo blk) x)
-> (forall x.
    Rep (InternalBlockInfo blk) x -> InternalBlockInfo blk)
-> Generic (InternalBlockInfo blk)
forall x. Rep (InternalBlockInfo blk) x -> InternalBlockInfo blk
forall x. InternalBlockInfo blk -> Rep (InternalBlockInfo blk) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall blk x.
Rep (InternalBlockInfo blk) x -> InternalBlockInfo blk
forall blk x.
InternalBlockInfo blk -> Rep (InternalBlockInfo blk) x
$cfrom :: forall blk x.
InternalBlockInfo blk -> Rep (InternalBlockInfo blk) x
from :: forall x. InternalBlockInfo blk -> Rep (InternalBlockInfo blk) x
$cto :: forall blk x.
Rep (InternalBlockInfo blk) x -> InternalBlockInfo blk
to :: forall x. Rep (InternalBlockInfo blk) x -> InternalBlockInfo blk
Generic, Context -> InternalBlockInfo blk -> IO (Maybe ThunkInfo)
Proxy (InternalBlockInfo blk) -> String
(Context -> InternalBlockInfo blk -> IO (Maybe ThunkInfo))
-> (Context -> InternalBlockInfo blk -> IO (Maybe ThunkInfo))
-> (Proxy (InternalBlockInfo blk) -> String)
-> NoThunks (InternalBlockInfo blk)
forall blk.
(StandardHash blk, Typeable blk) =>
Context -> InternalBlockInfo blk -> IO (Maybe ThunkInfo)
forall blk.
(StandardHash blk, Typeable blk) =>
Proxy (InternalBlockInfo blk) -> String
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
$cnoThunks :: forall blk.
(StandardHash blk, Typeable blk) =>
Context -> InternalBlockInfo blk -> IO (Maybe ThunkInfo)
noThunks :: Context -> InternalBlockInfo blk -> IO (Maybe ThunkInfo)
$cwNoThunks :: forall blk.
(StandardHash blk, Typeable blk) =>
Context -> InternalBlockInfo blk -> IO (Maybe ThunkInfo)
wNoThunks :: Context -> InternalBlockInfo blk -> IO (Maybe ThunkInfo)
$cshowTypeOf :: forall blk.
(StandardHash blk, Typeable blk) =>
Proxy (InternalBlockInfo blk) -> String
showTypeOf :: Proxy (InternalBlockInfo blk) -> String
NoThunks)