{-# LANGUAGE RecordWildCards #-}

module Test.Util.ChunkInfo (SmallChunkInfo (..)) where

import           Ouroboros.Consensus.Storage.ImmutableDB.Chunks
import           Test.QuickCheck

{-------------------------------------------------------------------------------
  ChunkInfo
-------------------------------------------------------------------------------}

data SmallChunkInfo = SmallChunkInfo ChunkInfo
  deriving (Int -> SmallChunkInfo -> ShowS
[SmallChunkInfo] -> ShowS
SmallChunkInfo -> String
(Int -> SmallChunkInfo -> ShowS)
-> (SmallChunkInfo -> String)
-> ([SmallChunkInfo] -> ShowS)
-> Show SmallChunkInfo
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SmallChunkInfo -> ShowS
showsPrec :: Int -> SmallChunkInfo -> ShowS
$cshow :: SmallChunkInfo -> String
show :: SmallChunkInfo -> String
$cshowList :: [SmallChunkInfo] -> ShowS
showList :: [SmallChunkInfo] -> ShowS
Show)

instance Arbitrary SmallChunkInfo where
  arbitrary :: Gen SmallChunkInfo
arbitrary = do
      numRegularBlocks   <- (Word64, Word64) -> Gen Word64
forall a. Random a => (a, a) -> Gen a
choose (Word64
5, Word64
15)
      chunkCanContainEBB <- arbitrary
      return $ SmallChunkInfo $ singleChunkInfo $ ChunkSize{..}

  -- Intentionally no shrinker, as shrinking the epoch size independent from
  -- the rest of the commands may lead to a non-sensical test