{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# OPTIONS_GHC -Wno-orphans #-}
module Ouroboros.Network.Protocol.Handshake.Test where
import Data.ByteString.Lazy (ByteString)
import Data.ByteString.Lazy qualified as BL
import Data.List (nub)
import Data.Map (Map)
import Data.Map qualified as Map
import Data.Maybe (fromMaybe)
import Data.Text (Text)
import Data.Text qualified as T
import GHC.Generics
import Codec.CBOR.Read qualified as CBOR
import Codec.CBOR.Term qualified as CBOR
import Control.Applicative (Alternative)
import Control.Concurrent.Class.MonadSTM.Strict
import Control.Monad.Class.MonadAsync
import Control.Monad.Class.MonadFork
import Control.Monad.Class.MonadST (MonadST)
import Control.Monad.Class.MonadThrow (MonadCatch, MonadMask, MonadThrow,
bracket)
import Control.Monad.Class.MonadTime.SI
import Control.Monad.Class.MonadTimer.SI
import Control.Monad.IOSim (runSimOrThrow)
import Control.Tracer (nullTracer)
import Network.Mux.Bearer qualified as Mx
import Network.Mux.Types (MiniProtocolDir (..), MiniProtocolNum (..),
bearerAsChannel)
import Network.TypedProtocol.Codec
import Network.TypedProtocol.Proofs
import Test.Ouroboros.Network.Protocol.Utils (prop_codec_cborM,
prop_codec_valid_cbor_encoding, splits2, splits3)
import Ouroboros.Network.Channel
import Ouroboros.Network.CodecCBORTerm
import Ouroboros.Network.Driver.Simple (runConnectedPeers,
runConnectedPeersAsymmetric, runPeer)
import Ouroboros.Network.Snocket (TestAddress (..))
import Ouroboros.Network.Snocket qualified as Snocket
import Simulation.Network.Snocket
import Ouroboros.Network.Protocol.Handshake.Client
import Ouroboros.Network.Protocol.Handshake.Codec
import Ouroboros.Network.Protocol.Handshake.Direct
import Ouroboros.Network.Protocol.Handshake.Server
import Ouroboros.Network.Protocol.Handshake.Type
import Ouroboros.Network.Protocol.Handshake.Version
import Codec.CBOR.Write qualified as CBOR
import Ouroboros.Network.Magic
import Ouroboros.Network.NodeToClient.Version as NTC
import Ouroboros.Network.NodeToNode.Version as NTN
import Ouroboros.Network.PeerSelection.PeerSharing (PeerSharing (..))
import Test.QuickCheck
import Test.Tasty (TestTree, testGroup)
import Test.Tasty.QuickCheck (testProperty)
tests :: TestTree
tests :: TestTree
tests =
String -> [TestTree] -> TestTree
testGroup String
"Ouroboros.Network.Protocol"
[ String -> [TestTree] -> TestTree
testGroup String
"Handshake"
[ String -> (ArbitraryVersions -> Property) -> TestTree
forall a. Testable a => String -> a -> TestTree
testProperty String
"connect" ArbitraryVersions -> Property
prop_connect
, String -> (ArbitraryVersions -> Property) -> TestTree
forall a. Testable a => String -> a -> TestTree
testProperty String
"channel ST" ArbitraryVersions -> Property
prop_channel_ST
, String -> (ArbitraryVersions -> Property) -> TestTree
forall a. Testable a => String -> a -> TestTree
testProperty String
"channel IO" ArbitraryVersions -> Property
prop_channel_IO
, String -> (ArbitraryVersions -> Property) -> TestTree
forall a. Testable a => String -> a -> TestTree
testProperty String
"pipe IO" ArbitraryVersions -> Property
prop_pipe_IO
, String -> (ArbitraryVersions -> Property) -> TestTree
forall a. Testable a => String -> a -> TestTree
testProperty String
"channel asymmetric ST" ArbitraryVersions -> Property
prop_channel_asymmetric_ST
, String -> (ArbitraryVersions -> Property) -> TestTree
forall a. Testable a => String -> a -> TestTree
testProperty String
"channel asymmetric IO" ArbitraryVersions -> Property
prop_channel_asymmetric_IO
, String -> (ArbitraryVersions -> Property) -> TestTree
forall a. Testable a => String -> a -> TestTree
testProperty String
"pipe asymmetric IO" ArbitraryVersions -> Property
prop_pipe_asymmetric_IO
, String -> [TestTree] -> TestTree
testGroup String
"VersionData"
[ String -> (VersionData -> VersionData -> Bool) -> TestTree
forall a. Testable a => String -> a -> TestTree
testProperty String
"acceptable_symmetric"
VersionData -> VersionData -> Bool
prop_acceptable_symmetric_VersionData
, String -> (ArbitraryVersions -> Property) -> TestTree
forall a. Testable a => String -> a -> TestTree
testProperty String
"acceptOrRefuse"
ArbitraryVersions -> Property
prop_acceptOrRefuse_symmetric_VersionData
, String -> (ArbitraryVersions -> Property) -> TestTree
forall a. Testable a => String -> a -> TestTree
testProperty String
"simultaneous open ST"
ArbitraryVersions -> Property
prop_channel_simultaneous_open_ST
, String -> (ArbitraryVersions -> Property) -> TestTree
forall a. Testable a => String -> a -> TestTree
testProperty String
"simultaneous open IO"
ArbitraryVersions -> Property
prop_channel_simultaneous_open_IO
, String -> (ArbitraryVersions -> Property) -> TestTree
forall a. Testable a => String -> a -> TestTree
testProperty String
"simultaneous open SimNet"
ArbitraryVersions -> Property
prop_channel_simultaneous_open_SimNet
]
, String -> [TestTree] -> TestTree
testGroup String
"NodeToNode"
[ String
-> (ArbitraryNodeToNodeVersionData
-> ArbitraryNodeToNodeVersionData -> Bool)
-> TestTree
forall a. Testable a => String -> a -> TestTree
testProperty String
"acceptable_symmetric"
ArbitraryNodeToNodeVersionData
-> ArbitraryNodeToNodeVersionData -> Bool
prop_acceptable_symmetric_NodeToNode
, String
-> (ArbitraryNodeToNodeVersions
-> ArbitraryNodeToNodeVersions -> Property)
-> TestTree
forall a. Testable a => String -> a -> TestTree
testProperty String
"acceptOrRefuse"
ArbitraryNodeToNodeVersions
-> ArbitraryNodeToNodeVersions -> Property
prop_acceptOrRefuse_symmetric_NodeToNode
, String
-> (ArbitraryNodeToNodeVersions
-> ArbitraryNodeToNodeVersions -> Property)
-> TestTree
forall a. Testable a => String -> a -> TestTree
testProperty String
"simultaneous open ST"
ArbitraryNodeToNodeVersions
-> ArbitraryNodeToNodeVersions -> Property
prop_channel_simultaneous_open_NodeToNode_ST
, String
-> (ArbitraryNodeToNodeVersions
-> ArbitraryNodeToNodeVersions -> Property)
-> TestTree
forall a. Testable a => String -> a -> TestTree
testProperty String
"simultaneous open IO"
ArbitraryNodeToNodeVersions
-> ArbitraryNodeToNodeVersions -> Property
prop_channel_simultaneous_open_NodeToNode_IO
, String
-> (ArbitraryNodeToNodeVersions
-> ArbitraryNodeToNodeVersions -> Property)
-> TestTree
forall a. Testable a => String -> a -> TestTree
testProperty String
"simultaneous open SimNet"
ArbitraryNodeToNodeVersions
-> ArbitraryNodeToNodeVersions -> Property
prop_channel_simultaneous_open_NodeToNode_SimNet
, String
-> (ArbitraryNodeToNodeVersions
-> ArbitraryNodeToNodeVersions -> Property)
-> TestTree
forall a. Testable a => String -> a -> TestTree
testProperty String
"query version ST"
ArbitraryNodeToNodeVersions
-> ArbitraryNodeToNodeVersions -> Property
prop_query_version_NodeToNode_ST
, String
-> (ArbitraryNodeToNodeVersions
-> ArbitraryNodeToNodeVersions -> Property)
-> TestTree
forall a. Testable a => String -> a -> TestTree
testProperty String
"query version IO"
ArbitraryNodeToNodeVersions
-> ArbitraryNodeToNodeVersions -> Property
prop_query_version_NodeToNode_IO
, String
-> (ArbitraryNodeToNodeVersions
-> ArbitraryNodeToNodeVersions -> Property)
-> TestTree
forall a. Testable a => String -> a -> TestTree
testProperty String
"query version SimNet"
ArbitraryNodeToNodeVersions
-> ArbitraryNodeToNodeVersions -> Property
prop_query_version_NodeToNode_SimNet
, String
-> (ArbitraryNodeToNodeVersions
-> ArbitraryNodeToNodeVersions -> Property)
-> TestTree
forall a. Testable a => String -> a -> TestTree
testProperty String
"peerSharing symmetry"
ArbitraryNodeToNodeVersions
-> ArbitraryNodeToNodeVersions -> Property
prop_peerSharing_symmetric_NodeToNode_SimNet
]
, String -> [TestTree] -> TestTree
testGroup String
"NodeToClient"
[ String
-> (ArbitraryNodeToClientVersionData
-> ArbitraryNodeToClientVersionData -> Bool)
-> TestTree
forall a. Testable a => String -> a -> TestTree
testProperty String
"acceptable_symmetric"
ArbitraryNodeToClientVersionData
-> ArbitraryNodeToClientVersionData -> Bool
prop_acceptable_symmetric_NodeToClient
, String
-> (ArbitraryNodeToClientVersions
-> ArbitraryNodeToClientVersions -> Property)
-> TestTree
forall a. Testable a => String -> a -> TestTree
testProperty String
"acceptOrRefuse"
ArbitraryNodeToClientVersions
-> ArbitraryNodeToClientVersions -> Property
prop_acceptOrRefuse_symmetric_NodeToClient
, String
-> (ArbitraryNodeToClientVersions
-> ArbitraryNodeToClientVersions -> Property)
-> TestTree
forall a. Testable a => String -> a -> TestTree
testProperty String
"simultaneous open ST"
ArbitraryNodeToClientVersions
-> ArbitraryNodeToClientVersions -> Property
prop_channel_simultaneous_open_NodeToClient_ST
, String
-> (ArbitraryNodeToClientVersions
-> ArbitraryNodeToClientVersions -> Property)
-> TestTree
forall a. Testable a => String -> a -> TestTree
testProperty String
"simultaneous open IO"
ArbitraryNodeToClientVersions
-> ArbitraryNodeToClientVersions -> Property
prop_channel_simultaneous_open_NodeToClient_IO
, String
-> (ArbitraryNodeToClientVersions
-> ArbitraryNodeToClientVersions -> Property)
-> TestTree
forall a. Testable a => String -> a -> TestTree
testProperty String
"simultaneous open SimNet"
ArbitraryNodeToClientVersions
-> ArbitraryNodeToClientVersions -> Property
prop_channel_simultaneous_open_NodeToClient_SimNet
, String
-> (ArbitraryNodeToClientVersions
-> ArbitraryNodeToClientVersions -> Property)
-> TestTree
forall a. Testable a => String -> a -> TestTree
testProperty String
"query version ST"
ArbitraryNodeToClientVersions
-> ArbitraryNodeToClientVersions -> Property
prop_query_version_NodeToClient_ST
, String
-> (ArbitraryNodeToClientVersions
-> ArbitraryNodeToClientVersions -> Property)
-> TestTree
forall a. Testable a => String -> a -> TestTree
testProperty String
"query version IO"
ArbitraryNodeToClientVersions
-> ArbitraryNodeToClientVersions -> Property
prop_query_version_NodeToClient_IO
, String
-> (ArbitraryNodeToClientVersions
-> ArbitraryNodeToClientVersions -> Property)
-> TestTree
forall a. Testable a => String -> a -> TestTree
testProperty String
"query version SimNet"
ArbitraryNodeToClientVersions
-> ArbitraryNodeToClientVersions -> Property
prop_query_version_NodeToClient_SimNet
]
, String -> (ArbitraryRefuseReason -> Bool) -> TestTree
forall a. Testable a => String -> a -> TestTree
testProperty String
"codec RefuseReason" ArbitraryRefuseReason -> Bool
prop_codec_RefuseReason
, String
-> (AnyMessage (Handshake VersionNumber Term) -> Bool) -> TestTree
forall a. Testable a => String -> a -> TestTree
testProperty String
"codec" AnyMessage (Handshake VersionNumber Term) -> Bool
prop_codec_Handshake
, String
-> (AnyMessage (Handshake VersionNumber Term) -> Bool) -> TestTree
forall a. Testable a => String -> a -> TestTree
testProperty String
"codec 2-splits" AnyMessage (Handshake VersionNumber Term) -> Bool
prop_codec_splits2_Handshake
, String -> Property -> TestTree
forall a. Testable a => String -> a -> TestTree
testProperty String
"codec 3-splits" (Property -> TestTree) -> Property -> TestTree
forall a b. (a -> b) -> a -> b
$ Int
-> (AnyMessage (Handshake VersionNumber Term) -> Bool) -> Property
forall prop. Testable prop => Int -> prop -> Property
withMaxSuccess Int
30
AnyMessage (Handshake VersionNumber Term) -> Bool
prop_codec_splits3_Handshake
, String
-> (AnyMessage (Handshake VersionNumber Term) -> Bool) -> TestTree
forall a. Testable a => String -> a -> TestTree
testProperty String
"codec cbor" AnyMessage (Handshake VersionNumber Term) -> Bool
prop_codec_cbor
, String
-> (AnyMessage (Handshake VersionNumber Term) -> Property)
-> TestTree
forall a. Testable a => String -> a -> TestTree
testProperty String
"codec valid cbor" AnyMessage (Handshake VersionNumber Term) -> Property
prop_codec_valid_cbor
, String -> [TestTree] -> TestTree
testGroup String
"Generators"
[ String -> Property -> TestTree
forall a. Testable a => String -> a -> TestTree
testProperty String
"ArbitraryVersions" (Property -> TestTree) -> Property -> TestTree
forall a b. (a -> b) -> a -> b
$
(ArbitraryVersions -> Property) -> Property
forall prop. Testable prop => prop -> Property
checkCoverage ArbitraryVersions -> Property
prop_arbitrary_ArbitraryVersions
, String -> (ArbitraryValidVersions -> Bool) -> TestTree
forall a. Testable a => String -> a -> TestTree
testProperty String
"arbitrary ArbitraryValidVersions"
ArbitraryValidVersions -> Bool
prop_arbitrary_ArbitraryValidVersions
, String -> (ArbitraryValidVersions -> Bool) -> TestTree
forall a. Testable a => String -> a -> TestTree
testProperty String
"shrink ArbitraryValidVersions"
ArbitraryValidVersions -> Bool
prop_shrink_ArbitraryValidVersions
]
]
]
data VersionNumber
= Version_0
| Version_1
| Version_2
deriving (VersionNumber -> VersionNumber -> Bool
(VersionNumber -> VersionNumber -> Bool)
-> (VersionNumber -> VersionNumber -> Bool) -> Eq VersionNumber
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: VersionNumber -> VersionNumber -> Bool
== :: VersionNumber -> VersionNumber -> Bool
$c/= :: VersionNumber -> VersionNumber -> Bool
/= :: VersionNumber -> VersionNumber -> Bool
Eq, Eq VersionNumber
Eq VersionNumber =>
(VersionNumber -> VersionNumber -> Ordering)
-> (VersionNumber -> VersionNumber -> Bool)
-> (VersionNumber -> VersionNumber -> Bool)
-> (VersionNumber -> VersionNumber -> Bool)
-> (VersionNumber -> VersionNumber -> Bool)
-> (VersionNumber -> VersionNumber -> VersionNumber)
-> (VersionNumber -> VersionNumber -> VersionNumber)
-> Ord VersionNumber
VersionNumber -> VersionNumber -> Bool
VersionNumber -> VersionNumber -> Ordering
VersionNumber -> VersionNumber -> VersionNumber
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: VersionNumber -> VersionNumber -> Ordering
compare :: VersionNumber -> VersionNumber -> Ordering
$c< :: VersionNumber -> VersionNumber -> Bool
< :: VersionNumber -> VersionNumber -> Bool
$c<= :: VersionNumber -> VersionNumber -> Bool
<= :: VersionNumber -> VersionNumber -> Bool
$c> :: VersionNumber -> VersionNumber -> Bool
> :: VersionNumber -> VersionNumber -> Bool
$c>= :: VersionNumber -> VersionNumber -> Bool
>= :: VersionNumber -> VersionNumber -> Bool
$cmax :: VersionNumber -> VersionNumber -> VersionNumber
max :: VersionNumber -> VersionNumber -> VersionNumber
$cmin :: VersionNumber -> VersionNumber -> VersionNumber
min :: VersionNumber -> VersionNumber -> VersionNumber
Ord, Int -> VersionNumber
VersionNumber -> Int
VersionNumber -> [VersionNumber]
VersionNumber -> VersionNumber
VersionNumber -> VersionNumber -> [VersionNumber]
VersionNumber -> VersionNumber -> VersionNumber -> [VersionNumber]
(VersionNumber -> VersionNumber)
-> (VersionNumber -> VersionNumber)
-> (Int -> VersionNumber)
-> (VersionNumber -> Int)
-> (VersionNumber -> [VersionNumber])
-> (VersionNumber -> VersionNumber -> [VersionNumber])
-> (VersionNumber -> VersionNumber -> [VersionNumber])
-> (VersionNumber
-> VersionNumber -> VersionNumber -> [VersionNumber])
-> Enum VersionNumber
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: VersionNumber -> VersionNumber
succ :: VersionNumber -> VersionNumber
$cpred :: VersionNumber -> VersionNumber
pred :: VersionNumber -> VersionNumber
$ctoEnum :: Int -> VersionNumber
toEnum :: Int -> VersionNumber
$cfromEnum :: VersionNumber -> Int
fromEnum :: VersionNumber -> Int
$cenumFrom :: VersionNumber -> [VersionNumber]
enumFrom :: VersionNumber -> [VersionNumber]
$cenumFromThen :: VersionNumber -> VersionNumber -> [VersionNumber]
enumFromThen :: VersionNumber -> VersionNumber -> [VersionNumber]
$cenumFromTo :: VersionNumber -> VersionNumber -> [VersionNumber]
enumFromTo :: VersionNumber -> VersionNumber -> [VersionNumber]
$cenumFromThenTo :: VersionNumber -> VersionNumber -> VersionNumber -> [VersionNumber]
enumFromThenTo :: VersionNumber -> VersionNumber -> VersionNumber -> [VersionNumber]
Enum, VersionNumber
VersionNumber -> VersionNumber -> Bounded VersionNumber
forall a. a -> a -> Bounded a
$cminBound :: VersionNumber
minBound :: VersionNumber
$cmaxBound :: VersionNumber
maxBound :: VersionNumber
Bounded, Int -> VersionNumber -> ShowS
[VersionNumber] -> ShowS
VersionNumber -> String
(Int -> VersionNumber -> ShowS)
-> (VersionNumber -> String)
-> ([VersionNumber] -> ShowS)
-> Show VersionNumber
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> VersionNumber -> ShowS
showsPrec :: Int -> VersionNumber -> ShowS
$cshow :: VersionNumber -> String
show :: VersionNumber -> String
$cshowList :: [VersionNumber] -> ShowS
showList :: [VersionNumber] -> ShowS
Show)
instance Arbitrary VersionNumber where
arbitrary :: Gen VersionNumber
arbitrary = [VersionNumber] -> Gen VersionNumber
forall a. [a] -> Gen a
elements [VersionNumber
forall a. Bounded a => a
minBound .. VersionNumber
forall a. Bounded a => a
maxBound]
versionNumberCodec :: CodecCBORTerm (String, Maybe Int) VersionNumber
versionNumberCodec :: CodecCBORTerm (String, Maybe Int) VersionNumber
versionNumberCodec = CodecCBORTerm { VersionNumber -> Term
encodeTerm :: VersionNumber -> Term
encodeTerm :: VersionNumber -> Term
encodeTerm, Term -> Either (String, Maybe Int) VersionNumber
decodeTerm :: Term -> Either (String, Maybe Int) VersionNumber
decodeTerm :: Term -> Either (String, Maybe Int) VersionNumber
decodeTerm }
where
encodeTerm :: VersionNumber -> Term
encodeTerm VersionNumber
Version_0 = Int -> Term
CBOR.TInt Int
0
encodeTerm VersionNumber
Version_1 = Int -> Term
CBOR.TInt Int
1
encodeTerm VersionNumber
Version_2 = Int -> Term
CBOR.TInt Int
2
decodeTerm :: Term -> Either (String, Maybe Int) VersionNumber
decodeTerm (CBOR.TInt Int
0) = VersionNumber -> Either (String, Maybe Int) VersionNumber
forall a b. b -> Either a b
Right VersionNumber
Version_0
decodeTerm (CBOR.TInt Int
1) = VersionNumber -> Either (String, Maybe Int) VersionNumber
forall a b. b -> Either a b
Right VersionNumber
Version_1
decodeTerm (CBOR.TInt Int
2) = VersionNumber -> Either (String, Maybe Int) VersionNumber
forall a b. b -> Either a b
Right VersionNumber
Version_2
decodeTerm (CBOR.TInt Int
n) = (String, Maybe Int) -> Either (String, Maybe Int) VersionNumber
forall a b. a -> Either a b
Left (String
"unknown version", Int -> Maybe Int
forall a. a -> Maybe a
Just Int
n)
decodeTerm Term
_ = (String, Maybe Int) -> Either (String, Maybe Int) VersionNumber
forall a b. a -> Either a b
Left (String
"unknown tag", Maybe Int
forall a. Maybe a
Nothing)
versionNumberHandshakeCodec :: ( MonadST m
, MonadThrow m
)
=> Codec (Handshake VersionNumber CBOR.Term)
CBOR.DeserialiseFailure m ByteString
versionNumberHandshakeCodec :: forall (m :: * -> *).
(MonadST m, MonadThrow m) =>
Codec
(Handshake VersionNumber Term) DeserialiseFailure m ByteString
versionNumberHandshakeCodec = CodecCBORTerm (String, Maybe Int) VersionNumber
-> Codec
(Handshake VersionNumber Term) DeserialiseFailure m ByteString
forall vNumber (m :: * -> *) failure.
(MonadST m, Ord vNumber, Show failure) =>
CodecCBORTerm (failure, Maybe Int) vNumber
-> Codec (Handshake vNumber Term) DeserialiseFailure m ByteString
codecHandshake CodecCBORTerm (String, Maybe Int) VersionNumber
versionNumberCodec
data VersionData = VersionData {
VersionData -> Int
dataVersion0 :: Int,
VersionData -> Bool
dataVersion1 :: Bool,
VersionData -> Bool
dataVersion2 :: Bool
}
deriving (VersionData -> VersionData -> Bool
(VersionData -> VersionData -> Bool)
-> (VersionData -> VersionData -> Bool) -> Eq VersionData
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: VersionData -> VersionData -> Bool
== :: VersionData -> VersionData -> Bool
$c/= :: VersionData -> VersionData -> Bool
/= :: VersionData -> VersionData -> Bool
Eq, Int -> VersionData -> ShowS
[VersionData] -> ShowS
VersionData -> String
(Int -> VersionData -> ShowS)
-> (VersionData -> String)
-> ([VersionData] -> ShowS)
-> Show VersionData
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> VersionData -> ShowS
showsPrec :: Int -> VersionData -> ShowS
$cshow :: VersionData -> String
show :: VersionData -> String
$cshowList :: [VersionData] -> ShowS
showList :: [VersionData] -> ShowS
Show, (forall x. VersionData -> Rep VersionData x)
-> (forall x. Rep VersionData x -> VersionData)
-> Generic VersionData
forall x. Rep VersionData x -> VersionData
forall x. VersionData -> Rep VersionData x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. VersionData -> Rep VersionData x
from :: forall x. VersionData -> Rep VersionData x
$cto :: forall x. Rep VersionData x -> VersionData
to :: forall x. Rep VersionData x -> VersionData
Generic)
instance Acceptable VersionData where
acceptableVersion :: VersionData -> VersionData -> Accept VersionData
acceptableVersion VersionData
d VersionData
d' =
if VersionData -> Int
dataVersion0 VersionData
d Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= VersionData -> Int
dataVersion0 VersionData
d'
then Text -> Accept VersionData
forall vData. Text -> Accept vData
Refuse (String -> Text
T.pack String
"incompatible")
else VersionData -> Accept VersionData
forall vData. vData -> Accept vData
Accept (VersionData -> Accept VersionData)
-> VersionData -> Accept VersionData
forall a b. (a -> b) -> a -> b
$ VersionData { dataVersion0 :: Int
dataVersion0 = VersionData -> Int
dataVersion0 VersionData
d,
dataVersion1 :: Bool
dataVersion1 = VersionData -> Bool
dataVersion1 VersionData
d
Bool -> Bool -> Bool
&& VersionData -> Bool
dataVersion1 VersionData
d',
dataVersion2 :: Bool
dataVersion2 = VersionData -> Bool
dataVersion2 VersionData
d
Bool -> Bool -> Bool
|| VersionData -> Bool
dataVersion2 VersionData
d' }
instance Queryable VersionData where
queryVersion :: VersionData -> Bool
queryVersion VersionData
_d = Bool
False
dataCodecCBORTerm :: VersionNumber -> CodecCBORTerm Text VersionData
dataCodecCBORTerm :: VersionNumber -> CodecCBORTerm Text VersionData
dataCodecCBORTerm VersionNumber
Version_0 = CodecCBORTerm {VersionData -> Term
encodeTerm :: VersionData -> Term
encodeTerm :: VersionData -> Term
encodeTerm, Term -> Either Text VersionData
decodeTerm :: Term -> Either Text VersionData
decodeTerm :: Term -> Either Text VersionData
decodeTerm}
where
encodeTerm :: VersionData -> Term
encodeTerm VersionData { Int
dataVersion0 :: VersionData -> Int
dataVersion0 :: Int
dataVersion0 } =
Int -> Term
CBOR.TInt Int
dataVersion0
decodeTerm :: Term -> Either Text VersionData
decodeTerm (CBOR.TInt Int
dataVersion0) =
VersionData -> Either Text VersionData
forall a b. b -> Either a b
Right VersionData { Int
dataVersion0 :: Int
dataVersion0 :: Int
dataVersion0,
dataVersion1 :: Bool
dataVersion1 = Bool
False,
dataVersion2 :: Bool
dataVersion2 = Bool
False }
decodeTerm Term
n =
Text -> Either Text VersionData
forall a b. a -> Either a b
Left (Text -> Either Text VersionData)
-> Text -> Either Text VersionData
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ String
"decodeTerm VersionData: unrecognised tag: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Term -> String
forall a. Show a => a -> String
show Term
n
dataCodecCBORTerm VersionNumber
Version_1 = CodecCBORTerm {VersionData -> Term
encodeTerm :: VersionData -> Term
encodeTerm :: VersionData -> Term
encodeTerm, Term -> Either Text VersionData
decodeTerm :: Term -> Either Text VersionData
decodeTerm :: Term -> Either Text VersionData
decodeTerm}
where
encodeTerm :: VersionData -> Term
encodeTerm VersionData { Int
dataVersion0 :: VersionData -> Int
dataVersion0 :: Int
dataVersion0,
Bool
dataVersion1 :: VersionData -> Bool
dataVersion1 :: Bool
dataVersion1 } =
[Term] -> Term
CBOR.TList [ Int -> Term
CBOR.TInt Int
dataVersion0,
Bool -> Term
CBOR.TBool Bool
dataVersion1 ]
decodeTerm :: Term -> Either Text VersionData
decodeTerm (CBOR.TList [ CBOR.TInt Int
dataVersion0,
CBOR.TBool Bool
dataVersion1 ])
= VersionData -> Either Text VersionData
forall a b. b -> Either a b
Right VersionData { Int
dataVersion0 :: Int
dataVersion0 :: Int
dataVersion0,
Bool
dataVersion1 :: Bool
dataVersion1 :: Bool
dataVersion1,
dataVersion2 :: Bool
dataVersion2 = Bool
False }
decodeTerm Term
n
= Text -> Either Text VersionData
forall a b. a -> Either a b
Left (Text -> Either Text VersionData)
-> Text -> Either Text VersionData
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ String
"decodeTerm VersionData: unrecognised tag: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Term -> String
forall a. Show a => a -> String
show Term
n
dataCodecCBORTerm VersionNumber
Version_2 = CodecCBORTerm {VersionData -> Term
encodeTerm :: VersionData -> Term
encodeTerm :: VersionData -> Term
encodeTerm, Term -> Either Text VersionData
decodeTerm :: Term -> Either Text VersionData
decodeTerm :: Term -> Either Text VersionData
decodeTerm}
where
encodeTerm :: VersionData -> Term
encodeTerm VersionData { Int
dataVersion0 :: VersionData -> Int
dataVersion0 :: Int
dataVersion0,
Bool
dataVersion1 :: VersionData -> Bool
dataVersion1 :: Bool
dataVersion1,
Bool
dataVersion2 :: VersionData -> Bool
dataVersion2 :: Bool
dataVersion2 } =
[Term] -> Term
CBOR.TList [ Int -> Term
CBOR.TInt Int
dataVersion0,
Bool -> Term
CBOR.TBool Bool
dataVersion1,
Bool -> Term
CBOR.TBool Bool
dataVersion2 ]
decodeTerm :: Term -> Either Text VersionData
decodeTerm (CBOR.TList [ CBOR.TInt Int
dataVersion0,
CBOR.TBool Bool
dataVersion1,
CBOR.TBool Bool
dataVersion2 ])
= VersionData -> Either Text VersionData
forall a b. b -> Either a b
Right VersionData { Int
dataVersion0 :: Int
dataVersion0 :: Int
dataVersion0,
Bool
dataVersion1 :: Bool
dataVersion1 :: Bool
dataVersion1,
Bool
dataVersion2 :: Bool
dataVersion2 :: Bool
dataVersion2 }
decodeTerm Term
n
= Text -> Either Text VersionData
forall a b. a -> Either a b
Left (Text -> Either Text VersionData)
-> Text -> Either Text VersionData
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ String
"decodeTerm Data: unrecognised tag: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Term -> String
forall a. Show a => a -> String
show Term
n
arbitraryVersionData :: VersionNumber -> Gen VersionData
arbitraryVersionData :: VersionNumber -> Gen VersionData
arbitraryVersionData VersionNumber
Version_0 = (\Int
a -> Int -> Bool -> Bool -> VersionData
VersionData Int
a Bool
False Bool
False)
(Int -> VersionData) -> Gen Int -> Gen VersionData
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Int
forall a. Arbitrary a => Gen a
arbitrary
arbitraryVersionData VersionNumber
Version_1 = (\Int
a Bool
b -> Int -> Bool -> Bool -> VersionData
VersionData Int
a Bool
b Bool
False)
(Int -> Bool -> VersionData)
-> Gen Int -> Gen (Bool -> VersionData)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Int
forall a. Arbitrary a => Gen a
arbitrary
Gen (Bool -> VersionData) -> Gen Bool -> Gen VersionData
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen Bool
forall a. Arbitrary a => Gen a
arbitrary
arbitraryVersionData VersionNumber
Version_2 = Int -> Bool -> Bool -> VersionData
VersionData
(Int -> Bool -> Bool -> VersionData)
-> Gen Int -> Gen (Bool -> Bool -> VersionData)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Int
forall a. Arbitrary a => Gen a
arbitrary
Gen (Bool -> Bool -> VersionData)
-> Gen Bool -> Gen (Bool -> VersionData)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen Bool
forall a. Arbitrary a => Gen a
arbitrary
Gen (Bool -> VersionData) -> Gen Bool -> Gen VersionData
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen Bool
forall a. Arbitrary a => Gen a
arbitrary
instance Arbitrary VersionData where
arbitrary :: Gen VersionData
arbitrary = Gen VersionNumber
forall a. Arbitrary a => Gen a
arbitrary Gen VersionNumber
-> (VersionNumber -> Gen VersionData) -> Gen VersionData
forall a b. Gen a -> (a -> Gen b) -> Gen b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= VersionNumber -> Gen VersionData
arbitraryVersionData
instance CoArbitrary VersionData where
application :: VersionData -> VersionData -> Bool
application :: VersionData -> VersionData -> Bool
application VersionData
d = \VersionData
d' ->
(VersionData -> Int
dataVersion0 VersionData
d Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== VersionData -> Int
dataVersion0 VersionData
d')
Bool -> Bool -> Bool
&& (VersionData -> Bool
dataVersion1 VersionData
d Bool -> Bool -> Bool
forall a. Ord a => a -> a -> Bool
>= VersionData -> Bool
dataVersion1 VersionData
d')
Bool -> Bool -> Bool
&& (VersionData -> Bool
dataVersion2 VersionData
d Bool -> Bool -> Bool
forall a. Ord a => a -> a -> Bool
<= VersionData -> Bool
dataVersion2 VersionData
d')
genValidVersion
:: VersionNumber
-> Gen (Version VersionData Bool)
genValidVersion :: VersionNumber -> Gen (Version VersionData Bool)
genValidVersion VersionNumber
version = do
d <- VersionNumber -> Gen VersionData
arbitraryVersionData VersionNumber
version
return $ Version (application d) d
genInvalidVersion
:: VersionNumber
-> Gen (Version VersionData Bool)
genInvalidVersion :: VersionNumber -> Gen (Version VersionData Bool)
genInvalidVersion VersionNumber
Version_0 =
[Gen (Version VersionData Bool)] -> Gen (Version VersionData Bool)
forall a. [Gen a] -> Gen a
oneof [ VersionNumber -> Gen (Version VersionData Bool)
genValidVersion VersionNumber
Version_1
, VersionNumber -> Gen (Version VersionData Bool)
genValidVersion VersionNumber
Version_2 ]
genInvalidVersion VersionNumber
Version_1 =
[Gen (Version VersionData Bool)] -> Gen (Version VersionData Bool)
forall a. [Gen a] -> Gen a
oneof [ VersionNumber -> Gen (Version VersionData Bool)
genValidVersion VersionNumber
Version_0
, VersionNumber -> Gen (Version VersionData Bool)
genValidVersion VersionNumber
Version_2 ]
genInvalidVersion VersionNumber
Version_2 =
[Gen (Version VersionData Bool)] -> Gen (Version VersionData Bool)
forall a. [Gen a] -> Gen a
oneof [ VersionNumber -> Gen (Version VersionData Bool)
genValidVersion VersionNumber
Version_0
, VersionNumber -> Gen (Version VersionData Bool)
genValidVersion VersionNumber
Version_1 ]
genValidVersions :: Gen (Versions VersionNumber VersionData Bool)
genValidVersions :: Gen (Versions VersionNumber VersionData Bool)
genValidVersions = do
vns <- [VersionNumber] -> [VersionNumber]
forall a. Eq a => [a] -> [a]
nub ([VersionNumber] -> [VersionNumber])
-> Gen [VersionNumber] -> Gen [VersionNumber]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Gen [VersionNumber] -> Gen [VersionNumber]
forall a. Int -> Gen a -> Gen a
resize Int
3 (Gen VersionNumber -> Gen [VersionNumber]
forall a. Gen a -> Gen [a]
listOf1 (Gen VersionNumber
forall a. Arbitrary a => Gen a
arbitrary :: Gen VersionNumber))
vs <- traverse genValidVersion vns
return $ Versions $ Map.fromList $ zip vns vs
genVersions :: Gen (Versions VersionNumber VersionData Bool)
genVersions :: Gen (Versions VersionNumber VersionData Bool)
genVersions = do
vns <- [VersionNumber] -> [VersionNumber]
forall a. Eq a => [a] -> [a]
nub ([VersionNumber] -> [VersionNumber])
-> Gen [VersionNumber] -> Gen [VersionNumber]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Gen [VersionNumber] -> Gen [VersionNumber]
forall a. Int -> Gen a -> Gen a
resize Int
3 (Gen VersionNumber -> Gen [VersionNumber]
forall a. Gen a -> Gen [a]
listOf1 (Gen VersionNumber
forall a. Arbitrary a => Gen a
arbitrary :: Gen VersionNumber))
vs <- traverse (\VersionNumber
v -> [Gen (Version VersionData Bool)] -> Gen (Version VersionData Bool)
forall a. [Gen a] -> Gen a
oneof [VersionNumber -> Gen (Version VersionData Bool)
genValidVersion VersionNumber
v, VersionNumber -> Gen (Version VersionData Bool)
genInvalidVersion VersionNumber
v]) vns
return $ Versions $ Map.fromList $ zip vns vs
newtype ArbitraryValidVersions = ArbitraryValidVersions {
ArbitraryValidVersions -> Versions VersionNumber VersionData Bool
runArbitraryValidVersions :: Versions VersionNumber VersionData Bool
}
instance Show ArbitraryValidVersions where
show :: ArbitraryValidVersions -> String
show (ArbitraryValidVersions (Versions Map VersionNumber (Version VersionData Bool)
vs)) = Map VersionNumber VersionData -> String
forall a. Show a => a -> String
show ((Version VersionData Bool -> VersionData)
-> Map VersionNumber (Version VersionData Bool)
-> Map VersionNumber VersionData
forall a b k. (a -> b) -> Map k a -> Map k b
Map.map Version VersionData Bool -> VersionData
forall vData r. Version vData r -> vData
versionData Map VersionNumber (Version VersionData Bool)
vs)
instance Arbitrary ArbitraryValidVersions where
arbitrary :: Gen ArbitraryValidVersions
arbitrary = Versions VersionNumber VersionData Bool -> ArbitraryValidVersions
ArbitraryValidVersions (Versions VersionNumber VersionData Bool -> ArbitraryValidVersions)
-> Gen (Versions VersionNumber VersionData Bool)
-> Gen ArbitraryValidVersions
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (Versions VersionNumber VersionData Bool)
genValidVersions
prop_arbitrary_ArbitraryValidVersions
:: ArbitraryValidVersions
-> Bool
prop_arbitrary_ArbitraryValidVersions :: ArbitraryValidVersions -> Bool
prop_arbitrary_ArbitraryValidVersions (ArbitraryValidVersions Versions VersionNumber VersionData Bool
vs) =
(Bool -> VersionNumber -> Version VersionData Bool -> Bool)
-> Bool -> Map VersionNumber (Version VersionData Bool) -> Bool
forall a k b. (a -> k -> b -> a) -> a -> Map k b -> a
Map.foldlWithKey' (\Bool
r VersionNumber
vn Version VersionData Bool
s -> Bool
r Bool -> Bool -> Bool
&& VersionNumber -> Version VersionData Bool -> Bool
validVersion VersionNumber
vn Version VersionData Bool
s) Bool
True (Versions VersionNumber VersionData Bool
-> Map VersionNumber (Version VersionData Bool)
forall vNum vData r.
Versions vNum vData r -> Map vNum (Version vData r)
getVersions Versions VersionNumber VersionData Bool
vs)
prop_shrink_ArbitraryValidVersions
:: ArbitraryValidVersions
-> Bool
prop_shrink_ArbitraryValidVersions :: ArbitraryValidVersions -> Bool
prop_shrink_ArbitraryValidVersions ArbitraryValidVersions
a = (Bool -> Bool) -> [Bool] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Bool -> Bool
forall a. a -> a
id
[ (Bool -> VersionNumber -> Version VersionData Bool -> Bool)
-> Bool -> Map VersionNumber (Version VersionData Bool) -> Bool
forall a k b. (a -> k -> b -> a) -> a -> Map k b -> a
Map.foldlWithKey' (\Bool
r VersionNumber
vn Version VersionData Bool
s -> Bool
r Bool -> Bool -> Bool
&& VersionNumber -> Version VersionData Bool -> Bool
validVersion VersionNumber
vn Version VersionData Bool
s) Bool
True (Versions VersionNumber VersionData Bool
-> Map VersionNumber (Version VersionData Bool)
forall vNum vData r.
Versions vNum vData r -> Map vNum (Version vData r)
getVersions Versions VersionNumber VersionData Bool
vs')
| ArbitraryValidVersions Versions VersionNumber VersionData Bool
vs' <- ArbitraryValidVersions -> [ArbitraryValidVersions]
forall a. Arbitrary a => a -> [a]
shrink ArbitraryValidVersions
a
]
data ArbitraryVersions =
ArbitraryVersions
(Versions VersionNumber VersionData Bool)
(Versions VersionNumber VersionData Bool)
instance Show ArbitraryVersions where
show :: ArbitraryVersions -> String
show (ArbitraryVersions (Versions Map VersionNumber (Version VersionData Bool)
vs) (Versions Map VersionNumber (Version VersionData Bool)
vs'))
= String
"ArbitraryVersions " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Map VersionNumber VersionData -> String
forall a. Show a => a -> String
show ((Version VersionData Bool -> VersionData)
-> Map VersionNumber (Version VersionData Bool)
-> Map VersionNumber VersionData
forall a b k. (a -> b) -> Map k a -> Map k b
Map.map Version VersionData Bool -> VersionData
forall vData r. Version vData r -> vData
versionData Map VersionNumber (Version VersionData Bool)
vs) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Map VersionNumber VersionData -> String
forall a. Show a => a -> String
show ((Version VersionData Bool -> VersionData)
-> Map VersionNumber (Version VersionData Bool)
-> Map VersionNumber VersionData
forall a b k. (a -> b) -> Map k a -> Map k b
Map.map Version VersionData Bool -> VersionData
forall vData r. Version vData r -> vData
versionData Map VersionNumber (Version VersionData Bool)
vs')
instance Arbitrary ArbitraryVersions where
arbitrary :: Gen ArbitraryVersions
arbitrary = [(Int, Gen ArbitraryVersions)] -> Gen ArbitraryVersions
forall a. [(Int, Gen a)] -> Gen a
frequency
[ (Int
1, (\Versions VersionNumber VersionData Bool
v -> Versions VersionNumber VersionData Bool
-> Versions VersionNumber VersionData Bool -> ArbitraryVersions
ArbitraryVersions Versions VersionNumber VersionData Bool
v Versions VersionNumber VersionData Bool
v) (Versions VersionNumber VersionData Bool -> ArbitraryVersions)
-> Gen (Versions VersionNumber VersionData Bool)
-> Gen ArbitraryVersions
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (Versions VersionNumber VersionData Bool)
genVersions)
, (Int
2, Versions VersionNumber VersionData Bool
-> Versions VersionNumber VersionData Bool -> ArbitraryVersions
ArbitraryVersions (Versions VersionNumber VersionData Bool
-> Versions VersionNumber VersionData Bool -> ArbitraryVersions)
-> Gen (Versions VersionNumber VersionData Bool)
-> Gen
(Versions VersionNumber VersionData Bool -> ArbitraryVersions)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (Versions VersionNumber VersionData Bool)
genVersions Gen (Versions VersionNumber VersionData Bool -> ArbitraryVersions)
-> Gen (Versions VersionNumber VersionData Bool)
-> Gen ArbitraryVersions
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen (Versions VersionNumber VersionData Bool)
genVersions)
]
shrink :: ArbitraryVersions -> [ArbitraryVersions]
shrink (ArbitraryVersions (Versions Map VersionNumber (Version VersionData Bool)
vs) (Versions Map VersionNumber (Version VersionData Bool)
vs')) =
[ Versions VersionNumber VersionData Bool
-> Versions VersionNumber VersionData Bool -> ArbitraryVersions
ArbitraryVersions (Map VersionNumber (Version VersionData Bool)
-> Versions VersionNumber VersionData Bool
forall vNum vData r.
Map vNum (Version vData r) -> Versions vNum vData r
Versions (Map VersionNumber (Version VersionData Bool)
-> Versions VersionNumber VersionData Bool)
-> Map VersionNumber (Version VersionData Bool)
-> Versions VersionNumber VersionData Bool
forall a b. (a -> b) -> a -> b
$ [(VersionNumber, Version VersionData Bool)]
-> Map VersionNumber (Version VersionData Bool)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(VersionNumber, Version VersionData Bool)]
vs'') (Map VersionNumber (Version VersionData Bool)
-> Versions VersionNumber VersionData Bool
forall vNum vData r.
Map vNum (Version vData r) -> Versions vNum vData r
Versions Map VersionNumber (Version VersionData Bool)
vs')
| [(VersionNumber, Version VersionData Bool)]
vs'' <- ((VersionNumber, Version VersionData Bool)
-> [(VersionNumber, Version VersionData Bool)])
-> [(VersionNumber, Version VersionData Bool)]
-> [[(VersionNumber, Version VersionData Bool)]]
forall a. (a -> [a]) -> [a] -> [[a]]
shrinkList ([(VersionNumber, Version VersionData Bool)]
-> (VersionNumber, Version VersionData Bool)
-> [(VersionNumber, Version VersionData Bool)]
forall a b. a -> b -> a
const []) (Map VersionNumber (Version VersionData Bool)
-> [(VersionNumber, Version VersionData Bool)]
forall k a. Map k a -> [(k, a)]
Map.toList Map VersionNumber (Version VersionData Bool)
vs)
] [ArbitraryVersions] -> [ArbitraryVersions] -> [ArbitraryVersions]
forall a. [a] -> [a] -> [a]
++
[ Versions VersionNumber VersionData Bool
-> Versions VersionNumber VersionData Bool -> ArbitraryVersions
ArbitraryVersions (Map VersionNumber (Version VersionData Bool)
-> Versions VersionNumber VersionData Bool
forall vNum vData r.
Map vNum (Version vData r) -> Versions vNum vData r
Versions Map VersionNumber (Version VersionData Bool)
vs) (Map VersionNumber (Version VersionData Bool)
-> Versions VersionNumber VersionData Bool
forall vNum vData r.
Map vNum (Version vData r) -> Versions vNum vData r
Versions (Map VersionNumber (Version VersionData Bool)
-> Versions VersionNumber VersionData Bool)
-> Map VersionNumber (Version VersionData Bool)
-> Versions VersionNumber VersionData Bool
forall a b. (a -> b) -> a -> b
$ [(VersionNumber, Version VersionData Bool)]
-> Map VersionNumber (Version VersionData Bool)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(VersionNumber, Version VersionData Bool)]
vs'')
| [(VersionNumber, Version VersionData Bool)]
vs'' <- ((VersionNumber, Version VersionData Bool)
-> [(VersionNumber, Version VersionData Bool)])
-> [(VersionNumber, Version VersionData Bool)]
-> [[(VersionNumber, Version VersionData Bool)]]
forall a. (a -> [a]) -> [a] -> [[a]]
shrinkList ([(VersionNumber, Version VersionData Bool)]
-> (VersionNumber, Version VersionData Bool)
-> [(VersionNumber, Version VersionData Bool)]
forall a b. a -> b -> a
const []) (Map VersionNumber (Version VersionData Bool)
-> [(VersionNumber, Version VersionData Bool)]
forall k a. Map k a -> [(k, a)]
Map.toList Map VersionNumber (Version VersionData Bool)
vs')
]
validVersion :: VersionNumber -> Version VersionData Bool -> Bool
validVersion :: VersionNumber -> Version VersionData Bool -> Bool
validVersion VersionNumber
Version_0 ((Version VersionData -> Bool
_ VersionData
d)) = VersionData -> Bool
dataVersion1 VersionData
d Bool -> Bool -> Bool
forall a. Eq a => a -> a -> Bool
== Bool
False
Bool -> Bool -> Bool
&& VersionData -> Bool
dataVersion2 VersionData
d Bool -> Bool -> Bool
forall a. Eq a => a -> a -> Bool
== Bool
False
validVersion VersionNumber
Version_1 ((Version VersionData -> Bool
_ VersionData
d)) = VersionData -> Bool
dataVersion2 VersionData
d Bool -> Bool -> Bool
forall a. Eq a => a -> a -> Bool
== Bool
False
validVersion VersionNumber
Version_2 ((Version VersionData -> Bool
_ VersionData
_)) = Bool
True
prop_arbitrary_ArbitraryVersions :: ArbitraryVersions -> Property
prop_arbitrary_ArbitraryVersions :: ArbitraryVersions -> Property
prop_arbitrary_ArbitraryVersions (ArbitraryVersions (Versions Map VersionNumber (Version VersionData Bool)
vs) (Versions Map VersionNumber (Version VersionData Bool)
vs')) =
Double -> Bool -> String -> Property -> Property
forall prop.
Testable prop =>
Double -> Bool -> String -> prop -> Property
cover Double
75 Bool
intersect String
"non-empty intersection" (Property -> Property) -> Property -> Property
forall a b. (a -> b) -> a -> b
$
Double -> Bool -> String -> Property -> Property
forall prop.
Testable prop =>
Double -> Bool -> String -> prop -> Property
cover Double
10 (Bool -> Bool
not Bool
intersect) String
"empty intersection" (Property -> Property) -> Property -> Property
forall a b. (a -> b) -> a -> b
$
Double -> Bool -> String -> Property -> Property
forall prop.
Testable prop =>
Double -> Bool -> String -> prop -> Property
cover Double
25 (case Map VersionNumber (Version VersionData Bool)
-> Maybe (VersionNumber, Version VersionData Bool)
forall k a. Map k a -> Maybe (k, a)
Map.lookupMax Map VersionNumber (Version VersionData Bool)
intersection of
Maybe (VersionNumber, Version VersionData Bool)
Nothing -> Bool
False
Just (VersionNumber
vn, Version VersionData Bool
s) -> VersionNumber -> Version VersionData Bool -> Bool
validVersion VersionNumber
vn Version VersionData Bool
s)
String
"valid common max version" (Property -> Property) -> Property -> Property
forall a b. (a -> b) -> a -> b
$
Double -> Bool -> String -> Property -> Property
forall prop.
Testable prop =>
Double -> Bool -> String -> prop -> Property
cover Double
25
((Bool -> VersionNumber -> Version VersionData Bool -> Bool)
-> Bool -> Map VersionNumber (Version VersionData Bool) -> Bool
forall a k b. (a -> k -> b -> a) -> a -> Map k b -> a
Map.foldlWithKey' (\Bool
r VersionNumber
vn Version VersionData Bool
s -> Bool
r Bool -> Bool -> Bool
&& (Bool -> Bool
not (VersionNumber
vn VersionNumber -> [VersionNumber] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [VersionNumber]
knownVersionNumbers) Bool -> Bool -> Bool
|| Bool -> Bool
not (VersionNumber -> Version VersionData Bool -> Bool
validVersion VersionNumber
vn Version VersionData Bool
s))) Bool
True Map VersionNumber (Version VersionData Bool)
vs)
String
"all versions are either unknown or not valid" (Property -> Property) -> Property -> Property
forall a b. (a -> b) -> a -> b
$
Bool -> Property
forall prop. Testable prop => prop -> Property
property Bool
True
where
intersection :: Map VersionNumber (Version VersionData Bool)
intersection = Map VersionNumber (Version VersionData Bool)
vs Map VersionNumber (Version VersionData Bool)
-> Map VersionNumber (Version VersionData Bool)
-> Map VersionNumber (Version VersionData Bool)
forall k a b. Ord k => Map k a -> Map k b -> Map k a
`Map.intersection` Map VersionNumber (Version VersionData Bool)
vs'
intersect :: Bool
intersect = Bool -> Bool
not (Map VersionNumber (Version VersionData Bool) -> Bool
forall k a. Map k a -> Bool
Map.null Map VersionNumber (Version VersionData Bool)
intersection)
knownVersionNumbers :: [VersionNumber]
knownVersionNumbers = Map VersionNumber (Version VersionData Bool) -> [VersionNumber]
forall k a. Map k a -> [k]
Map.keys Map VersionNumber (Version VersionData Bool)
vs'
maybeAccept :: Accept a -> Maybe a
maybeAccept :: forall a. Accept a -> Maybe a
maybeAccept (Accept a
a) = a -> Maybe a
forall a. a -> Maybe a
Just a
a
maybeAccept (Refuse Text
_) = Maybe a
forall a. Maybe a
Nothing
prop_connect :: ArbitraryVersions -> Property
prop_connect :: ArbitraryVersions -> Property
prop_connect (ArbitraryVersions Versions VersionNumber VersionData Bool
clientVersions Versions VersionNumber VersionData Bool
serverVersions) =
let (Maybe Bool
serverRes, Maybe Bool
clientRes) =
(VersionData -> VersionData -> Maybe VersionData)
-> Versions VersionNumber VersionData Bool
-> Versions VersionNumber VersionData Bool
-> (Maybe Bool, Maybe Bool)
forall vNumber vData r.
Ord vNumber =>
(vData -> vData -> Maybe vData)
-> Versions vNumber vData r
-> Versions vNumber vData r
-> (Maybe r, Maybe r)
pureHandshake
((Accept VersionData -> Maybe VersionData
forall a. Accept a -> Maybe a
maybeAccept (Accept VersionData -> Maybe VersionData)
-> (VersionData -> Accept VersionData)
-> VersionData
-> Maybe VersionData
forall b c a. (b -> c) -> (a -> b) -> a -> c
.) ((VersionData -> Accept VersionData)
-> VersionData -> Maybe VersionData)
-> (VersionData -> VersionData -> Accept VersionData)
-> VersionData
-> VersionData
-> Maybe VersionData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VersionData -> VersionData -> Accept VersionData
forall v. Acceptable v => v -> v -> Accept v
acceptableVersion)
Versions VersionNumber VersionData Bool
serverVersions
Versions VersionNumber VersionData Bool
clientVersions
in case (forall s.
IOSim
s
(Either
(HandshakeProtocolError VersionNumber)
(HandshakeResult Bool VersionNumber VersionData),
Either
(HandshakeProtocolError VersionNumber)
(HandshakeResult Bool VersionNumber VersionData),
TerminalStates (Handshake VersionNumber Term)))
-> (Either
(HandshakeProtocolError VersionNumber)
(HandshakeResult Bool VersionNumber VersionData),
Either
(HandshakeProtocolError VersionNumber)
(HandshakeResult Bool VersionNumber VersionData),
TerminalStates (Handshake VersionNumber Term))
forall a. (forall s. IOSim s a) -> a
runSimOrThrow
(Peer
(Handshake VersionNumber Term)
'AsClient
'NonPipelined
'StPropose
(IOSim s)
(Either
(HandshakeProtocolError VersionNumber)
(HandshakeResult Bool VersionNumber VersionData))
-> Peer
(Handshake VersionNumber Term)
(FlipAgency 'AsClient)
'NonPipelined
'StPropose
(IOSim s)
(Either
(HandshakeProtocolError VersionNumber)
(HandshakeResult Bool VersionNumber VersionData))
-> IOSim
s
(Either
(HandshakeProtocolError VersionNumber)
(HandshakeResult Bool VersionNumber VersionData),
Either
(HandshakeProtocolError VersionNumber)
(HandshakeResult Bool VersionNumber VersionData),
TerminalStates (Handshake VersionNumber Term))
forall ps (pr :: PeerRole) (initSt :: ps) (m :: * -> *) a b.
(Monad m, SingI pr) =>
Peer ps pr 'NonPipelined initSt m a
-> Peer ps (FlipAgency pr) 'NonPipelined initSt m b
-> m (a, b, TerminalStates ps)
connect
(VersionDataCodec Term VersionNumber VersionData
-> (VersionData -> VersionData -> Accept VersionData)
-> Versions VersionNumber VersionData Bool
-> Peer
(Handshake VersionNumber Term)
'AsClient
'NonPipelined
'StPropose
(IOSim s)
(Either
(HandshakeProtocolError VersionNumber)
(HandshakeResult Bool VersionNumber VersionData))
forall vNumber vData r (m :: * -> *).
Ord vNumber =>
VersionDataCodec Term vNumber vData
-> (vData -> vData -> Accept vData)
-> Versions vNumber vData r
-> Client
(Handshake vNumber Term)
'NonPipelined
'StPropose
m
(Either
(HandshakeProtocolError vNumber) (HandshakeResult r vNumber vData))
handshakeClientPeer
((VersionNumber -> CodecCBORTerm Text VersionData)
-> VersionDataCodec Term VersionNumber VersionData
forall vNumber vData.
(vNumber -> CodecCBORTerm Text vData)
-> VersionDataCodec Term vNumber vData
cborTermVersionDataCodec VersionNumber -> CodecCBORTerm Text VersionData
dataCodecCBORTerm)
VersionData -> VersionData -> Accept VersionData
forall v. Acceptable v => v -> v -> Accept v
acceptableVersion
Versions VersionNumber VersionData Bool
clientVersions)
(VersionDataCodec Term VersionNumber VersionData
-> (VersionData -> VersionData -> Accept VersionData)
-> (VersionData -> Bool)
-> Versions VersionNumber VersionData Bool
-> Server
(Handshake VersionNumber Term)
'NonPipelined
'StPropose
(IOSim s)
(Either
(HandshakeProtocolError VersionNumber)
(HandshakeResult Bool VersionNumber VersionData))
forall vNumber vData r (m :: * -> *).
Ord vNumber =>
VersionDataCodec Term vNumber vData
-> (vData -> vData -> Accept vData)
-> (vData -> Bool)
-> Versions vNumber vData r
-> Server
(Handshake vNumber Term)
'NonPipelined
'StPropose
m
(Either
(HandshakeProtocolError vNumber) (HandshakeResult r vNumber vData))
handshakeServerPeer
((VersionNumber -> CodecCBORTerm Text VersionData)
-> VersionDataCodec Term VersionNumber VersionData
forall vNumber vData.
(vNumber -> CodecCBORTerm Text vData)
-> VersionDataCodec Term vNumber vData
cborTermVersionDataCodec VersionNumber -> CodecCBORTerm Text VersionData
dataCodecCBORTerm)
VersionData -> VersionData -> Accept VersionData
forall v. Acceptable v => v -> v -> Accept v
acceptableVersion
VersionData -> Bool
forall v. Queryable v => v -> Bool
queryVersion
Versions VersionNumber VersionData Bool
serverVersions)) of
(Either
(HandshakeProtocolError VersionNumber)
(HandshakeResult Bool VersionNumber VersionData)
clientRes', Either
(HandshakeProtocolError VersionNumber)
(HandshakeResult Bool VersionNumber VersionData)
serverRes', TerminalStates SingHandshake st
StateToken st
SingDone SingHandshake 'StDone
StateToken st
SingDone) ->
Bool -> Maybe Bool -> Bool
forall a. a -> Maybe a -> a
fromMaybe Bool
False Maybe Bool
clientRes Bool -> Bool -> Property
forall a. (Eq a, Show a) => a -> a -> Property
=== (HandshakeProtocolError VersionNumber -> Bool)
-> (HandshakeResult Bool VersionNumber VersionData -> Bool)
-> Either
(HandshakeProtocolError VersionNumber)
(HandshakeResult Bool VersionNumber VersionData)
-> Bool
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Bool -> HandshakeProtocolError VersionNumber -> Bool
forall a b. a -> b -> a
const Bool
False) HandshakeResult Bool VersionNumber VersionData -> Bool
forall {vNumber} {vData}.
HandshakeResult Bool vNumber vData -> Bool
extractRes Either
(HandshakeProtocolError VersionNumber)
(HandshakeResult Bool VersionNumber VersionData)
clientRes'
Property -> Property -> Property
forall prop1 prop2.
(Testable prop1, Testable prop2) =>
prop1 -> prop2 -> Property
.&&.
Bool -> Maybe Bool -> Bool
forall a. a -> Maybe a -> a
fromMaybe Bool
False Maybe Bool
serverRes Bool -> Bool -> Property
forall a. (Eq a, Show a) => a -> a -> Property
=== (HandshakeProtocolError VersionNumber -> Bool)
-> (HandshakeResult Bool VersionNumber VersionData -> Bool)
-> Either
(HandshakeProtocolError VersionNumber)
(HandshakeResult Bool VersionNumber VersionData)
-> Bool
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Bool -> HandshakeProtocolError VersionNumber -> Bool
forall a b. a -> b -> a
const Bool
False) HandshakeResult Bool VersionNumber VersionData -> Bool
forall {vNumber} {vData}.
HandshakeResult Bool vNumber vData -> Bool
extractRes Either
(HandshakeProtocolError VersionNumber)
(HandshakeResult Bool VersionNumber VersionData)
serverRes'
where
extractRes :: HandshakeResult Bool vNumber vData -> Bool
extractRes (HandshakeNegotiationResult Bool
r vNumber
_ vData
_) = Bool
r
extractRes (HandshakeQueryResult Map vNumber (Either Text vData)
_) = Bool
False
prop_channel :: ( MonadAsync m
, MonadCatch m
, MonadST m
)
=> m (Channel m ByteString, Channel m ByteString)
-> Versions VersionNumber VersionData Bool
-> Versions VersionNumber VersionData Bool
-> m Property
prop_channel :: forall (m :: * -> *).
(MonadAsync m, MonadCatch m, MonadST m) =>
m (Channel m ByteString, Channel m ByteString)
-> Versions VersionNumber VersionData Bool
-> Versions VersionNumber VersionData Bool
-> m Property
prop_channel m (Channel m ByteString, Channel m ByteString)
createChannels Versions VersionNumber VersionData Bool
clientVersions Versions VersionNumber VersionData Bool
serverVersions =
let (!Maybe Bool
serverRes, !Maybe Bool
clientRes) =
(VersionData -> VersionData -> Maybe VersionData)
-> Versions VersionNumber VersionData Bool
-> Versions VersionNumber VersionData Bool
-> (Maybe Bool, Maybe Bool)
forall vNumber vData r.
Ord vNumber =>
(vData -> vData -> Maybe vData)
-> Versions vNumber vData r
-> Versions vNumber vData r
-> (Maybe r, Maybe r)
pureHandshake
((Accept VersionData -> Maybe VersionData
forall a. Accept a -> Maybe a
maybeAccept (Accept VersionData -> Maybe VersionData)
-> (VersionData -> Accept VersionData)
-> VersionData
-> Maybe VersionData
forall b c a. (b -> c) -> (a -> b) -> a -> c
.) ((VersionData -> Accept VersionData)
-> VersionData -> Maybe VersionData)
-> (VersionData -> VersionData -> Accept VersionData)
-> VersionData
-> VersionData
-> Maybe VersionData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VersionData -> VersionData -> Accept VersionData
forall v. Acceptable v => v -> v -> Accept v
acceptableVersion)
Versions VersionNumber VersionData Bool
serverVersions
Versions VersionNumber VersionData Bool
clientVersions
in do
(!clientRes', !serverRes') <-
m (Channel m ByteString, Channel m ByteString)
-> Tracer m (Role, TraceSendRecv (Handshake VersionNumber Term))
-> Codec
(Handshake VersionNumber Term) DeserialiseFailure m ByteString
-> Peer
(Handshake VersionNumber Term)
'AsClient
'NonPipelined
'StPropose
m
(Either
(HandshakeProtocolError VersionNumber)
(HandshakeResult Bool VersionNumber VersionData))
-> Peer
(Handshake VersionNumber Term)
(FlipAgency 'AsClient)
'NonPipelined
'StPropose
m
(Either
(HandshakeProtocolError VersionNumber)
(HandshakeResult Bool VersionNumber VersionData))
-> m (Either
(HandshakeProtocolError VersionNumber)
(HandshakeResult Bool VersionNumber VersionData),
Either
(HandshakeProtocolError VersionNumber)
(HandshakeResult Bool VersionNumber VersionData))
forall ps (pr :: PeerRole) (st :: ps) failure bytes (m :: * -> *) a
b.
(MonadAsync m, MonadThrow m, ShowProxy ps,
forall (st' :: ps) stok. (stok ~ StateToken st') => Show stok,
Show failure) =>
m (Channel m bytes, Channel m bytes)
-> Tracer m (Role, TraceSendRecv ps)
-> Codec ps failure m bytes
-> Peer ps pr 'NonPipelined st m a
-> Peer ps (FlipAgency pr) 'NonPipelined st m b
-> m (a, b)
runConnectedPeers
m (Channel m ByteString, Channel m ByteString)
createChannels Tracer m (Role, TraceSendRecv (Handshake VersionNumber Term))
forall (m :: * -> *) a. Applicative m => Tracer m a
nullTracer Codec
(Handshake VersionNumber Term) DeserialiseFailure m ByteString
forall (m :: * -> *).
(MonadST m, MonadThrow m) =>
Codec
(Handshake VersionNumber Term) DeserialiseFailure m ByteString
versionNumberHandshakeCodec
(VersionDataCodec Term VersionNumber VersionData
-> (VersionData -> VersionData -> Accept VersionData)
-> Versions VersionNumber VersionData Bool
-> Peer
(Handshake VersionNumber Term)
'AsClient
'NonPipelined
'StPropose
m
(Either
(HandshakeProtocolError VersionNumber)
(HandshakeResult Bool VersionNumber VersionData))
forall vNumber vData r (m :: * -> *).
Ord vNumber =>
VersionDataCodec Term vNumber vData
-> (vData -> vData -> Accept vData)
-> Versions vNumber vData r
-> Client
(Handshake vNumber Term)
'NonPipelined
'StPropose
m
(Either
(HandshakeProtocolError vNumber) (HandshakeResult r vNumber vData))
handshakeClientPeer
((VersionNumber -> CodecCBORTerm Text VersionData)
-> VersionDataCodec Term VersionNumber VersionData
forall vNumber vData.
(vNumber -> CodecCBORTerm Text vData)
-> VersionDataCodec Term vNumber vData
cborTermVersionDataCodec VersionNumber -> CodecCBORTerm Text VersionData
dataCodecCBORTerm)
VersionData -> VersionData -> Accept VersionData
forall v. Acceptable v => v -> v -> Accept v
acceptableVersion
Versions VersionNumber VersionData Bool
clientVersions)
(VersionDataCodec Term VersionNumber VersionData
-> (VersionData -> VersionData -> Accept VersionData)
-> (VersionData -> Bool)
-> Versions VersionNumber VersionData Bool
-> Server
(Handshake VersionNumber Term)
'NonPipelined
'StPropose
m
(Either
(HandshakeProtocolError VersionNumber)
(HandshakeResult Bool VersionNumber VersionData))
forall vNumber vData r (m :: * -> *).
Ord vNumber =>
VersionDataCodec Term vNumber vData
-> (vData -> vData -> Accept vData)
-> (vData -> Bool)
-> Versions vNumber vData r
-> Server
(Handshake vNumber Term)
'NonPipelined
'StPropose
m
(Either
(HandshakeProtocolError vNumber) (HandshakeResult r vNumber vData))
handshakeServerPeer
((VersionNumber -> CodecCBORTerm Text VersionData)
-> VersionDataCodec Term VersionNumber VersionData
forall vNumber vData.
(vNumber -> CodecCBORTerm Text vData)
-> VersionDataCodec Term vNumber vData
cborTermVersionDataCodec VersionNumber -> CodecCBORTerm Text VersionData
dataCodecCBORTerm)
VersionData -> VersionData -> Accept VersionData
forall v. Acceptable v => v -> v -> Accept v
acceptableVersion
VersionData -> Bool
forall v. Queryable v => v -> Bool
queryVersion
Versions VersionNumber VersionData Bool
serverVersions)
pure $!
case (clientRes', serverRes') of
(Right (HandshakeNegotiationResult !Bool
c VersionNumber
_ VersionData
_), Right (HandshakeNegotiationResult !Bool
s VersionNumber
_ VersionData
_)) ->
Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
c Maybe Bool -> Maybe Bool -> Property
forall a. (Eq a, Show a) => a -> a -> Property
=== Maybe Bool
clientRes
Property -> Property -> Property
forall prop1 prop2.
(Testable prop1, Testable prop2) =>
prop1 -> prop2 -> Property
.&&. Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
s Maybe Bool -> Maybe Bool -> Property
forall a. (Eq a, Show a) => a -> a -> Property
=== Maybe Bool
serverRes
(Right (HandshakeQueryResult Map VersionNumber (Either Text VersionData)
_), Right (HandshakeQueryResult Map VersionNumber (Either Text VersionData)
_)) ->
Bool -> Property
forall prop. Testable prop => prop -> Property
property Bool
True
(Left{}, Left{}) -> Bool -> Property
forall prop. Testable prop => prop -> Property
property Bool
True
(Either
(HandshakeProtocolError VersionNumber)
(HandshakeResult Bool VersionNumber VersionData),
Either
(HandshakeProtocolError VersionNumber)
(HandshakeResult Bool VersionNumber VersionData))
_ -> Bool -> Property
forall prop. Testable prop => prop -> Property
property Bool
False
prop_channel_ST :: ArbitraryVersions -> Property
prop_channel_ST :: ArbitraryVersions -> Property
prop_channel_ST (ArbitraryVersions Versions VersionNumber VersionData Bool
clientVersions Versions VersionNumber VersionData Bool
serverVersions) =
(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)
-> Versions VersionNumber VersionData Bool
-> Versions VersionNumber VersionData Bool
-> IOSim s Property
forall (m :: * -> *).
(MonadAsync m, MonadCatch m, MonadST m) =>
m (Channel m ByteString, Channel m ByteString)
-> Versions VersionNumber VersionData Bool
-> Versions VersionNumber VersionData Bool
-> 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 Versions VersionNumber VersionData Bool
clientVersions Versions VersionNumber VersionData Bool
serverVersions)
prop_channel_IO :: ArbitraryVersions -> Property
prop_channel_IO :: ArbitraryVersions -> Property
prop_channel_IO (ArbitraryVersions Versions VersionNumber VersionData Bool
clientVersions Versions VersionNumber VersionData Bool
serverVersions) =
IO Property -> Property
forall prop. Testable prop => IO prop -> Property
ioProperty (IO (Channel IO ByteString, Channel IO ByteString)
-> Versions VersionNumber VersionData Bool
-> Versions VersionNumber VersionData Bool
-> IO Property
forall (m :: * -> *).
(MonadAsync m, MonadCatch m, MonadST m) =>
m (Channel m ByteString, Channel m ByteString)
-> Versions VersionNumber VersionData Bool
-> Versions VersionNumber VersionData Bool
-> m Property
prop_channel IO (Channel IO ByteString, Channel IO ByteString)
forall (m :: * -> *) a. MonadSTM m => m (Channel m a, Channel m a)
createConnectedChannels Versions VersionNumber VersionData Bool
clientVersions Versions VersionNumber VersionData Bool
serverVersions)
prop_pipe_IO :: ArbitraryVersions -> Property
prop_pipe_IO :: ArbitraryVersions -> Property
prop_pipe_IO (ArbitraryVersions Versions VersionNumber VersionData Bool
clientVersions Versions VersionNumber VersionData Bool
serverVersions) =
IO Property -> Property
forall prop. Testable prop => IO prop -> Property
ioProperty (IO (Channel IO ByteString, Channel IO ByteString)
-> Versions VersionNumber VersionData Bool
-> Versions VersionNumber VersionData Bool
-> IO Property
forall (m :: * -> *).
(MonadAsync m, MonadCatch m, MonadST m) =>
m (Channel m ByteString, Channel m ByteString)
-> Versions VersionNumber VersionData Bool
-> Versions VersionNumber VersionData Bool
-> m Property
prop_channel IO (Channel IO ByteString, Channel IO ByteString)
createPipeConnectedChannels Versions VersionNumber VersionData Bool
clientVersions Versions VersionNumber VersionData Bool
serverVersions)
prop_channel_asymmetric
:: ( MonadAsync m
, MonadCatch m
, MonadLabelledSTM m
, MonadMask m
, MonadST m
)
=> m (Channel m ByteString, Channel m ByteString)
-> Versions VersionNumber VersionData Bool
-> m Property
prop_channel_asymmetric :: forall (m :: * -> *).
(MonadAsync m, MonadCatch m, MonadLabelledSTM m, MonadMask m,
MonadST m) =>
m (Channel m ByteString, Channel m ByteString)
-> Versions VersionNumber VersionData Bool -> m Property
prop_channel_asymmetric m (Channel m ByteString, Channel m ByteString)
createChannels Versions VersionNumber VersionData Bool
clientVersions = do
(clientRes', serverRes') <-
m (Channel m ByteString, Channel m ByteString)
-> Tracer m (Role, TraceSendRecv (Handshake VersionNumber Term))
-> Codec
(Handshake VersionNumber Term) DeserialiseFailure m ByteString
-> Codec
(Handshake VersionNumber Term) DeserialiseFailure m ByteString
-> Peer
(Handshake VersionNumber Term)
'AsClient
'NonPipelined
'StPropose
m
(Either
(HandshakeProtocolError VersionNumber)
(HandshakeResult Bool VersionNumber VersionData))
-> Peer
(Handshake VersionNumber Term)
(FlipAgency 'AsClient)
'NonPipelined
'StPropose
m
(Either
(HandshakeProtocolError VersionNumber)
(HandshakeResult Bool VersionNumber VersionData))
-> m (Either
(HandshakeProtocolError VersionNumber)
(HandshakeResult Bool VersionNumber VersionData),
Either
(HandshakeProtocolError VersionNumber)
(HandshakeResult Bool VersionNumber VersionData))
forall (m :: * -> *) ps failure bytes (pr :: PeerRole) (st :: ps) a
b.
(MonadAsync m, MonadMask m, ShowProxy ps,
forall (st' :: ps) stok. (stok ~ StateToken st') => Show stok,
Show failure) =>
m (Channel m bytes, Channel m bytes)
-> Tracer m (Role, TraceSendRecv ps)
-> Codec ps failure m bytes
-> Codec ps failure m bytes
-> Peer ps pr 'NonPipelined st m a
-> Peer ps (FlipAgency pr) 'NonPipelined st m b
-> m (a, b)
runConnectedPeersAsymmetric
m (Channel m ByteString, Channel m ByteString)
createChannels
Tracer m (Role, TraceSendRecv (Handshake VersionNumber Term))
forall (m :: * -> *) a. Applicative m => Tracer m a
nullTracer
Codec
(Handshake VersionNumber Term) DeserialiseFailure m ByteString
forall (m :: * -> *).
(MonadST m, MonadThrow m) =>
Codec
(Handshake VersionNumber Term) DeserialiseFailure m ByteString
versionNumberHandshakeCodec
(CodecCBORTerm (String, Maybe Int) VersionNumber
-> Codec
(Handshake VersionNumber Term) DeserialiseFailure m ByteString
forall vNumber (m :: * -> *) failure.
(MonadST m, Ord vNumber, Show failure) =>
CodecCBORTerm (failure, Maybe Int) vNumber
-> Codec (Handshake vNumber Term) DeserialiseFailure m ByteString
codecHandshake CodecCBORTerm (String, Maybe Int) VersionNumber
versionNumberCodec')
(VersionDataCodec Term VersionNumber VersionData
-> (VersionData -> VersionData -> Accept VersionData)
-> Versions VersionNumber VersionData Bool
-> Peer
(Handshake VersionNumber Term)
'AsClient
'NonPipelined
'StPropose
m
(Either
(HandshakeProtocolError VersionNumber)
(HandshakeResult Bool VersionNumber VersionData))
forall vNumber vData r (m :: * -> *).
Ord vNumber =>
VersionDataCodec Term vNumber vData
-> (vData -> vData -> Accept vData)
-> Versions vNumber vData r
-> Client
(Handshake vNumber Term)
'NonPipelined
'StPropose
m
(Either
(HandshakeProtocolError vNumber) (HandshakeResult r vNumber vData))
handshakeClientPeer
((VersionNumber -> CodecCBORTerm Text VersionData)
-> VersionDataCodec Term VersionNumber VersionData
forall vNumber vData.
(vNumber -> CodecCBORTerm Text vData)
-> VersionDataCodec Term vNumber vData
cborTermVersionDataCodec VersionNumber -> CodecCBORTerm Text VersionData
dataCodecCBORTerm)
VersionData -> VersionData -> Accept VersionData
forall v. Acceptable v => v -> v -> Accept v
acceptableVersion
Versions VersionNumber VersionData Bool
clientVersions)
(VersionDataCodec Term VersionNumber VersionData
-> (VersionData -> VersionData -> Accept VersionData)
-> (VersionData -> Bool)
-> Versions VersionNumber VersionData Bool
-> Server
(Handshake VersionNumber Term)
'NonPipelined
'StPropose
m
(Either
(HandshakeProtocolError VersionNumber)
(HandshakeResult Bool VersionNumber VersionData))
forall vNumber vData r (m :: * -> *).
Ord vNumber =>
VersionDataCodec Term vNumber vData
-> (vData -> vData -> Accept vData)
-> (vData -> Bool)
-> Versions vNumber vData r
-> Server
(Handshake vNumber Term)
'NonPipelined
'StPropose
m
(Either
(HandshakeProtocolError vNumber) (HandshakeResult r vNumber vData))
handshakeServerPeer
((VersionNumber -> CodecCBORTerm Text VersionData)
-> VersionDataCodec Term VersionNumber VersionData
forall vNumber vData.
(vNumber -> CodecCBORTerm Text vData)
-> VersionDataCodec Term vNumber vData
cborTermVersionDataCodec VersionNumber -> CodecCBORTerm Text VersionData
dataCodecCBORTerm)
VersionData -> VersionData -> Accept VersionData
forall v. Acceptable v => v -> v -> Accept v
acceptableVersion
VersionData -> Bool
forall v. Queryable v => v -> Bool
queryVersion
Versions VersionNumber VersionData Bool
serverVersions)
pure $
case (clientRes', serverRes') of
(Right (HandshakeNegotiationResult Bool
c VersionNumber
_ VersionData
_), Right (HandshakeNegotiationResult Bool
s VersionNumber
_ VersionData
_))
-> Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
c Maybe Bool -> Maybe Bool -> Property
forall a. (Eq a, Show a) => a -> a -> Property
=== Maybe Bool
clientRes
Property -> Property -> Property
forall prop1 prop2.
(Testable prop1, Testable prop2) =>
prop1 -> prop2 -> Property
.&&. Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
s Maybe Bool -> Maybe Bool -> Property
forall a. (Eq a, Show a) => a -> a -> Property
=== Maybe Bool
serverRes
(Right (HandshakeQueryResult Map VersionNumber (Either Text VersionData)
_), Right (HandshakeQueryResult Map VersionNumber (Either Text VersionData)
_))
-> Bool -> Property
forall prop. Testable prop => prop -> Property
property Bool
True
(Left{}, Left{}) -> Bool -> Property
forall prop. Testable prop => prop -> Property
property Bool
True
(Either
(HandshakeProtocolError VersionNumber)
(HandshakeResult Bool VersionNumber VersionData),
Either
(HandshakeProtocolError VersionNumber)
(HandshakeResult Bool VersionNumber VersionData))
_ -> Bool -> Property
forall prop. Testable prop => prop -> Property
property Bool
False
where
serverVersions :: Versions VersionNumber VersionData Bool
serverVersions :: Versions VersionNumber VersionData Bool
serverVersions =
let d :: VersionData
d = Int -> Bool -> Bool -> VersionData
VersionData Int
0 Bool
True Bool
True in
Map VersionNumber (Version VersionData Bool)
-> Versions VersionNumber VersionData Bool
forall vNum vData r.
Map vNum (Version vData r) -> Versions vNum vData r
Versions
(Map VersionNumber (Version VersionData Bool)
-> Versions VersionNumber VersionData Bool)
-> Map VersionNumber (Version VersionData Bool)
-> Versions VersionNumber VersionData Bool
forall a b. (a -> b) -> a -> b
$ VersionNumber
-> Version VersionData Bool
-> Map VersionNumber (Version VersionData Bool)
forall k a. k -> a -> Map k a
Map.singleton
VersionNumber
Version_1
((VersionData -> Bool) -> VersionData -> Version VersionData Bool
forall vData r. (vData -> r) -> vData -> Version vData r
Version (VersionData -> VersionData -> Bool
application VersionData
d) VersionData
d)
versionNumberCodec' :: CodecCBORTerm (String, Maybe Int) VersionNumber
versionNumberCodec' :: CodecCBORTerm (String, Maybe Int) VersionNumber
versionNumberCodec' = CodecCBORTerm { VersionNumber -> Term
encodeTerm :: VersionNumber -> Term
encodeTerm :: VersionNumber -> Term
encodeTerm, Term -> Either (String, Maybe Int) VersionNumber
decodeTerm :: Term -> Either (String, Maybe Int) VersionNumber
decodeTerm :: Term -> Either (String, Maybe Int) VersionNumber
decodeTerm }
where
encodeTerm :: VersionNumber -> Term
encodeTerm VersionNumber
Version_1 = Int -> Term
CBOR.TInt Int
1
encodeTerm VersionNumber
_ = String -> Term
forall a. HasCallStack => String -> a
error String
"server encoder error"
decodeTerm :: Term -> Either (String, Maybe Int) VersionNumber
decodeTerm (CBOR.TInt Int
1) = VersionNumber -> Either (String, Maybe Int) VersionNumber
forall a b. b -> Either a b
Right VersionNumber
Version_1
decodeTerm (CBOR.TInt Int
n) = (String, Maybe Int) -> Either (String, Maybe Int) VersionNumber
forall a b. a -> Either a b
Left (String
"unknown version", Int -> Maybe Int
forall a. a -> Maybe a
Just Int
n)
decodeTerm Term
_ = (String, Maybe Int) -> Either (String, Maybe Int) VersionNumber
forall a b. a -> Either a b
Left (String
"unknown tag", Maybe Int
forall a. Maybe a
Nothing)
(Maybe Bool
serverRes, Maybe Bool
clientRes) =
(VersionData -> VersionData -> Maybe VersionData)
-> Versions VersionNumber VersionData Bool
-> Versions VersionNumber VersionData Bool
-> (Maybe Bool, Maybe Bool)
forall vNumber vData r.
Ord vNumber =>
(vData -> vData -> Maybe vData)
-> Versions vNumber vData r
-> Versions vNumber vData r
-> (Maybe r, Maybe r)
pureHandshake
((Accept VersionData -> Maybe VersionData
forall a. Accept a -> Maybe a
maybeAccept (Accept VersionData -> Maybe VersionData)
-> (VersionData -> Accept VersionData)
-> VersionData
-> Maybe VersionData
forall b c a. (b -> c) -> (a -> b) -> a -> c
.) ((VersionData -> Accept VersionData)
-> VersionData -> Maybe VersionData)
-> (VersionData -> VersionData -> Accept VersionData)
-> VersionData
-> VersionData
-> Maybe VersionData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VersionData -> VersionData -> Accept VersionData
forall v. Acceptable v => v -> v -> Accept v
acceptableVersion)
Versions VersionNumber VersionData Bool
serverVersions
Versions VersionNumber VersionData Bool
clientVersions
prop_channel_asymmetric_ST :: ArbitraryVersions -> Property
prop_channel_asymmetric_ST :: ArbitraryVersions -> Property
prop_channel_asymmetric_ST (ArbitraryVersions Versions VersionNumber VersionData Bool
clientVersions Versions VersionNumber VersionData Bool
_serverVersions) =
(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)
-> Versions VersionNumber VersionData Bool -> IOSim s Property
forall (m :: * -> *).
(MonadAsync m, MonadCatch m, MonadLabelledSTM m, MonadMask m,
MonadST m) =>
m (Channel m ByteString, Channel m ByteString)
-> Versions VersionNumber VersionData Bool -> m Property
prop_channel_asymmetric IOSim
s (Channel (IOSim s) ByteString, Channel (IOSim s) ByteString)
forall (m :: * -> *) a. MonadSTM m => m (Channel m a, Channel m a)
createConnectedChannels Versions VersionNumber VersionData Bool
clientVersions)
prop_channel_asymmetric_IO :: ArbitraryVersions -> Property
prop_channel_asymmetric_IO :: ArbitraryVersions -> Property
prop_channel_asymmetric_IO (ArbitraryVersions Versions VersionNumber VersionData Bool
clientVersions Versions VersionNumber VersionData Bool
_serverVersions) =
IO Property -> Property
forall prop. Testable prop => IO prop -> Property
ioProperty (IO (Channel IO ByteString, Channel IO ByteString)
-> Versions VersionNumber VersionData Bool -> IO Property
forall (m :: * -> *).
(MonadAsync m, MonadCatch m, MonadLabelledSTM m, MonadMask m,
MonadST m) =>
m (Channel m ByteString, Channel m ByteString)
-> Versions VersionNumber VersionData Bool -> m Property
prop_channel_asymmetric IO (Channel IO ByteString, Channel IO ByteString)
forall (m :: * -> *) a. MonadSTM m => m (Channel m a, Channel m a)
createConnectedChannels Versions VersionNumber VersionData Bool
clientVersions)
prop_pipe_asymmetric_IO :: ArbitraryVersions -> Property
prop_pipe_asymmetric_IO :: ArbitraryVersions -> Property
prop_pipe_asymmetric_IO (ArbitraryVersions Versions VersionNumber VersionData Bool
clientVersions Versions VersionNumber VersionData Bool
_serverVersions) =
IO Property -> Property
forall prop. Testable prop => IO prop -> Property
ioProperty (IO (Channel IO ByteString, Channel IO ByteString)
-> Versions VersionNumber VersionData Bool -> IO Property
forall (m :: * -> *).
(MonadAsync m, MonadCatch m, MonadLabelledSTM m, MonadMask m,
MonadST m) =>
m (Channel m ByteString, Channel m ByteString)
-> Versions VersionNumber VersionData Bool -> m Property
prop_channel_asymmetric IO (Channel IO ByteString, Channel IO ByteString)
createPipeConnectedChannels Versions VersionNumber VersionData Bool
clientVersions)
newtype ArbitraryNodeToNodeVersion =
ArbitraryNodeToNodeVersion { ArbitraryNodeToNodeVersion -> NodeToNodeVersion
getNodeToNodeVersion :: NodeToNodeVersion }
deriving Int -> ArbitraryNodeToNodeVersion -> ShowS
[ArbitraryNodeToNodeVersion] -> ShowS
ArbitraryNodeToNodeVersion -> String
(Int -> ArbitraryNodeToNodeVersion -> ShowS)
-> (ArbitraryNodeToNodeVersion -> String)
-> ([ArbitraryNodeToNodeVersion] -> ShowS)
-> Show ArbitraryNodeToNodeVersion
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ArbitraryNodeToNodeVersion -> ShowS
showsPrec :: Int -> ArbitraryNodeToNodeVersion -> ShowS
$cshow :: ArbitraryNodeToNodeVersion -> String
show :: ArbitraryNodeToNodeVersion -> String
$cshowList :: [ArbitraryNodeToNodeVersion] -> ShowS
showList :: [ArbitraryNodeToNodeVersion] -> ShowS
Show
instance Arbitrary ArbitraryNodeToNodeVersion where
arbitrary :: Gen ArbitraryNodeToNodeVersion
arbitrary = [ArbitraryNodeToNodeVersion] -> Gen ArbitraryNodeToNodeVersion
forall a. [a] -> Gen a
elements (NodeToNodeVersion -> ArbitraryNodeToNodeVersion
ArbitraryNodeToNodeVersion (NodeToNodeVersion -> ArbitraryNodeToNodeVersion)
-> [NodeToNodeVersion] -> [ArbitraryNodeToNodeVersion]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [NodeToNodeVersion
forall a. Bounded a => a
minBound .. NodeToNodeVersion
forall a. Bounded a => a
maxBound])
newtype ArbitraryNodeToNodeVersionData =
ArbitraryNodeToNodeVersionData
{ ArbitraryNodeToNodeVersionData -> NodeToNodeVersionData
getNodeToNodeVersionData :: NodeToNodeVersionData }
deriving Int -> ArbitraryNodeToNodeVersionData -> ShowS
[ArbitraryNodeToNodeVersionData] -> ShowS
ArbitraryNodeToNodeVersionData -> String
(Int -> ArbitraryNodeToNodeVersionData -> ShowS)
-> (ArbitraryNodeToNodeVersionData -> String)
-> ([ArbitraryNodeToNodeVersionData] -> ShowS)
-> Show ArbitraryNodeToNodeVersionData
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ArbitraryNodeToNodeVersionData -> ShowS
showsPrec :: Int -> ArbitraryNodeToNodeVersionData -> ShowS
$cshow :: ArbitraryNodeToNodeVersionData -> String
show :: ArbitraryNodeToNodeVersionData -> String
$cshowList :: [ArbitraryNodeToNodeVersionData] -> ShowS
showList :: [ArbitraryNodeToNodeVersionData] -> ShowS
Show
deriving ArbitraryNodeToNodeVersionData
-> ArbitraryNodeToNodeVersionData
-> Accept ArbitraryNodeToNodeVersionData
(ArbitraryNodeToNodeVersionData
-> ArbitraryNodeToNodeVersionData
-> Accept ArbitraryNodeToNodeVersionData)
-> Acceptable ArbitraryNodeToNodeVersionData
forall v. (v -> v -> Accept v) -> Acceptable v
$cacceptableVersion :: ArbitraryNodeToNodeVersionData
-> ArbitraryNodeToNodeVersionData
-> Accept ArbitraryNodeToNodeVersionData
acceptableVersion :: ArbitraryNodeToNodeVersionData
-> ArbitraryNodeToNodeVersionData
-> Accept ArbitraryNodeToNodeVersionData
Acceptable via NodeToNodeVersionData
instance Eq ArbitraryNodeToNodeVersionData where
== :: ArbitraryNodeToNodeVersionData
-> ArbitraryNodeToNodeVersionData -> Bool
(==) (ArbitraryNodeToNodeVersionData (NodeToNodeVersionData NetworkMagic
nm DiffusionMode
dm PeerSharing
ps Bool
_))
(ArbitraryNodeToNodeVersionData (NodeToNodeVersionData NetworkMagic
nm' DiffusionMode
dm' PeerSharing
ps' Bool
_))
= NetworkMagic
nm NetworkMagic -> NetworkMagic -> Bool
forall a. Eq a => a -> a -> Bool
== NetworkMagic
nm' Bool -> Bool -> Bool
&& DiffusionMode
dm DiffusionMode -> DiffusionMode -> Bool
forall a. Eq a => a -> a -> Bool
== DiffusionMode
dm' Bool -> Bool -> Bool
&& PeerSharing
ps PeerSharing -> PeerSharing -> Bool
forall a. Eq a => a -> a -> Bool
== PeerSharing
ps'
instance Queryable ArbitraryNodeToNodeVersionData where
queryVersion :: ArbitraryNodeToNodeVersionData -> Bool
queryVersion = NodeToNodeVersionData -> Bool
forall v. Queryable v => v -> Bool
queryVersion (NodeToNodeVersionData -> Bool)
-> (ArbitraryNodeToNodeVersionData -> NodeToNodeVersionData)
-> ArbitraryNodeToNodeVersionData
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ArbitraryNodeToNodeVersionData -> NodeToNodeVersionData
getNodeToNodeVersionData
instance Arbitrary ArbitraryNodeToNodeVersionData where
arbitrary :: Gen ArbitraryNodeToNodeVersionData
arbitrary = ((PeerSharing -> Bool -> NodeToNodeVersionData)
-> PeerSharing -> Bool -> ArbitraryNodeToNodeVersionData)
-> (DiffusionMode -> PeerSharing -> Bool -> NodeToNodeVersionData)
-> DiffusionMode
-> PeerSharing
-> Bool
-> ArbitraryNodeToNodeVersionData
forall a b. (a -> b) -> (DiffusionMode -> a) -> DiffusionMode -> b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (((Bool -> NodeToNodeVersionData)
-> Bool -> ArbitraryNodeToNodeVersionData)
-> (PeerSharing -> Bool -> NodeToNodeVersionData)
-> PeerSharing
-> Bool
-> ArbitraryNodeToNodeVersionData
forall a b. (a -> b) -> (PeerSharing -> a) -> PeerSharing -> b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((NodeToNodeVersionData -> ArbitraryNodeToNodeVersionData)
-> (Bool -> NodeToNodeVersionData)
-> Bool
-> ArbitraryNodeToNodeVersionData
forall a b. (a -> b) -> (Bool -> a) -> Bool -> b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap NodeToNodeVersionData -> ArbitraryNodeToNodeVersionData
ArbitraryNodeToNodeVersionData))
((DiffusionMode -> PeerSharing -> Bool -> NodeToNodeVersionData)
-> DiffusionMode
-> PeerSharing
-> Bool
-> ArbitraryNodeToNodeVersionData)
-> (NetworkMagic
-> DiffusionMode -> PeerSharing -> Bool -> NodeToNodeVersionData)
-> NetworkMagic
-> DiffusionMode
-> PeerSharing
-> Bool
-> ArbitraryNodeToNodeVersionData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NetworkMagic
-> DiffusionMode -> PeerSharing -> Bool -> NodeToNodeVersionData
NodeToNodeVersionData
(NetworkMagic
-> DiffusionMode
-> PeerSharing
-> Bool
-> ArbitraryNodeToNodeVersionData)
-> Gen NetworkMagic
-> Gen
(DiffusionMode
-> PeerSharing -> Bool -> ArbitraryNodeToNodeVersionData)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Word32 -> NetworkMagic
NetworkMagic (Word32 -> NetworkMagic) -> Gen Word32 -> Gen NetworkMagic
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Word32
forall a. Arbitrary a => Gen a
arbitrary)
Gen
(DiffusionMode
-> PeerSharing -> Bool -> ArbitraryNodeToNodeVersionData)
-> Gen DiffusionMode
-> Gen (PeerSharing -> Bool -> ArbitraryNodeToNodeVersionData)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [DiffusionMode] -> Gen DiffusionMode
forall a. [a] -> Gen a
elements [ DiffusionMode
InitiatorOnlyDiffusionMode
, DiffusionMode
InitiatorAndResponderDiffusionMode
]
Gen (PeerSharing -> Bool -> ArbitraryNodeToNodeVersionData)
-> Gen PeerSharing -> Gen (Bool -> ArbitraryNodeToNodeVersionData)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [PeerSharing] -> Gen PeerSharing
forall a. [a] -> Gen a
elements [ PeerSharing
PeerSharingDisabled
, PeerSharing
PeerSharingEnabled
]
Gen (Bool -> ArbitraryNodeToNodeVersionData)
-> Gen Bool -> Gen ArbitraryNodeToNodeVersionData
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen Bool
forall a. Arbitrary a => Gen a
arbitrary
shrink :: ArbitraryNodeToNodeVersionData -> [ArbitraryNodeToNodeVersionData]
shrink (ArbitraryNodeToNodeVersionData
(NodeToNodeVersionData NetworkMagic
magic DiffusionMode
mode PeerSharing
peerSharing Bool
query)) =
[ NodeToNodeVersionData -> ArbitraryNodeToNodeVersionData
ArbitraryNodeToNodeVersionData (NetworkMagic
-> DiffusionMode -> PeerSharing -> Bool -> NodeToNodeVersionData
NodeToNodeVersionData NetworkMagic
magic' DiffusionMode
mode PeerSharing
peerSharing' Bool
query)
| NetworkMagic
magic' <- Word32 -> NetworkMagic
NetworkMagic (Word32 -> NetworkMagic) -> [Word32] -> [NetworkMagic]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Word32 -> [Word32]
forall a. Arbitrary a => a -> [a]
shrink (NetworkMagic -> Word32
unNetworkMagic NetworkMagic
magic)
, PeerSharing
peerSharing' <- PeerSharing -> [PeerSharing]
shrinkPeerSharing PeerSharing
peerSharing
]
[ArbitraryNodeToNodeVersionData]
-> [ArbitraryNodeToNodeVersionData]
-> [ArbitraryNodeToNodeVersionData]
forall a. [a] -> [a] -> [a]
++
[ NodeToNodeVersionData -> ArbitraryNodeToNodeVersionData
ArbitraryNodeToNodeVersionData (NetworkMagic
-> DiffusionMode -> PeerSharing -> Bool -> NodeToNodeVersionData
NodeToNodeVersionData NetworkMagic
magic DiffusionMode
mode' PeerSharing
peerSharing' Bool
query)
| DiffusionMode
mode' <- DiffusionMode -> [DiffusionMode]
shrinkMode DiffusionMode
mode
, PeerSharing
peerSharing' <- PeerSharing -> [PeerSharing]
shrinkPeerSharing PeerSharing
peerSharing
]
[ArbitraryNodeToNodeVersionData]
-> [ArbitraryNodeToNodeVersionData]
-> [ArbitraryNodeToNodeVersionData]
forall a. [a] -> [a] -> [a]
++
[ NodeToNodeVersionData -> ArbitraryNodeToNodeVersionData
ArbitraryNodeToNodeVersionData (NetworkMagic
-> DiffusionMode -> PeerSharing -> Bool -> NodeToNodeVersionData
NodeToNodeVersionData NetworkMagic
magic DiffusionMode
mode PeerSharing
peerSharing' Bool
query')
| Bool
query' <- Bool -> [Bool]
forall a. Arbitrary a => a -> [a]
shrink Bool
query
, PeerSharing
peerSharing' <- PeerSharing -> [PeerSharing]
shrinkPeerSharing PeerSharing
peerSharing
]
where
shrinkMode :: DiffusionMode -> [DiffusionMode]
shrinkMode :: DiffusionMode -> [DiffusionMode]
shrinkMode DiffusionMode
InitiatorOnlyDiffusionMode = []
shrinkMode DiffusionMode
InitiatorAndResponderDiffusionMode = [DiffusionMode
InitiatorOnlyDiffusionMode]
shrinkPeerSharing :: PeerSharing -> [PeerSharing]
shrinkPeerSharing PeerSharing
PeerSharingDisabled = []
shrinkPeerSharing PeerSharing
PeerSharingEnabled = [PeerSharing
PeerSharingDisabled]
newtype ArbitraryNodeToNodeVersions =
ArbitraryNodeToNodeVersions
{ ArbitraryNodeToNodeVersions
-> Versions NodeToNodeVersion ArbitraryNodeToNodeVersionData Bool
getArbitraryNodeToNodeVersiosn :: Versions NodeToNodeVersion
ArbitraryNodeToNodeVersionData Bool }
instance Show ArbitraryNodeToNodeVersions where
show :: ArbitraryNodeToNodeVersions -> String
show (ArbitraryNodeToNodeVersions (Versions Map NodeToNodeVersion (Version ArbitraryNodeToNodeVersionData Bool)
vs))
= String
"ArbitraryNodeToNodeVersions " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Map NodeToNodeVersion ArbitraryNodeToNodeVersionData -> String
forall a. Show a => a -> String
show ((Version ArbitraryNodeToNodeVersionData Bool
-> ArbitraryNodeToNodeVersionData)
-> Map
NodeToNodeVersion (Version ArbitraryNodeToNodeVersionData Bool)
-> Map NodeToNodeVersion ArbitraryNodeToNodeVersionData
forall a b k. (a -> b) -> Map k a -> Map k b
Map.map Version ArbitraryNodeToNodeVersionData Bool
-> ArbitraryNodeToNodeVersionData
forall vData r. Version vData r -> vData
versionData Map NodeToNodeVersion (Version ArbitraryNodeToNodeVersionData Bool)
vs)
instance Arbitrary ArbitraryNodeToNodeVersions where
arbitrary :: Gen ArbitraryNodeToNodeVersions
arbitrary = do
vs <- Gen NodeToNodeVersion -> Gen [NodeToNodeVersion]
forall a. Gen a -> Gen [a]
listOf (ArbitraryNodeToNodeVersion -> NodeToNodeVersion
getNodeToNodeVersion (ArbitraryNodeToNodeVersion -> NodeToNodeVersion)
-> Gen ArbitraryNodeToNodeVersion -> Gen NodeToNodeVersion
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen ArbitraryNodeToNodeVersion
forall a. Arbitrary a => Gen a
arbitrary)
ds <- vectorOf (length vs) arbitrary
r <- arbitrary
return $ ArbitraryNodeToNodeVersions
$ Versions
$ Map.fromList
[ (v, Version (const r) d)
| (v, d) <- zip vs ds
]
newtype ArbitraryNodeToClientVersion =
ArbitraryNodeToClientVersion { ArbitraryNodeToClientVersion -> NodeToClientVersion
getNodeToClientVersion :: NodeToClientVersion }
deriving Int -> ArbitraryNodeToClientVersion -> ShowS
[ArbitraryNodeToClientVersion] -> ShowS
ArbitraryNodeToClientVersion -> String
(Int -> ArbitraryNodeToClientVersion -> ShowS)
-> (ArbitraryNodeToClientVersion -> String)
-> ([ArbitraryNodeToClientVersion] -> ShowS)
-> Show ArbitraryNodeToClientVersion
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ArbitraryNodeToClientVersion -> ShowS
showsPrec :: Int -> ArbitraryNodeToClientVersion -> ShowS
$cshow :: ArbitraryNodeToClientVersion -> String
show :: ArbitraryNodeToClientVersion -> String
$cshowList :: [ArbitraryNodeToClientVersion] -> ShowS
showList :: [ArbitraryNodeToClientVersion] -> ShowS
Show
instance Arbitrary ArbitraryNodeToClientVersion where
arbitrary :: Gen ArbitraryNodeToClientVersion
arbitrary = [ArbitraryNodeToClientVersion] -> Gen ArbitraryNodeToClientVersion
forall a. [a] -> Gen a
elements (NodeToClientVersion -> ArbitraryNodeToClientVersion
ArbitraryNodeToClientVersion (NodeToClientVersion -> ArbitraryNodeToClientVersion)
-> [NodeToClientVersion] -> [ArbitraryNodeToClientVersion]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [NodeToClientVersion
forall a. Bounded a => a
minBound .. NodeToClientVersion
forall a. Bounded a => a
maxBound])
newtype ArbitraryNodeToClientVersionData =
ArbitraryNodeToClientVersionData
{ ArbitraryNodeToClientVersionData -> NodeToClientVersionData
getNodeToClientVersionData :: NodeToClientVersionData }
deriving Int -> ArbitraryNodeToClientVersionData -> ShowS
[ArbitraryNodeToClientVersionData] -> ShowS
ArbitraryNodeToClientVersionData -> String
(Int -> ArbitraryNodeToClientVersionData -> ShowS)
-> (ArbitraryNodeToClientVersionData -> String)
-> ([ArbitraryNodeToClientVersionData] -> ShowS)
-> Show ArbitraryNodeToClientVersionData
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ArbitraryNodeToClientVersionData -> ShowS
showsPrec :: Int -> ArbitraryNodeToClientVersionData -> ShowS
$cshow :: ArbitraryNodeToClientVersionData -> String
show :: ArbitraryNodeToClientVersionData -> String
$cshowList :: [ArbitraryNodeToClientVersionData] -> ShowS
showList :: [ArbitraryNodeToClientVersionData] -> ShowS
Show
instance Arbitrary ArbitraryNodeToClientVersionData where
arbitrary :: Gen ArbitraryNodeToClientVersionData
arbitrary = ( (NodeToClientVersionData -> ArbitraryNodeToClientVersionData
ArbitraryNodeToClientVersionData (NodeToClientVersionData -> ArbitraryNodeToClientVersionData)
-> (Bool -> NodeToClientVersionData)
-> Bool
-> ArbitraryNodeToClientVersionData
forall b c a. (b -> c) -> (a -> b) -> a -> c
.)
((Bool -> NodeToClientVersionData)
-> Bool -> ArbitraryNodeToClientVersionData)
-> (NetworkMagic -> Bool -> NodeToClientVersionData)
-> NetworkMagic
-> Bool
-> ArbitraryNodeToClientVersionData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NetworkMagic -> Bool -> NodeToClientVersionData
NodeToClientVersionData
)
(NetworkMagic -> Bool -> ArbitraryNodeToClientVersionData)
-> Gen NetworkMagic
-> Gen (Bool -> ArbitraryNodeToClientVersionData)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Word32 -> NetworkMagic
NetworkMagic (Word32 -> NetworkMagic) -> Gen Word32 -> Gen NetworkMagic
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Word32
forall a. Arbitrary a => Gen a
arbitrary)
Gen (Bool -> ArbitraryNodeToClientVersionData)
-> Gen Bool -> Gen ArbitraryNodeToClientVersionData
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen Bool
forall a. Arbitrary a => Gen a
arbitrary
shrink :: ArbitraryNodeToClientVersionData
-> [ArbitraryNodeToClientVersionData]
shrink (ArbitraryNodeToClientVersionData
(NodeToClientVersionData NetworkMagic
magic Bool
query)) =
[ NodeToClientVersionData -> ArbitraryNodeToClientVersionData
ArbitraryNodeToClientVersionData (NetworkMagic -> Bool -> NodeToClientVersionData
NodeToClientVersionData NetworkMagic
magic' Bool
query)
| NetworkMagic
magic' <- Word32 -> NetworkMagic
NetworkMagic (Word32 -> NetworkMagic) -> [Word32] -> [NetworkMagic]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Word32 -> [Word32]
forall a. Arbitrary a => a -> [a]
shrink (NetworkMagic -> Word32
unNetworkMagic NetworkMagic
magic)
]
[ArbitraryNodeToClientVersionData]
-> [ArbitraryNodeToClientVersionData]
-> [ArbitraryNodeToClientVersionData]
forall a. [a] -> [a] -> [a]
++
[ NodeToClientVersionData -> ArbitraryNodeToClientVersionData
ArbitraryNodeToClientVersionData (NetworkMagic -> Bool -> NodeToClientVersionData
NodeToClientVersionData NetworkMagic
magic Bool
query')
| Bool
query' <- Bool -> [Bool]
forall a. Arbitrary a => a -> [a]
shrink Bool
query
]
newtype ArbitraryNodeToClientVersions =
ArbitraryNodeToClientVersions
{ ArbitraryNodeToClientVersions
-> Versions NodeToClientVersion NodeToClientVersionData Bool
getArbitraryNodeToClientVersiosn :: Versions NodeToClientVersion
NodeToClientVersionData Bool }
instance Show ArbitraryNodeToClientVersions where
show :: ArbitraryNodeToClientVersions -> String
show (ArbitraryNodeToClientVersions (Versions Map NodeToClientVersion (Version NodeToClientVersionData Bool)
vs))
= String
"ArbitraryNodeToClientVersions " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Map NodeToClientVersion NodeToClientVersionData -> String
forall a. Show a => a -> String
show ((Version NodeToClientVersionData Bool -> NodeToClientVersionData)
-> Map NodeToClientVersion (Version NodeToClientVersionData Bool)
-> Map NodeToClientVersion NodeToClientVersionData
forall a b k. (a -> b) -> Map k a -> Map k b
Map.map Version NodeToClientVersionData Bool -> NodeToClientVersionData
forall vData r. Version vData r -> vData
versionData Map NodeToClientVersion (Version NodeToClientVersionData Bool)
vs)
instance Arbitrary ArbitraryNodeToClientVersions where
arbitrary :: Gen ArbitraryNodeToClientVersions
arbitrary = do
vs <- Gen NodeToClientVersion -> Gen [NodeToClientVersion]
forall a. Gen a -> Gen [a]
listOf (ArbitraryNodeToClientVersion -> NodeToClientVersion
getNodeToClientVersion (ArbitraryNodeToClientVersion -> NodeToClientVersion)
-> Gen ArbitraryNodeToClientVersion -> Gen NodeToClientVersion
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen ArbitraryNodeToClientVersion
forall a. Arbitrary a => Gen a
arbitrary)
ds <- vectorOf (length vs) (getNodeToClientVersionData <$> arbitrary)
r <- arbitrary
return $ ArbitraryNodeToClientVersions
$ Versions
$ Map.fromList
[ (v, Version (const r) d)
| (v, d) <- zip vs ds
]
prop_acceptable_symmetric
:: ( Acceptable vData
, Eq vData
)
=> vData
-> vData
-> Bool
prop_acceptable_symmetric :: forall vData.
(Acceptable vData, Eq vData) =>
vData -> vData -> Bool
prop_acceptable_symmetric vData
vData vData
vData' =
case (vData -> vData -> Accept vData
forall v. Acceptable v => v -> v -> Accept v
acceptableVersion vData
vData vData
vData', vData -> vData -> Accept vData
forall v. Acceptable v => v -> v -> Accept v
acceptableVersion vData
vData' vData
vData) of
(Accept vData
a, Accept vData
b) -> vData
a vData -> vData -> Bool
forall a. Eq a => a -> a -> Bool
== vData
b
(Refuse Text
_, Refuse Text
_) -> Bool
True
(Accept vData
_ , Accept vData
_ ) -> Bool
False
prop_acceptable_symmetric_VersionData
:: VersionData
-> VersionData
-> Bool
prop_acceptable_symmetric_VersionData :: VersionData -> VersionData -> Bool
prop_acceptable_symmetric_VersionData VersionData
a VersionData
b =
VersionData -> VersionData -> Bool
forall vData.
(Acceptable vData, Eq vData) =>
vData -> vData -> Bool
prop_acceptable_symmetric VersionData
a VersionData
b
prop_acceptable_symmetric_NodeToNode
:: ArbitraryNodeToNodeVersionData
-> ArbitraryNodeToNodeVersionData
-> Bool
prop_acceptable_symmetric_NodeToNode :: ArbitraryNodeToNodeVersionData
-> ArbitraryNodeToNodeVersionData -> Bool
prop_acceptable_symmetric_NodeToNode ArbitraryNodeToNodeVersionData
a ArbitraryNodeToNodeVersionData
b =
ArbitraryNodeToNodeVersionData
-> ArbitraryNodeToNodeVersionData -> Bool
forall vData.
(Acceptable vData, Eq vData) =>
vData -> vData -> Bool
prop_acceptable_symmetric ArbitraryNodeToNodeVersionData
a ArbitraryNodeToNodeVersionData
b
prop_acceptable_symmetric_NodeToClient
:: ArbitraryNodeToClientVersionData
-> ArbitraryNodeToClientVersionData
-> Bool
prop_acceptable_symmetric_NodeToClient :: ArbitraryNodeToClientVersionData
-> ArbitraryNodeToClientVersionData -> Bool
prop_acceptable_symmetric_NodeToClient (ArbitraryNodeToClientVersionData NodeToClientVersionData
a)
(ArbitraryNodeToClientVersionData NodeToClientVersionData
b) =
NodeToClientVersionData -> NodeToClientVersionData -> Bool
forall vData.
(Acceptable vData, Eq vData) =>
vData -> vData -> Bool
prop_acceptable_symmetric NodeToClientVersionData
a NodeToClientVersionData
b
prop_query_version_NodeToNode_ST :: ArbitraryNodeToNodeVersions
-> ArbitraryNodeToNodeVersions
-> Property
prop_query_version_NodeToNode_ST :: ArbitraryNodeToNodeVersions
-> ArbitraryNodeToNodeVersions -> Property
prop_query_version_NodeToNode_ST
(ArbitraryNodeToNodeVersions Versions NodeToNodeVersion ArbitraryNodeToNodeVersionData Bool
clientVersions)
(ArbitraryNodeToNodeVersions Versions NodeToNodeVersion ArbitraryNodeToNodeVersionData Bool
serverVersions) =
(forall s. IOSim s Property) -> Property
forall a. (forall s. IOSim s a) -> a
runSimOrThrow ((forall s. IOSim s Property) -> Property)
-> (forall s. IOSim s Property) -> Property
forall a b. (a -> b) -> a -> b
$ IOSim
s (Channel (IOSim s) ByteString, Channel (IOSim s) ByteString)
-> Codec
(Handshake NodeToNodeVersion Term)
DeserialiseFailure
(IOSim s)
ByteString
-> VersionDataCodec
Term NodeToNodeVersion ArbitraryNodeToNodeVersionData
-> Versions NodeToNodeVersion ArbitraryNodeToNodeVersionData Bool
-> Versions NodeToNodeVersion ArbitraryNodeToNodeVersionData Bool
-> (ArbitraryNodeToNodeVersionData
-> ArbitraryNodeToNodeVersionData)
-> IOSim s Property
forall (m :: * -> *) vData vNumber.
(MonadAsync m, MonadCatch m, MonadST m, Eq vData, Acceptable vData,
Queryable vData, Show vData, Ord vNumber, Show vNumber) =>
m (Channel m ByteString, Channel m ByteString)
-> Codec (Handshake vNumber Term) DeserialiseFailure m ByteString
-> VersionDataCodec Term vNumber vData
-> Versions vNumber vData Bool
-> Versions vNumber vData Bool
-> (vData -> vData)
-> m Property
prop_query_version
IOSim
s (Channel (IOSim s) ByteString, Channel (IOSim s) ByteString)
forall (m :: * -> *) a. MonadSTM m => m (Channel m a, Channel m a)
createConnectedChannels
(CodecCBORTerm (Text, Maybe Int) NodeToNodeVersion
-> Codec
(Handshake NodeToNodeVersion Term)
DeserialiseFailure
(IOSim s)
ByteString
forall vNumber (m :: * -> *) failure.
(MonadST m, Ord vNumber, Show failure) =>
CodecCBORTerm (failure, Maybe Int) vNumber
-> Codec (Handshake vNumber Term) DeserialiseFailure m ByteString
codecHandshake CodecCBORTerm (Text, Maybe Int) NodeToNodeVersion
nodeToNodeVersionCodec)
((NodeToNodeVersion
-> CodecCBORTerm Text ArbitraryNodeToNodeVersionData)
-> VersionDataCodec
Term NodeToNodeVersion ArbitraryNodeToNodeVersionData
forall vNumber vData.
(vNumber -> CodecCBORTerm Text vData)
-> VersionDataCodec Term vNumber vData
cborTermVersionDataCodec ((CodecCBORTerm Text NodeToNodeVersionData
-> CodecCBORTerm Text ArbitraryNodeToNodeVersionData)
-> (NodeToNodeVersion -> CodecCBORTerm Text NodeToNodeVersionData)
-> NodeToNodeVersion
-> CodecCBORTerm Text ArbitraryNodeToNodeVersionData
forall a b.
(a -> b) -> (NodeToNodeVersion -> a) -> NodeToNodeVersion -> b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap CodecCBORTerm Text NodeToNodeVersionData
-> CodecCBORTerm Text ArbitraryNodeToNodeVersionData
transformNodeToNodeVersionData NodeToNodeVersion -> CodecCBORTerm Text NodeToNodeVersionData
nodeToNodeCodecCBORTerm))
Versions NodeToNodeVersion ArbitraryNodeToNodeVersionData Bool
clientVersions
Versions NodeToNodeVersion ArbitraryNodeToNodeVersionData Bool
serverVersions
(\(ArbitraryNodeToNodeVersionData NodeToNodeVersionData
vd) ->
NodeToNodeVersionData -> ArbitraryNodeToNodeVersionData
ArbitraryNodeToNodeVersionData (NodeToNodeVersionData -> ArbitraryNodeToNodeVersionData)
-> NodeToNodeVersionData -> ArbitraryNodeToNodeVersionData
forall a b. (a -> b) -> a -> b
$
NodeToNodeVersionData
vd { NTN.query = True
, NTN.peerSharing = PeerSharingEnabled
})
prop_query_version_NodeToNode_IO :: ArbitraryNodeToNodeVersions
-> ArbitraryNodeToNodeVersions
-> Property
prop_query_version_NodeToNode_IO :: ArbitraryNodeToNodeVersions
-> ArbitraryNodeToNodeVersions -> Property
prop_query_version_NodeToNode_IO
(ArbitraryNodeToNodeVersions Versions NodeToNodeVersion ArbitraryNodeToNodeVersionData Bool
clientVersions)
(ArbitraryNodeToNodeVersions Versions NodeToNodeVersion ArbitraryNodeToNodeVersionData Bool
serverVersions) =
IO Property -> Property
forall prop. Testable prop => IO prop -> Property
ioProperty (IO Property -> Property) -> IO Property -> Property
forall a b. (a -> b) -> a -> b
$ IO (Channel IO ByteString, Channel IO ByteString)
-> Codec
(Handshake NodeToNodeVersion Term) DeserialiseFailure IO ByteString
-> VersionDataCodec
Term NodeToNodeVersion ArbitraryNodeToNodeVersionData
-> Versions NodeToNodeVersion ArbitraryNodeToNodeVersionData Bool
-> Versions NodeToNodeVersion ArbitraryNodeToNodeVersionData Bool
-> (ArbitraryNodeToNodeVersionData
-> ArbitraryNodeToNodeVersionData)
-> IO Property
forall (m :: * -> *) vData vNumber.
(MonadAsync m, MonadCatch m, MonadST m, Eq vData, Acceptable vData,
Queryable vData, Show vData, Ord vNumber, Show vNumber) =>
m (Channel m ByteString, Channel m ByteString)
-> Codec (Handshake vNumber Term) DeserialiseFailure m ByteString
-> VersionDataCodec Term vNumber vData
-> Versions vNumber vData Bool
-> Versions vNumber vData Bool
-> (vData -> vData)
-> m Property
prop_query_version
IO (Channel IO ByteString, Channel IO ByteString)
forall (m :: * -> *) a. MonadSTM m => m (Channel m a, Channel m a)
createConnectedChannels
(CodecCBORTerm (Text, Maybe Int) NodeToNodeVersion
-> Codec
(Handshake NodeToNodeVersion Term) DeserialiseFailure IO ByteString
forall vNumber (m :: * -> *) failure.
(MonadST m, Ord vNumber, Show failure) =>
CodecCBORTerm (failure, Maybe Int) vNumber
-> Codec (Handshake vNumber Term) DeserialiseFailure m ByteString
codecHandshake CodecCBORTerm (Text, Maybe Int) NodeToNodeVersion
nodeToNodeVersionCodec)
((NodeToNodeVersion
-> CodecCBORTerm Text ArbitraryNodeToNodeVersionData)
-> VersionDataCodec
Term NodeToNodeVersion ArbitraryNodeToNodeVersionData
forall vNumber vData.
(vNumber -> CodecCBORTerm Text vData)
-> VersionDataCodec Term vNumber vData
cborTermVersionDataCodec ((CodecCBORTerm Text NodeToNodeVersionData
-> CodecCBORTerm Text ArbitraryNodeToNodeVersionData)
-> (NodeToNodeVersion -> CodecCBORTerm Text NodeToNodeVersionData)
-> NodeToNodeVersion
-> CodecCBORTerm Text ArbitraryNodeToNodeVersionData
forall a b.
(a -> b) -> (NodeToNodeVersion -> a) -> NodeToNodeVersion -> b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap CodecCBORTerm Text NodeToNodeVersionData
-> CodecCBORTerm Text ArbitraryNodeToNodeVersionData
transformNodeToNodeVersionData NodeToNodeVersion -> CodecCBORTerm Text NodeToNodeVersionData
nodeToNodeCodecCBORTerm))
Versions NodeToNodeVersion ArbitraryNodeToNodeVersionData Bool
clientVersions
Versions NodeToNodeVersion ArbitraryNodeToNodeVersionData Bool
serverVersions
(\(ArbitraryNodeToNodeVersionData NodeToNodeVersionData
vd) ->
NodeToNodeVersionData -> ArbitraryNodeToNodeVersionData
ArbitraryNodeToNodeVersionData (NodeToNodeVersionData -> ArbitraryNodeToNodeVersionData)
-> NodeToNodeVersionData -> ArbitraryNodeToNodeVersionData
forall a b. (a -> b) -> a -> b
$
NodeToNodeVersionData
vd { NTN.query = True
, NTN.peerSharing = PeerSharingEnabled
})
prop_query_version_NodeToNode_SimNet :: ArbitraryNodeToNodeVersions
-> ArbitraryNodeToNodeVersions
-> Property
prop_query_version_NodeToNode_SimNet :: ArbitraryNodeToNodeVersions
-> ArbitraryNodeToNodeVersions -> Property
prop_query_version_NodeToNode_SimNet
(ArbitraryNodeToNodeVersions Versions NodeToNodeVersion ArbitraryNodeToNodeVersionData Bool
clientVersions)
(ArbitraryNodeToNodeVersions Versions NodeToNodeVersion ArbitraryNodeToNodeVersionData Bool
serverVersions) =
(forall s. IOSim s Property) -> Property
forall a. (forall s. IOSim s a) -> a
runSimOrThrow ((forall s. IOSim s Property) -> Property)
-> (forall s. IOSim s Property) -> Property
forall a b. (a -> b) -> a -> b
$ IOSim
s (Channel (IOSim s) ByteString, Channel (IOSim s) ByteString)
-> Codec
(Handshake NodeToNodeVersion Term)
DeserialiseFailure
(IOSim s)
ByteString
-> VersionDataCodec
Term NodeToNodeVersion ArbitraryNodeToNodeVersionData
-> Versions NodeToNodeVersion ArbitraryNodeToNodeVersionData Bool
-> Versions NodeToNodeVersion ArbitraryNodeToNodeVersionData Bool
-> (ArbitraryNodeToNodeVersionData
-> ArbitraryNodeToNodeVersionData)
-> IOSim s Property
forall (m :: * -> *) vData vNumber.
(MonadAsync m, MonadCatch m, MonadST m, Eq vData, Acceptable vData,
Queryable vData, Show vData, Ord vNumber, Show vNumber) =>
m (Channel m ByteString, Channel m ByteString)
-> Codec (Handshake vNumber Term) DeserialiseFailure m ByteString
-> VersionDataCodec Term vNumber vData
-> Versions vNumber vData Bool
-> Versions vNumber vData Bool
-> (vData -> vData)
-> m Property
prop_query_version
IOSim
s (Channel (IOSim s) ByteString, Channel (IOSim s) ByteString)
forall (m :: * -> *) a. MonadSTM m => m (Channel m a, Channel m a)
createConnectedChannels
(CodecCBORTerm (Text, Maybe Int) NodeToNodeVersion
-> Codec
(Handshake NodeToNodeVersion Term)
DeserialiseFailure
(IOSim s)
ByteString
forall vNumber (m :: * -> *) failure.
(MonadST m, Ord vNumber, Show failure) =>
CodecCBORTerm (failure, Maybe Int) vNumber
-> Codec (Handshake vNumber Term) DeserialiseFailure m ByteString
codecHandshake CodecCBORTerm (Text, Maybe Int) NodeToNodeVersion
nodeToNodeVersionCodec)
((NodeToNodeVersion
-> CodecCBORTerm Text ArbitraryNodeToNodeVersionData)
-> VersionDataCodec
Term NodeToNodeVersion ArbitraryNodeToNodeVersionData
forall vNumber vData.
(vNumber -> CodecCBORTerm Text vData)
-> VersionDataCodec Term vNumber vData
cborTermVersionDataCodec ((CodecCBORTerm Text NodeToNodeVersionData
-> CodecCBORTerm Text ArbitraryNodeToNodeVersionData)
-> (NodeToNodeVersion -> CodecCBORTerm Text NodeToNodeVersionData)
-> NodeToNodeVersion
-> CodecCBORTerm Text ArbitraryNodeToNodeVersionData
forall a b.
(a -> b) -> (NodeToNodeVersion -> a) -> NodeToNodeVersion -> b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap CodecCBORTerm Text NodeToNodeVersionData
-> CodecCBORTerm Text ArbitraryNodeToNodeVersionData
transformNodeToNodeVersionData NodeToNodeVersion -> CodecCBORTerm Text NodeToNodeVersionData
nodeToNodeCodecCBORTerm))
Versions NodeToNodeVersion ArbitraryNodeToNodeVersionData Bool
clientVersions
Versions NodeToNodeVersion ArbitraryNodeToNodeVersionData Bool
serverVersions
(\(ArbitraryNodeToNodeVersionData NodeToNodeVersionData
vd) ->
NodeToNodeVersionData -> ArbitraryNodeToNodeVersionData
ArbitraryNodeToNodeVersionData (NodeToNodeVersionData -> ArbitraryNodeToNodeVersionData)
-> NodeToNodeVersionData -> ArbitraryNodeToNodeVersionData
forall a b. (a -> b) -> a -> b
$
NodeToNodeVersionData
vd { NTN.query = True
, NTN.peerSharing = PeerSharingEnabled
})
prop_query_version_NodeToClient_ST :: ArbitraryNodeToClientVersions
-> ArbitraryNodeToClientVersions
-> Property
prop_query_version_NodeToClient_ST :: ArbitraryNodeToClientVersions
-> ArbitraryNodeToClientVersions -> Property
prop_query_version_NodeToClient_ST
(ArbitraryNodeToClientVersions Versions NodeToClientVersion NodeToClientVersionData Bool
clientVersions)
(ArbitraryNodeToClientVersions Versions NodeToClientVersion NodeToClientVersionData Bool
serverVersions) =
(forall s. IOSim s Property) -> Property
forall a. (forall s. IOSim s a) -> a
runSimOrThrow ((forall s. IOSim s Property) -> Property)
-> (forall s. IOSim s Property) -> Property
forall a b. (a -> b) -> a -> b
$ IOSim
s (Channel (IOSim s) ByteString, Channel (IOSim s) ByteString)
-> Codec
(Handshake NodeToClientVersion Term)
DeserialiseFailure
(IOSim s)
ByteString
-> VersionDataCodec
Term NodeToClientVersion NodeToClientVersionData
-> Versions NodeToClientVersion NodeToClientVersionData Bool
-> Versions NodeToClientVersion NodeToClientVersionData Bool
-> (NodeToClientVersionData -> NodeToClientVersionData)
-> IOSim s Property
forall (m :: * -> *) vData vNumber.
(MonadAsync m, MonadCatch m, MonadST m, Eq vData, Acceptable vData,
Queryable vData, Show vData, Ord vNumber, Show vNumber) =>
m (Channel m ByteString, Channel m ByteString)
-> Codec (Handshake vNumber Term) DeserialiseFailure m ByteString
-> VersionDataCodec Term vNumber vData
-> Versions vNumber vData Bool
-> Versions vNumber vData Bool
-> (vData -> vData)
-> m Property
prop_query_version
IOSim
s (Channel (IOSim s) ByteString, Channel (IOSim s) ByteString)
forall (m :: * -> *) a. MonadSTM m => m (Channel m a, Channel m a)
createConnectedChannels
(CodecCBORTerm (Text, Maybe Int) NodeToClientVersion
-> Codec
(Handshake NodeToClientVersion Term)
DeserialiseFailure
(IOSim s)
ByteString
forall vNumber (m :: * -> *) failure.
(MonadST m, Ord vNumber, Show failure) =>
CodecCBORTerm (failure, Maybe Int) vNumber
-> Codec (Handshake vNumber Term) DeserialiseFailure m ByteString
codecHandshake CodecCBORTerm (Text, Maybe Int) NodeToClientVersion
nodeToClientVersionCodec)
((NodeToClientVersion -> CodecCBORTerm Text NodeToClientVersionData)
-> VersionDataCodec
Term NodeToClientVersion NodeToClientVersionData
forall vNumber vData.
(vNumber -> CodecCBORTerm Text vData)
-> VersionDataCodec Term vNumber vData
cborTermVersionDataCodec NodeToClientVersion -> CodecCBORTerm Text NodeToClientVersionData
nodeToClientCodecCBORTerm)
Versions NodeToClientVersion NodeToClientVersionData Bool
clientVersions
Versions NodeToClientVersion NodeToClientVersionData Bool
serverVersions
(\NodeToClientVersionData
vd -> NodeToClientVersionData
vd {NTC.query = True})
prop_query_version_NodeToClient_IO :: ArbitraryNodeToClientVersions
-> ArbitraryNodeToClientVersions
-> Property
prop_query_version_NodeToClient_IO :: ArbitraryNodeToClientVersions
-> ArbitraryNodeToClientVersions -> Property
prop_query_version_NodeToClient_IO
(ArbitraryNodeToClientVersions Versions NodeToClientVersion NodeToClientVersionData Bool
clientVersions)
(ArbitraryNodeToClientVersions Versions NodeToClientVersion NodeToClientVersionData Bool
serverVersions) =
IO Property -> Property
forall prop. Testable prop => IO prop -> Property
ioProperty (IO Property -> Property) -> IO Property -> Property
forall a b. (a -> b) -> a -> b
$ IO (Channel IO ByteString, Channel IO ByteString)
-> Codec
(Handshake NodeToClientVersion Term)
DeserialiseFailure
IO
ByteString
-> VersionDataCodec
Term NodeToClientVersion NodeToClientVersionData
-> Versions NodeToClientVersion NodeToClientVersionData Bool
-> Versions NodeToClientVersion NodeToClientVersionData Bool
-> (NodeToClientVersionData -> NodeToClientVersionData)
-> IO Property
forall (m :: * -> *) vData vNumber.
(MonadAsync m, MonadCatch m, MonadST m, Eq vData, Acceptable vData,
Queryable vData, Show vData, Ord vNumber, Show vNumber) =>
m (Channel m ByteString, Channel m ByteString)
-> Codec (Handshake vNumber Term) DeserialiseFailure m ByteString
-> VersionDataCodec Term vNumber vData
-> Versions vNumber vData Bool
-> Versions vNumber vData Bool
-> (vData -> vData)
-> m Property
prop_query_version
IO (Channel IO ByteString, Channel IO ByteString)
forall (m :: * -> *) a. MonadSTM m => m (Channel m a, Channel m a)
createConnectedChannels
(CodecCBORTerm (Text, Maybe Int) NodeToClientVersion
-> Codec
(Handshake NodeToClientVersion Term)
DeserialiseFailure
IO
ByteString
forall vNumber (m :: * -> *) failure.
(MonadST m, Ord vNumber, Show failure) =>
CodecCBORTerm (failure, Maybe Int) vNumber
-> Codec (Handshake vNumber Term) DeserialiseFailure m ByteString
codecHandshake CodecCBORTerm (Text, Maybe Int) NodeToClientVersion
nodeToClientVersionCodec)
((NodeToClientVersion -> CodecCBORTerm Text NodeToClientVersionData)
-> VersionDataCodec
Term NodeToClientVersion NodeToClientVersionData
forall vNumber vData.
(vNumber -> CodecCBORTerm Text vData)
-> VersionDataCodec Term vNumber vData
cborTermVersionDataCodec NodeToClientVersion -> CodecCBORTerm Text NodeToClientVersionData
nodeToClientCodecCBORTerm)
Versions NodeToClientVersion NodeToClientVersionData Bool
clientVersions
Versions NodeToClientVersion NodeToClientVersionData Bool
serverVersions
(\NodeToClientVersionData
vd -> NodeToClientVersionData
vd {NTC.query = True})
prop_query_version_NodeToClient_SimNet :: ArbitraryNodeToClientVersions
-> ArbitraryNodeToClientVersions
-> Property
prop_query_version_NodeToClient_SimNet :: ArbitraryNodeToClientVersions
-> ArbitraryNodeToClientVersions -> Property
prop_query_version_NodeToClient_SimNet
(ArbitraryNodeToClientVersions Versions NodeToClientVersion NodeToClientVersionData Bool
clientVersions)
(ArbitraryNodeToClientVersions Versions NodeToClientVersion NodeToClientVersionData Bool
serverVersions) =
(forall s. IOSim s Property) -> Property
forall a. (forall s. IOSim s a) -> a
runSimOrThrow ((forall s. IOSim s Property) -> Property)
-> (forall s. IOSim s Property) -> Property
forall a b. (a -> b) -> a -> b
$ IOSim
s (Channel (IOSim s) ByteString, Channel (IOSim s) ByteString)
-> Codec
(Handshake NodeToClientVersion Term)
DeserialiseFailure
(IOSim s)
ByteString
-> VersionDataCodec
Term NodeToClientVersion NodeToClientVersionData
-> Versions NodeToClientVersion NodeToClientVersionData Bool
-> Versions NodeToClientVersion NodeToClientVersionData Bool
-> (NodeToClientVersionData -> NodeToClientVersionData)
-> IOSim s Property
forall (m :: * -> *) vData vNumber.
(MonadAsync m, MonadCatch m, MonadST m, Eq vData, Acceptable vData,
Queryable vData, Show vData, Ord vNumber, Show vNumber) =>
m (Channel m ByteString, Channel m ByteString)
-> Codec (Handshake vNumber Term) DeserialiseFailure m ByteString
-> VersionDataCodec Term vNumber vData
-> Versions vNumber vData Bool
-> Versions vNumber vData Bool
-> (vData -> vData)
-> m Property
prop_query_version
IOSim
s (Channel (IOSim s) ByteString, Channel (IOSim s) ByteString)
forall (m :: * -> *) a. MonadSTM m => m (Channel m a, Channel m a)
createConnectedChannels
(CodecCBORTerm (Text, Maybe Int) NodeToClientVersion
-> Codec
(Handshake NodeToClientVersion Term)
DeserialiseFailure
(IOSim s)
ByteString
forall vNumber (m :: * -> *) failure.
(MonadST m, Ord vNumber, Show failure) =>
CodecCBORTerm (failure, Maybe Int) vNumber
-> Codec (Handshake vNumber Term) DeserialiseFailure m ByteString
codecHandshake CodecCBORTerm (Text, Maybe Int) NodeToClientVersion
nodeToClientVersionCodec)
((NodeToClientVersion -> CodecCBORTerm Text NodeToClientVersionData)
-> VersionDataCodec
Term NodeToClientVersion NodeToClientVersionData
forall vNumber vData.
(vNumber -> CodecCBORTerm Text vData)
-> VersionDataCodec Term vNumber vData
cborTermVersionDataCodec NodeToClientVersion -> CodecCBORTerm Text NodeToClientVersionData
nodeToClientCodecCBORTerm)
Versions NodeToClientVersion NodeToClientVersionData Bool
clientVersions
Versions NodeToClientVersion NodeToClientVersionData Bool
serverVersions
(\NodeToClientVersionData
vd -> NodeToClientVersionData
vd {NTC.query = True})
prop_query_version :: ( MonadAsync m
, MonadCatch m
, MonadST m
, Eq vData
, Acceptable vData
, Queryable vData
, Show vData
, Ord vNumber
, Show vNumber
)
=> m (Channel m ByteString, Channel m ByteString)
-> Codec (Handshake vNumber CBOR.Term)
CBOR.DeserialiseFailure m ByteString
-> VersionDataCodec CBOR.Term vNumber vData
-> Versions vNumber vData Bool
-> Versions vNumber vData Bool
-> (vData -> vData)
-> m Property
prop_query_version :: forall (m :: * -> *) vData vNumber.
(MonadAsync m, MonadCatch m, MonadST m, Eq vData, Acceptable vData,
Queryable vData, Show vData, Ord vNumber, Show vNumber) =>
m (Channel m ByteString, Channel m ByteString)
-> Codec (Handshake vNumber Term) DeserialiseFailure m ByteString
-> VersionDataCodec Term vNumber vData
-> Versions vNumber vData Bool
-> Versions vNumber vData Bool
-> (vData -> vData)
-> m Property
prop_query_version m (Channel m ByteString, Channel m ByteString)
createChannels Codec (Handshake vNumber Term) DeserialiseFailure m ByteString
codec VersionDataCodec Term vNumber vData
versionDataCodec Versions vNumber vData Bool
clientVersions Versions vNumber vData Bool
serverVersions vData -> vData
setQuery = do
(clientRes, _serverRes) <-
m (Channel m ByteString, Channel m ByteString)
-> Tracer m (Role, TraceSendRecv (Handshake vNumber Term))
-> Codec (Handshake vNumber Term) DeserialiseFailure m ByteString
-> Peer
(Handshake vNumber Term)
'AsClient
'NonPipelined
'StPropose
m
(Either
(HandshakeProtocolError vNumber)
(HandshakeResult Bool vNumber vData))
-> Peer
(Handshake vNumber Term)
(FlipAgency 'AsClient)
'NonPipelined
'StPropose
m
(Either
(HandshakeProtocolError vNumber)
(HandshakeResult Bool vNumber vData))
-> m (Either
(HandshakeProtocolError vNumber)
(HandshakeResult Bool vNumber vData),
Either
(HandshakeProtocolError vNumber)
(HandshakeResult Bool vNumber vData))
forall ps (pr :: PeerRole) (st :: ps) failure bytes (m :: * -> *) a
b.
(MonadAsync m, MonadThrow m, ShowProxy ps,
forall (st' :: ps) stok. (stok ~ StateToken st') => Show stok,
Show failure) =>
m (Channel m bytes, Channel m bytes)
-> Tracer m (Role, TraceSendRecv ps)
-> Codec ps failure m bytes
-> Peer ps pr 'NonPipelined st m a
-> Peer ps (FlipAgency pr) 'NonPipelined st m b
-> m (a, b)
runConnectedPeers
m (Channel m ByteString, Channel m ByteString)
createChannels Tracer m (Role, TraceSendRecv (Handshake vNumber Term))
forall (m :: * -> *) a. Applicative m => Tracer m a
nullTracer Codec (Handshake vNumber Term) DeserialiseFailure m ByteString
codec
(VersionDataCodec Term vNumber vData
-> (vData -> vData -> Accept vData)
-> Versions vNumber vData Bool
-> Peer
(Handshake vNumber Term)
'AsClient
'NonPipelined
'StPropose
m
(Either
(HandshakeProtocolError vNumber)
(HandshakeResult Bool vNumber vData))
forall vNumber vData r (m :: * -> *).
Ord vNumber =>
VersionDataCodec Term vNumber vData
-> (vData -> vData -> Accept vData)
-> Versions vNumber vData r
-> Client
(Handshake vNumber Term)
'NonPipelined
'StPropose
m
(Either
(HandshakeProtocolError vNumber) (HandshakeResult r vNumber vData))
handshakeClientPeer
VersionDataCodec Term vNumber vData
versionDataCodec
vData -> vData -> Accept vData
forall v. Acceptable v => v -> v -> Accept v
acceptableVersion
Versions vNumber vData Bool
clientVersions')
(VersionDataCodec Term vNumber vData
-> (vData -> vData -> Accept vData)
-> (vData -> Bool)
-> Versions vNumber vData Bool
-> Server
(Handshake vNumber Term)
'NonPipelined
'StPropose
m
(Either
(HandshakeProtocolError vNumber)
(HandshakeResult Bool vNumber vData))
forall vNumber vData r (m :: * -> *).
Ord vNumber =>
VersionDataCodec Term vNumber vData
-> (vData -> vData -> Accept vData)
-> (vData -> Bool)
-> Versions vNumber vData r
-> Server
(Handshake vNumber Term)
'NonPipelined
'StPropose
m
(Either
(HandshakeProtocolError vNumber) (HandshakeResult r vNumber vData))
handshakeServerPeer
VersionDataCodec Term vNumber vData
versionDataCodec
vData -> vData -> Accept vData
forall v. Acceptable v => v -> v -> Accept v
acceptableVersion
vData -> Bool
forall v. Queryable v => v -> Bool
queryVersion
Versions vNumber vData Bool
serverVersions)
pure $ case clientRes of
Left HandshakeProtocolError vNumber
_ ->
Bool -> Property
forall prop. Testable prop => prop -> Property
property Bool
True
Right HandshakeNegotiationResult {} ->
Bool -> Property
forall prop. Testable prop => prop -> Property
property Bool
False
Right (HandshakeQueryResult Map vNumber (Either Text vData)
serverVersions') ->
Map vNumber (Either Text vData) -> Map vNumber (Either Text vData)
setQueryAll Map vNumber (Either Text vData)
serverVersions' Map vNumber (Either Text vData)
-> Map vNumber (Either Text vData) -> Property
forall a. (Eq a, Show a) => a -> a -> Property
=== Map vNumber (Either Text vData) -> Map vNumber (Either Text vData)
setQueryAll (vData -> Either Text vData
forall a b. b -> Either a b
Right (vData -> Either Text vData)
-> (Version vData Bool -> vData)
-> Version vData Bool
-> Either Text vData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Version vData Bool -> vData
forall vData r. Version vData r -> vData
versionData (Version vData Bool -> Either Text vData)
-> Map vNumber (Version vData Bool)
-> Map vNumber (Either Text vData)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Versions vNumber vData Bool -> Map vNumber (Version vData Bool)
forall vNum vData r.
Versions vNum vData r -> Map vNum (Version vData r)
getVersions Versions vNumber vData Bool
serverVersions)
where
setQueryAll :: Map vNumber (Either Text vData) -> Map vNumber (Either Text vData)
setQueryAll Map vNumber (Either Text vData)
vs = (vData -> vData
setQuery (vData -> vData) -> Either Text vData -> Either Text vData
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) (Either Text vData -> Either Text vData)
-> Map vNumber (Either Text vData)
-> Map vNumber (Either Text vData)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map vNumber (Either Text vData)
vs
setQueryVersions :: Versions vNumber vData Bool -> Versions vNumber vData Bool
setQueryVersions (Versions Map vNumber (Version vData Bool)
vs) = Map vNumber (Version vData Bool) -> Versions vNumber vData Bool
forall vNum vData r.
Map vNum (Version vData r) -> Versions vNum vData r
Versions (Map vNumber (Version vData Bool) -> Versions vNumber vData Bool)
-> Map vNumber (Version vData Bool) -> Versions vNumber vData Bool
forall a b. (a -> b) -> a -> b
$ (\vNumber
_k Version vData Bool
v -> Version vData Bool
v { versionData = setQuery (versionData v) }) (vNumber -> Version vData Bool -> Version vData Bool)
-> Map vNumber (Version vData Bool)
-> Map vNumber (Version vData Bool)
forall k a b. (k -> a -> b) -> Map k a -> Map k b
`Map.mapWithKey` Map vNumber (Version vData Bool)
vs
clientVersions' :: Versions vNumber vData Bool
clientVersions' = Versions vNumber vData Bool -> Versions vNumber vData Bool
setQueryVersions Versions vNumber vData Bool
clientVersions
prop_peerSharing_symmetric :: ( MonadAsync m
, MonadCatch m
, MonadST m
)
=> m (Channel m ByteString, Channel m ByteString)
-> Codec (Handshake NodeToNodeVersion CBOR.Term)
CBOR.DeserialiseFailure m ByteString
-> VersionDataCodec CBOR.Term NodeToNodeVersion ArbitraryNodeToNodeVersionData
-> Versions NodeToNodeVersion ArbitraryNodeToNodeVersionData Bool
-> Versions NodeToNodeVersion ArbitraryNodeToNodeVersionData Bool
-> m Property
prop_peerSharing_symmetric :: forall (m :: * -> *).
(MonadAsync m, MonadCatch m, MonadST m) =>
m (Channel m ByteString, Channel m ByteString)
-> Codec
(Handshake NodeToNodeVersion Term) DeserialiseFailure m ByteString
-> VersionDataCodec
Term NodeToNodeVersion ArbitraryNodeToNodeVersionData
-> Versions NodeToNodeVersion ArbitraryNodeToNodeVersionData Bool
-> Versions NodeToNodeVersion ArbitraryNodeToNodeVersionData Bool
-> m Property
prop_peerSharing_symmetric m (Channel m ByteString, Channel m ByteString)
createChannels Codec
(Handshake NodeToNodeVersion Term) DeserialiseFailure m ByteString
codec VersionDataCodec
Term NodeToNodeVersion ArbitraryNodeToNodeVersionData
versionDataCodec Versions NodeToNodeVersion ArbitraryNodeToNodeVersionData Bool
clientVersions Versions NodeToNodeVersion ArbitraryNodeToNodeVersionData Bool
serverVersions = do
(clientRes, serverRes) <-
m (Channel m ByteString, Channel m ByteString)
-> Tracer
m (Role, TraceSendRecv (Handshake NodeToNodeVersion Term))
-> Codec
(Handshake NodeToNodeVersion Term) DeserialiseFailure m ByteString
-> Peer
(Handshake NodeToNodeVersion Term)
'AsClient
'NonPipelined
'StPropose
m
(Either
(HandshakeProtocolError NodeToNodeVersion)
(HandshakeResult
Bool NodeToNodeVersion ArbitraryNodeToNodeVersionData))
-> Peer
(Handshake NodeToNodeVersion Term)
(FlipAgency 'AsClient)
'NonPipelined
'StPropose
m
(Either
(HandshakeProtocolError NodeToNodeVersion)
(HandshakeResult
Bool NodeToNodeVersion ArbitraryNodeToNodeVersionData))
-> m (Either
(HandshakeProtocolError NodeToNodeVersion)
(HandshakeResult
Bool NodeToNodeVersion ArbitraryNodeToNodeVersionData),
Either
(HandshakeProtocolError NodeToNodeVersion)
(HandshakeResult
Bool NodeToNodeVersion ArbitraryNodeToNodeVersionData))
forall ps (pr :: PeerRole) (st :: ps) failure bytes (m :: * -> *) a
b.
(MonadAsync m, MonadThrow m, ShowProxy ps,
forall (st' :: ps) stok. (stok ~ StateToken st') => Show stok,
Show failure) =>
m (Channel m bytes, Channel m bytes)
-> Tracer m (Role, TraceSendRecv ps)
-> Codec ps failure m bytes
-> Peer ps pr 'NonPipelined st m a
-> Peer ps (FlipAgency pr) 'NonPipelined st m b
-> m (a, b)
runConnectedPeers
m (Channel m ByteString, Channel m ByteString)
createChannels Tracer m (Role, TraceSendRecv (Handshake NodeToNodeVersion Term))
forall (m :: * -> *) a. Applicative m => Tracer m a
nullTracer Codec
(Handshake NodeToNodeVersion Term) DeserialiseFailure m ByteString
codec
(VersionDataCodec
Term NodeToNodeVersion ArbitraryNodeToNodeVersionData
-> (ArbitraryNodeToNodeVersionData
-> ArbitraryNodeToNodeVersionData
-> Accept ArbitraryNodeToNodeVersionData)
-> Versions NodeToNodeVersion ArbitraryNodeToNodeVersionData Bool
-> Peer
(Handshake NodeToNodeVersion Term)
'AsClient
'NonPipelined
'StPropose
m
(Either
(HandshakeProtocolError NodeToNodeVersion)
(HandshakeResult
Bool NodeToNodeVersion ArbitraryNodeToNodeVersionData))
forall vNumber vData r (m :: * -> *).
Ord vNumber =>
VersionDataCodec Term vNumber vData
-> (vData -> vData -> Accept vData)
-> Versions vNumber vData r
-> Client
(Handshake vNumber Term)
'NonPipelined
'StPropose
m
(Either
(HandshakeProtocolError vNumber) (HandshakeResult r vNumber vData))
handshakeClientPeer
VersionDataCodec
Term NodeToNodeVersion ArbitraryNodeToNodeVersionData
versionDataCodec
ArbitraryNodeToNodeVersionData
-> ArbitraryNodeToNodeVersionData
-> Accept ArbitraryNodeToNodeVersionData
forall v. Acceptable v => v -> v -> Accept v
acceptableVersion
Versions NodeToNodeVersion ArbitraryNodeToNodeVersionData Bool
clientVersions)
(VersionDataCodec
Term NodeToNodeVersion ArbitraryNodeToNodeVersionData
-> (ArbitraryNodeToNodeVersionData
-> ArbitraryNodeToNodeVersionData
-> Accept ArbitraryNodeToNodeVersionData)
-> (ArbitraryNodeToNodeVersionData -> Bool)
-> Versions NodeToNodeVersion ArbitraryNodeToNodeVersionData Bool
-> Server
(Handshake NodeToNodeVersion Term)
'NonPipelined
'StPropose
m
(Either
(HandshakeProtocolError NodeToNodeVersion)
(HandshakeResult
Bool NodeToNodeVersion ArbitraryNodeToNodeVersionData))
forall vNumber vData r (m :: * -> *).
Ord vNumber =>
VersionDataCodec Term vNumber vData
-> (vData -> vData -> Accept vData)
-> (vData -> Bool)
-> Versions vNumber vData r
-> Server
(Handshake vNumber Term)
'NonPipelined
'StPropose
m
(Either
(HandshakeProtocolError vNumber) (HandshakeResult r vNumber vData))
handshakeServerPeer
VersionDataCodec
Term NodeToNodeVersion ArbitraryNodeToNodeVersionData
versionDataCodec
ArbitraryNodeToNodeVersionData
-> ArbitraryNodeToNodeVersionData
-> Accept ArbitraryNodeToNodeVersionData
forall v. Acceptable v => v -> v -> Accept v
acceptableVersion
ArbitraryNodeToNodeVersionData -> Bool
forall v. Queryable v => v -> Bool
queryVersion
Versions NodeToNodeVersion ArbitraryNodeToNodeVersionData Bool
serverVersions)
pure $ case (clientRes, serverRes) of
( Right (HandshakeNegotiationResult Bool
_ NodeToNodeVersion
v (ArbitraryNodeToNodeVersionData NodeToNodeVersionData
clientResult))
, Right (HandshakeNegotiationResult Bool
_ NodeToNodeVersion
v' (ArbitraryNodeToNodeVersionData NodeToNodeVersionData
serverResult))
) | NodeToNodeVersion
v NodeToNodeVersion -> NodeToNodeVersion -> Bool
forall a. Eq a => a -> a -> Bool
== NodeToNodeVersion
v'
, NodeToNodeVersion
v NodeToNodeVersion -> NodeToNodeVersion -> Bool
forall a. Ord a => a -> a -> Bool
>= NodeToNodeVersion
NodeToNodeV_13 ->
String -> Property -> Property
forall prop. Testable prop => String -> prop -> Property
counterexample
(String
"VersionNumber: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ NodeToNodeVersion -> String
forall a. Show a => a -> String
show NodeToNodeVersion
v)
(Property -> Property) -> Property -> Property
forall a b. (a -> b) -> a -> b
$ NodeToNodeVersionData
clientResult NodeToNodeVersionData -> NodeToNodeVersionData -> Property
forall a. (Eq a, Show a) => a -> a -> Property
=== NodeToNodeVersionData
serverResult
| NodeToNodeVersion
v NodeToNodeVersion -> NodeToNodeVersion -> Bool
forall a. Eq a => a -> a -> Bool
== NodeToNodeVersion
v'
, NodeToNodeVersion
v NodeToNodeVersion -> NodeToNodeVersion -> Bool
forall a. Ord a => a -> a -> Bool
< NodeToNodeVersion
NodeToNodeV_13 -> Bool -> Property
forall prop. Testable prop => prop -> Property
property Bool
True
| Bool
otherwise -> String -> Bool -> Property
forall prop. Testable prop => String -> prop -> Property
counterexample String
"Version mismatch" Bool
False
(Right HandshakeResult
Bool NodeToNodeVersion ArbitraryNodeToNodeVersionData
_, Left HandshakeProtocolError NodeToNodeVersion
_) -> String -> Bool -> Property
forall prop. Testable prop => String -> prop -> Property
counterexample String
"Acceptance mismatch" Bool
False
(Left HandshakeProtocolError NodeToNodeVersion
_, Right HandshakeResult
Bool NodeToNodeVersion ArbitraryNodeToNodeVersionData
_) -> String -> Bool -> Property
forall prop. Testable prop => String -> prop -> Property
counterexample String
"Acceptance mismatch" Bool
False
(Either
(HandshakeProtocolError NodeToNodeVersion)
(HandshakeResult
Bool NodeToNodeVersion ArbitraryNodeToNodeVersionData),
Either
(HandshakeProtocolError NodeToNodeVersion)
(HandshakeResult
Bool NodeToNodeVersion ArbitraryNodeToNodeVersionData))
_ -> Bool -> Property
forall prop. Testable prop => prop -> Property
property Bool
True
prop_peerSharing_symmetric_NodeToNode_SimNet
:: ArbitraryNodeToNodeVersions
-> ArbitraryNodeToNodeVersions
-> Property
prop_peerSharing_symmetric_NodeToNode_SimNet :: ArbitraryNodeToNodeVersions
-> ArbitraryNodeToNodeVersions -> Property
prop_peerSharing_symmetric_NodeToNode_SimNet
(ArbitraryNodeToNodeVersions Versions NodeToNodeVersion ArbitraryNodeToNodeVersionData Bool
clientVersions)
(ArbitraryNodeToNodeVersions Versions NodeToNodeVersion ArbitraryNodeToNodeVersionData Bool
serverVersions) =
(forall s. IOSim s Property) -> Property
forall a. (forall s. IOSim s a) -> a
runSimOrThrow ((forall s. IOSim s Property) -> Property)
-> (forall s. IOSim s Property) -> Property
forall a b. (a -> b) -> a -> b
$ IOSim
s (Channel (IOSim s) ByteString, Channel (IOSim s) ByteString)
-> Codec
(Handshake NodeToNodeVersion Term)
DeserialiseFailure
(IOSim s)
ByteString
-> VersionDataCodec
Term NodeToNodeVersion ArbitraryNodeToNodeVersionData
-> Versions NodeToNodeVersion ArbitraryNodeToNodeVersionData Bool
-> Versions NodeToNodeVersion ArbitraryNodeToNodeVersionData Bool
-> IOSim s Property
forall (m :: * -> *).
(MonadAsync m, MonadCatch m, MonadST m) =>
m (Channel m ByteString, Channel m ByteString)
-> Codec
(Handshake NodeToNodeVersion Term) DeserialiseFailure m ByteString
-> VersionDataCodec
Term NodeToNodeVersion ArbitraryNodeToNodeVersionData
-> Versions NodeToNodeVersion ArbitraryNodeToNodeVersionData Bool
-> Versions NodeToNodeVersion ArbitraryNodeToNodeVersionData Bool
-> m Property
prop_peerSharing_symmetric
IOSim
s (Channel (IOSim s) ByteString, Channel (IOSim s) ByteString)
forall (m :: * -> *) a. MonadSTM m => m (Channel m a, Channel m a)
createConnectedChannels
(CodecCBORTerm (Text, Maybe Int) NodeToNodeVersion
-> Codec
(Handshake NodeToNodeVersion Term)
DeserialiseFailure
(IOSim s)
ByteString
forall vNumber (m :: * -> *) failure.
(MonadST m, Ord vNumber, Show failure) =>
CodecCBORTerm (failure, Maybe Int) vNumber
-> Codec (Handshake vNumber Term) DeserialiseFailure m ByteString
codecHandshake CodecCBORTerm (Text, Maybe Int) NodeToNodeVersion
nodeToNodeVersionCodec)
((NodeToNodeVersion
-> CodecCBORTerm Text ArbitraryNodeToNodeVersionData)
-> VersionDataCodec
Term NodeToNodeVersion ArbitraryNodeToNodeVersionData
forall vNumber vData.
(vNumber -> CodecCBORTerm Text vData)
-> VersionDataCodec Term vNumber vData
cborTermVersionDataCodec ((CodecCBORTerm Text NodeToNodeVersionData
-> CodecCBORTerm Text ArbitraryNodeToNodeVersionData)
-> (NodeToNodeVersion -> CodecCBORTerm Text NodeToNodeVersionData)
-> NodeToNodeVersion
-> CodecCBORTerm Text ArbitraryNodeToNodeVersionData
forall a b.
(a -> b) -> (NodeToNodeVersion -> a) -> NodeToNodeVersion -> b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap CodecCBORTerm Text NodeToNodeVersionData
-> CodecCBORTerm Text ArbitraryNodeToNodeVersionData
transformNodeToNodeVersionData NodeToNodeVersion -> CodecCBORTerm Text NodeToNodeVersionData
nodeToNodeCodecCBORTerm))
Versions NodeToNodeVersion ArbitraryNodeToNodeVersionData Bool
clientVersions
Versions NodeToNodeVersion ArbitraryNodeToNodeVersionData Bool
serverVersions
prop_acceptOrRefuse_symmetric
:: forall vNumber vData r.
( Acceptable vData
, Eq vData
, Show vData
, Ord vNumber
, Show vNumber
, Eq r
, Show r
)
=> Versions vNumber vData r
-> Versions vNumber vData r
-> Property
prop_acceptOrRefuse_symmetric :: forall vNumber vData r.
(Acceptable vData, Eq vData, Show vData, Ord vNumber, Show vNumber,
Eq r, Show r) =>
Versions vNumber vData r -> Versions vNumber vData r -> Property
prop_acceptOrRefuse_symmetric Versions vNumber vData r
clientVersions Versions vNumber vData r
serverVersions =
case ( VersionDataCodec vData vNumber vData
-> (vData -> vData -> Accept vData)
-> Versions vNumber vData r
-> Map vNumber vData
-> Either (RefuseReason vNumber) (r, vNumber, vData)
forall vParams vNumber vData r.
Ord vNumber =>
VersionDataCodec vParams vNumber vData
-> (vData -> vData -> Accept vData)
-> Versions vNumber vData r
-> Map vNumber vParams
-> Either (RefuseReason vNumber) (r, vNumber, vData)
acceptOrRefuse VersionDataCodec vData vNumber vData
codec vData -> vData -> Accept vData
forall v. Acceptable v => v -> v -> Accept v
acceptableVersion Versions vNumber vData r
clientVersions Map vNumber vData
serverMap
, VersionDataCodec vData vNumber vData
-> (vData -> vData -> Accept vData)
-> Versions vNumber vData r
-> Map vNumber vData
-> Either (RefuseReason vNumber) (r, vNumber, vData)
forall vParams vNumber vData r.
Ord vNumber =>
VersionDataCodec vParams vNumber vData
-> (vData -> vData -> Accept vData)
-> Versions vNumber vData r
-> Map vNumber vParams
-> Either (RefuseReason vNumber) (r, vNumber, vData)
acceptOrRefuse VersionDataCodec vData vNumber vData
codec vData -> vData -> Accept vData
forall v. Acceptable v => v -> v -> Accept v
acceptableVersion Versions vNumber vData r
serverVersions Map vNumber vData
clientMap
) of
(Right (r
_, vNumber
vNumber, vData
vData), Right (r
_, vNumber
vNumber', vData
vData')) ->
vNumber
vNumber vNumber -> vNumber -> Property
forall a. (Eq a, Show a) => a -> a -> Property
=== vNumber
vNumber'
Property -> Property -> Property
forall prop1 prop2.
(Testable prop1, Testable prop2) =>
prop1 -> prop2 -> Property
.&&. vData
vData vData -> vData -> Property
forall a. (Eq a, Show a) => a -> a -> Property
=== vData
vData'
(Left (VersionMismatch [vNumber]
vNumbers [Int]
_), Left (VersionMismatch [vNumber]
vNumbers' [Int]
_)) ->
[vNumber]
vNumbers [vNumber] -> [vNumber] -> Property
forall a. (Eq a, Show a) => a -> a -> Property
=== Map vNumber vData -> [vNumber]
forall k a. Map k a -> [k]
Map.keys Map vNumber vData
clientMap
Property -> Property -> Property
forall prop1 prop2.
(Testable prop1, Testable prop2) =>
prop1 -> prop2 -> Property
.&&. [vNumber]
vNumbers' [vNumber] -> [vNumber] -> Property
forall a. (Eq a, Show a) => a -> a -> Property
=== Map vNumber vData -> [vNumber]
forall k a. Map k a -> [k]
Map.keys Map vNumber vData
serverMap
(Left HandshakeDecodeError {}, Left RefuseReason vNumber
_) ->
Bool -> Property
forall prop. Testable prop => prop -> Property
property Bool
True
(Left RefuseReason vNumber
_, Left HandshakeDecodeError {}) ->
Bool -> Property
forall prop. Testable prop => prop -> Property
property Bool
True
(Left (Refused vNumber
vNumber Text
_), Left (Refused vNumber
vNumber' Text
_)) ->
vNumber
vNumber vNumber -> vNumber -> Property
forall a. (Eq a, Show a) => a -> a -> Property
=== vNumber
vNumber'
(Either (RefuseReason vNumber) (r, vNumber, vData)
_ , Either (RefuseReason vNumber) (r, vNumber, vData)
_ ) ->
Bool -> Property
forall prop. Testable prop => prop -> Property
property Bool
False
where
codec :: VersionDataCodec vData vNumber vData
codec :: VersionDataCodec vData vNumber vData
codec = VersionDataCodec {
encodeData :: vNumber -> vData -> vData
encodeData = \vNumber
_ vData
vData -> vData
vData,
decodeData :: vNumber -> vData -> Either Text vData
decodeData = \vNumber
_ vData
vData -> vData -> Either Text vData
forall a b. b -> Either a b
Right vData
vData
}
toMap :: Versions vNumber vData r
-> Map vNumber vData
toMap :: Versions vNumber vData r -> Map vNumber vData
toMap (Versions Map vNumber (Version vData r)
m) = Version vData r -> vData
forall vData r. Version vData r -> vData
versionData (Version vData r -> vData)
-> Map vNumber (Version vData r) -> Map vNumber vData
forall a b k. (a -> b) -> Map k a -> Map k b
`Map.map` Map vNumber (Version vData r)
m
clientMap :: Map vNumber vData
clientMap = Versions vNumber vData r -> Map vNumber vData
toMap Versions vNumber vData r
clientVersions
serverMap :: Map vNumber vData
serverMap = Versions vNumber vData r -> Map vNumber vData
toMap Versions vNumber vData r
serverVersions
prop_acceptOrRefuse_symmetric_VersionData
:: ArbitraryVersions
-> Property
prop_acceptOrRefuse_symmetric_VersionData :: ArbitraryVersions -> Property
prop_acceptOrRefuse_symmetric_VersionData (ArbitraryVersions Versions VersionNumber VersionData Bool
a Versions VersionNumber VersionData Bool
b) =
Versions VersionNumber VersionData Bool
-> Versions VersionNumber VersionData Bool -> Property
forall vNumber vData r.
(Acceptable vData, Eq vData, Show vData, Ord vNumber, Show vNumber,
Eq r, Show r) =>
Versions vNumber vData r -> Versions vNumber vData r -> Property
prop_acceptOrRefuse_symmetric Versions VersionNumber VersionData Bool
a Versions VersionNumber VersionData Bool
b
prop_acceptOrRefuse_symmetric_NodeToNode
:: ArbitraryNodeToNodeVersions
-> ArbitraryNodeToNodeVersions
-> Property
prop_acceptOrRefuse_symmetric_NodeToNode :: ArbitraryNodeToNodeVersions
-> ArbitraryNodeToNodeVersions -> Property
prop_acceptOrRefuse_symmetric_NodeToNode (ArbitraryNodeToNodeVersions Versions NodeToNodeVersion ArbitraryNodeToNodeVersionData Bool
a)
(ArbitraryNodeToNodeVersions Versions NodeToNodeVersion ArbitraryNodeToNodeVersionData Bool
b) =
Versions NodeToNodeVersion ArbitraryNodeToNodeVersionData Bool
-> Versions NodeToNodeVersion ArbitraryNodeToNodeVersionData Bool
-> Property
forall vNumber vData r.
(Acceptable vData, Eq vData, Show vData, Ord vNumber, Show vNumber,
Eq r, Show r) =>
Versions vNumber vData r -> Versions vNumber vData r -> Property
prop_acceptOrRefuse_symmetric Versions NodeToNodeVersion ArbitraryNodeToNodeVersionData Bool
a Versions NodeToNodeVersion ArbitraryNodeToNodeVersionData Bool
b
prop_acceptOrRefuse_symmetric_NodeToClient
:: ArbitraryNodeToClientVersions
-> ArbitraryNodeToClientVersions
-> Property
prop_acceptOrRefuse_symmetric_NodeToClient :: ArbitraryNodeToClientVersions
-> ArbitraryNodeToClientVersions -> Property
prop_acceptOrRefuse_symmetric_NodeToClient (ArbitraryNodeToClientVersions Versions NodeToClientVersion NodeToClientVersionData Bool
a)
(ArbitraryNodeToClientVersions Versions NodeToClientVersion NodeToClientVersionData Bool
b) =
Versions NodeToClientVersion NodeToClientVersionData Bool
-> Versions NodeToClientVersion NodeToClientVersionData Bool
-> Property
forall vNumber vData r.
(Acceptable vData, Eq vData, Show vData, Ord vNumber, Show vNumber,
Eq r, Show r) =>
Versions vNumber vData r -> Versions vNumber vData r -> Property
prop_acceptOrRefuse_symmetric Versions NodeToClientVersion NodeToClientVersionData Bool
a Versions NodeToClientVersion NodeToClientVersionData Bool
b
prop_channel_simultaneous_open
:: ( MonadAsync m
, MonadCatch m
, MonadST m
, Acceptable vData
, Ord vNumber
)
=> m (Channel m ByteString, Channel m ByteString)
-> Codec (Handshake vNumber CBOR.Term)
CBOR.DeserialiseFailure m ByteString
-> VersionDataCodec CBOR.Term vNumber vData
-> Versions vNumber vData Bool
-> Versions vNumber vData Bool
-> m Property
prop_channel_simultaneous_open :: forall (m :: * -> *) vData vNumber.
(MonadAsync m, MonadCatch m, MonadST m, Acceptable vData,
Ord vNumber) =>
m (Channel m ByteString, Channel m ByteString)
-> Codec (Handshake vNumber Term) DeserialiseFailure m ByteString
-> VersionDataCodec Term vNumber vData
-> Versions vNumber vData Bool
-> Versions vNumber vData Bool
-> m Property
prop_channel_simultaneous_open m (Channel m ByteString, Channel m ByteString)
createChannels Codec (Handshake vNumber Term) DeserialiseFailure m ByteString
codec VersionDataCodec Term vNumber vData
versionDataCodec Versions vNumber vData Bool
clientVersions Versions vNumber vData Bool
serverVersions =
let (Maybe Bool
serverRes, Maybe Bool
clientRes) =
(vData -> vData -> Maybe vData)
-> Versions vNumber vData Bool
-> Versions vNumber vData Bool
-> (Maybe Bool, Maybe Bool)
forall vNumber vData r.
Ord vNumber =>
(vData -> vData -> Maybe vData)
-> Versions vNumber vData r
-> Versions vNumber vData r
-> (Maybe r, Maybe r)
pureHandshake
((Accept vData -> Maybe vData
forall a. Accept a -> Maybe a
maybeAccept (Accept vData -> Maybe vData)
-> (vData -> Accept vData) -> vData -> Maybe vData
forall b c a. (b -> c) -> (a -> b) -> a -> c
.) ((vData -> Accept vData) -> vData -> Maybe vData)
-> (vData -> vData -> Accept vData)
-> vData
-> vData
-> Maybe vData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. vData -> vData -> Accept vData
forall v. Acceptable v => v -> v -> Accept v
acceptableVersion)
Versions vNumber vData Bool
serverVersions
Versions vNumber vData Bool
clientVersions
in do
(clientChannel, serverChannel) <- m (Channel m ByteString, Channel m ByteString)
createChannels
let client = VersionDataCodec Term vNumber vData
-> (vData -> vData -> Accept vData)
-> Versions vNumber vData Bool
-> Client
(Handshake vNumber Term)
'NonPipelined
'StPropose
m
(Either
(HandshakeProtocolError vNumber)
(HandshakeResult Bool vNumber vData))
forall vNumber vData r (m :: * -> *).
Ord vNumber =>
VersionDataCodec Term vNumber vData
-> (vData -> vData -> Accept vData)
-> Versions vNumber vData r
-> Client
(Handshake vNumber Term)
'NonPipelined
'StPropose
m
(Either
(HandshakeProtocolError vNumber) (HandshakeResult r vNumber vData))
handshakeClientPeer
VersionDataCodec Term vNumber vData
versionDataCodec
vData -> vData -> Accept vData
forall v. Acceptable v => v -> v -> Accept v
acceptableVersion
Versions vNumber vData Bool
clientVersions
client' = VersionDataCodec Term vNumber vData
-> (vData -> vData -> Accept vData)
-> Versions vNumber vData Bool
-> Client
(Handshake vNumber Term)
'NonPipelined
'StPropose
m
(Either
(HandshakeProtocolError vNumber)
(HandshakeResult Bool vNumber vData))
forall vNumber vData r (m :: * -> *).
Ord vNumber =>
VersionDataCodec Term vNumber vData
-> (vData -> vData -> Accept vData)
-> Versions vNumber vData r
-> Client
(Handshake vNumber Term)
'NonPipelined
'StPropose
m
(Either
(HandshakeProtocolError vNumber) (HandshakeResult r vNumber vData))
handshakeClientPeer
VersionDataCodec Term vNumber vData
versionDataCodec
vData -> vData -> Accept vData
forall v. Acceptable v => v -> v -> Accept v
acceptableVersion
Versions vNumber vData Bool
serverVersions
(clientRes', serverRes') <-
(fst <$> runPeer nullTracer
codec clientChannel client)
`concurrently`
(fst <$> runPeer nullTracer
codec serverChannel client')
pure $
case (clientRes', serverRes') of
(Right (HandshakeNegotiationResult Bool
c vNumber
_ vData
_), Right (HandshakeNegotiationResult Bool
s vNumber
_ vData
_)) ->
String -> Property -> Property
forall prop. Testable prop => String -> prop -> Property
label String
"both-succeed" (Property -> Property) -> Property -> Property
forall a b. (a -> b) -> a -> b
$
Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
c Maybe Bool -> Maybe Bool -> Property
forall a. (Eq a, Show a) => a -> a -> Property
=== Maybe Bool
clientRes
Property -> Property -> Property
forall prop1 prop2.
(Testable prop1, Testable prop2) =>
prop1 -> prop2 -> Property
.&&. Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
s Maybe Bool -> Maybe Bool -> Property
forall a. (Eq a, Show a) => a -> a -> Property
=== Maybe Bool
serverRes
(Right (HandshakeQueryResult Map vNumber (Either Text vData)
_), Right (HandshakeQueryResult Map vNumber (Either Text vData)
_)) ->
String -> Bool -> Property
forall prop. Testable prop => String -> prop -> Property
label String
"both-query" Bool
True
(Left{}, Left{}) -> String -> Bool -> Property
forall prop. Testable prop => String -> prop -> Property
label String
"both-failed" Bool
True
(Either
(HandshakeProtocolError vNumber)
(HandshakeResult Bool vNumber vData),
Either
(HandshakeProtocolError vNumber)
(HandshakeResult Bool vNumber vData))
_ -> Bool -> Property
forall prop. Testable prop => prop -> Property
property Bool
False
prop_channel_simultaneous_open_ST :: ArbitraryVersions -> Property
prop_channel_simultaneous_open_ST :: ArbitraryVersions -> Property
prop_channel_simultaneous_open_ST (ArbitraryVersions Versions VersionNumber VersionData Bool
clientVersions Versions VersionNumber VersionData Bool
serverVersions) =
(forall s. IOSim s Property) -> Property
forall a. (forall s. IOSim s a) -> a
runSimOrThrow ((forall s. IOSim s Property) -> Property)
-> (forall s. IOSim s Property) -> Property
forall a b. (a -> b) -> a -> b
$ IOSim
s (Channel (IOSim s) ByteString, Channel (IOSim s) ByteString)
-> Codec
(Handshake VersionNumber Term)
DeserialiseFailure
(IOSim s)
ByteString
-> VersionDataCodec Term VersionNumber VersionData
-> Versions VersionNumber VersionData Bool
-> Versions VersionNumber VersionData Bool
-> IOSim s Property
forall (m :: * -> *) vData vNumber.
(MonadAsync m, MonadCatch m, MonadST m, Acceptable vData,
Ord vNumber) =>
m (Channel m ByteString, Channel m ByteString)
-> Codec (Handshake vNumber Term) DeserialiseFailure m ByteString
-> VersionDataCodec Term vNumber vData
-> Versions vNumber vData Bool
-> Versions vNumber vData Bool
-> m Property
prop_channel_simultaneous_open
IOSim
s (Channel (IOSim s) ByteString, Channel (IOSim s) ByteString)
forall (m :: * -> *) a. MonadSTM m => m (Channel m a, Channel m a)
createConnectedChannels
Codec
(Handshake VersionNumber Term)
DeserialiseFailure
(IOSim s)
ByteString
forall (m :: * -> *).
(MonadST m, MonadThrow m) =>
Codec
(Handshake VersionNumber Term) DeserialiseFailure m ByteString
versionNumberHandshakeCodec
((VersionNumber -> CodecCBORTerm Text VersionData)
-> VersionDataCodec Term VersionNumber VersionData
forall vNumber vData.
(vNumber -> CodecCBORTerm Text vData)
-> VersionDataCodec Term vNumber vData
cborTermVersionDataCodec VersionNumber -> CodecCBORTerm Text VersionData
dataCodecCBORTerm)
Versions VersionNumber VersionData Bool
clientVersions
Versions VersionNumber VersionData Bool
serverVersions
prop_channel_simultaneous_open_IO :: ArbitraryVersions -> Property
prop_channel_simultaneous_open_IO :: ArbitraryVersions -> Property
prop_channel_simultaneous_open_IO (ArbitraryVersions Versions VersionNumber VersionData Bool
clientVersions Versions VersionNumber VersionData Bool
serverVersions) =
IO Property -> Property
forall prop. Testable prop => IO prop -> Property
ioProperty (IO Property -> Property) -> IO Property -> Property
forall a b. (a -> b) -> a -> b
$ IO (Channel IO ByteString, Channel IO ByteString)
-> Codec
(Handshake VersionNumber Term) DeserialiseFailure IO ByteString
-> VersionDataCodec Term VersionNumber VersionData
-> Versions VersionNumber VersionData Bool
-> Versions VersionNumber VersionData Bool
-> IO Property
forall (m :: * -> *) vData vNumber.
(MonadAsync m, MonadCatch m, MonadST m, Acceptable vData,
Ord vNumber) =>
m (Channel m ByteString, Channel m ByteString)
-> Codec (Handshake vNumber Term) DeserialiseFailure m ByteString
-> VersionDataCodec Term vNumber vData
-> Versions vNumber vData Bool
-> Versions vNumber vData Bool
-> m Property
prop_channel_simultaneous_open
IO (Channel IO ByteString, Channel IO ByteString)
forall (m :: * -> *) a. MonadSTM m => m (Channel m a, Channel m a)
createConnectedChannels
Codec
(Handshake VersionNumber Term) DeserialiseFailure IO ByteString
forall (m :: * -> *).
(MonadST m, MonadThrow m) =>
Codec
(Handshake VersionNumber Term) DeserialiseFailure m ByteString
versionNumberHandshakeCodec
((VersionNumber -> CodecCBORTerm Text VersionData)
-> VersionDataCodec Term VersionNumber VersionData
forall vNumber vData.
(vNumber -> CodecCBORTerm Text vData)
-> VersionDataCodec Term vNumber vData
cborTermVersionDataCodec VersionNumber -> CodecCBORTerm Text VersionData
dataCodecCBORTerm)
Versions VersionNumber VersionData Bool
clientVersions
Versions VersionNumber VersionData Bool
serverVersions
prop_channel_simultaneous_open_NodeToNode_ST :: ArbitraryNodeToNodeVersions
-> ArbitraryNodeToNodeVersions
-> Property
prop_channel_simultaneous_open_NodeToNode_ST :: ArbitraryNodeToNodeVersions
-> ArbitraryNodeToNodeVersions -> Property
prop_channel_simultaneous_open_NodeToNode_ST
(ArbitraryNodeToNodeVersions Versions NodeToNodeVersion ArbitraryNodeToNodeVersionData Bool
clientVersions)
(ArbitraryNodeToNodeVersions Versions NodeToNodeVersion ArbitraryNodeToNodeVersionData Bool
serverVersions) =
(forall s. IOSim s Property) -> Property
forall a. (forall s. IOSim s a) -> a
runSimOrThrow ((forall s. IOSim s Property) -> Property)
-> (forall s. IOSim s Property) -> Property
forall a b. (a -> b) -> a -> b
$ IOSim
s (Channel (IOSim s) ByteString, Channel (IOSim s) ByteString)
-> Codec
(Handshake NodeToNodeVersion Term)
DeserialiseFailure
(IOSim s)
ByteString
-> VersionDataCodec
Term NodeToNodeVersion ArbitraryNodeToNodeVersionData
-> Versions NodeToNodeVersion ArbitraryNodeToNodeVersionData Bool
-> Versions NodeToNodeVersion ArbitraryNodeToNodeVersionData Bool
-> IOSim s Property
forall (m :: * -> *) vData vNumber.
(MonadAsync m, MonadCatch m, MonadST m, Acceptable vData,
Ord vNumber) =>
m (Channel m ByteString, Channel m ByteString)
-> Codec (Handshake vNumber Term) DeserialiseFailure m ByteString
-> VersionDataCodec Term vNumber vData
-> Versions vNumber vData Bool
-> Versions vNumber vData Bool
-> m Property
prop_channel_simultaneous_open
IOSim
s (Channel (IOSim s) ByteString, Channel (IOSim s) ByteString)
forall (m :: * -> *) a. MonadSTM m => m (Channel m a, Channel m a)
createConnectedChannels
(CodecCBORTerm (Text, Maybe Int) NodeToNodeVersion
-> Codec
(Handshake NodeToNodeVersion Term)
DeserialiseFailure
(IOSim s)
ByteString
forall vNumber (m :: * -> *) failure.
(MonadST m, Ord vNumber, Show failure) =>
CodecCBORTerm (failure, Maybe Int) vNumber
-> Codec (Handshake vNumber Term) DeserialiseFailure m ByteString
codecHandshake CodecCBORTerm (Text, Maybe Int) NodeToNodeVersion
nodeToNodeVersionCodec)
((NodeToNodeVersion
-> CodecCBORTerm Text ArbitraryNodeToNodeVersionData)
-> VersionDataCodec
Term NodeToNodeVersion ArbitraryNodeToNodeVersionData
forall vNumber vData.
(vNumber -> CodecCBORTerm Text vData)
-> VersionDataCodec Term vNumber vData
cborTermVersionDataCodec ((CodecCBORTerm Text NodeToNodeVersionData
-> CodecCBORTerm Text ArbitraryNodeToNodeVersionData)
-> (NodeToNodeVersion -> CodecCBORTerm Text NodeToNodeVersionData)
-> NodeToNodeVersion
-> CodecCBORTerm Text ArbitraryNodeToNodeVersionData
forall a b.
(a -> b) -> (NodeToNodeVersion -> a) -> NodeToNodeVersion -> b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap CodecCBORTerm Text NodeToNodeVersionData
-> CodecCBORTerm Text ArbitraryNodeToNodeVersionData
transformNodeToNodeVersionData NodeToNodeVersion -> CodecCBORTerm Text NodeToNodeVersionData
nodeToNodeCodecCBORTerm))
Versions NodeToNodeVersion ArbitraryNodeToNodeVersionData Bool
clientVersions
Versions NodeToNodeVersion ArbitraryNodeToNodeVersionData Bool
serverVersions
transformNodeToNodeVersionData :: CodecCBORTerm Text NodeToNodeVersionData
-> CodecCBORTerm Text ArbitraryNodeToNodeVersionData
transformNodeToNodeVersionData :: CodecCBORTerm Text NodeToNodeVersionData
-> CodecCBORTerm Text ArbitraryNodeToNodeVersionData
transformNodeToNodeVersionData (CodecCBORTerm NodeToNodeVersionData -> Term
g Term -> Either Text NodeToNodeVersionData
h) =
CodecCBORTerm { encodeTerm :: ArbitraryNodeToNodeVersionData -> Term
encodeTerm = \(ArbitraryNodeToNodeVersionData NodeToNodeVersionData
a) -> NodeToNodeVersionData -> Term
g NodeToNodeVersionData
a
, decodeTerm :: Term -> Either Text ArbitraryNodeToNodeVersionData
decodeTerm = (Either Text NodeToNodeVersionData
-> Either Text ArbitraryNodeToNodeVersionData)
-> (Term -> Either Text NodeToNodeVersionData)
-> Term
-> Either Text ArbitraryNodeToNodeVersionData
forall a b. (a -> b) -> (Term -> a) -> Term -> b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((NodeToNodeVersionData -> ArbitraryNodeToNodeVersionData)
-> Either Text NodeToNodeVersionData
-> Either Text ArbitraryNodeToNodeVersionData
forall a b. (a -> b) -> Either Text a -> Either Text b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap NodeToNodeVersionData -> ArbitraryNodeToNodeVersionData
ArbitraryNodeToNodeVersionData) Term -> Either Text NodeToNodeVersionData
h
}
prop_channel_simultaneous_open_NodeToNode_IO :: ArbitraryNodeToNodeVersions
-> ArbitraryNodeToNodeVersions
-> Property
prop_channel_simultaneous_open_NodeToNode_IO :: ArbitraryNodeToNodeVersions
-> ArbitraryNodeToNodeVersions -> Property
prop_channel_simultaneous_open_NodeToNode_IO
(ArbitraryNodeToNodeVersions Versions NodeToNodeVersion ArbitraryNodeToNodeVersionData Bool
clientVersions)
(ArbitraryNodeToNodeVersions Versions NodeToNodeVersion ArbitraryNodeToNodeVersionData Bool
serverVersions) =
IO Property -> Property
forall prop. Testable prop => IO prop -> Property
ioProperty (IO Property -> Property) -> IO Property -> Property
forall a b. (a -> b) -> a -> b
$ IO (Channel IO ByteString, Channel IO ByteString)
-> Codec
(Handshake NodeToNodeVersion Term) DeserialiseFailure IO ByteString
-> VersionDataCodec
Term NodeToNodeVersion ArbitraryNodeToNodeVersionData
-> Versions NodeToNodeVersion ArbitraryNodeToNodeVersionData Bool
-> Versions NodeToNodeVersion ArbitraryNodeToNodeVersionData Bool
-> IO Property
forall (m :: * -> *) vData vNumber.
(MonadAsync m, MonadCatch m, MonadST m, Acceptable vData,
Ord vNumber) =>
m (Channel m ByteString, Channel m ByteString)
-> Codec (Handshake vNumber Term) DeserialiseFailure m ByteString
-> VersionDataCodec Term vNumber vData
-> Versions vNumber vData Bool
-> Versions vNumber vData Bool
-> m Property
prop_channel_simultaneous_open
IO (Channel IO ByteString, Channel IO ByteString)
forall (m :: * -> *) a. MonadSTM m => m (Channel m a, Channel m a)
createConnectedChannels
(CodecCBORTerm (Text, Maybe Int) NodeToNodeVersion
-> Codec
(Handshake NodeToNodeVersion Term) DeserialiseFailure IO ByteString
forall vNumber (m :: * -> *) failure.
(MonadST m, Ord vNumber, Show failure) =>
CodecCBORTerm (failure, Maybe Int) vNumber
-> Codec (Handshake vNumber Term) DeserialiseFailure m ByteString
codecHandshake CodecCBORTerm (Text, Maybe Int) NodeToNodeVersion
nodeToNodeVersionCodec)
((NodeToNodeVersion
-> CodecCBORTerm Text ArbitraryNodeToNodeVersionData)
-> VersionDataCodec
Term NodeToNodeVersion ArbitraryNodeToNodeVersionData
forall vNumber vData.
(vNumber -> CodecCBORTerm Text vData)
-> VersionDataCodec Term vNumber vData
cborTermVersionDataCodec ((CodecCBORTerm Text NodeToNodeVersionData
-> CodecCBORTerm Text ArbitraryNodeToNodeVersionData)
-> (NodeToNodeVersion -> CodecCBORTerm Text NodeToNodeVersionData)
-> NodeToNodeVersion
-> CodecCBORTerm Text ArbitraryNodeToNodeVersionData
forall a b.
(a -> b) -> (NodeToNodeVersion -> a) -> NodeToNodeVersion -> b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap CodecCBORTerm Text NodeToNodeVersionData
-> CodecCBORTerm Text ArbitraryNodeToNodeVersionData
transformNodeToNodeVersionData NodeToNodeVersion -> CodecCBORTerm Text NodeToNodeVersionData
nodeToNodeCodecCBORTerm))
Versions NodeToNodeVersion ArbitraryNodeToNodeVersionData Bool
clientVersions
Versions NodeToNodeVersion ArbitraryNodeToNodeVersionData Bool
serverVersions
prop_channel_simultaneous_open_NodeToClient_ST :: ArbitraryNodeToClientVersions
-> ArbitraryNodeToClientVersions
-> Property
prop_channel_simultaneous_open_NodeToClient_ST :: ArbitraryNodeToClientVersions
-> ArbitraryNodeToClientVersions -> Property
prop_channel_simultaneous_open_NodeToClient_ST
(ArbitraryNodeToClientVersions Versions NodeToClientVersion NodeToClientVersionData Bool
clientVersions)
(ArbitraryNodeToClientVersions Versions NodeToClientVersion NodeToClientVersionData Bool
serverVersions) =
(forall s. IOSim s Property) -> Property
forall a. (forall s. IOSim s a) -> a
runSimOrThrow ((forall s. IOSim s Property) -> Property)
-> (forall s. IOSim s Property) -> Property
forall a b. (a -> b) -> a -> b
$ IOSim
s (Channel (IOSim s) ByteString, Channel (IOSim s) ByteString)
-> Codec
(Handshake NodeToClientVersion Term)
DeserialiseFailure
(IOSim s)
ByteString
-> VersionDataCodec
Term NodeToClientVersion NodeToClientVersionData
-> Versions NodeToClientVersion NodeToClientVersionData Bool
-> Versions NodeToClientVersion NodeToClientVersionData Bool
-> IOSim s Property
forall (m :: * -> *) vData vNumber.
(MonadAsync m, MonadCatch m, MonadST m, Acceptable vData,
Ord vNumber) =>
m (Channel m ByteString, Channel m ByteString)
-> Codec (Handshake vNumber Term) DeserialiseFailure m ByteString
-> VersionDataCodec Term vNumber vData
-> Versions vNumber vData Bool
-> Versions vNumber vData Bool
-> m Property
prop_channel_simultaneous_open
IOSim
s (Channel (IOSim s) ByteString, Channel (IOSim s) ByteString)
forall (m :: * -> *) a. MonadSTM m => m (Channel m a, Channel m a)
createConnectedChannels
(CodecCBORTerm (Text, Maybe Int) NodeToClientVersion
-> Codec
(Handshake NodeToClientVersion Term)
DeserialiseFailure
(IOSim s)
ByteString
forall vNumber (m :: * -> *) failure.
(MonadST m, Ord vNumber, Show failure) =>
CodecCBORTerm (failure, Maybe Int) vNumber
-> Codec (Handshake vNumber Term) DeserialiseFailure m ByteString
codecHandshake CodecCBORTerm (Text, Maybe Int) NodeToClientVersion
nodeToClientVersionCodec)
((NodeToClientVersion -> CodecCBORTerm Text NodeToClientVersionData)
-> VersionDataCodec
Term NodeToClientVersion NodeToClientVersionData
forall vNumber vData.
(vNumber -> CodecCBORTerm Text vData)
-> VersionDataCodec Term vNumber vData
cborTermVersionDataCodec NodeToClientVersion -> CodecCBORTerm Text NodeToClientVersionData
nodeToClientCodecCBORTerm)
Versions NodeToClientVersion NodeToClientVersionData Bool
clientVersions
Versions NodeToClientVersion NodeToClientVersionData Bool
serverVersions
prop_channel_simultaneous_open_NodeToClient_IO :: ArbitraryNodeToClientVersions
-> ArbitraryNodeToClientVersions
-> Property
prop_channel_simultaneous_open_NodeToClient_IO :: ArbitraryNodeToClientVersions
-> ArbitraryNodeToClientVersions -> Property
prop_channel_simultaneous_open_NodeToClient_IO
(ArbitraryNodeToClientVersions Versions NodeToClientVersion NodeToClientVersionData Bool
clientVersions)
(ArbitraryNodeToClientVersions Versions NodeToClientVersion NodeToClientVersionData Bool
serverVersions) =
IO Property -> Property
forall prop. Testable prop => IO prop -> Property
ioProperty (IO Property -> Property) -> IO Property -> Property
forall a b. (a -> b) -> a -> b
$ IO (Channel IO ByteString, Channel IO ByteString)
-> Codec
(Handshake NodeToClientVersion Term)
DeserialiseFailure
IO
ByteString
-> VersionDataCodec
Term NodeToClientVersion NodeToClientVersionData
-> Versions NodeToClientVersion NodeToClientVersionData Bool
-> Versions NodeToClientVersion NodeToClientVersionData Bool
-> IO Property
forall (m :: * -> *) vData vNumber.
(MonadAsync m, MonadCatch m, MonadST m, Acceptable vData,
Ord vNumber) =>
m (Channel m ByteString, Channel m ByteString)
-> Codec (Handshake vNumber Term) DeserialiseFailure m ByteString
-> VersionDataCodec Term vNumber vData
-> Versions vNumber vData Bool
-> Versions vNumber vData Bool
-> m Property
prop_channel_simultaneous_open
IO (Channel IO ByteString, Channel IO ByteString)
forall (m :: * -> *) a. MonadSTM m => m (Channel m a, Channel m a)
createConnectedChannels
(CodecCBORTerm (Text, Maybe Int) NodeToClientVersion
-> Codec
(Handshake NodeToClientVersion Term)
DeserialiseFailure
IO
ByteString
forall vNumber (m :: * -> *) failure.
(MonadST m, Ord vNumber, Show failure) =>
CodecCBORTerm (failure, Maybe Int) vNumber
-> Codec (Handshake vNumber Term) DeserialiseFailure m ByteString
codecHandshake CodecCBORTerm (Text, Maybe Int) NodeToClientVersion
nodeToClientVersionCodec)
((NodeToClientVersion -> CodecCBORTerm Text NodeToClientVersionData)
-> VersionDataCodec
Term NodeToClientVersion NodeToClientVersionData
forall vNumber vData.
(vNumber -> CodecCBORTerm Text vData)
-> VersionDataCodec Term vNumber vData
cborTermVersionDataCodec NodeToClientVersion -> CodecCBORTerm Text NodeToClientVersionData
nodeToClientCodecCBORTerm)
Versions NodeToClientVersion NodeToClientVersionData Bool
clientVersions
Versions NodeToClientVersion NodeToClientVersionData Bool
serverVersions
prop_channel_simultaneous_open_sim
:: forall vNumber vData m.
( Alternative (STM m)
, MonadAsync m
, MonadCatch m
, MonadDelay m
, MonadFork m
, MonadLabelledSTM m
, MonadMask m
, MonadMonotonicTime m
, MonadST m
, MonadThrow (STM m)
, MonadTime m
, MonadTimer m
, Acceptable vData
, Ord vNumber
)
=> Codec (Handshake vNumber CBOR.Term)
CBOR.DeserialiseFailure m ByteString
-> VersionDataCodec CBOR.Term vNumber vData
-> Versions vNumber vData Bool
-> Versions vNumber vData Bool
-> m Property
prop_channel_simultaneous_open_sim :: forall vNumber vData (m :: * -> *).
(Alternative (STM m), MonadAsync m, MonadCatch m, MonadDelay m,
MonadFork m, MonadLabelledSTM m, MonadMask m, MonadMonotonicTime m,
MonadST m, MonadThrow (STM m), MonadTime m, MonadTimer m,
Acceptable vData, Ord vNumber) =>
Codec (Handshake vNumber Term) DeserialiseFailure m ByteString
-> VersionDataCodec Term vNumber vData
-> Versions vNumber vData Bool
-> Versions vNumber vData Bool
-> m Property
prop_channel_simultaneous_open_sim Codec (Handshake vNumber Term) DeserialiseFailure m ByteString
codec VersionDataCodec Term vNumber vData
versionDataCodec
Versions vNumber vData Bool
clientVersions Versions vNumber vData Bool
serverVersions =
let attenuation :: BearerInfo
attenuation = BearerInfo
noAttenuation { biConnectionDelay = 1 } in
Tracer
m (WithAddr (TestAddress Int) (SnocketTrace m (TestAddress Int)))
-> BearerInfo
-> Map (NormalisedId (TestAddress Int)) (Script BearerInfo)
-> (Snocket m (FD m (TestAddress Int)) (TestAddress Int)
-> m (ObservableNetworkState (TestAddress Int)) -> m Property)
-> m Property
forall (m :: * -> *) peerAddr a.
(Alternative (STM m), MonadDelay m, MonadLabelledSTM m,
MonadMask m, MonadTimer m, MonadThrow (STM m),
GlobalAddressScheme peerAddr, Ord peerAddr, Typeable peerAddr,
Show peerAddr) =>
Tracer
m
(WithAddr
(TestAddress peerAddr) (SnocketTrace m (TestAddress peerAddr)))
-> BearerInfo
-> Map (NormalisedId (TestAddress peerAddr)) (Script BearerInfo)
-> (Snocket m (FD m (TestAddress peerAddr)) (TestAddress peerAddr)
-> m (ObservableNetworkState (TestAddress peerAddr)) -> m a)
-> m a
withSnocket Tracer
m (WithAddr (TestAddress Int) (SnocketTrace m (TestAddress Int)))
forall (m :: * -> *) a. Applicative m => Tracer m a
nullTracer
BearerInfo
attenuation
Map (NormalisedId (TestAddress Int)) (Script BearerInfo)
forall k a. Map k a
Map.empty
((Snocket m (FD m (TestAddress Int)) (TestAddress Int)
-> m (ObservableNetworkState (TestAddress Int)) -> m Property)
-> m Property)
-> (Snocket m (FD m (TestAddress Int)) (TestAddress Int)
-> m (ObservableNetworkState (TestAddress Int)) -> m Property)
-> m Property
forall a b. (a -> b) -> a -> b
$ \Snocket m (FD m (TestAddress Int)) (TestAddress Int)
sn m (ObservableNetworkState (TestAddress Int))
_ -> do
let addr, addr' :: TestAddress Int
addr :: TestAddress Int
addr = Int -> TestAddress Int
forall addr. addr -> TestAddress addr
Snocket.TestAddress Int
1
addr' :: TestAddress Int
addr' = Int -> TestAddress Int
forall addr. addr -> TestAddress addr
Snocket.TestAddress Int
2
m (FD m (TestAddress Int))
-> (FD m (TestAddress Int) -> m ())
-> (FD m (TestAddress Int) -> m Property)
-> m Property
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 (Snocket m (FD m (TestAddress Int)) (TestAddress Int)
-> AddressFamily (TestAddress Int) -> m (FD m (TestAddress Int))
forall (m :: * -> *) fd addr.
Snocket m fd addr -> AddressFamily addr -> m fd
Snocket.open Snocket m (FD m (TestAddress Int)) (TestAddress Int)
sn AddressFamily (TestAddress Int)
forall addr1. AddressFamily (TestAddress addr1)
Snocket.TestFamily)
(Snocket m (FD m (TestAddress Int)) (TestAddress Int)
-> FD m (TestAddress Int) -> m ()
forall (m :: * -> *) fd addr. Snocket m fd addr -> fd -> m ()
Snocket.close Snocket m (FD m (TestAddress Int)) (TestAddress Int)
sn) ((FD m (TestAddress Int) -> m Property) -> m Property)
-> (FD m (TestAddress Int) -> m Property) -> m Property
forall a b. (a -> b) -> a -> b
$ \FD m (TestAddress Int)
fdLst ->
m (FD m (TestAddress Int))
-> (FD m (TestAddress Int) -> m ())
-> (FD m (TestAddress Int) -> m Property)
-> m Property
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 (Snocket m (FD m (TestAddress Int)) (TestAddress Int)
-> AddressFamily (TestAddress Int) -> m (FD m (TestAddress Int))
forall (m :: * -> *) fd addr.
Snocket m fd addr -> AddressFamily addr -> m fd
Snocket.open Snocket m (FD m (TestAddress Int)) (TestAddress Int)
sn AddressFamily (TestAddress Int)
forall addr1. AddressFamily (TestAddress addr1)
Snocket.TestFamily)
(Snocket m (FD m (TestAddress Int)) (TestAddress Int)
-> FD m (TestAddress Int) -> m ()
forall (m :: * -> *) fd addr. Snocket m fd addr -> fd -> m ()
Snocket.close Snocket m (FD m (TestAddress Int)) (TestAddress Int)
sn) ((FD m (TestAddress Int) -> m Property) -> m Property)
-> (FD m (TestAddress Int) -> m Property) -> m Property
forall a b. (a -> b) -> a -> b
$ \FD m (TestAddress Int)
fdLst' -> do
Snocket m (FD m (TestAddress Int)) (TestAddress Int)
-> FD m (TestAddress Int) -> TestAddress Int -> m ()
forall (m :: * -> *) fd addr.
Snocket m fd addr -> fd -> addr -> m ()
Snocket.bind Snocket m (FD m (TestAddress Int)) (TestAddress Int)
sn FD m (TestAddress Int)
fdLst TestAddress Int
addr
Snocket m (FD m (TestAddress Int)) (TestAddress Int)
-> FD m (TestAddress Int) -> TestAddress Int -> m ()
forall (m :: * -> *) fd addr.
Snocket m fd addr -> fd -> addr -> m ()
Snocket.bind Snocket m (FD m (TestAddress Int)) (TestAddress Int)
sn FD m (TestAddress Int)
fdLst' TestAddress Int
addr'
Snocket m (FD m (TestAddress Int)) (TestAddress Int)
-> FD m (TestAddress Int) -> m ()
forall (m :: * -> *) fd addr. Snocket m fd addr -> fd -> m ()
Snocket.listen Snocket m (FD m (TestAddress Int)) (TestAddress Int)
sn FD m (TestAddress Int)
fdLst
Snocket m (FD m (TestAddress Int)) (TestAddress Int)
-> FD m (TestAddress Int) -> m ()
forall (m :: * -> *) fd addr. Snocket m fd addr -> fd -> m ()
Snocket.listen Snocket m (FD m (TestAddress Int)) (TestAddress Int)
sn FD m (TestAddress Int)
fdLst'
m (FD m (TestAddress Int), FD m (TestAddress Int))
-> ((FD m (TestAddress Int), FD m (TestAddress Int)) -> m ())
-> ((FD m (TestAddress Int), FD m (TestAddress Int)) -> m Property)
-> m Property
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 ((,) (FD m (TestAddress Int)
-> FD m (TestAddress Int)
-> (FD m (TestAddress Int), FD m (TestAddress Int)))
-> m (FD m (TestAddress Int))
-> m (FD m (TestAddress Int)
-> (FD m (TestAddress Int), FD m (TestAddress Int)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Snocket m (FD m (TestAddress Int)) (TestAddress Int)
-> AddressFamily (TestAddress Int) -> m (FD m (TestAddress Int))
forall (m :: * -> *) fd addr.
Snocket m fd addr -> AddressFamily addr -> m fd
Snocket.open Snocket m (FD m (TestAddress Int)) (TestAddress Int)
sn AddressFamily (TestAddress Int)
forall addr1. AddressFamily (TestAddress addr1)
Snocket.TestFamily
m (FD m (TestAddress Int)
-> (FD m (TestAddress Int), FD m (TestAddress Int)))
-> m (FD m (TestAddress Int))
-> m (FD m (TestAddress Int), FD m (TestAddress Int))
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Snocket m (FD m (TestAddress Int)) (TestAddress Int)
-> AddressFamily (TestAddress Int) -> m (FD m (TestAddress Int))
forall (m :: * -> *) fd addr.
Snocket m fd addr -> AddressFamily addr -> m fd
Snocket.open Snocket m (FD m (TestAddress Int)) (TestAddress Int)
sn AddressFamily (TestAddress Int)
forall addr1. AddressFamily (TestAddress addr1)
Snocket.TestFamily
)
(\(FD m (TestAddress Int)
fdConn, FD m (TestAddress Int)
fdConn') ->
Snocket m (FD m (TestAddress Int)) (TestAddress Int)
-> FD m (TestAddress Int) -> m ()
forall (m :: * -> *) fd addr. Snocket m fd addr -> fd -> m ()
Snocket.close Snocket m (FD m (TestAddress Int)) (TestAddress Int)
sn FD m (TestAddress Int)
fdConn
m () -> m () -> m ()
forall a b. m a -> m b -> m ()
forall (m :: * -> *) a b. MonadAsync m => m a -> m b -> m ()
`concurrently_`
Snocket m (FD m (TestAddress Int)) (TestAddress Int)
-> FD m (TestAddress Int) -> m ()
forall (m :: * -> *) fd addr. Snocket m fd addr -> fd -> m ()
Snocket.close Snocket m (FD m (TestAddress Int)) (TestAddress Int)
sn FD m (TestAddress Int)
fdConn'
) (((FD m (TestAddress Int), FD m (TestAddress Int)) -> m Property)
-> m Property)
-> ((FD m (TestAddress Int), FD m (TestAddress Int)) -> m Property)
-> m Property
forall a b. (a -> b) -> a -> b
$ \(FD m (TestAddress Int)
fdConn, FD m (TestAddress Int)
fdConn') -> do
Snocket m (FD m (TestAddress Int)) (TestAddress Int)
-> FD m (TestAddress Int) -> TestAddress Int -> m ()
forall (m :: * -> *) fd addr.
Snocket m fd addr -> fd -> addr -> m ()
Snocket.bind Snocket m (FD m (TestAddress Int)) (TestAddress Int)
sn FD m (TestAddress Int)
fdConn TestAddress Int
addr
Snocket m (FD m (TestAddress Int)) (TestAddress Int)
-> FD m (TestAddress Int) -> TestAddress Int -> m ()
forall (m :: * -> *) fd addr.
Snocket m fd addr -> fd -> addr -> m ()
Snocket.bind Snocket m (FD m (TestAddress Int)) (TestAddress Int)
sn FD m (TestAddress Int)
fdConn' TestAddress Int
addr'
m () -> m () -> m ()
forall a b. m a -> m b -> m ()
forall (m :: * -> *) a b. MonadAsync m => m a -> m b -> m ()
concurrently_
(Snocket m (FD m (TestAddress Int)) (TestAddress Int)
-> FD m (TestAddress Int) -> TestAddress Int -> m ()
forall (m :: * -> *) fd addr.
Snocket m fd addr -> fd -> addr -> m ()
Snocket.connect Snocket m (FD m (TestAddress Int)) (TestAddress Int)
sn FD m (TestAddress Int)
fdConn TestAddress Int
addr')
(Snocket m (FD m (TestAddress Int)) (TestAddress Int)
-> FD m (TestAddress Int) -> TestAddress Int -> m ()
forall (m :: * -> *) fd addr.
Snocket m fd addr -> fd -> addr -> m ()
Snocket.connect Snocket m (FD m (TestAddress Int)) (TestAddress Int)
sn FD m (TestAddress Int)
fdConn' TestAddress Int
addr)
bearer <- MakeBearer m (FD m (TestAddress Int))
-> DiffTime
-> Tracer m Trace
-> FD m (TestAddress Int)
-> m (Bearer m)
forall (m :: * -> *) fd.
MakeBearer m fd -> DiffTime -> Tracer m Trace -> fd -> m (Bearer m)
Mx.getBearer MakeBearer m (FD m (TestAddress Int))
forall addr (m :: * -> *).
(MonadMonotonicTime m, MonadSTM m, MonadThrow m, Show addr) =>
MakeBearer m (FD m (TestAddress addr))
makeFDBearer
DiffTime
1
Tracer m Trace
forall (m :: * -> *) a. Applicative m => Tracer m a
nullTracer
FD m (TestAddress Int)
fdConn
bearer' <- Mx.getBearer makeFDBearer
1
nullTracer
fdConn'
let chann = Bearer m -> MiniProtocolNum -> MiniProtocolDir -> ByteChannel m
forall (m :: * -> *).
Functor m =>
Bearer m -> MiniProtocolNum -> MiniProtocolDir -> ByteChannel m
bearerAsChannel Bearer m
bearer (Word16 -> MiniProtocolNum
MiniProtocolNum Word16
0) MiniProtocolDir
InitiatorDir
chann' = Bearer m -> MiniProtocolNum -> MiniProtocolDir -> ByteChannel m
forall (m :: * -> *).
Functor m =>
Bearer m -> MiniProtocolNum -> MiniProtocolDir -> ByteChannel m
bearerAsChannel Bearer m
bearer' (Word16 -> MiniProtocolNum
MiniProtocolNum Word16
0) MiniProtocolDir
InitiatorDir
res <- prop_channel_simultaneous_open
(pure (chann, chann'))
codec
versionDataCodec
clientVersions
serverVersions
return res
prop_channel_simultaneous_open_SimNet :: ArbitraryVersions
-> Property
prop_channel_simultaneous_open_SimNet :: ArbitraryVersions -> Property
prop_channel_simultaneous_open_SimNet
(ArbitraryVersions Versions VersionNumber VersionData Bool
clientVersions Versions VersionNumber VersionData Bool
serverVersions) =
(forall s. IOSim s Property) -> Property
forall a. (forall s. IOSim s a) -> a
runSimOrThrow ((forall s. IOSim s Property) -> Property)
-> (forall s. IOSim s Property) -> Property
forall a b. (a -> b) -> a -> b
$ Codec
(Handshake VersionNumber Term)
DeserialiseFailure
(IOSim s)
ByteString
-> VersionDataCodec Term VersionNumber VersionData
-> Versions VersionNumber VersionData Bool
-> Versions VersionNumber VersionData Bool
-> IOSim s Property
forall vNumber vData (m :: * -> *).
(Alternative (STM m), MonadAsync m, MonadCatch m, MonadDelay m,
MonadFork m, MonadLabelledSTM m, MonadMask m, MonadMonotonicTime m,
MonadST m, MonadThrow (STM m), MonadTime m, MonadTimer m,
Acceptable vData, Ord vNumber) =>
Codec (Handshake vNumber Term) DeserialiseFailure m ByteString
-> VersionDataCodec Term vNumber vData
-> Versions vNumber vData Bool
-> Versions vNumber vData Bool
-> m Property
prop_channel_simultaneous_open_sim
Codec
(Handshake VersionNumber Term)
DeserialiseFailure
(IOSim s)
ByteString
forall (m :: * -> *).
(MonadST m, MonadThrow m) =>
Codec
(Handshake VersionNumber Term) DeserialiseFailure m ByteString
versionNumberHandshakeCodec
((VersionNumber -> CodecCBORTerm Text VersionData)
-> VersionDataCodec Term VersionNumber VersionData
forall vNumber vData.
(vNumber -> CodecCBORTerm Text vData)
-> VersionDataCodec Term vNumber vData
cborTermVersionDataCodec VersionNumber -> CodecCBORTerm Text VersionData
dataCodecCBORTerm)
Versions VersionNumber VersionData Bool
clientVersions
Versions VersionNumber VersionData Bool
serverVersions
prop_channel_simultaneous_open_NodeToNode_SimNet :: ArbitraryNodeToNodeVersions
-> ArbitraryNodeToNodeVersions
-> Property
prop_channel_simultaneous_open_NodeToNode_SimNet :: ArbitraryNodeToNodeVersions
-> ArbitraryNodeToNodeVersions -> Property
prop_channel_simultaneous_open_NodeToNode_SimNet
(ArbitraryNodeToNodeVersions Versions NodeToNodeVersion ArbitraryNodeToNodeVersionData Bool
clientVersions)
(ArbitraryNodeToNodeVersions Versions NodeToNodeVersion ArbitraryNodeToNodeVersionData Bool
serverVersions) =
(forall s. IOSim s Property) -> Property
forall a. (forall s. IOSim s a) -> a
runSimOrThrow ((forall s. IOSim s Property) -> Property)
-> (forall s. IOSim s Property) -> Property
forall a b. (a -> b) -> a -> b
$ Codec
(Handshake NodeToNodeVersion Term)
DeserialiseFailure
(IOSim s)
ByteString
-> VersionDataCodec
Term NodeToNodeVersion ArbitraryNodeToNodeVersionData
-> Versions NodeToNodeVersion ArbitraryNodeToNodeVersionData Bool
-> Versions NodeToNodeVersion ArbitraryNodeToNodeVersionData Bool
-> IOSim s Property
forall vNumber vData (m :: * -> *).
(Alternative (STM m), MonadAsync m, MonadCatch m, MonadDelay m,
MonadFork m, MonadLabelledSTM m, MonadMask m, MonadMonotonicTime m,
MonadST m, MonadThrow (STM m), MonadTime m, MonadTimer m,
Acceptable vData, Ord vNumber) =>
Codec (Handshake vNumber Term) DeserialiseFailure m ByteString
-> VersionDataCodec Term vNumber vData
-> Versions vNumber vData Bool
-> Versions vNumber vData Bool
-> m Property
prop_channel_simultaneous_open_sim
(CodecCBORTerm (Text, Maybe Int) NodeToNodeVersion
-> Codec
(Handshake NodeToNodeVersion Term)
DeserialiseFailure
(IOSim s)
ByteString
forall vNumber (m :: * -> *) failure.
(MonadST m, Ord vNumber, Show failure) =>
CodecCBORTerm (failure, Maybe Int) vNumber
-> Codec (Handshake vNumber Term) DeserialiseFailure m ByteString
codecHandshake CodecCBORTerm (Text, Maybe Int) NodeToNodeVersion
nodeToNodeVersionCodec)
((NodeToNodeVersion
-> CodecCBORTerm Text ArbitraryNodeToNodeVersionData)
-> VersionDataCodec
Term NodeToNodeVersion ArbitraryNodeToNodeVersionData
forall vNumber vData.
(vNumber -> CodecCBORTerm Text vData)
-> VersionDataCodec Term vNumber vData
cborTermVersionDataCodec ((CodecCBORTerm Text NodeToNodeVersionData
-> CodecCBORTerm Text ArbitraryNodeToNodeVersionData)
-> (NodeToNodeVersion -> CodecCBORTerm Text NodeToNodeVersionData)
-> NodeToNodeVersion
-> CodecCBORTerm Text ArbitraryNodeToNodeVersionData
forall a b.
(a -> b) -> (NodeToNodeVersion -> a) -> NodeToNodeVersion -> b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap CodecCBORTerm Text NodeToNodeVersionData
-> CodecCBORTerm Text ArbitraryNodeToNodeVersionData
transformNodeToNodeVersionData NodeToNodeVersion -> CodecCBORTerm Text NodeToNodeVersionData
nodeToNodeCodecCBORTerm))
Versions NodeToNodeVersion ArbitraryNodeToNodeVersionData Bool
clientVersions
Versions NodeToNodeVersion ArbitraryNodeToNodeVersionData Bool
serverVersions
prop_channel_simultaneous_open_NodeToClient_SimNet :: ArbitraryNodeToClientVersions
-> ArbitraryNodeToClientVersions
-> Property
prop_channel_simultaneous_open_NodeToClient_SimNet :: ArbitraryNodeToClientVersions
-> ArbitraryNodeToClientVersions -> Property
prop_channel_simultaneous_open_NodeToClient_SimNet
(ArbitraryNodeToClientVersions Versions NodeToClientVersion NodeToClientVersionData Bool
clientVersions)
(ArbitraryNodeToClientVersions Versions NodeToClientVersion NodeToClientVersionData Bool
serverVersions) =
(forall s. IOSim s Property) -> Property
forall a. (forall s. IOSim s a) -> a
runSimOrThrow ((forall s. IOSim s Property) -> Property)
-> (forall s. IOSim s Property) -> Property
forall a b. (a -> b) -> a -> b
$ Codec
(Handshake NodeToClientVersion Term)
DeserialiseFailure
(IOSim s)
ByteString
-> VersionDataCodec
Term NodeToClientVersion NodeToClientVersionData
-> Versions NodeToClientVersion NodeToClientVersionData Bool
-> Versions NodeToClientVersion NodeToClientVersionData Bool
-> IOSim s Property
forall vNumber vData (m :: * -> *).
(Alternative (STM m), MonadAsync m, MonadCatch m, MonadDelay m,
MonadFork m, MonadLabelledSTM m, MonadMask m, MonadMonotonicTime m,
MonadST m, MonadThrow (STM m), MonadTime m, MonadTimer m,
Acceptable vData, Ord vNumber) =>
Codec (Handshake vNumber Term) DeserialiseFailure m ByteString
-> VersionDataCodec Term vNumber vData
-> Versions vNumber vData Bool
-> Versions vNumber vData Bool
-> m Property
prop_channel_simultaneous_open_sim
(CodecCBORTerm (Text, Maybe Int) NodeToClientVersion
-> Codec
(Handshake NodeToClientVersion Term)
DeserialiseFailure
(IOSim s)
ByteString
forall vNumber (m :: * -> *) failure.
(MonadST m, Ord vNumber, Show failure) =>
CodecCBORTerm (failure, Maybe Int) vNumber
-> Codec (Handshake vNumber Term) DeserialiseFailure m ByteString
codecHandshake CodecCBORTerm (Text, Maybe Int) NodeToClientVersion
nodeToClientVersionCodec)
((NodeToClientVersion -> CodecCBORTerm Text NodeToClientVersionData)
-> VersionDataCodec
Term NodeToClientVersion NodeToClientVersionData
forall vNumber vData.
(vNumber -> CodecCBORTerm Text vData)
-> VersionDataCodec Term vNumber vData
cborTermVersionDataCodec NodeToClientVersion -> CodecCBORTerm Text NodeToClientVersionData
nodeToClientCodecCBORTerm)
Versions NodeToClientVersion NodeToClientVersionData Bool
clientVersions
Versions NodeToClientVersion NodeToClientVersionData Bool
serverVersions
instance Eq (AnyMessage (Handshake VersionNumber CBOR.Term)) where
AnyMessage (MsgProposeVersions Map vNumber1 vParams1
vs) == :: AnyMessage (Handshake VersionNumber Term)
-> AnyMessage (Handshake VersionNumber Term) -> Bool
== AnyMessage (MsgProposeVersions Map vNumber1 vParams1
vs')
= Map vNumber1 vParams1
vs Map vNumber1 vParams1 -> Map vNumber1 vParams1 -> Bool
forall a. Eq a => a -> a -> Bool
== Map vNumber1 vParams1
Map vNumber1 vParams1
vs'
AnyMessage (MsgReplyVersions Map vNumber1 vParams1
vs) == AnyMessage (MsgReplyVersions Map vNumber1 vParams1
vs')
= Map vNumber1 vParams1
vs Map vNumber1 vParams1 -> Map vNumber1 vParams1 -> Bool
forall a. Eq a => a -> a -> Bool
== Map vNumber1 vParams1
Map vNumber1 vParams1
vs'
AnyMessage (MsgAcceptVersion vNumber1
vNumber vParams1
vParams) == AnyMessage (MsgAcceptVersion vNumber1
vNumber' vParams1
vParams')
= vNumber1
vNumber vNumber1 -> vNumber1 -> Bool
forall a. Eq a => a -> a -> Bool
== vNumber1
vNumber1
vNumber' Bool -> Bool -> Bool
&& vParams1
vParams vParams1 -> vParams1 -> Bool
forall a. Eq a => a -> a -> Bool
== vParams1
vParams1
vParams'
AnyMessage (MsgRefuse RefuseReason vNumber1
vReason) == AnyMessage (MsgRefuse RefuseReason vNumber1
vReason')
= RefuseReason vNumber1
vReason RefuseReason vNumber1 -> RefuseReason vNumber1 -> Bool
forall a. Eq a => a -> a -> Bool
== RefuseReason vNumber1
RefuseReason vNumber1
vReason'
AnyMessage (Handshake VersionNumber Term)
_ == AnyMessage (Handshake VersionNumber Term)
_ = Bool
False
instance Arbitrary (AnyMessage (Handshake VersionNumber CBOR.Term)) where
arbitrary :: Gen (AnyMessage (Handshake VersionNumber Term))
arbitrary = [Gen (AnyMessage (Handshake VersionNumber Term))]
-> Gen (AnyMessage (Handshake VersionNumber Term))
forall a. [Gen a] -> Gen a
oneof
[ Message (Handshake VersionNumber Term) 'StPropose 'StConfirm
-> AnyMessage (Handshake VersionNumber Term)
forall ps (st :: ps) (st' :: ps).
(StateTokenI st, ActiveState st) =>
Message ps st st' -> AnyMessage ps
AnyMessage
(Message (Handshake VersionNumber Term) 'StPropose 'StConfirm
-> AnyMessage (Handshake VersionNumber Term))
-> (Versions VersionNumber VersionData Bool
-> Message (Handshake VersionNumber Term) 'StPropose 'StConfirm)
-> Versions VersionNumber VersionData Bool
-> AnyMessage (Handshake VersionNumber Term)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map VersionNumber Term
-> Message (Handshake VersionNumber Term) 'StPropose 'StConfirm
forall vNumber1 vParams1.
Map vNumber1 vParams1
-> Message (Handshake vNumber1 vParams1) 'StPropose 'StConfirm
MsgProposeVersions
(Map VersionNumber Term
-> Message (Handshake VersionNumber Term) 'StPropose 'StConfirm)
-> (Versions VersionNumber VersionData Bool
-> Map VersionNumber Term)
-> Versions VersionNumber VersionData Bool
-> Message (Handshake VersionNumber Term) 'StPropose 'StConfirm
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (VersionNumber -> Version VersionData Bool -> Term)
-> Map VersionNumber (Version VersionData Bool)
-> Map VersionNumber Term
forall k a b. (k -> a -> b) -> Map k a -> Map k b
Map.mapWithKey (\VersionNumber
v -> CodecCBORTerm Text VersionData -> VersionData -> Term
forall fail a. CodecCBORTerm fail a -> a -> Term
encodeTerm (VersionNumber -> CodecCBORTerm Text VersionData
dataCodecCBORTerm VersionNumber
v) (VersionData -> Term)
-> (Version VersionData Bool -> VersionData)
-> Version VersionData Bool
-> Term
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Version VersionData Bool -> VersionData
forall vData r. Version vData r -> vData
versionData)
(Map VersionNumber (Version VersionData Bool)
-> Map VersionNumber Term)
-> (Versions VersionNumber VersionData Bool
-> Map VersionNumber (Version VersionData Bool))
-> Versions VersionNumber VersionData Bool
-> Map VersionNumber Term
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Versions VersionNumber VersionData Bool
-> Map VersionNumber (Version VersionData Bool)
forall vNum vData r.
Versions vNum vData r -> Map vNum (Version vData r)
getVersions
(Versions VersionNumber VersionData Bool
-> AnyMessage (Handshake VersionNumber Term))
-> Gen (Versions VersionNumber VersionData Bool)
-> Gen (AnyMessage (Handshake VersionNumber Term))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (Versions VersionNumber VersionData Bool)
genVersions
, Message (Handshake VersionNumber Term) 'StConfirm 'StDone
-> AnyMessage (Handshake VersionNumber Term)
forall ps (st :: ps) (st' :: ps).
(StateTokenI st, ActiveState st) =>
Message ps st st' -> AnyMessage ps
AnyMessage
(Message (Handshake VersionNumber Term) 'StConfirm 'StDone
-> AnyMessage (Handshake VersionNumber Term))
-> (Versions VersionNumber VersionData Bool
-> Message (Handshake VersionNumber Term) 'StConfirm 'StDone)
-> Versions VersionNumber VersionData Bool
-> AnyMessage (Handshake VersionNumber Term)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map VersionNumber Term
-> Message (Handshake VersionNumber Term) 'StConfirm 'StDone
forall vNumber1 vParams1.
Map vNumber1 vParams1
-> Message (Handshake vNumber1 vParams1) 'StConfirm 'StDone
MsgReplyVersions
(Map VersionNumber Term
-> Message (Handshake VersionNumber Term) 'StConfirm 'StDone)
-> (Versions VersionNumber VersionData Bool
-> Map VersionNumber Term)
-> Versions VersionNumber VersionData Bool
-> Message (Handshake VersionNumber Term) 'StConfirm 'StDone
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (VersionNumber -> Version VersionData Bool -> Term)
-> Map VersionNumber (Version VersionData Bool)
-> Map VersionNumber Term
forall k a b. (k -> a -> b) -> Map k a -> Map k b
Map.mapWithKey (\VersionNumber
v -> CodecCBORTerm Text VersionData -> VersionData -> Term
forall fail a. CodecCBORTerm fail a -> a -> Term
encodeTerm (VersionNumber -> CodecCBORTerm Text VersionData
dataCodecCBORTerm VersionNumber
v) (VersionData -> Term)
-> (Version VersionData Bool -> VersionData)
-> Version VersionData Bool
-> Term
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Version VersionData Bool -> VersionData
forall vData r. Version vData r -> vData
versionData)
(Map VersionNumber (Version VersionData Bool)
-> Map VersionNumber Term)
-> (Versions VersionNumber VersionData Bool
-> Map VersionNumber (Version VersionData Bool))
-> Versions VersionNumber VersionData Bool
-> Map VersionNumber Term
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Versions VersionNumber VersionData Bool
-> Map VersionNumber (Version VersionData Bool)
forall vNum vData r.
Versions vNum vData r -> Map vNum (Version vData r)
getVersions
(Versions VersionNumber VersionData Bool
-> AnyMessage (Handshake VersionNumber Term))
-> Gen (Versions VersionNumber VersionData Bool)
-> Gen (AnyMessage (Handshake VersionNumber Term))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (Versions VersionNumber VersionData Bool)
genVersions
, Message (Handshake VersionNumber Term) 'StConfirm 'StDone
-> AnyMessage (Handshake VersionNumber Term)
forall ps (st :: ps) (st' :: ps).
(StateTokenI st, ActiveState st) =>
Message ps st st' -> AnyMessage ps
AnyMessage
(Message (Handshake VersionNumber Term) 'StConfirm 'StDone
-> AnyMessage (Handshake VersionNumber Term))
-> ((VersionNumber, Term)
-> Message (Handshake VersionNumber Term) 'StConfirm 'StDone)
-> (VersionNumber, Term)
-> AnyMessage (Handshake VersionNumber Term)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (VersionNumber
-> Term
-> Message (Handshake VersionNumber Term) 'StConfirm 'StDone)
-> (VersionNumber, Term)
-> Message (Handshake VersionNumber Term) 'StConfirm 'StDone
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry VersionNumber
-> Term
-> Message (Handshake VersionNumber Term) 'StConfirm 'StDone
forall vNumber1 vParams1.
vNumber1
-> vParams1
-> Message (Handshake vNumber1 vParams1) 'StConfirm 'StDone
MsgAcceptVersion
((VersionNumber, Term)
-> AnyMessage (Handshake VersionNumber Term))
-> Gen (VersionNumber, Term)
-> Gen (AnyMessage (Handshake VersionNumber Term))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (VersionNumber, Term)
genValidVersion'
, Message (Handshake VersionNumber Term) 'StConfirm 'StDone
-> AnyMessage (Handshake VersionNumber Term)
forall ps (st :: ps) (st' :: ps).
(StateTokenI st, ActiveState st) =>
Message ps st st' -> AnyMessage ps
AnyMessage
(Message (Handshake VersionNumber Term) 'StConfirm 'StDone
-> AnyMessage (Handshake VersionNumber Term))
-> (ArbitraryRefuseReason
-> Message (Handshake VersionNumber Term) 'StConfirm 'StDone)
-> ArbitraryRefuseReason
-> AnyMessage (Handshake VersionNumber Term)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RefuseReason VersionNumber
-> Message (Handshake VersionNumber Term) 'StConfirm 'StDone
forall {k1} vNumber1 (vParams :: k1).
RefuseReason vNumber1
-> Message (Handshake vNumber1 vParams) 'StConfirm 'StDone
MsgRefuse
(RefuseReason VersionNumber
-> Message (Handshake VersionNumber Term) 'StConfirm 'StDone)
-> (ArbitraryRefuseReason -> RefuseReason VersionNumber)
-> ArbitraryRefuseReason
-> Message (Handshake VersionNumber Term) 'StConfirm 'StDone
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ArbitraryRefuseReason -> RefuseReason VersionNumber
runArbitraryRefuseReason
(ArbitraryRefuseReason
-> AnyMessage (Handshake VersionNumber Term))
-> Gen ArbitraryRefuseReason
-> Gen (AnyMessage (Handshake VersionNumber Term))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen ArbitraryRefuseReason
forall a. Arbitrary a => Gen a
arbitrary
]
where
genValidVersion' :: Gen (VersionNumber, CBOR.Term)
genValidVersion' :: Gen (VersionNumber, Term)
genValidVersion' = do
vn <- Gen VersionNumber
forall a. Arbitrary a => Gen a
arbitrary
Version _ vData <- genValidVersion vn
pure (vn, encodeTerm (dataCodecCBORTerm vn) vData)
newtype ArbitraryRefuseReason = ArbitraryRefuseReason {
ArbitraryRefuseReason -> RefuseReason VersionNumber
runArbitraryRefuseReason :: RefuseReason VersionNumber
}
deriving (ArbitraryRefuseReason -> ArbitraryRefuseReason -> Bool
(ArbitraryRefuseReason -> ArbitraryRefuseReason -> Bool)
-> (ArbitraryRefuseReason -> ArbitraryRefuseReason -> Bool)
-> Eq ArbitraryRefuseReason
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ArbitraryRefuseReason -> ArbitraryRefuseReason -> Bool
== :: ArbitraryRefuseReason -> ArbitraryRefuseReason -> Bool
$c/= :: ArbitraryRefuseReason -> ArbitraryRefuseReason -> Bool
/= :: ArbitraryRefuseReason -> ArbitraryRefuseReason -> Bool
Eq, Int -> ArbitraryRefuseReason -> ShowS
[ArbitraryRefuseReason] -> ShowS
ArbitraryRefuseReason -> String
(Int -> ArbitraryRefuseReason -> ShowS)
-> (ArbitraryRefuseReason -> String)
-> ([ArbitraryRefuseReason] -> ShowS)
-> Show ArbitraryRefuseReason
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ArbitraryRefuseReason -> ShowS
showsPrec :: Int -> ArbitraryRefuseReason -> ShowS
$cshow :: ArbitraryRefuseReason -> String
show :: ArbitraryRefuseReason -> String
$cshowList :: [ArbitraryRefuseReason] -> ShowS
showList :: [ArbitraryRefuseReason] -> ShowS
Show)
instance Arbitrary ArbitraryRefuseReason where
arbitrary :: Gen ArbitraryRefuseReason
arbitrary = RefuseReason VersionNumber -> ArbitraryRefuseReason
ArbitraryRefuseReason (RefuseReason VersionNumber -> ArbitraryRefuseReason)
-> Gen (RefuseReason VersionNumber) -> Gen ArbitraryRefuseReason
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Gen (RefuseReason VersionNumber)]
-> Gen (RefuseReason VersionNumber)
forall a. [Gen a] -> Gen a
oneof
[ [VersionNumber] -> [Int] -> RefuseReason VersionNumber
forall vNumber. [vNumber] -> [Int] -> RefuseReason vNumber
VersionMismatch
([VersionNumber] -> [Int] -> RefuseReason VersionNumber)
-> Gen [VersionNumber] -> Gen ([Int] -> RefuseReason VersionNumber)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen [VersionNumber]
forall a. Arbitrary a => Gen a
arbitrary
Gen ([Int] -> RefuseReason VersionNumber)
-> Gen [Int] -> Gen (RefuseReason VersionNumber)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [Int] -> Gen [Int]
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
, VersionNumber -> Text -> RefuseReason VersionNumber
forall vNumber. vNumber -> Text -> RefuseReason vNumber
HandshakeDecodeError (VersionNumber -> Text -> RefuseReason VersionNumber)
-> Gen VersionNumber -> Gen (Text -> RefuseReason VersionNumber)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen VersionNumber
forall a. Arbitrary a => Gen a
arbitrary Gen (Text -> RefuseReason VersionNumber)
-> Gen Text -> Gen (RefuseReason VersionNumber)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen Text
arbitraryText
, VersionNumber -> Text -> RefuseReason VersionNumber
forall vNumber. vNumber -> Text -> RefuseReason vNumber
Refused (VersionNumber -> Text -> RefuseReason VersionNumber)
-> Gen VersionNumber -> Gen (Text -> RefuseReason VersionNumber)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen VersionNumber
forall a. Arbitrary a => Gen a
arbitrary Gen (Text -> RefuseReason VersionNumber)
-> Gen Text -> Gen (RefuseReason VersionNumber)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen Text
arbitraryText
]
where
arbitraryText :: Gen Text
arbitraryText = String -> Text
T.pack (String -> Text) -> Gen String -> Gen Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen String
forall a. Arbitrary a => Gen a
arbitrary
prop_codec_RefuseReason
:: ArbitraryRefuseReason
-> Bool
prop_codec_RefuseReason :: ArbitraryRefuseReason -> Bool
prop_codec_RefuseReason (ArbitraryRefuseReason RefuseReason VersionNumber
vReason) =
case (forall s. Decoder s (RefuseReason VersionNumber))
-> ByteString
-> Either
DeserialiseFailure (ByteString, RefuseReason VersionNumber)
forall a.
(forall s. Decoder s a)
-> ByteString -> Either DeserialiseFailure (ByteString, a)
CBOR.deserialiseFromBytes
(CodecCBORTerm (String, Maybe Int) VersionNumber
-> Decoder s (RefuseReason VersionNumber)
forall failure vNumber s.
Show failure =>
CodecCBORTerm (failure, Maybe Int) vNumber
-> Decoder s (RefuseReason vNumber)
decodeRefuseReason CodecCBORTerm (String, Maybe Int) VersionNumber
versionNumberCodec)
(Encoding -> ByteString
CBOR.toLazyByteString (Encoding -> ByteString) -> Encoding -> ByteString
forall a b. (a -> b) -> a -> b
$ CodecCBORTerm (String, Maybe Int) VersionNumber
-> RefuseReason VersionNumber -> Encoding
forall fail vNumber.
CodecCBORTerm fail vNumber -> RefuseReason vNumber -> Encoding
encodeRefuseReason CodecCBORTerm (String, Maybe Int) VersionNumber
versionNumberCodec RefuseReason VersionNumber
vReason) of
Left DeserialiseFailure
_ -> Bool
False
Right (ByteString
bytes, RefuseReason VersionNumber
vReason') -> ByteString -> Bool
BL.null ByteString
bytes Bool -> Bool -> Bool
&& RefuseReason VersionNumber
vReason' RefuseReason VersionNumber -> RefuseReason VersionNumber -> Bool
forall a. Eq a => a -> a -> Bool
== RefuseReason VersionNumber
vReason
prop_codec_Handshake
:: AnyMessage (Handshake VersionNumber CBOR.Term)
-> Bool
prop_codec_Handshake :: AnyMessage (Handshake VersionNumber Term) -> Bool
prop_codec_Handshake AnyMessage (Handshake VersionNumber Term)
msg =
(forall s. IOSim s Bool) -> Bool
forall a. (forall s. IOSim s a) -> a
runSimOrThrow (Codec
(Handshake VersionNumber Term)
DeserialiseFailure
(IOSim s)
ByteString
-> AnyMessage (Handshake VersionNumber Term) -> IOSim s Bool
forall ps failure (m :: * -> *) bytes.
(Monad m, Eq (AnyMessage ps)) =>
Codec ps failure m bytes -> AnyMessage ps -> m Bool
prop_codecM (CodecCBORTerm (String, Maybe Int) VersionNumber
-> Codec
(Handshake VersionNumber Term)
DeserialiseFailure
(IOSim s)
ByteString
forall vNumber (m :: * -> *) failure.
(MonadST m, Ord vNumber, Show failure) =>
CodecCBORTerm (failure, Maybe Int) vNumber
-> Codec (Handshake vNumber Term) DeserialiseFailure m ByteString
codecHandshake CodecCBORTerm (String, Maybe Int) VersionNumber
versionNumberCodec) AnyMessage (Handshake VersionNumber Term)
msg)
prop_codec_splits2_Handshake
:: AnyMessage (Handshake VersionNumber CBOR.Term)
-> Bool
prop_codec_splits2_Handshake :: AnyMessage (Handshake VersionNumber Term) -> Bool
prop_codec_splits2_Handshake AnyMessage (Handshake VersionNumber Term)
msg =
(forall s. IOSim s Bool) -> Bool
forall a. (forall s. IOSim s a) -> a
runSimOrThrow ((ByteString -> [[ByteString]])
-> Codec
(Handshake VersionNumber Term)
DeserialiseFailure
(IOSim s)
ByteString
-> AnyMessage (Handshake VersionNumber Term)
-> IOSim s Bool
forall ps failure (m :: * -> *) bytes.
(Monad m, Eq (AnyMessage ps)) =>
(bytes -> [[bytes]])
-> Codec ps failure m bytes -> AnyMessage ps -> m Bool
prop_codec_splitsM ByteString -> [[ByteString]]
splits2 (CodecCBORTerm (String, Maybe Int) VersionNumber
-> Codec
(Handshake VersionNumber Term)
DeserialiseFailure
(IOSim s)
ByteString
forall vNumber (m :: * -> *) failure.
(MonadST m, Ord vNumber, Show failure) =>
CodecCBORTerm (failure, Maybe Int) vNumber
-> Codec (Handshake vNumber Term) DeserialiseFailure m ByteString
codecHandshake CodecCBORTerm (String, Maybe Int) VersionNumber
versionNumberCodec) AnyMessage (Handshake VersionNumber Term)
msg)
prop_codec_splits3_Handshake
:: AnyMessage (Handshake VersionNumber CBOR.Term)
-> Bool
prop_codec_splits3_Handshake :: AnyMessage (Handshake VersionNumber Term) -> Bool
prop_codec_splits3_Handshake AnyMessage (Handshake VersionNumber Term)
msg =
(forall s. IOSim s Bool) -> Bool
forall a. (forall s. IOSim s a) -> a
runSimOrThrow ((ByteString -> [[ByteString]])
-> Codec
(Handshake VersionNumber Term)
DeserialiseFailure
(IOSim s)
ByteString
-> AnyMessage (Handshake VersionNumber Term)
-> IOSim s Bool
forall ps failure (m :: * -> *) bytes.
(Monad m, Eq (AnyMessage ps)) =>
(bytes -> [[bytes]])
-> Codec ps failure m bytes -> AnyMessage ps -> m Bool
prop_codec_splitsM ByteString -> [[ByteString]]
splits3 (CodecCBORTerm (String, Maybe Int) VersionNumber
-> Codec
(Handshake VersionNumber Term)
DeserialiseFailure
(IOSim s)
ByteString
forall vNumber (m :: * -> *) failure.
(MonadST m, Ord vNumber, Show failure) =>
CodecCBORTerm (failure, Maybe Int) vNumber
-> Codec (Handshake vNumber Term) DeserialiseFailure m ByteString
codecHandshake CodecCBORTerm (String, Maybe Int) VersionNumber
versionNumberCodec) AnyMessage (Handshake VersionNumber Term)
msg)
prop_codec_cbor
:: AnyMessage (Handshake VersionNumber CBOR.Term)
-> Bool
prop_codec_cbor :: AnyMessage (Handshake VersionNumber Term) -> Bool
prop_codec_cbor AnyMessage (Handshake VersionNumber Term)
msg =
(forall s. IOSim s Bool) -> Bool
forall a. (forall s. IOSim s a) -> a
runSimOrThrow (Codec
(Handshake VersionNumber Term)
DeserialiseFailure
(IOSim s)
ByteString
-> AnyMessage (Handshake VersionNumber Term) -> IOSim s Bool
forall ps (m :: * -> *).
Monad m =>
Codec ps DeserialiseFailure m ByteString -> AnyMessage ps -> m Bool
prop_codec_cborM (CodecCBORTerm (String, Maybe Int) VersionNumber
-> Codec
(Handshake VersionNumber Term)
DeserialiseFailure
(IOSim s)
ByteString
forall vNumber (m :: * -> *) failure.
(MonadST m, Ord vNumber, Show failure) =>
CodecCBORTerm (failure, Maybe Int) vNumber
-> Codec (Handshake vNumber Term) DeserialiseFailure m ByteString
codecHandshake CodecCBORTerm (String, Maybe Int) VersionNumber
versionNumberCodec) AnyMessage (Handshake VersionNumber Term)
msg)
prop_codec_valid_cbor
:: AnyMessage (Handshake VersionNumber CBOR.Term)
-> Property
prop_codec_valid_cbor :: AnyMessage (Handshake VersionNumber Term) -> Property
prop_codec_valid_cbor = Codec
(Handshake VersionNumber Term) DeserialiseFailure IO ByteString
-> AnyMessage (Handshake VersionNumber Term) -> Property
forall ps.
Codec ps DeserialiseFailure IO ByteString
-> AnyMessage ps -> Property
prop_codec_valid_cbor_encoding (CodecCBORTerm (String, Maybe Int) VersionNumber
-> Codec
(Handshake VersionNumber Term) DeserialiseFailure IO ByteString
forall vNumber (m :: * -> *) failure.
(MonadST m, Ord vNumber, Show failure) =>
CodecCBORTerm (failure, Maybe Int) vNumber
-> Codec (Handshake vNumber Term) DeserialiseFailure m ByteString
codecHandshake CodecCBORTerm (String, Maybe Int) VersionNumber
versionNumberCodec)