{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}

module Test.Ouroboros.Storage.ChainDB.Unit (tests) where


import           Cardano.Slotting.Slot (WithOrigin (..))
import           Control.Monad (replicateM, unless, void)
import           Control.Monad.Except (Except, ExceptT, MonadError, runExcept,
                     runExceptT, throwError)
import           Control.Monad.Reader (MonadReader, ReaderT, ask, runReaderT)
import           Control.Monad.State (MonadState, StateT, evalStateT, get,
                     modify, put)
import           Control.Monad.Trans.Class (lift)
import           Data.Maybe (isJust)
import           Ouroboros.Consensus.Block.Abstract (blockSlot)
import           Ouroboros.Consensus.Block.RealPoint
                     (pointToWithOriginRealPoint)
import           Ouroboros.Consensus.Config (TopLevelConfig,
                     configSecurityParam)
import           Ouroboros.Consensus.Ledger.Extended (ExtLedgerState)
import           Ouroboros.Consensus.Ledger.SupportsProtocol
                     (LedgerSupportsProtocol)
import qualified Ouroboros.Consensus.Storage.ChainDB.API as API
import qualified Ouroboros.Consensus.Storage.ChainDB.API.Types.InvalidBlockPunishment as API
import           Ouroboros.Consensus.Storage.ChainDB.Impl (TraceEvent)
import           Ouroboros.Consensus.Storage.ChainDB.Impl.Args
import qualified Ouroboros.Consensus.Storage.ChainDB.Impl.Args as ChainDB
import           Ouroboros.Consensus.Storage.Common (StreamFrom (..),
                     StreamTo (..))
import           Ouroboros.Consensus.Storage.ImmutableDB.Chunks as ImmutableDB
import           Ouroboros.Consensus.Util.IOLike
import           Ouroboros.Consensus.Util.ResourceRegistry (closeRegistry,
                     unsafeNewRegistry)
import qualified Ouroboros.Network.AnchoredFragment as AF
import           Ouroboros.Network.Block (ChainUpdate (..), Point, blockPoint)
import qualified Ouroboros.Network.Mock.Chain as Mock
import qualified Test.Ouroboros.Storage.ChainDB.Model as Model
import           Test.Ouroboros.Storage.ChainDB.Model (Model)
import qualified Test.Ouroboros.Storage.ChainDB.StateMachine as SM
import           Test.Ouroboros.Storage.ChainDB.StateMachine (AllComponents,
                     ChainDBEnv (..), ChainDBState (..),
                     ShouldGarbageCollect (..), TestConstraints, allComponents,
                     close, mkTestCfg, open)
import           Test.Ouroboros.Storage.TestBlock
import           Test.Tasty (TestTree, testGroup)
import           Test.Tasty.HUnit (Assertion, assertFailure, testCase)
import           Test.Util.ChainDB (MinimalChainDbArgs (..), emptyNodeDBs,
                     fromMinimalChainDbArgs, nodeDBsVol)
import           Test.Util.Tracer (recordingTracerTVar)

tests :: TestTree
tests :: TestTree
tests = String -> [TestTree] -> TestTree
testGroup String
"Unit tests"
  [ String -> [TestTree] -> TestTree
testGroup String
"First follower instruction isJust on empty ChainDB"
    [ String -> Assertion -> TestTree
testCase String
"model" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$ LoE () -> ModelM TestBlock () -> Assertion
forall a. LoE () -> ModelM TestBlock a -> Assertion
runModelIO LoE ()
forall a. LoE a
API.LoEDisabled ModelM TestBlock ()
forall (m :: * -> *).
(SupportsUnitTest m, MonadError TestFailure m) =>
m ()
followerInstructionOnEmptyChain
    , String -> Assertion -> TestTree
testCase String
"system" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$ SystemM TestBlock IO () -> Assertion
forall a. SystemM TestBlock IO a -> Assertion
runSystemIO SystemM TestBlock IO ()
forall (m :: * -> *).
(SupportsUnitTest m, MonadError TestFailure m) =>
m ()
followerInstructionOnEmptyChain
    ]
  , String -> [TestTree] -> TestTree
testGroup String
"Follower switches to new chain"
    [ String -> Assertion -> TestTree
testCase String
"model" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$ LoE () -> ModelM TestBlock () -> Assertion
forall a. LoE () -> ModelM TestBlock a -> Assertion
runModelIO LoE ()
forall a. LoE a
API.LoEDisabled ModelM TestBlock ()
forall (m :: * -> *).
(Block m ~ TestBlock, SupportsUnitTest m,
 MonadError TestFailure m) =>
m ()
followerSwitchesToNewChain
    , String -> Assertion -> TestTree
testCase String
"system" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$ SystemM TestBlock IO () -> Assertion
forall a. SystemM TestBlock IO a -> Assertion
runSystemIO SystemM TestBlock IO ()
forall (m :: * -> *).
(Block m ~ TestBlock, SupportsUnitTest m,
 MonadError TestFailure m) =>
m ()
followerSwitchesToNewChain
    ]
  , String -> [TestTree] -> TestTree
testGroup (Int -> String
ouroborosNetworkIssue Int
4183)
    [ String -> Assertion -> TestTree
testCase String
"model" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$ LoE () -> ModelM TestBlock () -> Assertion
forall a. LoE () -> ModelM TestBlock a -> Assertion
runModelIO LoE ()
forall a. LoE a
API.LoEDisabled ModelM TestBlock ()
forall (m :: * -> *).
(Block m ~ TestBlock, SupportsUnitTest m,
 MonadError TestFailure m) =>
m ()
ouroboros_network_4183
    , String -> Assertion -> TestTree
testCase String
"system" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$ SystemM TestBlock IO () -> Assertion
forall a. SystemM TestBlock IO a -> Assertion
runSystemIO SystemM TestBlock IO ()
forall (m :: * -> *).
(Block m ~ TestBlock, SupportsUnitTest m,
 MonadError TestFailure m) =>
m ()
ouroboros_network_4183
    ]
  , String -> [TestTree] -> TestTree
testGroup (Int -> String
ouroborosNetworkIssue Int
3999)
    [ String -> Assertion -> TestTree
testCase String
"model" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$ LoE () -> ModelM TestBlock () -> Assertion
forall a. LoE () -> ModelM TestBlock a -> Assertion
runModelIO LoE ()
forall a. LoE a
API.LoEDisabled ModelM TestBlock ()
forall (m :: * -> *).
(HasHeader (Block m), Block m ~ TestBlock, SupportsUnitTest m,
 MonadError TestFailure m) =>
m ()
ouroboros_network_3999
    , String -> Assertion -> TestTree
testCase String
"system" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$ SystemM TestBlock IO () -> Assertion
forall a. SystemM TestBlock IO a -> Assertion
runSystemIO SystemM TestBlock IO ()
forall (m :: * -> *).
(HasHeader (Block m), Block m ~ TestBlock, SupportsUnitTest m,
 MonadError TestFailure m) =>
m ()
ouroboros_network_3999
    ]
  ]


followerInstructionOnEmptyChain :: (SupportsUnitTest m, MonadError TestFailure m) => m ()
followerInstructionOnEmptyChain :: forall (m :: * -> *).
(SupportsUnitTest m, MonadError TestFailure m) =>
m ()
followerInstructionOnEmptyChain = do
  FollowerId m
f <- m (FollowerId m)
forall (m :: * -> *). SupportsUnitTest m => m (FollowerId m)
newFollower
  FollowerId m
-> m (Either
        (ChainDbError (Block m))
        (Maybe
           (ChainUpdate
              (Block m)
              (Block m, Block m, Header (Block m), ByteString, ByteString,
               HeaderHash (Block m), SlotNo, IsEBB, SizeInBytes, Word16,
               SomeSecond (NestedCtxt Header) (Block m)))))
forall (m :: * -> *).
SupportsUnitTest m =>
FollowerId m
-> m (Either
        (ChainDbError (Block m))
        (Maybe (ChainUpdate (Block m) (AllComponents (Block m)))))
followerInstruction FollowerId m
f m (Either
     (ChainDbError (Block m))
     (Maybe
        (ChainUpdate
           (Block m)
           (Block m, Block m, Header (Block m), ByteString, ByteString,
            HeaderHash (Block m), SlotNo, IsEBB, SizeInBytes, Word16,
            SomeSecond (NestedCtxt Header) (Block m)))))
-> (Either
      (ChainDbError (Block m))
      (Maybe
         (ChainUpdate
            (Block m)
            (Block m, Block m, Header (Block m), ByteString, ByteString,
             HeaderHash (Block m), SlotNo, IsEBB, SizeInBytes, Word16,
             SomeSecond (NestedCtxt Header) (Block m))))
    -> m ())
-> m ()
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Right Maybe
  (ChainUpdate
     (Block m)
     (Block m, Block m, Header (Block m), ByteString, ByteString,
      HeaderHash (Block m), SlotNo, IsEBB, SizeInBytes, Word16,
      SomeSecond (NestedCtxt Header) (Block m)))
instr -> Maybe
  (ChainUpdate
     (Block m)
     (Block m, Block m, Header (Block m), ByteString, ByteString,
      HeaderHash (Block m), SlotNo, IsEBB, SizeInBytes, Word16,
      SomeSecond (NestedCtxt Header) (Block m)))
-> Bool
forall a. Maybe a -> Bool
isJust Maybe
  (ChainUpdate
     (Block m)
     (Block m, Block m, Header (Block m), ByteString, ByteString,
      HeaderHash (Block m), SlotNo, IsEBB, SizeInBytes, Word16,
      SomeSecond (NestedCtxt Header) (Block m)))
instr Bool -> String -> m ()
forall (m :: * -> *).
MonadError TestFailure m =>
Bool -> String -> m ()
`orFailWith` String
"Expecting a follower instruction"
    Left ChainDbError (Block m)
_      -> String -> m ()
forall (m :: * -> *) a. MonadError TestFailure m => String -> m a
failWith (String -> m ()) -> String -> m ()
forall a b. (a -> b) -> a -> b
$ String
"ChainDbError"


-- | Test that a follower starts following the newly selected fork.
-- The chain constructed in this example looks like:
--
--     G --- b1 --- b2
--            \
--             \--- b3 -- b4
--
followerSwitchesToNewChain ::
     (Block m ~ TestBlock, SupportsUnitTest m, MonadError TestFailure m) => m ()
followerSwitchesToNewChain :: forall (m :: * -> *).
(Block m ~ TestBlock, SupportsUnitTest m,
 MonadError TestFailure m) =>
m ()
followerSwitchesToNewChain =
  let fork :: Word -> TestBody
fork Word
i = Word -> Bool -> TestBody
TestBody Word
i Bool
True
  in do
    TestBlock
b1 <- Block m -> m (Block m)
forall (m :: * -> *). SupportsUnitTest m => Block m -> m (Block m)
addBlock (Block m -> m (Block m)) -> Block m -> m (Block m)
forall a b. (a -> b) -> a -> b
$ SlotNo -> TestBody -> TestBlock
firstBlock SlotNo
0     (TestBody -> TestBlock) -> TestBody -> TestBlock
forall a b. (a -> b) -> a -> b
$ Word -> TestBody
fork Word
0 -- b1 on top of G
    TestBlock
b2 <- Block m -> m (Block m)
forall (m :: * -> *). SupportsUnitTest m => Block m -> m (Block m)
addBlock (Block m -> m (Block m)) -> Block m -> m (Block m)
forall a b. (a -> b) -> a -> b
$ TestBlock -> SlotNo -> TestBody -> TestBlock
mkNextBlock TestBlock
b1 SlotNo
1 (TestBody -> TestBlock) -> TestBody -> TestBlock
forall a b. (a -> b) -> a -> b
$ Word -> TestBody
fork Word
0 -- b2 on top of b1
    FollowerId m
f <- m (FollowerId m)
forall (m :: * -> *). SupportsUnitTest m => m (FollowerId m)
newFollower
    FollowerId m
-> [Point (Block m)]
-> m (Either (ChainDbError (Block m)) (Maybe (Point (Block m))))
forall (m :: * -> *).
SupportsUnitTest m =>
FollowerId m
-> [Point (Block m)]
-> m (Either (ChainDbError (Block m)) (Maybe (Point (Block m))))
followerForward FollowerId m
f [TestBlock -> Point TestBlock
forall block. HasHeader block => block -> Point block
blockPoint TestBlock
b2] m (Either (ChainDbError TestBlock) (Maybe (Point TestBlock)))
-> (Either (ChainDbError TestBlock) (Maybe (Point TestBlock))
    -> m ())
-> m ()
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      Right (Just Point TestBlock
pt) -> Point TestBlock -> Point TestBlock -> String -> m ()
forall (m :: * -> *) a.
(MonadError TestFailure m, Eq a, Show a) =>
a -> a -> String -> m ()
assertEqual (TestBlock -> Point TestBlock
forall block. HasHeader block => block -> Point block
blockPoint TestBlock
b2) Point TestBlock
pt String
"Expected to be at b2"
      Either (ChainDbError TestBlock) (Maybe (Point TestBlock))
_               -> String -> m ()
forall (m :: * -> *) a. MonadError TestFailure m => String -> m a
failWith String
"Expecting a success"
    TestBlock
b3 <- Block m -> m (Block m)
forall (m :: * -> *). SupportsUnitTest m => Block m -> m (Block m)
addBlock (Block m -> m (Block m)) -> Block m -> m (Block m)
forall a b. (a -> b) -> a -> b
$ TestBlock -> SlotNo -> TestBody -> TestBlock
mkNextBlock TestBlock
b1 SlotNo
2 (TestBody -> TestBlock) -> TestBody -> TestBlock
forall a b. (a -> b) -> a -> b
$ Word -> TestBody
fork Word
1 -- b3 on top of b1
    TestBlock
b4 <- Block m -> m (Block m)
forall (m :: * -> *). SupportsUnitTest m => Block m -> m (Block m)
addBlock (Block m -> m (Block m)) -> Block m -> m (Block m)
forall a b. (a -> b) -> a -> b
$ TestBlock -> SlotNo -> TestBody -> TestBlock
mkNextBlock TestBlock
b3 SlotNo
3 (TestBody -> TestBlock) -> TestBody -> TestBlock
forall a b. (a -> b) -> a -> b
$ Word -> TestBody
fork Word
1 -- b4 on top of b3
    FollowerId m
-> m (Either
        (ChainDbError (Block m))
        (Maybe (ChainUpdate (Block m) (AllComponents (Block m)))))
forall (m :: * -> *).
SupportsUnitTest m =>
FollowerId m
-> m (Either
        (ChainDbError (Block m))
        (Maybe (ChainUpdate (Block m) (AllComponents (Block m)))))
followerInstruction FollowerId m
f m (Either
     (ChainDbError TestBlock)
     (Maybe
        (ChainUpdate
           TestBlock
           (TestBlock, TestBlock, Header TestBlock, ByteString, ByteString,
            TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
            SomeSecond (NestedCtxt Header) TestBlock))))
-> (Either
      (ChainDbError TestBlock)
      (Maybe
         (ChainUpdate
            TestBlock
            (TestBlock, TestBlock, Header TestBlock, ByteString, ByteString,
             TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
             SomeSecond (NestedCtxt Header) TestBlock)))
    -> m ())
-> m ()
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      Right (Just (RollBack Point TestBlock
actual))
        -- Expect to rollback to the intersection point between [b1, b2] and
        -- [b1, b3, b4]
        -> Point TestBlock -> Point TestBlock -> String -> m ()
forall (m :: * -> *) a.
(MonadError TestFailure m, Eq a, Show a) =>
a -> a -> String -> m ()
assertEqual (TestBlock -> Point TestBlock
forall block. HasHeader block => block -> Point block
blockPoint TestBlock
b1) Point TestBlock
actual String
"Rollback to wrong point"
      Either
  (ChainDbError TestBlock)
  (Maybe
     (ChainUpdate
        TestBlock
        (TestBlock, TestBlock, Header TestBlock, ByteString, ByteString,
         TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
         SomeSecond (NestedCtxt Header) TestBlock)))
_ -> String -> m ()
forall (m :: * -> *) a. MonadError TestFailure m => String -> m a
failWith String
"Expecting a rollback"
    FollowerId m
-> m (Either
        (ChainDbError (Block m))
        (Maybe (ChainUpdate (Block m) (AllComponents (Block m)))))
forall (m :: * -> *).
SupportsUnitTest m =>
FollowerId m
-> m (Either
        (ChainDbError (Block m))
        (Maybe (ChainUpdate (Block m) (AllComponents (Block m)))))
followerInstruction FollowerId m
f m (Either
     (ChainDbError TestBlock)
     (Maybe
        (ChainUpdate
           TestBlock
           (TestBlock, TestBlock, Header TestBlock, ByteString, ByteString,
            TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
            SomeSecond (NestedCtxt Header) TestBlock))))
-> (Either
      (ChainDbError TestBlock)
      (Maybe
         (ChainUpdate
            TestBlock
            (TestBlock, TestBlock, Header TestBlock, ByteString, ByteString,
             TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
             SomeSecond (NestedCtxt Header) TestBlock)))
    -> m ())
-> m ()
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      Right (Just (AddBlock (TestBlock, TestBlock, Header TestBlock, ByteString, ByteString,
 TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
 SomeSecond (NestedCtxt Header) TestBlock)
actual))
        -> TestBlock -> TestBlock -> String -> m ()
forall (m :: * -> *) a.
(MonadError TestFailure m, Eq a, Show a) =>
a -> a -> String -> m ()
assertEqual TestBlock
b3 (AllComponents TestBlock -> TestBlock
forall blk. AllComponents blk -> blk
extractBlock AllComponents TestBlock
(TestBlock, TestBlock, Header TestBlock, ByteString, ByteString,
 TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
 SomeSecond (NestedCtxt Header) TestBlock)
actual) String
"Instructed to add wrong block"
      Either
  (ChainDbError TestBlock)
  (Maybe
     (ChainUpdate
        TestBlock
        (TestBlock, TestBlock, Header TestBlock, ByteString, ByteString,
         TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
         SomeSecond (NestedCtxt Header) TestBlock)))
_ -> String -> m ()
forall (m :: * -> *) a. MonadError TestFailure m => String -> m a
failWith String
"Expecting instruction to add a block"
    FollowerId m
-> m (Either
        (ChainDbError (Block m))
        (Maybe (ChainUpdate (Block m) (AllComponents (Block m)))))
forall (m :: * -> *).
SupportsUnitTest m =>
FollowerId m
-> m (Either
        (ChainDbError (Block m))
        (Maybe (ChainUpdate (Block m) (AllComponents (Block m)))))
followerInstruction FollowerId m
f m (Either
     (ChainDbError TestBlock)
     (Maybe
        (ChainUpdate
           TestBlock
           (TestBlock, TestBlock, Header TestBlock, ByteString, ByteString,
            TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
            SomeSecond (NestedCtxt Header) TestBlock))))
-> (Either
      (ChainDbError TestBlock)
      (Maybe
         (ChainUpdate
            TestBlock
            (TestBlock, TestBlock, Header TestBlock, ByteString, ByteString,
             TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
             SomeSecond (NestedCtxt Header) TestBlock)))
    -> m ())
-> m ()
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      Right (Just (AddBlock (TestBlock, TestBlock, Header TestBlock, ByteString, ByteString,
 TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
 SomeSecond (NestedCtxt Header) TestBlock)
actual))
        -> TestBlock -> TestBlock -> String -> m ()
forall (m :: * -> *) a.
(MonadError TestFailure m, Eq a, Show a) =>
a -> a -> String -> m ()
assertEqual TestBlock
b4 (AllComponents TestBlock -> TestBlock
forall blk. AllComponents blk -> blk
extractBlock AllComponents TestBlock
(TestBlock, TestBlock, Header TestBlock, ByteString, ByteString,
 TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
 SomeSecond (NestedCtxt Header) TestBlock)
actual) String
"Instructed to add wrong block"
      Either
  (ChainDbError TestBlock)
  (Maybe
     (ChainUpdate
        TestBlock
        (TestBlock, TestBlock, Header TestBlock, ByteString, ByteString,
         TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
         SomeSecond (NestedCtxt Header) TestBlock)))
_ -> String -> m ()
forall (m :: * -> *) a. MonadError TestFailure m => String -> m a
failWith String
"Expecting instruction to add a block"


ouroborosNetworkIssue :: Int -> String
ouroborosNetworkIssue :: Int -> String
ouroborosNetworkIssue Int
n
  | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0 = String -> String
forall a. HasCallStack => String -> a
error String
"Issue number should be positive"
  | Bool
otherwise = String
"https://github.com/IntersectMBO/ouroboros-network/issues/" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show Int
n


ouroboros_network_4183 :: (
    Block m ~ TestBlock
  , SupportsUnitTest m
  , MonadError TestFailure m
  ) => m ()
ouroboros_network_4183 :: forall (m :: * -> *).
(Block m ~ TestBlock, SupportsUnitTest m,
 MonadError TestFailure m) =>
m ()
ouroboros_network_4183 =
  let fork :: Word -> TestBody
fork Word
i = Word -> Bool -> TestBody
TestBody Word
i Bool
True
  in do
    TestBlock
b1 <- Block m -> m (Block m)
forall (m :: * -> *). SupportsUnitTest m => Block m -> m (Block m)
addBlock (Block m -> m (Block m)) -> Block m -> m (Block m)
forall a b. (a -> b) -> a -> b
$ (SlotNo -> Bool) -> TestBody -> TestBlock
firstEBB (Bool -> SlotNo -> Bool
forall a b. a -> b -> a
const Bool
True) (TestBody -> TestBlock) -> TestBody -> TestBlock
forall a b. (a -> b) -> a -> b
$ Word -> TestBody
fork Word
0
    TestBlock
b2 <- Block m -> m (Block m)
forall (m :: * -> *). SupportsUnitTest m => Block m -> m (Block m)
addBlock (Block m -> m (Block m)) -> Block m -> m (Block m)
forall a b. (a -> b) -> a -> b
$ TestBlock -> SlotNo -> TestBody -> TestBlock
mkNextBlock TestBlock
b1 SlotNo
0 (TestBody -> TestBlock) -> TestBody -> TestBlock
forall a b. (a -> b) -> a -> b
$ Word -> TestBody
fork Word
0
    TestBlock
b3 <- Block m -> m (Block m)
forall (m :: * -> *). SupportsUnitTest m => Block m -> m (Block m)
addBlock (Block m -> m (Block m)) -> Block m -> m (Block m)
forall a b. (a -> b) -> a -> b
$ TestBlock -> SlotNo -> TestBody -> TestBlock
mkNextBlock TestBlock
b2 SlotNo
1 (TestBody -> TestBlock) -> TestBody -> TestBlock
forall a b. (a -> b) -> a -> b
$ Word -> TestBody
fork Word
1
    TestBlock
b4 <- Block m -> m (Block m)
forall (m :: * -> *). SupportsUnitTest m => Block m -> m (Block m)
addBlock (Block m -> m (Block m)) -> Block m -> m (Block m)
forall a b. (a -> b) -> a -> b
$ TestBlock -> SlotNo -> TestBody -> TestBlock
mkNextBlock TestBlock
b2 SlotNo
1 (TestBody -> TestBlock) -> TestBody -> TestBlock
forall a b. (a -> b) -> a -> b
$ Word -> TestBody
fork Word
0
    FollowerId m
f <- m (FollowerId m)
forall (m :: * -> *). SupportsUnitTest m => m (FollowerId m)
newFollower
    m (Either (ChainDbError TestBlock) (Maybe (Point TestBlock)))
-> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (m (Either (ChainDbError TestBlock) (Maybe (Point TestBlock)))
 -> m ())
-> m (Either (ChainDbError TestBlock) (Maybe (Point TestBlock)))
-> m ()
forall a b. (a -> b) -> a -> b
$ FollowerId m
-> [Point (Block m)]
-> m (Either (ChainDbError (Block m)) (Maybe (Point (Block m))))
forall (m :: * -> *).
SupportsUnitTest m =>
FollowerId m
-> [Point (Block m)]
-> m (Either (ChainDbError (Block m)) (Maybe (Point (Block m))))
followerForward FollowerId m
f [TestBlock -> Point TestBlock
forall block. HasHeader block => block -> Point block
blockPoint TestBlock
b1]
    m TestBlock -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (m TestBlock -> m ()) -> m TestBlock -> m ()
forall a b. (a -> b) -> a -> b
$ Block m -> m (Block m)
forall (m :: * -> *). SupportsUnitTest m => Block m -> m (Block m)
addBlock (Block m -> m (Block m)) -> Block m -> m (Block m)
forall a b. (a -> b) -> a -> b
$ TestBlock -> SlotNo -> TestBody -> TestBlock
mkNextBlock TestBlock
b4 SlotNo
4 (TestBody -> TestBlock) -> TestBody -> TestBlock
forall a b. (a -> b) -> a -> b
$ Word -> TestBody
fork Word
0
    ShouldGarbageCollect -> m ()
forall (m :: * -> *).
SupportsUnitTest m =>
ShouldGarbageCollect -> m ()
persistBlks ShouldGarbageCollect
DoNotGarbageCollect
    m TestBlock -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (m TestBlock -> m ()) -> m TestBlock -> m ()
forall a b. (a -> b) -> a -> b
$ Block m -> m (Block m)
forall (m :: * -> *). SupportsUnitTest m => Block m -> m (Block m)
addBlock (Block m -> m (Block m)) -> Block m -> m (Block m)
forall a b. (a -> b) -> a -> b
$ TestBlock -> SlotNo -> TestBody -> TestBlock
mkNextBlock TestBlock
b3 SlotNo
3 (TestBody -> TestBlock) -> TestBody -> TestBlock
forall a b. (a -> b) -> a -> b
$ Word -> TestBody
fork Word
1
    FollowerId m
-> m (Either
        (ChainDbError (Block m))
        (Maybe (ChainUpdate (Block m) (AllComponents (Block m)))))
forall (m :: * -> *).
SupportsUnitTest m =>
FollowerId m
-> m (Either
        (ChainDbError (Block m))
        (Maybe (ChainUpdate (Block m) (AllComponents (Block m)))))
followerInstruction FollowerId m
f m (Either
     (ChainDbError TestBlock)
     (Maybe
        (ChainUpdate
           TestBlock
           (TestBlock, TestBlock, Header TestBlock, ByteString, ByteString,
            TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
            SomeSecond (NestedCtxt Header) TestBlock))))
-> (Either
      (ChainDbError TestBlock)
      (Maybe
         (ChainUpdate
            TestBlock
            (TestBlock, TestBlock, Header TestBlock, ByteString, ByteString,
             TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
             SomeSecond (NestedCtxt Header) TestBlock)))
    -> m ())
-> m ()
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      Right (Just (RollBack Point TestBlock
actual))
        -> Point TestBlock -> Point TestBlock -> String -> m ()
forall (m :: * -> *) a.
(MonadError TestFailure m, Eq a, Show a) =>
a -> a -> String -> m ()
assertEqual (TestBlock -> Point TestBlock
forall block. HasHeader block => block -> Point block
blockPoint TestBlock
b1) Point TestBlock
actual String
"Rollback to wrong point"
      Either
  (ChainDbError TestBlock)
  (Maybe
     (ChainUpdate
        TestBlock
        (TestBlock, TestBlock, Header TestBlock, ByteString, ByteString,
         TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
         SomeSecond (NestedCtxt Header) TestBlock)))
_ -> String -> m ()
forall (m :: * -> *) a. MonadError TestFailure m => String -> m a
failWith String
"Expecting a rollback"


-- | Test that iterators over dead forks that may have been garbage-collected
-- either stream the blocks in the dead fork normally, report that the blocks
-- have been garbage-collected, or return that the iterator is exhausted,
-- depending on when garbage collection happened. The result is
-- non-deterministic, since garbage collection happens in the background, and
-- hence, may not yet have happened when the next item in the iterator is
-- requested.
ouroboros_network_3999 :: (
    Mock.HasHeader (Block m)
  , Block m ~ TestBlock
  , SupportsUnitTest m
  , MonadError TestFailure m
  ) => m ()
ouroboros_network_3999 :: forall (m :: * -> *).
(HasHeader (Block m), Block m ~ TestBlock, SupportsUnitTest m,
 MonadError TestFailure m) =>
m ()
ouroboros_network_3999 = do
    TestBlock
b1 <- Block m -> m (Block m)
forall (m :: * -> *). SupportsUnitTest m => Block m -> m (Block m)
addBlock (Block m -> m (Block m)) -> Block m -> m (Block m)
forall a b. (a -> b) -> a -> b
$ SlotNo -> TestBody -> TestBlock
firstBlock SlotNo
0 (TestBody -> TestBlock) -> TestBody -> TestBlock
forall a b. (a -> b) -> a -> b
$ Word -> TestBody
fork Word
1
    TestBlock
b2 <- Block m -> m (Block m)
forall (m :: * -> *). SupportsUnitTest m => Block m -> m (Block m)
addBlock (Block m -> m (Block m)) -> Block m -> m (Block m)
forall a b. (a -> b) -> a -> b
$ TestBlock -> SlotNo -> TestBody -> TestBlock
mkNextBlock TestBlock
b1 SlotNo
1 (TestBody -> TestBlock) -> TestBody -> TestBlock
forall a b. (a -> b) -> a -> b
$ Word -> TestBody
fork Word
1
    TestBlock
b3 <- Block m -> m (Block m)
forall (m :: * -> *). SupportsUnitTest m => Block m -> m (Block m)
addBlock (Block m -> m (Block m)) -> Block m -> m (Block m)
forall a b. (a -> b) -> a -> b
$ TestBlock -> SlotNo -> TestBody -> TestBlock
mkNextBlock TestBlock
b2 SlotNo
2 (TestBody -> TestBlock) -> TestBody -> TestBlock
forall a b. (a -> b) -> a -> b
$ Word -> TestBody
fork Word
1
    IteratorId m
i <- StreamFrom (Block m) -> StreamTo (Block m) -> m (IteratorId m)
forall (m :: * -> *).
(MonadError TestFailure m, SupportsUnitTest m,
 HasHeader (Block m)) =>
StreamFrom (Block m) -> StreamTo (Block m) -> m (IteratorId m)
streamAssertSuccess (TestBlock -> StreamFrom TestBlock
inclusiveFrom TestBlock
b1) (TestBlock -> StreamTo TestBlock
inclusiveTo TestBlock
b3)
    TestBlock
b4 <- Block m -> m (Block m)
forall (m :: * -> *). SupportsUnitTest m => Block m -> m (Block m)
addBlock (Block m -> m (Block m)) -> Block m -> m (Block m)
forall a b. (a -> b) -> a -> b
$ TestBlock -> SlotNo -> TestBody -> TestBlock
mkNextBlock TestBlock
b1 SlotNo
3 (TestBody -> TestBlock) -> TestBody -> TestBlock
forall a b. (a -> b) -> a -> b
$ Word -> TestBody
fork Word
2
    TestBlock
b5 <- Block m -> m (Block m)
forall (m :: * -> *). SupportsUnitTest m => Block m -> m (Block m)
addBlock (Block m -> m (Block m)) -> Block m -> m (Block m)
forall a b. (a -> b) -> a -> b
$ TestBlock -> SlotNo -> TestBody -> TestBlock
mkNextBlock TestBlock
b4 SlotNo
4 (TestBody -> TestBlock) -> TestBody -> TestBlock
forall a b. (a -> b) -> a -> b
$ Word -> TestBody
fork Word
2
    TestBlock
b6 <- Block m -> m (Block m)
forall (m :: * -> *). SupportsUnitTest m => Block m -> m (Block m)
addBlock (Block m -> m (Block m)) -> Block m -> m (Block m)
forall a b. (a -> b) -> a -> b
$ TestBlock -> SlotNo -> TestBody -> TestBlock
mkNextBlock TestBlock
b5 SlotNo
5 (TestBody -> TestBlock) -> TestBody -> TestBlock
forall a b. (a -> b) -> a -> b
$ Word -> TestBody
fork Word
2
    m TestBlock -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (m TestBlock -> m ()) -> m TestBlock -> m ()
forall a b. (a -> b) -> a -> b
$ Block m -> m (Block m)
forall (m :: * -> *). SupportsUnitTest m => Block m -> m (Block m)
addBlock (Block m -> m (Block m)) -> Block m -> m (Block m)
forall a b. (a -> b) -> a -> b
$ TestBlock -> SlotNo -> TestBody -> TestBlock
mkNextBlock TestBlock
b6 SlotNo
6 (TestBody -> TestBlock) -> TestBody -> TestBlock
forall a b. (a -> b) -> a -> b
$ Word -> TestBody
fork Word
2
    ShouldGarbageCollect -> m ()
forall (m :: * -> *).
SupportsUnitTest m =>
ShouldGarbageCollect -> m ()
persistBlks ShouldGarbageCollect
GarbageCollect

    -- The block b1 is part of the current chain, so should always be returned.
    IteratorResult TestBlock TestBlock
result <- IteratorId m -> m (IteratorResult (Block m) (Block m))
forall {f :: * -> *}.
(Functor f, SupportsUnitTest f) =>
IteratorId f -> f (IteratorResult (Block f) (Block f))
iteratorNextBlock IteratorId m
i
    IteratorResult TestBlock TestBlock
-> IteratorResult TestBlock TestBlock -> String -> m ()
forall (m :: * -> *) a.
(MonadError TestFailure m, Eq a, Show a) =>
a -> a -> String -> m ()
assertEqual (TestBlock -> IteratorResult TestBlock TestBlock
forall blk b. b -> IteratorResult blk b
API.IteratorResult TestBlock
b1) IteratorResult TestBlock TestBlock
result String
"Streaming first block"

    -- The remainder of the elements in the iterator are part of the dead fork,
    -- and may have been garbage-collected.
    let options :: [[IteratorResult TestBlock TestBlock]]
options = [
            -- The dead fork has been garbage-collected.
            [RealPoint TestBlock -> IteratorResult TestBlock TestBlock
forall blk b. RealPoint blk -> IteratorResult blk b
API.IteratorBlockGCed (RealPoint TestBlock -> IteratorResult TestBlock TestBlock)
-> RealPoint TestBlock -> IteratorResult TestBlock TestBlock
forall a b. (a -> b) -> a -> b
$ TestBlock -> RealPoint TestBlock
forall {blk}. HasHeader blk => blk -> RealPoint blk
blockRealPoint TestBlock
b2, IteratorResult TestBlock TestBlock
forall blk b. IteratorResult blk b
API.IteratorExhausted]
            -- The dead fork has not been garbage-collected yet.
          , [TestBlock -> IteratorResult TestBlock TestBlock
forall blk b. b -> IteratorResult blk b
API.IteratorResult TestBlock
b2, TestBlock -> IteratorResult TestBlock TestBlock
forall blk b. b -> IteratorResult blk b
API.IteratorResult TestBlock
b3]]

    [IteratorResult TestBlock TestBlock]
actual <- Int
-> m (IteratorResult TestBlock TestBlock)
-> m [IteratorResult TestBlock TestBlock]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
2 (IteratorId m -> m (IteratorResult (Block m) (Block m))
forall {f :: * -> *}.
(Functor f, SupportsUnitTest f) =>
IteratorId f -> f (IteratorResult (Block f) (Block f))
iteratorNextBlock IteratorId m
i)
    [[IteratorResult TestBlock TestBlock]]
-> [IteratorResult TestBlock TestBlock] -> String -> m ()
forall (m :: * -> *) a.
(MonadError TestFailure m, Eq a, Show a) =>
[a] -> a -> String -> m ()
assertOneOf [[IteratorResult TestBlock TestBlock]]
options [IteratorResult TestBlock TestBlock]
actual String
"Streaming over dead fork"

  where
    fork :: Word -> TestBody
fork Word
i = Word -> Bool -> TestBody
TestBody Word
i Bool
True

    iteratorNextBlock :: IteratorId f -> f (IteratorResult (Block f) (Block f))
iteratorNextBlock IteratorId f
it = ((Block f, Block f, Header (Block f), ByteString, ByteString,
  HeaderHash (Block f), SlotNo, IsEBB, SizeInBytes, Word16,
  SomeSecond (NestedCtxt Header) (Block f))
 -> Block f)
-> IteratorResult
     (Block f)
     (Block f, Block f, Header (Block f), ByteString, ByteString,
      HeaderHash (Block f), SlotNo, IsEBB, SizeInBytes, Word16,
      SomeSecond (NestedCtxt Header) (Block f))
-> IteratorResult (Block f) (Block f)
forall a b.
(a -> b)
-> IteratorResult (Block f) a -> IteratorResult (Block f) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Block f, Block f, Header (Block f), ByteString, ByteString,
 HeaderHash (Block f), SlotNo, IsEBB, SizeInBytes, Word16,
 SomeSecond (NestedCtxt Header) (Block f))
-> Block f
forall blk. AllComponents blk -> blk
extractBlock (IteratorResult
   (Block f)
   (Block f, Block f, Header (Block f), ByteString, ByteString,
    HeaderHash (Block f), SlotNo, IsEBB, SizeInBytes, Word16,
    SomeSecond (NestedCtxt Header) (Block f))
 -> IteratorResult (Block f) (Block f))
-> f (IteratorResult
        (Block f)
        (Block f, Block f, Header (Block f), ByteString, ByteString,
         HeaderHash (Block f), SlotNo, IsEBB, SizeInBytes, Word16,
         SomeSecond (NestedCtxt Header) (Block f)))
-> f (IteratorResult (Block f) (Block f))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IteratorId f
-> f (IteratorResult
        (Block f)
        (Block f, Block f, Header (Block f), ByteString, ByteString,
         HeaderHash (Block f), SlotNo, IsEBB, SizeInBytes, Word16,
         SomeSecond (NestedCtxt Header) (Block f)))
forall (m :: * -> *).
SupportsUnitTest m =>
IteratorId m
-> m (IteratorResult (Block m) (AllComponents (Block m)))
iteratorNext IteratorId f
it

    inclusiveFrom :: TestBlock -> StreamFrom TestBlock
inclusiveFrom      = RealPoint TestBlock -> StreamFrom TestBlock
forall blk. RealPoint blk -> StreamFrom blk
StreamFromInclusive (RealPoint TestBlock -> StreamFrom TestBlock)
-> (TestBlock -> RealPoint TestBlock)
-> TestBlock
-> StreamFrom TestBlock
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TestBlock -> RealPoint TestBlock
forall {blk}. HasHeader blk => blk -> RealPoint blk
blockRealPoint
    inclusiveTo :: TestBlock -> StreamTo TestBlock
inclusiveTo        = RealPoint TestBlock -> StreamTo TestBlock
forall blk. RealPoint blk -> StreamTo blk
StreamToInclusive (RealPoint TestBlock -> StreamTo TestBlock)
-> (TestBlock -> RealPoint TestBlock)
-> TestBlock
-> StreamTo TestBlock
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TestBlock -> RealPoint TestBlock
forall {blk}. HasHeader blk => blk -> RealPoint blk
blockRealPoint
    -- Do not call this function with `Genesis`
    blockRealPoint :: blk -> RealPoint blk
blockRealPoint blk
blk = case Point blk -> WithOrigin (RealPoint blk)
forall blk. Point blk -> WithOrigin (RealPoint blk)
pointToWithOriginRealPoint (Point blk -> WithOrigin (RealPoint blk))
-> Point blk -> WithOrigin (RealPoint blk)
forall a b. (a -> b) -> a -> b
$ blk -> Point blk
forall block. HasHeader block => block -> Point block
blockPoint blk
blk of
      At RealPoint blk
realPoint -> RealPoint blk
realPoint
      WithOrigin (RealPoint blk)
_            -> String -> RealPoint blk
forall a. HasCallStack => String -> a
error String
"Should not happen"


streamAssertSuccess :: (MonadError TestFailure m, SupportsUnitTest m, Mock.HasHeader (Block m))
                    => StreamFrom (Block m) -> StreamTo (Block m) -> m (IteratorId m)
streamAssertSuccess :: forall (m :: * -> *).
(MonadError TestFailure m, SupportsUnitTest m,
 HasHeader (Block m)) =>
StreamFrom (Block m) -> StreamTo (Block m) -> m (IteratorId m)
streamAssertSuccess StreamFrom (Block m)
from StreamTo (Block m)
to = StreamFrom (Block m)
-> StreamTo (Block m)
-> m (Either
        (ChainDbError (Block m))
        (Either (UnknownRange (Block m)) (IteratorId m)))
forall (m :: * -> *).
SupportsUnitTest m =>
StreamFrom (Block m)
-> StreamTo (Block m)
-> m (Either
        (ChainDbError (Block m))
        (Either (UnknownRange (Block m)) (IteratorId m)))
stream StreamFrom (Block m)
from StreamTo (Block m)
to m (Either
     (ChainDbError (Block m))
     (Either (UnknownRange (Block m)) (IteratorId m)))
-> (Either
      (ChainDbError (Block m))
      (Either (UnknownRange (Block m)) (IteratorId m))
    -> m (IteratorId m))
-> m (IteratorId m)
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Left ChainDbError (Block m)
err -> String -> m (IteratorId m)
forall (m :: * -> *) a. MonadError TestFailure m => String -> m a
failWith (String -> m (IteratorId m)) -> String -> m (IteratorId m)
forall a b. (a -> b) -> a -> b
$ String
"Should be able to create iterator: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> ChainDbError (Block m) -> String
forall a. Show a => a -> String
show ChainDbError (Block m)
err
    Right (Left UnknownRange (Block m)
err) -> String -> m (IteratorId m)
forall (m :: * -> *) a. MonadError TestFailure m => String -> m a
failWith (String -> m (IteratorId m)) -> String -> m (IteratorId m)
forall a b. (a -> b) -> a -> b
$ String
"Range should be valid: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> UnknownRange (Block m) -> String
forall a. Show a => a -> String
show UnknownRange (Block m)
err
    Right (Right IteratorId m
iteratorId) -> IteratorId m -> m (IteratorId m)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure IteratorId m
iteratorId


extractBlock :: AllComponents blk -> blk
extractBlock :: forall blk. AllComponents blk -> blk
extractBlock (blk
blk, blk
_, Header blk
_, ByteString
_, ByteString
_, HeaderHash blk
_, SlotNo
_, IsEBB
_, SizeInBytes
_, Word16
_, SomeSecond (NestedCtxt Header) blk
_) = blk
blk


-- | Helper function to run the test against the model and translate to something
-- that HUnit likes.
runModelIO :: API.LoE () -> ModelM TestBlock a -> IO ()
runModelIO :: forall a. LoE () -> ModelM TestBlock a -> Assertion
runModelIO LoE ()
loe ModelM TestBlock a
expr = Either TestFailure a -> Assertion
forall a. Either TestFailure a -> Assertion
toAssertion (Model TestBlock
-> TopLevelConfig TestBlock
-> ModelM TestBlock a
-> Either TestFailure a
forall blk b.
Model blk
-> TopLevelConfig blk -> ModelM blk b -> Either TestFailure b
runModel Model TestBlock
newModel TopLevelConfig TestBlock
topLevelConfig ModelM TestBlock a
expr)
  where
    chunkInfo :: ChunkInfo
chunkInfo      = EpochSize -> ChunkInfo
ImmutableDB.simpleChunkInfo EpochSize
100
    newModel :: Model TestBlock
newModel       = LoE () -> ExtLedgerState TestBlock -> Word64 -> Model TestBlock
forall blk.
HasHeader blk =>
LoE () -> ExtLedgerState blk -> Word64 -> Model blk
Model.empty LoE ()
loe ExtLedgerState TestBlock
testInitExtLedger Word64
0
    topLevelConfig :: TopLevelConfig TestBlock
topLevelConfig = ChunkInfo -> TopLevelConfig TestBlock
mkTestCfg ChunkInfo
chunkInfo


-- | Helper function to run the test against the actual chain database and
-- translate to something that HUnit likes.
runSystemIO :: SystemM TestBlock IO a -> IO ()
runSystemIO :: forall a. SystemM TestBlock IO a -> Assertion
runSystemIO SystemM TestBlock IO a
expr = (forall a.
 (ChainDBEnv IO TestBlock -> IO [TraceEvent TestBlock] -> IO a)
 -> IO a)
-> SystemM TestBlock IO a -> IO (Either TestFailure a)
forall (m :: * -> *) blk b.
(forall a. (ChainDBEnv m blk -> m [TraceEvent blk] -> m a) -> m a)
-> SystemM blk m b -> m (Either TestFailure b)
runSystem (ChainDBEnv IO TestBlock -> IO [TraceEvent TestBlock] -> IO a)
-> IO a
forall a.
(ChainDBEnv IO TestBlock -> IO [TraceEvent TestBlock] -> IO a)
-> IO a
withChainDbEnv SystemM TestBlock IO a
expr IO (Either TestFailure a)
-> (Either TestFailure a -> Assertion) -> Assertion
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Either TestFailure a -> Assertion
forall a. Either TestFailure a -> Assertion
toAssertion
  where
    chunkInfo :: ChunkInfo
chunkInfo      = EpochSize -> ChunkInfo
ImmutableDB.simpleChunkInfo EpochSize
100
    topLevelConfig :: TopLevelConfig TestBlock
topLevelConfig = ChunkInfo -> TopLevelConfig TestBlock
mkTestCfg ChunkInfo
chunkInfo
    withChainDbEnv :: (ChainDBEnv IO TestBlock -> IO [TraceEvent TestBlock] -> IO a)
-> IO a
withChainDbEnv = TopLevelConfig TestBlock
-> ChunkInfo
-> ExtLedgerState TestBlock
-> (ChainDBEnv IO TestBlock -> IO [TraceEvent TestBlock] -> IO a)
-> IO a
forall (m :: * -> *) blk a.
(IOLike m, TestConstraints blk) =>
TopLevelConfig blk
-> ChunkInfo
-> ExtLedgerState blk
-> (ChainDBEnv m blk -> m [TraceEvent blk] -> m a)
-> m a
withTestChainDbEnv TopLevelConfig TestBlock
topLevelConfig ChunkInfo
chunkInfo ExtLedgerState TestBlock
testInitExtLedger


newtype TestFailure = TestFailure String deriving (Int -> TestFailure -> String -> String
[TestFailure] -> String -> String
TestFailure -> String
(Int -> TestFailure -> String -> String)
-> (TestFailure -> String)
-> ([TestFailure] -> String -> String)
-> Show TestFailure
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: Int -> TestFailure -> String -> String
showsPrec :: Int -> TestFailure -> String -> String
$cshow :: TestFailure -> String
show :: TestFailure -> String
$cshowList :: [TestFailure] -> String -> String
showList :: [TestFailure] -> String -> String
Show)


toAssertion :: Either TestFailure a -> Assertion
toAssertion :: forall a. Either TestFailure a -> Assertion
toAssertion (Left (TestFailure String
t)) = String -> Assertion
forall a. HasCallStack => String -> IO a
assertFailure String
t
toAssertion (Right a
_)              = () -> Assertion
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

orFailWith :: (MonadError TestFailure m) => Bool -> String -> m ()
orFailWith :: forall (m :: * -> *).
MonadError TestFailure m =>
Bool -> String -> m ()
orFailWith Bool
b String
msg = Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
b (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ String -> m ()
forall (m :: * -> *) a. MonadError TestFailure m => String -> m a
failWith String
msg
infixl 1 `orFailWith`

failWith :: (MonadError TestFailure m) => String -> m a
failWith :: forall (m :: * -> *) a. MonadError TestFailure m => String -> m a
failWith String
msg = TestFailure -> m a
forall a. TestFailure -> m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (String -> TestFailure
TestFailure String
msg)

assertEqual :: (MonadError TestFailure m, Eq a, Show a)
            => a -> a -> String -> m ()
assertEqual :: forall (m :: * -> *) a.
(MonadError TestFailure m, Eq a, Show a) =>
a -> a -> String -> m ()
assertEqual a
expected a
actual String
description = a
expected a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
actual Bool -> String -> m ()
forall (m :: * -> *).
MonadError TestFailure m =>
Bool -> String -> m ()
`orFailWith` String
msg
  where
    msg :: String
msg = String
description String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"\n\t Expected: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> a -> String
forall a. Show a => a -> String
show a
expected
                      String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"\n\t Actual: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> a -> String
forall a. Show a => a -> String
show a
actual

assertOneOf :: (MonadError TestFailure m, Eq a, Show a)
            => [a] -> a -> String -> m ()
assertOneOf :: forall (m :: * -> *) a.
(MonadError TestFailure m, Eq a, Show a) =>
[a] -> a -> String -> m ()
assertOneOf [a]
options a
actual String
description = a
actual a -> [a] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [a]
options Bool -> String -> m ()
forall (m :: * -> *).
MonadError TestFailure m =>
Bool -> String -> m ()
`orFailWith` String
msg
  where
    msg :: String
msg = String
description String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"\n\t Options: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> [a] -> String
forall a. Show a => a -> String
show [a]
options
                      String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"\n\t Actual: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> a -> String
forall a. Show a => a -> String
show a
actual

-- | SupportsUnitTests for the test expression need to instantiate this class.
class SupportsUnitTest m where
  type FollowerId m
  type IteratorId m
  type Block m

  addBlock
    :: Block m -> m (Block m)

  newFollower
    :: m (FollowerId m)

  followerInstruction
    :: FollowerId m
    -> m (Either (API.ChainDbError (Block m))
                 (Maybe (ChainUpdate (Block m) (AllComponents (Block m)))))

  followerForward
    :: FollowerId m
    -> [Point (Block m)]
    -> m (Either (API.ChainDbError (Block m))
                 (Maybe (Point (Block m))))

  persistBlks :: ShouldGarbageCollect -> m ()

  stream
    :: StreamFrom (Block m)
    -> StreamTo (Block m)
    -> m (Either (API.ChainDbError (Block m))
                 (Either (API.UnknownRange (Block m)) (IteratorId m)))

  iteratorNext
    :: IteratorId m
    -> m (API.IteratorResult (Block m) (AllComponents (Block m)))


{-------------------------------------------------------------------------------
  Model
-------------------------------------------------------------------------------}

-- | Tests against the model run in this monad.
newtype ModelM blk a = ModelM
  { forall blk a.
ModelM blk a
-> StateT
     (Model blk) (ReaderT (TopLevelConfig blk) (Except TestFailure)) a
runModelM :: StateT (Model blk) (ReaderT (TopLevelConfig blk) (Except TestFailure)) a
  } deriving newtype ((forall a b. (a -> b) -> ModelM blk a -> ModelM blk b)
-> (forall a b. a -> ModelM blk b -> ModelM blk a)
-> Functor (ModelM blk)
forall a b. a -> ModelM blk b -> ModelM blk a
forall a b. (a -> b) -> ModelM blk a -> ModelM blk b
forall blk a b. a -> ModelM blk b -> ModelM blk a
forall blk a b. (a -> b) -> ModelM blk a -> ModelM blk b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall blk a b. (a -> b) -> ModelM blk a -> ModelM blk b
fmap :: forall a b. (a -> b) -> ModelM blk a -> ModelM blk b
$c<$ :: forall blk a b. a -> ModelM blk b -> ModelM blk a
<$ :: forall a b. a -> ModelM blk b -> ModelM blk a
Functor, Functor (ModelM blk)
Functor (ModelM blk) =>
(forall a. a -> ModelM blk a)
-> (forall a b.
    ModelM blk (a -> b) -> ModelM blk a -> ModelM blk b)
-> (forall a b c.
    (a -> b -> c) -> ModelM blk a -> ModelM blk b -> ModelM blk c)
-> (forall a b. ModelM blk a -> ModelM blk b -> ModelM blk b)
-> (forall a b. ModelM blk a -> ModelM blk b -> ModelM blk a)
-> Applicative (ModelM blk)
forall blk. Functor (ModelM blk)
forall a. a -> ModelM blk a
forall blk a. a -> ModelM blk a
forall a b. ModelM blk a -> ModelM blk b -> ModelM blk a
forall a b. ModelM blk a -> ModelM blk b -> ModelM blk b
forall a b. ModelM blk (a -> b) -> ModelM blk a -> ModelM blk b
forall blk a b. ModelM blk a -> ModelM blk b -> ModelM blk a
forall blk a b. ModelM blk a -> ModelM blk b -> ModelM blk b
forall blk a b. ModelM blk (a -> b) -> ModelM blk a -> ModelM blk b
forall a b c.
(a -> b -> c) -> ModelM blk a -> ModelM blk b -> ModelM blk c
forall blk a b c.
(a -> b -> c) -> ModelM blk a -> ModelM blk b -> ModelM blk c
forall (f :: * -> *).
Functor f =>
(forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
$cpure :: forall blk a. a -> ModelM blk a
pure :: forall a. a -> ModelM blk a
$c<*> :: forall blk a b. ModelM blk (a -> b) -> ModelM blk a -> ModelM blk b
<*> :: forall a b. ModelM blk (a -> b) -> ModelM blk a -> ModelM blk b
$cliftA2 :: forall blk a b c.
(a -> b -> c) -> ModelM blk a -> ModelM blk b -> ModelM blk c
liftA2 :: forall a b c.
(a -> b -> c) -> ModelM blk a -> ModelM blk b -> ModelM blk c
$c*> :: forall blk a b. ModelM blk a -> ModelM blk b -> ModelM blk b
*> :: forall a b. ModelM blk a -> ModelM blk b -> ModelM blk b
$c<* :: forall blk a b. ModelM blk a -> ModelM blk b -> ModelM blk a
<* :: forall a b. ModelM blk a -> ModelM blk b -> ModelM blk a
Applicative, Applicative (ModelM blk)
Applicative (ModelM blk) =>
(forall a b. ModelM blk a -> (a -> ModelM blk b) -> ModelM blk b)
-> (forall a b. ModelM blk a -> ModelM blk b -> ModelM blk b)
-> (forall a. a -> ModelM blk a)
-> Monad (ModelM blk)
forall blk. Applicative (ModelM blk)
forall a. a -> ModelM blk a
forall blk a. a -> ModelM blk a
forall a b. ModelM blk a -> ModelM blk b -> ModelM blk b
forall a b. ModelM blk a -> (a -> ModelM blk b) -> ModelM blk b
forall blk a b. ModelM blk a -> ModelM blk b -> ModelM blk b
forall blk a b. ModelM blk a -> (a -> ModelM blk b) -> ModelM blk b
forall (m :: * -> *).
Applicative m =>
(forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
$c>>= :: forall blk a b. ModelM blk a -> (a -> ModelM blk b) -> ModelM blk b
>>= :: forall a b. ModelM blk a -> (a -> ModelM blk b) -> ModelM blk b
$c>> :: forall blk a b. ModelM blk a -> ModelM blk b -> ModelM blk b
>> :: forall a b. ModelM blk a -> ModelM blk b -> ModelM blk b
$creturn :: forall blk a. a -> ModelM blk a
return :: forall a. a -> ModelM blk a
Monad,
                      MonadReader (TopLevelConfig blk),
                      MonadState (Model blk), MonadError TestFailure)


runModel ::
     Model blk
  -> TopLevelConfig blk
  -> ModelM blk b
  -> Either TestFailure b
runModel :: forall blk b.
Model blk
-> TopLevelConfig blk -> ModelM blk b -> Either TestFailure b
runModel Model blk
model TopLevelConfig blk
topLevelConfig ModelM blk b
expr
  = Except TestFailure b -> Either TestFailure b
forall e a. Except e a -> Either e a
runExcept (ReaderT (TopLevelConfig blk) (Except TestFailure) b
-> TopLevelConfig blk -> Except TestFailure b
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (StateT
  (Model blk) (ReaderT (TopLevelConfig blk) (Except TestFailure)) b
-> Model blk -> ReaderT (TopLevelConfig blk) (Except TestFailure) b
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
evalStateT (ModelM blk b
-> StateT
     (Model blk) (ReaderT (TopLevelConfig blk) (Except TestFailure)) b
forall blk a.
ModelM blk a
-> StateT
     (Model blk) (ReaderT (TopLevelConfig blk) (Except TestFailure)) a
runModelM ModelM blk b
expr) Model blk
model) TopLevelConfig blk
topLevelConfig)


withModelContext :: (Model blk -> TopLevelConfig blk -> (a, Model blk)) -> ModelM blk a
withModelContext :: forall blk a.
(Model blk -> TopLevelConfig blk -> (a, Model blk)) -> ModelM blk a
withModelContext Model blk -> TopLevelConfig blk -> (a, Model blk)
f = do
  Model blk
model <- ModelM blk (Model blk)
forall s (m :: * -> *). MonadState s m => m s
get
  TopLevelConfig blk
topLevelConfig <- ModelM blk (TopLevelConfig blk)
forall r (m :: * -> *). MonadReader r m => m r
ask
  let (a
a, Model blk
model') = Model blk -> TopLevelConfig blk -> (a, Model blk)
f Model blk
model TopLevelConfig blk
topLevelConfig
  Model blk -> ModelM blk ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put Model blk
model'
  a -> ModelM blk a
forall a. a -> ModelM blk a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
a


instance (Model.ModelSupportsBlock blk, LedgerSupportsProtocol blk)
      => SupportsUnitTest (ModelM blk) where

  type FollowerId (ModelM blk) = Model.FollowerId
  type IteratorId (ModelM blk) = Model.IteratorId
  type Block (ModelM blk) = blk

  newFollower :: ModelM blk (FollowerId (ModelM blk))
newFollower = (Model blk
 -> TopLevelConfig blk -> (FollowerId (ModelM blk), Model blk))
-> ModelM blk (FollowerId (ModelM blk))
forall blk a.
(Model blk -> TopLevelConfig blk -> (a, Model blk)) -> ModelM blk a
withModelContext ((Model blk
  -> TopLevelConfig blk -> (FollowerId (ModelM blk), Model blk))
 -> ModelM blk (FollowerId (ModelM blk)))
-> (Model blk
    -> TopLevelConfig blk -> (FollowerId (ModelM blk), Model blk))
-> ModelM blk (FollowerId (ModelM blk))
forall a b. (a -> b) -> a -> b
$ \Model blk
model TopLevelConfig blk
_ ->
    Model blk -> (Int, Model blk)
forall blk. HasHeader blk => Model blk -> (Int, Model blk)
Model.newFollower Model blk
model

  followerInstruction :: FollowerId (ModelM blk)
-> ModelM
     blk
     (Either
        (ChainDbError (Block (ModelM blk)))
        (Maybe
           (ChainUpdate
              (Block (ModelM blk)) (AllComponents (Block (ModelM blk))))))
followerInstruction FollowerId (ModelM blk)
followerId = (Model blk
 -> TopLevelConfig blk
 -> (Either
       (ChainDbError (Block (ModelM blk)))
       (Maybe
          (ChainUpdate
             (Block (ModelM blk)) (AllComponents (Block (ModelM blk))))),
     Model blk))
-> ModelM
     blk
     (Either
        (ChainDbError (Block (ModelM blk)))
        (Maybe
           (ChainUpdate
              (Block (ModelM blk)) (AllComponents (Block (ModelM blk))))))
forall blk a.
(Model blk -> TopLevelConfig blk -> (a, Model blk)) -> ModelM blk a
withModelContext ((Model blk
  -> TopLevelConfig blk
  -> (Either
        (ChainDbError (Block (ModelM blk)))
        (Maybe
           (ChainUpdate
              (Block (ModelM blk)) (AllComponents (Block (ModelM blk))))),
      Model blk))
 -> ModelM
      blk
      (Either
         (ChainDbError (Block (ModelM blk)))
         (Maybe
            (ChainUpdate
               (Block (ModelM blk)) (AllComponents (Block (ModelM blk)))))))
-> (Model blk
    -> TopLevelConfig blk
    -> (Either
          (ChainDbError (Block (ModelM blk)))
          (Maybe
             (ChainUpdate
                (Block (ModelM blk)) (AllComponents (Block (ModelM blk))))),
        Model blk))
-> ModelM
     blk
     (Either
        (ChainDbError (Block (ModelM blk)))
        (Maybe
           (ChainUpdate
              (Block (ModelM blk)) (AllComponents (Block (ModelM blk))))))
forall a b. (a -> b) -> a -> b
$ \Model blk
model TopLevelConfig blk
_ ->
    case Int
-> BlockComponent
     blk
     (blk, blk, Header blk, ByteString, ByteString, HeaderHash blk,
      SlotNo, IsEBB, SizeInBytes, Word16,
      SomeSecond (NestedCtxt Header) blk)
-> Model blk
-> Either
     (ChainDbError blk)
     (Maybe
        (ChainUpdate
           blk
           (blk, blk, Header blk, ByteString, ByteString, HeaderHash blk,
            SlotNo, IsEBB, SizeInBytes, Word16,
            SomeSecond (NestedCtxt Header) blk)),
      Model blk)
forall blk b.
ModelSupportsBlock blk =>
Int
-> BlockComponent blk b
-> Model blk
-> Either (ChainDbError blk) (Maybe (ChainUpdate blk b), Model blk)
Model.followerInstruction Int
FollowerId (ModelM blk)
followerId BlockComponent
  blk
  (blk, blk, Header blk, ByteString, ByteString, HeaderHash blk,
   SlotNo, IsEBB, SizeInBytes, Word16,
   SomeSecond (NestedCtxt Header) blk)
forall blk. BlockComponent blk (AllComponents blk)
allComponents Model blk
model of
      Left ChainDbError blk
err                     -> (ChainDbError blk
-> Either
     (ChainDbError blk)
     (Maybe
        (ChainUpdate
           blk
           (blk, blk, Header blk, ByteString, ByteString, HeaderHash blk,
            SlotNo, IsEBB, SizeInBytes, Word16,
            SomeSecond (NestedCtxt Header) blk)))
forall a b. a -> Either a b
Left ChainDbError blk
err, Model blk
model)
      Right (Maybe
  (ChainUpdate
     blk
     (blk, blk, Header blk, ByteString, ByteString, HeaderHash blk,
      SlotNo, IsEBB, SizeInBytes, Word16,
      SomeSecond (NestedCtxt Header) blk))
mChainUpdate, Model blk
model') -> (Maybe
  (ChainUpdate
     blk
     (blk, blk, Header blk, ByteString, ByteString, HeaderHash blk,
      SlotNo, IsEBB, SizeInBytes, Word16,
      SomeSecond (NestedCtxt Header) blk))
-> Either
     (ChainDbError blk)
     (Maybe
        (ChainUpdate
           blk
           (blk, blk, Header blk, ByteString, ByteString, HeaderHash blk,
            SlotNo, IsEBB, SizeInBytes, Word16,
            SomeSecond (NestedCtxt Header) blk)))
forall a b. b -> Either a b
Right Maybe
  (ChainUpdate
     blk
     (blk, blk, Header blk, ByteString, ByteString, HeaderHash blk,
      SlotNo, IsEBB, SizeInBytes, Word16,
      SomeSecond (NestedCtxt Header) blk))
mChainUpdate, Model blk
model')

  addBlock :: Block (ModelM blk) -> ModelM blk (Block (ModelM blk))
addBlock Block (ModelM blk)
blk = do
    -- Ensure that blocks are not characterized as invalid because they are
    -- from the future.
    (Model blk -> Model blk) -> ModelM blk ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((Model blk -> Model blk) -> ModelM blk ())
-> (Model blk -> Model blk) -> ModelM blk ()
forall a b. (a -> b) -> a -> b
$ \Model blk
model -> Model blk
model { Model.currentSlot = blockSlot blk }
    (Model blk -> TopLevelConfig blk -> ((), Model blk))
-> ModelM blk ()
forall blk a.
(Model blk -> TopLevelConfig blk -> (a, Model blk)) -> ModelM blk a
withModelContext ((Model blk -> TopLevelConfig blk -> ((), Model blk))
 -> ModelM blk ())
-> (Model blk -> TopLevelConfig blk -> ((), Model blk))
-> ModelM blk ()
forall a b. (a -> b) -> a -> b
$ \Model blk
model TopLevelConfig blk
cfg -> ((), TopLevelConfig blk -> blk -> Model blk -> Model blk
forall blk.
LedgerSupportsProtocol blk =>
TopLevelConfig blk -> blk -> Model blk -> Model blk
Model.addBlock TopLevelConfig blk
cfg blk
Block (ModelM blk)
blk Model blk
model)
    blk -> ModelM blk blk
forall a. a -> ModelM blk a
forall (f :: * -> *) a. Applicative f => a -> f a
pure blk
Block (ModelM blk)
blk

  followerForward :: FollowerId (ModelM blk)
-> [Point (Block (ModelM blk))]
-> ModelM
     blk
     (Either
        (ChainDbError (Block (ModelM blk)))
        (Maybe (Point (Block (ModelM blk)))))
followerForward FollowerId (ModelM blk)
followerId [Point (Block (ModelM blk))]
points = (Model blk
 -> TopLevelConfig blk
 -> (Either
       (ChainDbError (Block (ModelM blk)))
       (Maybe (Point (Block (ModelM blk)))),
     Model blk))
-> ModelM
     blk
     (Either
        (ChainDbError (Block (ModelM blk)))
        (Maybe (Point (Block (ModelM blk)))))
forall blk a.
(Model blk -> TopLevelConfig blk -> (a, Model blk)) -> ModelM blk a
withModelContext ((Model blk
  -> TopLevelConfig blk
  -> (Either
        (ChainDbError (Block (ModelM blk)))
        (Maybe (Point (Block (ModelM blk)))),
      Model blk))
 -> ModelM
      blk
      (Either
         (ChainDbError (Block (ModelM blk)))
         (Maybe (Point (Block (ModelM blk))))))
-> (Model blk
    -> TopLevelConfig blk
    -> (Either
          (ChainDbError (Block (ModelM blk)))
          (Maybe (Point (Block (ModelM blk)))),
        Model blk))
-> ModelM
     blk
     (Either
        (ChainDbError (Block (ModelM blk)))
        (Maybe (Point (Block (ModelM blk)))))
forall a b. (a -> b) -> a -> b
$ \Model blk
model TopLevelConfig blk
_ ->
    case Int
-> [Point blk]
-> Model blk
-> Either (ChainDbError blk) (Maybe (Point blk), Model blk)
forall blk.
HasHeader blk =>
Int
-> [Point blk]
-> Model blk
-> Either (ChainDbError blk) (Maybe (Point blk), Model blk)
Model.followerForward Int
FollowerId (ModelM blk)
followerId [Point blk]
[Point (Block (ModelM blk))]
points Model blk
model of
      Left ChainDbError blk
err                     -> (ChainDbError blk -> Either (ChainDbError blk) (Maybe (Point blk))
forall a b. a -> Either a b
Left ChainDbError blk
err, Model blk
model)
      Right (Maybe (Point blk)
mChainUpdate, Model blk
model') -> (Maybe (Point blk) -> Either (ChainDbError blk) (Maybe (Point blk))
forall a b. b -> Either a b
Right Maybe (Point blk)
mChainUpdate, Model blk
model')

  persistBlks :: ShouldGarbageCollect -> ModelM blk ()
persistBlks ShouldGarbageCollect
shouldGarbageCollect = (Model blk -> TopLevelConfig blk -> ((), Model blk))
-> ModelM blk ()
forall blk a.
(Model blk -> TopLevelConfig blk -> (a, Model blk)) -> ModelM blk a
withModelContext ((Model blk -> TopLevelConfig blk -> ((), Model blk))
 -> ModelM blk ())
-> (Model blk -> TopLevelConfig blk -> ((), Model blk))
-> ModelM blk ()
forall a b. (a -> b) -> a -> b
$ \Model blk
model TopLevelConfig blk
cfg ->
    do
      let k :: SecurityParam
k = TopLevelConfig blk -> SecurityParam
forall blk.
ConsensusProtocol (BlockProtocol blk) =>
TopLevelConfig blk -> SecurityParam
configSecurityParam TopLevelConfig blk
cfg
      Model blk -> ((), Model blk)
forall a. a -> ((), a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Model blk -> ((), Model blk)) -> Model blk -> ((), Model blk)
forall a b. (a -> b) -> a -> b
$ SecurityParam -> ShouldGarbageCollect -> Model blk -> Model blk
forall blk.
HasHeader blk =>
SecurityParam -> ShouldGarbageCollect -> Model blk -> Model blk
Model.copyToImmutableDB SecurityParam
k ShouldGarbageCollect
shouldGarbageCollect Model blk
model

  stream :: StreamFrom (Block (ModelM blk))
-> StreamTo (Block (ModelM blk))
-> ModelM
     blk
     (Either
        (ChainDbError (Block (ModelM blk)))
        (Either
           (UnknownRange (Block (ModelM blk))) (IteratorId (ModelM blk))))
stream StreamFrom (Block (ModelM blk))
from StreamTo (Block (ModelM blk))
to = (Model blk
 -> TopLevelConfig blk
 -> (Either
       (ChainDbError (Block (ModelM blk)))
       (Either
          (UnknownRange (Block (ModelM blk))) (IteratorId (ModelM blk))),
     Model blk))
-> ModelM
     blk
     (Either
        (ChainDbError (Block (ModelM blk)))
        (Either
           (UnknownRange (Block (ModelM blk))) (IteratorId (ModelM blk))))
forall blk a.
(Model blk -> TopLevelConfig blk -> (a, Model blk)) -> ModelM blk a
withModelContext ((Model blk
  -> TopLevelConfig blk
  -> (Either
        (ChainDbError (Block (ModelM blk)))
        (Either
           (UnknownRange (Block (ModelM blk))) (IteratorId (ModelM blk))),
      Model blk))
 -> ModelM
      blk
      (Either
         (ChainDbError (Block (ModelM blk)))
         (Either
            (UnknownRange (Block (ModelM blk))) (IteratorId (ModelM blk)))))
-> (Model blk
    -> TopLevelConfig blk
    -> (Either
          (ChainDbError (Block (ModelM blk)))
          (Either
             (UnknownRange (Block (ModelM blk))) (IteratorId (ModelM blk))),
        Model blk))
-> ModelM
     blk
     (Either
        (ChainDbError (Block (ModelM blk)))
        (Either
           (UnknownRange (Block (ModelM blk))) (IteratorId (ModelM blk))))
forall a b. (a -> b) -> a -> b
$ \Model blk
model TopLevelConfig blk
cfg ->
    do
      let k :: SecurityParam
k = TopLevelConfig blk -> SecurityParam
forall blk.
ConsensusProtocol (BlockProtocol blk) =>
TopLevelConfig blk -> SecurityParam
configSecurityParam TopLevelConfig blk
cfg
      case SecurityParam
-> StreamFrom blk
-> StreamTo blk
-> Model blk
-> Either
     (ChainDbError blk) (Either (UnknownRange blk) Int, Model blk)
forall blk.
GetPrevHash blk =>
SecurityParam
-> StreamFrom blk
-> StreamTo blk
-> Model blk
-> Either
     (ChainDbError blk) (Either (UnknownRange blk) Int, Model blk)
Model.stream SecurityParam
k StreamFrom blk
StreamFrom (Block (ModelM blk))
from StreamTo blk
StreamTo (Block (ModelM blk))
to Model blk
model of
        Left ChainDbError blk
err               -> (ChainDbError blk
-> Either (ChainDbError blk) (Either (UnknownRange blk) Int)
forall a b. a -> Either a b
Left ChainDbError blk
err, Model blk
model)
        Right (Either (UnknownRange blk) Int
result, Model blk
model') -> (Either (UnknownRange blk) Int
-> Either (ChainDbError blk) (Either (UnknownRange blk) Int)
forall a b. b -> Either a b
Right Either (UnknownRange blk) Int
result, Model blk
model')

  iteratorNext :: IteratorId (ModelM blk)
-> ModelM
     blk
     (IteratorResult
        (Block (ModelM blk)) (AllComponents (Block (ModelM blk))))
iteratorNext IteratorId (ModelM blk)
iteratorId = (Model blk
 -> TopLevelConfig blk
 -> (IteratorResult
       (Block (ModelM blk)) (AllComponents (Block (ModelM blk))),
     Model blk))
-> ModelM
     blk
     (IteratorResult
        (Block (ModelM blk)) (AllComponents (Block (ModelM blk))))
forall blk a.
(Model blk -> TopLevelConfig blk -> (a, Model blk)) -> ModelM blk a
withModelContext ((Model blk
  -> TopLevelConfig blk
  -> (IteratorResult
        (Block (ModelM blk)) (AllComponents (Block (ModelM blk))),
      Model blk))
 -> ModelM
      blk
      (IteratorResult
         (Block (ModelM blk)) (AllComponents (Block (ModelM blk)))))
-> (Model blk
    -> TopLevelConfig blk
    -> (IteratorResult
          (Block (ModelM blk)) (AllComponents (Block (ModelM blk))),
        Model blk))
-> ModelM
     blk
     (IteratorResult
        (Block (ModelM blk)) (AllComponents (Block (ModelM blk))))
forall a b. (a -> b) -> a -> b
$ \Model blk
model TopLevelConfig blk
_ ->
    Int
-> BlockComponent
     blk
     (blk, blk, Header blk, ByteString, ByteString, HeaderHash blk,
      SlotNo, IsEBB, SizeInBytes, Word16,
      SomeSecond (NestedCtxt Header) blk)
-> Model blk
-> (IteratorResult
      blk
      (blk, blk, Header blk, ByteString, ByteString, HeaderHash blk,
       SlotNo, IsEBB, SizeInBytes, Word16,
       SomeSecond (NestedCtxt Header) blk),
    Model blk)
forall blk b.
ModelSupportsBlock blk =>
Int
-> BlockComponent blk b
-> Model blk
-> (IteratorResult blk b, Model blk)
Model.iteratorNext Int
IteratorId (ModelM blk)
iteratorId BlockComponent
  blk
  (blk, blk, Header blk, ByteString, ByteString, HeaderHash blk,
   SlotNo, IsEBB, SizeInBytes, Word16,
   SomeSecond (NestedCtxt Header) blk)
forall blk. BlockComponent blk (AllComponents blk)
allComponents Model blk
model

{-------------------------------------------------------------------------------
  System
-------------------------------------------------------------------------------}

-- | Tests against the actual chain database run in this monad.
newtype SystemM blk m a = SystemM
  { forall blk (m :: * -> *) a.
SystemM blk m a
-> ReaderT (ChainDBEnv m blk) (ExceptT TestFailure m) a
runSystemM :: ReaderT (ChainDBEnv m blk) (ExceptT TestFailure m) a
  } deriving newtype ((forall a b. (a -> b) -> SystemM blk m a -> SystemM blk m b)
-> (forall a b. a -> SystemM blk m b -> SystemM blk m a)
-> Functor (SystemM blk m)
forall a b. a -> SystemM blk m b -> SystemM blk m a
forall a b. (a -> b) -> SystemM blk m a -> SystemM blk m b
forall blk (m :: * -> *) a b.
Functor m =>
a -> SystemM blk m b -> SystemM blk m a
forall blk (m :: * -> *) a b.
Functor m =>
(a -> b) -> SystemM blk m a -> SystemM blk m b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall blk (m :: * -> *) a b.
Functor m =>
(a -> b) -> SystemM blk m a -> SystemM blk m b
fmap :: forall a b. (a -> b) -> SystemM blk m a -> SystemM blk m b
$c<$ :: forall blk (m :: * -> *) a b.
Functor m =>
a -> SystemM blk m b -> SystemM blk m a
<$ :: forall a b. a -> SystemM blk m b -> SystemM blk m a
Functor, Functor (SystemM blk m)
Functor (SystemM blk m) =>
(forall a. a -> SystemM blk m a)
-> (forall a b.
    SystemM blk m (a -> b) -> SystemM blk m a -> SystemM blk m b)
-> (forall a b c.
    (a -> b -> c)
    -> SystemM blk m a -> SystemM blk m b -> SystemM blk m c)
-> (forall a b.
    SystemM blk m a -> SystemM blk m b -> SystemM blk m b)
-> (forall a b.
    SystemM blk m a -> SystemM blk m b -> SystemM blk m a)
-> Applicative (SystemM blk m)
forall a. a -> SystemM blk m a
forall a b. SystemM blk m a -> SystemM blk m b -> SystemM blk m a
forall a b. SystemM blk m a -> SystemM blk m b -> SystemM blk m b
forall a b.
SystemM blk m (a -> b) -> SystemM blk m a -> SystemM blk m b
forall a b c.
(a -> b -> c)
-> SystemM blk m a -> SystemM blk m b -> SystemM blk m c
forall blk (m :: * -> *). Monad m => Functor (SystemM blk m)
forall blk (m :: * -> *) a. Monad m => a -> SystemM blk m a
forall blk (m :: * -> *) a b.
Monad m =>
SystemM blk m a -> SystemM blk m b -> SystemM blk m a
forall blk (m :: * -> *) a b.
Monad m =>
SystemM blk m a -> SystemM blk m b -> SystemM blk m b
forall blk (m :: * -> *) a b.
Monad m =>
SystemM blk m (a -> b) -> SystemM blk m a -> SystemM blk m b
forall blk (m :: * -> *) a b c.
Monad m =>
(a -> b -> c)
-> SystemM blk m a -> SystemM blk m b -> SystemM blk m c
forall (f :: * -> *).
Functor f =>
(forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
$cpure :: forall blk (m :: * -> *) a. Monad m => a -> SystemM blk m a
pure :: forall a. a -> SystemM blk m a
$c<*> :: forall blk (m :: * -> *) a b.
Monad m =>
SystemM blk m (a -> b) -> SystemM blk m a -> SystemM blk m b
<*> :: forall a b.
SystemM blk m (a -> b) -> SystemM blk m a -> SystemM blk m b
$cliftA2 :: forall blk (m :: * -> *) a b c.
Monad m =>
(a -> b -> c)
-> SystemM blk m a -> SystemM blk m b -> SystemM blk m c
liftA2 :: forall a b c.
(a -> b -> c)
-> SystemM blk m a -> SystemM blk m b -> SystemM blk m c
$c*> :: forall blk (m :: * -> *) a b.
Monad m =>
SystemM blk m a -> SystemM blk m b -> SystemM blk m b
*> :: forall a b. SystemM blk m a -> SystemM blk m b -> SystemM blk m b
$c<* :: forall blk (m :: * -> *) a b.
Monad m =>
SystemM blk m a -> SystemM blk m b -> SystemM blk m a
<* :: forall a b. SystemM blk m a -> SystemM blk m b -> SystemM blk m a
Applicative, Applicative (SystemM blk m)
Applicative (SystemM blk m) =>
(forall a b.
 SystemM blk m a -> (a -> SystemM blk m b) -> SystemM blk m b)
-> (forall a b.
    SystemM blk m a -> SystemM blk m b -> SystemM blk m b)
-> (forall a. a -> SystemM blk m a)
-> Monad (SystemM blk m)
forall a. a -> SystemM blk m a
forall a b. SystemM blk m a -> SystemM blk m b -> SystemM blk m b
forall a b.
SystemM blk m a -> (a -> SystemM blk m b) -> SystemM blk m b
forall blk (m :: * -> *). Monad m => Applicative (SystemM blk m)
forall blk (m :: * -> *) a. Monad m => a -> SystemM blk m a
forall blk (m :: * -> *) a b.
Monad m =>
SystemM blk m a -> SystemM blk m b -> SystemM blk m b
forall blk (m :: * -> *) a b.
Monad m =>
SystemM blk m a -> (a -> SystemM blk m b) -> SystemM blk m b
forall (m :: * -> *).
Applicative m =>
(forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
$c>>= :: forall blk (m :: * -> *) a b.
Monad m =>
SystemM blk m a -> (a -> SystemM blk m b) -> SystemM blk m b
>>= :: forall a b.
SystemM blk m a -> (a -> SystemM blk m b) -> SystemM blk m b
$c>> :: forall blk (m :: * -> *) a b.
Monad m =>
SystemM blk m a -> SystemM blk m b -> SystemM blk m b
>> :: forall a b. SystemM blk m a -> SystemM blk m b -> SystemM blk m b
$creturn :: forall blk (m :: * -> *) a. Monad m => a -> SystemM blk m a
return :: forall a. a -> SystemM blk m a
Monad,
                      MonadReader (ChainDBEnv m blk), MonadError TestFailure)


runSystem ::
     (forall a. (ChainDBEnv m blk -> m [TraceEvent blk] -> m a) -> m a)
  -> SystemM blk m b
  -> m (Either TestFailure b)
runSystem :: forall (m :: * -> *) blk b.
(forall a. (ChainDBEnv m blk -> m [TraceEvent blk] -> m a) -> m a)
-> SystemM blk m b -> m (Either TestFailure b)
runSystem forall a. (ChainDBEnv m blk -> m [TraceEvent blk] -> m a) -> m a
withChainDbEnv SystemM blk m b
expr
  = (ChainDBEnv m blk
 -> m [TraceEvent blk] -> m (Either TestFailure b))
-> m (Either TestFailure b)
forall a. (ChainDBEnv m blk -> m [TraceEvent blk] -> m a) -> m a
withChainDbEnv ((ChainDBEnv m blk
  -> m [TraceEvent blk] -> m (Either TestFailure b))
 -> m (Either TestFailure b))
-> (ChainDBEnv m blk
    -> m [TraceEvent blk] -> m (Either TestFailure b))
-> m (Either TestFailure b)
forall a b. (a -> b) -> a -> b
$ \ChainDBEnv m blk
env m [TraceEvent blk]
_getTrace ->
                       ExceptT TestFailure m b -> m (Either TestFailure b)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT TestFailure m b -> m (Either TestFailure b))
-> ExceptT TestFailure m b -> m (Either TestFailure b)
forall a b. (a -> b) -> a -> b
$ ReaderT (ChainDBEnv m blk) (ExceptT TestFailure m) b
-> ChainDBEnv m blk -> ExceptT TestFailure m b
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (SystemM blk m b
-> ReaderT (ChainDBEnv m blk) (ExceptT TestFailure m) b
forall blk (m :: * -> *) a.
SystemM blk m a
-> ReaderT (ChainDBEnv m blk) (ExceptT TestFailure m) a
runSystemM SystemM blk m b
expr) ChainDBEnv m blk
env


-- | Provide a standard ChainDbEnv for testing.
withTestChainDbEnv ::
     (IOLike m, TestConstraints blk)
  => TopLevelConfig blk
  -> ImmutableDB.ChunkInfo
  -> ExtLedgerState blk
  -> (ChainDBEnv m blk -> m [TraceEvent blk] -> m a)
  -> m a
withTestChainDbEnv :: forall (m :: * -> *) blk a.
(IOLike m, TestConstraints blk) =>
TopLevelConfig blk
-> ChunkInfo
-> ExtLedgerState blk
-> (ChainDBEnv m blk -> m [TraceEvent blk] -> m a)
-> m a
withTestChainDbEnv TopLevelConfig blk
topLevelConfig ChunkInfo
chunkInfo ExtLedgerState blk
extLedgerState ChainDBEnv m blk -> m [TraceEvent blk] -> m a
cont
  = m (ChainDBEnv m blk, m [TraceEvent blk])
-> ((ChainDBEnv m blk, m [TraceEvent blk]) -> m ())
-> ((ChainDBEnv m blk, m [TraceEvent blk]) -> m a)
-> m a
forall a b c. m a -> (a -> m b) -> (a -> m c) -> m c
forall (m :: * -> *) a b c.
MonadThrow m =>
m a -> (a -> m b) -> (a -> m c) -> m c
bracket m (ChainDBEnv m blk, m [TraceEvent blk])
openChainDbEnv (ChainDBEnv m blk, m [TraceEvent blk]) -> m ()
forall {m :: * -> *} {blk} {b}.
IOLike m =>
(ChainDBEnv m blk, b) -> m ()
closeChainDbEnv ((ChainDBEnv m blk -> m [TraceEvent blk] -> m a)
-> (ChainDBEnv m blk, m [TraceEvent blk]) -> m a
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry ChainDBEnv m blk -> m [TraceEvent blk] -> m a
cont)
  where
    openChainDbEnv :: m (ChainDBEnv m blk, m [TraceEvent blk])
openChainDbEnv = do
      ResourceRegistry m
threadRegistry <- m (ResourceRegistry m)
forall (m :: * -> *).
(IOLike m, HasCallStack) =>
m (ResourceRegistry m)
unsafeNewRegistry
      ResourceRegistry m
iteratorRegistry <- m (ResourceRegistry m)
forall (m :: * -> *).
(IOLike m, HasCallStack) =>
m (ResourceRegistry m)
unsafeNewRegistry
      StrictTVar m SlotNo
varCurSlot <- SlotNo -> m (StrictTVar m SlotNo)
forall (m :: * -> *) a. MonadSTM m => a -> m (StrictTVar m a)
uncheckedNewTVarM SlotNo
0
      StrictTVar m Id
varNextId <- Id -> m (StrictTVar m Id)
forall (m :: * -> *) a. MonadSTM m => a -> m (StrictTVar m a)
uncheckedNewTVarM Id
0
      StrictTVar
  m
  (AnchoredSeq
     (WithOrigin SlotNo) (Anchor (Header blk)) (Header blk))
varLoEFragment <- AnchoredSeq (WithOrigin SlotNo) (Anchor (Header blk)) (Header blk)
-> m (StrictTVar
        m
        (AnchoredSeq
           (WithOrigin SlotNo) (Anchor (Header blk)) (Header blk)))
forall (m :: * -> *) a.
(HasCallStack, MonadSTM m, NoThunks a) =>
a -> m (StrictTVar m a)
newTVarIO (AnchoredSeq (WithOrigin SlotNo) (Anchor (Header blk)) (Header blk)
 -> m (StrictTVar
         m
         (AnchoredSeq
            (WithOrigin SlotNo) (Anchor (Header blk)) (Header blk))))
-> AnchoredSeq
     (WithOrigin SlotNo) (Anchor (Header blk)) (Header blk)
-> m (StrictTVar
        m
        (AnchoredSeq
           (WithOrigin SlotNo) (Anchor (Header blk)) (Header blk)))
forall a b. (a -> b) -> a -> b
$ Anchor (Header blk)
-> AnchoredSeq
     (WithOrigin SlotNo) (Anchor (Header blk)) (Header blk)
forall v a b. Anchorable v a b => a -> AnchoredSeq v a b
AF.Empty Anchor (Header blk)
forall block. Anchor block
AF.AnchorGenesis
      NodeDBs (StrictTMVar m MockFS)
nodeDbs <- m (NodeDBs (StrictTMVar m MockFS))
forall (m :: * -> *).
MonadSTM m =>
m (NodeDBs (StrictTMVar m MockFS))
emptyNodeDBs
      (Tracer m (TraceEvent blk)
tracer, m [TraceEvent blk]
getTrace) <- m (Tracer m (TraceEvent blk), m [TraceEvent blk])
forall (m :: * -> *) ev. MonadSTM m => m (Tracer m ev, m [ev])
recordingTracerTVar
      let args :: ChainDbArgs Identity m blk
args = ResourceRegistry m
-> NodeDBs (StrictTMVar m MockFS)
-> Tracer m (TraceEvent blk)
-> ChainDbArgs Identity m blk
chainDbArgs ResourceRegistry m
threadRegistry NodeDBs (StrictTMVar m MockFS)
nodeDbs Tracer m (TraceEvent blk)
tracer
      StrictTVar m (ChainDBState m blk)
varDB <- ChainDbArgs Identity m blk -> m (ChainDBState m blk)
forall (m :: * -> *) blk.
(IOLike m, TestConstraints blk) =>
ChainDbArgs Identity m blk -> m (ChainDBState m blk)
open ChainDbArgs Identity m blk
args m (ChainDBState m blk)
-> (ChainDBState m blk -> m (StrictTVar m (ChainDBState m blk)))
-> m (StrictTVar m (ChainDBState m blk))
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ChainDBState m blk -> m (StrictTVar m (ChainDBState m blk))
forall (m :: * -> *) a.
(HasCallStack, MonadSTM m, NoThunks a) =>
a -> m (StrictTVar m a)
newTVarIO
      let env :: ChainDBEnv m blk
env = ChainDBEnv
            { StrictTVar m (ChainDBState m blk)
varDB :: StrictTVar m (ChainDBState m blk)
$sel:varDB:ChainDBEnv :: StrictTVar m (ChainDBState m blk)
varDB
            , $sel:registry:ChainDBEnv :: ResourceRegistry m
registry = ResourceRegistry m
iteratorRegistry
            , StrictTVar m SlotNo
varCurSlot :: StrictTVar m SlotNo
$sel:varCurSlot:ChainDBEnv :: StrictTVar m SlotNo
varCurSlot
            , StrictTVar m Id
varNextId :: StrictTVar m Id
$sel:varNextId:ChainDBEnv :: StrictTVar m Id
varNextId
            , $sel:varVolatileDbFs:ChainDBEnv :: StrictTMVar m MockFS
varVolatileDbFs = NodeDBs (StrictTMVar m MockFS) -> StrictTMVar m MockFS
forall db. NodeDBs db -> db
nodeDBsVol NodeDBs (StrictTMVar m MockFS)
nodeDbs
            , ChainDbArgs Identity m blk
args :: ChainDbArgs Identity m blk
$sel:args:ChainDBEnv :: ChainDbArgs Identity m blk
args
            , StrictTVar
  m
  (AnchoredSeq
     (WithOrigin SlotNo) (Anchor (Header blk)) (Header blk))
varLoEFragment :: StrictTVar
  m
  (AnchoredSeq
     (WithOrigin SlotNo) (Anchor (Header blk)) (Header blk))
$sel:varLoEFragment:ChainDBEnv :: StrictTVar
  m
  (AnchoredSeq
     (WithOrigin SlotNo) (Anchor (Header blk)) (Header blk))
varLoEFragment
            }
      (ChainDBEnv m blk, m [TraceEvent blk])
-> m (ChainDBEnv m blk, m [TraceEvent blk])
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ChainDBEnv m blk
env, m [TraceEvent blk]
getTrace)

    closeChainDbEnv :: (ChainDBEnv m blk, b) -> m ()
closeChainDbEnv (ChainDBEnv m blk
env, b
_) = do
      StrictTVar m (ChainDBState m blk) -> m (ChainDBState m blk)
forall (m :: * -> *) a. MonadSTM m => StrictTVar m a -> m a
readTVarIO (ChainDBEnv m blk -> StrictTVar m (ChainDBState m blk)
forall (m :: * -> *) blk.
ChainDBEnv m blk -> StrictTVar m (ChainDBState m blk)
varDB ChainDBEnv m blk
env) m (ChainDBState m blk) -> (ChainDBState m blk -> m ()) -> m ()
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ChainDBState m blk -> m ()
forall (m :: * -> *) blk. IOLike m => ChainDBState m blk -> m ()
close
      ResourceRegistry m -> m ()
forall (m :: * -> *).
(IOLike m, HasCallStack) =>
ResourceRegistry m -> m ()
closeRegistry (ChainDBEnv m blk -> ResourceRegistry m
forall (m :: * -> *) blk. ChainDBEnv m blk -> ResourceRegistry m
registry ChainDBEnv m blk
env)
      ResourceRegistry m -> m ()
forall (m :: * -> *).
(IOLike m, HasCallStack) =>
ResourceRegistry m -> m ()
closeRegistry (ChainDbSpecificArgs Identity m blk
-> HKD Identity (ResourceRegistry m)
forall (f :: * -> *) (m :: * -> *) blk.
ChainDbSpecificArgs f m blk -> HKD f (ResourceRegistry m)
cdbsRegistry (ChainDbSpecificArgs Identity m blk
 -> HKD Identity (ResourceRegistry m))
-> ChainDbSpecificArgs Identity m blk
-> HKD Identity (ResourceRegistry m)
forall a b. (a -> b) -> a -> b
$ ChainDbArgs Identity m blk -> ChainDbSpecificArgs Identity m blk
forall (f :: * -> *) (m :: * -> *) blk.
ChainDbArgs f m blk -> ChainDbSpecificArgs f m blk
cdbsArgs (ChainDbArgs Identity m blk -> ChainDbSpecificArgs Identity m blk)
-> ChainDbArgs Identity m blk -> ChainDbSpecificArgs Identity m blk
forall a b. (a -> b) -> a -> b
$ ChainDBEnv m blk -> ChainDbArgs Identity m blk
forall (m :: * -> *) blk.
ChainDBEnv m blk -> ChainDbArgs Identity m blk
args ChainDBEnv m blk
env)

    chainDbArgs :: ResourceRegistry m
-> NodeDBs (StrictTMVar m MockFS)
-> Tracer m (TraceEvent blk)
-> ChainDbArgs Identity m blk
chainDbArgs ResourceRegistry m
registry NodeDBs (StrictTMVar m MockFS)
nodeDbs Tracer m (TraceEvent blk)
tracer =
      let args :: ChainDbArgs Identity m blk
args = MinimalChainDbArgs m blk -> ChainDbArgs Identity m blk
forall (m :: * -> *) blk.
(MonadThrow m, MonadSTM m, ConsensusProtocol (BlockProtocol blk),
 PrimMonad m) =>
MinimalChainDbArgs m blk -> Complete ChainDbArgs m blk
fromMinimalChainDbArgs MinimalChainDbArgs
            { mcdbTopLevelConfig :: TopLevelConfig blk
mcdbTopLevelConfig = TopLevelConfig blk
topLevelConfig
            , mcdbChunkInfo :: ChunkInfo
mcdbChunkInfo = ChunkInfo
chunkInfo
            , mcdbInitLedger :: ExtLedgerState blk
mcdbInitLedger = ExtLedgerState blk
extLedgerState
            , mcdbRegistry :: ResourceRegistry m
mcdbRegistry = ResourceRegistry m
registry
            , mcdbNodeDBs :: NodeDBs (StrictTMVar m MockFS)
mcdbNodeDBs = NodeDBs (StrictTMVar m MockFS)
nodeDbs
            }
      in Tracer m (TraceEvent blk)
-> ChainDbArgs Identity m blk -> ChainDbArgs Identity m blk
forall (m :: * -> *) blk (f :: * -> *).
Tracer m (TraceEvent blk)
-> ChainDbArgs f m blk -> ChainDbArgs f m blk
ChainDB.updateTracer Tracer m (TraceEvent blk)
tracer ChainDbArgs Identity m blk
args


instance IOLike m => SupportsUnitTest (SystemM blk m) where

  type IteratorId (SystemM blk m) = API.Iterator m blk (AllComponents blk)
  type FollowerId (SystemM blk m) = API.Follower m blk (AllComponents blk)
  type Block (SystemM blk m) = blk

  addBlock :: Block (SystemM blk m) -> SystemM blk m (Block (SystemM blk m))
addBlock Block (SystemM blk m)
blk = do
    ChainDBEnv m blk
env <- SystemM blk m (ChainDBEnv m blk)
forall r (m :: * -> *). MonadReader r m => m r
ask
    ReaderT (ChainDBEnv m blk) (ExceptT TestFailure m) blk
-> SystemM blk m blk
forall blk (m :: * -> *) a.
ReaderT (ChainDBEnv m blk) (ExceptT TestFailure m) a
-> SystemM blk m a
SystemM (ReaderT (ChainDBEnv m blk) (ExceptT TestFailure m) blk
 -> SystemM blk m blk)
-> ReaderT (ChainDBEnv m blk) (ExceptT TestFailure m) blk
-> SystemM blk m blk
forall a b. (a -> b) -> a -> b
$ ExceptT TestFailure m blk
-> ReaderT (ChainDBEnv m blk) (ExceptT TestFailure m) blk
forall (m :: * -> *) a.
Monad m =>
m a -> ReaderT (ChainDBEnv m blk) m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ExceptT TestFailure m blk
 -> ReaderT (ChainDBEnv m blk) (ExceptT TestFailure m) blk)
-> ExceptT TestFailure m blk
-> ReaderT (ChainDBEnv m blk) (ExceptT TestFailure m) blk
forall a b. (a -> b) -> a -> b
$ m blk -> ExceptT TestFailure m blk
forall (m :: * -> *) a. Monad m => m a -> ExceptT TestFailure m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m blk -> ExceptT TestFailure m blk)
-> m blk -> ExceptT TestFailure m blk
forall a b. (a -> b) -> a -> b
$ do
      ChainDB m blk
api <- ChainDBState m blk -> ChainDB m blk
forall (m :: * -> *) blk. ChainDBState m blk -> ChainDB m blk
chainDB (ChainDBState m blk -> ChainDB m blk)
-> m (ChainDBState m blk) -> m (ChainDB m blk)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StrictTVar m (ChainDBState m blk) -> m (ChainDBState m blk)
forall (m :: * -> *) a. MonadSTM m => StrictTVar m a -> m a
readTVarIO (ChainDBEnv m blk -> StrictTVar m (ChainDBState m blk)
forall (m :: * -> *) blk.
ChainDBEnv m blk -> StrictTVar m (ChainDBState m blk)
varDB ChainDBEnv m blk
env)
      m (AddBlockResult blk) -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (m (AddBlockResult blk) -> m ()) -> m (AddBlockResult blk) -> m ()
forall a b. (a -> b) -> a -> b
$ ChainDB m blk
-> InvalidBlockPunishment m -> blk -> m (AddBlockResult blk)
forall (m :: * -> *) blk.
IOLike m =>
ChainDB m blk
-> InvalidBlockPunishment m -> blk -> m (AddBlockResult blk)
API.addBlock ChainDB m blk
api InvalidBlockPunishment m
forall (m :: * -> *). Applicative m => InvalidBlockPunishment m
API.noPunishment blk
Block (SystemM blk m)
blk
      blk -> m blk
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure blk
Block (SystemM blk m)
blk

  persistBlks :: ShouldGarbageCollect -> SystemM blk m ()
persistBlks ShouldGarbageCollect
shouldGarbageCollect = do
    ChainDBEnv m blk
env <- SystemM blk m (ChainDBEnv m blk)
forall r (m :: * -> *). MonadReader r m => m r
ask
    ReaderT (ChainDBEnv m blk) (ExceptT TestFailure m) ()
-> SystemM blk m ()
forall blk (m :: * -> *) a.
ReaderT (ChainDBEnv m blk) (ExceptT TestFailure m) a
-> SystemM blk m a
SystemM (ReaderT (ChainDBEnv m blk) (ExceptT TestFailure m) ()
 -> SystemM blk m ())
-> ReaderT (ChainDBEnv m blk) (ExceptT TestFailure m) ()
-> SystemM blk m ()
forall a b. (a -> b) -> a -> b
$ ExceptT TestFailure m ()
-> ReaderT (ChainDBEnv m blk) (ExceptT TestFailure m) ()
forall (m :: * -> *) a.
Monad m =>
m a -> ReaderT (ChainDBEnv m blk) m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ExceptT TestFailure m ()
 -> ReaderT (ChainDBEnv m blk) (ExceptT TestFailure m) ())
-> ExceptT TestFailure m ()
-> ReaderT (ChainDBEnv m blk) (ExceptT TestFailure m) ()
forall a b. (a -> b) -> a -> b
$ m () -> ExceptT TestFailure m ()
forall (m :: * -> *) a. Monad m => m a -> ExceptT TestFailure m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> ExceptT TestFailure m ())
-> m () -> ExceptT TestFailure m ()
forall a b. (a -> b) -> a -> b
$ do
      Internal m blk
internal <- ChainDBState m blk -> Internal m blk
forall (m :: * -> *) blk. ChainDBState m blk -> Internal m blk
internal (ChainDBState m blk -> Internal m blk)
-> m (ChainDBState m blk) -> m (Internal m blk)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StrictTVar m (ChainDBState m blk) -> m (ChainDBState m blk)
forall (m :: * -> *) a. MonadSTM m => StrictTVar m a -> m a
readTVarIO (ChainDBEnv m blk -> StrictTVar m (ChainDBState m blk)
forall (m :: * -> *) blk.
ChainDBEnv m blk -> StrictTVar m (ChainDBState m blk)
varDB ChainDBEnv m blk
env)
      ShouldGarbageCollect -> Internal m blk -> m ()
forall (m :: * -> *) blk.
IOLike m =>
ShouldGarbageCollect -> Internal m blk -> m ()
SM.persistBlks ShouldGarbageCollect
shouldGarbageCollect Internal m blk
internal

  newFollower :: SystemM blk m (FollowerId (SystemM blk m))
newFollower = do
    ChainDBEnv m blk
env <- SystemM blk m (ChainDBEnv m blk)
forall r (m :: * -> *). MonadReader r m => m r
ask
    ReaderT
  (ChainDBEnv m blk)
  (ExceptT TestFailure m)
  (Follower
     m
     blk
     (blk, blk, Header blk, ByteString, ByteString, HeaderHash blk,
      SlotNo, IsEBB, SizeInBytes, Word16,
      SomeSecond (NestedCtxt Header) blk))
-> SystemM
     blk
     m
     (Follower
        m
        blk
        (blk, blk, Header blk, ByteString, ByteString, HeaderHash blk,
         SlotNo, IsEBB, SizeInBytes, Word16,
         SomeSecond (NestedCtxt Header) blk))
forall blk (m :: * -> *) a.
ReaderT (ChainDBEnv m blk) (ExceptT TestFailure m) a
-> SystemM blk m a
SystemM (ReaderT
   (ChainDBEnv m blk)
   (ExceptT TestFailure m)
   (Follower
      m
      blk
      (blk, blk, Header blk, ByteString, ByteString, HeaderHash blk,
       SlotNo, IsEBB, SizeInBytes, Word16,
       SomeSecond (NestedCtxt Header) blk))
 -> SystemM
      blk
      m
      (Follower
         m
         blk
         (blk, blk, Header blk, ByteString, ByteString, HeaderHash blk,
          SlotNo, IsEBB, SizeInBytes, Word16,
          SomeSecond (NestedCtxt Header) blk)))
-> ReaderT
     (ChainDBEnv m blk)
     (ExceptT TestFailure m)
     (Follower
        m
        blk
        (blk, blk, Header blk, ByteString, ByteString, HeaderHash blk,
         SlotNo, IsEBB, SizeInBytes, Word16,
         SomeSecond (NestedCtxt Header) blk))
-> SystemM
     blk
     m
     (Follower
        m
        blk
        (blk, blk, Header blk, ByteString, ByteString, HeaderHash blk,
         SlotNo, IsEBB, SizeInBytes, Word16,
         SomeSecond (NestedCtxt Header) blk))
forall a b. (a -> b) -> a -> b
$ ExceptT
  TestFailure
  m
  (Follower
     m
     blk
     (blk, blk, Header blk, ByteString, ByteString, HeaderHash blk,
      SlotNo, IsEBB, SizeInBytes, Word16,
      SomeSecond (NestedCtxt Header) blk))
-> ReaderT
     (ChainDBEnv m blk)
     (ExceptT TestFailure m)
     (Follower
        m
        blk
        (blk, blk, Header blk, ByteString, ByteString, HeaderHash blk,
         SlotNo, IsEBB, SizeInBytes, Word16,
         SomeSecond (NestedCtxt Header) blk))
forall (m :: * -> *) a.
Monad m =>
m a -> ReaderT (ChainDBEnv m blk) m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ExceptT
   TestFailure
   m
   (Follower
      m
      blk
      (blk, blk, Header blk, ByteString, ByteString, HeaderHash blk,
       SlotNo, IsEBB, SizeInBytes, Word16,
       SomeSecond (NestedCtxt Header) blk))
 -> ReaderT
      (ChainDBEnv m blk)
      (ExceptT TestFailure m)
      (Follower
         m
         blk
         (blk, blk, Header blk, ByteString, ByteString, HeaderHash blk,
          SlotNo, IsEBB, SizeInBytes, Word16,
          SomeSecond (NestedCtxt Header) blk)))
-> ExceptT
     TestFailure
     m
     (Follower
        m
        blk
        (blk, blk, Header blk, ByteString, ByteString, HeaderHash blk,
         SlotNo, IsEBB, SizeInBytes, Word16,
         SomeSecond (NestedCtxt Header) blk))
-> ReaderT
     (ChainDBEnv m blk)
     (ExceptT TestFailure m)
     (Follower
        m
        blk
        (blk, blk, Header blk, ByteString, ByteString, HeaderHash blk,
         SlotNo, IsEBB, SizeInBytes, Word16,
         SomeSecond (NestedCtxt Header) blk))
forall a b. (a -> b) -> a -> b
$ m (Follower
     m
     blk
     (blk, blk, Header blk, ByteString, ByteString, HeaderHash blk,
      SlotNo, IsEBB, SizeInBytes, Word16,
      SomeSecond (NestedCtxt Header) blk))
-> ExceptT
     TestFailure
     m
     (Follower
        m
        blk
        (blk, blk, Header blk, ByteString, ByteString, HeaderHash blk,
         SlotNo, IsEBB, SizeInBytes, Word16,
         SomeSecond (NestedCtxt Header) blk))
forall (m :: * -> *) a. Monad m => m a -> ExceptT TestFailure m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (Follower
      m
      blk
      (blk, blk, Header blk, ByteString, ByteString, HeaderHash blk,
       SlotNo, IsEBB, SizeInBytes, Word16,
       SomeSecond (NestedCtxt Header) blk))
 -> ExceptT
      TestFailure
      m
      (Follower
         m
         blk
         (blk, blk, Header blk, ByteString, ByteString, HeaderHash blk,
          SlotNo, IsEBB, SizeInBytes, Word16,
          SomeSecond (NestedCtxt Header) blk)))
-> m (Follower
        m
        blk
        (blk, blk, Header blk, ByteString, ByteString, HeaderHash blk,
         SlotNo, IsEBB, SizeInBytes, Word16,
         SomeSecond (NestedCtxt Header) blk))
-> ExceptT
     TestFailure
     m
     (Follower
        m
        blk
        (blk, blk, Header blk, ByteString, ByteString, HeaderHash blk,
         SlotNo, IsEBB, SizeInBytes, Word16,
         SomeSecond (NestedCtxt Header) blk))
forall a b. (a -> b) -> a -> b
$ do
      ChainDB m blk
api <- ChainDBState m blk -> ChainDB m blk
forall (m :: * -> *) blk. ChainDBState m blk -> ChainDB m blk
chainDB (ChainDBState m blk -> ChainDB m blk)
-> m (ChainDBState m blk) -> m (ChainDB m blk)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StrictTVar m (ChainDBState m blk) -> m (ChainDBState m blk)
forall (m :: * -> *) a. MonadSTM m => StrictTVar m a -> m a
readTVarIO (ChainDBEnv m blk -> StrictTVar m (ChainDBState m blk)
forall (m :: * -> *) blk.
ChainDBEnv m blk -> StrictTVar m (ChainDBState m blk)
varDB ChainDBEnv m blk
env)
      ChainDB m blk
-> forall b.
   ResourceRegistry m
   -> ChainType -> BlockComponent blk b -> m (Follower m blk b)
forall (m :: * -> *) blk.
ChainDB m blk
-> forall b.
   ResourceRegistry m
   -> ChainType -> BlockComponent blk b -> m (Follower m blk b)
API.newFollower ChainDB m blk
api (ChainDBEnv m blk -> ResourceRegistry m
forall (m :: * -> *) blk. ChainDBEnv m blk -> ResourceRegistry m
registry ChainDBEnv m blk
env) ChainType
API.SelectedChain BlockComponent
  blk
  (blk, blk, Header blk, ByteString, ByteString, HeaderHash blk,
   SlotNo, IsEBB, SizeInBytes, Word16,
   SomeSecond (NestedCtxt Header) blk)
forall blk. BlockComponent blk (AllComponents blk)
allComponents

  followerInstruction :: FollowerId (SystemM blk m)
-> SystemM
     blk
     m
     (Either
        (ChainDbError (Block (SystemM blk m)))
        (Maybe
           (ChainUpdate
              (Block (SystemM blk m)) (AllComponents (Block (SystemM blk m))))))
followerInstruction = ReaderT
  (ChainDBEnv m blk)
  (ExceptT TestFailure m)
  (Either
     (ChainDbError blk)
     (Maybe
        (ChainUpdate
           blk
           (blk, blk, Header blk, ByteString, ByteString, HeaderHash blk,
            SlotNo, IsEBB, SizeInBytes, Word16,
            SomeSecond (NestedCtxt Header) blk))))
-> SystemM
     blk
     m
     (Either
        (ChainDbError blk)
        (Maybe
           (ChainUpdate
              blk
              (blk, blk, Header blk, ByteString, ByteString, HeaderHash blk,
               SlotNo, IsEBB, SizeInBytes, Word16,
               SomeSecond (NestedCtxt Header) blk))))
forall blk (m :: * -> *) a.
ReaderT (ChainDBEnv m blk) (ExceptT TestFailure m) a
-> SystemM blk m a
SystemM (ReaderT
   (ChainDBEnv m blk)
   (ExceptT TestFailure m)
   (Either
      (ChainDbError blk)
      (Maybe
         (ChainUpdate
            blk
            (blk, blk, Header blk, ByteString, ByteString, HeaderHash blk,
             SlotNo, IsEBB, SizeInBytes, Word16,
             SomeSecond (NestedCtxt Header) blk))))
 -> SystemM
      blk
      m
      (Either
         (ChainDbError blk)
         (Maybe
            (ChainUpdate
               blk
               (blk, blk, Header blk, ByteString, ByteString, HeaderHash blk,
                SlotNo, IsEBB, SizeInBytes, Word16,
                SomeSecond (NestedCtxt Header) blk)))))
-> (m (Maybe
         (ChainUpdate
            blk
            (blk, blk, Header blk, ByteString, ByteString, HeaderHash blk,
             SlotNo, IsEBB, SizeInBytes, Word16,
             SomeSecond (NestedCtxt Header) blk)))
    -> ReaderT
         (ChainDBEnv m blk)
         (ExceptT TestFailure m)
         (Either
            (ChainDbError blk)
            (Maybe
               (ChainUpdate
                  blk
                  (blk, blk, Header blk, ByteString, ByteString, HeaderHash blk,
                   SlotNo, IsEBB, SizeInBytes, Word16,
                   SomeSecond (NestedCtxt Header) blk)))))
-> m (Maybe
        (ChainUpdate
           blk
           (blk, blk, Header blk, ByteString, ByteString, HeaderHash blk,
            SlotNo, IsEBB, SizeInBytes, Word16,
            SomeSecond (NestedCtxt Header) blk)))
-> SystemM
     blk
     m
     (Either
        (ChainDbError blk)
        (Maybe
           (ChainUpdate
              blk
              (blk, blk, Header blk, ByteString, ByteString, HeaderHash blk,
               SlotNo, IsEBB, SizeInBytes, Word16,
               SomeSecond (NestedCtxt Header) blk))))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ExceptT
  TestFailure
  m
  (Either
     (ChainDbError blk)
     (Maybe
        (ChainUpdate
           blk
           (blk, blk, Header blk, ByteString, ByteString, HeaderHash blk,
            SlotNo, IsEBB, SizeInBytes, Word16,
            SomeSecond (NestedCtxt Header) blk))))
-> ReaderT
     (ChainDBEnv m blk)
     (ExceptT TestFailure m)
     (Either
        (ChainDbError blk)
        (Maybe
           (ChainUpdate
              blk
              (blk, blk, Header blk, ByteString, ByteString, HeaderHash blk,
               SlotNo, IsEBB, SizeInBytes, Word16,
               SomeSecond (NestedCtxt Header) blk))))
forall (m :: * -> *) a.
Monad m =>
m a -> ReaderT (ChainDBEnv m blk) m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ExceptT
   TestFailure
   m
   (Either
      (ChainDbError blk)
      (Maybe
         (ChainUpdate
            blk
            (blk, blk, Header blk, ByteString, ByteString, HeaderHash blk,
             SlotNo, IsEBB, SizeInBytes, Word16,
             SomeSecond (NestedCtxt Header) blk))))
 -> ReaderT
      (ChainDBEnv m blk)
      (ExceptT TestFailure m)
      (Either
         (ChainDbError blk)
         (Maybe
            (ChainUpdate
               blk
               (blk, blk, Header blk, ByteString, ByteString, HeaderHash blk,
                SlotNo, IsEBB, SizeInBytes, Word16,
                SomeSecond (NestedCtxt Header) blk)))))
-> (m (Maybe
         (ChainUpdate
            blk
            (blk, blk, Header blk, ByteString, ByteString, HeaderHash blk,
             SlotNo, IsEBB, SizeInBytes, Word16,
             SomeSecond (NestedCtxt Header) blk)))
    -> ExceptT
         TestFailure
         m
         (Either
            (ChainDbError blk)
            (Maybe
               (ChainUpdate
                  blk
                  (blk, blk, Header blk, ByteString, ByteString, HeaderHash blk,
                   SlotNo, IsEBB, SizeInBytes, Word16,
                   SomeSecond (NestedCtxt Header) blk)))))
-> m (Maybe
        (ChainUpdate
           blk
           (blk, blk, Header blk, ByteString, ByteString, HeaderHash blk,
            SlotNo, IsEBB, SizeInBytes, Word16,
            SomeSecond (NestedCtxt Header) blk)))
-> ReaderT
     (ChainDBEnv m blk)
     (ExceptT TestFailure m)
     (Either
        (ChainDbError blk)
        (Maybe
           (ChainUpdate
              blk
              (blk, blk, Header blk, ByteString, ByteString, HeaderHash blk,
               SlotNo, IsEBB, SizeInBytes, Word16,
               SomeSecond (NestedCtxt Header) blk))))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m (Either
     (ChainDbError blk)
     (Maybe
        (ChainUpdate
           blk
           (blk, blk, Header blk, ByteString, ByteString, HeaderHash blk,
            SlotNo, IsEBB, SizeInBytes, Word16,
            SomeSecond (NestedCtxt Header) blk))))
-> ExceptT
     TestFailure
     m
     (Either
        (ChainDbError blk)
        (Maybe
           (ChainUpdate
              blk
              (blk, blk, Header blk, ByteString, ByteString, HeaderHash blk,
               SlotNo, IsEBB, SizeInBytes, Word16,
               SomeSecond (NestedCtxt Header) blk))))
forall (m :: * -> *) a. Monad m => m a -> ExceptT TestFailure m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (Either
      (ChainDbError blk)
      (Maybe
         (ChainUpdate
            blk
            (blk, blk, Header blk, ByteString, ByteString, HeaderHash blk,
             SlotNo, IsEBB, SizeInBytes, Word16,
             SomeSecond (NestedCtxt Header) blk))))
 -> ExceptT
      TestFailure
      m
      (Either
         (ChainDbError blk)
         (Maybe
            (ChainUpdate
               blk
               (blk, blk, Header blk, ByteString, ByteString, HeaderHash blk,
                SlotNo, IsEBB, SizeInBytes, Word16,
                SomeSecond (NestedCtxt Header) blk)))))
-> (m (Maybe
         (ChainUpdate
            blk
            (blk, blk, Header blk, ByteString, ByteString, HeaderHash blk,
             SlotNo, IsEBB, SizeInBytes, Word16,
             SomeSecond (NestedCtxt Header) blk)))
    -> m (Either
            (ChainDbError blk)
            (Maybe
               (ChainUpdate
                  blk
                  (blk, blk, Header blk, ByteString, ByteString, HeaderHash blk,
                   SlotNo, IsEBB, SizeInBytes, Word16,
                   SomeSecond (NestedCtxt Header) blk)))))
-> m (Maybe
        (ChainUpdate
           blk
           (blk, blk, Header blk, ByteString, ByteString, HeaderHash blk,
            SlotNo, IsEBB, SizeInBytes, Word16,
            SomeSecond (NestedCtxt Header) blk)))
-> ExceptT
     TestFailure
     m
     (Either
        (ChainDbError blk)
        (Maybe
           (ChainUpdate
              blk
              (blk, blk, Header blk, ByteString, ByteString, HeaderHash blk,
               SlotNo, IsEBB, SizeInBytes, Word16,
               SomeSecond (NestedCtxt Header) blk))))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe
   (ChainUpdate
      blk
      (blk, blk, Header blk, ByteString, ByteString, HeaderHash blk,
       SlotNo, IsEBB, SizeInBytes, Word16,
       SomeSecond (NestedCtxt Header) blk))
 -> Either
      (ChainDbError blk)
      (Maybe
         (ChainUpdate
            blk
            (blk, blk, Header blk, ByteString, ByteString, HeaderHash blk,
             SlotNo, IsEBB, SizeInBytes, Word16,
             SomeSecond (NestedCtxt Header) blk))))
-> m (Maybe
        (ChainUpdate
           blk
           (blk, blk, Header blk, ByteString, ByteString, HeaderHash blk,
            SlotNo, IsEBB, SizeInBytes, Word16,
            SomeSecond (NestedCtxt Header) blk)))
-> m (Either
        (ChainDbError blk)
        (Maybe
           (ChainUpdate
              blk
              (blk, blk, Header blk, ByteString, ByteString, HeaderHash blk,
               SlotNo, IsEBB, SizeInBytes, Word16,
               SomeSecond (NestedCtxt Header) blk))))
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Maybe
  (ChainUpdate
     blk
     (blk, blk, Header blk, ByteString, ByteString, HeaderHash blk,
      SlotNo, IsEBB, SizeInBytes, Word16,
      SomeSecond (NestedCtxt Header) blk))
-> Either
     (ChainDbError blk)
     (Maybe
        (ChainUpdate
           blk
           (blk, blk, Header blk, ByteString, ByteString, HeaderHash blk,
            SlotNo, IsEBB, SizeInBytes, Word16,
            SomeSecond (NestedCtxt Header) blk)))
forall a b. b -> Either a b
Right
    (m (Maybe
      (ChainUpdate
         blk
         (blk, blk, Header blk, ByteString, ByteString, HeaderHash blk,
          SlotNo, IsEBB, SizeInBytes, Word16,
          SomeSecond (NestedCtxt Header) blk)))
 -> SystemM
      blk
      m
      (Either
         (ChainDbError blk)
         (Maybe
            (ChainUpdate
               blk
               (blk, blk, Header blk, ByteString, ByteString, HeaderHash blk,
                SlotNo, IsEBB, SizeInBytes, Word16,
                SomeSecond (NestedCtxt Header) blk)))))
-> (Follower
      m
      blk
      (blk, blk, Header blk, ByteString, ByteString, HeaderHash blk,
       SlotNo, IsEBB, SizeInBytes, Word16,
       SomeSecond (NestedCtxt Header) blk)
    -> m (Maybe
            (ChainUpdate
               blk
               (blk, blk, Header blk, ByteString, ByteString, HeaderHash blk,
                SlotNo, IsEBB, SizeInBytes, Word16,
                SomeSecond (NestedCtxt Header) blk))))
-> Follower
     m
     blk
     (blk, blk, Header blk, ByteString, ByteString, HeaderHash blk,
      SlotNo, IsEBB, SizeInBytes, Word16,
      SomeSecond (NestedCtxt Header) blk)
-> SystemM
     blk
     m
     (Either
        (ChainDbError blk)
        (Maybe
           (ChainUpdate
              blk
              (blk, blk, Header blk, ByteString, ByteString, HeaderHash blk,
               SlotNo, IsEBB, SizeInBytes, Word16,
               SomeSecond (NestedCtxt Header) blk))))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Follower
  m
  blk
  (blk, blk, Header blk, ByteString, ByteString, HeaderHash blk,
   SlotNo, IsEBB, SizeInBytes, Word16,
   SomeSecond (NestedCtxt Header) blk)
-> m (Maybe
        (ChainUpdate
           blk
           (blk, blk, Header blk, ByteString, ByteString, HeaderHash blk,
            SlotNo, IsEBB, SizeInBytes, Word16,
            SomeSecond (NestedCtxt Header) blk)))
forall (m :: * -> *) blk a.
Follower m blk a -> m (Maybe (ChainUpdate blk a))
API.followerInstruction

  followerForward :: FollowerId (SystemM blk m)
-> [Point (Block (SystemM blk m))]
-> SystemM
     blk
     m
     (Either
        (ChainDbError (Block (SystemM blk m)))
        (Maybe (Point (Block (SystemM blk m)))))
followerForward FollowerId (SystemM blk m)
follower [Point (Block (SystemM blk m))]
points = ReaderT
  (ChainDBEnv m blk)
  (ExceptT TestFailure m)
  (Either
     (ChainDbError (Block (SystemM blk m)))
     (Maybe (Point (Block (SystemM blk m)))))
-> SystemM
     blk
     m
     (Either
        (ChainDbError (Block (SystemM blk m)))
        (Maybe (Point (Block (SystemM blk m)))))
forall blk (m :: * -> *) a.
ReaderT (ChainDBEnv m blk) (ExceptT TestFailure m) a
-> SystemM blk m a
SystemM (ReaderT
   (ChainDBEnv m blk)
   (ExceptT TestFailure m)
   (Either
      (ChainDbError (Block (SystemM blk m)))
      (Maybe (Point (Block (SystemM blk m)))))
 -> SystemM
      blk
      m
      (Either
         (ChainDbError (Block (SystemM blk m)))
         (Maybe (Point (Block (SystemM blk m))))))
-> ReaderT
     (ChainDBEnv m blk)
     (ExceptT TestFailure m)
     (Either
        (ChainDbError (Block (SystemM blk m)))
        (Maybe (Point (Block (SystemM blk m)))))
-> SystemM
     blk
     m
     (Either
        (ChainDbError (Block (SystemM blk m)))
        (Maybe (Point (Block (SystemM blk m)))))
forall a b. (a -> b) -> a -> b
$ ExceptT
  TestFailure
  m
  (Either
     (ChainDbError (Block (SystemM blk m)))
     (Maybe (Point (Block (SystemM blk m)))))
-> ReaderT
     (ChainDBEnv m blk)
     (ExceptT TestFailure m)
     (Either
        (ChainDbError (Block (SystemM blk m)))
        (Maybe (Point (Block (SystemM blk m)))))
forall (m :: * -> *) a.
Monad m =>
m a -> ReaderT (ChainDBEnv m blk) m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ExceptT
   TestFailure
   m
   (Either
      (ChainDbError (Block (SystemM blk m)))
      (Maybe (Point (Block (SystemM blk m)))))
 -> ReaderT
      (ChainDBEnv m blk)
      (ExceptT TestFailure m)
      (Either
         (ChainDbError (Block (SystemM blk m)))
         (Maybe (Point (Block (SystemM blk m))))))
-> ExceptT
     TestFailure
     m
     (Either
        (ChainDbError (Block (SystemM blk m)))
        (Maybe (Point (Block (SystemM blk m)))))
-> ReaderT
     (ChainDBEnv m blk)
     (ExceptT TestFailure m)
     (Either
        (ChainDbError (Block (SystemM blk m)))
        (Maybe (Point (Block (SystemM blk m)))))
forall a b. (a -> b) -> a -> b
$ m (Either
     (ChainDbError (Block (SystemM blk m)))
     (Maybe (Point (Block (SystemM blk m)))))
-> ExceptT
     TestFailure
     m
     (Either
        (ChainDbError (Block (SystemM blk m)))
        (Maybe (Point (Block (SystemM blk m)))))
forall (m :: * -> *) a. Monad m => m a -> ExceptT TestFailure m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (Either
      (ChainDbError (Block (SystemM blk m)))
      (Maybe (Point (Block (SystemM blk m)))))
 -> ExceptT
      TestFailure
      m
      (Either
         (ChainDbError (Block (SystemM blk m)))
         (Maybe (Point (Block (SystemM blk m))))))
-> m (Either
        (ChainDbError (Block (SystemM blk m)))
        (Maybe (Point (Block (SystemM blk m)))))
-> ExceptT
     TestFailure
     m
     (Either
        (ChainDbError (Block (SystemM blk m)))
        (Maybe (Point (Block (SystemM blk m)))))
forall a b. (a -> b) -> a -> b
$ Maybe (Point blk) -> Either (ChainDbError blk) (Maybe (Point blk))
forall a b. b -> Either a b
Right
    (Maybe (Point blk)
 -> Either (ChainDbError blk) (Maybe (Point blk)))
-> m (Maybe (Point blk))
-> m (Either (ChainDbError blk) (Maybe (Point blk)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Follower
  m
  blk
  (blk, blk, Header blk, ByteString, ByteString, HeaderHash blk,
   SlotNo, IsEBB, SizeInBytes, Word16,
   SomeSecond (NestedCtxt Header) blk)
-> [Point blk] -> m (Maybe (Point blk))
forall (m :: * -> *) blk a.
Follower m blk a -> [Point blk] -> m (Maybe (Point blk))
API.followerForward Follower
  m
  blk
  (blk, blk, Header blk, ByteString, ByteString, HeaderHash blk,
   SlotNo, IsEBB, SizeInBytes, Word16,
   SomeSecond (NestedCtxt Header) blk)
FollowerId (SystemM blk m)
follower [Point blk]
[Point (Block (SystemM blk m))]
points

  stream :: StreamFrom (Block (SystemM blk m))
-> StreamTo (Block (SystemM blk m))
-> SystemM
     blk
     m
     (Either
        (ChainDbError (Block (SystemM blk m)))
        (Either
           (UnknownRange (Block (SystemM blk m)))
           (IteratorId (SystemM blk m))))
stream StreamFrom (Block (SystemM blk m))
from StreamTo (Block (SystemM blk m))
to = do
    ChainDBEnv m blk
env <- SystemM blk m (ChainDBEnv m blk)
forall r (m :: * -> *). MonadReader r m => m r
ask
    ReaderT
  (ChainDBEnv m blk)
  (ExceptT TestFailure m)
  (Either
     (ChainDbError blk)
     (Either
        (UnknownRange blk)
        (Iterator
           m
           blk
           (blk, blk, Header blk, ByteString, ByteString, HeaderHash blk,
            SlotNo, IsEBB, SizeInBytes, Word16,
            SomeSecond (NestedCtxt Header) blk))))
-> SystemM
     blk
     m
     (Either
        (ChainDbError blk)
        (Either
           (UnknownRange blk)
           (Iterator
              m
              blk
              (blk, blk, Header blk, ByteString, ByteString, HeaderHash blk,
               SlotNo, IsEBB, SizeInBytes, Word16,
               SomeSecond (NestedCtxt Header) blk))))
forall blk (m :: * -> *) a.
ReaderT (ChainDBEnv m blk) (ExceptT TestFailure m) a
-> SystemM blk m a
SystemM (ReaderT
   (ChainDBEnv m blk)
   (ExceptT TestFailure m)
   (Either
      (ChainDbError blk)
      (Either
         (UnknownRange blk)
         (Iterator
            m
            blk
            (blk, blk, Header blk, ByteString, ByteString, HeaderHash blk,
             SlotNo, IsEBB, SizeInBytes, Word16,
             SomeSecond (NestedCtxt Header) blk))))
 -> SystemM
      blk
      m
      (Either
         (ChainDbError blk)
         (Either
            (UnknownRange blk)
            (Iterator
               m
               blk
               (blk, blk, Header blk, ByteString, ByteString, HeaderHash blk,
                SlotNo, IsEBB, SizeInBytes, Word16,
                SomeSecond (NestedCtxt Header) blk)))))
-> ReaderT
     (ChainDBEnv m blk)
     (ExceptT TestFailure m)
     (Either
        (ChainDbError blk)
        (Either
           (UnknownRange blk)
           (Iterator
              m
              blk
              (blk, blk, Header blk, ByteString, ByteString, HeaderHash blk,
               SlotNo, IsEBB, SizeInBytes, Word16,
               SomeSecond (NestedCtxt Header) blk))))
-> SystemM
     blk
     m
     (Either
        (ChainDbError blk)
        (Either
           (UnknownRange blk)
           (Iterator
              m
              blk
              (blk, blk, Header blk, ByteString, ByteString, HeaderHash blk,
               SlotNo, IsEBB, SizeInBytes, Word16,
               SomeSecond (NestedCtxt Header) blk))))
forall a b. (a -> b) -> a -> b
$ ExceptT
  TestFailure
  m
  (Either
     (ChainDbError blk)
     (Either
        (UnknownRange blk)
        (Iterator
           m
           blk
           (blk, blk, Header blk, ByteString, ByteString, HeaderHash blk,
            SlotNo, IsEBB, SizeInBytes, Word16,
            SomeSecond (NestedCtxt Header) blk))))
-> ReaderT
     (ChainDBEnv m blk)
     (ExceptT TestFailure m)
     (Either
        (ChainDbError blk)
        (Either
           (UnknownRange blk)
           (Iterator
              m
              blk
              (blk, blk, Header blk, ByteString, ByteString, HeaderHash blk,
               SlotNo, IsEBB, SizeInBytes, Word16,
               SomeSecond (NestedCtxt Header) blk))))
forall (m :: * -> *) a.
Monad m =>
m a -> ReaderT (ChainDBEnv m blk) m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ExceptT
   TestFailure
   m
   (Either
      (ChainDbError blk)
      (Either
         (UnknownRange blk)
         (Iterator
            m
            blk
            (blk, blk, Header blk, ByteString, ByteString, HeaderHash blk,
             SlotNo, IsEBB, SizeInBytes, Word16,
             SomeSecond (NestedCtxt Header) blk))))
 -> ReaderT
      (ChainDBEnv m blk)
      (ExceptT TestFailure m)
      (Either
         (ChainDbError blk)
         (Either
            (UnknownRange blk)
            (Iterator
               m
               blk
               (blk, blk, Header blk, ByteString, ByteString, HeaderHash blk,
                SlotNo, IsEBB, SizeInBytes, Word16,
                SomeSecond (NestedCtxt Header) blk)))))
-> ExceptT
     TestFailure
     m
     (Either
        (ChainDbError blk)
        (Either
           (UnknownRange blk)
           (Iterator
              m
              blk
              (blk, blk, Header blk, ByteString, ByteString, HeaderHash blk,
               SlotNo, IsEBB, SizeInBytes, Word16,
               SomeSecond (NestedCtxt Header) blk))))
-> ReaderT
     (ChainDBEnv m blk)
     (ExceptT TestFailure m)
     (Either
        (ChainDbError blk)
        (Either
           (UnknownRange blk)
           (Iterator
              m
              blk
              (blk, blk, Header blk, ByteString, ByteString, HeaderHash blk,
               SlotNo, IsEBB, SizeInBytes, Word16,
               SomeSecond (NestedCtxt Header) blk))))
forall a b. (a -> b) -> a -> b
$ m (Either
     (ChainDbError blk)
     (Either
        (UnknownRange blk)
        (Iterator
           m
           blk
           (blk, blk, Header blk, ByteString, ByteString, HeaderHash blk,
            SlotNo, IsEBB, SizeInBytes, Word16,
            SomeSecond (NestedCtxt Header) blk))))
-> ExceptT
     TestFailure
     m
     (Either
        (ChainDbError blk)
        (Either
           (UnknownRange blk)
           (Iterator
              m
              blk
              (blk, blk, Header blk, ByteString, ByteString, HeaderHash blk,
               SlotNo, IsEBB, SizeInBytes, Word16,
               SomeSecond (NestedCtxt Header) blk))))
forall (m :: * -> *) a. Monad m => m a -> ExceptT TestFailure m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (Either
      (ChainDbError blk)
      (Either
         (UnknownRange blk)
         (Iterator
            m
            blk
            (blk, blk, Header blk, ByteString, ByteString, HeaderHash blk,
             SlotNo, IsEBB, SizeInBytes, Word16,
             SomeSecond (NestedCtxt Header) blk))))
 -> ExceptT
      TestFailure
      m
      (Either
         (ChainDbError blk)
         (Either
            (UnknownRange blk)
            (Iterator
               m
               blk
               (blk, blk, Header blk, ByteString, ByteString, HeaderHash blk,
                SlotNo, IsEBB, SizeInBytes, Word16,
                SomeSecond (NestedCtxt Header) blk)))))
-> m (Either
        (ChainDbError blk)
        (Either
           (UnknownRange blk)
           (Iterator
              m
              blk
              (blk, blk, Header blk, ByteString, ByteString, HeaderHash blk,
               SlotNo, IsEBB, SizeInBytes, Word16,
               SomeSecond (NestedCtxt Header) blk))))
-> ExceptT
     TestFailure
     m
     (Either
        (ChainDbError blk)
        (Either
           (UnknownRange blk)
           (Iterator
              m
              blk
              (blk, blk, Header blk, ByteString, ByteString, HeaderHash blk,
               SlotNo, IsEBB, SizeInBytes, Word16,
               SomeSecond (NestedCtxt Header) blk))))
forall a b. (a -> b) -> a -> b
$ (Either
   (UnknownRange blk)
   (Iterator
      m
      blk
      (blk, blk, Header blk, ByteString, ByteString, HeaderHash blk,
       SlotNo, IsEBB, SizeInBytes, Word16,
       SomeSecond (NestedCtxt Header) blk))
 -> Either
      (ChainDbError blk)
      (Either
         (UnknownRange blk)
         (Iterator
            m
            blk
            (blk, blk, Header blk, ByteString, ByteString, HeaderHash blk,
             SlotNo, IsEBB, SizeInBytes, Word16,
             SomeSecond (NestedCtxt Header) blk))))
-> m (Either
        (UnknownRange blk)
        (Iterator
           m
           blk
           (blk, blk, Header blk, ByteString, ByteString, HeaderHash blk,
            SlotNo, IsEBB, SizeInBytes, Word16,
            SomeSecond (NestedCtxt Header) blk)))
-> m (Either
        (ChainDbError blk)
        (Either
           (UnknownRange blk)
           (Iterator
              m
              blk
              (blk, blk, Header blk, ByteString, ByteString, HeaderHash blk,
               SlotNo, IsEBB, SizeInBytes, Word16,
               SomeSecond (NestedCtxt Header) blk))))
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Either
  (UnknownRange blk)
  (Iterator
     m
     blk
     (blk, blk, Header blk, ByteString, ByteString, HeaderHash blk,
      SlotNo, IsEBB, SizeInBytes, Word16,
      SomeSecond (NestedCtxt Header) blk))
-> Either
     (ChainDbError blk)
     (Either
        (UnknownRange blk)
        (Iterator
           m
           blk
           (blk, blk, Header blk, ByteString, ByteString, HeaderHash blk,
            SlotNo, IsEBB, SizeInBytes, Word16,
            SomeSecond (NestedCtxt Header) blk)))
forall a b. b -> Either a b
Right (m (Either
      (UnknownRange blk)
      (Iterator
         m
         blk
         (blk, blk, Header blk, ByteString, ByteString, HeaderHash blk,
          SlotNo, IsEBB, SizeInBytes, Word16,
          SomeSecond (NestedCtxt Header) blk)))
 -> m (Either
         (ChainDbError blk)
         (Either
            (UnknownRange blk)
            (Iterator
               m
               blk
               (blk, blk, Header blk, ByteString, ByteString, HeaderHash blk,
                SlotNo, IsEBB, SizeInBytes, Word16,
                SomeSecond (NestedCtxt Header) blk)))))
-> m (Either
        (UnknownRange blk)
        (Iterator
           m
           blk
           (blk, blk, Header blk, ByteString, ByteString, HeaderHash blk,
            SlotNo, IsEBB, SizeInBytes, Word16,
            SomeSecond (NestedCtxt Header) blk)))
-> m (Either
        (ChainDbError blk)
        (Either
           (UnknownRange blk)
           (Iterator
              m
              blk
              (blk, blk, Header blk, ByteString, ByteString, HeaderHash blk,
               SlotNo, IsEBB, SizeInBytes, Word16,
               SomeSecond (NestedCtxt Header) blk))))
forall a b. (a -> b) -> a -> b
$ do
      ChainDB m blk
api <- ChainDBState m blk -> ChainDB m blk
forall (m :: * -> *) blk. ChainDBState m blk -> ChainDB m blk
chainDB (ChainDBState m blk -> ChainDB m blk)
-> m (ChainDBState m blk) -> m (ChainDB m blk)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StrictTVar m (ChainDBState m blk) -> m (ChainDBState m blk)
forall (m :: * -> *) a. MonadSTM m => StrictTVar m a -> m a
readTVarIO (ChainDBEnv m blk -> StrictTVar m (ChainDBState m blk)
forall (m :: * -> *) blk.
ChainDBEnv m blk -> StrictTVar m (ChainDBState m blk)
varDB ChainDBEnv m blk
env)
      ChainDB m blk
-> forall b.
   ResourceRegistry m
   -> BlockComponent blk b
   -> StreamFrom blk
   -> StreamTo blk
   -> m (Either (UnknownRange blk) (Iterator m blk b))
forall (m :: * -> *) blk.
ChainDB m blk
-> forall b.
   ResourceRegistry m
   -> BlockComponent blk b
   -> StreamFrom blk
   -> StreamTo blk
   -> m (Either (UnknownRange blk) (Iterator m blk b))
API.stream ChainDB m blk
api (ChainDBEnv m blk -> ResourceRegistry m
forall (m :: * -> *) blk. ChainDBEnv m blk -> ResourceRegistry m
registry ChainDBEnv m blk
env) BlockComponent
  blk
  (blk, blk, Header blk, ByteString, ByteString, HeaderHash blk,
   SlotNo, IsEBB, SizeInBytes, Word16,
   SomeSecond (NestedCtxt Header) blk)
forall blk. BlockComponent blk (AllComponents blk)
allComponents StreamFrom blk
StreamFrom (Block (SystemM blk m))
from StreamTo blk
StreamTo (Block (SystemM blk m))
to

  iteratorNext :: IteratorId (SystemM blk m)
-> SystemM
     blk
     m
     (IteratorResult
        (Block (SystemM blk m)) (AllComponents (Block (SystemM blk m))))
iteratorNext IteratorId (SystemM blk m)
iterator = ReaderT
  (ChainDBEnv m blk)
  (ExceptT TestFailure m)
  (IteratorResult
     (Block (SystemM blk m)) (AllComponents (Block (SystemM blk m))))
-> SystemM
     blk
     m
     (IteratorResult
        (Block (SystemM blk m)) (AllComponents (Block (SystemM blk m))))
forall blk (m :: * -> *) a.
ReaderT (ChainDBEnv m blk) (ExceptT TestFailure m) a
-> SystemM blk m a
SystemM (ReaderT
   (ChainDBEnv m blk)
   (ExceptT TestFailure m)
   (IteratorResult
      (Block (SystemM blk m)) (AllComponents (Block (SystemM blk m))))
 -> SystemM
      blk
      m
      (IteratorResult
         (Block (SystemM blk m)) (AllComponents (Block (SystemM blk m)))))
-> ReaderT
     (ChainDBEnv m blk)
     (ExceptT TestFailure m)
     (IteratorResult
        (Block (SystemM blk m)) (AllComponents (Block (SystemM blk m))))
-> SystemM
     blk
     m
     (IteratorResult
        (Block (SystemM blk m)) (AllComponents (Block (SystemM blk m))))
forall a b. (a -> b) -> a -> b
$ ExceptT
  TestFailure
  m
  (IteratorResult
     (Block (SystemM blk m)) (AllComponents (Block (SystemM blk m))))
-> ReaderT
     (ChainDBEnv m blk)
     (ExceptT TestFailure m)
     (IteratorResult
        (Block (SystemM blk m)) (AllComponents (Block (SystemM blk m))))
forall (m :: * -> *) a.
Monad m =>
m a -> ReaderT (ChainDBEnv m blk) m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ExceptT
   TestFailure
   m
   (IteratorResult
      (Block (SystemM blk m)) (AllComponents (Block (SystemM blk m))))
 -> ReaderT
      (ChainDBEnv m blk)
      (ExceptT TestFailure m)
      (IteratorResult
         (Block (SystemM blk m)) (AllComponents (Block (SystemM blk m)))))
-> ExceptT
     TestFailure
     m
     (IteratorResult
        (Block (SystemM blk m)) (AllComponents (Block (SystemM blk m))))
-> ReaderT
     (ChainDBEnv m blk)
     (ExceptT TestFailure m)
     (IteratorResult
        (Block (SystemM blk m)) (AllComponents (Block (SystemM blk m))))
forall a b. (a -> b) -> a -> b
$ m (IteratorResult
     blk
     (blk, blk, Header blk, ByteString, ByteString, HeaderHash blk,
      SlotNo, IsEBB, SizeInBytes, Word16,
      SomeSecond (NestedCtxt Header) blk))
-> ExceptT
     TestFailure
     m
     (IteratorResult
        blk
        (blk, blk, Header blk, ByteString, ByteString, HeaderHash blk,
         SlotNo, IsEBB, SizeInBytes, Word16,
         SomeSecond (NestedCtxt Header) blk))
forall (m :: * -> *) a. Monad m => m a -> ExceptT TestFailure m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Iterator
  m
  blk
  (blk, blk, Header blk, ByteString, ByteString, HeaderHash blk,
   SlotNo, IsEBB, SizeInBytes, Word16,
   SomeSecond (NestedCtxt Header) blk)
-> m (IteratorResult
        blk
        (blk, blk, Header blk, ByteString, ByteString, HeaderHash blk,
         SlotNo, IsEBB, SizeInBytes, Word16,
         SomeSecond (NestedCtxt Header) blk))
forall (m :: * -> *) blk b.
Iterator m blk b -> m (IteratorResult blk b)
API.iteratorNext Iterator
  m
  blk
  (blk, blk, Header blk, ByteString, ByteString, HeaderHash blk,
   SlotNo, IsEBB, SizeInBytes, Word16,
   SomeSecond (NestedCtxt Header) blk)
IteratorId (SystemM blk m)
iterator)