{-# LANGUAGE CPP                        #-}
{-# LANGUAGE DeriveAnyClass             #-}
{-# LANGUAGE DeriveGeneric              #-}
{-# LANGUAGE DerivingStrategies         #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE RecordWildCards            #-}
{-# LANGUAGE TypeApplications           #-}

module Ouroboros.Consensus.Storage.ImmutableDB.Chunks.Internal (
    ChunkInfo (..)
  , chunkInfoSupportsEBBs
  , simpleChunkInfo
  , singleChunkInfo
    -- * Chunk number
  , ChunkNo (..)
  , chunkNoFromInt
  , chunkNoToInt
  , chunksBetween
  , countChunks
  , firstChunkNo
  , nextChunkNo
  , prevChunkNo
  , unsafeChunkNoToEpochNo
  , unsafeEpochNoToChunkNo
    -- * Chunk size
  , ChunkSize (..)
  , getChunkSize
    -- * Layout
  , RelativeSlot (..)
  , assertRelativeSlotInChunk
  , compareRelativeSlot
  , maxRelativeIndex
  , mkRelativeSlot
    -- * Assertions
  , ChunkAssertionFailure
  , assertChunkCanContainEBB
  , assertSameChunk
  , assertWithinBounds
  ) where

import           Control.Exception
import           Control.Monad
import           Data.Word
import           GHC.Generics (Generic)
import           NoThunks.Class (NoThunks)

import           Ouroboros.Consensus.Block
import           Ouroboros.Consensus.Util.CallStack
import           Ouroboros.Consensus.Util.RedundantConstraints

-- | Size of the chunks of the immutable DB
--
-- This is the key data structure that drives all layout functions.
--
-- TODO: Add support for non-uniform 'ChunkInfo'
-- <https://github.com/input-output-hk/ouroboros-network/issues/1754>
data ChunkInfo =
    -- | A single, uniform, chunk size
    --
    -- If EBBs are present, the chunk size must line up precisely with the
    -- epoch size (that is, the number of regular blocks in the chunk must equal
    -- the number of regular blocks in an epoch).
    --
    UniformChunkSize !ChunkSize
  deriving stock    (Int -> ChunkInfo -> ShowS
[ChunkInfo] -> ShowS
ChunkInfo -> String
(Int -> ChunkInfo -> ShowS)
-> (ChunkInfo -> String)
-> ([ChunkInfo] -> ShowS)
-> Show ChunkInfo
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ChunkInfo] -> ShowS
$cshowList :: [ChunkInfo] -> ShowS
show :: ChunkInfo -> String
$cshow :: ChunkInfo -> String
showsPrec :: Int -> ChunkInfo -> ShowS
$cshowsPrec :: Int -> ChunkInfo -> ShowS
Show, (forall x. ChunkInfo -> Rep ChunkInfo x)
-> (forall x. Rep ChunkInfo x -> ChunkInfo) -> Generic ChunkInfo
forall x. Rep ChunkInfo x -> ChunkInfo
forall x. ChunkInfo -> Rep ChunkInfo x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ChunkInfo x -> ChunkInfo
$cfrom :: forall x. ChunkInfo -> Rep ChunkInfo x
Generic)
  deriving anyclass (Context -> ChunkInfo -> IO (Maybe ThunkInfo)
Proxy ChunkInfo -> String
(Context -> ChunkInfo -> IO (Maybe ThunkInfo))
-> (Context -> ChunkInfo -> IO (Maybe ThunkInfo))
-> (Proxy ChunkInfo -> String)
-> NoThunks ChunkInfo
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
showTypeOf :: Proxy ChunkInfo -> String
$cshowTypeOf :: Proxy ChunkInfo -> String
wNoThunks :: Context -> ChunkInfo -> IO (Maybe ThunkInfo)
$cwNoThunks :: Context -> ChunkInfo -> IO (Maybe ThunkInfo)
noThunks :: Context -> ChunkInfo -> IO (Maybe ThunkInfo)
$cnoThunks :: Context -> ChunkInfo -> IO (Maybe ThunkInfo)
NoThunks)

-- | Simple chunk config with a single chunk size
--
-- This intentionally takes 'EpochSize' (number of slots) rather than
-- 'ChunkSize': the translation from 'EpochSize' to 'ChunkSize' (number of
-- available entries in a chunk) should not be done by client code.
simpleChunkInfo :: EpochSize -> ChunkInfo
simpleChunkInfo :: EpochSize -> ChunkInfo
simpleChunkInfo (EpochSize Word64
sz) = ChunkSize -> ChunkInfo
UniformChunkSize (Bool -> Word64 -> ChunkSize
ChunkSize Bool
True Word64
sz)

-- | 'ChunkInfo' for a single 'ChunkSize'
--
-- See also 'simpleChunkInfo'.
singleChunkInfo :: ChunkSize -> ChunkInfo
singleChunkInfo :: ChunkSize -> ChunkInfo
singleChunkInfo = ChunkSize -> ChunkInfo
UniformChunkSize

-- | Can we store EBBs in the chunks described by this 'ChunkInfo'?
--
-- This is only used for tests. This API will need to change (and the tests will
-- become more complicated) once we support non-uniform 'ChunkInfo'.
chunkInfoSupportsEBBs :: ChunkInfo -> Bool
chunkInfoSupportsEBBs :: ChunkInfo -> Bool
chunkInfoSupportsEBBs (UniformChunkSize ChunkSize
chunkSize) =
    ChunkSize -> Bool
chunkCanContainEBB ChunkSize
chunkSize

{-------------------------------------------------------------------------------
  Queries
-------------------------------------------------------------------------------}

-- | Size of a chunk
--
-- The total number of slots available in a chunk is equal to 'numRegularBlocks'
-- if @not@ 'chunkCanContainEBB', and 'numRegularBlocks' @+ 1@ otherwise.
data ChunkSize = ChunkSize {
      -- | Does this chunk also accomodate an EBB?
      ChunkSize -> Bool
chunkCanContainEBB :: !Bool

      -- | The number of regular blocks in this chunk
    , ChunkSize -> Word64
numRegularBlocks   :: !Word64
    }
  deriving stock    (Int -> ChunkSize -> ShowS
[ChunkSize] -> ShowS
ChunkSize -> String
(Int -> ChunkSize -> ShowS)
-> (ChunkSize -> String)
-> ([ChunkSize] -> ShowS)
-> Show ChunkSize
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ChunkSize] -> ShowS
$cshowList :: [ChunkSize] -> ShowS
show :: ChunkSize -> String
$cshow :: ChunkSize -> String
showsPrec :: Int -> ChunkSize -> ShowS
$cshowsPrec :: Int -> ChunkSize -> ShowS
Show, (forall x. ChunkSize -> Rep ChunkSize x)
-> (forall x. Rep ChunkSize x -> ChunkSize) -> Generic ChunkSize
forall x. Rep ChunkSize x -> ChunkSize
forall x. ChunkSize -> Rep ChunkSize x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ChunkSize x -> ChunkSize
$cfrom :: forall x. ChunkSize -> Rep ChunkSize x
Generic)
  deriving anyclass (Context -> ChunkSize -> IO (Maybe ThunkInfo)
Proxy ChunkSize -> String
(Context -> ChunkSize -> IO (Maybe ThunkInfo))
-> (Context -> ChunkSize -> IO (Maybe ThunkInfo))
-> (Proxy ChunkSize -> String)
-> NoThunks ChunkSize
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
showTypeOf :: Proxy ChunkSize -> String
$cshowTypeOf :: Proxy ChunkSize -> String
wNoThunks :: Context -> ChunkSize -> IO (Maybe ThunkInfo)
$cwNoThunks :: Context -> ChunkSize -> IO (Maybe ThunkInfo)
noThunks :: Context -> ChunkSize -> IO (Maybe ThunkInfo)
$cnoThunks :: Context -> ChunkSize -> IO (Maybe ThunkInfo)
NoThunks)

-- | Chunk number
newtype ChunkNo = ChunkNo { ChunkNo -> Word64
unChunkNo :: Word64 }
  deriving stock   (ChunkNo -> ChunkNo -> Bool
(ChunkNo -> ChunkNo -> Bool)
-> (ChunkNo -> ChunkNo -> Bool) -> Eq ChunkNo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ChunkNo -> ChunkNo -> Bool
$c/= :: ChunkNo -> ChunkNo -> Bool
== :: ChunkNo -> ChunkNo -> Bool
$c== :: ChunkNo -> ChunkNo -> Bool
Eq, Eq ChunkNo
Eq ChunkNo
-> (ChunkNo -> ChunkNo -> Ordering)
-> (ChunkNo -> ChunkNo -> Bool)
-> (ChunkNo -> ChunkNo -> Bool)
-> (ChunkNo -> ChunkNo -> Bool)
-> (ChunkNo -> ChunkNo -> Bool)
-> (ChunkNo -> ChunkNo -> ChunkNo)
-> (ChunkNo -> ChunkNo -> ChunkNo)
-> Ord ChunkNo
ChunkNo -> ChunkNo -> Bool
ChunkNo -> ChunkNo -> Ordering
ChunkNo -> ChunkNo -> ChunkNo
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: ChunkNo -> ChunkNo -> ChunkNo
$cmin :: ChunkNo -> ChunkNo -> ChunkNo
max :: ChunkNo -> ChunkNo -> ChunkNo
$cmax :: ChunkNo -> ChunkNo -> ChunkNo
>= :: ChunkNo -> ChunkNo -> Bool
$c>= :: ChunkNo -> ChunkNo -> Bool
> :: ChunkNo -> ChunkNo -> Bool
$c> :: ChunkNo -> ChunkNo -> Bool
<= :: ChunkNo -> ChunkNo -> Bool
$c<= :: ChunkNo -> ChunkNo -> Bool
< :: ChunkNo -> ChunkNo -> Bool
$c< :: ChunkNo -> ChunkNo -> Bool
compare :: ChunkNo -> ChunkNo -> Ordering
$ccompare :: ChunkNo -> ChunkNo -> Ordering
$cp1Ord :: Eq ChunkNo
Ord, (forall x. ChunkNo -> Rep ChunkNo x)
-> (forall x. Rep ChunkNo x -> ChunkNo) -> Generic ChunkNo
forall x. Rep ChunkNo x -> ChunkNo
forall x. ChunkNo -> Rep ChunkNo x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ChunkNo x -> ChunkNo
$cfrom :: forall x. ChunkNo -> Rep ChunkNo x
Generic)
  deriving newtype (Int -> ChunkNo -> ShowS
[ChunkNo] -> ShowS
ChunkNo -> String
(Int -> ChunkNo -> ShowS)
-> (ChunkNo -> String) -> ([ChunkNo] -> ShowS) -> Show ChunkNo
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ChunkNo] -> ShowS
$cshowList :: [ChunkNo] -> ShowS
show :: ChunkNo -> String
$cshow :: ChunkNo -> String
showsPrec :: Int -> ChunkNo -> ShowS
$cshowsPrec :: Int -> ChunkNo -> ShowS
Show, Context -> ChunkNo -> IO (Maybe ThunkInfo)
Proxy ChunkNo -> String
(Context -> ChunkNo -> IO (Maybe ThunkInfo))
-> (Context -> ChunkNo -> IO (Maybe ThunkInfo))
-> (Proxy ChunkNo -> String)
-> NoThunks ChunkNo
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
showTypeOf :: Proxy ChunkNo -> String
$cshowTypeOf :: Proxy ChunkNo -> String
wNoThunks :: Context -> ChunkNo -> IO (Maybe ThunkInfo)
$cwNoThunks :: Context -> ChunkNo -> IO (Maybe ThunkInfo)
noThunks :: Context -> ChunkNo -> IO (Maybe ThunkInfo)
$cnoThunks :: Context -> ChunkNo -> IO (Maybe ThunkInfo)
NoThunks)

-- | First chunk
firstChunkNo :: ChunkNo
firstChunkNo :: ChunkNo
firstChunkNo = Word64 -> ChunkNo
ChunkNo Word64
0

-- | Convert 'ChunkNo' to 'Int'
--
-- This is primarily useful for the immutable DB, which uses an 'IntPSQ'.
chunkNoToInt :: ChunkNo -> Int
chunkNoToInt :: ChunkNo -> Int
chunkNoToInt (ChunkNo Word64
n) = Word64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
n

-- | Convert 'Int' to 'ChunkNo'
--
-- See 'chunkNoToInt' for motivation.
chunkNoFromInt :: Int -> ChunkNo
chunkNoFromInt :: Int -> ChunkNo
chunkNoFromInt Int
n = Word64 -> ChunkNo
ChunkNo (Int -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n)

nextChunkNo :: ChunkNo -> ChunkNo
nextChunkNo :: ChunkNo -> ChunkNo
nextChunkNo (ChunkNo Word64
n) = Word64 -> ChunkNo
ChunkNo (Word64
n Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Word64
1)

prevChunkNo :: ChunkNo -> Maybe ChunkNo
prevChunkNo :: ChunkNo -> Maybe ChunkNo
prevChunkNo (ChunkNo Word64
n) = Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Word64
n Word64 -> Word64 -> Bool
forall a. Ord a => a -> a -> Bool
> Word64
0) Maybe () -> Maybe ChunkNo -> Maybe ChunkNo
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ChunkNo -> Maybe ChunkNo
forall (m :: * -> *) a. Monad m => a -> m a
return (Word64 -> ChunkNo
ChunkNo (Word64 -> ChunkNo) -> Word64 -> ChunkNo
forall a b. (a -> b) -> a -> b
$ Word64
n Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
- Word64
1)

-- | Count number of chunks between two indices
--
-- > countChunks x              x  == 0
-- > countChunks x (nextChunkNo x) == 1
countChunks :: ChunkNo -> ChunkNo -> Word64
countChunks :: ChunkNo -> ChunkNo -> Word64
countChunks (ChunkNo Word64
a) (ChunkNo Word64
b) = if Word64
a Word64 -> Word64 -> Bool
forall a. Ord a => a -> a -> Bool
>= Word64
b then Word64
a Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
- Word64
b else Word64
b Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
- Word64
a

-- | Enumerate all chunks
--
-- > chunksBetween x              x  == [x]
-- > chunksBetween x (nextChunkNo x) == [x, nextChunkNo x]
chunksBetween :: ChunkNo -> ChunkNo -> [ChunkNo]
chunksBetween :: ChunkNo -> ChunkNo -> [ChunkNo]
chunksBetween (ChunkNo Word64
a) (ChunkNo Word64
b) = (Word64 -> ChunkNo) -> [Word64] -> [ChunkNo]
forall a b. (a -> b) -> [a] -> [b]
map Word64 -> ChunkNo
ChunkNo ([Word64] -> [ChunkNo]) -> [Word64] -> [ChunkNo]
forall a b. (a -> b) -> a -> b
$
                                          if Word64
a Word64 -> Word64 -> Bool
forall a. Ord a => a -> a -> Bool
>= Word64
b then [Word64
a .. Word64
b] else [Word64
b .. Word64
a]

-- | Translate 'EpochNo' to 'ChunkNo'
--
-- This should /ONLY/ be used to translate the 'EpochNo' of an EBB, since the
-- invariant says EBBs can only exist in the first period of the DB, where the
-- chunk size must equal the epoch size. See 'ChunkInfo' for details.
unsafeEpochNoToChunkNo :: EpochNo -> ChunkNo
unsafeEpochNoToChunkNo :: EpochNo -> ChunkNo
unsafeEpochNoToChunkNo (EpochNo Word64
n) = Word64 -> ChunkNo
ChunkNo Word64
n

-- | Translate 'ChunkNo' to 'EpochNo'
--
-- This should /ONLY/ be used for chunks that contain EBBs.
-- See 'unsafeEpochNoToChunkNo' and 'ChunkInfo' for details.
unsafeChunkNoToEpochNo :: ChunkNo -> EpochNo
unsafeChunkNoToEpochNo :: ChunkNo -> EpochNo
unsafeChunkNoToEpochNo (ChunkNo Word64
n) = Word64 -> EpochNo
EpochNo Word64
n

getChunkSize :: ChunkInfo -> ChunkNo -> ChunkSize
getChunkSize :: ChunkInfo -> ChunkNo -> ChunkSize
getChunkSize ChunkInfo
chunkInfo ChunkNo
_chunk =
    case ChunkInfo
chunkInfo of
      UniformChunkSize ChunkSize
sz -> ChunkSize
sz

{-------------------------------------------------------------------------------
  Layout

  These are defined in the @Internal@ module so that most code can safely
  import from "Ouroboros.Consensus.Storage.ImmutableDB.Chunks.Layout" without
  worrying that it's making assumptions that it shouldn't. All bets are off for
  modules that import "Ouroboros.Consensus.Storage.ImmutableDB.Chunks.Internal".
-------------------------------------------------------------------------------}

-- | A /relative/ slot within a chunk
data RelativeSlot = RelativeSlot {
    -- | The chunk index of the chunk this slot is in
    --
    -- Recorded primarily to be able to define a semi-sensible 'Ord' instance.
    RelativeSlot -> ChunkNo
relativeSlotChunkNo   :: !ChunkNo

    -- | The size of the chunk that this slot is in
    --
    -- We record this for bounds checking as well as to be able to answer
    -- questions such as 'relativeSlotIsEBB'.
  , RelativeSlot -> ChunkSize
relativeSlotChunkSize :: !ChunkSize

    -- | The index within the chunk
  , RelativeSlot -> Word64
relativeSlotIndex     :: !Word64
  }
  deriving stock    (Int -> RelativeSlot -> ShowS
[RelativeSlot] -> ShowS
RelativeSlot -> String
(Int -> RelativeSlot -> ShowS)
-> (RelativeSlot -> String)
-> ([RelativeSlot] -> ShowS)
-> Show RelativeSlot
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RelativeSlot] -> ShowS
$cshowList :: [RelativeSlot] -> ShowS
show :: RelativeSlot -> String
$cshow :: RelativeSlot -> String
showsPrec :: Int -> RelativeSlot -> ShowS
$cshowsPrec :: Int -> RelativeSlot -> ShowS
Show, (forall x. RelativeSlot -> Rep RelativeSlot x)
-> (forall x. Rep RelativeSlot x -> RelativeSlot)
-> Generic RelativeSlot
forall x. Rep RelativeSlot x -> RelativeSlot
forall x. RelativeSlot -> Rep RelativeSlot x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep RelativeSlot x -> RelativeSlot
$cfrom :: forall x. RelativeSlot -> Rep RelativeSlot x
Generic)
  deriving anyclass (Context -> RelativeSlot -> IO (Maybe ThunkInfo)
Proxy RelativeSlot -> String
(Context -> RelativeSlot -> IO (Maybe ThunkInfo))
-> (Context -> RelativeSlot -> IO (Maybe ThunkInfo))
-> (Proxy RelativeSlot -> String)
-> NoThunks RelativeSlot
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
showTypeOf :: Proxy RelativeSlot -> String
$cshowTypeOf :: Proxy RelativeSlot -> String
wNoThunks :: Context -> RelativeSlot -> IO (Maybe ThunkInfo)
$cwNoThunks :: Context -> RelativeSlot -> IO (Maybe ThunkInfo)
noThunks :: Context -> RelativeSlot -> IO (Maybe ThunkInfo)
$cnoThunks :: Context -> RelativeSlot -> IO (Maybe ThunkInfo)
NoThunks)

-- | Maximum relative index within a chunk
maxRelativeIndex :: ChunkSize -> Word64
maxRelativeIndex :: ChunkSize -> Word64
maxRelativeIndex ChunkSize{Bool
Word64
numRegularBlocks :: Word64
chunkCanContainEBB :: Bool
numRegularBlocks :: ChunkSize -> Word64
chunkCanContainEBB :: ChunkSize -> Bool
..}
  | Bool
chunkCanContainEBB = Word64
numRegularBlocks
  | Bool
otherwise          = Word64
numRegularBlocks Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
- Word64
1

-- | Smart constructor for 'RelativeSlot'
mkRelativeSlot :: HasCallStack => ChunkInfo -> ChunkNo -> Word64 -> RelativeSlot
mkRelativeSlot :: ChunkInfo -> ChunkNo -> Word64 -> RelativeSlot
mkRelativeSlot ChunkInfo
chunkInfo ChunkNo
chunk Word64
index =
    Word64 -> ChunkSize -> RelativeSlot -> RelativeSlot
forall a. HasCallStack => Word64 -> ChunkSize -> a -> a
assertWithinBounds Word64
index ChunkSize
size (RelativeSlot -> RelativeSlot) -> RelativeSlot -> RelativeSlot
forall a b. (a -> b) -> a -> b
$
    RelativeSlot :: ChunkNo -> ChunkSize -> Word64 -> RelativeSlot
RelativeSlot {
        relativeSlotChunkNo :: ChunkNo
relativeSlotChunkNo   = ChunkNo
chunk
      , relativeSlotChunkSize :: ChunkSize
relativeSlotChunkSize = ChunkSize
size
      , relativeSlotIndex :: Word64
relativeSlotIndex     = Word64
index
      }
  where
    size :: ChunkSize
size = ChunkInfo -> ChunkNo -> ChunkSize
getChunkSize ChunkInfo
chunkInfo ChunkNo
chunk

instance Eq RelativeSlot where
  RelativeSlot
a == :: RelativeSlot -> RelativeSlot -> Bool
== RelativeSlot
b
    | RelativeSlot -> ChunkNo
relativeSlotChunkNo RelativeSlot
a ChunkNo -> ChunkNo -> Bool
forall a. Eq a => a -> a -> Bool
/= RelativeSlot -> ChunkNo
relativeSlotChunkNo RelativeSlot
b = Bool
False
    | Bool
otherwise =
        -- If the 'ChunkNo's are the same, then the 'ChunkSize's /must/ also be
        ChunkNo -> ChunkNo -> Bool -> Bool
forall a. HasCallStack => ChunkNo -> ChunkNo -> a -> a
assertSameChunk (RelativeSlot -> ChunkNo
relativeSlotChunkNo RelativeSlot
a) (RelativeSlot -> ChunkNo
relativeSlotChunkNo RelativeSlot
b) (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$
          RelativeSlot -> Word64
relativeSlotIndex RelativeSlot
a Word64 -> Word64 -> Bool
forall a. Eq a => a -> a -> Bool
== RelativeSlot -> Word64
relativeSlotIndex RelativeSlot
b

-- | 'RelativeSlot' is partially ordered, not totally ordered
--
-- It makes no sense to compare 'RelativeSlots' from different chunks. Doing so
-- will result in an assertion failure.
compareRelativeSlot :: HasCallStack => RelativeSlot -> RelativeSlot -> Ordering
compareRelativeSlot :: RelativeSlot -> RelativeSlot -> Ordering
compareRelativeSlot RelativeSlot
a RelativeSlot
b =
    ChunkNo -> ChunkNo -> Ordering -> Ordering
forall a. HasCallStack => ChunkNo -> ChunkNo -> a -> a
assertSameChunk (RelativeSlot -> ChunkNo
relativeSlotChunkNo RelativeSlot
a) (RelativeSlot -> ChunkNo
relativeSlotChunkNo RelativeSlot
b) (Ordering -> Ordering) -> Ordering -> Ordering
forall a b. (a -> b) -> a -> b
$
      Word64 -> Word64 -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (RelativeSlot -> Word64
relativeSlotIndex RelativeSlot
a) (RelativeSlot -> Word64
relativeSlotIndex RelativeSlot
b)

assertRelativeSlotInChunk :: HasCallStack => ChunkNo -> RelativeSlot -> Word64
assertRelativeSlotInChunk :: ChunkNo -> RelativeSlot -> Word64
assertRelativeSlotInChunk ChunkNo
chunk RelativeSlot
relSlot =
    ChunkNo -> ChunkNo -> Word64 -> Word64
forall a. HasCallStack => ChunkNo -> ChunkNo -> a -> a
assertSameChunk (RelativeSlot -> ChunkNo
relativeSlotChunkNo RelativeSlot
relSlot) ChunkNo
chunk (Word64 -> Word64) -> Word64 -> Word64
forall a b. (a -> b) -> a -> b
$
      RelativeSlot -> Word64
relativeSlotIndex RelativeSlot
relSlot

{-------------------------------------------------------------------------------
  Assert failures

  We insist on keeping the HasCallStack constraint here, because if we make
  that constraint depend on CPP, we will get redundant constraint warnings for
  any functions that (transitively) call these functions.
-------------------------------------------------------------------------------}

data ChunkAssertionFailure =
    NotSameChunk ChunkNo ChunkNo PrettyCallStack
  | NotWithinBounds Word64 ChunkSize PrettyCallStack
  | ChunkCannotContainEBBs ChunkNo PrettyCallStack
  deriving (Int -> ChunkAssertionFailure -> ShowS
[ChunkAssertionFailure] -> ShowS
ChunkAssertionFailure -> String
(Int -> ChunkAssertionFailure -> ShowS)
-> (ChunkAssertionFailure -> String)
-> ([ChunkAssertionFailure] -> ShowS)
-> Show ChunkAssertionFailure
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ChunkAssertionFailure] -> ShowS
$cshowList :: [ChunkAssertionFailure] -> ShowS
show :: ChunkAssertionFailure -> String
$cshow :: ChunkAssertionFailure -> String
showsPrec :: Int -> ChunkAssertionFailure -> ShowS
$cshowsPrec :: Int -> ChunkAssertionFailure -> ShowS
Show)

instance Exception ChunkAssertionFailure

assertSameChunk :: HasCallStack => ChunkNo -> ChunkNo -> a -> a
#if ENABLE_ASSERTIONS
assertSameChunk a b
  | a == b    = id
  | otherwise = throw $ NotSameChunk a b prettyCallStack
#else
assertSameChunk :: ChunkNo -> ChunkNo -> a -> a
assertSameChunk ChunkNo
_ ChunkNo
_ = a -> a
forall a. a -> a
id
#endif
  where
    ()
_ = Proxy HasCallStack -> ()
forall (c :: Constraint) (proxy :: Constraint -> *).
c =>
proxy c -> ()
keepRedundantConstraint (Proxy HasCallStack
forall k (t :: k). Proxy t
Proxy @HasCallStack)

assertWithinBounds :: HasCallStack => Word64 -> ChunkSize -> a -> a
#if ENABLE_ASSERTIONS
assertWithinBounds ix sz
  | ix <= maxRelativeIndex sz = id
  | otherwise                 = throw $ NotWithinBounds ix sz prettyCallStack
#else
assertWithinBounds :: Word64 -> ChunkSize -> a -> a
assertWithinBounds Word64
_ ChunkSize
_ = a -> a
forall a. a -> a
id
#endif
  where
    ()
_ = Proxy HasCallStack -> ()
forall (c :: Constraint) (proxy :: Constraint -> *).
c =>
proxy c -> ()
keepRedundantConstraint (Proxy HasCallStack
forall k (t :: k). Proxy t
Proxy @HasCallStack)

assertChunkCanContainEBB :: HasCallStack => ChunkNo -> ChunkSize -> a -> a
#if ENABLE_ASSERTIONS
assertChunkCanContainEBB chunk size
  | chunkCanContainEBB size = id
  | otherwise               = throw $ ChunkCannotContainEBBs chunk prettyCallStack
#else
assertChunkCanContainEBB :: ChunkNo -> ChunkSize -> a -> a
assertChunkCanContainEBB ChunkNo
_ ChunkSize
_ = a -> a
forall a. a -> a
id
#endif
  where
    ()
_ = Proxy HasCallStack -> ()
forall (c :: Constraint) (proxy :: Constraint -> *).
c =>
proxy c -> ()
keepRedundantConstraint (Proxy HasCallStack
forall k (t :: k). Proxy t
Proxy @HasCallStack)