{-# LANGUAGE BangPatterns        #-}
{-# LANGUAGE DeriveGeneric       #-}
{-# LANGUAGE DerivingVia         #-}
{-# LANGUAGE FlexibleContexts    #-}
{-# LANGUAGE FlexibleInstances   #-}
{-# LANGUAGE GADTs               #-}
{-# LANGUAGE NamedFieldPuns      #-}
{-# LANGUAGE PolyKinds           #-}
{-# LANGUAGE ScopedTypeVariables #-}

-- TODO: Needed for PeerSharing arbitrary instance see
-- todo there.
{-# 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 (..),
           muxBearerAsChannel)
import Network.TypedProtocol.Codec
import Network.TypedProtocol.Proofs

import Test.Ouroboros.Network.Testing.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
-> (AnyMessageAndAgency (Handshake VersionNumber Term) -> Bool)
-> TestTree
forall a. Testable a => String -> a -> TestTree
testProperty String
"codec"                 AnyMessageAndAgency (Handshake VersionNumber Term) -> Bool
prop_codec_Handshake
        , String
-> (AnyMessageAndAgency (Handshake VersionNumber Term) -> Bool)
-> TestTree
forall a. Testable a => String -> a -> TestTree
testProperty String
"codec 2-splits"        AnyMessageAndAgency (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
-> (AnyMessageAndAgency (Handshake VersionNumber Term) -> Bool)
-> Property
forall prop. Testable prop => Int -> prop -> Property
withMaxSuccess Int
30
                                               AnyMessageAndAgency (Handshake VersionNumber Term) -> Bool
prop_codec_splits3_Handshake
        , String
-> (AnyMessageAndAgency (Handshake VersionNumber Term) -> Bool)
-> TestTree
forall a. Testable a => String -> a -> TestTree
testProperty String
"codec cbor"            AnyMessageAndAgency (Handshake VersionNumber Term) -> Bool
prop_codec_cbor
        , String
-> (AnyMessageAndAgency (Handshake VersionNumber Term) -> Property)
-> TestTree
forall a. Testable a => String -> a -> TestTree
testProperty String
"codec valid cbor"      AnyMessageAndAgency (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
          ]
        ]
    ]

--
-- Test Versions
--
-- Notes: Associated data are chosen in such a way that a decoder will fail
-- interpreting one of them as the other.  This is done on purpose for testing
-- wrongly encoded data (protocol version & associated version data mismatch)
--

-- |
-- Testing version number
--
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
      -- We are using @CBOR.TInt@ instead of @CBOR.TInteger@, since for small
      -- integers generated by QuickCheck they will be encoded as @TkInt@ and then
      -- are decoded back to @CBOR.TInt@ rather than @COBR.TInteger@.  The same for
      -- other @CodecCBORTerm@ records.
      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

--
-- ProtocolVersion generators
--

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')
     -- we take `&&` (see `acceptableVersions`
     -- below), which is like `*` in Z₂
  Bool -> Bool -> Bool
&& (VersionData -> Bool
dataVersion1 VersionData
d Bool -> Bool -> Bool
forall a. Ord a => a -> a -> Bool
>= VersionData -> Bool
dataVersion1 VersionData
d')
     -- we take `||` (see `acceptableVersions`
     -- below), which is like `+` in Z₂
  Bool -> Bool -> Bool
&& (VersionData -> Bool
dataVersion2 VersionData
d Bool -> Bool -> Bool
forall a. Ord a => a -> a -> Bool
<= VersionData -> Bool
dataVersion2 VersionData
d')

-- |
-- Generate a valid @'ProtocolVersion' 'VersionNumber' r@
--
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


-- |
-- Generate an invalid @'ProtocolVersion' 'VersionNumber' r@.
--
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 ]

-- |
-- Generate valid @Versions@.
--
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

-- |
-- Generate possibly invalid @Versions@.
--
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
    -- TODO: shrink (issue #3407)

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
  ]

-- |
-- Generators for pairs of arbitrary list of versions.
--
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')
      ]


-- |
-- Check if a @'ProtocolVersion' 'VersionNumber' r@ is valid.
--
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')) =
    -- in 75% of cases the intersection is non-empty
    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
$

    -- in 10% of cases the intersection is empty
    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
$

    -- in 25% of cases the common max version is valid
    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
$

    -- in 25% of cases all the versions in @vs'@ are either not in @vs@ or are
    -- not valid
    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

-- | Run a handshake protocol, without going via a channel.
--
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
  'StPropose
  (IOSim s)
  (Either
     (HandshakeProtocolError VersionNumber)
     (HandshakeResult Bool VersionNumber VersionData))
-> Peer
     (Handshake VersionNumber Term)
     (FlipAgency 'AsClient)
     '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) (st :: ps) (m :: * -> *) a b.
(Monad m, Protocol ps) =>
Peer ps pr st m a
-> Peer ps (FlipAgency pr) st m b -> m (a, b, TerminalStates ps)
connect
              (VersionDataCodec Term VersionNumber VersionData
-> (VersionData -> VersionData -> Accept VersionData)
-> Versions VersionNumber VersionData Bool
-> Peer
     (Handshake VersionNumber Term)
     'AsClient
     '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
-> Peer
     (Handshake vNumber Term)
     'AsClient
     '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
-> Peer
     (Handshake VersionNumber Term)
     'AsServer
     '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
-> Peer
     (Handshake vNumber Term)
     'AsServer
     '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 NobodyHasAgency st
R:NobodyHasAgencyHandshakest (*) (*) VersionNumber Term st
TokDone NobodyHasAgency st
R:NobodyHasAgencyHandshakest (*) (*) VersionNumber Term 'StDone
TokDone) ->
           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

--
-- Properties using a channel
--

-- | Run a simple block-fetch client and server using connected channels.
--
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
     'StPropose
     m
     (Either
        (HandshakeProtocolError VersionNumber)
        (HandshakeResult Bool VersionNumber VersionData))
-> Peer
     (Handshake VersionNumber Term)
     (FlipAgency 'AsClient)
     '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 :: * -> *) failure ps bytes (pr :: PeerRole) (st :: ps) a
       b.
(MonadAsync m, MonadCatch m, Show failure,
 forall (st' :: ps). Show (ClientHasAgency st'),
 forall (st' :: ps). Show (ServerHasAgency st'), ShowProxy ps) =>
m (Channel m bytes, Channel m bytes)
-> Tracer m (Role, TraceSendRecv ps)
-> Codec ps failure m bytes
-> Peer ps pr st m a
-> Peer ps (FlipAgency pr) st m b
-> m (a, b)
runConnectedPeers
        m (Channel m ByteString, Channel m ByteString)
createChannels Tracer m (Role, TraceSendRecv (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
     '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
-> Peer
     (Handshake vNumber Term)
     'AsClient
     '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
-> Peer
     (Handshake VersionNumber Term)
     'AsServer
     '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
-> Peer
     (Handshake vNumber Term)
     'AsServer
     '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
        -- both succeeded, we just check that the application (which is
        -- a boolean value) is the one that was put inside 'Version'
        (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

        -- both queried versions
        (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

        -- both failed
        (Left{}, Left{})   -> Bool -> Property
forall prop. Testable prop => prop -> Property
property Bool
True

        -- it should not happen that one protocol succeeds and the other end
        -- fails
        (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


-- | Run 'prop_channel' in the simulation monad.
--
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)


-- | Run 'prop_channel' in the IO monad.
--
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)


-- | Run 'prop_channel' in the IO monad using local pipes.
--
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)

--
-- Asymmetric tests
--


-- | Run a simple handshake client and server using connected channels.
-- The server can only decode a subset of versions send by client.
-- This test is using a fixed server 'Versions' which can only accept
-- a single version 'Version_1' (it cannot decode any other version).
--
prop_channel_asymmetric
    :: ( MonadAsync m
       , MonadCatch m
       , MonadST m
       )
    => m (Channel m ByteString, Channel m ByteString)
    -> Versions VersionNumber VersionData Bool
    -- ^ client versions
    -> m Property
prop_channel_asymmetric :: forall (m :: * -> *).
(MonadAsync m, MonadCatch 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
     'StPropose
     m
     (Either
        (HandshakeProtocolError VersionNumber)
        (HandshakeResult Bool VersionNumber VersionData))
-> Peer
     (Handshake VersionNumber Term)
     (FlipAgency 'AsClient)
     '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 :: * -> *) failure ps bytes (pr :: PeerRole) (st :: ps) a
       b.
(MonadAsync m, MonadCatch m, Show failure,
 forall (st' :: ps). Show (ClientHasAgency st'),
 forall (st' :: ps). Show (ServerHasAgency st'), ShowProxy ps) =>
m (Channel m bytes, Channel m bytes)
-> Tracer m (Role, TraceSendRecv ps)
-> Codec ps failure m bytes
-> Codec ps failure m bytes
-> Peer ps pr st m a
-> Peer ps (FlipAgency pr) 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
     '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
-> Peer
     (Handshake vNumber Term)
     'AsClient
     '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
-> Peer
     (Handshake VersionNumber Term)
     'AsServer
     '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
-> Peer
     (Handshake vNumber Term)
     'AsServer
     '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
    -- server versions
    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)


    -- This codec does not know how to decode 'Version_0' and 'Version_2'.
    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



-- | Run 'prop_channel' in the simulation monad.
--
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, 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)


-- | Run 'prop_channel' in the IO monad.
--
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, 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)


-- | Run 'prop_channel' in the IO monad using local pipes.
--
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, 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)



--
-- NodeToNode generators
--

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

-- | With the introduction of PeerSharing to 'NodeToNodeVersionData' this type's
-- 'Acceptable' instance is no longer symmetric. Because when handshake is
-- performed we keep only the remote's side PeerSharing information. Due to this,
-- the 'ArbitraryNodeToNodeVersionData' needs to have a custom 'Eq' type that
-- ignores this parameter. We also ignore the query field which may differ
-- between parties.
--
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
                ]
    -- TODO: shrink (issue #3407)


--
-- NodeToClient generators
--

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
                ]
    -- TODO: shrink (issue #3407)


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


-- | Run 'prop_query_version' in the simulation monad.
--
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
-> (NodeToNodeVersion -> 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
-> (vNumber -> 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
                    (NodeToNodeVersion -> NodeToNodeVersion -> Bool
forall a. Ord a => a -> a -> Bool
>= NodeToNodeVersion
NodeToNodeV_13)
                    (\(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
                           })

-- | Run 'prop_query_version' in the IO monad.
--
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
-> (NodeToNodeVersion -> 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
-> (vNumber -> 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
                    (NodeToNodeVersion -> NodeToNodeVersion -> Bool
forall a. Ord a => a -> a -> Bool
>= NodeToNodeVersion
NodeToNodeV_13)
                    (\(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
                           })

-- | Run 'prop_query_version' with SimNet.
--
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
-> (NodeToNodeVersion -> 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
-> (vNumber -> 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
                    (NodeToNodeVersion -> NodeToNodeVersion -> Bool
forall a. Ord a => a -> a -> Bool
>= NodeToNodeVersion
NodeToNodeV_13)
                    (\(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
                           })

-- | Run 'prop_query_version' in the simulation monad.
--
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
-> (NodeToClientVersion -> 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
-> (vNumber -> 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
                    (NodeToClientVersion -> NodeToClientVersion -> Bool
forall a. Ord a => a -> a -> Bool
>= NodeToClientVersion
NodeToClientV_15)
                    (\NodeToClientVersionData
vd -> NodeToClientVersionData
vd {NTC.query = True})

-- | Run 'prop_query_version' in the IO monad.
--
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
-> (NodeToClientVersion -> 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
-> (vNumber -> 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
                    (NodeToClientVersion -> NodeToClientVersion -> Bool
forall a. Ord a => a -> a -> Bool
>= NodeToClientVersion
NodeToClientV_15)
                    (\NodeToClientVersionData
vd -> NodeToClientVersionData
vd {NTC.query = True})

-- | Run 'prop_query_version' with SimNet.
--
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
-> (NodeToClientVersion -> 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
-> (vNumber -> 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
                    (NodeToClientVersion -> NodeToClientVersion -> Bool
forall a. Ord a => a -> a -> Bool
>= NodeToClientVersion
NodeToClientV_15)
                    (\NodeToClientVersionData
vd -> NodeToClientVersionData
vd {NTC.query = True})


-- | Run a query for the server's supported version.
--
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
                   -> (vNumber -> 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
-> (vNumber -> 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 vNumber -> Bool
supportsQuery 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
     'StPropose
     m
     (Either
        (HandshakeProtocolError vNumber)
        (HandshakeResult Bool vNumber vData))
-> Peer
     (Handshake vNumber Term)
     (FlipAgency 'AsClient)
     '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 (m :: * -> *) failure ps bytes (pr :: PeerRole) (st :: ps) a
       b.
(MonadAsync m, MonadCatch m, Show failure,
 forall (st' :: ps). Show (ClientHasAgency st'),
 forall (st' :: ps). Show (ServerHasAgency st'), ShowProxy ps) =>
m (Channel m bytes, Channel m bytes)
-> Tracer m (Role, TraceSendRecv ps)
-> Codec ps failure m bytes
-> Peer ps pr st m a
-> Peer ps (FlipAgency pr) st m b
-> m (a, b)
runConnectedPeers
      m (Channel m ByteString, Channel m ByteString)
createChannels Tracer m (Role, TraceSendRecv (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
     '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
-> Peer
     (Handshake vNumber Term)
     'AsClient
     '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
-> Peer
     (Handshake vNumber Term)
     'AsServer
     '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
-> Peer
     (Handshake vNumber Term)
     'AsServer
     '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
    -- Ignore handshake errors.
    Left HandshakeProtocolError vNumber
_ ->
      Bool -> Property
forall prop. Testable prop => prop -> Property
property Bool
True
    -- We should receive the queried versions.
    Right (HandshakeNegotiationResult Bool
_ vNumber
k vData
_) ->
      -- We will only receive a negotiated result if the negotiated version does not support queries.
      Bool -> Property
forall prop. Testable prop => prop -> Property
property (Bool -> Property) -> Bool -> Property
forall a b. (a -> b) -> a -> b
$ Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ vNumber -> Bool
supportsQuery vNumber
k
    -- On successful handshakes, the received versions should match the server versions (ignoring `query`).
    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 -> if vNumber -> Bool
supportsQuery vNumber
k then Version vData Bool
v { versionData = setQuery (versionData v) } else Version vData Bool
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


-- | Run a query for the server's supported version.
--
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
     'StPropose
     m
     (Either
        (HandshakeProtocolError NodeToNodeVersion)
        (HandshakeResult
           Bool NodeToNodeVersion ArbitraryNodeToNodeVersionData))
-> Peer
     (Handshake NodeToNodeVersion Term)
     (FlipAgency 'AsClient)
     '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 (m :: * -> *) failure ps bytes (pr :: PeerRole) (st :: ps) a
       b.
(MonadAsync m, MonadCatch m, Show failure,
 forall (st' :: ps). Show (ClientHasAgency st'),
 forall (st' :: ps). Show (ServerHasAgency st'), ShowProxy ps) =>
m (Channel m bytes, Channel m bytes)
-> Tracer m (Role, TraceSendRecv ps)
-> Codec ps failure m bytes
-> Peer ps pr st m a
-> Peer ps (FlipAgency pr) st m b
-> m (a, b)
runConnectedPeers
      m (Channel m ByteString, Channel m ByteString)
createChannels Tracer m (Role, TraceSendRecv (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
     '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
-> Peer
     (Handshake vNumber Term)
     'AsClient
     '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
-> Peer
     (Handshake NodeToNodeVersion Term)
     'AsServer
     '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
-> Peer
     (Handshake vNumber Term)
     'AsServer
     '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
    -- TODO: make this return ArbitraryNodeToNodeVersionData rather than a pair
    -- of NodeToNodeVersionData
    (  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

-- | Run 'prop_peerSharing_symmetric' with SimNet.
--
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

-- | 'acceptOrRefuse' is symmetric in the following sense:
--
-- Either both sides:
-- * accept the same version and version data; or
-- * refuse
--
-- The refuse reason might differ, although if one side refuses it with
-- `Refused` the other side must refuse the same version.
--
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


-- | Run two handshake clients against each other, which simulates a TCP
-- simultaneous open.
--
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
-> Peer
     (Handshake vNumber Term)
     'AsClient
     '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
-> Peer
     (Handshake vNumber Term)
     'AsClient
     '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
-> Peer
     (Handshake vNumber Term)
     'AsClient
     '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
-> Peer
     (Handshake vNumber Term)
     'AsClient
     '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
                      -- (("client",) `contramap` Tracer Debug.traceShowM)
                       codec clientChannel client)
        `concurrently`
      (fst <$> runPeer nullTracer
                      -- (("server",) `contramap` Tracer Debug.traceShowM)
                       codec serverChannel client')
    pure $
      case (clientRes', serverRes') of
        -- both succeeded, we just check that the application (which is
        -- a boolean value) is the one that was put inside 'Version'
        (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

        -- both queried versions
        (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

        -- both failed
        (Left{}, Left{})   -> String -> Bool -> Property
forall prop. Testable prop => String -> prop -> Property
label String
"both-failed" Bool
True

        -- it should not happen that one protocol succeeds and the other end
        -- fails
        (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

-- | Run 'prop_channel_simultaneous_open' in the simulation monad.
--
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

-- | Run 'prop_channel_simultaneous_open' in the IO monad.
--
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
      -- listening snockets
      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'
          -- connection snockets
          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') ->
                      -- we need concurrently close both sockets: they need to
                      -- communicate between each other while they close.
                      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 MuxTrace
-> FD m (TestAddress Int)
-> m (MuxBearer m)
forall (m :: * -> *) fd.
MakeBearer m fd
-> DiffTime -> Tracer m MuxTrace -> fd -> m (MuxBearer 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 MuxTrace
forall (m :: * -> *) a. Applicative m => Tracer m a
nullTracer
                        -- (("client",) `contramap` Tracer Debug.traceShowM)
                        FD m (TestAddress Int)
fdConn
            bearer' <- Mx.getBearer makeFDBearer
                        1
                        nullTracer
                        -- (("server",) `contramap` Tracer Debug.traceShowM)
                        fdConn'
            let chann  = Channel m -> Channel m ByteString
forall (m :: * -> *). Channel m -> Channel m ByteString
fromChannel
                       (Channel m -> Channel m ByteString)
-> Channel m -> Channel m ByteString
forall a b. (a -> b) -> a -> b
$ MuxBearer m -> MiniProtocolNum -> MiniProtocolDir -> Channel m
forall (m :: * -> *).
Functor m =>
MuxBearer m -> MiniProtocolNum -> MiniProtocolDir -> Channel m
muxBearerAsChannel MuxBearer m
bearer  (Word16 -> MiniProtocolNum
MiniProtocolNum Word16
0) MiniProtocolDir
InitiatorDir
                chann' = Channel m -> Channel m ByteString
forall (m :: * -> *). Channel m -> Channel m ByteString
fromChannel
                       (Channel m -> Channel m ByteString)
-> Channel m -> Channel m ByteString
forall a b. (a -> b) -> a -> b
$ MuxBearer m -> MiniProtocolNum -> MiniProtocolDir -> Channel m
forall (m :: * -> *).
Functor m =>
MuxBearer m -> MiniProtocolNum -> MiniProtocolDir -> Channel m
muxBearerAsChannel MuxBearer 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



--
-- Codec tests
--

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 (AnyMessageAndAgency (Handshake VersionNumber CBOR.Term)) where
  arbitrary :: Gen (AnyMessageAndAgency (Handshake VersionNumber Term))
arbitrary = [Gen (AnyMessageAndAgency (Handshake VersionNumber Term))]
-> Gen (AnyMessageAndAgency (Handshake VersionNumber Term))
forall a. [Gen a] -> Gen a
oneof
    [     PeerHasAgency 'AsClient 'StPropose
-> Message (Handshake VersionNumber Term) 'StPropose 'StConfirm
-> AnyMessageAndAgency (Handshake VersionNumber Term)
forall (pr :: PeerRole) ps (st :: ps) (st' :: ps).
PeerHasAgency pr st -> Message ps st st' -> AnyMessageAndAgency ps
AnyMessageAndAgency (ClientHasAgency 'StPropose -> PeerHasAgency 'AsClient 'StPropose
forall {ps} (st :: ps).
ClientHasAgency st -> PeerHasAgency 'AsClient st
ClientAgency ClientHasAgency 'StPropose
forall {k} {k1} {vNumber :: k} {vParams :: k1}.
ClientHasAgency 'StPropose
TokPropose)
        (Message (Handshake VersionNumber Term) 'StPropose 'StConfirm
 -> AnyMessageAndAgency (Handshake VersionNumber Term))
-> (Versions VersionNumber VersionData Bool
    -> Message (Handshake VersionNumber Term) 'StPropose 'StConfirm)
-> Versions VersionNumber VersionData Bool
-> AnyMessageAndAgency (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
 -> AnyMessageAndAgency (Handshake VersionNumber Term))
-> Gen (Versions VersionNumber VersionData Bool)
-> Gen (AnyMessageAndAgency (Handshake VersionNumber Term))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (Versions VersionNumber VersionData Bool)
genVersions

    ,     PeerHasAgency 'AsServer 'StConfirm
-> Message (Handshake VersionNumber Term) 'StConfirm 'StDone
-> AnyMessageAndAgency (Handshake VersionNumber Term)
forall (pr :: PeerRole) ps (st :: ps) (st' :: ps).
PeerHasAgency pr st -> Message ps st st' -> AnyMessageAndAgency ps
AnyMessageAndAgency (ServerHasAgency 'StConfirm -> PeerHasAgency 'AsServer 'StConfirm
forall {ps} (st :: ps).
ServerHasAgency st -> PeerHasAgency 'AsServer st
ServerAgency ServerHasAgency 'StConfirm
forall {k} {k1} {vNumber :: k} {vParams :: k1}.
ServerHasAgency 'StConfirm
TokConfirm)
        (Message (Handshake VersionNumber Term) 'StConfirm 'StDone
 -> AnyMessageAndAgency (Handshake VersionNumber Term))
-> (Versions VersionNumber VersionData Bool
    -> Message (Handshake VersionNumber Term) 'StConfirm 'StDone)
-> Versions VersionNumber VersionData Bool
-> AnyMessageAndAgency (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
 -> AnyMessageAndAgency (Handshake VersionNumber Term))
-> Gen (Versions VersionNumber VersionData Bool)
-> Gen (AnyMessageAndAgency (Handshake VersionNumber Term))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (Versions VersionNumber VersionData Bool)
genVersions

    ,     PeerHasAgency 'AsServer 'StConfirm
-> Message (Handshake VersionNumber Term) 'StConfirm 'StDone
-> AnyMessageAndAgency (Handshake VersionNumber Term)
forall (pr :: PeerRole) ps (st :: ps) (st' :: ps).
PeerHasAgency pr st -> Message ps st st' -> AnyMessageAndAgency ps
AnyMessageAndAgency (ServerHasAgency 'StConfirm -> PeerHasAgency 'AsServer 'StConfirm
forall {ps} (st :: ps).
ServerHasAgency st -> PeerHasAgency 'AsServer st
ServerAgency ServerHasAgency 'StConfirm
forall {k} {k1} {vNumber :: k} {vParams :: k1}.
ServerHasAgency 'StConfirm
TokConfirm)
        (Message (Handshake VersionNumber Term) 'StConfirm 'StDone
 -> AnyMessageAndAgency (Handshake VersionNumber Term))
-> ((VersionNumber, Term)
    -> Message (Handshake VersionNumber Term) 'StConfirm 'StDone)
-> (VersionNumber, Term)
-> AnyMessageAndAgency (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)
 -> AnyMessageAndAgency (Handshake VersionNumber Term))
-> Gen (VersionNumber, Term)
-> Gen (AnyMessageAndAgency (Handshake VersionNumber Term))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (VersionNumber, Term)
genValidVersion'

    ,     PeerHasAgency 'AsServer 'StConfirm
-> Message (Handshake VersionNumber Term) 'StConfirm 'StDone
-> AnyMessageAndAgency (Handshake VersionNumber Term)
forall (pr :: PeerRole) ps (st :: ps) (st' :: ps).
PeerHasAgency pr st -> Message ps st st' -> AnyMessageAndAgency ps
AnyMessageAndAgency (ServerHasAgency 'StConfirm -> PeerHasAgency 'AsServer 'StConfirm
forall {ps} (st :: ps).
ServerHasAgency st -> PeerHasAgency 'AsServer st
ServerAgency ServerHasAgency 'StConfirm
forall {k} {k1} {vNumber :: k} {vParams :: k1}.
ServerHasAgency 'StConfirm
TokConfirm)
        (Message (Handshake VersionNumber Term) 'StConfirm 'StDone
 -> AnyMessageAndAgency (Handshake VersionNumber Term))
-> (ArbitraryRefuseReason
    -> Message (Handshake VersionNumber Term) 'StConfirm 'StDone)
-> ArbitraryRefuseReason
-> AnyMessageAndAgency (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
 -> AnyMessageAndAgency (Handshake VersionNumber Term))
-> Gen ArbitraryRefuseReason
-> Gen (AnyMessageAndAgency (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
          -- this argument is not supposed to be sent, only received:
          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


--
--  TODO: these tests should be moved to 'ouroboros-network-framework'
--

-- TODO: we are not testing the cases where we decode version numbers that we do
-- not know about.
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
  :: AnyMessageAndAgency (Handshake VersionNumber CBOR.Term)
  -> Bool
prop_codec_Handshake :: AnyMessageAndAgency (Handshake VersionNumber Term) -> Bool
prop_codec_Handshake AnyMessageAndAgency (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
-> AnyMessageAndAgency (Handshake VersionNumber Term)
-> IOSim s Bool
forall ps failure (m :: * -> *) bytes.
(Monad m, Eq (AnyMessage ps)) =>
Codec ps failure m bytes -> AnyMessageAndAgency 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) AnyMessageAndAgency (Handshake VersionNumber Term)
msg)

prop_codec_splits2_Handshake
  :: AnyMessageAndAgency (Handshake VersionNumber CBOR.Term)
  -> Bool
prop_codec_splits2_Handshake :: AnyMessageAndAgency (Handshake VersionNumber Term) -> Bool
prop_codec_splits2_Handshake AnyMessageAndAgency (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
-> AnyMessageAndAgency (Handshake VersionNumber Term)
-> IOSim s Bool
forall ps failure (m :: * -> *) bytes.
(Monad m, Eq (AnyMessage ps)) =>
(bytes -> [[bytes]])
-> Codec ps failure m bytes -> AnyMessageAndAgency ps -> m Bool
prop_codec_splitsM ByteString -> [[ByteString]]
splits2 (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) AnyMessageAndAgency (Handshake VersionNumber Term)
msg)

prop_codec_splits3_Handshake
  :: AnyMessageAndAgency (Handshake VersionNumber CBOR.Term)
  -> Bool
prop_codec_splits3_Handshake :: AnyMessageAndAgency (Handshake VersionNumber Term) -> Bool
prop_codec_splits3_Handshake AnyMessageAndAgency (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
-> AnyMessageAndAgency (Handshake VersionNumber Term)
-> IOSim s Bool
forall ps failure (m :: * -> *) bytes.
(Monad m, Eq (AnyMessage ps)) =>
(bytes -> [[bytes]])
-> Codec ps failure m bytes -> AnyMessageAndAgency ps -> m Bool
prop_codec_splitsM ByteString -> [[ByteString]]
splits3 (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) AnyMessageAndAgency (Handshake VersionNumber Term)
msg)

prop_codec_cbor
  :: AnyMessageAndAgency (Handshake VersionNumber CBOR.Term)
  -> Bool
prop_codec_cbor :: AnyMessageAndAgency (Handshake VersionNumber Term) -> Bool
prop_codec_cbor AnyMessageAndAgency (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
-> AnyMessageAndAgency (Handshake VersionNumber Term)
-> IOSim s Bool
forall ps (m :: * -> *).
(Monad m, Eq (AnyMessage ps)) =>
Codec ps DeserialiseFailure m ByteString
-> AnyMessageAndAgency 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) AnyMessageAndAgency (Handshake VersionNumber Term)
msg)

-- | Check that the encoder produces a valid CBOR.
--
prop_codec_valid_cbor
  :: AnyMessageAndAgency (Handshake VersionNumber CBOR.Term)
  -> Property
prop_codec_valid_cbor :: AnyMessageAndAgency (Handshake VersionNumber Term) -> Property
prop_codec_valid_cbor = Codec
  (Handshake VersionNumber Term) DeserialiseFailure IO ByteString
-> AnyMessageAndAgency (Handshake VersionNumber Term) -> Property
forall ps.
Codec ps DeserialiseFailure IO ByteString
-> AnyMessageAndAgency 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)