{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE ParallelListComp #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE TypeApplications #-}
{-# OPTIONS_GHC -Wno-orphans #-}
module Ouroboros.Network.Protocol.BlockFetch.Test (tests) where
import Codec.Serialise qualified as S
import Control.Monad.ST (runST)
import Data.ByteString.Lazy (ByteString)
import Control.Monad.Class.MonadAsync (MonadAsync)
import Control.Monad.Class.MonadST (MonadST)
import Control.Monad.Class.MonadSTM (MonadSTM)
import Control.Monad.Class.MonadThrow (MonadCatch)
import Control.Monad.IOSim (runSimOrThrow)
import Control.Tracer (nullTracer)
import Network.TypedProtocol.Codec
import Network.TypedProtocol.Proofs
import Ouroboros.Network.Channel
import Ouroboros.Network.Driver.Simple (runConnectedPeers)
import Ouroboros.Network.Block (Serialised (..), genesisPoint, unwrapCBORinCBOR,
wrapCBORinCBOR)
import Ouroboros.Network.Mock.Chain (Chain, Point)
import Ouroboros.Network.Mock.Chain qualified as Chain
import Ouroboros.Network.Mock.ConcreteBlock (Block)
import Ouroboros.Network.Protocol.BlockFetch.Client
import Ouroboros.Network.Protocol.BlockFetch.Codec
import Ouroboros.Network.Protocol.BlockFetch.Direct
import Ouroboros.Network.Protocol.BlockFetch.Examples
import Ouroboros.Network.Protocol.BlockFetch.Server
import Ouroboros.Network.Protocol.BlockFetch.Type
import Test.Data.PipeliningDepth (PipeliningDepth (..))
import Test.ChainGenerators (TestChainAndPoints (..))
import Test.Ouroboros.Network.Testing.Utils (prop_codec_cborM,
prop_codec_valid_cbor_encoding, splits2, splits3)
import Test.QuickCheck
import Test.Tasty (TestTree, testGroup)
import Test.Tasty.QuickCheck (testProperty)
tests :: TestTree
tests :: TestTree
tests =
TestName -> [TestTree] -> TestTree
testGroup TestName
"Ouroboros.Network.Protocol"
[ TestName -> [TestTree] -> TestTree
testGroup TestName
"BlockFetch"
[ TestName -> (TestChainAndPoints -> Bool) -> TestTree
forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"direct" TestChainAndPoints -> Bool
prop_direct
, TestName -> (TestChainAndPoints -> Bool) -> TestTree
forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"directPipelined 1" TestChainAndPoints -> Bool
prop_directPipelined1
, TestName -> (TestChainAndPoints -> Bool) -> TestTree
forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"directPipelined 2" TestChainAndPoints -> Bool
prop_directPipelined2
, TestName -> (TestChainAndPoints -> Bool) -> TestTree
forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"connect" TestChainAndPoints -> Bool
prop_connect
, TestName -> (TestChainAndPoints -> [Bool] -> Bool) -> TestTree
forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"connect_pipelined 1" TestChainAndPoints -> [Bool] -> Bool
prop_connect_pipelined1
, TestName -> (TestChainAndPoints -> Bool) -> TestTree
forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"connect_pipelined 2" TestChainAndPoints -> Bool
prop_connect_pipelined2
, TestName -> (TestChainAndPoints -> Bool) -> TestTree
forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"connect_pipelined 3" TestChainAndPoints -> Bool
prop_connect_pipelined3
, TestName -> (TestChainAndPoints -> [Bool] -> Bool) -> TestTree
forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"connect_pipelined 4" TestChainAndPoints -> [Bool] -> Bool
prop_connect_pipelined4
, TestName
-> (TestChainAndPoints -> PipeliningDepth -> [Bool] -> Bool)
-> TestTree
forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"connect_pipelined 5" TestChainAndPoints -> PipeliningDepth -> [Bool] -> Bool
prop_connect_pipelined5
, TestName -> (TestChainAndPoints -> Property) -> TestTree
forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"channel ST" TestChainAndPoints -> Property
prop_channel_ST
, TestName -> (TestChainAndPoints -> Property) -> TestTree
forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"channel IO" TestChainAndPoints -> Property
prop_channel_IO
, TestName -> (TestChainAndPoints -> Property) -> TestTree
forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"pipe IO" TestChainAndPoints -> Property
prop_pipe_IO
, TestName
-> (AnyMessageAndAgency (BlockFetch Block (Point Block)) -> Bool)
-> TestTree
forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"codec" AnyMessageAndAgency (BlockFetch Block (Point Block)) -> Bool
prop_codec_BlockFetch
, TestName
-> (AnyMessageAndAgency (BlockFetch Block (Point Block)) -> Bool)
-> TestTree
forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"codec 2-splits" AnyMessageAndAgency (BlockFetch Block (Point Block)) -> Bool
prop_codec_splits2_BlockFetch
, TestName -> Property -> TestTree
forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"codec 3-splits" (Property -> TestTree) -> Property -> TestTree
forall a b. (a -> b) -> a -> b
$ Int
-> (AnyMessageAndAgency (BlockFetch Block (Point Block)) -> Bool)
-> Property
forall prop. Testable prop => Int -> prop -> Property
withMaxSuccess Int
30
AnyMessageAndAgency (BlockFetch Block (Point Block)) -> Bool
prop_codec_splits3_BlockFetch
, TestName
-> (AnyMessageAndAgency (BlockFetch Block (Point Block)) -> Bool)
-> TestTree
forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"codec cbor" AnyMessageAndAgency (BlockFetch Block (Point Block)) -> Bool
prop_codec_cbor_BlockFetch
, TestName
-> (AnyMessageAndAgency (BlockFetch Block (Point Block))
-> Property)
-> TestTree
forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"codec valid cbor" AnyMessageAndAgency (BlockFetch Block (Point Block)) -> Property
prop_codec_valid_cbor_BlockFetch
, TestName
-> (AnyMessageAndAgency
(BlockFetch (Serialised Block) (Point Block))
-> Bool)
-> TestTree
forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"codecSerialised" AnyMessageAndAgency (BlockFetch (Serialised Block) (Point Block))
-> Bool
prop_codec_BlockFetchSerialised
, TestName
-> (AnyMessageAndAgency
(BlockFetch (Serialised Block) (Point Block))
-> Bool)
-> TestTree
forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"codecSerialised 2-splits" AnyMessageAndAgency (BlockFetch (Serialised Block) (Point Block))
-> Bool
prop_codec_splits2_BlockFetchSerialised
, TestName -> Property -> TestTree
forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"codecSerialised 3-splits" (Property -> TestTree) -> Property -> TestTree
forall a b. (a -> b) -> a -> b
$ Int
-> (AnyMessageAndAgency
(BlockFetch (Serialised Block) (Point Block))
-> Bool)
-> Property
forall prop. Testable prop => Int -> prop -> Property
withMaxSuccess Int
30
AnyMessageAndAgency (BlockFetch (Serialised Block) (Point Block))
-> Bool
prop_codec_splits3_BlockFetchSerialised
, TestName
-> (AnyMessageAndAgency
(BlockFetch (Serialised Block) (Point Block))
-> Bool)
-> TestTree
forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"codecSerialised cbor" AnyMessageAndAgency (BlockFetch (Serialised Block) (Point Block))
-> Bool
prop_codec_cbor_BlockFetchSerialised
, TestName
-> (AnyMessageAndAgency (BlockFetch Block (Point Block)) -> Bool)
-> TestTree
forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"codec/codecSerialised bin compat" AnyMessageAndAgency (BlockFetch Block (Point Block)) -> Bool
prop_codec_binary_compat_BlockFetch_BlockFetchSerialised
, TestName
-> (AnyMessageAndAgency
(BlockFetch (Serialised Block) (Point Block))
-> Bool)
-> TestTree
forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"codecSerialised/codec bin compat" AnyMessageAndAgency (BlockFetch (Serialised Block) (Point Block))
-> Bool
prop_codec_binary_compat_BlockFetchSerialised_BlockFetch
]
]
type TestClient m = BlockFetchClient Block (Point Block) m [Block]
type TestServer m = BlockFetchServer Block (Point Block) m ()
type TestClientPipelined m =
BlockFetchClientPipelined Block (Point Block) m
[Either (ChainRange (Point Block)) [Block]]
testClient :: MonadSTM m => Chain Block -> [Point Block] -> TestClient m
testClient :: forall (m :: * -> *).
MonadSTM m =>
Chain Block -> [Point Block] -> TestClient m
testClient Chain Block
chain [Point Block]
points = [ChainRange (Point Block)]
-> BlockFetchClient Block (Point Block) m [Block]
forall block point (m :: * -> *).
MonadSTM m =>
[ChainRange point] -> BlockFetchClient block point m [block]
blockFetchClientMap (Chain Block -> [Point Block] -> [ChainRange (Point Block)]
forall block.
HasHeader block =>
Chain block -> [Point block] -> [ChainRange (Point block)]
pointsToRanges Chain Block
chain [Point Block]
points)
testServer :: MonadSTM m => Chain Block -> TestServer m
testServer :: forall (m :: * -> *). MonadSTM m => Chain Block -> TestServer m
testServer Chain Block
chain = RangeRequests m Block -> BlockFetchServer Block (Point Block) m ()
forall (m :: * -> *) block.
Monad m =>
RangeRequests m block -> BlockFetchServer block (Point block) m ()
blockFetchServer (Chain Block -> RangeRequests m Block
forall (m :: * -> *) block.
(Monad m, HasHeader block) =>
Chain block -> RangeRequests m block
rangeRequestsFromChain Chain Block
chain)
testClientPipelinedMax,
testClientPipelinedMin
:: MonadSTM m
=> Chain Block
-> [Point Block]
-> TestClientPipelined m
testClientPipelinedLimited
:: MonadSTM m
=> Int
-> Chain Block
-> [Point Block]
-> TestClientPipelined m
testClientPipelinedMax :: forall (m :: * -> *).
MonadSTM m =>
Chain Block -> [Point Block] -> TestClientPipelined m
testClientPipelinedMax Chain Block
chain [Point Block]
points =
[ChainRange (Point Block)]
-> BlockFetchClientPipelined
Block (Point Block) m [Either (ChainRange (Point Block)) [Block]]
forall block point (m :: * -> *).
Monad m =>
[ChainRange point]
-> BlockFetchClientPipelined
block point m [Either (ChainRange point) [block]]
blockFetchClientPipelinedMax (Chain Block -> [Point Block] -> [ChainRange (Point Block)]
forall block.
HasHeader block =>
Chain block -> [Point block] -> [ChainRange (Point block)]
pointsToRanges Chain Block
chain [Point Block]
points)
testClientPipelinedMin :: forall (m :: * -> *).
MonadSTM m =>
Chain Block -> [Point Block] -> TestClientPipelined m
testClientPipelinedMin Chain Block
chain [Point Block]
points =
[ChainRange (Point Block)]
-> BlockFetchClientPipelined
Block (Point Block) m [Either (ChainRange (Point Block)) [Block]]
forall block point (m :: * -> *).
Monad m =>
[ChainRange point]
-> BlockFetchClientPipelined
block point m [Either (ChainRange point) [block]]
blockFetchClientPipelinedMin (Chain Block -> [Point Block] -> [ChainRange (Point Block)]
forall block.
HasHeader block =>
Chain block -> [Point block] -> [ChainRange (Point block)]
pointsToRanges Chain Block
chain [Point Block]
points)
testClientPipelinedLimited :: forall (m :: * -> *).
MonadSTM m =>
Int -> Chain Block -> [Point Block] -> TestClientPipelined m
testClientPipelinedLimited Int
omax Chain Block
chain [Point Block]
points =
Int
-> [ChainRange (Point Block)]
-> BlockFetchClientPipelined
Block (Point Block) m [Either (ChainRange (Point Block)) [Block]]
forall block point (m :: * -> *).
Monad m =>
Int
-> [ChainRange point]
-> BlockFetchClientPipelined
block point m [Either (ChainRange point) [block]]
blockFetchClientPipelinedLimited Int
omax (Chain Block -> [Point Block] -> [ChainRange (Point Block)]
forall block.
HasHeader block =>
Chain block -> [Point block] -> [ChainRange (Point block)]
pointsToRanges Chain Block
chain [Point Block]
points)
prop_direct :: TestChainAndPoints -> Bool
prop_direct :: TestChainAndPoints -> Bool
prop_direct (TestChainAndPoints Chain Block
chain [Point Block]
points) =
(forall s. IOSim s ([Block], ())) -> ([Block], ())
forall a. (forall s. IOSim s a) -> a
runSimOrThrow (BlockFetchClient Block (Point Block) (IOSim s) [Block]
-> BlockFetchServer Block (Point Block) (IOSim s) ()
-> IOSim s ([Block], ())
forall block point (m :: * -> *) a b.
Monad m =>
BlockFetchClient block point m a
-> BlockFetchServer block point m b -> m (a, b)
direct (Chain Block
-> [Point Block]
-> BlockFetchClient Block (Point Block) (IOSim s) [Block]
forall (m :: * -> *).
MonadSTM m =>
Chain Block -> [Point Block] -> TestClient m
testClient Chain Block
chain [Point Block]
points)
(Chain Block -> BlockFetchServer Block (Point Block) (IOSim s) ()
forall (m :: * -> *). MonadSTM m => Chain Block -> TestServer m
testServer Chain Block
chain))
([Block], ()) -> ([Block], ()) -> Bool
forall a. Eq a => a -> a -> Bool
==
([Block] -> [Block]
forall a. [a] -> [a]
reverse ([Block] -> [Block])
-> ([[Block]] -> [Block]) -> [[Block]] -> [Block]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[Block]] -> [Block]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[Block]] -> [Block]) -> [[Block]] -> [Block]
forall a b. (a -> b) -> a -> b
$ Chain Block -> [Point Block] -> [[Block]]
receivedBlockBodies Chain Block
chain [Point Block]
points, ())
prop_directPipelined1 :: TestChainAndPoints -> Bool
prop_directPipelined1 :: TestChainAndPoints -> Bool
prop_directPipelined1 (TestChainAndPoints Chain Block
chain [Point Block]
points) =
case (forall s.
IOSim s ([Either (ChainRange (Point Block)) [Block]], ()))
-> ([Either (ChainRange (Point Block)) [Block]], ())
forall a. (forall s. IOSim s a) -> a
runSimOrThrow (BlockFetchClientPipelined
Block
(Point Block)
(IOSim s)
[Either (ChainRange (Point Block)) [Block]]
-> BlockFetchServer Block (Point Block) (IOSim s) ()
-> IOSim s ([Either (ChainRange (Point Block)) [Block]], ())
forall block point (m :: * -> *) a b.
Monad m =>
BlockFetchClientPipelined block point m a
-> BlockFetchServer block point m b -> m (a, b)
directPipelined (Chain Block
-> [Point Block]
-> BlockFetchClientPipelined
Block
(Point Block)
(IOSim s)
[Either (ChainRange (Point Block)) [Block]]
forall (m :: * -> *).
MonadSTM m =>
Chain Block -> [Point Block] -> TestClientPipelined m
testClientPipelinedMax Chain Block
chain [Point Block]
points)
(Chain Block -> BlockFetchServer Block (Point Block) (IOSim s) ()
forall (m :: * -> *). MonadSTM m => Chain Block -> TestServer m
testServer Chain Block
chain)) of
([Either (ChainRange (Point Block)) [Block]]
res, ()) ->
[Either (ChainRange (Point Block)) [Block]]
-> [Either (ChainRange (Point Block)) [Block]]
forall a. [a] -> [a]
reverse ((Either (ChainRange (Point Block)) [Block]
-> Either (ChainRange (Point Block)) [Block])
-> [Either (ChainRange (Point Block)) [Block]]
-> [Either (ChainRange (Point Block)) [Block]]
forall a b. (a -> b) -> [a] -> [b]
map (([Block] -> [Block])
-> Either (ChainRange (Point Block)) [Block]
-> Either (ChainRange (Point Block)) [Block]
forall a b.
(a -> b)
-> Either (ChainRange (Point Block)) a
-> Either (ChainRange (Point Block)) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Block] -> [Block]
forall a. [a] -> [a]
reverse) [Either (ChainRange (Point Block)) [Block]]
res)
[Either (ChainRange (Point Block)) [Block]]
-> [Either (ChainRange (Point Block)) [Block]] -> Bool
forall a. Eq a => a -> a -> Bool
==
(ChainRange (Point Block)
-> Either (ChainRange (Point Block)) [Block])
-> [ChainRange (Point Block)]
-> [Either (ChainRange (Point Block)) [Block]]
forall a b. (a -> b) -> [a] -> [b]
map ChainRange (Point Block)
-> Either (ChainRange (Point Block)) [Block]
forall a b. a -> Either a b
Left (Chain Block -> [Point Block] -> [ChainRange (Point Block)]
forall block.
HasHeader block =>
Chain block -> [Point block] -> [ChainRange (Point block)]
pointsToRanges Chain Block
chain [Point Block]
points)
[Either (ChainRange (Point Block)) [Block]]
-> [Either (ChainRange (Point Block)) [Block]]
-> [Either (ChainRange (Point Block)) [Block]]
forall a. [a] -> [a] -> [a]
++ ([Block] -> Either (ChainRange (Point Block)) [Block])
-> [[Block]] -> [Either (ChainRange (Point Block)) [Block]]
forall a b. (a -> b) -> [a] -> [b]
map [Block] -> Either (ChainRange (Point Block)) [Block]
forall a b. b -> Either a b
Right (Chain Block -> [Point Block] -> [[Block]]
receivedBlockBodies Chain Block
chain [Point Block]
points)
prop_directPipelined2 :: TestChainAndPoints -> Bool
prop_directPipelined2 :: TestChainAndPoints -> Bool
prop_directPipelined2 (TestChainAndPoints Chain Block
chain [Point Block]
points) =
case (forall s.
IOSim s ([Either (ChainRange (Point Block)) [Block]], ()))
-> ([Either (ChainRange (Point Block)) [Block]], ())
forall a. (forall s. IOSim s a) -> a
runSimOrThrow (BlockFetchClientPipelined
Block
(Point Block)
(IOSim s)
[Either (ChainRange (Point Block)) [Block]]
-> BlockFetchServer Block (Point Block) (IOSim s) ()
-> IOSim s ([Either (ChainRange (Point Block)) [Block]], ())
forall block point (m :: * -> *) a b.
Monad m =>
BlockFetchClientPipelined block point m a
-> BlockFetchServer block point m b -> m (a, b)
directPipelined (Chain Block
-> [Point Block]
-> BlockFetchClientPipelined
Block
(Point Block)
(IOSim s)
[Either (ChainRange (Point Block)) [Block]]
forall (m :: * -> *).
MonadSTM m =>
Chain Block -> [Point Block] -> TestClientPipelined m
testClientPipelinedMin Chain Block
chain [Point Block]
points)
(Chain Block -> BlockFetchServer Block (Point Block) (IOSim s) ()
forall (m :: * -> *). MonadSTM m => Chain Block -> TestServer m
testServer Chain Block
chain)) of
([Either (ChainRange (Point Block)) [Block]]
res, ()) ->
[Either (ChainRange (Point Block)) [Block]]
-> [Either (ChainRange (Point Block)) [Block]]
forall a. [a] -> [a]
reverse ((Either (ChainRange (Point Block)) [Block]
-> Either (ChainRange (Point Block)) [Block])
-> [Either (ChainRange (Point Block)) [Block]]
-> [Either (ChainRange (Point Block)) [Block]]
forall a b. (a -> b) -> [a] -> [b]
map (([Block] -> [Block])
-> Either (ChainRange (Point Block)) [Block]
-> Either (ChainRange (Point Block)) [Block]
forall a b.
(a -> b)
-> Either (ChainRange (Point Block)) a
-> Either (ChainRange (Point Block)) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Block] -> [Block]
forall a. [a] -> [a]
reverse) [Either (ChainRange (Point Block)) [Block]]
res)
[Either (ChainRange (Point Block)) [Block]]
-> [Either (ChainRange (Point Block)) [Block]] -> Bool
forall a. Eq a => a -> a -> Bool
==
[[Either (ChainRange (Point Block)) [Block]]]
-> [Either (ChainRange (Point Block)) [Block]]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [ [ChainRange (Point Block)
-> Either (ChainRange (Point Block)) [Block]
forall a b. a -> Either a b
Left ChainRange (Point Block)
l, [Block] -> Either (ChainRange (Point Block)) [Block]
forall a b. b -> Either a b
Right [Block]
r]
| ChainRange (Point Block)
l <- Chain Block -> [Point Block] -> [ChainRange (Point Block)]
forall block.
HasHeader block =>
Chain block -> [Point block] -> [ChainRange (Point block)]
pointsToRanges Chain Block
chain [Point Block]
points
| [Block]
r <- Chain Block -> [Point Block] -> [[Block]]
receivedBlockBodies Chain Block
chain [Point Block]
points ]
prop_connect :: TestChainAndPoints -> Bool
prop_connect :: TestChainAndPoints -> Bool
prop_connect (TestChainAndPoints Chain Block
chain [Point Block]
points) =
case (forall s.
IOSim
s ([Block], (), TerminalStates (BlockFetch Block (Point Block))))
-> ([Block], (), TerminalStates (BlockFetch Block (Point Block)))
forall a. (forall s. IOSim s a) -> a
runSimOrThrow
(Peer
(BlockFetch Block (Point Block))
'AsClient
'BFIdle
(IOSim s)
[Block]
-> Peer
(BlockFetch Block (Point Block))
(FlipAgency 'AsClient)
'BFIdle
(IOSim s)
()
-> IOSim
s ([Block], (), TerminalStates (BlockFetch Block (Point Block)))
forall ps (pr :: PeerRole) (st :: ps) (m :: * -> *) a b.
(Monad m, Protocol ps) =>
Peer ps pr st m a
-> Peer ps (FlipAgency pr) st m b -> m (a, b, TerminalStates ps)
connect
(BlockFetchClient Block (Point Block) (IOSim s) [Block]
-> Peer
(BlockFetch Block (Point Block))
'AsClient
'BFIdle
(IOSim s)
[Block]
forall block point (m :: * -> *) a.
Monad m =>
BlockFetchClient block point m a
-> Peer (BlockFetch block point) 'AsClient 'BFIdle m a
blockFetchClientPeer (Chain Block
-> [Point Block]
-> BlockFetchClient Block (Point Block) (IOSim s) [Block]
forall (m :: * -> *).
MonadSTM m =>
Chain Block -> [Point Block] -> TestClient m
testClient Chain Block
chain [Point Block]
points))
(BlockFetchServer Block (Point Block) (IOSim s) ()
-> Peer
(BlockFetch Block (Point Block)) 'AsServer 'BFIdle (IOSim s) ()
forall block point (m :: * -> *) a.
Functor m =>
BlockFetchServer block point m a
-> Peer (BlockFetch block point) 'AsServer 'BFIdle m a
blockFetchServerPeer (Chain Block -> BlockFetchServer Block (Point Block) (IOSim s) ()
forall (m :: * -> *). MonadSTM m => Chain Block -> TestServer m
testServer Chain Block
chain))) of
([Block]
bodies, (), TerminalStates NobodyHasAgency st
R:NobodyHasAgencyBlockFetchst (*) (*) Block (Point Block) st
TokDone NobodyHasAgency st
R:NobodyHasAgencyBlockFetchst (*) (*) Block (Point Block) 'BFDone
TokDone) ->
[Block] -> [Block]
forall a. [a] -> [a]
reverse [Block]
bodies [Block] -> [Block] -> Bool
forall a. Eq a => a -> a -> Bool
== [[Block]] -> [Block]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (Chain Block -> [Point Block] -> [[Block]]
receivedBlockBodies Chain Block
chain [Point Block]
points)
connect_pipelined :: MonadSTM m
=> TestClientPipelined m
-> Chain Block
-> [Bool]
-> m [Either (ChainRange (Point Block)) [Block]]
connect_pipelined :: forall (m :: * -> *).
MonadSTM m =>
TestClientPipelined m
-> Chain Block
-> [Bool]
-> m [Either (ChainRange (Point Block)) [Block]]
connect_pipelined TestClientPipelined m
client Chain Block
chain [Bool]
cs = do
(res, _, TerminalStates TokDone TokDone)
<- [Bool]
-> PeerPipelined
(BlockFetch Block (Point Block))
'AsClient
'BFIdle
m
[Either (ChainRange (Point Block)) [Block]]
-> Peer
(BlockFetch Block (Point Block))
(FlipAgency 'AsClient)
'BFIdle
m
()
-> m ([Either (ChainRange (Point Block)) [Block]], (),
TerminalStates (BlockFetch Block (Point Block)))
forall ps (pr :: PeerRole) (st :: ps) (m :: * -> *) a b.
(Monad m, Protocol ps) =>
[Bool]
-> PeerPipelined ps pr st m a
-> Peer ps (FlipAgency pr) st m b
-> m (a, b, TerminalStates ps)
connectPipelined [Bool]
cs
(TestClientPipelined m
-> PeerPipelined
(BlockFetch Block (Point Block))
'AsClient
'BFIdle
m
[Either (ChainRange (Point Block)) [Block]]
forall block point (m :: * -> *) a.
Monad m =>
BlockFetchClientPipelined block point m a
-> PeerPipelined (BlockFetch block point) 'AsClient 'BFIdle m a
blockFetchClientPeerPipelined TestClientPipelined m
client)
(BlockFetchServer Block (Point Block) m ()
-> Peer (BlockFetch Block (Point Block)) 'AsServer 'BFIdle m ()
forall block point (m :: * -> *) a.
Functor m =>
BlockFetchServer block point m a
-> Peer (BlockFetch block point) 'AsServer 'BFIdle m a
blockFetchServerPeer (Chain Block -> BlockFetchServer Block (Point Block) m ()
forall (m :: * -> *). MonadSTM m => Chain Block -> TestServer m
testServer Chain Block
chain))
return $ reverse $ map (fmap reverse) res
prop_connect_pipelined1 :: TestChainAndPoints -> [Bool] -> Bool
prop_connect_pipelined1 :: TestChainAndPoints -> [Bool] -> Bool
prop_connect_pipelined1 (TestChainAndPoints Chain Block
chain [Point Block]
points) [Bool]
choices =
(forall s. IOSim s [Either (ChainRange (Point Block)) [Block]])
-> [Either (ChainRange (Point Block)) [Block]]
forall a. (forall s. IOSim s a) -> a
runSimOrThrow
(TestClientPipelined (IOSim s)
-> Chain Block
-> [Bool]
-> IOSim s [Either (ChainRange (Point Block)) [Block]]
forall (m :: * -> *).
MonadSTM m =>
TestClientPipelined m
-> Chain Block
-> [Bool]
-> m [Either (ChainRange (Point Block)) [Block]]
connect_pipelined (Chain Block -> [Point Block] -> TestClientPipelined (IOSim s)
forall (m :: * -> *).
MonadSTM m =>
Chain Block -> [Point Block] -> TestClientPipelined m
testClientPipelinedMax Chain Block
chain [Point Block]
points) Chain Block
chain [Bool]
choices)
[Either (ChainRange (Point Block)) [Block]]
-> [Either (ChainRange (Point Block)) [Block]] -> Bool
forall a. Eq a => a -> a -> Bool
==
(ChainRange (Point Block)
-> Either (ChainRange (Point Block)) [Block])
-> [ChainRange (Point Block)]
-> [Either (ChainRange (Point Block)) [Block]]
forall a b. (a -> b) -> [a] -> [b]
map ChainRange (Point Block)
-> Either (ChainRange (Point Block)) [Block]
forall a b. a -> Either a b
Left (Chain Block -> [Point Block] -> [ChainRange (Point Block)]
forall block.
HasHeader block =>
Chain block -> [Point block] -> [ChainRange (Point block)]
pointsToRanges Chain Block
chain [Point Block]
points)
[Either (ChainRange (Point Block)) [Block]]
-> [Either (ChainRange (Point Block)) [Block]]
-> [Either (ChainRange (Point Block)) [Block]]
forall a. [a] -> [a] -> [a]
++ ([Block] -> Either (ChainRange (Point Block)) [Block])
-> [[Block]] -> [Either (ChainRange (Point Block)) [Block]]
forall a b. (a -> b) -> [a] -> [b]
map [Block] -> Either (ChainRange (Point Block)) [Block]
forall a b. b -> Either a b
Right (Chain Block -> [Point Block] -> [[Block]]
receivedBlockBodies Chain Block
chain [Point Block]
points)
prop_connect_pipelined2 :: TestChainAndPoints -> Bool
prop_connect_pipelined2 :: TestChainAndPoints -> Bool
prop_connect_pipelined2 (TestChainAndPoints Chain Block
chain [Point Block]
points) =
(forall s. IOSim s [Either (ChainRange (Point Block)) [Block]])
-> [Either (ChainRange (Point Block)) [Block]]
forall a. (forall s. IOSim s a) -> a
runSimOrThrow
(TestClientPipelined (IOSim s)
-> Chain Block
-> [Bool]
-> IOSim s [Either (ChainRange (Point Block)) [Block]]
forall (m :: * -> *).
MonadSTM m =>
TestClientPipelined m
-> Chain Block
-> [Bool]
-> m [Either (ChainRange (Point Block)) [Block]]
connect_pipelined (Chain Block -> [Point Block] -> TestClientPipelined (IOSim s)
forall (m :: * -> *).
MonadSTM m =>
Chain Block -> [Point Block] -> TestClientPipelined m
testClientPipelinedMin Chain Block
chain [Point Block]
points) Chain Block
chain [Bool]
choices)
[Either (ChainRange (Point Block)) [Block]]
-> [Either (ChainRange (Point Block)) [Block]] -> Bool
forall a. Eq a => a -> a -> Bool
==
(ChainRange (Point Block)
-> Either (ChainRange (Point Block)) [Block])
-> [ChainRange (Point Block)]
-> [Either (ChainRange (Point Block)) [Block]]
forall a b. (a -> b) -> [a] -> [b]
map ChainRange (Point Block)
-> Either (ChainRange (Point Block)) [Block]
forall a b. a -> Either a b
Left (Chain Block -> [Point Block] -> [ChainRange (Point Block)]
forall block.
HasHeader block =>
Chain block -> [Point block] -> [ChainRange (Point block)]
pointsToRanges Chain Block
chain [Point Block]
points)
[Either (ChainRange (Point Block)) [Block]]
-> [Either (ChainRange (Point Block)) [Block]]
-> [Either (ChainRange (Point Block)) [Block]]
forall a. [a] -> [a] -> [a]
++ ([Block] -> Either (ChainRange (Point Block)) [Block])
-> [[Block]] -> [Either (ChainRange (Point Block)) [Block]]
forall a b. (a -> b) -> [a] -> [b]
map [Block] -> Either (ChainRange (Point Block)) [Block]
forall a b. b -> Either a b
Right (Chain Block -> [Point Block] -> [[Block]]
receivedBlockBodies Chain Block
chain [Point Block]
points)
where
choices :: [Bool]
choices = Bool -> [Bool]
forall a. a -> [a]
repeat Bool
True
prop_connect_pipelined3 :: TestChainAndPoints -> Bool
prop_connect_pipelined3 :: TestChainAndPoints -> Bool
prop_connect_pipelined3 (TestChainAndPoints Chain Block
chain [Point Block]
points) =
(forall s. IOSim s [Either (ChainRange (Point Block)) [Block]])
-> [Either (ChainRange (Point Block)) [Block]]
forall a. (forall s. IOSim s a) -> a
runSimOrThrow
(TestClientPipelined (IOSim s)
-> Chain Block
-> [Bool]
-> IOSim s [Either (ChainRange (Point Block)) [Block]]
forall (m :: * -> *).
MonadSTM m =>
TestClientPipelined m
-> Chain Block
-> [Bool]
-> m [Either (ChainRange (Point Block)) [Block]]
connect_pipelined (Chain Block -> [Point Block] -> TestClientPipelined (IOSim s)
forall (m :: * -> *).
MonadSTM m =>
Chain Block -> [Point Block] -> TestClientPipelined m
testClientPipelinedMin Chain Block
chain [Point Block]
points) Chain Block
chain [Bool]
choices)
[Either (ChainRange (Point Block)) [Block]]
-> [Either (ChainRange (Point Block)) [Block]] -> Bool
forall a. Eq a => a -> a -> Bool
==
[[Either (ChainRange (Point Block)) [Block]]]
-> [Either (ChainRange (Point Block)) [Block]]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [ [ChainRange (Point Block)
-> Either (ChainRange (Point Block)) [Block]
forall a b. a -> Either a b
Left ChainRange (Point Block)
l, [Block] -> Either (ChainRange (Point Block)) [Block]
forall a b. b -> Either a b
Right [Block]
r]
| ChainRange (Point Block)
l <- Chain Block -> [Point Block] -> [ChainRange (Point Block)]
forall block.
HasHeader block =>
Chain block -> [Point block] -> [ChainRange (Point block)]
pointsToRanges Chain Block
chain [Point Block]
points
| [Block]
r <- Chain Block -> [Point Block] -> [[Block]]
receivedBlockBodies Chain Block
chain [Point Block]
points ]
where
choices :: [Bool]
choices = Bool -> [Bool]
forall a. a -> [a]
repeat Bool
False
prop_connect_pipelined4 :: TestChainAndPoints -> [Bool] -> Bool
prop_connect_pipelined4 :: TestChainAndPoints -> [Bool] -> Bool
prop_connect_pipelined4 (TestChainAndPoints Chain Block
chain [Point Block]
points) [Bool]
choices =
(forall s. IOSim s [Either (ChainRange (Point Block)) [Block]])
-> [Either (ChainRange (Point Block)) [Block]]
forall a. (forall s. IOSim s a) -> a
runSimOrThrow
(TestClientPipelined (IOSim s)
-> Chain Block
-> [Bool]
-> IOSim s [Either (ChainRange (Point Block)) [Block]]
forall (m :: * -> *).
MonadSTM m =>
TestClientPipelined m
-> Chain Block
-> [Bool]
-> m [Either (ChainRange (Point Block)) [Block]]
connect_pipelined (Chain Block -> [Point Block] -> TestClientPipelined (IOSim s)
forall (m :: * -> *).
MonadSTM m =>
Chain Block -> [Point Block] -> TestClientPipelined m
testClientPipelinedMin Chain Block
chain [Point Block]
points) Chain Block
chain [Bool]
choices)
[Either (ChainRange (Point Block)) [Block]]
-> [Either (ChainRange (Point Block)) [Block]] -> Bool
forall a. Eq a => a -> a -> Bool
==
Int
-> [Bool]
-> [ChainRange (Point Block)]
-> [[Block]]
-> [Either (ChainRange (Point Block)) [Block]]
forall req resp.
Int -> [Bool] -> [req] -> [resp] -> [Either req resp]
pipelineInterleaving Int
forall a. Bounded a => a
maxBound [Bool]
choices
(Chain Block -> [Point Block] -> [ChainRange (Point Block)]
forall block.
HasHeader block =>
Chain block -> [Point block] -> [ChainRange (Point block)]
pointsToRanges Chain Block
chain [Point Block]
points)
(Chain Block -> [Point Block] -> [[Block]]
receivedBlockBodies Chain Block
chain [Point Block]
points)
prop_connect_pipelined5 :: TestChainAndPoints -> PipeliningDepth
-> [Bool] -> Bool
prop_connect_pipelined5 :: TestChainAndPoints -> PipeliningDepth -> [Bool] -> Bool
prop_connect_pipelined5 (TestChainAndPoints Chain Block
chain [Point Block]
points)
(PipeliningDepth Int
omax) [Bool]
choices =
(forall s. IOSim s [Either (ChainRange (Point Block)) [Block]])
-> [Either (ChainRange (Point Block)) [Block]]
forall a. (forall s. IOSim s a) -> a
runSimOrThrow
(TestClientPipelined (IOSim s)
-> Chain Block
-> [Bool]
-> IOSim s [Either (ChainRange (Point Block)) [Block]]
forall (m :: * -> *).
MonadSTM m =>
TestClientPipelined m
-> Chain Block
-> [Bool]
-> m [Either (ChainRange (Point Block)) [Block]]
connect_pipelined (Int
-> Chain Block -> [Point Block] -> TestClientPipelined (IOSim s)
forall (m :: * -> *).
MonadSTM m =>
Int -> Chain Block -> [Point Block] -> TestClientPipelined m
testClientPipelinedLimited Int
omax Chain Block
chain [Point Block]
points)
Chain Block
chain [Bool]
choices)
[Either (ChainRange (Point Block)) [Block]]
-> [Either (ChainRange (Point Block)) [Block]] -> Bool
forall a. Eq a => a -> a -> Bool
==
Int
-> [Bool]
-> [ChainRange (Point Block)]
-> [[Block]]
-> [Either (ChainRange (Point Block)) [Block]]
forall req resp.
Int -> [Bool] -> [req] -> [resp] -> [Either req resp]
pipelineInterleaving (Int
omax) [Bool]
choices
(Chain Block -> [Point Block] -> [ChainRange (Point Block)]
forall block.
HasHeader block =>
Chain block -> [Point block] -> [ChainRange (Point block)]
pointsToRanges Chain Block
chain [Point Block]
points)
(Chain Block -> [Point Block] -> [[Block]]
receivedBlockBodies Chain Block
chain [Point Block]
points)
prop_channel :: (MonadAsync m, MonadCatch m, MonadST m)
=> m (Channel m ByteString, Channel m ByteString)
-> Chain Block -> [Point Block] -> m Property
prop_channel :: forall (m :: * -> *).
(MonadAsync m, MonadCatch m, MonadST m) =>
m (Channel m ByteString, Channel m ByteString)
-> Chain Block -> [Point Block] -> m Property
prop_channel m (Channel m ByteString, Channel m ByteString)
createChannels Chain Block
chain [Point Block]
points = do
(bodies, ()) <-
m (Channel m ByteString, Channel m ByteString)
-> Tracer m (Role, TraceSendRecv (BlockFetch Block (Point Block)))
-> Codec
(BlockFetch Block (Point Block)) DeserialiseFailure m ByteString
-> Peer
(BlockFetch Block (Point Block)) 'AsClient 'BFIdle m [Block]
-> Peer
(BlockFetch Block (Point Block))
(FlipAgency 'AsClient)
'BFIdle
m
()
-> m ([Block], ())
forall (m :: * -> *) failure ps bytes (pr :: PeerRole) (st :: ps) a
b.
(MonadAsync m, MonadCatch m, Show failure,
forall (st' :: ps). Show (ClientHasAgency st'),
forall (st' :: ps). Show (ServerHasAgency st'), ShowProxy ps) =>
m (Channel m bytes, Channel m bytes)
-> Tracer m (Role, TraceSendRecv ps)
-> Codec ps failure m bytes
-> Peer ps pr st m a
-> Peer ps (FlipAgency pr) st m b
-> m (a, b)
runConnectedPeers
m (Channel m ByteString, Channel m ByteString)
createChannels Tracer m (Role, TraceSendRecv (BlockFetch Block (Point Block)))
forall (m :: * -> *) a. Applicative m => Tracer m a
nullTracer
Codec
(BlockFetch Block (Point Block)) DeserialiseFailure m ByteString
forall (m :: * -> *).
MonadST m =>
Codec
(BlockFetch Block (Point Block)) DeserialiseFailure m ByteString
codec
(BlockFetchClient Block (Point Block) m [Block]
-> Peer
(BlockFetch Block (Point Block)) 'AsClient 'BFIdle m [Block]
forall block point (m :: * -> *) a.
Monad m =>
BlockFetchClient block point m a
-> Peer (BlockFetch block point) 'AsClient 'BFIdle m a
blockFetchClientPeer (Chain Block
-> [Point Block] -> BlockFetchClient Block (Point Block) m [Block]
forall (m :: * -> *).
MonadSTM m =>
Chain Block -> [Point Block] -> TestClient m
testClient Chain Block
chain [Point Block]
points))
(BlockFetchServer Block (Point Block) m ()
-> Peer (BlockFetch Block (Point Block)) 'AsServer 'BFIdle m ()
forall block point (m :: * -> *) a.
Functor m =>
BlockFetchServer block point m a
-> Peer (BlockFetch block point) 'AsServer 'BFIdle m a
blockFetchServerPeer (Chain Block -> BlockFetchServer Block (Point Block) m ()
forall (m :: * -> *). MonadSTM m => Chain Block -> TestServer m
testServer Chain Block
chain))
return $ reverse bodies === concat (receivedBlockBodies chain points)
prop_channel_ST :: TestChainAndPoints -> Property
prop_channel_ST :: TestChainAndPoints -> Property
prop_channel_ST (TestChainAndPoints Chain Block
chain [Point Block]
points) =
(forall s. IOSim s Property) -> Property
forall a. (forall s. IOSim s a) -> a
runSimOrThrow (IOSim
s (Channel (IOSim s) ByteString, Channel (IOSim s) ByteString)
-> Chain Block -> [Point Block] -> IOSim s Property
forall (m :: * -> *).
(MonadAsync m, MonadCatch m, MonadST m) =>
m (Channel m ByteString, Channel m ByteString)
-> Chain Block -> [Point Block] -> m Property
prop_channel IOSim
s (Channel (IOSim s) ByteString, Channel (IOSim s) ByteString)
forall (m :: * -> *) a. MonadSTM m => m (Channel m a, Channel m a)
createConnectedChannels Chain Block
chain [Point Block]
points)
prop_channel_IO :: TestChainAndPoints -> Property
prop_channel_IO :: TestChainAndPoints -> Property
prop_channel_IO (TestChainAndPoints Chain Block
chain [Point Block]
points) =
IO Property -> Property
forall prop. Testable prop => IO prop -> Property
ioProperty (IO (Channel IO ByteString, Channel IO ByteString)
-> Chain Block -> [Point Block] -> IO Property
forall (m :: * -> *).
(MonadAsync m, MonadCatch m, MonadST m) =>
m (Channel m ByteString, Channel m ByteString)
-> Chain Block -> [Point Block] -> m Property
prop_channel IO (Channel IO ByteString, Channel IO ByteString)
forall (m :: * -> *) a. MonadSTM m => m (Channel m a, Channel m a)
createConnectedChannels Chain Block
chain [Point Block]
points)
prop_pipe_IO :: TestChainAndPoints -> Property
prop_pipe_IO :: TestChainAndPoints -> Property
prop_pipe_IO (TestChainAndPoints Chain Block
chain [Point Block]
points) =
IO Property -> Property
forall prop. Testable prop => IO prop -> Property
ioProperty (IO (Channel IO ByteString, Channel IO ByteString)
-> Chain Block -> [Point Block] -> IO Property
forall (m :: * -> *).
(MonadAsync m, MonadCatch m, MonadST m) =>
m (Channel m ByteString, Channel m ByteString)
-> Chain Block -> [Point Block] -> m Property
prop_channel IO (Channel IO ByteString, Channel IO ByteString)
createPipeConnectedChannels Chain Block
chain [Point Block]
points)
codec :: MonadST m
=> Codec (BlockFetch Block (Point Block))
S.DeserialiseFailure
m ByteString
codec :: forall (m :: * -> *).
MonadST m =>
Codec
(BlockFetch Block (Point Block)) DeserialiseFailure m ByteString
codec = (Block -> Encoding)
-> (forall s. Decoder s Block)
-> (Point Block -> Encoding)
-> (forall s. Decoder s (Point Block))
-> Codec
(BlockFetch Block (Point Block)) DeserialiseFailure m ByteString
forall block point (m :: * -> *).
MonadST m =>
(block -> Encoding)
-> (forall s. Decoder s block)
-> (point -> Encoding)
-> (forall s. Decoder s point)
-> Codec (BlockFetch block point) DeserialiseFailure m ByteString
codecBlockFetch Block -> Encoding
forall a. Serialise a => a -> Encoding
S.encode Decoder s Block
forall s. Decoder s Block
forall a s. Serialise a => Decoder s a
S.decode
Point Block -> Encoding
forall a. Serialise a => a -> Encoding
S.encode Decoder s (Point Block)
forall s. Decoder s (Point Block)
forall a s. Serialise a => Decoder s a
S.decode
codecWrapped :: MonadST m
=> Codec (BlockFetch Block (Point Block))
S.DeserialiseFailure
m ByteString
codecWrapped :: forall (m :: * -> *).
MonadST m =>
Codec
(BlockFetch Block (Point Block)) DeserialiseFailure m ByteString
codecWrapped =
(Block -> Encoding)
-> (forall s. Decoder s Block)
-> (Point Block -> Encoding)
-> (forall s. Decoder s (Point Block))
-> Codec
(BlockFetch Block (Point Block)) DeserialiseFailure m ByteString
forall block point (m :: * -> *).
MonadST m =>
(block -> Encoding)
-> (forall s. Decoder s block)
-> (point -> Encoding)
-> (forall s. Decoder s point)
-> Codec (BlockFetch block point) DeserialiseFailure m ByteString
codecBlockFetch
((Block -> Encoding) -> Block -> Encoding
forall a. (a -> Encoding) -> a -> Encoding
wrapCBORinCBOR Block -> Encoding
forall a. Serialise a => a -> Encoding
S.encode) ((forall s. Decoder s (ByteString -> Block))
-> forall s. Decoder s Block
forall a.
(forall s. Decoder s (ByteString -> a)) -> forall s. Decoder s a
unwrapCBORinCBOR (Block -> ByteString -> Block
forall a b. a -> b -> a
const (Block -> ByteString -> Block)
-> Decoder s Block -> Decoder s (ByteString -> Block)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s Block
forall s. Decoder s Block
forall a s. Serialise a => Decoder s a
S.decode))
Point Block -> Encoding
forall a. Serialise a => a -> Encoding
S.encode Decoder s (Point Block)
forall s. Decoder s (Point Block)
forall a s. Serialise a => Decoder s a
S.decode
codecSerialised :: MonadST m
=> Codec (BlockFetch (Serialised Block) (Point Block))
S.DeserialiseFailure
m ByteString
codecSerialised :: forall (m :: * -> *).
MonadST m =>
Codec
(BlockFetch (Serialised Block) (Point Block))
DeserialiseFailure
m
ByteString
codecSerialised = (Serialised Block -> Encoding)
-> (forall s. Decoder s (Serialised Block))
-> (Point Block -> Encoding)
-> (forall s. Decoder s (Point Block))
-> Codec
(BlockFetch (Serialised Block) (Point Block))
DeserialiseFailure
m
ByteString
forall block point (m :: * -> *).
MonadST m =>
(block -> Encoding)
-> (forall s. Decoder s block)
-> (point -> Encoding)
-> (forall s. Decoder s point)
-> Codec (BlockFetch block point) DeserialiseFailure m ByteString
codecBlockFetch Serialised Block -> Encoding
forall a. Serialise a => a -> Encoding
S.encode Decoder s (Serialised Block)
forall s. Decoder s (Serialised Block)
forall a s. Serialise a => Decoder s a
S.decode Point Block -> Encoding
forall a. Serialise a => a -> Encoding
S.encode Decoder s (Point Block)
forall s. Decoder s (Point Block)
forall a s. Serialise a => Decoder s a
S.decode
instance Arbitrary point => Arbitrary (ChainRange point) where
arbitrary :: Gen (ChainRange point)
arbitrary = point -> point -> ChainRange point
forall point. point -> point -> ChainRange point
ChainRange (point -> point -> ChainRange point)
-> Gen point -> Gen (point -> ChainRange point)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen point
forall a. Arbitrary a => Gen a
arbitrary Gen (point -> ChainRange point)
-> Gen point -> Gen (ChainRange point)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen point
forall a. Arbitrary a => Gen a
arbitrary
shrink :: ChainRange point -> [ChainRange point]
shrink (ChainRange point
a point
b) =
[ point -> point -> ChainRange point
forall point. point -> point -> ChainRange point
ChainRange point
a' point
b
| point
a' <- point -> [point]
forall a. Arbitrary a => a -> [a]
shrink point
a
]
[ChainRange point] -> [ChainRange point] -> [ChainRange point]
forall a. [a] -> [a] -> [a]
++
[ point -> point -> ChainRange point
forall point. point -> point -> ChainRange point
ChainRange point
a point
b'
| point
b' <- point -> [point]
forall a. Arbitrary a => a -> [a]
shrink point
b
]
instance (Arbitrary block, Arbitrary point)
=> Arbitrary (AnyMessageAndAgency (BlockFetch block point)) where
arbitrary :: Gen (AnyMessageAndAgency (BlockFetch block point))
arbitrary = [Gen (AnyMessageAndAgency (BlockFetch block point))]
-> Gen (AnyMessageAndAgency (BlockFetch block point))
forall a. [Gen a] -> Gen a
oneof
[ PeerHasAgency 'AsClient 'BFIdle
-> Message (BlockFetch block point) 'BFIdle 'BFBusy
-> AnyMessageAndAgency (BlockFetch block point)
forall (pr :: PeerRole) ps (st :: ps) (st' :: ps).
PeerHasAgency pr st -> Message ps st st' -> AnyMessageAndAgency ps
AnyMessageAndAgency (ClientHasAgency 'BFIdle -> PeerHasAgency 'AsClient 'BFIdle
forall {ps} (st :: ps).
ClientHasAgency st -> PeerHasAgency 'AsClient st
ClientAgency ClientHasAgency 'BFIdle
forall {k} {k1} {block :: k} {point :: k1}. ClientHasAgency 'BFIdle
TokIdle) (Message (BlockFetch block point) 'BFIdle 'BFBusy
-> AnyMessageAndAgency (BlockFetch block point))
-> (ChainRange point
-> Message (BlockFetch block point) 'BFIdle 'BFBusy)
-> ChainRange point
-> AnyMessageAndAgency (BlockFetch block point)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ChainRange point
-> Message (BlockFetch block point) 'BFIdle 'BFBusy
forall {k} point1 (block :: k).
ChainRange point1
-> Message (BlockFetch block point1) 'BFIdle 'BFBusy
MsgRequestRange (ChainRange point -> AnyMessageAndAgency (BlockFetch block point))
-> Gen (ChainRange point)
-> Gen (AnyMessageAndAgency (BlockFetch block point))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (ChainRange point)
forall a. Arbitrary a => Gen a
arbitrary
, AnyMessageAndAgency (BlockFetch block point)
-> Gen (AnyMessageAndAgency (BlockFetch block point))
forall a. a -> Gen a
forall (m :: * -> *) a. Monad m => a -> m a
return (AnyMessageAndAgency (BlockFetch block point)
-> Gen (AnyMessageAndAgency (BlockFetch block point)))
-> AnyMessageAndAgency (BlockFetch block point)
-> Gen (AnyMessageAndAgency (BlockFetch block point))
forall a b. (a -> b) -> a -> b
$ PeerHasAgency 'AsServer 'BFBusy
-> Message (BlockFetch block point) 'BFBusy 'BFStreaming
-> AnyMessageAndAgency (BlockFetch block point)
forall (pr :: PeerRole) ps (st :: ps) (st' :: ps).
PeerHasAgency pr st -> Message ps st st' -> AnyMessageAndAgency ps
AnyMessageAndAgency (ServerHasAgency 'BFBusy -> PeerHasAgency 'AsServer 'BFBusy
forall {ps} (st :: ps).
ServerHasAgency st -> PeerHasAgency 'AsServer st
ServerAgency ServerHasAgency 'BFBusy
forall {k} {k1} {block :: k} {point :: k1}. ServerHasAgency 'BFBusy
TokBusy) Message (BlockFetch block point) 'BFBusy 'BFStreaming
forall {k} {k1} (block :: k) (point :: k1).
Message (BlockFetch block point) 'BFBusy 'BFStreaming
MsgStartBatch
, AnyMessageAndAgency (BlockFetch block point)
-> Gen (AnyMessageAndAgency (BlockFetch block point))
forall a. a -> Gen a
forall (m :: * -> *) a. Monad m => a -> m a
return (AnyMessageAndAgency (BlockFetch block point)
-> Gen (AnyMessageAndAgency (BlockFetch block point)))
-> AnyMessageAndAgency (BlockFetch block point)
-> Gen (AnyMessageAndAgency (BlockFetch block point))
forall a b. (a -> b) -> a -> b
$ PeerHasAgency 'AsServer 'BFBusy
-> Message (BlockFetch block point) 'BFBusy 'BFIdle
-> AnyMessageAndAgency (BlockFetch block point)
forall (pr :: PeerRole) ps (st :: ps) (st' :: ps).
PeerHasAgency pr st -> Message ps st st' -> AnyMessageAndAgency ps
AnyMessageAndAgency (ServerHasAgency 'BFBusy -> PeerHasAgency 'AsServer 'BFBusy
forall {ps} (st :: ps).
ServerHasAgency st -> PeerHasAgency 'AsServer st
ServerAgency ServerHasAgency 'BFBusy
forall {k} {k1} {block :: k} {point :: k1}. ServerHasAgency 'BFBusy
TokBusy) Message (BlockFetch block point) 'BFBusy 'BFIdle
forall {k} {k1} (block :: k) (point :: k1).
Message (BlockFetch block point) 'BFBusy 'BFIdle
MsgNoBlocks
, PeerHasAgency 'AsServer 'BFStreaming
-> Message (BlockFetch block point) 'BFStreaming 'BFStreaming
-> AnyMessageAndAgency (BlockFetch block point)
forall (pr :: PeerRole) ps (st :: ps) (st' :: ps).
PeerHasAgency pr st -> Message ps st st' -> AnyMessageAndAgency ps
AnyMessageAndAgency (ServerHasAgency 'BFStreaming
-> PeerHasAgency 'AsServer 'BFStreaming
forall {ps} (st :: ps).
ServerHasAgency st -> PeerHasAgency 'AsServer st
ServerAgency ServerHasAgency 'BFStreaming
forall {k} {k1} {block :: k} {point :: k1}.
ServerHasAgency 'BFStreaming
TokStreaming) (Message (BlockFetch block point) 'BFStreaming 'BFStreaming
-> AnyMessageAndAgency (BlockFetch block point))
-> (block
-> Message (BlockFetch block point) 'BFStreaming 'BFStreaming)
-> block
-> AnyMessageAndAgency (BlockFetch block point)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> block -> Message (BlockFetch block point) 'BFStreaming 'BFStreaming
forall {k1} block1 (point :: k1).
block1
-> Message (BlockFetch block1 point) 'BFStreaming 'BFStreaming
MsgBlock (block -> AnyMessageAndAgency (BlockFetch block point))
-> Gen block -> Gen (AnyMessageAndAgency (BlockFetch block point))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen block
forall a. Arbitrary a => Gen a
arbitrary
, AnyMessageAndAgency (BlockFetch block point)
-> Gen (AnyMessageAndAgency (BlockFetch block point))
forall a. a -> Gen a
forall (m :: * -> *) a. Monad m => a -> m a
return (AnyMessageAndAgency (BlockFetch block point)
-> Gen (AnyMessageAndAgency (BlockFetch block point)))
-> AnyMessageAndAgency (BlockFetch block point)
-> Gen (AnyMessageAndAgency (BlockFetch block point))
forall a b. (a -> b) -> a -> b
$ PeerHasAgency 'AsServer 'BFStreaming
-> Message (BlockFetch block point) 'BFStreaming 'BFIdle
-> AnyMessageAndAgency (BlockFetch block point)
forall (pr :: PeerRole) ps (st :: ps) (st' :: ps).
PeerHasAgency pr st -> Message ps st st' -> AnyMessageAndAgency ps
AnyMessageAndAgency (ServerHasAgency 'BFStreaming
-> PeerHasAgency 'AsServer 'BFStreaming
forall {ps} (st :: ps).
ServerHasAgency st -> PeerHasAgency 'AsServer st
ServerAgency ServerHasAgency 'BFStreaming
forall {k} {k1} {block :: k} {point :: k1}.
ServerHasAgency 'BFStreaming
TokStreaming) Message (BlockFetch block point) 'BFStreaming 'BFIdle
forall {k} {k1} (block :: k) (point :: k1).
Message (BlockFetch block point) 'BFStreaming 'BFIdle
MsgBatchDone
, AnyMessageAndAgency (BlockFetch block point)
-> Gen (AnyMessageAndAgency (BlockFetch block point))
forall a. a -> Gen a
forall (m :: * -> *) a. Monad m => a -> m a
return (AnyMessageAndAgency (BlockFetch block point)
-> Gen (AnyMessageAndAgency (BlockFetch block point)))
-> AnyMessageAndAgency (BlockFetch block point)
-> Gen (AnyMessageAndAgency (BlockFetch block point))
forall a b. (a -> b) -> a -> b
$ PeerHasAgency 'AsClient 'BFIdle
-> Message (BlockFetch block point) 'BFIdle 'BFDone
-> AnyMessageAndAgency (BlockFetch block point)
forall (pr :: PeerRole) ps (st :: ps) (st' :: ps).
PeerHasAgency pr st -> Message ps st st' -> AnyMessageAndAgency ps
AnyMessageAndAgency (ClientHasAgency 'BFIdle -> PeerHasAgency 'AsClient 'BFIdle
forall {ps} (st :: ps).
ClientHasAgency st -> PeerHasAgency 'AsClient st
ClientAgency ClientHasAgency 'BFIdle
forall {k} {k1} {block :: k} {point :: k1}. ClientHasAgency 'BFIdle
TokIdle) Message (BlockFetch block point) 'BFIdle 'BFDone
forall {k} {k1} (block :: k) (point :: k1).
Message (BlockFetch block point) 'BFIdle 'BFDone
MsgClientDone
]
shrink :: AnyMessageAndAgency (BlockFetch block point)
-> [AnyMessageAndAgency (BlockFetch block point)]
shrink (AnyMessageAndAgency a :: PeerHasAgency pr st
a@(ClientAgency ClientHasAgency st
R:ClientHasAgencyBlockFetchst (*) (*) block point st
TokIdle) (MsgRequestRange ChainRange point1
range)) =
[ PeerHasAgency pr st
-> Message (BlockFetch block point) st 'BFBusy
-> AnyMessageAndAgency (BlockFetch block point)
forall (pr :: PeerRole) ps (st :: ps) (st' :: ps).
PeerHasAgency pr st -> Message ps st st' -> AnyMessageAndAgency ps
AnyMessageAndAgency PeerHasAgency pr st
a (ChainRange point
-> Message (BlockFetch block point) 'BFIdle 'BFBusy
forall {k} point1 (block :: k).
ChainRange point1
-> Message (BlockFetch block point1) 'BFIdle 'BFBusy
MsgRequestRange ChainRange point
ChainRange point1
range')
| ChainRange point1
range' <- ChainRange point1 -> [ChainRange point1]
forall a. Arbitrary a => a -> [a]
shrink ChainRange point1
range
]
shrink (AnyMessageAndAgency (ServerAgency ServerHasAgency st
R:ServerHasAgencyBlockFetchst (*) (*) block point st
TokBusy) Message (BlockFetch block point) st st'
R:MessageBlockFetchfromto (*) (*) block point st st'
MsgStartBatch) = []
shrink (AnyMessageAndAgency (ServerAgency ServerHasAgency st
R:ServerHasAgencyBlockFetchst (*) (*) block point st
TokBusy) Message (BlockFetch block point) st st'
R:MessageBlockFetchfromto (*) (*) block point st st'
MsgNoBlocks) = []
shrink (AnyMessageAndAgency a :: PeerHasAgency pr st
a@(ServerAgency ServerHasAgency st
R:ServerHasAgencyBlockFetchst (*) (*) block point st
TokStreaming) (MsgBlock block1
block)) =
[ PeerHasAgency pr st
-> Message (BlockFetch block point) st 'BFStreaming
-> AnyMessageAndAgency (BlockFetch block point)
forall (pr :: PeerRole) ps (st :: ps) (st' :: ps).
PeerHasAgency pr st -> Message ps st st' -> AnyMessageAndAgency ps
AnyMessageAndAgency PeerHasAgency pr st
a (block -> Message (BlockFetch block point) 'BFStreaming 'BFStreaming
forall {k1} block1 (point :: k1).
block1
-> Message (BlockFetch block1 point) 'BFStreaming 'BFStreaming
MsgBlock block
block1
block')
| block1
block' <- block1 -> [block1]
forall a. Arbitrary a => a -> [a]
shrink block1
block
]
shrink (AnyMessageAndAgency (ServerAgency ServerHasAgency st
R:ServerHasAgencyBlockFetchst (*) (*) block point st
TokStreaming) Message (BlockFetch block point) st st'
R:MessageBlockFetchfromto (*) (*) block point st st'
MsgBatchDone) = []
shrink (AnyMessageAndAgency (ClientAgency ClientHasAgency st
R:ClientHasAgencyBlockFetchst (*) (*) block point st
TokIdle) Message (BlockFetch block point) st st'
R:MessageBlockFetchfromto (*) (*) block point st st'
MsgClientDone) = []
instance (Eq block, Eq point) =>
Eq (AnyMessage (BlockFetch block point)) where
AnyMessage (MsgRequestRange ChainRange point1
r1) == :: AnyMessage (BlockFetch block point)
-> AnyMessage (BlockFetch block point) -> Bool
== AnyMessage (MsgRequestRange ChainRange point1
r2) = ChainRange point1
r1 ChainRange point1 -> ChainRange point1 -> Bool
forall a. Eq a => a -> a -> Bool
== ChainRange point1
ChainRange point1
r2
AnyMessage Message (BlockFetch block point) st st'
R:MessageBlockFetchfromto (*) (*) block point st st'
MsgStartBatch == AnyMessage Message (BlockFetch block point) st st'
R:MessageBlockFetchfromto (*) (*) block point st st'
MsgStartBatch = Bool
True
AnyMessage Message (BlockFetch block point) st st'
R:MessageBlockFetchfromto (*) (*) block point st st'
MsgNoBlocks == AnyMessage Message (BlockFetch block point) st st'
R:MessageBlockFetchfromto (*) (*) block point st st'
MsgNoBlocks = Bool
True
AnyMessage (MsgBlock block1
b1) == AnyMessage (MsgBlock block1
b2) = block1
b1 block1 -> block1 -> Bool
forall a. Eq a => a -> a -> Bool
== block1
block1
b2
AnyMessage Message (BlockFetch block point) st st'
R:MessageBlockFetchfromto (*) (*) block point st st'
MsgBatchDone == AnyMessage Message (BlockFetch block point) st st'
R:MessageBlockFetchfromto (*) (*) block point st st'
MsgBatchDone = Bool
True
AnyMessage Message (BlockFetch block point) st st'
R:MessageBlockFetchfromto (*) (*) block point st st'
MsgClientDone == AnyMessage Message (BlockFetch block point) st st'
R:MessageBlockFetchfromto (*) (*) block point st st'
MsgClientDone = Bool
True
AnyMessage (BlockFetch block point)
_ == AnyMessage (BlockFetch block point)
_ = Bool
False
instance Arbitrary (Serialised Block) where
arbitrary :: Gen (Serialised Block)
arbitrary = ByteString -> Serialised Block
forall {k} (a :: k). ByteString -> Serialised a
Serialised (ByteString -> Serialised Block)
-> (Block -> ByteString) -> Block -> Serialised Block
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Serialise a => a -> ByteString
S.serialise @Block (Block -> Serialised Block) -> Gen Block -> Gen (Serialised Block)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Block
forall a. Arbitrary a => Gen a
arbitrary
shrink :: Serialised Block -> [Serialised Block]
shrink (Serialised ByteString
block) =
ByteString -> Serialised Block
forall {k} (a :: k). ByteString -> Serialised a
Serialised (ByteString -> Serialised Block)
-> (Block -> ByteString) -> Block -> Serialised Block
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Serialise a => a -> ByteString
S.serialise @Block (Block -> Serialised Block) -> [Block] -> [Serialised Block]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Block -> [Block]
forall a. Arbitrary a => a -> [a]
shrink (ByteString -> Block
forall a. Serialise a => ByteString -> a
S.deserialise ByteString
block)
prop_codec_BlockFetch
:: AnyMessageAndAgency (BlockFetch Block (Point Block))
-> Bool
prop_codec_BlockFetch :: AnyMessageAndAgency (BlockFetch Block (Point Block)) -> Bool
prop_codec_BlockFetch AnyMessageAndAgency (BlockFetch Block (Point Block))
msg =
(forall s. ST s Bool) -> Bool
forall a. (forall s. ST s a) -> a
runST (Codec
(BlockFetch Block (Point Block))
DeserialiseFailure
(ST s)
ByteString
-> AnyMessageAndAgency (BlockFetch Block (Point Block))
-> ST s Bool
forall ps failure (m :: * -> *) bytes.
(Monad m, Eq (AnyMessage ps)) =>
Codec ps failure m bytes -> AnyMessageAndAgency ps -> m Bool
prop_codecM Codec
(BlockFetch Block (Point Block))
DeserialiseFailure
(ST s)
ByteString
forall (m :: * -> *).
MonadST m =>
Codec
(BlockFetch Block (Point Block)) DeserialiseFailure m ByteString
codec AnyMessageAndAgency (BlockFetch Block (Point Block))
msg)
prop_codec_splits2_BlockFetch
:: AnyMessageAndAgency (BlockFetch Block (Point Block))
-> Bool
prop_codec_splits2_BlockFetch :: AnyMessageAndAgency (BlockFetch Block (Point Block)) -> Bool
prop_codec_splits2_BlockFetch AnyMessageAndAgency (BlockFetch Block (Point Block))
msg =
(forall s. ST s Bool) -> Bool
forall a. (forall s. ST s a) -> a
runST ((ByteString -> [[ByteString]])
-> Codec
(BlockFetch Block (Point Block))
DeserialiseFailure
(ST s)
ByteString
-> AnyMessageAndAgency (BlockFetch Block (Point Block))
-> ST s Bool
forall ps failure (m :: * -> *) bytes.
(Monad m, Eq (AnyMessage ps)) =>
(bytes -> [[bytes]])
-> Codec ps failure m bytes -> AnyMessageAndAgency ps -> m Bool
prop_codec_splitsM ByteString -> [[ByteString]]
splits2 Codec
(BlockFetch Block (Point Block))
DeserialiseFailure
(ST s)
ByteString
forall (m :: * -> *).
MonadST m =>
Codec
(BlockFetch Block (Point Block)) DeserialiseFailure m ByteString
codec AnyMessageAndAgency (BlockFetch Block (Point Block))
msg)
prop_codec_splits3_BlockFetch
:: AnyMessageAndAgency (BlockFetch Block (Point Block))
-> Bool
prop_codec_splits3_BlockFetch :: AnyMessageAndAgency (BlockFetch Block (Point Block)) -> Bool
prop_codec_splits3_BlockFetch AnyMessageAndAgency (BlockFetch Block (Point Block))
msg =
(forall s. ST s Bool) -> Bool
forall a. (forall s. ST s a) -> a
runST ((ByteString -> [[ByteString]])
-> Codec
(BlockFetch Block (Point Block))
DeserialiseFailure
(ST s)
ByteString
-> AnyMessageAndAgency (BlockFetch Block (Point Block))
-> ST s Bool
forall ps failure (m :: * -> *) bytes.
(Monad m, Eq (AnyMessage ps)) =>
(bytes -> [[bytes]])
-> Codec ps failure m bytes -> AnyMessageAndAgency ps -> m Bool
prop_codec_splitsM ByteString -> [[ByteString]]
splits3 Codec
(BlockFetch Block (Point Block))
DeserialiseFailure
(ST s)
ByteString
forall (m :: * -> *).
MonadST m =>
Codec
(BlockFetch Block (Point Block)) DeserialiseFailure m ByteString
codec AnyMessageAndAgency (BlockFetch Block (Point Block))
msg)
prop_codec_cbor_BlockFetch
:: AnyMessageAndAgency (BlockFetch Block (Point Block))
-> Bool
prop_codec_cbor_BlockFetch :: AnyMessageAndAgency (BlockFetch Block (Point Block)) -> Bool
prop_codec_cbor_BlockFetch AnyMessageAndAgency (BlockFetch Block (Point Block))
msg =
(forall s. ST s Bool) -> Bool
forall a. (forall s. ST s a) -> a
runST (Codec
(BlockFetch Block (Point Block))
DeserialiseFailure
(ST s)
ByteString
-> AnyMessageAndAgency (BlockFetch Block (Point Block))
-> ST s Bool
forall ps (m :: * -> *).
(Monad m, Eq (AnyMessage ps)) =>
Codec ps DeserialiseFailure m ByteString
-> AnyMessageAndAgency ps -> m Bool
prop_codec_cborM Codec
(BlockFetch Block (Point Block))
DeserialiseFailure
(ST s)
ByteString
forall (m :: * -> *).
MonadST m =>
Codec
(BlockFetch Block (Point Block)) DeserialiseFailure m ByteString
codec AnyMessageAndAgency (BlockFetch Block (Point Block))
msg)
prop_codec_valid_cbor_BlockFetch
:: AnyMessageAndAgency (BlockFetch Block (Point Block))
-> Property
prop_codec_valid_cbor_BlockFetch :: AnyMessageAndAgency (BlockFetch Block (Point Block)) -> Property
prop_codec_valid_cbor_BlockFetch = Codec
(BlockFetch Block (Point Block)) DeserialiseFailure IO ByteString
-> AnyMessageAndAgency (BlockFetch Block (Point Block)) -> Property
forall ps.
Codec ps DeserialiseFailure IO ByteString
-> AnyMessageAndAgency ps -> Property
prop_codec_valid_cbor_encoding Codec
(BlockFetch Block (Point Block)) DeserialiseFailure IO ByteString
forall (m :: * -> *).
MonadST m =>
Codec
(BlockFetch Block (Point Block)) DeserialiseFailure m ByteString
codec
prop_codec_BlockFetchSerialised
:: AnyMessageAndAgency (BlockFetch (Serialised Block) (Point Block))
-> Bool
prop_codec_BlockFetchSerialised :: AnyMessageAndAgency (BlockFetch (Serialised Block) (Point Block))
-> Bool
prop_codec_BlockFetchSerialised AnyMessageAndAgency (BlockFetch (Serialised Block) (Point Block))
msg =
(forall s. ST s Bool) -> Bool
forall a. (forall s. ST s a) -> a
runST (Codec
(BlockFetch (Serialised Block) (Point Block))
DeserialiseFailure
(ST s)
ByteString
-> AnyMessageAndAgency
(BlockFetch (Serialised Block) (Point Block))
-> ST s Bool
forall ps failure (m :: * -> *) bytes.
(Monad m, Eq (AnyMessage ps)) =>
Codec ps failure m bytes -> AnyMessageAndAgency ps -> m Bool
prop_codecM Codec
(BlockFetch (Serialised Block) (Point Block))
DeserialiseFailure
(ST s)
ByteString
forall (m :: * -> *).
MonadST m =>
Codec
(BlockFetch (Serialised Block) (Point Block))
DeserialiseFailure
m
ByteString
codecSerialised AnyMessageAndAgency (BlockFetch (Serialised Block) (Point Block))
msg)
prop_codec_splits2_BlockFetchSerialised
:: AnyMessageAndAgency (BlockFetch (Serialised Block) (Point Block))
-> Bool
prop_codec_splits2_BlockFetchSerialised :: AnyMessageAndAgency (BlockFetch (Serialised Block) (Point Block))
-> Bool
prop_codec_splits2_BlockFetchSerialised AnyMessageAndAgency (BlockFetch (Serialised Block) (Point Block))
msg =
(forall s. ST s Bool) -> Bool
forall a. (forall s. ST s a) -> a
runST ((ByteString -> [[ByteString]])
-> Codec
(BlockFetch (Serialised Block) (Point Block))
DeserialiseFailure
(ST s)
ByteString
-> AnyMessageAndAgency
(BlockFetch (Serialised Block) (Point Block))
-> ST s Bool
forall ps failure (m :: * -> *) bytes.
(Monad m, Eq (AnyMessage ps)) =>
(bytes -> [[bytes]])
-> Codec ps failure m bytes -> AnyMessageAndAgency ps -> m Bool
prop_codec_splitsM ByteString -> [[ByteString]]
splits2 Codec
(BlockFetch (Serialised Block) (Point Block))
DeserialiseFailure
(ST s)
ByteString
forall (m :: * -> *).
MonadST m =>
Codec
(BlockFetch (Serialised Block) (Point Block))
DeserialiseFailure
m
ByteString
codecSerialised AnyMessageAndAgency (BlockFetch (Serialised Block) (Point Block))
msg)
prop_codec_splits3_BlockFetchSerialised
:: AnyMessageAndAgency (BlockFetch (Serialised Block) (Point Block))
-> Bool
prop_codec_splits3_BlockFetchSerialised :: AnyMessageAndAgency (BlockFetch (Serialised Block) (Point Block))
-> Bool
prop_codec_splits3_BlockFetchSerialised AnyMessageAndAgency (BlockFetch (Serialised Block) (Point Block))
msg =
(forall s. ST s Bool) -> Bool
forall a. (forall s. ST s a) -> a
runST ((ByteString -> [[ByteString]])
-> Codec
(BlockFetch (Serialised Block) (Point Block))
DeserialiseFailure
(ST s)
ByteString
-> AnyMessageAndAgency
(BlockFetch (Serialised Block) (Point Block))
-> ST s Bool
forall ps failure (m :: * -> *) bytes.
(Monad m, Eq (AnyMessage ps)) =>
(bytes -> [[bytes]])
-> Codec ps failure m bytes -> AnyMessageAndAgency ps -> m Bool
prop_codec_splitsM ByteString -> [[ByteString]]
splits3 Codec
(BlockFetch (Serialised Block) (Point Block))
DeserialiseFailure
(ST s)
ByteString
forall (m :: * -> *).
MonadST m =>
Codec
(BlockFetch (Serialised Block) (Point Block))
DeserialiseFailure
m
ByteString
codecSerialised AnyMessageAndAgency (BlockFetch (Serialised Block) (Point Block))
msg)
prop_codec_cbor_BlockFetchSerialised
:: AnyMessageAndAgency (BlockFetch (Serialised Block) (Point Block))
-> Bool
prop_codec_cbor_BlockFetchSerialised :: AnyMessageAndAgency (BlockFetch (Serialised Block) (Point Block))
-> Bool
prop_codec_cbor_BlockFetchSerialised AnyMessageAndAgency (BlockFetch (Serialised Block) (Point Block))
msg =
(forall s. ST s Bool) -> Bool
forall a. (forall s. ST s a) -> a
runST (Codec
(BlockFetch (Serialised Block) (Point Block))
DeserialiseFailure
(ST s)
ByteString
-> AnyMessageAndAgency
(BlockFetch (Serialised Block) (Point Block))
-> ST s Bool
forall ps (m :: * -> *).
(Monad m, Eq (AnyMessage ps)) =>
Codec ps DeserialiseFailure m ByteString
-> AnyMessageAndAgency ps -> m Bool
prop_codec_cborM Codec
(BlockFetch (Serialised Block) (Point Block))
DeserialiseFailure
(ST s)
ByteString
forall (m :: * -> *).
MonadST m =>
Codec
(BlockFetch (Serialised Block) (Point Block))
DeserialiseFailure
m
ByteString
codecSerialised AnyMessageAndAgency (BlockFetch (Serialised Block) (Point Block))
msg)
prop_codec_binary_compat_BlockFetch_BlockFetchSerialised
:: AnyMessageAndAgency (BlockFetch Block (Point Block))
-> Bool
prop_codec_binary_compat_BlockFetch_BlockFetchSerialised :: AnyMessageAndAgency (BlockFetch Block (Point Block)) -> Bool
prop_codec_binary_compat_BlockFetch_BlockFetchSerialised AnyMessageAndAgency (BlockFetch Block (Point Block))
msg =
(forall s. ST s Bool) -> Bool
forall a. (forall s. ST s a) -> a
runST (Codec
(BlockFetch Block (Point Block))
DeserialiseFailure
(ST s)
ByteString
-> Codec
(BlockFetch (Serialised Block) (Point Block))
DeserialiseFailure
(ST s)
ByteString
-> (forall (pr :: PeerRole)
(stA :: BlockFetch Block (Point Block)).
PeerHasAgency pr stA
-> SamePeerHasAgency
pr (BlockFetch (Serialised Block) (Point Block)))
-> AnyMessageAndAgency (BlockFetch Block (Point Block))
-> ST s Bool
forall psA psB failure (m :: * -> *) bytes.
(Monad m, Eq (AnyMessage psA)) =>
Codec psA failure m bytes
-> Codec psB failure m bytes
-> (forall (pr :: PeerRole) (stA :: psA).
PeerHasAgency pr stA -> SamePeerHasAgency pr psB)
-> AnyMessageAndAgency psA
-> m Bool
prop_codec_binary_compatM Codec
(BlockFetch Block (Point Block))
DeserialiseFailure
(ST s)
ByteString
forall (m :: * -> *).
MonadST m =>
Codec
(BlockFetch Block (Point Block)) DeserialiseFailure m ByteString
codecWrapped Codec
(BlockFetch (Serialised Block) (Point Block))
DeserialiseFailure
(ST s)
ByteString
forall (m :: * -> *).
MonadST m =>
Codec
(BlockFetch (Serialised Block) (Point Block))
DeserialiseFailure
m
ByteString
codecSerialised PeerHasAgency pr stA
-> SamePeerHasAgency
pr (BlockFetch (Serialised Block) (Point Block))
forall (pr :: PeerRole) (stA :: BlockFetch Block (Point Block)).
PeerHasAgency pr stA
-> SamePeerHasAgency
pr (BlockFetch (Serialised Block) (Point Block))
stokEq AnyMessageAndAgency (BlockFetch Block (Point Block))
msg)
where
stokEq
:: forall pr (stA :: BlockFetch Block (Point Block)).
PeerHasAgency pr stA
-> SamePeerHasAgency pr (BlockFetch (Serialised Block) (Point Block))
stokEq :: forall (pr :: PeerRole) (stA :: BlockFetch Block (Point Block)).
PeerHasAgency pr stA
-> SamePeerHasAgency
pr (BlockFetch (Serialised Block) (Point Block))
stokEq (ClientAgency ClientHasAgency stA
ca) = case ClientHasAgency stA
ca of
ClientHasAgency stA
R:ClientHasAgencyBlockFetchst (*) (*) Block (Point Block) stA
TokIdle -> PeerHasAgency pr 'BFIdle
-> SamePeerHasAgency
pr (BlockFetch (Serialised Block) (Point Block))
forall (pr :: PeerRole) ps (st :: ps).
PeerHasAgency pr st -> SamePeerHasAgency pr ps
SamePeerHasAgency (PeerHasAgency pr 'BFIdle
-> SamePeerHasAgency
pr (BlockFetch (Serialised Block) (Point Block)))
-> PeerHasAgency pr 'BFIdle
-> SamePeerHasAgency
pr (BlockFetch (Serialised Block) (Point Block))
forall a b. (a -> b) -> a -> b
$ ClientHasAgency 'BFIdle -> PeerHasAgency 'AsClient 'BFIdle
forall {ps} (st :: ps).
ClientHasAgency st -> PeerHasAgency 'AsClient st
ClientAgency ClientHasAgency 'BFIdle
forall {k} {k1} {block :: k} {point :: k1}. ClientHasAgency 'BFIdle
TokIdle
stokEq (ServerAgency ServerHasAgency stA
sa) = case ServerHasAgency stA
sa of
ServerHasAgency stA
R:ServerHasAgencyBlockFetchst (*) (*) Block (Point Block) stA
TokBusy -> PeerHasAgency pr 'BFBusy
-> SamePeerHasAgency
pr (BlockFetch (Serialised Block) (Point Block))
forall (pr :: PeerRole) ps (st :: ps).
PeerHasAgency pr st -> SamePeerHasAgency pr ps
SamePeerHasAgency (PeerHasAgency pr 'BFBusy
-> SamePeerHasAgency
pr (BlockFetch (Serialised Block) (Point Block)))
-> PeerHasAgency pr 'BFBusy
-> SamePeerHasAgency
pr (BlockFetch (Serialised Block) (Point Block))
forall a b. (a -> b) -> a -> b
$ ServerHasAgency 'BFBusy -> PeerHasAgency 'AsServer 'BFBusy
forall {ps} (st :: ps).
ServerHasAgency st -> PeerHasAgency 'AsServer st
ServerAgency ServerHasAgency 'BFBusy
forall {k} {k1} {block :: k} {point :: k1}. ServerHasAgency 'BFBusy
TokBusy
ServerHasAgency stA
R:ServerHasAgencyBlockFetchst (*) (*) Block (Point Block) stA
TokStreaming -> PeerHasAgency pr 'BFStreaming
-> SamePeerHasAgency
pr (BlockFetch (Serialised Block) (Point Block))
forall (pr :: PeerRole) ps (st :: ps).
PeerHasAgency pr st -> SamePeerHasAgency pr ps
SamePeerHasAgency (PeerHasAgency pr 'BFStreaming
-> SamePeerHasAgency
pr (BlockFetch (Serialised Block) (Point Block)))
-> PeerHasAgency pr 'BFStreaming
-> SamePeerHasAgency
pr (BlockFetch (Serialised Block) (Point Block))
forall a b. (a -> b) -> a -> b
$ ServerHasAgency 'BFStreaming
-> PeerHasAgency 'AsServer 'BFStreaming
forall {ps} (st :: ps).
ServerHasAgency st -> PeerHasAgency 'AsServer st
ServerAgency ServerHasAgency 'BFStreaming
forall {k} {k1} {block :: k} {point :: k1}.
ServerHasAgency 'BFStreaming
TokStreaming
prop_codec_binary_compat_BlockFetchSerialised_BlockFetch
:: AnyMessageAndAgency (BlockFetch (Serialised Block) (Point Block))
-> Bool
prop_codec_binary_compat_BlockFetchSerialised_BlockFetch :: AnyMessageAndAgency (BlockFetch (Serialised Block) (Point Block))
-> Bool
prop_codec_binary_compat_BlockFetchSerialised_BlockFetch AnyMessageAndAgency (BlockFetch (Serialised Block) (Point Block))
msg =
(forall s. ST s Bool) -> Bool
forall a. (forall s. ST s a) -> a
runST (Codec
(BlockFetch (Serialised Block) (Point Block))
DeserialiseFailure
(ST s)
ByteString
-> Codec
(BlockFetch Block (Point Block))
DeserialiseFailure
(ST s)
ByteString
-> (forall (pr :: PeerRole)
(stA :: BlockFetch (Serialised Block) (Point Block)).
PeerHasAgency pr stA
-> SamePeerHasAgency pr (BlockFetch Block (Point Block)))
-> AnyMessageAndAgency
(BlockFetch (Serialised Block) (Point Block))
-> ST s Bool
forall psA psB failure (m :: * -> *) bytes.
(Monad m, Eq (AnyMessage psA)) =>
Codec psA failure m bytes
-> Codec psB failure m bytes
-> (forall (pr :: PeerRole) (stA :: psA).
PeerHasAgency pr stA -> SamePeerHasAgency pr psB)
-> AnyMessageAndAgency psA
-> m Bool
prop_codec_binary_compatM Codec
(BlockFetch (Serialised Block) (Point Block))
DeserialiseFailure
(ST s)
ByteString
forall (m :: * -> *).
MonadST m =>
Codec
(BlockFetch (Serialised Block) (Point Block))
DeserialiseFailure
m
ByteString
codecSerialised Codec
(BlockFetch Block (Point Block))
DeserialiseFailure
(ST s)
ByteString
forall (m :: * -> *).
MonadST m =>
Codec
(BlockFetch Block (Point Block)) DeserialiseFailure m ByteString
codecWrapped PeerHasAgency pr stA
-> SamePeerHasAgency pr (BlockFetch Block (Point Block))
forall (pr :: PeerRole)
(stA :: BlockFetch (Serialised Block) (Point Block)).
PeerHasAgency pr stA
-> SamePeerHasAgency pr (BlockFetch Block (Point Block))
stokEq AnyMessageAndAgency (BlockFetch (Serialised Block) (Point Block))
msg)
where
stokEq
:: forall pr (stA :: BlockFetch (Serialised Block) (Point Block)).
PeerHasAgency pr stA
-> SamePeerHasAgency pr (BlockFetch Block (Point Block))
stokEq :: forall (pr :: PeerRole)
(stA :: BlockFetch (Serialised Block) (Point Block)).
PeerHasAgency pr stA
-> SamePeerHasAgency pr (BlockFetch Block (Point Block))
stokEq (ClientAgency ClientHasAgency stA
ca) = case ClientHasAgency stA
ca of
ClientHasAgency stA
R:ClientHasAgencyBlockFetchst
(*) (*) (Serialised Block) (Point Block) stA
TokIdle -> PeerHasAgency pr 'BFIdle
-> SamePeerHasAgency pr (BlockFetch Block (Point Block))
forall (pr :: PeerRole) ps (st :: ps).
PeerHasAgency pr st -> SamePeerHasAgency pr ps
SamePeerHasAgency (PeerHasAgency pr 'BFIdle
-> SamePeerHasAgency pr (BlockFetch Block (Point Block)))
-> PeerHasAgency pr 'BFIdle
-> SamePeerHasAgency pr (BlockFetch Block (Point Block))
forall a b. (a -> b) -> a -> b
$ ClientHasAgency 'BFIdle -> PeerHasAgency 'AsClient 'BFIdle
forall {ps} (st :: ps).
ClientHasAgency st -> PeerHasAgency 'AsClient st
ClientAgency ClientHasAgency 'BFIdle
forall {k} {k1} {block :: k} {point :: k1}. ClientHasAgency 'BFIdle
TokIdle
stokEq (ServerAgency ServerHasAgency stA
sa) = case ServerHasAgency stA
sa of
ServerHasAgency stA
R:ServerHasAgencyBlockFetchst
(*) (*) (Serialised Block) (Point Block) stA
TokBusy -> PeerHasAgency pr 'BFBusy
-> SamePeerHasAgency pr (BlockFetch Block (Point Block))
forall (pr :: PeerRole) ps (st :: ps).
PeerHasAgency pr st -> SamePeerHasAgency pr ps
SamePeerHasAgency (PeerHasAgency pr 'BFBusy
-> SamePeerHasAgency pr (BlockFetch Block (Point Block)))
-> PeerHasAgency pr 'BFBusy
-> SamePeerHasAgency pr (BlockFetch Block (Point Block))
forall a b. (a -> b) -> a -> b
$ ServerHasAgency 'BFBusy -> PeerHasAgency 'AsServer 'BFBusy
forall {ps} (st :: ps).
ServerHasAgency st -> PeerHasAgency 'AsServer st
ServerAgency ServerHasAgency 'BFBusy
forall {k} {k1} {block :: k} {point :: k1}. ServerHasAgency 'BFBusy
TokBusy
ServerHasAgency stA
R:ServerHasAgencyBlockFetchst
(*) (*) (Serialised Block) (Point Block) stA
TokStreaming -> PeerHasAgency pr 'BFStreaming
-> SamePeerHasAgency pr (BlockFetch Block (Point Block))
forall (pr :: PeerRole) ps (st :: ps).
PeerHasAgency pr st -> SamePeerHasAgency pr ps
SamePeerHasAgency (PeerHasAgency pr 'BFStreaming
-> SamePeerHasAgency pr (BlockFetch Block (Point Block)))
-> PeerHasAgency pr 'BFStreaming
-> SamePeerHasAgency pr (BlockFetch Block (Point Block))
forall a b. (a -> b) -> a -> b
$ ServerHasAgency 'BFStreaming
-> PeerHasAgency 'AsServer 'BFStreaming
forall {ps} (st :: ps).
ServerHasAgency st -> PeerHasAgency 'AsServer st
ServerAgency ServerHasAgency 'BFStreaming
forall {k} {k1} {block :: k} {point :: k1}.
ServerHasAgency 'BFStreaming
TokStreaming
pointsToRanges
:: Chain.HasHeader block
=> Chain block
-> [Point block]
-> [ChainRange (Point block)]
pointsToRanges :: forall block.
HasHeader block =>
Chain block -> [Point block] -> [ChainRange (Point block)]
pointsToRanges Chain block
chain [Point block]
points =
[Point block] -> [ChainRange (Point block)]
go ([Point block] -> [Point block]
forall a. [a] -> [a]
reverse [Point block]
points)
where
go :: [Point block] -> [ChainRange (Point block)]
go (Point block
x : Point block
y : [Point block]
ys) =
if Point block
x Point block -> Chain block -> Bool
forall block. HasHeader block => Point block -> Chain block -> Bool
`Chain.pointOnChain` Chain block
chain
then case Point block -> Chain block -> Maybe block
forall block.
HasHeader block =>
Point block -> Chain block -> Maybe block
Chain.successorBlock Point block
x Chain block
chain of
Maybe block
Nothing -> Point block -> Point block -> ChainRange (Point block)
forall point. point -> point -> ChainRange point
ChainRange Point block
x Point block
y ChainRange (Point block)
-> [ChainRange (Point block)] -> [ChainRange (Point block)]
forall a. a -> [a] -> [a]
: [Point block] -> [ChainRange (Point block)]
go (Point block
y Point block -> [Point block] -> [Point block]
forall a. a -> [a] -> [a]
: [Point block]
ys)
Just block
x' -> Point block -> Point block -> ChainRange (Point block)
forall point. point -> point -> ChainRange point
ChainRange (block -> Point block
forall block. HasHeader block => block -> Point block
Chain.blockPoint block
x') Point block
y ChainRange (Point block)
-> [ChainRange (Point block)] -> [ChainRange (Point block)]
forall a. a -> [a] -> [a]
: [Point block] -> [ChainRange (Point block)]
go (Point block
y Point block -> [Point block] -> [Point block]
forall a. a -> [a] -> [a]
: [Point block]
ys)
else Point block -> Point block -> ChainRange (Point block)
forall point. point -> point -> ChainRange point
ChainRange Point block
x Point block
y ChainRange (Point block)
-> [ChainRange (Point block)] -> [ChainRange (Point block)]
forall a. a -> [a] -> [a]
: [Point block] -> [ChainRange (Point block)]
go (Point block
y Point block -> [Point block] -> [Point block]
forall a. a -> [a] -> [a]
: [Point block]
ys)
go [Point block
x] = [Point block -> Point block -> ChainRange (Point block)
forall point. point -> point -> ChainRange point
ChainRange Point block
forall {k} (block :: k). Point block
genesisPoint Point block
x]
go [] = []
receivedBlockBodies
:: Chain Block
-> [Point Block]
-> [[Block]]
receivedBlockBodies :: Chain Block -> [Point Block] -> [[Block]]
receivedBlockBodies Chain Block
chain [Point Block]
points =
(ChainRange (Point Block) -> [Block])
-> [ChainRange (Point Block)] -> [[Block]]
forall a b. (a -> b) -> [a] -> [b]
map ChainRange (Point Block) -> [Block]
f (Chain Block -> [Point Block] -> [ChainRange (Point Block)]
forall block.
HasHeader block =>
Chain block -> [Point block] -> [ChainRange (Point block)]
pointsToRanges Chain Block
chain [Point Block]
points)
where
f :: ChainRange (Point Block) -> [Block]
f (ChainRange Point Block
from Point Block
to) =
case Chain Block -> Point Block -> Point Block -> Maybe [Block]
forall block.
HasHeader block =>
Chain block -> Point block -> Point block -> Maybe [block]
Chain.selectBlockRange Chain Block
chain Point Block
from Point Block
to of
Maybe [Block]
Nothing -> []
Just [Block]
bs -> [Block]
bs