{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE ScopedTypeVariables #-}

{-# OPTIONS_GHC -Wno-name-shadowing #-}

-- | Tests for the chain DB iterator.
--
-- This is a set of unit tests that check for specific bugs discovered during
-- other testing. The more important tests for the iterators is the main model
-- based test of the chain DB (@Test.Ouroboros.Storage.ChainDB.Model.Test@).
--
module Test.Ouroboros.Storage.ChainDB.Iterator (tests) where

import           Control.Monad (forM_)
import           Control.Monad.Except (ExceptT (..), runExceptT)
import           Control.Monad.IOSim (runSimOrThrow)
import           Control.Monad.Trans.Class (lift)
import           Control.ResourceRegistry
import           Control.Tracer
import           Data.List (intercalate)
import qualified Data.Map.Strict as Map
import           Ouroboros.Consensus.Block
import           Ouroboros.Consensus.Storage.ChainDB.API (BlockComponent (..),
                     Iterator (..), IteratorResult (..), StreamFrom (..),
                     StreamTo (..), UnknownRange (..))
import           Ouroboros.Consensus.Storage.ChainDB.Impl.Iterator
                     (IteratorEnv (..), newIterator)
import           Ouroboros.Consensus.Storage.ChainDB.Impl.Types
                     (IteratorKey (..), TraceIteratorEvent (..))
import           Ouroboros.Consensus.Storage.ImmutableDB (ImmutableDB)
import qualified Ouroboros.Consensus.Storage.ImmutableDB as ImmutableDB
import           Ouroboros.Consensus.Storage.VolatileDB (VolatileDB)
import qualified Ouroboros.Consensus.Storage.VolatileDB as VolatileDB
import           Ouroboros.Consensus.Util.Condense (condense)
import           Ouroboros.Consensus.Util.IOLike
import           Ouroboros.Network.Mock.Chain (Chain)
import qualified Ouroboros.Network.Mock.Chain as Chain
import qualified Test.Ouroboros.Storage.ImmutableDB.Mock as ImmutableDB
                     (openDBMock)
import           Test.Ouroboros.Storage.TestBlock
import qualified Test.Ouroboros.Storage.VolatileDB.Mock as VolatileDB
                     (openDBMock)
import           Test.Tasty
import           Test.Tasty.QuickCheck
import           Test.Util.Orphans.IOLike ()
import           Test.Util.Tracer (recordingTracerTVar)

{-------------------------------------------------------------------------------
  Top-level tests
-------------------------------------------------------------------------------}

tests :: TestTree
tests :: TestTree
tests = String -> [TestTree] -> TestTree
testGroup String
"Iterator"
    [ String -> Property -> TestTree
forall a. Testable a => String -> a -> TestTree
testProperty String
"#773 bug in example 1"  Property
prop_773_bug
    , String -> Property -> TestTree
forall a. Testable a => String -> a -> TestTree
testProperty String
"#773 correct example 2" Property
prop_773_working
    , String -> Property -> TestTree
forall a. Testable a => String -> a -> TestTree
testProperty String
"#1435 case 1" Property
prop_1435_case1
    , String -> Property -> TestTree
forall a. Testable a => String -> a -> TestTree
testProperty String
"#1435 case 2" Property
prop_1435_case2
    , String -> Property -> TestTree
forall a. Testable a => String -> a -> TestTree
testProperty String
"#1435 case 3" Property
prop_1435_case3
    , String -> Property -> TestTree
forall a. Testable a => String -> a -> TestTree
testProperty String
"#1435 case 4" Property
prop_1435_case4
    , String -> Property -> TestTree
forall a. Testable a => String -> a -> TestTree
testProperty String
"#1435 case 5" Property
prop_1435_case5
    , String -> Property -> TestTree
forall a. Testable a => String -> a -> TestTree
testProperty String
"#1435 case 6" Property
prop_1435_case6
    ]

-- These tests focus on the implementation of the ChainDB iterators, which are
-- used to stream blocks from the ChainDB. A few things make this code
-- complex:
--
-- * We need to be able to stream from both the ImmutableDB and the
--   VolatileDB.
-- * While streaming, blocks might be copied from the VolatileDB to the
--   ImmutableDB.
-- * While streaming, blocks might be garbage-collected from the VolatileDB.
--   These blocks might have been copied to the ImmutableDB or not.
--
-- The copying and garbage collection will happen in the background,
-- /concurrently/ with the streaming, so we have to be careful about race
-- conditions. For these reasons, we provide separate tests for the ChainDb
-- iterators.
--
-- To avoid the complexity of a whole ChainDB and to have explicit control of
-- the copying and garbage collection, we set up a mock 'IteratorEnv' record
-- containing (amongst others) a mock ImmutableDB and a mock VolatileDB that
-- can be manipulated directly, instead of relying on the background threads
-- to manipulate them for us.

-- TODO (#766):
-- - Write a generator for TestSetup and a model implementation (reuse
--   ChainDB.Model) to turn this into a property test.
-- - Instead of simply reading all blocks, use:
--   > data Action = IterNext .. | CopyToImmutableDB .. | GCFromVolatileDB ..
--   And write a generator for it.
-- - Run multiple @Action@s in parallel

{-------------------------------------------------------------------------------
  Test cases
-------------------------------------------------------------------------------}

-- All blocks on the same chain
a, b, c, d, e :: TestBlock
a :: TestBlock
a = SlotNo -> TestBody -> TestBlock
firstBlock    SlotNo
0 TestBody { tbForkNo :: Word
tbForkNo = Word
0, tbIsValid :: Bool
tbIsValid = Bool
True }
b :: TestBlock
b = TestBlock -> SlotNo -> TestBody -> TestBlock
mkNextBlock TestBlock
a SlotNo
1 TestBody { tbForkNo :: Word
tbForkNo = Word
0, tbIsValid :: Bool
tbIsValid = Bool
True }
c :: TestBlock
c = TestBlock -> SlotNo -> TestBody -> TestBlock
mkNextBlock TestBlock
b SlotNo
2 TestBody { tbForkNo :: Word
tbForkNo = Word
0, tbIsValid :: Bool
tbIsValid = Bool
True }
d :: TestBlock
d = TestBlock -> SlotNo -> TestBody -> TestBlock
mkNextBlock TestBlock
c SlotNo
3 TestBody { tbForkNo :: Word
tbForkNo = Word
0, tbIsValid :: Bool
tbIsValid = Bool
True }
e :: TestBlock
e = TestBlock -> SlotNo -> TestBody -> TestBlock
mkNextBlock TestBlock
d SlotNo
4 TestBody { tbForkNo :: Word
tbForkNo = Word
0, tbIsValid :: Bool
tbIsValid = Bool
True }

-- | Requested stream = A -> C
--
--           ImmutableDB        VolatileDB
-- Hash    A -> B -> C -> D        C, D
--
-- Bug: we find a partial path [B]->C in the VolatileDB. Now the 'ForkTooOld'
-- condition is triggered because the tip of the ImmutableDB is not B but D.
--
-- For more details, see:
-- https://github.com/IntersectMBO/ouroboros-network/pull/773#issuecomment-513128004
prop_773_bug :: Property
prop_773_bug :: Property
prop_773_bug = TestSetup
-> StreamFrom TestBlock
-> StreamTo TestBlock
-> IterRes
-> Property
prop_general_test
    TestSetup
      { immutable :: Chain TestBlock
immutable = [TestBlock] -> Chain TestBlock
forall block. HasHeader block => [block] -> Chain block
Chain.fromOldestFirst [TestBlock
a, TestBlock
b, TestBlock
c, TestBlock
d]
      , volatile :: [TestBlock]
volatile  = [TestBlock
c, TestBlock
d]
      }
    (RealPoint TestBlock -> StreamFrom TestBlock
forall blk. RealPoint blk -> StreamFrom blk
StreamFromInclusive (TestBlock -> RealPoint TestBlock
forall blk. HasHeader blk => blk -> RealPoint blk
blockRealPoint TestBlock
a))
    (RealPoint TestBlock -> StreamTo TestBlock
forall blk. RealPoint blk -> StreamTo blk
StreamToInclusive   (TestBlock -> RealPoint TestBlock
forall blk. HasHeader blk => blk -> RealPoint blk
blockRealPoint TestBlock
c))
    ([Either (RealPoint TestBlock) TestBlock] -> IterRes
forall a b. b -> Either a b
Right ((TestBlock -> Either (RealPoint TestBlock) TestBlock)
-> [TestBlock] -> [Either (RealPoint TestBlock) TestBlock]
forall a b. (a -> b) -> [a] -> [b]
map TestBlock -> Either (RealPoint TestBlock) TestBlock
forall a b. b -> Either a b
Right [TestBlock
a, TestBlock
b, TestBlock
c]))

-- | Requested stream = A -> E
--
--           ImmutableDB           VolatileDB
-- Hash    A -> B -> C -> D        C   D   E
--
-- This was/is handled correctly in @streamFromBoth@.
prop_773_working :: Property
prop_773_working :: Property
prop_773_working = TestSetup
-> StreamFrom TestBlock
-> StreamTo TestBlock
-> IterRes
-> Property
prop_general_test
    TestSetup
      { immutable :: Chain TestBlock
immutable = [TestBlock] -> Chain TestBlock
forall block. HasHeader block => [block] -> Chain block
Chain.fromOldestFirst [TestBlock
a, TestBlock
b, TestBlock
c, TestBlock
d]
      , volatile :: [TestBlock]
volatile  = [TestBlock
c, TestBlock
d, TestBlock
e]
      }
    (RealPoint TestBlock -> StreamFrom TestBlock
forall blk. RealPoint blk -> StreamFrom blk
StreamFromInclusive (TestBlock -> RealPoint TestBlock
forall blk. HasHeader blk => blk -> RealPoint blk
blockRealPoint TestBlock
a))
    (RealPoint TestBlock -> StreamTo TestBlock
forall blk. RealPoint blk -> StreamTo blk
StreamToInclusive   (TestBlock -> RealPoint TestBlock
forall blk. HasHeader blk => blk -> RealPoint blk
blockRealPoint TestBlock
e))
    ([Either (RealPoint TestBlock) TestBlock] -> IterRes
forall a b. b -> Either a b
Right ((TestBlock -> Either (RealPoint TestBlock) TestBlock)
-> [TestBlock] -> [Either (RealPoint TestBlock) TestBlock]
forall a b. (a -> b) -> [a] -> [b]
map TestBlock -> Either (RealPoint TestBlock) TestBlock
forall a b. b -> Either a b
Right [TestBlock
a, TestBlock
b, TestBlock
c, TestBlock
d, TestBlock
e]))

-- | Requested stream = B' -> B' where EBB, B, and B' are all blocks in the
-- same slot, and B' is not part of the current chain nor ChainDB.
--
--      ImmutableDB      VolatileDB
-- Hash  EBB -> B
--
prop_1435_case1 :: Property
prop_1435_case1 :: Property
prop_1435_case1 = TestSetup
-> StreamFrom TestBlock
-> StreamTo TestBlock
-> IterRes
-> Property
prop_general_test
    TestSetup
      { immutable :: Chain TestBlock
immutable = [TestBlock] -> Chain TestBlock
forall block. HasHeader block => [block] -> Chain block
Chain.fromOldestFirst [TestBlock
ebb, TestBlock
b]
      , volatile :: [TestBlock]
volatile  = []
      }
    (RealPoint TestBlock -> StreamFrom TestBlock
forall blk. RealPoint blk -> StreamFrom blk
StreamFromInclusive (TestBlock -> RealPoint TestBlock
forall blk. HasHeader blk => blk -> RealPoint blk
blockRealPoint TestBlock
b'))
    (RealPoint TestBlock -> StreamTo TestBlock
forall blk. RealPoint blk -> StreamTo blk
StreamToInclusive   (TestBlock -> RealPoint TestBlock
forall blk. HasHeader blk => blk -> RealPoint blk
blockRealPoint TestBlock
b'))
    (UnknownRange TestBlock -> IterRes
forall a b. a -> Either a b
Left (StreamFrom TestBlock -> UnknownRange TestBlock
forall blk. StreamFrom blk -> UnknownRange blk
ForkTooOld (RealPoint TestBlock -> StreamFrom TestBlock
forall blk. RealPoint blk -> StreamFrom blk
StreamFromInclusive (TestBlock -> RealPoint TestBlock
forall blk. HasHeader blk => blk -> RealPoint blk
blockRealPoint TestBlock
b'))))
  where
    canContainEBB :: b -> Bool
canContainEBB = Bool -> b -> Bool
forall a b. a -> b -> a
const Bool
True
    ebb :: TestBlock
ebb = (SlotNo -> Bool) -> TestBody -> TestBlock
firstEBB    SlotNo -> Bool
forall {b}. b -> Bool
canContainEBB       TestBody { tbForkNo :: Word
tbForkNo = Word
0, tbIsValid :: Bool
tbIsValid = Bool
True }
    b :: TestBlock
b   = TestBlock -> SlotNo -> TestBody -> TestBlock
mkNextBlock               TestBlock
ebb SlotNo
0 TestBody { tbForkNo :: Word
tbForkNo = Word
0, tbIsValid :: Bool
tbIsValid = Bool
True }
    b' :: TestBlock
b'  = TestBlock -> SlotNo -> TestBody -> TestBlock
mkNextBlock               TestBlock
ebb SlotNo
0 TestBody { tbForkNo :: Word
tbForkNo = Word
1, tbIsValid :: Bool
tbIsValid = Bool
True }

-- | Requested stream = EBB' -> EBB' where EBB, B, and EBB' are all blocks in
-- the same slot, and EBB' is not part of the current chain nor ChainDB.
--
--      ImmutableDB      VolatileDB
-- Hash  EBB -> B
--
prop_1435_case2 :: Property
prop_1435_case2 :: Property
prop_1435_case2 = TestSetup
-> StreamFrom TestBlock
-> StreamTo TestBlock
-> IterRes
-> Property
prop_general_test
    TestSetup
      { immutable :: Chain TestBlock
immutable = [TestBlock] -> Chain TestBlock
forall block. HasHeader block => [block] -> Chain block
Chain.fromOldestFirst [TestBlock
ebb, TestBlock
b]
      , volatile :: [TestBlock]
volatile  = []
      }
    (RealPoint TestBlock -> StreamFrom TestBlock
forall blk. RealPoint blk -> StreamFrom blk
StreamFromInclusive (TestBlock -> RealPoint TestBlock
forall blk. HasHeader blk => blk -> RealPoint blk
blockRealPoint TestBlock
ebb'))
    (RealPoint TestBlock -> StreamTo TestBlock
forall blk. RealPoint blk -> StreamTo blk
StreamToInclusive   (TestBlock -> RealPoint TestBlock
forall blk. HasHeader blk => blk -> RealPoint blk
blockRealPoint TestBlock
ebb'))
    (UnknownRange TestBlock -> IterRes
forall a b. a -> Either a b
Left (StreamFrom TestBlock -> UnknownRange TestBlock
forall blk. StreamFrom blk -> UnknownRange blk
ForkTooOld (RealPoint TestBlock -> StreamFrom TestBlock
forall blk. RealPoint blk -> StreamFrom blk
StreamFromInclusive (TestBlock -> RealPoint TestBlock
forall blk. HasHeader blk => blk -> RealPoint blk
blockRealPoint TestBlock
ebb'))))
  where
    canContainEBB :: b -> Bool
canContainEBB = Bool -> b -> Bool
forall a b. a -> b -> a
const Bool
True
    ebb :: TestBlock
ebb  = (SlotNo -> Bool) -> TestBody -> TestBlock
firstEBB    SlotNo -> Bool
forall {b}. b -> Bool
canContainEBB       TestBody { tbForkNo :: Word
tbForkNo = Word
0, tbIsValid :: Bool
tbIsValid = Bool
True }
    b :: TestBlock
b    = TestBlock -> SlotNo -> TestBody -> TestBlock
mkNextBlock               TestBlock
ebb SlotNo
0 TestBody { tbForkNo :: Word
tbForkNo = Word
0, tbIsValid :: Bool
tbIsValid = Bool
True }
    ebb' :: TestBlock
ebb' = (SlotNo -> Bool) -> TestBody -> TestBlock
firstEBB    SlotNo -> Bool
forall {b}. b -> Bool
canContainEBB       TestBody { tbForkNo :: Word
tbForkNo = Word
1, tbIsValid :: Bool
tbIsValid = Bool
True }

-- | Requested stream = EBB -> EBB where EBB and B are all blocks in the same
-- slot.
--
--      ImmutableDB      VolatileDB
-- Hash  EBB -> B
--
prop_1435_case3 :: Property
prop_1435_case3 :: Property
prop_1435_case3 = TestSetup
-> StreamFrom TestBlock
-> StreamTo TestBlock
-> IterRes
-> Property
prop_general_test
    TestSetup
      { immutable :: Chain TestBlock
immutable = [TestBlock] -> Chain TestBlock
forall block. HasHeader block => [block] -> Chain block
Chain.fromOldestFirst [TestBlock
ebb, TestBlock
b]
      , volatile :: [TestBlock]
volatile  = []
      }
    (RealPoint TestBlock -> StreamFrom TestBlock
forall blk. RealPoint blk -> StreamFrom blk
StreamFromInclusive (TestBlock -> RealPoint TestBlock
forall blk. HasHeader blk => blk -> RealPoint blk
blockRealPoint TestBlock
ebb))
    (RealPoint TestBlock -> StreamTo TestBlock
forall blk. RealPoint blk -> StreamTo blk
StreamToInclusive   (TestBlock -> RealPoint TestBlock
forall blk. HasHeader blk => blk -> RealPoint blk
blockRealPoint TestBlock
ebb))
    ([Either (RealPoint TestBlock) TestBlock] -> IterRes
forall a b. b -> Either a b
Right ((TestBlock -> Either (RealPoint TestBlock) TestBlock)
-> [TestBlock] -> [Either (RealPoint TestBlock) TestBlock]
forall a b. (a -> b) -> [a] -> [b]
map TestBlock -> Either (RealPoint TestBlock) TestBlock
forall a b. b -> Either a b
Right [TestBlock
ebb]))
  where
    canContainEBB :: b -> Bool
canContainEBB = Bool -> b -> Bool
forall a b. a -> b -> a
const Bool
True
    ebb :: TestBlock
ebb  = (SlotNo -> Bool) -> TestBody -> TestBlock
firstEBB    SlotNo -> Bool
forall {b}. b -> Bool
canContainEBB       TestBody { tbForkNo :: Word
tbForkNo = Word
0, tbIsValid :: Bool
tbIsValid = Bool
True }
    b :: TestBlock
b    = TestBlock -> SlotNo -> TestBody -> TestBlock
mkNextBlock               TestBlock
ebb SlotNo
0 TestBody { tbForkNo :: Word
tbForkNo = Word
0, tbIsValid :: Bool
tbIsValid = Bool
True }

-- | Requested stream = EBB -> EBB where EBB and B are all blocks in the same
-- slot.
--
--       ImmutableDB      VolatileDB
-- Hash     EBB               B
--
prop_1435_case4 :: Property
prop_1435_case4 :: Property
prop_1435_case4 = TestSetup
-> StreamFrom TestBlock
-> StreamTo TestBlock
-> IterRes
-> Property
prop_general_test
    TestSetup
      { immutable :: Chain TestBlock
immutable = [TestBlock] -> Chain TestBlock
forall block. HasHeader block => [block] -> Chain block
Chain.fromOldestFirst [TestBlock
ebb]
      , volatile :: [TestBlock]
volatile  = [TestBlock
b]
      }
    (RealPoint TestBlock -> StreamFrom TestBlock
forall blk. RealPoint blk -> StreamFrom blk
StreamFromInclusive (TestBlock -> RealPoint TestBlock
forall blk. HasHeader blk => blk -> RealPoint blk
blockRealPoint TestBlock
ebb))
    (RealPoint TestBlock -> StreamTo TestBlock
forall blk. RealPoint blk -> StreamTo blk
StreamToInclusive   (TestBlock -> RealPoint TestBlock
forall blk. HasHeader blk => blk -> RealPoint blk
blockRealPoint TestBlock
ebb))
    ([Either (RealPoint TestBlock) TestBlock] -> IterRes
forall a b. b -> Either a b
Right ((TestBlock -> Either (RealPoint TestBlock) TestBlock)
-> [TestBlock] -> [Either (RealPoint TestBlock) TestBlock]
forall a b. (a -> b) -> [a] -> [b]
map TestBlock -> Either (RealPoint TestBlock) TestBlock
forall a b. b -> Either a b
Right [TestBlock
ebb]))
  where
    canContainEBB :: b -> Bool
canContainEBB = Bool -> b -> Bool
forall a b. a -> b -> a
const Bool
True
    ebb :: TestBlock
ebb  = (SlotNo -> Bool) -> TestBody -> TestBlock
firstEBB    SlotNo -> Bool
forall {b}. b -> Bool
canContainEBB       TestBody { tbForkNo :: Word
tbForkNo = Word
0, tbIsValid :: Bool
tbIsValid = Bool
True }
    b :: TestBlock
b    = TestBlock -> SlotNo -> TestBody -> TestBlock
mkNextBlock               TestBlock
ebb SlotNo
0 TestBody { tbForkNo :: Word
tbForkNo = Word
0, tbIsValid :: Bool
tbIsValid = Bool
True }

-- | Requested stream = EBB -> EBB where EBB and B' are all blocks in the same
-- slot, and B' is not part of the current chain nor ChainDB.
--
--       ImmutableDB      VolatileDB
-- Hash     EBB
--
prop_1435_case5 :: Property
prop_1435_case5 :: Property
prop_1435_case5 = TestSetup
-> StreamFrom TestBlock
-> StreamTo TestBlock
-> IterRes
-> Property
prop_general_test
    TestSetup
      { immutable :: Chain TestBlock
immutable = [TestBlock] -> Chain TestBlock
forall block. HasHeader block => [block] -> Chain block
Chain.fromOldestFirst [TestBlock
ebb]
      , volatile :: [TestBlock]
volatile  = []
      }
    (RealPoint TestBlock -> StreamFrom TestBlock
forall blk. RealPoint blk -> StreamFrom blk
StreamFromInclusive (TestBlock -> RealPoint TestBlock
forall blk. HasHeader blk => blk -> RealPoint blk
blockRealPoint TestBlock
b'))
    (RealPoint TestBlock -> StreamTo TestBlock
forall blk. RealPoint blk -> StreamTo blk
StreamToInclusive   (TestBlock -> RealPoint TestBlock
forall blk. HasHeader blk => blk -> RealPoint blk
blockRealPoint TestBlock
b'))
    (UnknownRange TestBlock -> IterRes
forall a b. a -> Either a b
Left (StreamFrom TestBlock -> UnknownRange TestBlock
forall blk. StreamFrom blk -> UnknownRange blk
ForkTooOld (RealPoint TestBlock -> StreamFrom TestBlock
forall blk. RealPoint blk -> StreamFrom blk
StreamFromInclusive (TestBlock -> RealPoint TestBlock
forall blk. HasHeader blk => blk -> RealPoint blk
blockRealPoint TestBlock
b'))))
  where
    canContainEBB :: b -> Bool
canContainEBB = Bool -> b -> Bool
forall a b. a -> b -> a
const Bool
True
    ebb :: TestBlock
ebb  = (SlotNo -> Bool) -> TestBody -> TestBlock
firstEBB    SlotNo -> Bool
forall {b}. b -> Bool
canContainEBB       TestBody { tbForkNo :: Word
tbForkNo = Word
0, tbIsValid :: Bool
tbIsValid = Bool
True }
    b' :: TestBlock
b'   = TestBlock -> SlotNo -> TestBody -> TestBlock
mkNextBlock               TestBlock
ebb SlotNo
0 TestBody { tbForkNo :: Word
tbForkNo = Word
1, tbIsValid :: Bool
tbIsValid = Bool
True }

-- | Requested stream = EBB' -> EBB' where EBB and EBB' are all blocks in the
-- same slot, and EBB' is not part of the current chain nor ChainDB.
--
--       ImmutableDB      VolatileDB
-- Hash     EBB
--
prop_1435_case6 :: Property
prop_1435_case6 :: Property
prop_1435_case6 = TestSetup
-> StreamFrom TestBlock
-> StreamTo TestBlock
-> IterRes
-> Property
prop_general_test
    TestSetup
      { immutable :: Chain TestBlock
immutable = [TestBlock] -> Chain TestBlock
forall block. HasHeader block => [block] -> Chain block
Chain.fromOldestFirst [TestBlock
ebb]
      , volatile :: [TestBlock]
volatile  = []
      }
    (RealPoint TestBlock -> StreamFrom TestBlock
forall blk. RealPoint blk -> StreamFrom blk
StreamFromInclusive (TestBlock -> RealPoint TestBlock
forall blk. HasHeader blk => blk -> RealPoint blk
blockRealPoint TestBlock
ebb'))
    (RealPoint TestBlock -> StreamTo TestBlock
forall blk. RealPoint blk -> StreamTo blk
StreamToInclusive   (TestBlock -> RealPoint TestBlock
forall blk. HasHeader blk => blk -> RealPoint blk
blockRealPoint TestBlock
ebb'))
    (UnknownRange TestBlock -> IterRes
forall a b. a -> Either a b
Left (StreamFrom TestBlock -> UnknownRange TestBlock
forall blk. StreamFrom blk -> UnknownRange blk
ForkTooOld (RealPoint TestBlock -> StreamFrom TestBlock
forall blk. RealPoint blk -> StreamFrom blk
StreamFromInclusive (TestBlock -> RealPoint TestBlock
forall blk. HasHeader blk => blk -> RealPoint blk
blockRealPoint TestBlock
ebb'))))
  where
    canContainEBB :: b -> Bool
canContainEBB = Bool -> b -> Bool
forall a b. a -> b -> a
const Bool
True
    ebb :: TestBlock
ebb  = (SlotNo -> Bool) -> TestBody -> TestBlock
firstEBB SlotNo -> Bool
forall {b}. b -> Bool
canContainEBB TestBody { tbForkNo :: Word
tbForkNo = Word
0, tbIsValid :: Bool
tbIsValid = Bool
True }
    ebb' :: TestBlock
ebb' = (SlotNo -> Bool) -> TestBody -> TestBlock
firstEBB SlotNo -> Bool
forall {b}. b -> Bool
canContainEBB TestBody { tbForkNo :: Word
tbForkNo = Word
1, tbIsValid :: Bool
tbIsValid = Bool
True }

-- | The general property test
prop_general_test
  :: TestSetup
  -> StreamFrom TestBlock
  -> StreamTo   TestBlock
  -> IterRes
  -> Property
prop_general_test :: TestSetup
-> StreamFrom TestBlock
-> StreamTo TestBlock
-> IterRes
-> Property
prop_general_test TestSetup
setup StreamFrom TestBlock
from StreamTo TestBlock
to IterRes
expected =
    String -> Property -> Property
forall prop. Testable prop => String -> prop -> Property
counterexample (TestSetup -> String
testSetupInfo TestSetup
setup) (Property -> Property) -> Property -> Property
forall a b. (a -> b) -> a -> b
$
    case (IterRes
actual, IterRes
expected) of
      (Left UnknownRange TestBlock
actualErr, Left UnknownRange TestBlock
expectedErr)         -> UnknownRange TestBlock
actualErr UnknownRange TestBlock -> UnknownRange TestBlock -> Property
forall a. (Eq a, Show a) => a -> a -> Property
=== UnknownRange TestBlock
expectedErr
      (Left UnknownRange TestBlock
actualErr, Right [Either (RealPoint TestBlock) TestBlock]
expectedStream)     -> String -> Property
failure (String -> Property) -> String -> Property
forall a b. (a -> b) -> a -> b
$
        String
"Got " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> UnknownRange TestBlock -> String
forall a. Show a => a -> String
show UnknownRange TestBlock
actualErr String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"\nbut expected " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> [Either (RealPoint TestBlock) TestBlock] -> String
ppStream [Either (RealPoint TestBlock) TestBlock]
expectedStream
      (Right [Either (RealPoint TestBlock) TestBlock]
actualStream, Left UnknownRange TestBlock
expectedErr)     -> String -> Property
failure (String -> Property) -> String -> Property
forall a b. (a -> b) -> a -> b
$
        String
"Got " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> [Either (RealPoint TestBlock) TestBlock] -> String
ppStream [Either (RealPoint TestBlock) TestBlock]
actualStream String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"\nbut expected " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> UnknownRange TestBlock -> String
forall a. Show a => a -> String
show UnknownRange TestBlock
expectedErr
      (Right [Either (RealPoint TestBlock) TestBlock]
actualStream, Right [Either (RealPoint TestBlock) TestBlock]
expectedStream)
        | [Either (RealPoint TestBlock) TestBlock]
actualStream [Either (RealPoint TestBlock) TestBlock]
-> [Either (RealPoint TestBlock) TestBlock] -> Bool
forall a. Eq a => a -> a -> Bool
== [Either (RealPoint TestBlock) TestBlock]
expectedStream
        -> Bool -> Property
forall prop. Testable prop => prop -> Property
property Bool
True
        | Bool
otherwise
        -> String -> Property
failure (String -> Property) -> String -> Property
forall a b. (a -> b) -> a -> b
$ String
"Got " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> [Either (RealPoint TestBlock) TestBlock] -> String
ppStream [Either (RealPoint TestBlock) TestBlock]
actualStream String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"\nbut expected " String -> String -> String
forall a. Semigroup a => a -> a -> a
<>
            [Either (RealPoint TestBlock) TestBlock] -> String
ppStream [Either (RealPoint TestBlock) TestBlock]
expectedStream
  where
    ([TraceIteratorEvent TestBlock]
_trace, IterRes
actual) = TestSetup
-> StreamFrom TestBlock
-> StreamTo TestBlock
-> ([TraceIteratorEvent TestBlock], IterRes)
runIterator TestSetup
setup StreamFrom TestBlock
from StreamTo TestBlock
to
    failure :: String -> Property
failure String
msg = String -> Bool -> Property
forall prop. Testable prop => String -> prop -> Property
counterexample String
msg Bool
False

    ppStream :: [Either (RealPoint TestBlock) TestBlock] -> String
    ppStream :: [Either (RealPoint TestBlock) TestBlock] -> String
ppStream = String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
" :> " ([String] -> String)
-> ([Either (RealPoint TestBlock) TestBlock] -> [String])
-> [Either (RealPoint TestBlock) TestBlock]
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Either (RealPoint TestBlock) TestBlock -> String)
-> [Either (RealPoint TestBlock) TestBlock] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Either (RealPoint TestBlock) TestBlock -> String
ppGCedOrBlock

{-------------------------------------------------------------------------------
  Test setup
-------------------------------------------------------------------------------}

-- | The initial contents of the ImmutableDB and the VolatileDB.
--
-- Note that the iterator implementation does not rely on the current
-- in-memory chain.
data TestSetup = TestSetup
  { TestSetup -> Chain TestBlock
immutable :: Chain TestBlock
  , TestSetup -> [TestBlock]
volatile  :: [TestBlock]
  }

-- | Human-friendly string description of the 'TestSetup' that can be used
-- when printing a failing test.
testSetupInfo :: TestSetup -> String
testSetupInfo :: TestSetup -> String
testSetupInfo TestSetup { Chain TestBlock
immutable :: TestSetup -> Chain TestBlock
immutable :: Chain TestBlock
immutable, [TestBlock]
volatile :: TestSetup -> [TestBlock]
volatile :: [TestBlock]
volatile } = [String] -> String
forall a. Monoid a => [a] -> a
mconcat
    [ String
"Immutable: "
    , String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
" :> " ((TestBlock -> String) -> [TestBlock] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map TestBlock -> String
ppBlock (Chain TestBlock -> [TestBlock]
forall block. Chain block -> [block]
Chain.toOldestFirst Chain TestBlock
immutable))
    , String
"\n"
    , String
"Volatile:  "
    , String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
", " ((TestBlock -> String) -> [TestBlock] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map TestBlock -> String
ppBlock [TestBlock]
volatile)
    ]

ppGCedOrBlock :: Either (RealPoint TestBlock) TestBlock -> String
ppGCedOrBlock :: Either (RealPoint TestBlock) TestBlock -> String
ppGCedOrBlock (Left  RealPoint TestBlock
gcedPt) = String
"GCed: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> RealPoint TestBlock -> String
forall a. Condense a => a -> String
condense RealPoint TestBlock
gcedPt
ppGCedOrBlock (Right TestBlock
blk)    = TestBlock -> String
ppBlock TestBlock
blk

ppBlock :: TestBlock -> String
ppBlock :: TestBlock -> String
ppBlock = TestBlock -> String
forall a. Condense a => a -> String
condense

{-------------------------------------------------------------------------------
  Running an iterator test
-------------------------------------------------------------------------------}

type IterRes = Either (UnknownRange TestBlock)
                      [Either (RealPoint TestBlock) TestBlock]
                      -- Left:  point of garbage collected block
                      -- Right: regular block

-- | Open an iterator with the given bounds on the given 'TestSetup'. Return a
-- trace of the 'TraceIteratorEvent's produced and the result of the iterator
-- itself.
runIterator ::
     TestSetup
  -> StreamFrom TestBlock
  -> StreamTo   TestBlock
  -> ([TraceIteratorEvent TestBlock], IterRes)
runIterator :: TestSetup
-> StreamFrom TestBlock
-> StreamTo TestBlock
-> ([TraceIteratorEvent TestBlock], IterRes)
runIterator TestSetup
setup StreamFrom TestBlock
from StreamTo TestBlock
to = (forall s. IOSim s ([TraceIteratorEvent TestBlock], IterRes))
-> ([TraceIteratorEvent TestBlock], IterRes)
forall a. (forall s. IOSim s a) -> a
runSimOrThrow ((forall s. IOSim s ([TraceIteratorEvent TestBlock], IterRes))
 -> ([TraceIteratorEvent TestBlock], IterRes))
-> (forall s. IOSim s ([TraceIteratorEvent TestBlock], IterRes))
-> ([TraceIteratorEvent TestBlock], IterRes)
forall a b. (a -> b) -> a -> b
$ (ResourceRegistry (IOSim s)
 -> IOSim s ([TraceIteratorEvent TestBlock], IterRes))
-> IOSim s ([TraceIteratorEvent TestBlock], IterRes)
forall (m :: * -> *) a.
(MonadSTM m, MonadMask m, MonadThread m, HasCallStack) =>
(ResourceRegistry m -> m a) -> m a
withRegistry ((ResourceRegistry (IOSim s)
  -> IOSim s ([TraceIteratorEvent TestBlock], IterRes))
 -> IOSim s ([TraceIteratorEvent TestBlock], IterRes))
-> (ResourceRegistry (IOSim s)
    -> IOSim s ([TraceIteratorEvent TestBlock], IterRes))
-> IOSim s ([TraceIteratorEvent TestBlock], IterRes)
forall a b. (a -> b) -> a -> b
$ \ResourceRegistry (IOSim s)
r -> do
    (Tracer (IOSim s) (TraceIteratorEvent TestBlock)
tracer, IOSim s [TraceIteratorEvent TestBlock]
getTrace) <- IOSim
  s
  (Tracer (IOSim s) (TraceIteratorEvent TestBlock),
   IOSim s [TraceIteratorEvent TestBlock])
forall (m :: * -> *) ev. MonadSTM m => m (Tracer m ev, m [ev])
recordingTracerTVar
    IteratorEnv (IOSim s) TestBlock
itEnv <- TestSetup
-> Tracer (IOSim s) (TraceIteratorEvent TestBlock)
-> IOSim s (IteratorEnv (IOSim s) TestBlock)
forall (m :: * -> *).
IOLike m =>
TestSetup
-> Tracer m (TraceIteratorEvent TestBlock)
-> m (IteratorEnv m TestBlock)
initIteratorEnv TestSetup
setup Tracer (IOSim s) (TraceIteratorEvent TestBlock)
tracer
    IterRes
res <- ExceptT
  (UnknownRange TestBlock)
  (IOSim s)
  [Either (RealPoint TestBlock) TestBlock]
-> IOSim s IterRes
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT
   (UnknownRange TestBlock)
   (IOSim s)
   [Either (RealPoint TestBlock) TestBlock]
 -> IOSim s IterRes)
-> ExceptT
     (UnknownRange TestBlock)
     (IOSim s)
     [Either (RealPoint TestBlock) TestBlock]
-> IOSim s IterRes
forall a b. (a -> b) -> a -> b
$ do
      Iterator (IOSim s) TestBlock TestBlock
it <- IOSim
  s
  (Either
     (UnknownRange TestBlock) (Iterator (IOSim s) TestBlock TestBlock))
-> ExceptT
     (UnknownRange TestBlock)
     (IOSim s)
     (Iterator (IOSim s) TestBlock TestBlock)
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (IOSim
   s
   (Either
      (UnknownRange TestBlock) (Iterator (IOSim s) TestBlock TestBlock))
 -> ExceptT
      (UnknownRange TestBlock)
      (IOSim s)
      (Iterator (IOSim s) TestBlock TestBlock))
-> IOSim
     s
     (Either
        (UnknownRange TestBlock) (Iterator (IOSim s) TestBlock TestBlock))
-> ExceptT
     (UnknownRange TestBlock)
     (IOSim s)
     (Iterator (IOSim s) TestBlock TestBlock)
forall a b. (a -> b) -> a -> b
$ IteratorEnv (IOSim s) TestBlock
-> (forall r.
    (IteratorEnv (IOSim s) TestBlock -> IOSim s r) -> IOSim s r)
-> ResourceRegistry (IOSim s)
-> BlockComponent TestBlock TestBlock
-> StreamFrom TestBlock
-> StreamTo TestBlock
-> IOSim
     s
     (Either
        (UnknownRange TestBlock) (Iterator (IOSim s) TestBlock TestBlock))
forall (m :: * -> *) blk b.
(IOLike m, HasHeader blk, HasCallStack) =>
IteratorEnv m blk
-> (forall r. (IteratorEnv m blk -> m r) -> m r)
-> ResourceRegistry m
-> BlockComponent blk b
-> StreamFrom blk
-> StreamTo blk
-> m (Either (UnknownRange blk) (Iterator m blk b))
newIterator IteratorEnv (IOSim s) TestBlock
itEnv ((IteratorEnv (IOSim s) TestBlock -> IOSim s r)
-> IteratorEnv (IOSim s) TestBlock -> IOSim s r
forall a b. (a -> b) -> a -> b
$ IteratorEnv (IOSim s) TestBlock
itEnv) ResourceRegistry (IOSim s)
r BlockComponent TestBlock TestBlock
forall blk. BlockComponent blk blk
GetBlock StreamFrom TestBlock
from StreamTo TestBlock
to
      IOSim s [Either (RealPoint TestBlock) TestBlock]
-> ExceptT
     (UnknownRange TestBlock)
     (IOSim s)
     [Either (RealPoint TestBlock) TestBlock]
forall (m :: * -> *) a.
Monad m =>
m a -> ExceptT (UnknownRange TestBlock) m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IOSim s [Either (RealPoint TestBlock) TestBlock]
 -> ExceptT
      (UnknownRange TestBlock)
      (IOSim s)
      [Either (RealPoint TestBlock) TestBlock])
-> IOSim s [Either (RealPoint TestBlock) TestBlock]
-> ExceptT
     (UnknownRange TestBlock)
     (IOSim s)
     [Either (RealPoint TestBlock) TestBlock]
forall a b. (a -> b) -> a -> b
$ Iterator (IOSim s) TestBlock TestBlock
-> IOSim s [Either (RealPoint TestBlock) TestBlock]
forall (m :: * -> *).
Monad m =>
Iterator m TestBlock TestBlock
-> m [Either (RealPoint TestBlock) TestBlock]
consume Iterator (IOSim s) TestBlock TestBlock
it
    [TraceIteratorEvent TestBlock]
trace <- IOSim s [TraceIteratorEvent TestBlock]
getTrace
    ([TraceIteratorEvent TestBlock], IterRes)
-> IOSim s ([TraceIteratorEvent TestBlock], IterRes)
forall a. a -> IOSim s a
forall (m :: * -> *) a. Monad m => a -> m a
return ([TraceIteratorEvent TestBlock]
trace, IterRes
res)
  where
    consume :: Monad m
            => Iterator m TestBlock TestBlock
            -> m [Either (RealPoint TestBlock) TestBlock]
    consume :: forall (m :: * -> *).
Monad m =>
Iterator m TestBlock TestBlock
-> m [Either (RealPoint TestBlock) TestBlock]
consume Iterator m TestBlock TestBlock
it = Iterator m TestBlock TestBlock
-> m (IteratorResult TestBlock TestBlock)
forall (m :: * -> *) blk b.
Iterator m blk b -> m (IteratorResult blk b)
iteratorNext Iterator m TestBlock TestBlock
it m (IteratorResult TestBlock TestBlock)
-> (IteratorResult TestBlock TestBlock
    -> m [Either (RealPoint TestBlock) TestBlock])
-> m [Either (RealPoint TestBlock) TestBlock]
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      IteratorResult TestBlock
blk -> (TestBlock -> Either (RealPoint TestBlock) TestBlock
forall a b. b -> Either a b
Right TestBlock
blk Either (RealPoint TestBlock) TestBlock
-> [Either (RealPoint TestBlock) TestBlock]
-> [Either (RealPoint TestBlock) TestBlock]
forall a. a -> [a] -> [a]
:) ([Either (RealPoint TestBlock) TestBlock]
 -> [Either (RealPoint TestBlock) TestBlock])
-> m [Either (RealPoint TestBlock) TestBlock]
-> m [Either (RealPoint TestBlock) TestBlock]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Iterator m TestBlock TestBlock
-> m [Either (RealPoint TestBlock) TestBlock]
forall (m :: * -> *).
Monad m =>
Iterator m TestBlock TestBlock
-> m [Either (RealPoint TestBlock) TestBlock]
consume Iterator m TestBlock TestBlock
it
      IteratorBlockGCed RealPoint TestBlock
hash -> do
        Iterator m TestBlock TestBlock -> m ()
forall (m :: * -> *) blk b. Iterator m blk b -> m ()
iteratorClose Iterator m TestBlock TestBlock
it
        [Either (RealPoint TestBlock) TestBlock]
-> m [Either (RealPoint TestBlock) TestBlock]
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return [RealPoint TestBlock -> Either (RealPoint TestBlock) TestBlock
forall a b. a -> Either a b
Left RealPoint TestBlock
hash]
      IteratorResult TestBlock TestBlock
IteratorExhausted -> do
        Iterator m TestBlock TestBlock -> m ()
forall (m :: * -> *) blk b. Iterator m blk b -> m ()
iteratorClose Iterator m TestBlock TestBlock
it
        [Either (RealPoint TestBlock) TestBlock]
-> m [Either (RealPoint TestBlock) TestBlock]
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return []

{-------------------------------------------------------------------------------
  Setting up a mock IteratorEnv
-------------------------------------------------------------------------------}

initIteratorEnv ::
     forall m. IOLike m
  => TestSetup
  -> Tracer m (TraceIteratorEvent TestBlock)
  -> m (IteratorEnv m TestBlock)
initIteratorEnv :: forall (m :: * -> *).
IOLike m =>
TestSetup
-> Tracer m (TraceIteratorEvent TestBlock)
-> m (IteratorEnv m TestBlock)
initIteratorEnv TestSetup { Chain TestBlock
immutable :: TestSetup -> Chain TestBlock
immutable :: Chain TestBlock
immutable, [TestBlock]
volatile :: TestSetup -> [TestBlock]
volatile :: [TestBlock]
volatile } Tracer m (TraceIteratorEvent TestBlock)
tracer = do
    StrictTVar m (Map IteratorKey (m ()))
iters       <- Map IteratorKey (m ()) -> m (StrictTVar m (Map IteratorKey (m ())))
forall (m :: * -> *) a. MonadSTM m => a -> m (StrictTVar m a)
uncheckedNewTVarM Map IteratorKey (m ())
forall k a. Map k a
Map.empty
    StrictTVar m IteratorKey
nextIterKey <- IteratorKey -> m (StrictTVar m IteratorKey)
forall (m :: * -> *) a. MonadSTM m => a -> m (StrictTVar m a)
uncheckedNewTVarM (IteratorKey -> m (StrictTVar m IteratorKey))
-> IteratorKey -> m (StrictTVar m IteratorKey)
forall a b. (a -> b) -> a -> b
$ Word -> IteratorKey
IteratorKey Word
0
    VolatileDB m TestBlock
volatileDB  <- [TestBlock] -> m (VolatileDB m TestBlock)
openVolatileDB [TestBlock]
volatile
    ImmutableDB m TestBlock
immutableDB <- Chain TestBlock -> m (ImmutableDB m TestBlock)
openImmutableDB Chain TestBlock
immutable
    IteratorEnv m TestBlock -> m (IteratorEnv m TestBlock)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return IteratorEnv
      { itImmutableDB :: ImmutableDB m TestBlock
itImmutableDB     = ImmutableDB m TestBlock
immutableDB
      , itVolatileDB :: VolatileDB m TestBlock
itVolatileDB      = VolatileDB m TestBlock
volatileDB
      , itIterators :: StrictTVar m (Map IteratorKey (m ()))
itIterators       = StrictTVar m (Map IteratorKey (m ()))
iters
      , itNextIteratorKey :: StrictTVar m IteratorKey
itNextIteratorKey = StrictTVar m IteratorKey
nextIterKey
      , itTracer :: Tracer m (TraceIteratorEvent TestBlock)
itTracer          = Tracer m (TraceIteratorEvent TestBlock)
tracer
      }
  where
    -- | Open a mock VolatileDB and add the given blocks
    openVolatileDB :: [TestBlock] -> m (VolatileDB m TestBlock)
    openVolatileDB :: [TestBlock] -> m (VolatileDB m TestBlock)
openVolatileDB [TestBlock]
blocks = do
        (DBModel TestBlock
_volatileDBModel, VolatileDB m TestBlock
volatileDB) <-
          BlocksPerFile
-> CodecConfig TestBlock
-> m (DBModel TestBlock, VolatileDB m TestBlock)
forall (m :: * -> *) blk.
(IOLike m, GetPrevHash blk, HasBinaryBlockInfo blk,
 EncodeDisk blk blk, HasNestedContent Header blk) =>
BlocksPerFile
-> CodecConfig blk -> m (DBModel blk, VolatileDB m blk)
VolatileDB.openDBMock
            (Word32 -> BlocksPerFile
VolatileDB.mkBlocksPerFile Word32
1)
            CodecConfig TestBlock
TestBlockCodecConfig
        [TestBlock] -> (TestBlock -> m ()) -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [TestBlock]
blocks ((TestBlock -> m ()) -> m ()) -> (TestBlock -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ VolatileDB m TestBlock -> HasCallStack => TestBlock -> m ()
forall (m :: * -> *) blk.
VolatileDB m blk -> HasCallStack => blk -> m ()
VolatileDB.putBlock VolatileDB m TestBlock
volatileDB
        VolatileDB m TestBlock -> m (VolatileDB m TestBlock)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return VolatileDB m TestBlock
volatileDB

    epochSize :: EpochSize
    epochSize :: EpochSize
epochSize = EpochSize
10

    -- | Open a mock ImmutableDB and add the given chain of blocks
    openImmutableDB :: Chain TestBlock -> m (ImmutableDB m TestBlock)
    openImmutableDB :: Chain TestBlock -> m (ImmutableDB m TestBlock)
openImmutableDB Chain TestBlock
chain = do
        (DBModel TestBlock
_immutableDBModel, ImmutableDB m TestBlock
immutableDB) <-
            ChunkInfo
-> CodecConfig TestBlock
-> m (DBModel TestBlock, ImmutableDB m TestBlock)
forall (m :: * -> *) blk.
(HasHeader blk, GetHeader blk, EncodeDisk blk blk,
 HasNestedContent Header blk, EncodeDiskDep (NestedCtxt Header) blk,
 IOLike m) =>
ChunkInfo -> CodecConfig blk -> m (DBModel blk, ImmutableDB m blk)
ImmutableDB.openDBMock
              ChunkInfo
chunkInfo
              CodecConfig TestBlock
TestBlockCodecConfig
        (TestBlock -> m ()) -> [TestBlock] -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (ImmutableDB m TestBlock -> TestBlock -> m ()
forall (m :: * -> *) blk.
HasCallStack =>
ImmutableDB m blk -> blk -> m ()
ImmutableDB.appendBlock ImmutableDB m TestBlock
immutableDB) (Chain TestBlock -> [TestBlock]
forall block. Chain block -> [block]
Chain.toOldestFirst Chain TestBlock
chain)
        ImmutableDB m TestBlock -> m (ImmutableDB m TestBlock)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ImmutableDB m TestBlock
immutableDB
      where
        chunkInfo :: ChunkInfo
chunkInfo = EpochSize -> ChunkInfo
ImmutableDB.simpleChunkInfo EpochSize
epochSize