{-# LANGUAGE DataKinds          #-}
{-# LANGUAGE GADTs              #-}
{-# LANGUAGE LambdaCase         #-}
{-# LANGUAGE NamedFieldPuns     #-}
{-# LANGUAGE NumericUnderscores #-}

-- | Values with a CBOR encoding of an exact, chosen size, for testing size
-- limits of codecs, and `TxSubmission2` messages built from them within
-- given size bounds.
--
module Test.Ouroboros.Network.TxSubmission.SizedBytes
  ( tests
  , SizedBytes (..)
  , codec_sized
  , TxSubmission2Bounds (..)
  , genBoundedMessage
  , shrinkBoundedMessage
  , withinBounds
  ) where

import Data.Bits (shiftR)
import Data.ByteString qualified as BS
import Data.ByteString.Lazy (ByteString)
import Data.ByteString.Lazy qualified as BSL
import Data.List (sort)
import Data.List.NonEmpty qualified as NonEmpty
import Data.Word (Word16, Word8)

import Codec.CBOR.Decoding qualified as CBOR
import Codec.CBOR.Encoding qualified as CBOR
import Codec.CBOR.Read qualified as CBOR
import Codec.CBOR.Write qualified as CBOR

import Control.Monad.Class.MonadST (MonadST)

import Network.TypedProtocol.Codec (AnyMessage (..), Codec)

import Ouroboros.Network.Protocol.TxSubmission2.Codec (codecTxSubmission2)
import Ouroboros.Network.Protocol.TxSubmission2.Type

import Test.QuickCheck
import Test.Tasty (TestTree, testGroup)
import Test.Tasty.QuickCheck (testProperty)


tests :: TestTree
tests :: TestTree
tests =
  TestName -> [TestTree] -> TestTree
testGroup TestName
"SizedBytes"
    [ TestName -> (SizedBytes -> Property) -> TestTree
forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"size"       SizedBytes -> Property
prop_sizedBytes_encoded_size
    , TestName -> (SizedBytes -> Property) -> TestTree
forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"round trip" SizedBytes -> Property
prop_sizedBytes_roundtrip
    ]

-- | A value represented only by the size of its CBOR encoding, which is
-- a byte string of exactly that many bytes.  It can stand in for any
-- encoded value, to build encodings of a chosen size.
--
newtype SizedBytes = SizedBytes { SizedBytes -> Word
size :: Word }
  deriving (SizedBytes -> SizedBytes -> Bool
(SizedBytes -> SizedBytes -> Bool)
-> (SizedBytes -> SizedBytes -> Bool) -> Eq SizedBytes
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SizedBytes -> SizedBytes -> Bool
== :: SizedBytes -> SizedBytes -> Bool
$c/= :: SizedBytes -> SizedBytes -> Bool
/= :: SizedBytes -> SizedBytes -> Bool
Eq, Int -> SizedBytes -> ShowS
[SizedBytes] -> ShowS
SizedBytes -> TestName
(Int -> SizedBytes -> ShowS)
-> (SizedBytes -> TestName)
-> ([SizedBytes] -> ShowS)
-> Show SizedBytes
forall a.
(Int -> a -> ShowS) -> (a -> TestName) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SizedBytes -> ShowS
showsPrec :: Int -> SizedBytes -> ShowS
$cshow :: SizedBytes -> TestName
show :: SizedBytes -> TestName
$cshowList :: [SizedBytes] -> ShowS
showList :: [SizedBytes] -> ShowS
Show)

-- | Encode a CBOR byte string of exactly the given size (at least 1).  The
-- length header isn't necessarily minimal, which is valid (non-canonical)
-- CBOR.
--
encodeSizedBytes :: SizedBytes -> CBOR.Encoding
encodeSizedBytes :: SizedBytes -> Encoding
encodeSizedBytes (SizedBytes Word
size)
    | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
24
    = ByteString -> Encoding
CBOR.encodePreEncoded
    (ByteString -> Encoding) -> ByteString -> Encoding
forall a b. (a -> b) -> a -> b
$ Word8 -> ByteString -> ByteString
BS.cons (Word8
0x40 Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
+ Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)) (Int -> Word8 -> ByteString
BS.replicate (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Word8
0)
    | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
3 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
0xffff
    = ByteString -> Encoding
CBOR.encodePreEncoded
    (ByteString -> Encoding) -> ByteString -> Encoding
forall a b. (a -> b) -> a -> b
$ [Word8] -> ByteString
BS.pack [Word8
0x59, Int -> Int -> Word8
byte Int
1 (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
3), Int -> Int -> Word8
byte Int
0 (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
3)]
   ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> Int -> Word8 -> ByteString
BS.replicate (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
3) Word8
0
    | Bool
otherwise
    = ByteString -> Encoding
CBOR.encodePreEncoded
    (ByteString -> Encoding) -> ByteString -> Encoding
forall a b. (a -> b) -> a -> b
$ [Word8] -> ByteString
BS.pack [Word8
0x5a, Int -> Int -> Word8
byte Int
3 (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
5), Int -> Int -> Word8
byte Int
2 (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
5), Int -> Int -> Word8
byte Int
1 (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
5), Int -> Int -> Word8
byte Int
0 (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
5)]
   ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> Int -> Word8 -> ByteString
BS.replicate (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
5) Word8
0
  where
    n :: Int
    n :: Int
n = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
1 (Word -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word
size)

    byte :: Int -> Int -> Word8
    byte :: Int -> Int -> Word8
byte Int
i Int
x = Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
x Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`shiftR` (Int
8 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
i))


-- | Decode a CBOR byte string, returning the size of its encoding.
--
decodeSizedBytes :: CBOR.Decoder s SizedBytes
decodeSizedBytes :: forall s. Decoder s SizedBytes
decodeSizedBytes = do
    start <- Decoder s ByteOffset
forall s. Decoder s ByteOffset
CBOR.peekByteOffset
    _ <- CBOR.decodeBytes
    end <- CBOR.peekByteOffset
    pure (SizedBytes (fromIntegral (end - start)))


-- | Sizes of each width of the CBOR length header, and the sizes at which
-- the width changes.
--
instance Arbitrary SizedBytes where
  arbitrary :: Gen SizedBytes
arbitrary = Word -> SizedBytes
SizedBytes (Word -> SizedBytes) -> Gen Word -> Gen SizedBytes
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Int, Gen Word)] -> Gen Word
forall a. HasCallStack => [(Int, Gen a)] -> Gen a
frequency
    [ (Int
1, [Word] -> Gen Word
forall a. HasCallStack => [a] -> Gen a
elements [Word
1, Word
24, Word
25, Word
3 Word -> Word -> Word
forall a. Num a => a -> a -> a
+ Word
0xffff, Word
4 Word -> Word -> Word
forall a. Num a => a -> a -> a
+ Word
0xffff])
    , (Int
2, (Word, Word) -> Gen Word
forall a. Random a => (a, a) -> Gen a
choose (Word
1, Word
24))
    , (Int
2, (Word, Word) -> Gen Word
forall a. Random a => (a, a) -> Gen a
choose (Word
25, Word
3 Word -> Word -> Word
forall a. Num a => a -> a -> a
+ Word
0xffff))
    , (Int
2, (Word, Word) -> Gen Word
forall a. Random a => (a, a) -> Gen a
choose (Word
4 Word -> Word -> Word
forall a. Num a => a -> a -> a
+ Word
0xffff, Word
200_000))
    ]
  shrink :: SizedBytes -> [SizedBytes]
shrink (SizedBytes Word
size) = [ Word -> SizedBytes
SizedBytes Word
s | Word
s <- Word -> [Word]
forall a. Arbitrary a => a -> [a]
shrink Word
size, Word
s Word -> Word -> Bool
forall a. Ord a => a -> a -> Bool
>= Word
1 ]


-- | `encodeSizedBytes` produces an encoding of the given size
--
prop_sizedBytes_encoded_size :: SizedBytes -> Property
prop_sizedBytes_encoded_size :: SizedBytes -> Property
prop_sizedBytes_encoded_size SizedBytes
sizedBytes =
       ByteString -> Int
BS.length (Encoding -> ByteString
CBOR.toStrictByteString (SizedBytes -> Encoding
encodeSizedBytes SizedBytes
sizedBytes))
       Int -> Int -> Property
forall a. (Eq a, Show a) => a -> a -> Property
===
       Word -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (SizedBytes -> Word
size SizedBytes
sizedBytes)


-- | Round trip prperty for `encodeSizedBytes` and `decodeSizedBytes`.
--
prop_sizedBytes_roundtrip :: SizedBytes -> Property
prop_sizedBytes_roundtrip :: SizedBytes -> Property
prop_sizedBytes_roundtrip SizedBytes
sizedBytes =
    case (forall s. Decoder s SizedBytes)
-> ByteString -> Either DeserialiseFailure (ByteString, SizedBytes)
forall a.
(forall s. Decoder s a)
-> ByteString -> Either DeserialiseFailure (ByteString, a)
CBOR.deserialiseFromBytes Decoder s SizedBytes
forall s. Decoder s SizedBytes
decodeSizedBytes
          (Encoding -> ByteString
CBOR.toLazyByteString (SizedBytes -> Encoding
encodeSizedBytes SizedBytes
sizedBytes)) of
      Left DeserialiseFailure
e -> TestName -> Bool -> Property
forall prop. Testable prop => TestName -> prop -> Property
counterexample (DeserialiseFailure -> TestName
forall a. Show a => a -> TestName
show DeserialiseFailure
e) Bool
False
      Right (ByteString
trailing, SizedBytes
sizedBytes')
        | Bool -> Bool
not (ByteString -> Bool
BSL.null ByteString
trailing)
        -> TestName -> Bool -> Property
forall prop. Testable prop => TestName -> prop -> Property
counterexample (TestName
"trailing bytes: " TestName -> ShowS
forall a. [a] -> [a] -> [a]
++ ByteString -> TestName
forall a. Show a => a -> TestName
show ByteString
trailing) Bool
False
        | Bool
otherwise
        -> SizedBytes
sizedBytes' SizedBytes -> SizedBytes -> Property
forall a. (Eq a, Show a) => a -> a -> Property
=== SizedBytes
sizedBytes

codec_sized :: MonadST m
            => Codec (TxSubmission2 SizedBytes SizedBytes)
                     CBOR.DeserialiseFailure
                     m ByteString
codec_sized :: forall (m :: * -> *).
MonadST m =>
Codec
  (TxSubmission2 SizedBytes SizedBytes)
  DeserialiseFailure
  m
  ByteString
codec_sized = (SizedBytes -> Encoding)
-> (forall s. Decoder s SizedBytes)
-> (SizedBytes -> Encoding)
-> (forall s. Decoder s SizedBytes)
-> Codec
     (TxSubmission2 SizedBytes SizedBytes)
     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
              SizedBytes -> Encoding
encodeSizedBytes Decoder s SizedBytes
forall s. Decoder s SizedBytes
decodeSizedBytes
              SizedBytes -> Encoding
encodeSizedBytes Decoder s SizedBytes
forall s. Decoder s SizedBytes
decodeSizedBytes

-- | Bounds on the messages generated by `genBoundedMessage`.  Sizes are sizes
-- of CBOR encodings.
--
data TxSubmission2Bounds = TxSubmission2Bounds {
    TxSubmission2Bounds -> Word16
tbMaxNumTxIds :: Word16,
    -- ^ maximal number of txids in a message, and of txs in a `MsgReplyTxs`
    TxSubmission2Bounds -> Word
tbMaxTxIdSize :: Word,
    -- ^ maximal size of a txid
    TxSubmission2Bounds -> Word
tbMaxTxSize   :: Word,
    -- ^ maximal size of a tx, which is sent on its own in a `MsgReplyTxs`
    TxSubmission2Bounds -> Word
tbMaxTxsSize  :: Word
    -- ^ maximal total size of the txs in a `MsgReplyTxs`, unless it carries
    -- a single tx
  }
  deriving Int -> TxSubmission2Bounds -> ShowS
[TxSubmission2Bounds] -> ShowS
TxSubmission2Bounds -> TestName
(Int -> TxSubmission2Bounds -> ShowS)
-> (TxSubmission2Bounds -> TestName)
-> ([TxSubmission2Bounds] -> ShowS)
-> Show TxSubmission2Bounds
forall a.
(Int -> a -> ShowS) -> (a -> TestName) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TxSubmission2Bounds -> ShowS
showsPrec :: Int -> TxSubmission2Bounds -> ShowS
$cshow :: TxSubmission2Bounds -> TestName
show :: TxSubmission2Bounds -> TestName
$cshowList :: [TxSubmission2Bounds] -> ShowS
showList :: [TxSubmission2Bounds] -> ShowS
Show

-- | Generate any message within the given bounds.  Counts and sizes are
-- biased towards the bounds.
--
genBoundedMessage :: TxSubmission2Bounds
                  -> Gen (AnyMessage (TxSubmission2 SizedBytes SizedBytes))
genBoundedMessage :: TxSubmission2Bounds
-> Gen (AnyMessage (TxSubmission2 SizedBytes SizedBytes))
genBoundedMessage TxSubmission2Bounds { Word16
tbMaxNumTxIds :: TxSubmission2Bounds -> Word16
tbMaxNumTxIds :: Word16
tbMaxNumTxIds, Word
tbMaxTxIdSize :: TxSubmission2Bounds -> Word
tbMaxTxIdSize :: Word
tbMaxTxIdSize,
                                        Word
tbMaxTxSize :: TxSubmission2Bounds -> Word
tbMaxTxSize :: Word
tbMaxTxSize, Word
tbMaxTxsSize :: TxSubmission2Bounds -> Word
tbMaxTxsSize :: Word
tbMaxTxsSize } =
    [(Int, Gen (AnyMessage (TxSubmission2 SizedBytes SizedBytes)))]
-> Gen (AnyMessage (TxSubmission2 SizedBytes SizedBytes))
forall a. HasCallStack => [(Int, Gen a)] -> Gen a
frequency
      [ (Int
1, AnyMessage (TxSubmission2 SizedBytes SizedBytes)
-> Gen (AnyMessage (TxSubmission2 SizedBytes SizedBytes))
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Message (TxSubmission2 SizedBytes SizedBytes) 'StInit 'StIdle
-> AnyMessage (TxSubmission2 SizedBytes SizedBytes)
forall ps (st :: ps) (st' :: ps).
(StateTokenI st, ActiveState st) =>
Message ps st st' -> AnyMessage ps
AnyMessage Message (TxSubmission2 SizedBytes SizedBytes) 'StInit 'StIdle
forall txid tx. Message (TxSubmission2 txid tx) 'StInit 'StIdle
MsgInit))
      , (Int
1, Message
  (TxSubmission2 SizedBytes SizedBytes)
  'StIdle
  ('StTxIds 'StBlocking)
-> AnyMessage (TxSubmission2 SizedBytes SizedBytes)
forall ps (st :: ps) (st' :: ps).
(StateTokenI st, ActiveState st) =>
Message ps st st' -> AnyMessage ps
AnyMessage (Message
   (TxSubmission2 SizedBytes SizedBytes)
   'StIdle
   ('StTxIds 'StBlocking)
 -> AnyMessage (TxSubmission2 SizedBytes SizedBytes))
-> Gen
     (Message
        (TxSubmission2 SizedBytes SizedBytes)
        'StIdle
        ('StTxIds 'StBlocking))
-> Gen (AnyMessage (TxSubmission2 SizedBytes SizedBytes))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
              (SingBlockingStyle 'StBlocking
-> NumTxIdsToAck
-> NumTxIdsToReq
-> Message
     (TxSubmission2 SizedBytes SizedBytes)
     'StIdle
     ('StTxIds 'StBlocking)
forall (blocking :: StBlockingStyle) txid tx.
SingI blocking =>
SingBlockingStyle blocking
-> NumTxIdsToAck
-> NumTxIdsToReq
-> Message (TxSubmission2 txid tx) 'StIdle ('StTxIds blocking)
MsgRequestTxIds SingBlockingStyle 'StBlocking
SingBlocking
                (NumTxIdsToAck
 -> NumTxIdsToReq
 -> Message
      (TxSubmission2 SizedBytes SizedBytes)
      'StIdle
      ('StTxIds 'StBlocking))
-> Gen NumTxIdsToAck
-> Gen
     (NumTxIdsToReq
      -> Message
           (TxSubmission2 SizedBytes SizedBytes)
           'StIdle
           ('StTxIds 'StBlocking))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Word16 -> NumTxIdsToAck
NumTxIdsToAck (Word16 -> NumTxIdsToAck) -> Gen Word16 -> Gen NumTxIdsToAck
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Word16 -> Gen Word16
genCount Word16
0)
                Gen
  (NumTxIdsToReq
   -> Message
        (TxSubmission2 SizedBytes SizedBytes)
        'StIdle
        ('StTxIds 'StBlocking))
-> Gen NumTxIdsToReq
-> Gen
     (Message
        (TxSubmission2 SizedBytes SizedBytes)
        '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
<*> (Word16 -> NumTxIdsToReq
NumTxIdsToReq (Word16 -> NumTxIdsToReq) -> Gen Word16 -> Gen NumTxIdsToReq
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Word16 -> Gen Word16
genCount Word16
0)))
      , (Int
1, Message
  (TxSubmission2 SizedBytes SizedBytes)
  'StIdle
  ('StTxIds 'StNonBlocking)
-> AnyMessage (TxSubmission2 SizedBytes SizedBytes)
forall ps (st :: ps) (st' :: ps).
(StateTokenI st, ActiveState st) =>
Message ps st st' -> AnyMessage ps
AnyMessage (Message
   (TxSubmission2 SizedBytes SizedBytes)
   'StIdle
   ('StTxIds 'StNonBlocking)
 -> AnyMessage (TxSubmission2 SizedBytes SizedBytes))
-> Gen
     (Message
        (TxSubmission2 SizedBytes SizedBytes)
        'StIdle
        ('StTxIds 'StNonBlocking))
-> Gen (AnyMessage (TxSubmission2 SizedBytes SizedBytes))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
              (SingBlockingStyle 'StNonBlocking
-> NumTxIdsToAck
-> NumTxIdsToReq
-> Message
     (TxSubmission2 SizedBytes SizedBytes)
     'StIdle
     ('StTxIds 'StNonBlocking)
forall (blocking :: StBlockingStyle) txid tx.
SingI blocking =>
SingBlockingStyle blocking
-> NumTxIdsToAck
-> NumTxIdsToReq
-> Message (TxSubmission2 txid tx) 'StIdle ('StTxIds blocking)
MsgRequestTxIds SingBlockingStyle 'StNonBlocking
SingNonBlocking
                (NumTxIdsToAck
 -> NumTxIdsToReq
 -> Message
      (TxSubmission2 SizedBytes SizedBytes)
      'StIdle
      ('StTxIds 'StNonBlocking))
-> Gen NumTxIdsToAck
-> Gen
     (NumTxIdsToReq
      -> Message
           (TxSubmission2 SizedBytes SizedBytes)
           'StIdle
           ('StTxIds 'StNonBlocking))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Word16 -> NumTxIdsToAck
NumTxIdsToAck (Word16 -> NumTxIdsToAck) -> Gen Word16 -> Gen NumTxIdsToAck
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Word16 -> Gen Word16
genCount Word16
0)
                Gen
  (NumTxIdsToReq
   -> Message
        (TxSubmission2 SizedBytes SizedBytes)
        'StIdle
        ('StTxIds 'StNonBlocking))
-> Gen NumTxIdsToReq
-> Gen
     (Message
        (TxSubmission2 SizedBytes SizedBytes)
        '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
<*> (Word16 -> NumTxIdsToReq
NumTxIdsToReq (Word16 -> NumTxIdsToReq) -> Gen Word16 -> Gen NumTxIdsToReq
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Word16 -> Gen Word16
genCount Word16
0)))
      , (Int
2, Message
  (TxSubmission2 SizedBytes SizedBytes)
  ('StTxIds 'StBlocking)
  'StIdle
-> AnyMessage (TxSubmission2 SizedBytes SizedBytes)
forall ps (st :: ps) (st' :: ps).
(StateTokenI st, ActiveState st) =>
Message ps st st' -> AnyMessage ps
AnyMessage (Message
   (TxSubmission2 SizedBytes SizedBytes)
   ('StTxIds 'StBlocking)
   'StIdle
 -> AnyMessage (TxSubmission2 SizedBytes SizedBytes))
-> ([(SizedBytes, SizeInBytes)]
    -> Message
         (TxSubmission2 SizedBytes SizedBytes)
         ('StTxIds 'StBlocking)
         'StIdle)
-> [(SizedBytes, SizeInBytes)]
-> AnyMessage (TxSubmission2 SizedBytes SizedBytes)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BlockingReplyList 'StBlocking (SizedBytes, SizeInBytes)
-> Message
     (TxSubmission2 SizedBytes SizedBytes)
     ('StTxIds 'StBlocking)
     'StIdle
forall (blocking :: StBlockingStyle) txid tx.
BlockingReplyList blocking (txid, SizeInBytes)
-> Message (TxSubmission2 txid tx) ('StTxIds blocking) 'StIdle
MsgReplyTxIds (BlockingReplyList 'StBlocking (SizedBytes, SizeInBytes)
 -> Message
      (TxSubmission2 SizedBytes SizedBytes)
      ('StTxIds 'StBlocking)
      'StIdle)
-> ([(SizedBytes, SizeInBytes)]
    -> BlockingReplyList 'StBlocking (SizedBytes, SizeInBytes))
-> [(SizedBytes, SizeInBytes)]
-> Message
     (TxSubmission2 SizedBytes SizedBytes)
     ('StTxIds 'StBlocking)
     'StIdle
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty (SizedBytes, SizeInBytes)
-> BlockingReplyList 'StBlocking (SizedBytes, SizeInBytes)
forall a. NonEmpty a -> BlockingReplyList 'StBlocking a
BlockingReply (NonEmpty (SizedBytes, SizeInBytes)
 -> BlockingReplyList 'StBlocking (SizedBytes, SizeInBytes))
-> ([(SizedBytes, SizeInBytes)]
    -> NonEmpty (SizedBytes, SizeInBytes))
-> [(SizedBytes, SizeInBytes)]
-> BlockingReplyList 'StBlocking (SizedBytes, SizeInBytes)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(SizedBytes, SizeInBytes)] -> NonEmpty (SizedBytes, SizeInBytes)
forall a. HasCallStack => [a] -> NonEmpty a
NonEmpty.fromList
              ([(SizedBytes, SizeInBytes)]
 -> AnyMessage (TxSubmission2 SizedBytes SizedBytes))
-> Gen [(SizedBytes, SizeInBytes)]
-> Gen (AnyMessage (TxSubmission2 SizedBytes SizedBytes))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Word16 -> Gen [(SizedBytes, SizeInBytes)]
genTxIdsAndSizes Word16
1)
      , (Int
2, Message
  (TxSubmission2 SizedBytes SizedBytes)
  ('StTxIds 'StNonBlocking)
  'StIdle
-> AnyMessage (TxSubmission2 SizedBytes SizedBytes)
forall ps (st :: ps) (st' :: ps).
(StateTokenI st, ActiveState st) =>
Message ps st st' -> AnyMessage ps
AnyMessage (Message
   (TxSubmission2 SizedBytes SizedBytes)
   ('StTxIds 'StNonBlocking)
   'StIdle
 -> AnyMessage (TxSubmission2 SizedBytes SizedBytes))
-> ([(SizedBytes, SizeInBytes)]
    -> Message
         (TxSubmission2 SizedBytes SizedBytes)
         ('StTxIds 'StNonBlocking)
         'StIdle)
-> [(SizedBytes, SizeInBytes)]
-> AnyMessage (TxSubmission2 SizedBytes SizedBytes)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BlockingReplyList 'StNonBlocking (SizedBytes, SizeInBytes)
-> Message
     (TxSubmission2 SizedBytes SizedBytes)
     ('StTxIds 'StNonBlocking)
     'StIdle
forall (blocking :: StBlockingStyle) txid tx.
BlockingReplyList blocking (txid, SizeInBytes)
-> Message (TxSubmission2 txid tx) ('StTxIds blocking) 'StIdle
MsgReplyTxIds (BlockingReplyList 'StNonBlocking (SizedBytes, SizeInBytes)
 -> Message
      (TxSubmission2 SizedBytes SizedBytes)
      ('StTxIds 'StNonBlocking)
      'StIdle)
-> ([(SizedBytes, SizeInBytes)]
    -> BlockingReplyList 'StNonBlocking (SizedBytes, SizeInBytes))
-> [(SizedBytes, SizeInBytes)]
-> Message
     (TxSubmission2 SizedBytes SizedBytes)
     ('StTxIds 'StNonBlocking)
     'StIdle
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(SizedBytes, SizeInBytes)]
-> BlockingReplyList 'StNonBlocking (SizedBytes, SizeInBytes)
forall a. [a] -> BlockingReplyList 'StNonBlocking a
NonBlockingReply
              ([(SizedBytes, SizeInBytes)]
 -> AnyMessage (TxSubmission2 SizedBytes SizedBytes))
-> Gen [(SizedBytes, SizeInBytes)]
-> Gen (AnyMessage (TxSubmission2 SizedBytes SizedBytes))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Word16 -> Gen [(SizedBytes, SizeInBytes)]
genTxIdsAndSizes Word16
0)
      , (Int
4, Message (TxSubmission2 SizedBytes SizedBytes) 'StIdle 'StTxs
-> AnyMessage (TxSubmission2 SizedBytes SizedBytes)
forall ps (st :: ps) (st' :: ps).
(StateTokenI st, ActiveState st) =>
Message ps st st' -> AnyMessage ps
AnyMessage (Message (TxSubmission2 SizedBytes SizedBytes) 'StIdle 'StTxs
 -> AnyMessage (TxSubmission2 SizedBytes SizedBytes))
-> ([SizedBytes]
    -> Message (TxSubmission2 SizedBytes SizedBytes) 'StIdle 'StTxs)
-> [SizedBytes]
-> AnyMessage (TxSubmission2 SizedBytes SizedBytes)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [SizedBytes]
-> Message (TxSubmission2 SizedBytes SizedBytes) 'StIdle 'StTxs
forall txid tx.
[txid] -> Message (TxSubmission2 txid tx) 'StIdle 'StTxs
MsgRequestTxs ([SizedBytes] -> AnyMessage (TxSubmission2 SizedBytes SizedBytes))
-> Gen [SizedBytes]
-> Gen (AnyMessage (TxSubmission2 SizedBytes SizedBytes))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen [SizedBytes]
genTxIds)
      , (Int
8, Message (TxSubmission2 SizedBytes SizedBytes) 'StTxs 'StIdle
-> AnyMessage (TxSubmission2 SizedBytes SizedBytes)
forall ps (st :: ps) (st' :: ps).
(StateTokenI st, ActiveState st) =>
Message ps st st' -> AnyMessage ps
AnyMessage (Message (TxSubmission2 SizedBytes SizedBytes) 'StTxs 'StIdle
 -> AnyMessage (TxSubmission2 SizedBytes SizedBytes))
-> ([SizedBytes]
    -> Message (TxSubmission2 SizedBytes SizedBytes) 'StTxs 'StIdle)
-> [SizedBytes]
-> AnyMessage (TxSubmission2 SizedBytes SizedBytes)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [SizedBytes]
-> Message (TxSubmission2 SizedBytes SizedBytes) 'StTxs 'StIdle
forall tx txid.
[tx] -> Message (TxSubmission2 txid tx) 'StTxs 'StIdle
MsgReplyTxs ([SizedBytes] -> AnyMessage (TxSubmission2 SizedBytes SizedBytes))
-> Gen [SizedBytes]
-> Gen (AnyMessage (TxSubmission2 SizedBytes SizedBytes))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen [SizedBytes]
genTxs)
      , (Int
1, AnyMessage (TxSubmission2 SizedBytes SizedBytes)
-> Gen (AnyMessage (TxSubmission2 SizedBytes SizedBytes))
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Message
  (TxSubmission2 SizedBytes SizedBytes)
  ('StTxIds 'StBlocking)
  'StDone
-> AnyMessage (TxSubmission2 SizedBytes SizedBytes)
forall ps (st :: ps) (st' :: ps).
(StateTokenI st, ActiveState st) =>
Message ps st st' -> AnyMessage ps
AnyMessage Message
  (TxSubmission2 SizedBytes SizedBytes)
  ('StTxIds 'StBlocking)
  'StDone
forall txid tx.
Message (TxSubmission2 txid tx) ('StTxIds 'StBlocking) 'StDone
MsgDone))
      ]
  where
    -- a count, at least `lo`, biased towards `tbMaxNumTxIds`
    genCount :: Word16 -> Gen Word16
    genCount :: Word16 -> Gen Word16
genCount Word16
lo =
      [(Int, Gen Word16)] -> Gen Word16
forall a. HasCallStack => [(Int, Gen a)] -> Gen a
frequency [ (Int
3, Word16 -> Gen Word16
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Word16 -> Word16 -> Word16
forall a. Ord a => a -> a -> a
max Word16
lo Word16
tbMaxNumTxIds))
                , (Int
1, (Word16, Word16) -> Gen Word16
forall a. Random a => (a, a) -> Gen a
choose (Word16
lo, Word16 -> Word16 -> Word16
forall a. Ord a => a -> a -> a
max Word16
lo Word16
tbMaxNumTxIds))
                ]

    -- a size, biased towards `maxSize`
    genSize :: Word -> Gen Word
    genSize :: Word -> Gen Word
genSize Word
maxSize =
      [(Int, Gen Word)] -> Gen Word
forall a. HasCallStack => [(Int, Gen a)] -> Gen a
frequency [ (Int
3, Word -> Gen Word
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Word -> Word -> Word
forall a. Ord a => a -> a -> a
max Word
1 Word
maxSize))
                , (Int
1, (Word, Word) -> Gen Word
forall a. Random a => (a, a) -> Gen a
choose (Word
1, Word -> Word -> Word
forall a. Ord a => a -> a -> a
max Word
1 Word
maxSize))
                ]

    -- `n` sizes: either all of them maximal, or each one chosen by `genSize`
    genSizes :: Int -> Word -> Gen [Word]
    genSizes :: Int -> Word -> Gen [Word]
genSizes Int
n Word
maxSize =
      [(Int, Gen [Word])] -> Gen [Word]
forall a. HasCallStack => [(Int, Gen a)] -> Gen a
frequency [ (Int
3, [Word] -> Gen [Word]
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int -> Word -> [Word]
forall a. Int -> a -> [a]
replicate Int
n (Word -> Word -> Word
forall a. Ord a => a -> a -> a
max Word
1 Word
maxSize)))
                , (Int
1, Int -> Gen Word -> Gen [Word]
forall a. Int -> Gen a -> Gen [a]
vectorOf Int
n (Word -> Gen Word
genSize Word
maxSize))
                ]

    genTxIds :: Gen [SizedBytes]
    genTxIds :: Gen [SizedBytes]
genTxIds = do
      n <- Word16 -> Gen Word16
genCount Word16
0
      map SizedBytes <$> genSizes (fromIntegral n) tbMaxTxIdSize

    genTxIdsAndSizes :: Word16 -> Gen [(SizedBytes, SizeInBytes)]
    genTxIdsAndSizes :: Word16 -> Gen [(SizedBytes, SizeInBytes)]
genTxIdsAndSizes Word16
lo = do
      n <- Word16 -> Gen Word16
genCount Word16
lo
      zip <$> (map SizedBytes <$> genSizes (fromIntegral n) tbMaxTxIdSize)
          <*> vectorOf (fromIntegral n)
                (SizeInBytes <$> frequency
                                   [ (1, pure maxBound)
                                   , (1, arbitraryBoundedIntegral)
                                   ])

    genTxs :: Gen [SizedBytes]
    genTxs :: Gen [SizedBytes]
genTxs = [(Int, Gen [SizedBytes])] -> Gen [SizedBytes]
forall a. HasCallStack => [(Int, Gen a)] -> Gen a
frequency
      [ (if Word16
tbMaxNumTxIds Word16 -> Word16 -> Bool
forall a. Ord a => a -> a -> Bool
>= Word16
1 then Int
1 else Int
0,
          (SizedBytes -> [SizedBytes] -> [SizedBytes]
forall a. a -> [a] -> [a]
: []) (SizedBytes -> [SizedBytes])
-> (Word -> SizedBytes) -> Word -> [SizedBytes]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word -> SizedBytes
SizedBytes (Word -> [SizedBytes]) -> Gen Word -> Gen [SizedBytes]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Word -> Gen Word
genSize Word
tbMaxTxSize)
      , (Int
3, do
          -- each tx is at least one byte
          n <- Word16 -> Word16 -> Word16
forall a. Ord a => a -> a -> a
min (Word -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word
tbMaxTxsSize) (Word16 -> Word16) -> Gen Word16 -> Gen Word16
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Word16 -> Gen Word16
genCount Word16
0
          if n == 0
            then pure []
            else do
              txsSize <- frequency
                [ (3, pure tbMaxTxsSize)
                , (1, choose (fromIntegral n, tbMaxTxsSize))
                ]
              -- split `txsSize` into `n` positive sizes
              cuts <- sort <$> vectorOf (fromIntegral n - 1)
                                        (choose (0, txsSize - fromIntegral n))
              let bounds = Word
0 Word -> [Word] -> [Word]
forall a. a -> [a] -> [a]
: [Word]
cuts [Word] -> [Word] -> [Word]
forall a. [a] -> [a] -> [a]
++ [Word
txsSize Word -> Word -> Word
forall a. Num a => a -> a -> a
- Word16 -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
n]
              pure [ SizedBytes (b - a + 1)
                   | (a, b) <- zip bounds (drop 1 bounds) ])
      ]

-- | Whether a message is within the given bounds; every message generated by
-- `genBoundedMessage` is.
--
withinBounds :: TxSubmission2Bounds
             -> AnyMessage (TxSubmission2 SizedBytes SizedBytes)
             -> Bool
withinBounds :: TxSubmission2Bounds
-> AnyMessage (TxSubmission2 SizedBytes SizedBytes) -> Bool
withinBounds TxSubmission2Bounds { Word16
tbMaxNumTxIds :: TxSubmission2Bounds -> Word16
tbMaxNumTxIds :: Word16
tbMaxNumTxIds, Word
tbMaxTxIdSize :: TxSubmission2Bounds -> Word
tbMaxTxIdSize :: Word
tbMaxTxIdSize,
                                   Word
tbMaxTxSize :: TxSubmission2Bounds -> Word
tbMaxTxSize :: Word
tbMaxTxSize, Word
tbMaxTxsSize :: TxSubmission2Bounds -> Word
tbMaxTxsSize :: Word
tbMaxTxsSize } = \case
    AnyMessage Message (TxSubmission2 SizedBytes SizedBytes) st st'
R:MessageTxSubmission2fromto SizedBytes SizedBytes st st'
MsgInit -> Bool
True
    AnyMessage (MsgRequestTxIds SingBlockingStyle blocking
_ (NumTxIdsToAck Word16
ackNo) (NumTxIdsToReq Word16
reqNo)) ->
         Word16
ackNo Word16 -> Word16 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word16
tbMaxNumTxIds
      Bool -> Bool -> Bool
&& Word16
reqNo Word16 -> Word16 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word16
tbMaxNumTxIds
    AnyMessage (MsgReplyTxIds (BlockingReply NonEmpty (SizedBytes, SizeInBytes)
txids)) ->
      [SizedBytes] -> Bool
txIdsWithin ((SizedBytes, SizeInBytes) -> SizedBytes
forall a b. (a, b) -> a
fst ((SizedBytes, SizeInBytes) -> SizedBytes)
-> [(SizedBytes, SizeInBytes)] -> [SizedBytes]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NonEmpty (SizedBytes, SizeInBytes) -> [(SizedBytes, SizeInBytes)]
forall a. NonEmpty a -> [a]
NonEmpty.toList NonEmpty (SizedBytes, SizeInBytes)
txids)
    AnyMessage (MsgReplyTxIds (NonBlockingReply [(SizedBytes, SizeInBytes)]
txids)) ->
      [SizedBytes] -> Bool
txIdsWithin ((SizedBytes, SizeInBytes) -> SizedBytes
forall a b. (a, b) -> a
fst ((SizedBytes, SizeInBytes) -> SizedBytes)
-> [(SizedBytes, SizeInBytes)] -> [SizedBytes]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(SizedBytes, SizeInBytes)]
txids)
    AnyMessage (MsgRequestTxs [SizedBytes]
txids) ->
      [SizedBytes] -> Bool
txIdsWithin [SizedBytes]
txids
    AnyMessage (MsgReplyTxs [SizedBytes]
txs) ->
         [SizedBytes] -> Bool
forall a. [a] -> Bool
countWithin [SizedBytes]
txs
      Bool -> Bool -> Bool
&& (SizedBytes -> Bool) -> [SizedBytes] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all ((Word -> Word -> Bool
forall a. Ord a => a -> a -> Bool
>= Word
1) (Word -> Bool) -> (SizedBytes -> Word) -> SizedBytes -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SizedBytes -> Word
size) [SizedBytes]
txs
      Bool -> Bool -> Bool
&& (   [Word] -> Word
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum (SizedBytes -> Word
size (SizedBytes -> Word) -> [SizedBytes] -> [Word]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [SizedBytes]
txs) Word -> Word -> Bool
forall a. Ord a => a -> a -> Bool
<= Word
tbMaxTxsSize
          Bool -> Bool -> Bool
|| ([SizedBytes] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [SizedBytes]
txs Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 Bool -> Bool -> Bool
&& (SizedBytes -> Bool) -> [SizedBytes] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all ((Word -> Word -> Bool
forall a. Ord a => a -> a -> Bool
<= Word -> Word -> Word
forall a. Ord a => a -> a -> a
max Word
1 Word
tbMaxTxSize) (Word -> Bool) -> (SizedBytes -> Word) -> SizedBytes -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SizedBytes -> Word
size) [SizedBytes]
txs))
    AnyMessage Message (TxSubmission2 SizedBytes SizedBytes) st st'
R:MessageTxSubmission2fromto SizedBytes SizedBytes st st'
MsgDone -> Bool
True
  where
    countWithin :: [a] -> Bool
    countWithin :: forall a. [a] -> Bool
countWithin [a]
as = [a] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
as Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Word16 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
tbMaxNumTxIds

    txIdsWithin :: [SizedBytes] -> Bool
    txIdsWithin :: [SizedBytes] -> Bool
txIdsWithin [SizedBytes]
txids =
         [SizedBytes] -> Bool
forall a. [a] -> Bool
countWithin [SizedBytes]
txids
      Bool -> Bool -> Bool
&& (SizedBytes -> Bool) -> [SizedBytes] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (\SizedBytes { Word
size :: SizedBytes -> Word
size :: Word
size } -> Word
size Word -> Word -> Bool
forall a. Ord a => a -> a -> Bool
>= Word
1 Bool -> Bool -> Bool
&& Word
size Word -> Word -> Bool
forall a. Ord a => a -> a -> Bool
<= Word -> Word -> Word
forall a. Ord a => a -> a -> a
max Word
1 Word
tbMaxTxIdSize) [SizedBytes]
txids

-- | Shrink a message, keeping its constructor.  Fewer txids or txs, and
-- smaller sizes and counts, keep a message within the bounds it was
-- generated in (see `withinBounds`).
--
shrinkBoundedMessage :: AnyMessage (TxSubmission2 SizedBytes SizedBytes)
                     -> [AnyMessage (TxSubmission2 SizedBytes SizedBytes)]
shrinkBoundedMessage :: AnyMessage (TxSubmission2 SizedBytes SizedBytes)
-> [AnyMessage (TxSubmission2 SizedBytes SizedBytes)]
shrinkBoundedMessage = \case
    AnyMessage (MsgRequestTxIds SingBlockingStyle blocking
blocking NumTxIdsToAck
ackNo NumTxIdsToReq
reqNo) ->
         [ Message
  (TxSubmission2 SizedBytes SizedBytes) 'StIdle ('StTxIds blocking)
-> AnyMessage (TxSubmission2 SizedBytes SizedBytes)
forall ps (st :: ps) (st' :: ps).
(StateTokenI st, ActiveState st) =>
Message ps st st' -> AnyMessage ps
AnyMessage (SingBlockingStyle blocking
-> NumTxIdsToAck
-> NumTxIdsToReq
-> Message
     (TxSubmission2 SizedBytes SizedBytes) 'StIdle ('StTxIds blocking)
forall (blocking :: StBlockingStyle) txid tx.
SingI blocking =>
SingBlockingStyle blocking
-> NumTxIdsToAck
-> NumTxIdsToReq
-> Message (TxSubmission2 txid tx) 'StIdle ('StTxIds blocking)
MsgRequestTxIds SingBlockingStyle blocking
blocking (Word16 -> NumTxIdsToAck
NumTxIdsToAck Word16
ackNo') NumTxIdsToReq
reqNo)
         | Word16
ackNo' <- Word16 -> [Word16]
forall a. Arbitrary a => a -> [a]
shrink (NumTxIdsToAck -> Word16
getNumTxIdsToAck NumTxIdsToAck
ackNo) ]
      [AnyMessage (TxSubmission2 SizedBytes SizedBytes)]
-> [AnyMessage (TxSubmission2 SizedBytes SizedBytes)]
-> [AnyMessage (TxSubmission2 SizedBytes SizedBytes)]
forall a. [a] -> [a] -> [a]
++ [ Message
  (TxSubmission2 SizedBytes SizedBytes) 'StIdle ('StTxIds blocking)
-> AnyMessage (TxSubmission2 SizedBytes SizedBytes)
forall ps (st :: ps) (st' :: ps).
(StateTokenI st, ActiveState st) =>
Message ps st st' -> AnyMessage ps
AnyMessage (SingBlockingStyle blocking
-> NumTxIdsToAck
-> NumTxIdsToReq
-> Message
     (TxSubmission2 SizedBytes SizedBytes) 'StIdle ('StTxIds blocking)
forall (blocking :: StBlockingStyle) txid tx.
SingI blocking =>
SingBlockingStyle blocking
-> NumTxIdsToAck
-> NumTxIdsToReq
-> Message (TxSubmission2 txid tx) 'StIdle ('StTxIds blocking)
MsgRequestTxIds SingBlockingStyle blocking
blocking NumTxIdsToAck
ackNo (Word16 -> NumTxIdsToReq
NumTxIdsToReq Word16
reqNo'))
         | Word16
reqNo' <- Word16 -> [Word16]
forall a. Arbitrary a => a -> [a]
shrink (NumTxIdsToReq -> Word16
getNumTxIdsToReq NumTxIdsToReq
reqNo) ]
    AnyMessage (MsgReplyTxIds (BlockingReply NonEmpty (SizedBytes, SizeInBytes)
txids)) ->
      [ Message
  (TxSubmission2 SizedBytes SizedBytes)
  ('StTxIds 'StBlocking)
  'StIdle
-> AnyMessage (TxSubmission2 SizedBytes SizedBytes)
forall ps (st :: ps) (st' :: ps).
(StateTokenI st, ActiveState st) =>
Message ps st st' -> AnyMessage ps
AnyMessage (BlockingReplyList 'StBlocking (SizedBytes, SizeInBytes)
-> Message
     (TxSubmission2 SizedBytes SizedBytes)
     ('StTxIds 'StBlocking)
     'StIdle
forall (blocking :: StBlockingStyle) txid tx.
BlockingReplyList blocking (txid, SizeInBytes)
-> Message (TxSubmission2 txid tx) ('StTxIds blocking) 'StIdle
MsgReplyTxIds (NonEmpty (SizedBytes, SizeInBytes)
-> BlockingReplyList 'StBlocking (SizedBytes, SizeInBytes)
forall a. NonEmpty a -> BlockingReplyList 'StBlocking a
BlockingReply NonEmpty (SizedBytes, SizeInBytes)
txids''))
      | [(SizedBytes, SizeInBytes)]
txids' <- ((SizedBytes, SizeInBytes) -> [(SizedBytes, SizeInBytes)])
-> [(SizedBytes, SizeInBytes)] -> [[(SizedBytes, SizeInBytes)]]
forall a. (a -> [a]) -> [a] -> [[a]]
shrinkList (SizedBytes, SizeInBytes) -> [(SizedBytes, SizeInBytes)]
shrinkTxIdAndSize (NonEmpty (SizedBytes, SizeInBytes) -> [(SizedBytes, SizeInBytes)]
forall a. NonEmpty a -> [a]
NonEmpty.toList NonEmpty (SizedBytes, SizeInBytes)
txids)
      , Just NonEmpty (SizedBytes, SizeInBytes)
txids'' <- [[(SizedBytes, SizeInBytes)]
-> Maybe (NonEmpty (SizedBytes, SizeInBytes))
forall a. [a] -> Maybe (NonEmpty a)
NonEmpty.nonEmpty [(SizedBytes, SizeInBytes)]
txids']
      ]
    AnyMessage (MsgReplyTxIds (NonBlockingReply [(SizedBytes, SizeInBytes)]
txids)) ->
      [ Message
  (TxSubmission2 SizedBytes SizedBytes)
  ('StTxIds 'StNonBlocking)
  'StIdle
-> AnyMessage (TxSubmission2 SizedBytes SizedBytes)
forall ps (st :: ps) (st' :: ps).
(StateTokenI st, ActiveState st) =>
Message ps st st' -> AnyMessage ps
AnyMessage (BlockingReplyList 'StNonBlocking (SizedBytes, SizeInBytes)
-> Message
     (TxSubmission2 SizedBytes SizedBytes)
     ('StTxIds 'StNonBlocking)
     'StIdle
forall (blocking :: StBlockingStyle) txid tx.
BlockingReplyList blocking (txid, SizeInBytes)
-> Message (TxSubmission2 txid tx) ('StTxIds blocking) 'StIdle
MsgReplyTxIds ([(SizedBytes, SizeInBytes)]
-> BlockingReplyList 'StNonBlocking (SizedBytes, SizeInBytes)
forall a. [a] -> BlockingReplyList 'StNonBlocking a
NonBlockingReply [(SizedBytes, SizeInBytes)]
txids'))
      | [(SizedBytes, SizeInBytes)]
txids' <- ((SizedBytes, SizeInBytes) -> [(SizedBytes, SizeInBytes)])
-> [(SizedBytes, SizeInBytes)] -> [[(SizedBytes, SizeInBytes)]]
forall a. (a -> [a]) -> [a] -> [[a]]
shrinkList (SizedBytes, SizeInBytes) -> [(SizedBytes, SizeInBytes)]
shrinkTxIdAndSize [(SizedBytes, SizeInBytes)]
txids ]
    AnyMessage (MsgRequestTxs [SizedBytes]
txids) ->
      [ Message (TxSubmission2 SizedBytes SizedBytes) 'StIdle 'StTxs
-> AnyMessage (TxSubmission2 SizedBytes SizedBytes)
forall ps (st :: ps) (st' :: ps).
(StateTokenI st, ActiveState st) =>
Message ps st st' -> AnyMessage ps
AnyMessage ([SizedBytes]
-> Message (TxSubmission2 SizedBytes SizedBytes) 'StIdle 'StTxs
forall txid tx.
[txid] -> Message (TxSubmission2 txid tx) 'StIdle 'StTxs
MsgRequestTxs [SizedBytes]
txids') | [SizedBytes]
txids' <- (SizedBytes -> [SizedBytes]) -> [SizedBytes] -> [[SizedBytes]]
forall a. (a -> [a]) -> [a] -> [[a]]
shrinkList SizedBytes -> [SizedBytes]
forall a. Arbitrary a => a -> [a]
shrink [SizedBytes]
txids ]
    AnyMessage (MsgReplyTxs [SizedBytes]
txs) ->
      [ Message (TxSubmission2 SizedBytes SizedBytes) 'StTxs 'StIdle
-> AnyMessage (TxSubmission2 SizedBytes SizedBytes)
forall ps (st :: ps) (st' :: ps).
(StateTokenI st, ActiveState st) =>
Message ps st st' -> AnyMessage ps
AnyMessage ([SizedBytes]
-> Message (TxSubmission2 SizedBytes SizedBytes) 'StTxs 'StIdle
forall tx txid.
[tx] -> Message (TxSubmission2 txid tx) 'StTxs 'StIdle
MsgReplyTxs [SizedBytes]
txs') | [SizedBytes]
txs' <- (SizedBytes -> [SizedBytes]) -> [SizedBytes] -> [[SizedBytes]]
forall a. (a -> [a]) -> [a] -> [[a]]
shrinkList SizedBytes -> [SizedBytes]
forall a. Arbitrary a => a -> [a]
shrink [SizedBytes]
txs ]
    AnyMessage Message (TxSubmission2 SizedBytes SizedBytes) st st'
R:MessageTxSubmission2fromto SizedBytes SizedBytes st st'
MsgInit -> []
    AnyMessage Message (TxSubmission2 SizedBytes SizedBytes) st st'
R:MessageTxSubmission2fromto SizedBytes SizedBytes st st'
MsgDone -> []
  where
    shrinkTxIdAndSize :: (SizedBytes, SizeInBytes) -> [(SizedBytes, SizeInBytes)]
    shrinkTxIdAndSize :: (SizedBytes, SizeInBytes) -> [(SizedBytes, SizeInBytes)]
shrinkTxIdAndSize (SizedBytes
txid, SizeInBytes Word32
txSize) =
         [ (SizedBytes
txid', Word32 -> SizeInBytes
SizeInBytes Word32
txSize) | SizedBytes
txid' <- SizedBytes -> [SizedBytes]
forall a. Arbitrary a => a -> [a]
shrink SizedBytes
txid ]
      [(SizedBytes, SizeInBytes)]
-> [(SizedBytes, SizeInBytes)] -> [(SizedBytes, SizeInBytes)]
forall a. [a] -> [a] -> [a]
++ [ (SizedBytes
txid, Word32 -> SizeInBytes
SizeInBytes Word32
txSize') | Word32
txSize' <- Word32 -> [Word32]
forall a. Arbitrary a => a -> [a]
shrink Word32
txSize ]