{-# 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, put)
import Control.Monad.Trans.Class (lift)
import Control.ResourceRegistry (closeRegistry, unsafeNewRegistry)
import Data.Maybe (isJust)
import Ouroboros.Consensus.Block.RealPoint
(pointToWithOriginRealPoint)
import Ouroboros.Consensus.Config (TopLevelConfig,
configSecurityParam)
import Ouroboros.Consensus.Ledger.Basics
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 Ouroboros.Consensus.Storage.Common (StreamFrom (..),
StreamTo (..))
import Ouroboros.Consensus.Storage.ImmutableDB.Chunks as ImmutableDB
import Ouroboros.Consensus.Util.IOLike
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
f <- m (FollowerId m)
forall (m :: * -> *). SupportsUnitTest m => m (FollowerId m)
newFollower
followerInstruction f >>= \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"
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
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
b2 <- addBlock $ mkNextBlock b1 1 $ fork 0
f <- newFollower
followerForward f [blockPoint b2] >>= \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"
b3 <- addBlock $ mkNextBlock b1 2 $ fork 1
b4 <- addBlock $ mkNextBlock b3 3 $ fork 1
followerInstruction f >>= \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"
followerInstruction f >>= \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"
followerInstruction f >>= \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
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
b2 <- addBlock $ mkNextBlock b1 0 $ fork 0
b3 <- addBlock $ mkNextBlock b2 1 $ fork 1
b4 <- addBlock $ mkNextBlock b2 1 $ fork 0
f <- newFollower
void $ followerForward f [blockPoint b1]
void $ addBlock $ mkNextBlock b4 4 $ fork 0
persistBlks DoNotGarbageCollect
void $ addBlock $ mkNextBlock b3 3 $ fork 1
followerInstruction f >>= \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"
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
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
b2 <- addBlock $ mkNextBlock b1 1 $ fork 1
b3 <- addBlock $ mkNextBlock b2 2 $ fork 1
i <- streamAssertSuccess (inclusiveFrom b1) (inclusiveTo b3)
b4 <- addBlock $ mkNextBlock b1 3 $ fork 2
b5 <- addBlock $ mkNextBlock b4 4 $ fork 2
b6 <- addBlock $ mkNextBlock b5 5 $ fork 2
void $ addBlock $ mkNextBlock b6 6 $ fork 2
persistBlks GarbageCollect
result <- iteratorNextBlock i
assertEqual (API.IteratorResult b1) result "Streaming first block"
let options = [
[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]
, [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]]
actual <- replicateM 2 (iteratorNextBlock i)
assertOneOf options actual "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
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
(blk
blk, blk
_, Header blk
_, ByteString
_, ByteString
_, HeaderHash blk
_, SlotNo
_, IsEBB
_, SizeInBytes
_, Word16
_, SomeSecond (NestedCtxt Header) blk
_) = blk
blk
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 EmptyMK -> Model TestBlock
forall blk.
HasHeader blk =>
LoE () -> ExtLedgerState blk EmptyMK -> Model blk
Model.empty LoE ()
loe ExtLedgerState TestBlock EmptyMK
testInitExtLedger
topLevelConfig :: TopLevelConfig TestBlock
topLevelConfig = ChunkInfo -> TopLevelConfig TestBlock
mkTestCfg ChunkInfo
chunkInfo
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 ValuesMK
-> (ChainDBEnv IO TestBlock -> IO [TraceEvent TestBlock] -> IO a)
-> IO a
forall (m :: * -> *) blk a.
(IOLike m, TestConstraints blk) =>
TopLevelConfig blk
-> ChunkInfo
-> ExtLedgerState blk ValuesMK
-> (ChainDBEnv m blk -> m [TraceEvent blk] -> m a)
-> m a
withTestChainDbEnv TopLevelConfig TestBlock
topLevelConfig ChunkInfo
chunkInfo (ExtLedgerState TestBlock ValuesMK
-> (ChainDBEnv IO TestBlock -> IO [TraceEvent TestBlock] -> IO a)
-> IO a)
-> ExtLedgerState TestBlock ValuesMK
-> (ChainDBEnv IO TestBlock -> IO [TraceEvent TestBlock] -> IO a)
-> IO a
forall a b. (a -> b) -> a -> b
$ ExtLedgerState TestBlock EmptyMK
-> ExtLedgerState TestBlock ValuesMK
forall (mk :: MapKind) (mk' :: MapKind).
ExtLedgerState TestBlock mk -> ExtLedgerState TestBlock mk'
forall (l :: LedgerStateKind) (mk :: MapKind) (mk' :: MapKind).
LedgerTablesAreTrivial l =>
l mk -> l mk'
convertMapKind ExtLedgerState TestBlock EmptyMK
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
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)))
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 <- ModelM blk (Model blk)
forall s (m :: * -> *). MonadState s m => m s
get
topLevelConfig <- ask
let (a, model') = f model topLevelConfig
put model'
pure a
instance (Model.ModelSupportsBlock blk, LedgerSupportsProtocol blk, LedgerTablesAreTrivial (LedgerState 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
(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,
LedgerTablesAreTrivial (ExtLedgerState 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
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
withTestChainDbEnv ::
(IOLike m, TestConstraints blk)
=> TopLevelConfig blk
-> ImmutableDB.ChunkInfo
-> ExtLedgerState blk ValuesMK
-> (ChainDBEnv m blk -> m [TraceEvent blk] -> m a)
-> m a
withTestChainDbEnv :: forall (m :: * -> *) blk a.
(IOLike m, TestConstraints blk) =>
TopLevelConfig blk
-> ChunkInfo
-> ExtLedgerState blk ValuesMK
-> (ChainDBEnv m blk -> m [TraceEvent blk] -> m a)
-> m a
withTestChainDbEnv TopLevelConfig blk
topLevelConfig ChunkInfo
chunkInfo ExtLedgerState blk ValuesMK
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
threadRegistry <- m (ResourceRegistry m)
forall (m :: * -> *).
(MonadSTM m, MonadThread m, HasCallStack) =>
m (ResourceRegistry m)
unsafeNewRegistry
iteratorRegistry <- unsafeNewRegistry
varCurSlot <- uncheckedNewTVarM 0
varNextId <- uncheckedNewTVarM 0
varLoEFragment <- newTVarIO $ AF.Empty AF.AnchorGenesis
nodeDbs <- emptyNodeDBs
(tracer, getTrace) <- recordingTracerTVar
let 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
varDB <- open args >>= newTVarIO
let env = ChainDBEnv
{ StrictTVar m (ChainDBState m blk)
varDB :: StrictTVar m (ChainDBState m blk)
varDB :: StrictTVar m (ChainDBState m blk)
varDB
, registry :: ResourceRegistry m
registry = ResourceRegistry m
iteratorRegistry
, StrictTVar m SlotNo
varCurSlot :: StrictTVar m SlotNo
varCurSlot :: StrictTVar m SlotNo
varCurSlot
, StrictTVar m Id
varNextId :: StrictTVar m Id
varNextId :: StrictTVar m Id
varNextId
, varVolatileDbFs :: 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
args :: ChainDbArgs Identity m blk
args
, StrictTVar
m
(AnchoredSeq
(WithOrigin SlotNo)
(Anchor (HeaderWithTime blk))
(HeaderWithTime blk))
varLoEFragment :: StrictTVar
m
(AnchoredSeq
(WithOrigin SlotNo)
(Anchor (HeaderWithTime blk))
(HeaderWithTime blk))
varLoEFragment :: StrictTVar
m
(AnchoredSeq
(WithOrigin SlotNo)
(Anchor (HeaderWithTime blk))
(HeaderWithTime blk))
varLoEFragment
}
pure (env, 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 :: * -> *).
(MonadMask m, MonadThread m, MonadSTM 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 :: * -> *).
(MonadMask m, MonadThread m, MonadSTM m, HasCallStack) =>
ResourceRegistry m -> m ()
closeRegistry (ChainDbSpecificArgs Identity m blk
-> HKD Identity (ResourceRegistry m)
ChainDbSpecificArgs Identity m blk -> ResourceRegistry m
forall (f :: * -> *) (m :: * -> *) blk.
ChainDbSpecificArgs f m blk -> HKD f (ResourceRegistry m)
cdbsRegistry (ChainDbSpecificArgs Identity m blk -> ResourceRegistry m)
-> (ChainDbArgs Identity m blk
-> ChainDbSpecificArgs Identity m blk)
-> ChainDbArgs Identity m blk
-> ResourceRegistry m
forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 -> ResourceRegistry m)
-> ChainDbArgs Identity m blk -> ResourceRegistry m
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 ValuesMK
mcdbInitLedger = ExtLedgerState blk ValuesMK
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
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
env <- SystemM blk m (ChainDBEnv m blk)
forall r (m :: * -> *). MonadReader r m => m r
ask
SystemM $ lift $ lift $ do
api <- chainDB <$> readTVarIO (varDB env)
void $ API.addBlock api API.noPunishment blk
pure blk
persistBlks :: ShouldGarbageCollect -> SystemM blk m ()
persistBlks ShouldGarbageCollect
shouldGarbageCollect = do
env <- SystemM blk m (ChainDBEnv m blk)
forall r (m :: * -> *). MonadReader r m => m r
ask
SystemM $ lift $ lift $ do
internal <- internal <$> readTVarIO (varDB env)
SM.persistBlks shouldGarbageCollect internal
newFollower :: SystemM blk m (FollowerId (SystemM blk m))
newFollower = do
env <- SystemM blk m (ChainDBEnv m blk)
forall r (m :: * -> *). MonadReader r m => m r
ask
SystemM $ lift $ lift $ do
api <- chainDB <$> readTVarIO (varDB env)
API.newFollower api (registry env) API.SelectedChain 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
env <- SystemM blk m (ChainDBEnv m blk)
forall r (m :: * -> *). MonadReader r m => m r
ask
SystemM $ lift $ lift $ fmap Right $ do
api <- chainDB <$> readTVarIO (varDB env)
API.stream api (registry env) allComponents from 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)