{-# LANGUAGE DataKinds                  #-}
{-# LANGUAGE DerivingStrategies         #-}
{-# LANGUAGE FlexibleContexts           #-}
{-# LANGUAGE FlexibleInstances          #-}
{-# LANGUAGE GADTs                      #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE NamedFieldPuns             #-}
{-# LANGUAGE PolyKinds                  #-}
{-# LANGUAGE QuantifiedConstraints      #-}
{-# LANGUAGE RankNTypes                 #-}
{-# LANGUAGE StandaloneDeriving         #-}
{-# LANGUAGE TupleSections              #-}
{-# LANGUAGE TypeFamilies               #-}

{-# OPTIONS_GHC -Wno-orphans #-}
{-# LANGUAGE DeriveGeneric              #-}
module Ouroboros.Network.Protocol.TxSubmission2.Test
  ( tests
  , Tx (..)
  , TxId (..)
  ) where

import Data.Bifunctor (second)
import Data.ByteString.Lazy (ByteString)
import Data.List (nub)
import Data.List.NonEmpty qualified as NonEmpty
import Data.Word (Word16)

import Control.Monad.Class.MonadAsync (MonadAsync)
import Control.Monad.Class.MonadST (MonadST)
import Control.Monad.Class.MonadThrow (MonadCatch)
import Control.Monad.IOSim
import Control.Monad.ST (runST)
import Control.Tracer (Tracer (..), contramap, nullTracer)

import Codec.Serialise (DeserialiseFailure, Serialise)
import Codec.Serialise qualified as Serialise (decode, encode)

import Network.TypedProtocol.Codec hiding (prop_codec)
import Network.TypedProtocol.Proofs

import Ouroboros.Network.Channel
import Ouroboros.Network.Driver.Simple (runConnectedPeersPipelined)
import Ouroboros.Network.Util.ShowProxy

import Ouroboros.Network.Protocol.TxSubmission2.Client
import Ouroboros.Network.Protocol.TxSubmission2.Codec
import Ouroboros.Network.Protocol.TxSubmission2.Direct
import Ouroboros.Network.Protocol.TxSubmission2.Examples
import Ouroboros.Network.Protocol.TxSubmission2.Server
import Ouroboros.Network.Protocol.TxSubmission2.Type

import Test.Data.CDDL (Any (..))
import Test.Ouroboros.Network.Testing.Utils (prop_codec_cborM,
           prop_codec_valid_cbor_encoding, splits2, splits3)

import Control.DeepSeq
import GHC.Generics
import Test.QuickCheck as QC
import Test.QuickCheck.Instances.ByteString ()
import Test.Tasty (TestTree, testGroup)
import Test.Tasty.QuickCheck (testProperty)


--
-- Test cases
--


tests :: TestTree
tests :: TestTree
tests =
  TestName -> [TestTree] -> TestTree
testGroup TestName
"Ouroboros.Network.Protocol"
    [ TestName -> [TestTree] -> TestTree
testGroup TestName
"TxSubmission2"
        [ TestName -> (TxSubmissionTestParams -> Bool) -> TestTree
forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"direct"              TxSubmissionTestParams -> Bool
prop_direct
        , TestName -> (TxSubmissionTestParams -> Bool) -> TestTree
forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"connect 1"           TxSubmissionTestParams -> Bool
prop_connect1
        , TestName
-> (TxSubmissionTestParams -> NonEmptyList Bool -> Bool)
-> TestTree
forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"connect 2"           TxSubmissionTestParams -> NonEmptyList Bool -> Bool
prop_connect2
        , TestName
-> (AnyMessage (TxSubmission2 TxId Tx) -> Bool) -> TestTree
forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"codec"               AnyMessage (TxSubmission2 TxId Tx) -> Bool
prop_codec
        , TestName
-> (AnyMessage (TxSubmission2 TxId Tx) -> Bool) -> TestTree
forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"codec id"            AnyMessage (TxSubmission2 TxId Tx) -> Bool
prop_codec_id
        , TestName
-> (AnyMessage (TxSubmission2 TxId Tx) -> Bool) -> TestTree
forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"codec 2-splits"      AnyMessage (TxSubmission2 TxId Tx) -> Bool
prop_codec_splits2
        , TestName -> Property -> TestTree
forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"codec 3-splits"    (Property -> TestTree) -> Property -> TestTree
forall a b. (a -> b) -> a -> b
$ Int -> (AnyMessage (TxSubmission2 TxId Tx) -> Bool) -> Property
forall prop. Testable prop => Int -> prop -> Property
withMaxSuccess Int
30
                                             AnyMessage (TxSubmission2 TxId Tx) -> Bool
prop_codec_splits3
        , TestName
-> (AnyMessage (TxSubmission2 TxId Tx) -> Bool) -> TestTree
forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"codec cbor"          AnyMessage (TxSubmission2 TxId Tx) -> Bool
prop_codec_cbor
        , TestName
-> (AnyMessage (TxSubmission2 TxId Tx) -> Property) -> TestTree
forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"codec valid cbor"    AnyMessage (TxSubmission2 TxId Tx) -> Property
prop_codec_valid_cbor
        , TestName -> (TxSubmissionTestParams -> Bool) -> TestTree
forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"channel ST"          TxSubmissionTestParams -> Bool
prop_channel_ST
        , TestName -> (TxSubmissionTestParams -> Property) -> TestTree
forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"channel IO"          TxSubmissionTestParams -> Property
prop_channel_IO
        , TestName -> (TxSubmissionTestParams -> Property) -> TestTree
forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"pipe IO"             TxSubmissionTestParams -> Property
prop_pipe_IO
        ]
    ]

--
-- Common types & clients and servers used in the tests in this module.
--

newtype Tx = Tx TxId
  deriving (Tx -> Tx -> Bool
(Tx -> Tx -> Bool) -> (Tx -> Tx -> Bool) -> Eq Tx
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Tx -> Tx -> Bool
== :: Tx -> Tx -> Bool
$c/= :: Tx -> Tx -> Bool
/= :: Tx -> Tx -> Bool
Eq, Int -> Tx -> ShowS
[Tx] -> ShowS
Tx -> TestName
(Int -> Tx -> ShowS)
-> (Tx -> TestName) -> ([Tx] -> ShowS) -> Show Tx
forall a.
(Int -> a -> ShowS) -> (a -> TestName) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Tx -> ShowS
showsPrec :: Int -> Tx -> ShowS
$cshow :: Tx -> TestName
show :: Tx -> TestName
$cshowList :: [Tx] -> ShowS
showList :: [Tx] -> ShowS
Show, Gen Tx
Gen Tx -> (Tx -> [Tx]) -> Arbitrary Tx
Tx -> [Tx]
forall a. Gen a -> (a -> [a]) -> Arbitrary a
$carbitrary :: Gen Tx
arbitrary :: Gen Tx
$cshrink :: Tx -> [Tx]
shrink :: Tx -> [Tx]
Arbitrary, [Tx] -> Encoding
Tx -> Encoding
(Tx -> Encoding)
-> (forall s. Decoder s Tx)
-> ([Tx] -> Encoding)
-> (forall s. Decoder s [Tx])
-> Serialise Tx
forall s. Decoder s [Tx]
forall s. Decoder s Tx
forall a.
(a -> Encoding)
-> (forall s. Decoder s a)
-> ([a] -> Encoding)
-> (forall s. Decoder s [a])
-> Serialise a
$cencode :: Tx -> Encoding
encode :: Tx -> Encoding
$cdecode :: forall s. Decoder s Tx
decode :: forall s. Decoder s Tx
$cencodeList :: [Tx] -> Encoding
encodeList :: [Tx] -> Encoding
$cdecodeList :: forall s. Decoder s [Tx]
decodeList :: forall s. Decoder s [Tx]
Serialise, (forall x. Tx -> Rep Tx x)
-> (forall x. Rep Tx x -> Tx) -> Generic Tx
forall x. Rep Tx x -> Tx
forall x. Tx -> Rep Tx x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Tx -> Rep Tx x
from :: forall x. Tx -> Rep Tx x
$cto :: forall x. Rep Tx x -> Tx
to :: forall x. Rep Tx x -> Tx
Generic, Tx -> ()
(Tx -> ()) -> NFData Tx
forall a. (a -> ()) -> NFData a
$crnf :: Tx -> ()
rnf :: Tx -> ()
NFData)

instance ShowProxy Tx where
    showProxy :: Proxy Tx -> TestName
showProxy Proxy Tx
_ = TestName
"Tx"

txId :: Tx -> TxId
txId :: Tx -> TxId
txId (Tx TxId
txid) = TxId
txid

-- | We use any `CBOR.Term`.  This allows us to use `any` in cddl specs.
--
newtype TxId = TxId Any
  deriving (TxId -> TxId -> Bool
(TxId -> TxId -> Bool) -> (TxId -> TxId -> Bool) -> Eq TxId
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TxId -> TxId -> Bool
== :: TxId -> TxId -> Bool
$c/= :: TxId -> TxId -> Bool
/= :: TxId -> TxId -> Bool
Eq, Eq TxId
Eq TxId =>
(TxId -> TxId -> Ordering)
-> (TxId -> TxId -> Bool)
-> (TxId -> TxId -> Bool)
-> (TxId -> TxId -> Bool)
-> (TxId -> TxId -> Bool)
-> (TxId -> TxId -> TxId)
-> (TxId -> TxId -> TxId)
-> Ord TxId
TxId -> TxId -> Bool
TxId -> TxId -> Ordering
TxId -> TxId -> TxId
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 :: TxId -> TxId -> Ordering
compare :: TxId -> TxId -> Ordering
$c< :: TxId -> TxId -> Bool
< :: TxId -> TxId -> Bool
$c<= :: TxId -> TxId -> Bool
<= :: TxId -> TxId -> Bool
$c> :: TxId -> TxId -> Bool
> :: TxId -> TxId -> Bool
$c>= :: TxId -> TxId -> Bool
>= :: TxId -> TxId -> Bool
$cmax :: TxId -> TxId -> TxId
max :: TxId -> TxId -> TxId
$cmin :: TxId -> TxId -> TxId
min :: TxId -> TxId -> TxId
Ord, Int -> TxId -> ShowS
[TxId] -> ShowS
TxId -> TestName
(Int -> TxId -> ShowS)
-> (TxId -> TestName) -> ([TxId] -> ShowS) -> Show TxId
forall a.
(Int -> a -> ShowS) -> (a -> TestName) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TxId -> ShowS
showsPrec :: Int -> TxId -> ShowS
$cshow :: TxId -> TestName
show :: TxId -> TestName
$cshowList :: [TxId] -> ShowS
showList :: [TxId] -> ShowS
Show, Gen TxId
Gen TxId -> (TxId -> [TxId]) -> Arbitrary TxId
TxId -> [TxId]
forall a. Gen a -> (a -> [a]) -> Arbitrary a
$carbitrary :: Gen TxId
arbitrary :: Gen TxId
$cshrink :: TxId -> [TxId]
shrink :: TxId -> [TxId]
Arbitrary, [TxId] -> Encoding
TxId -> Encoding
(TxId -> Encoding)
-> (forall s. Decoder s TxId)
-> ([TxId] -> Encoding)
-> (forall s. Decoder s [TxId])
-> Serialise TxId
forall s. Decoder s [TxId]
forall s. Decoder s TxId
forall a.
(a -> Encoding)
-> (forall s. Decoder s a)
-> ([a] -> Encoding)
-> (forall s. Decoder s [a])
-> Serialise a
$cencode :: TxId -> Encoding
encode :: TxId -> Encoding
$cdecode :: forall s. Decoder s TxId
decode :: forall s. Decoder s TxId
$cencodeList :: [TxId] -> Encoding
encodeList :: [TxId] -> Encoding
$cdecodeList :: forall s. Decoder s [TxId]
decodeList :: forall s. Decoder s [TxId]
Serialise, (forall x. TxId -> Rep TxId x)
-> (forall x. Rep TxId x -> TxId) -> Generic TxId
forall x. Rep TxId x -> TxId
forall x. TxId -> Rep TxId x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. TxId -> Rep TxId x
from :: forall x. TxId -> Rep TxId x
$cto :: forall x. Rep TxId x -> TxId
to :: forall x. Rep TxId x -> TxId
Generic, TxId -> ()
(TxId -> ()) -> NFData TxId
forall a. (a -> ()) -> NFData a
$crnf :: TxId -> ()
rnf :: TxId -> ()
NFData)

instance ShowProxy TxId where
    showProxy :: Proxy TxId -> TestName
showProxy Proxy TxId
_ = TestName
"TxId"

type TestServer m = TxSubmissionServerPipelined TxId Tx m [Tx]
type TestClient m = TxSubmissionClient          TxId Tx m ()

testServer :: Monad m
           => Tracer m (TraceEventServer TxId Tx)
           -> TxSubmissionTestParams
           -> TestServer m
testServer :: forall (m :: * -> *).
Monad m =>
Tracer m (TraceEventServer TxId Tx)
-> TxSubmissionTestParams -> TestServer m
testServer Tracer m (TraceEventServer TxId Tx)
tracer
           TxSubmissionTestParams {
             testMaxUnacked :: TxSubmissionTestParams -> Positive (Small Word16)
testMaxUnacked        = Positive (Small Word16
maxUnacked),
             testMaxTxIdsToRequest :: TxSubmissionTestParams -> Positive (Small Word16)
testMaxTxIdsToRequest = Positive (Small Word16
maxTxIdsToRequest),
             testMaxTxToRequest :: TxSubmissionTestParams -> Positive (Small Word16)
testMaxTxToRequest    = Positive (Small Word16
maxTxToRequest)
           } =
    Tracer m (TraceEventServer TxId Tx)
-> (Tx -> TxId)
-> Word16
-> Word16
-> Word16
-> TxSubmissionServerPipelined TxId Tx m [Tx]
forall txid tx (m :: * -> *).
(Ord txid, Monad m) =>
Tracer m (TraceEventServer txid tx)
-> (tx -> txid)
-> Word16
-> Word16
-> Word16
-> TxSubmissionServerPipelined txid tx m [tx]
txSubmissionServer
      Tracer m (TraceEventServer TxId Tx)
tracer Tx -> TxId
txId
      Word16
maxUnacked Word16
maxTxIdsToRequest Word16
maxTxToRequest

testClient :: Monad m
           => Tracer m (TraceEventClient TxId Tx)
           -> TxSubmissionTestParams
           -> TestClient m
testClient :: forall (m :: * -> *).
Monad m =>
Tracer m (TraceEventClient TxId Tx)
-> TxSubmissionTestParams -> TestClient m
testClient Tracer m (TraceEventClient TxId Tx)
tracer            TxSubmissionTestParams {
             testMaxUnacked :: TxSubmissionTestParams -> Positive (Small Word16)
testMaxUnacked   = Positive (Small Word16
maxUnacked),
             testTransactions :: TxSubmissionTestParams -> DistinctList Tx
testTransactions = DistinctList [Tx]
txs
           } =
    Tracer m (TraceEventClient TxId Tx)
-> (Tx -> TxId)
-> (Tx -> SizeInBytes)
-> Word16
-> [Tx]
-> TxSubmissionClient TxId Tx m ()
forall txid tx (m :: * -> *).
(Ord txid, Show txid, Monad m) =>
Tracer m (TraceEventClient txid tx)
-> (tx -> txid)
-> (tx -> SizeInBytes)
-> Word16
-> [tx]
-> TxSubmissionClient txid tx m ()
txSubmissionClient
      Tracer m (TraceEventClient TxId Tx)
tracer Tx -> TxId
txId Tx -> SizeInBytes
forall {a} {p}. Num a => p -> a
txSize
      Word16
maxUnacked
      [Tx]
txs
  where
    txSize :: p -> a
txSize p
_ = a
500


--
-- Properties going directly, not via Peer.
--

-- | Run a simple tx-submission client and server, directly on the wrappers,
-- without going via the 'Peer'.
--
prop_direct :: TxSubmissionTestParams -> Bool
prop_direct :: TxSubmissionTestParams -> Bool
prop_direct params :: TxSubmissionTestParams
params@TxSubmissionTestParams{DistinctList Tx
testTransactions :: TxSubmissionTestParams -> DistinctList Tx
testTransactions :: DistinctList Tx
testTransactions} =
    (forall s. IOSim s ([Tx], ())) -> ([Tx], ())
forall a. (forall s. IOSim s a) -> a
runSimOrThrow
      (TxSubmissionServerPipelined TxId Tx (IOSim s) [Tx]
-> TxSubmissionClient TxId Tx (IOSim s) () -> IOSim s ([Tx], ())
forall txid tx (m :: * -> *) a b.
Monad m =>
TxSubmissionServerPipelined txid tx m a
-> TxSubmissionClient txid tx m b -> m (a, b)
directPipelined
        (Tracer (IOSim s) (TraceEventServer TxId Tx)
-> TxSubmissionTestParams
-> TxSubmissionServerPipelined TxId Tx (IOSim s) [Tx]
forall (m :: * -> *).
Monad m =>
Tracer m (TraceEventServer TxId Tx)
-> TxSubmissionTestParams -> TestServer m
testServer Tracer (IOSim s) (TraceEventServer TxId Tx)
forall (m :: * -> *) a. Applicative m => Tracer m a
nullTracer TxSubmissionTestParams
params)
        (Tracer (IOSim s) (TraceEventClient TxId Tx)
-> TxSubmissionTestParams
-> TxSubmissionClient TxId Tx (IOSim s) ()
forall (m :: * -> *).
Monad m =>
Tracer m (TraceEventClient TxId Tx)
-> TxSubmissionTestParams -> TestClient m
testClient Tracer (IOSim s) (TraceEventClient TxId Tx)
forall (m :: * -> *) a. Applicative m => Tracer m a
nullTracer TxSubmissionTestParams
params))
  ([Tx], ()) -> ([Tx], ()) -> Bool
forall a. Eq a => a -> a -> Bool
==
    (DistinctList Tx -> [Tx]
forall a. DistinctList a -> [a]
fromDistinctList DistinctList Tx
testTransactions, ())


-- | Run a simple tx-submission client and server, going via the 'Peer'
-- representation, but without going via a channel.
--
-- This test converts the pipelined server peer to a non-pipelined peer
-- before connecting it with the client.
--
prop_connect1 :: TxSubmissionTestParams -> Bool
prop_connect1 :: TxSubmissionTestParams -> Bool
prop_connect1 params :: TxSubmissionTestParams
params@TxSubmissionTestParams{DistinctList Tx
testTransactions :: TxSubmissionTestParams -> DistinctList Tx
testTransactions :: DistinctList Tx
testTransactions} =
    case (forall s.
 IOSim s ([Tx], (), TerminalStates (TxSubmission2 TxId Tx)))
-> ([Tx], (), TerminalStates (TxSubmission2 TxId Tx))
forall a. (forall s. IOSim s a) -> a
runSimOrThrow
           (Peer
  (TxSubmission2 TxId Tx)
  'AsServer
  'NonPipelined
  'StInit
  (IOSim s)
  [Tx]
-> Peer
     (TxSubmission2 TxId Tx)
     (FlipAgency 'AsServer)
     'NonPipelined
     'StInit
     (IOSim s)
     ()
-> IOSim s ([Tx], (), TerminalStates (TxSubmission2 TxId Tx))
forall ps (pr :: PeerRole) (initSt :: ps) (m :: * -> *) a b.
(Monad m, SingI pr) =>
Peer ps pr 'NonPipelined initSt m a
-> Peer ps (FlipAgency pr) 'NonPipelined initSt m b
-> m (a, b, TerminalStates ps)
connect
             ([Bool]
-> PeerPipelined
     (TxSubmission2 TxId Tx) 'AsServer 'StInit (IOSim s) [Tx]
-> Peer
     (TxSubmission2 TxId Tx)
     'AsServer
     'NonPipelined
     'StInit
     (IOSim s)
     [Tx]
forall ps (pr :: PeerRole) (st :: ps) (m :: * -> *) a.
Functor m =>
[Bool]
-> PeerPipelined ps pr st m a -> Peer ps pr 'NonPipelined st m a
forgetPipelined [] (PeerPipelined
   (TxSubmission2 TxId Tx) 'AsServer 'StInit (IOSim s) [Tx]
 -> Peer
      (TxSubmission2 TxId Tx)
      'AsServer
      'NonPipelined
      'StInit
      (IOSim s)
      [Tx])
-> PeerPipelined
     (TxSubmission2 TxId Tx) 'AsServer 'StInit (IOSim s) [Tx]
-> Peer
     (TxSubmission2 TxId Tx)
     'AsServer
     'NonPipelined
     'StInit
     (IOSim s)
     [Tx]
forall a b. (a -> b) -> a -> b
$
              TxSubmissionServerPipelined TxId Tx (IOSim s) [Tx]
-> PeerPipelined
     (TxSubmission2 TxId Tx) 'AsServer 'StInit (IOSim s) [Tx]
forall txid tx (m :: * -> *) a.
Functor m =>
TxSubmissionServerPipelined txid tx m a
-> ServerPipelined (TxSubmission2 txid tx) 'StInit m a
txSubmissionServerPeerPipelined (TxSubmissionServerPipelined TxId Tx (IOSim s) [Tx]
 -> PeerPipelined
      (TxSubmission2 TxId Tx) 'AsServer 'StInit (IOSim s) [Tx])
-> TxSubmissionServerPipelined TxId Tx (IOSim s) [Tx]
-> PeerPipelined
     (TxSubmission2 TxId Tx) 'AsServer 'StInit (IOSim s) [Tx]
forall a b. (a -> b) -> a -> b
$
              Tracer (IOSim s) (TraceEventServer TxId Tx)
-> TxSubmissionTestParams
-> TxSubmissionServerPipelined TxId Tx (IOSim s) [Tx]
forall (m :: * -> *).
Monad m =>
Tracer m (TraceEventServer TxId Tx)
-> TxSubmissionTestParams -> TestServer m
testServer Tracer (IOSim s) (TraceEventServer TxId Tx)
forall (m :: * -> *) a. Applicative m => Tracer m a
nullTracer TxSubmissionTestParams
params)
             (TxSubmissionClient TxId Tx (IOSim s) ()
-> Client
     (TxSubmission2 TxId Tx) 'NonPipelined 'StInit (IOSim s) ()
forall txid tx (m :: * -> *) a.
Monad m =>
TxSubmissionClient txid tx m a
-> Client (TxSubmission2 txid tx) 'NonPipelined 'StInit m a
txSubmissionClientPeer (TxSubmissionClient TxId Tx (IOSim s) ()
 -> Client
      (TxSubmission2 TxId Tx) 'NonPipelined 'StInit (IOSim s) ())
-> TxSubmissionClient TxId Tx (IOSim s) ()
-> Client
     (TxSubmission2 TxId Tx) 'NonPipelined 'StInit (IOSim s) ()
forall a b. (a -> b) -> a -> b
$
              Tracer (IOSim s) (TraceEventClient TxId Tx)
-> TxSubmissionTestParams
-> TxSubmissionClient TxId Tx (IOSim s) ()
forall (m :: * -> *).
Monad m =>
Tracer m (TraceEventClient TxId Tx)
-> TxSubmissionTestParams -> TestClient m
testClient Tracer (IOSim s) (TraceEventClient TxId Tx)
forall (m :: * -> *) a. Applicative m => Tracer m a
nullTracer TxSubmissionTestParams
params)) of

      ([Tx]
txs', (), TerminalStates SingTxSubmission st
StateToken st
SingDone SingTxSubmission 'StDone
StateToken st
SingDone) ->
        [Tx]
txs' [Tx] -> [Tx] -> Bool
forall a. Eq a => a -> a -> Bool
== DistinctList Tx -> [Tx]
forall a. DistinctList a -> [a]
fromDistinctList DistinctList Tx
testTransactions



-- | Run a pipelined tx-submission client against a server, going via the
-- 'Peer' representation, but without going via a channel.
--
-- This test uses the pipelined server, connected to the non-pipelined client.
--
prop_connect2 :: TxSubmissionTestParams -> NonEmptyList Bool -> Bool
prop_connect2 :: TxSubmissionTestParams -> NonEmptyList Bool -> Bool
prop_connect2 params :: TxSubmissionTestParams
params@TxSubmissionTestParams{DistinctList Tx
testTransactions :: TxSubmissionTestParams -> DistinctList Tx
testTransactions :: DistinctList Tx
testTransactions}
                     (NonEmpty [Bool]
choices) =
    case (forall s.
 IOSim s ([Tx], (), TerminalStates (TxSubmission2 TxId Tx)))
-> ([Tx], (), TerminalStates (TxSubmission2 TxId Tx))
forall a. (forall s. IOSim s a) -> a
runSimOrThrow
           ([Bool]
-> PeerPipelined
     (TxSubmission2 TxId Tx) 'AsServer 'StInit (IOSim s) [Tx]
-> Peer
     (TxSubmission2 TxId Tx)
     (FlipAgency 'AsServer)
     'NonPipelined
     'StInit
     (IOSim s)
     ()
-> IOSim s ([Tx], (), TerminalStates (TxSubmission2 TxId Tx))
forall ps (pr :: PeerRole) (st :: ps) (m :: * -> *) a b.
(Monad m, SingI pr) =>
[Bool]
-> PeerPipelined ps pr st m a
-> Peer ps (FlipAgency pr) 'NonPipelined st m b
-> m (a, b, TerminalStates ps)
connectPipelined [Bool]
choices
             (TxSubmissionServerPipelined TxId Tx (IOSim s) [Tx]
-> PeerPipelined
     (TxSubmission2 TxId Tx) 'AsServer 'StInit (IOSim s) [Tx]
forall txid tx (m :: * -> *) a.
Functor m =>
TxSubmissionServerPipelined txid tx m a
-> ServerPipelined (TxSubmission2 txid tx) 'StInit m a
txSubmissionServerPeerPipelined (TxSubmissionServerPipelined TxId Tx (IOSim s) [Tx]
 -> PeerPipelined
      (TxSubmission2 TxId Tx) 'AsServer 'StInit (IOSim s) [Tx])
-> TxSubmissionServerPipelined TxId Tx (IOSim s) [Tx]
-> PeerPipelined
     (TxSubmission2 TxId Tx) 'AsServer 'StInit (IOSim s) [Tx]
forall a b. (a -> b) -> a -> b
$
              Tracer (IOSim s) (TraceEventServer TxId Tx)
-> TxSubmissionTestParams
-> TxSubmissionServerPipelined TxId Tx (IOSim s) [Tx]
forall (m :: * -> *).
Monad m =>
Tracer m (TraceEventServer TxId Tx)
-> TxSubmissionTestParams -> TestServer m
testServer Tracer (IOSim s) (TraceEventServer TxId Tx)
forall (m :: * -> *) a. Applicative m => Tracer m a
nullTracer TxSubmissionTestParams
params)
             (TxSubmissionClient TxId Tx (IOSim s) ()
-> Client
     (TxSubmission2 TxId Tx) 'NonPipelined 'StInit (IOSim s) ()
forall txid tx (m :: * -> *) a.
Monad m =>
TxSubmissionClient txid tx m a
-> Client (TxSubmission2 txid tx) 'NonPipelined 'StInit m a
txSubmissionClientPeer (TxSubmissionClient TxId Tx (IOSim s) ()
 -> Client
      (TxSubmission2 TxId Tx) 'NonPipelined 'StInit (IOSim s) ())
-> TxSubmissionClient TxId Tx (IOSim s) ()
-> Client
     (TxSubmission2 TxId Tx) 'NonPipelined 'StInit (IOSim s) ()
forall a b. (a -> b) -> a -> b
$
              Tracer (IOSim s) (TraceEventClient TxId Tx)
-> TxSubmissionTestParams
-> TxSubmissionClient TxId Tx (IOSim s) ()
forall (m :: * -> *).
Monad m =>
Tracer m (TraceEventClient TxId Tx)
-> TxSubmissionTestParams -> TestClient m
testClient Tracer (IOSim s) (TraceEventClient TxId Tx)
forall (m :: * -> *) a. Applicative m => Tracer m a
nullTracer TxSubmissionTestParams
params)) of

      ([Tx]
txs', (), TerminalStates SingTxSubmission st
StateToken st
SingDone SingTxSubmission 'StDone
StateToken st
SingDone) ->
        [Tx]
txs' [Tx] -> [Tx] -> Bool
forall a. Eq a => a -> a -> Bool
== DistinctList Tx -> [Tx]
forall a. DistinctList a -> [a]
fromDistinctList DistinctList Tx
testTransactions

--
-- Properties using a channel
--

-- | Run a simple tx-submission client and server using connected channels.
--
prop_channel :: (MonadAsync m, MonadCatch m, MonadST m)
             => m (Channel m ByteString, Channel m ByteString)
             -> TxSubmissionTestParams
             -> m Bool
prop_channel :: forall (m :: * -> *).
(MonadAsync m, MonadCatch m, MonadST m) =>
m (Channel m ByteString, Channel m ByteString)
-> TxSubmissionTestParams -> m Bool
prop_channel m (Channel m ByteString, Channel m ByteString)
createChannels params :: TxSubmissionTestParams
params@TxSubmissionTestParams{DistinctList Tx
testTransactions :: TxSubmissionTestParams -> DistinctList Tx
testTransactions :: DistinctList Tx
testTransactions} =

    (\([Tx]
txs', ()) -> [Tx]
txs' [Tx] -> [Tx] -> Bool
forall a. Eq a => a -> a -> Bool
== DistinctList Tx -> [Tx]
forall a. DistinctList a -> [a]
fromDistinctList DistinctList Tx
testTransactions) (([Tx], ()) -> Bool) -> m ([Tx], ()) -> m Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>

    m (Channel m ByteString, Channel m ByteString)
-> Tracer m (Role, TraceSendRecv (TxSubmission2 TxId Tx))
-> Codec (TxSubmission2 TxId Tx) DeserialiseFailure m ByteString
-> PeerPipelined (TxSubmission2 TxId Tx) 'AsServer 'StInit m [Tx]
-> Peer
     (TxSubmission2 TxId Tx)
     (FlipAgency 'AsServer)
     'NonPipelined
     'StInit
     m
     ()
-> m ([Tx], ())
forall (m :: * -> *) ps failure bytes (pr :: PeerRole) (st :: ps) a
       b.
(MonadAsync m, MonadCatch m, ShowProxy ps,
 forall (st' :: ps) stok. (stok ~ StateToken st') => Show stok,
 Show failure) =>
m (Channel m bytes, Channel m bytes)
-> Tracer m (Role, TraceSendRecv ps)
-> Codec ps failure m bytes
-> PeerPipelined ps pr st m a
-> Peer ps (FlipAgency pr) 'NonPipelined st m b
-> m (a, b)
runConnectedPeersPipelined
      m (Channel m ByteString, Channel m ByteString)
createChannels
      Tracer m (Role, TraceSendRecv (TxSubmission2 TxId Tx))
forall (m :: * -> *) a. Applicative m => Tracer m a
nullTracer
      Codec (TxSubmission2 TxId Tx) DeserialiseFailure m ByteString
forall (m :: * -> *).
MonadST m =>
Codec (TxSubmission2 TxId Tx) DeserialiseFailure m ByteString
codec_v2
      (TxSubmissionServerPipelined TxId Tx m [Tx]
-> PeerPipelined (TxSubmission2 TxId Tx) 'AsServer 'StInit m [Tx]
forall txid tx (m :: * -> *) a.
Functor m =>
TxSubmissionServerPipelined txid tx m a
-> ServerPipelined (TxSubmission2 txid tx) 'StInit m a
txSubmissionServerPeerPipelined (TxSubmissionServerPipelined TxId Tx m [Tx]
 -> PeerPipelined (TxSubmission2 TxId Tx) 'AsServer 'StInit m [Tx])
-> TxSubmissionServerPipelined TxId Tx m [Tx]
-> PeerPipelined (TxSubmission2 TxId Tx) 'AsServer 'StInit m [Tx]
forall a b. (a -> b) -> a -> b
$
       Tracer m (TraceEventServer TxId Tx)
-> TxSubmissionTestParams
-> TxSubmissionServerPipelined TxId Tx m [Tx]
forall (m :: * -> *).
Monad m =>
Tracer m (TraceEventServer TxId Tx)
-> TxSubmissionTestParams -> TestServer m
testServer ((TestName
"server",) (TraceEventServer TxId Tx -> (TestName, TraceEventServer TxId Tx))
-> Tracer m (TestName, TraceEventServer TxId Tx)
-> Tracer m (TraceEventServer TxId Tx)
forall a' a. (a' -> a) -> Tracer m a -> Tracer m a'
forall (f :: * -> *) a' a.
Contravariant f =>
(a' -> a) -> f a -> f a'
`contramap` Tracer m (TestName, TraceEventServer TxId Tx)
forall (m :: * -> *) a. Applicative m => Tracer m a
nullTracer) TxSubmissionTestParams
params)
      (TxSubmissionClient TxId Tx m ()
-> Client (TxSubmission2 TxId Tx) 'NonPipelined 'StInit m ()
forall txid tx (m :: * -> *) a.
Monad m =>
TxSubmissionClient txid tx m a
-> Client (TxSubmission2 txid tx) 'NonPipelined 'StInit m a
txSubmissionClientPeer (TxSubmissionClient TxId Tx m ()
 -> Client (TxSubmission2 TxId Tx) 'NonPipelined 'StInit m ())
-> TxSubmissionClient TxId Tx m ()
-> Client (TxSubmission2 TxId Tx) 'NonPipelined 'StInit m ()
forall a b. (a -> b) -> a -> b
$
       Tracer m (TraceEventClient TxId Tx)
-> TxSubmissionTestParams -> TxSubmissionClient TxId Tx m ()
forall (m :: * -> *).
Monad m =>
Tracer m (TraceEventClient TxId Tx)
-> TxSubmissionTestParams -> TestClient m
testClient ((TestName
"client",) (TraceEventClient TxId Tx -> (TestName, TraceEventClient TxId Tx))
-> Tracer m (TestName, TraceEventClient TxId Tx)
-> Tracer m (TraceEventClient TxId Tx)
forall a' a. (a' -> a) -> Tracer m a -> Tracer m a'
forall (f :: * -> *) a' a.
Contravariant f =>
(a' -> a) -> f a -> f a'
`contramap` Tracer m (TestName, TraceEventClient TxId Tx)
forall (m :: * -> *) a. Applicative m => Tracer m a
nullTracer) TxSubmissionTestParams
params)


-- | Run 'prop_channel' in the simulation monad.
--
prop_channel_ST :: TxSubmissionTestParams
                -> Bool
prop_channel_ST :: TxSubmissionTestParams -> Bool
prop_channel_ST TxSubmissionTestParams
params =
    (forall s. IOSim s Bool) -> Bool
forall a. (forall s. IOSim s a) -> a
runSimOrThrow
      (IOSim
  s (Channel (IOSim s) ByteString, Channel (IOSim s) ByteString)
-> TxSubmissionTestParams -> IOSim s Bool
forall (m :: * -> *).
(MonadAsync m, MonadCatch m, MonadST m) =>
m (Channel m ByteString, Channel m ByteString)
-> TxSubmissionTestParams -> m Bool
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 TxSubmissionTestParams
params)


-- | Run 'prop_channel' in the IO monad.
--
prop_channel_IO :: TxSubmissionTestParams -> Property
prop_channel_IO :: TxSubmissionTestParams -> Property
prop_channel_IO TxSubmissionTestParams
params =
    IO Bool -> Property
forall prop. Testable prop => IO prop -> Property
ioProperty (IO (Channel IO ByteString, Channel IO ByteString)
-> TxSubmissionTestParams -> IO Bool
forall (m :: * -> *).
(MonadAsync m, MonadCatch m, MonadST m) =>
m (Channel m ByteString, Channel m ByteString)
-> TxSubmissionTestParams -> m Bool
prop_channel IO (Channel IO ByteString, Channel IO ByteString)
forall (m :: * -> *) a. MonadSTM m => m (Channel m a, Channel m a)
createConnectedBufferedChannelsUnbounded TxSubmissionTestParams
params)


-- | Run 'prop_channel' in the IO monad using local pipes.
--
prop_pipe_IO :: TxSubmissionTestParams -> Property
prop_pipe_IO :: TxSubmissionTestParams -> Property
prop_pipe_IO TxSubmissionTestParams
params =
    IO Bool -> Property
forall prop. Testable prop => IO prop -> Property
ioProperty (IO (Channel IO ByteString, Channel IO ByteString)
-> TxSubmissionTestParams -> IO Bool
forall (m :: * -> *).
(MonadAsync m, MonadCatch m, MonadST m) =>
m (Channel m ByteString, Channel m ByteString)
-> TxSubmissionTestParams -> m Bool
prop_channel IO (Channel IO ByteString, Channel IO ByteString)
createPipeConnectedChannels TxSubmissionTestParams
params)


deriving newtype instance Arbitrary NumTxIdsToAck
deriving newtype instance Arbitrary NumTxIdsToReq


instance Arbitrary (AnyMessage (TxSubmission2 TxId Tx)) where
  arbitrary :: Gen (AnyMessage (TxSubmission2 TxId Tx))
arbitrary = [Gen (AnyMessage (TxSubmission2 TxId Tx))]
-> Gen (AnyMessage (TxSubmission2 TxId Tx))
forall a. [Gen a] -> Gen a
oneof
    [ AnyMessage (TxSubmission2 TxId Tx)
-> Gen (AnyMessage (TxSubmission2 TxId Tx))
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (AnyMessage (TxSubmission2 TxId Tx)
 -> Gen (AnyMessage (TxSubmission2 TxId Tx)))
-> AnyMessage (TxSubmission2 TxId Tx)
-> Gen (AnyMessage (TxSubmission2 TxId Tx))
forall a b. (a -> b) -> a -> b
$ Message (TxSubmission2 TxId Tx) 'StInit 'StIdle
-> AnyMessage (TxSubmission2 TxId Tx)
forall ps (st :: ps) (st' :: ps).
(StateTokenI st, ActiveState st) =>
Message ps st st' -> AnyMessage ps
AnyMessage Message (TxSubmission2 TxId Tx) 'StInit 'StIdle
forall {k} {k1} (txid :: k) (tx :: k1).
Message (TxSubmission2 txid tx) 'StInit 'StIdle
MsgInit
    , Message (TxSubmission2 TxId Tx) 'StIdle ('StTxIds 'StBlocking)
-> AnyMessage (TxSubmission2 TxId Tx)
forall ps (st :: ps) (st' :: ps).
(StateTokenI st, ActiveState st) =>
Message ps st st' -> AnyMessage ps
AnyMessage  (Message (TxSubmission2 TxId Tx) 'StIdle ('StTxIds 'StBlocking)
 -> AnyMessage (TxSubmission2 TxId Tx))
-> Gen
     (Message (TxSubmission2 TxId Tx) 'StIdle ('StTxIds 'StBlocking))
-> Gen (AnyMessage (TxSubmission2 TxId Tx))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
        (SingBlockingStyle 'StBlocking
-> NumTxIdsToAck
-> NumTxIdsToReq
-> Message (TxSubmission2 TxId Tx) 'StIdle ('StTxIds 'StBlocking)
forall {k} {k1} (blocking :: StBlockingStyle) (txid :: k)
       (tx :: k1).
SingBlockingStyle blocking
-> NumTxIdsToAck
-> NumTxIdsToReq
-> Message (TxSubmission2 txid tx) 'StIdle ('StTxIds blocking)
MsgRequestTxIds SingBlockingStyle 'StBlocking
SingBlocking
                     (NumTxIdsToAck
 -> NumTxIdsToReq
 -> Message (TxSubmission2 TxId Tx) 'StIdle ('StTxIds 'StBlocking))
-> Gen NumTxIdsToAck
-> Gen
     (NumTxIdsToReq
      -> Message (TxSubmission2 TxId Tx) 'StIdle ('StTxIds 'StBlocking))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen NumTxIdsToAck
forall a. Arbitrary a => Gen a
arbitrary
                     Gen
  (NumTxIdsToReq
   -> Message (TxSubmission2 TxId Tx) 'StIdle ('StTxIds 'StBlocking))
-> Gen NumTxIdsToReq
-> Gen
     (Message (TxSubmission2 TxId Tx) 'StIdle ('StTxIds 'StBlocking))
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen NumTxIdsToReq
forall a. Arbitrary a => Gen a
arbitrary)

    , Message (TxSubmission2 TxId Tx) 'StIdle ('StTxIds 'StNonBlocking)
-> AnyMessage (TxSubmission2 TxId Tx)
forall ps (st :: ps) (st' :: ps).
(StateTokenI st, ActiveState st) =>
Message ps st st' -> AnyMessage ps
AnyMessage (Message (TxSubmission2 TxId Tx) 'StIdle ('StTxIds 'StNonBlocking)
 -> AnyMessage (TxSubmission2 TxId Tx))
-> Gen
     (Message (TxSubmission2 TxId Tx) 'StIdle ('StTxIds 'StNonBlocking))
-> Gen (AnyMessage (TxSubmission2 TxId Tx))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
        (SingBlockingStyle 'StNonBlocking
-> NumTxIdsToAck
-> NumTxIdsToReq
-> Message
     (TxSubmission2 TxId Tx) 'StIdle ('StTxIds 'StNonBlocking)
forall {k} {k1} (blocking :: StBlockingStyle) (txid :: k)
       (tx :: k1).
SingBlockingStyle blocking
-> NumTxIdsToAck
-> NumTxIdsToReq
-> Message (TxSubmission2 txid tx) 'StIdle ('StTxIds blocking)
MsgRequestTxIds SingBlockingStyle 'StNonBlocking
SingNonBlocking
                     (NumTxIdsToAck
 -> NumTxIdsToReq
 -> Message
      (TxSubmission2 TxId Tx) 'StIdle ('StTxIds 'StNonBlocking))
-> Gen NumTxIdsToAck
-> Gen
     (NumTxIdsToReq
      -> Message
           (TxSubmission2 TxId Tx) 'StIdle ('StTxIds 'StNonBlocking))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen NumTxIdsToAck
forall a. Arbitrary a => Gen a
arbitrary
                     Gen
  (NumTxIdsToReq
   -> Message
        (TxSubmission2 TxId Tx) 'StIdle ('StTxIds 'StNonBlocking))
-> Gen NumTxIdsToReq
-> Gen
     (Message (TxSubmission2 TxId Tx) 'StIdle ('StTxIds 'StNonBlocking))
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen NumTxIdsToReq
forall a. Arbitrary a => Gen a
arbitrary)

    , Message (TxSubmission2 TxId Tx) ('StTxIds 'StBlocking) 'StIdle
-> AnyMessage (TxSubmission2 TxId Tx)
forall ps (st :: ps) (st' :: ps).
(StateTokenI st, ActiveState st) =>
Message ps st st' -> AnyMessage ps
AnyMessage (Message (TxSubmission2 TxId Tx) ('StTxIds 'StBlocking) 'StIdle
 -> AnyMessage (TxSubmission2 TxId Tx))
-> (BlockingReplyList 'StBlocking (TxId, SizeInBytes)
    -> Message (TxSubmission2 TxId Tx) ('StTxIds 'StBlocking) 'StIdle)
-> BlockingReplyList 'StBlocking (TxId, SizeInBytes)
-> AnyMessage (TxSubmission2 TxId Tx)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
        BlockingReplyList 'StBlocking (TxId, SizeInBytes)
-> Message (TxSubmission2 TxId Tx) ('StTxIds 'StBlocking) 'StIdle
forall {k1} (blocking :: StBlockingStyle) txid1 (tx :: k1).
BlockingReplyList blocking (txid1, SizeInBytes)
-> Message (TxSubmission2 txid1 tx) ('StTxIds blocking) 'StIdle
MsgReplyTxIds (BlockingReplyList 'StBlocking (TxId, SizeInBytes)
 -> AnyMessage (TxSubmission2 TxId Tx))
-> Gen (BlockingReplyList 'StBlocking (TxId, SizeInBytes))
-> Gen (AnyMessage (TxSubmission2 TxId Tx))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (NonEmpty (TxId, SizeInBytes)
-> BlockingReplyList 'StBlocking (TxId, SizeInBytes)
forall a. NonEmpty a -> BlockingReplyList 'StBlocking a
BlockingReply (NonEmpty (TxId, SizeInBytes)
 -> BlockingReplyList 'StBlocking (TxId, SizeInBytes))
-> (NonEmptyList (TxId, Word32) -> NonEmpty (TxId, SizeInBytes))
-> NonEmptyList (TxId, Word32)
-> BlockingReplyList 'StBlocking (TxId, SizeInBytes)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(TxId, SizeInBytes)] -> NonEmpty (TxId, SizeInBytes)
forall a. HasCallStack => [a] -> NonEmpty a
NonEmpty.fromList
                                         ([(TxId, SizeInBytes)] -> NonEmpty (TxId, SizeInBytes))
-> (NonEmptyList (TxId, Word32) -> [(TxId, SizeInBytes)])
-> NonEmptyList (TxId, Word32)
-> NonEmpty (TxId, SizeInBytes)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((TxId, Word32) -> (TxId, SizeInBytes))
-> [(TxId, Word32)] -> [(TxId, SizeInBytes)]
forall a b. (a -> b) -> [a] -> [b]
map ((Word32 -> SizeInBytes) -> (TxId, Word32) -> (TxId, SizeInBytes)
forall b c a. (b -> c) -> (a, b) -> (a, c)
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second Word32 -> SizeInBytes
SizeInBytes)
                                         ([(TxId, Word32)] -> [(TxId, SizeInBytes)])
-> (NonEmptyList (TxId, Word32) -> [(TxId, Word32)])
-> NonEmptyList (TxId, Word32)
-> [(TxId, SizeInBytes)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmptyList (TxId, Word32) -> [(TxId, Word32)]
forall a. NonEmptyList a -> [a]
QC.getNonEmpty
                                       (NonEmptyList (TxId, Word32)
 -> BlockingReplyList 'StBlocking (TxId, SizeInBytes))
-> Gen (NonEmptyList (TxId, Word32))
-> Gen (BlockingReplyList 'StBlocking (TxId, SizeInBytes))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (NonEmptyList (TxId, Word32))
forall a. Arbitrary a => Gen a
arbitrary)

    , Message (TxSubmission2 TxId Tx) ('StTxIds 'StNonBlocking) 'StIdle
-> AnyMessage (TxSubmission2 TxId Tx)
forall ps (st :: ps) (st' :: ps).
(StateTokenI st, ActiveState st) =>
Message ps st st' -> AnyMessage ps
AnyMessage (Message (TxSubmission2 TxId Tx) ('StTxIds 'StNonBlocking) 'StIdle
 -> AnyMessage (TxSubmission2 TxId Tx))
-> (BlockingReplyList 'StNonBlocking (TxId, SizeInBytes)
    -> Message
         (TxSubmission2 TxId Tx) ('StTxIds 'StNonBlocking) 'StIdle)
-> BlockingReplyList 'StNonBlocking (TxId, SizeInBytes)
-> AnyMessage (TxSubmission2 TxId Tx)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BlockingReplyList 'StNonBlocking (TxId, SizeInBytes)
-> Message
     (TxSubmission2 TxId Tx) ('StTxIds 'StNonBlocking) 'StIdle
forall {k1} (blocking :: StBlockingStyle) txid1 (tx :: k1).
BlockingReplyList blocking (txid1, SizeInBytes)
-> Message (TxSubmission2 txid1 tx) ('StTxIds blocking) 'StIdle
MsgReplyTxIds (BlockingReplyList 'StNonBlocking (TxId, SizeInBytes)
 -> AnyMessage (TxSubmission2 TxId Tx))
-> Gen (BlockingReplyList 'StNonBlocking (TxId, SizeInBytes))
-> Gen (AnyMessage (TxSubmission2 TxId Tx))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ([(TxId, SizeInBytes)]
-> BlockingReplyList 'StNonBlocking (TxId, SizeInBytes)
forall a. [a] -> BlockingReplyList 'StNonBlocking a
NonBlockingReply ([(TxId, SizeInBytes)]
 -> BlockingReplyList 'StNonBlocking (TxId, SizeInBytes))
-> ([(TxId, Word32)] -> [(TxId, SizeInBytes)])
-> [(TxId, Word32)]
-> BlockingReplyList 'StNonBlocking (TxId, SizeInBytes)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((TxId, Word32) -> (TxId, SizeInBytes))
-> [(TxId, Word32)] -> [(TxId, SizeInBytes)]
forall a b. (a -> b) -> [a] -> [b]
map ((Word32 -> SizeInBytes) -> (TxId, Word32) -> (TxId, SizeInBytes)
forall b c a. (b -> c) -> (a, b) -> (a, c)
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second Word32 -> SizeInBytes
SizeInBytes) ([(TxId, Word32)]
 -> BlockingReplyList 'StNonBlocking (TxId, SizeInBytes))
-> Gen [(TxId, Word32)]
-> Gen (BlockingReplyList 'StNonBlocking (TxId, SizeInBytes))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen [(TxId, Word32)]
forall a. Arbitrary a => Gen a
arbitrary)

    , Message (TxSubmission2 TxId Tx) 'StIdle 'StTxs
-> AnyMessage (TxSubmission2 TxId Tx)
forall ps (st :: ps) (st' :: ps).
(StateTokenI st, ActiveState st) =>
Message ps st st' -> AnyMessage ps
AnyMessage (Message (TxSubmission2 TxId Tx) 'StIdle 'StTxs
 -> AnyMessage (TxSubmission2 TxId Tx))
-> ([TxId] -> Message (TxSubmission2 TxId Tx) 'StIdle 'StTxs)
-> [TxId]
-> AnyMessage (TxSubmission2 TxId Tx)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [TxId] -> Message (TxSubmission2 TxId Tx) 'StIdle 'StTxs
forall {k1} txid1 (tx :: k1).
[txid1] -> Message (TxSubmission2 txid1 tx) 'StIdle 'StTxs
MsgRequestTxs ([TxId] -> AnyMessage (TxSubmission2 TxId Tx))
-> Gen [TxId] -> Gen (AnyMessage (TxSubmission2 TxId Tx))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen [TxId]
forall a. Arbitrary a => Gen a
arbitrary

    , Message (TxSubmission2 TxId Tx) 'StTxs 'StIdle
-> AnyMessage (TxSubmission2 TxId Tx)
forall ps (st :: ps) (st' :: ps).
(StateTokenI st, ActiveState st) =>
Message ps st st' -> AnyMessage ps
AnyMessage (Message (TxSubmission2 TxId Tx) 'StTxs 'StIdle
 -> AnyMessage (TxSubmission2 TxId Tx))
-> ([Tx] -> Message (TxSubmission2 TxId Tx) 'StTxs 'StIdle)
-> [Tx]
-> AnyMessage (TxSubmission2 TxId Tx)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Tx] -> Message (TxSubmission2 TxId Tx) 'StTxs 'StIdle
forall {k} tx1 (txid :: k).
[tx1] -> Message (TxSubmission2 txid tx1) 'StTxs 'StIdle
MsgReplyTxs ([Tx] -> AnyMessage (TxSubmission2 TxId Tx))
-> Gen [Tx] -> Gen (AnyMessage (TxSubmission2 TxId Tx))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen [Tx]
forall a. Arbitrary a => Gen a
arbitrary

    , Message (TxSubmission2 TxId Tx) ('StTxIds 'StBlocking) 'StDone
-> AnyMessage (TxSubmission2 TxId Tx)
forall ps (st :: ps) (st' :: ps).
(StateTokenI st, ActiveState st) =>
Message ps st st' -> AnyMessage ps
AnyMessage (Message (TxSubmission2 TxId Tx) ('StTxIds 'StBlocking) 'StDone
 -> AnyMessage (TxSubmission2 TxId Tx))
-> Gen
     (Message (TxSubmission2 TxId Tx) ('StTxIds 'StBlocking) 'StDone)
-> Gen (AnyMessage (TxSubmission2 TxId Tx))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Message (TxSubmission2 TxId Tx) ('StTxIds 'StBlocking) 'StDone
-> Gen
     (Message (TxSubmission2 TxId Tx) ('StTxIds 'StBlocking) 'StDone)
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Message (TxSubmission2 TxId Tx) ('StTxIds 'StBlocking) 'StDone
forall {k} {k1} (txid :: k) (tx :: k1).
Message (TxSubmission2 txid tx) ('StTxIds 'StBlocking) 'StDone
MsgDone
    ]

instance (Eq txid, Eq tx) => Eq (AnyMessage (TxSubmission2 txid tx)) where

  == :: AnyMessage (TxSubmission2 txid tx)
-> AnyMessage (TxSubmission2 txid tx) -> Bool
(==) (AnyMessage Message (TxSubmission2 txid tx) st st'
R:MessageTxSubmission2fromto (*) (*) txid tx st st'
MsgInit)
       (AnyMessage Message (TxSubmission2 txid tx) st st'
R:MessageTxSubmission2fromto (*) (*) txid tx st st'
MsgInit) = Bool
True

  (==) (AnyMessage (MsgRequestTxIds SingBlockingStyle blocking
SingBlocking NumTxIdsToAck
ackNo  NumTxIdsToReq
reqNo))
       (AnyMessage (MsgRequestTxIds SingBlockingStyle blocking
SingBlocking NumTxIdsToAck
ackNo' NumTxIdsToReq
reqNo')) =
    (NumTxIdsToAck
ackNo, NumTxIdsToReq
reqNo) (NumTxIdsToAck, NumTxIdsToReq)
-> (NumTxIdsToAck, NumTxIdsToReq) -> Bool
forall a. Eq a => a -> a -> Bool
== (NumTxIdsToAck
ackNo', NumTxIdsToReq
reqNo')

  (==) (AnyMessage (MsgRequestTxIds SingBlockingStyle blocking
SingNonBlocking NumTxIdsToAck
ackNo  NumTxIdsToReq
reqNo))
       (AnyMessage (MsgRequestTxIds SingBlockingStyle blocking
SingNonBlocking NumTxIdsToAck
ackNo' NumTxIdsToReq
reqNo')) =
    (NumTxIdsToAck
ackNo, NumTxIdsToReq
reqNo) (NumTxIdsToAck, NumTxIdsToReq)
-> (NumTxIdsToAck, NumTxIdsToReq) -> Bool
forall a. Eq a => a -> a -> Bool
== (NumTxIdsToAck
ackNo', NumTxIdsToReq
reqNo')

  (==) (AnyMessage (MsgReplyTxIds (BlockingReply NonEmpty (txid1, SizeInBytes)
txids)))
       (AnyMessage (MsgReplyTxIds (BlockingReply NonEmpty (txid1, SizeInBytes)
txids'))) =
    NonEmpty (txid1, SizeInBytes)
txids NonEmpty (txid1, SizeInBytes)
-> NonEmpty (txid1, SizeInBytes) -> Bool
forall a. Eq a => a -> a -> Bool
== NonEmpty (txid1, SizeInBytes)
NonEmpty (txid1, SizeInBytes)
txids'

  (==) (AnyMessage (MsgReplyTxIds (NonBlockingReply [(txid1, SizeInBytes)]
txids)))
       (AnyMessage (MsgReplyTxIds (NonBlockingReply [(txid1, SizeInBytes)]
txids'))) =
    [(txid1, SizeInBytes)]
txids [(txid1, SizeInBytes)] -> [(txid1, SizeInBytes)] -> Bool
forall a. Eq a => a -> a -> Bool
== [(txid1, SizeInBytes)]
[(txid1, SizeInBytes)]
txids'

  (==) (AnyMessage (MsgRequestTxs [txid1]
txids))
       (AnyMessage (MsgRequestTxs [txid1]
txids')) = [txid1]
txids [txid1] -> [txid1] -> Bool
forall a. Eq a => a -> a -> Bool
== [txid1]
[txid1]
txids'

  (==) (AnyMessage (MsgReplyTxs [tx1]
txs))
       (AnyMessage (MsgReplyTxs [tx1]
txs')) = [tx1]
txs [tx1] -> [tx1] -> Bool
forall a. Eq a => a -> a -> Bool
== [tx1]
[tx1]
txs'

  (==) (AnyMessage Message (TxSubmission2 txid tx) st st'
R:MessageTxSubmission2fromto (*) (*) txid tx st st'
MsgDone)
       (AnyMessage Message (TxSubmission2 txid tx) st st'
R:MessageTxSubmission2fromto (*) (*) txid tx st st'
MsgDone) = Bool
True

  AnyMessage (TxSubmission2 txid tx)
_ == AnyMessage (TxSubmission2 txid tx)
_ = Bool
False


codec_v2 :: MonadST m
         => Codec (TxSubmission2 TxId Tx)
                   DeserialiseFailure
                   m ByteString
codec_v2 :: forall (m :: * -> *).
MonadST m =>
Codec (TxSubmission2 TxId Tx) DeserialiseFailure m ByteString
codec_v2 = (TxId -> Encoding)
-> (forall s. Decoder s TxId)
-> (Tx -> Encoding)
-> (forall s. Decoder s Tx)
-> Codec (TxSubmission2 TxId Tx) DeserialiseFailure m ByteString
forall txid tx (m :: * -> *).
MonadST m =>
(txid -> Encoding)
-> (forall s. Decoder s txid)
-> (tx -> Encoding)
-> (forall s. Decoder s tx)
-> Codec (TxSubmission2 txid tx) DeserialiseFailure m ByteString
codecTxSubmission2
           TxId -> Encoding
forall a. Serialise a => a -> Encoding
Serialise.encode Decoder s TxId
forall s. Decoder s TxId
forall a s. Serialise a => Decoder s a
Serialise.decode
           Tx -> Encoding
forall a. Serialise a => a -> Encoding
Serialise.encode Decoder s Tx
forall s. Decoder s Tx
forall a s. Serialise a => Decoder s a
Serialise.decode


-- | Check the codec round trip property.
--
prop_codec :: AnyMessage (TxSubmission2 TxId Tx) -> Bool
prop_codec :: AnyMessage (TxSubmission2 TxId Tx) -> Bool
prop_codec AnyMessage (TxSubmission2 TxId Tx)
msg =
  (forall s. ST s Bool) -> Bool
forall a. (forall s. ST s a) -> a
runST (Codec (TxSubmission2 TxId Tx) DeserialiseFailure (ST s) ByteString
-> AnyMessage (TxSubmission2 TxId Tx) -> ST s Bool
forall ps failure (m :: * -> *) bytes.
(Monad m, Eq (AnyMessage ps)) =>
Codec ps failure m bytes -> AnyMessage ps -> m Bool
prop_codecM Codec (TxSubmission2 TxId Tx) DeserialiseFailure (ST s) ByteString
forall (m :: * -> *).
MonadST m =>
Codec (TxSubmission2 TxId Tx) DeserialiseFailure m ByteString
codec_v2 AnyMessage (TxSubmission2 TxId Tx)
msg)

-- | Check the codec round trip property for the id condec.
--
prop_codec_id :: AnyMessage (TxSubmission2 TxId Tx) -> Bool
prop_codec_id :: AnyMessage (TxSubmission2 TxId Tx) -> Bool
prop_codec_id AnyMessage (TxSubmission2 TxId Tx)
msg =
  (forall s. ST s Bool) -> Bool
forall a. (forall s. ST s a) -> a
runST (Codec
  (TxSubmission2 TxId Tx)
  CodecFailure
  (ST s)
  (AnyMessage (TxSubmission2 TxId Tx))
-> AnyMessage (TxSubmission2 TxId Tx) -> ST s Bool
forall ps failure (m :: * -> *) bytes.
(Monad m, Eq (AnyMessage ps)) =>
Codec ps failure m bytes -> AnyMessage ps -> m Bool
prop_codecM Codec
  (TxSubmission2 TxId Tx)
  CodecFailure
  (ST s)
  (AnyMessage (TxSubmission2 TxId Tx))
forall {k} {k1} (txid :: k) (tx :: k1) (m :: * -> *).
Monad m =>
Codec
  (TxSubmission2 txid tx)
  CodecFailure
  m
  (AnyMessage (TxSubmission2 txid tx))
codecTxSubmission2Id AnyMessage (TxSubmission2 TxId Tx)
msg)

-- | Check for data chunk boundary problems in the codec using 2 chunks.
--
prop_codec_splits2 :: AnyMessage (TxSubmission2 TxId Tx) -> Bool
prop_codec_splits2 :: AnyMessage (TxSubmission2 TxId Tx) -> Bool
prop_codec_splits2 AnyMessage (TxSubmission2 TxId Tx)
msg =
  (forall s. ST s Bool) -> Bool
forall a. (forall s. ST s a) -> a
runST ((ByteString -> [[ByteString]])
-> Codec
     (TxSubmission2 TxId Tx) DeserialiseFailure (ST s) ByteString
-> AnyMessage (TxSubmission2 TxId Tx)
-> ST s Bool
forall ps failure (m :: * -> *) bytes.
(Monad m, Eq (AnyMessage ps)) =>
(bytes -> [[bytes]])
-> Codec ps failure m bytes -> AnyMessage ps -> m Bool
prop_codec_splitsM ByteString -> [[ByteString]]
splits2 Codec (TxSubmission2 TxId Tx) DeserialiseFailure (ST s) ByteString
forall (m :: * -> *).
MonadST m =>
Codec (TxSubmission2 TxId Tx) DeserialiseFailure m ByteString
codec_v2 AnyMessage (TxSubmission2 TxId Tx)
msg)

-- | Check for data chunk boundary problems in the codec using 3 chunks.
--
prop_codec_splits3 :: AnyMessage (TxSubmission2 TxId Tx) -> Bool
prop_codec_splits3 :: AnyMessage (TxSubmission2 TxId Tx) -> Bool
prop_codec_splits3 AnyMessage (TxSubmission2 TxId Tx)
msg =
  (forall s. ST s Bool) -> Bool
forall a. (forall s. ST s a) -> a
runST ((ByteString -> [[ByteString]])
-> Codec
     (TxSubmission2 TxId Tx) DeserialiseFailure (ST s) ByteString
-> AnyMessage (TxSubmission2 TxId Tx)
-> ST s Bool
forall ps failure (m :: * -> *) bytes.
(Monad m, Eq (AnyMessage ps)) =>
(bytes -> [[bytes]])
-> Codec ps failure m bytes -> AnyMessage ps -> m Bool
prop_codec_splitsM ByteString -> [[ByteString]]
splits3 Codec (TxSubmission2 TxId Tx) DeserialiseFailure (ST s) ByteString
forall (m :: * -> *).
MonadST m =>
Codec (TxSubmission2 TxId Tx) DeserialiseFailure m ByteString
codec_v2 AnyMessage (TxSubmission2 TxId Tx)
msg)

prop_codec_cbor
  :: AnyMessage (TxSubmission2 TxId Tx)
  -> Bool
prop_codec_cbor :: AnyMessage (TxSubmission2 TxId Tx) -> Bool
prop_codec_cbor AnyMessage (TxSubmission2 TxId Tx)
msg =
  (forall s. ST s Bool) -> Bool
forall a. (forall s. ST s a) -> a
runST (Codec (TxSubmission2 TxId Tx) DeserialiseFailure (ST s) ByteString
-> AnyMessage (TxSubmission2 TxId Tx) -> ST s Bool
forall ps (m :: * -> *).
Monad m =>
Codec ps DeserialiseFailure m ByteString -> AnyMessage ps -> m Bool
prop_codec_cborM Codec (TxSubmission2 TxId Tx) DeserialiseFailure (ST s) ByteString
forall (m :: * -> *).
MonadST m =>
Codec (TxSubmission2 TxId Tx) DeserialiseFailure m ByteString
codec_v2 AnyMessage (TxSubmission2 TxId Tx)
msg)

-- | Check that the encoder produces a valid CBOR.
--
prop_codec_valid_cbor
  :: AnyMessage (TxSubmission2 TxId Tx)
  -> Property
prop_codec_valid_cbor :: AnyMessage (TxSubmission2 TxId Tx) -> Property
prop_codec_valid_cbor = Codec (TxSubmission2 TxId Tx) DeserialiseFailure IO ByteString
-> AnyMessage (TxSubmission2 TxId Tx) -> Property
forall ps.
Codec ps DeserialiseFailure IO ByteString
-> AnyMessage ps -> Property
prop_codec_valid_cbor_encoding Codec (TxSubmission2 TxId Tx) DeserialiseFailure IO ByteString
forall (m :: * -> *).
MonadST m =>
Codec (TxSubmission2 TxId Tx) DeserialiseFailure m ByteString
codec_v2

--
-- Local generators
--

data TxSubmissionTestParams =
     TxSubmissionTestParams {
       TxSubmissionTestParams -> Positive (Small Word16)
testMaxUnacked        :: Positive (Small Word16),
       TxSubmissionTestParams -> Positive (Small Word16)
testMaxTxIdsToRequest :: Positive (Small Word16),
       TxSubmissionTestParams -> Positive (Small Word16)
testMaxTxToRequest    :: Positive (Small Word16),
       TxSubmissionTestParams -> DistinctList Tx
testTransactions      :: DistinctList Tx
     }
  deriving Int -> TxSubmissionTestParams -> ShowS
[TxSubmissionTestParams] -> ShowS
TxSubmissionTestParams -> TestName
(Int -> TxSubmissionTestParams -> ShowS)
-> (TxSubmissionTestParams -> TestName)
-> ([TxSubmissionTestParams] -> ShowS)
-> Show TxSubmissionTestParams
forall a.
(Int -> a -> ShowS) -> (a -> TestName) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TxSubmissionTestParams -> ShowS
showsPrec :: Int -> TxSubmissionTestParams -> ShowS
$cshow :: TxSubmissionTestParams -> TestName
show :: TxSubmissionTestParams -> TestName
$cshowList :: [TxSubmissionTestParams] -> ShowS
showList :: [TxSubmissionTestParams] -> ShowS
Show

instance Arbitrary TxSubmissionTestParams where
  arbitrary :: Gen TxSubmissionTestParams
arbitrary =
    Positive (Small Word16)
-> Positive (Small Word16)
-> Positive (Small Word16)
-> DistinctList Tx
-> TxSubmissionTestParams
TxSubmissionTestParams (Positive (Small Word16)
 -> Positive (Small Word16)
 -> Positive (Small Word16)
 -> DistinctList Tx
 -> TxSubmissionTestParams)
-> Gen (Positive (Small Word16))
-> Gen
     (Positive (Small Word16)
      -> Positive (Small Word16)
      -> DistinctList Tx
      -> TxSubmissionTestParams)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (Positive (Small Word16))
forall a. Arbitrary a => Gen a
arbitrary
                           Gen
  (Positive (Small Word16)
   -> Positive (Small Word16)
   -> DistinctList Tx
   -> TxSubmissionTestParams)
-> Gen (Positive (Small Word16))
-> Gen
     (Positive (Small Word16)
      -> DistinctList Tx -> TxSubmissionTestParams)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen (Positive (Small Word16))
forall a. Arbitrary a => Gen a
arbitrary
                           Gen
  (Positive (Small Word16)
   -> DistinctList Tx -> TxSubmissionTestParams)
-> Gen (Positive (Small Word16))
-> Gen (DistinctList Tx -> TxSubmissionTestParams)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen (Positive (Small Word16))
forall a. Arbitrary a => Gen a
arbitrary
                           Gen (DistinctList Tx -> TxSubmissionTestParams)
-> Gen (DistinctList Tx) -> Gen TxSubmissionTestParams
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen (DistinctList Tx)
forall a. Arbitrary a => Gen a
arbitrary

  shrink :: TxSubmissionTestParams -> [TxSubmissionTestParams]
shrink (TxSubmissionTestParams Positive (Small Word16)
a Positive (Small Word16)
b Positive (Small Word16)
c DistinctList Tx
d) =
    [ Positive (Small Word16)
-> Positive (Small Word16)
-> Positive (Small Word16)
-> DistinctList Tx
-> TxSubmissionTestParams
TxSubmissionTestParams Positive (Small Word16)
a' Positive (Small Word16)
b' Positive (Small Word16)
c' DistinctList Tx
d'
    | (Positive (Small Word16)
a', Positive (Small Word16)
b', Positive (Small Word16)
c', DistinctList Tx
d') <- (Positive (Small Word16), Positive (Small Word16),
 Positive (Small Word16), DistinctList Tx)
-> [(Positive (Small Word16), Positive (Small Word16),
     Positive (Small Word16), DistinctList Tx)]
forall a. Arbitrary a => a -> [a]
shrink (Positive (Small Word16)
a, Positive (Small Word16)
b, Positive (Small Word16)
c, DistinctList Tx
d) ]


newtype DistinctList a = DistinctList { forall a. DistinctList a -> [a]
fromDistinctList :: [a] }
  deriving Int -> DistinctList a -> ShowS
[DistinctList a] -> ShowS
DistinctList a -> TestName
(Int -> DistinctList a -> ShowS)
-> (DistinctList a -> TestName)
-> ([DistinctList a] -> ShowS)
-> Show (DistinctList a)
forall a. Show a => Int -> DistinctList a -> ShowS
forall a. Show a => [DistinctList a] -> ShowS
forall a. Show a => DistinctList a -> TestName
forall a.
(Int -> a -> ShowS) -> (a -> TestName) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Show a => Int -> DistinctList a -> ShowS
showsPrec :: Int -> DistinctList a -> ShowS
$cshow :: forall a. Show a => DistinctList a -> TestName
show :: DistinctList a -> TestName
$cshowList :: forall a. Show a => [DistinctList a] -> ShowS
showList :: [DistinctList a] -> ShowS
Show

instance (Eq a, Arbitrary a) => Arbitrary (DistinctList a) where
  arbitrary :: Gen (DistinctList a)
arbitrary = [a] -> DistinctList a
forall a. [a] -> DistinctList a
DistinctList ([a] -> DistinctList a) -> ([a] -> [a]) -> [a] -> DistinctList a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> [a]
forall a. Eq a => [a] -> [a]
nub ([a] -> DistinctList a) -> Gen [a] -> Gen (DistinctList a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen [a]
forall a. Arbitrary a => Gen a
arbitrary

  shrink :: DistinctList a -> [DistinctList a]
shrink (DistinctList [a]
xs) =
    [ [a] -> DistinctList a
forall a. [a] -> DistinctList a
DistinctList ([a] -> [a]
forall a. Eq a => [a] -> [a]
nub [a]
xs') | [a]
xs' <- [a] -> [[a]]
forall a. Arbitrary a => a -> [a]
shrink [a]
xs ]