{-# LANGUAGE DataKinds #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}

-- | Tests of the node's LeiosNotify client and server, run over real
-- connections against peers run by the Leios node-vs-environment tests.
module Test.Consensus.Leios.LeiosNotify.Node (tests) where

import Cardano.Ledger.BaseTypes (Milliseconds32 (..), knownNonZeroBounded)
import Cardano.Ledger.State (emptyLeiosCommittee)
import Cardano.Network.NodeToNode (defaultMiniProtocolParameters)
import Cardano.Network.NodeToNode.Version (NodeToNodeVersion (..))
import Control.Concurrent.Class.MonadSTM.Strict
import Control.Monad.Class.MonadAsync
import Control.Monad.Class.MonadThrow
import Control.Monad.Class.MonadTime.SI (DiffTime)
import Control.Monad.Class.MonadTimer.SI (threadDelay, timeout)
import Control.Monad.IOSim (IOSim, runSimOrThrow)
import Control.Tracer (nullTracer)
import qualified Data.ByteString as BS
import qualified Data.ByteString.Lazy as BSL
import Data.Foldable (for_)
import qualified Data.List.NonEmpty as NE
import qualified Data.Map.Strict as Map
import Data.Proxy (Proxy (..))
import qualified Data.Set as Set
import Data.Word (Word16, Word8)
import Ouroboros.Consensus.Block (ConvertRawHash (..), SlotNo (..), blockHash)
import Ouroboros.Consensus.BlockchainTime (slotLengthFromSec)
import Ouroboros.Consensus.Config (SecurityParam (..))
import qualified Ouroboros.Consensus.HardFork.History as HardFork
import Ouroboros.Consensus.Leios.Protocol (LeiosLedgerView (..))
import Ouroboros.Consensus.Leios.Types
  ( BytesSize
  , EbHash (..)
  , LeiosPoint (..)
  , LeiosVote (..)
  , RbHash (..)
  )
import qualified Ouroboros.Consensus.MiniProtocol.ChainSync.Client.InFutureCheck as InFutureCheck
import Ouroboros.Consensus.MiniProtocol.LeiosNotify.Client
import qualified Ouroboros.Consensus.MiniProtocol.LeiosNotify.Client.Announcements as Announcements
import Ouroboros.Consensus.MiniProtocol.LeiosNotify.Client.Announcements.Validation
  ( maxAnnouncementAgeRecv
  )
import Ouroboros.Consensus.MiniProtocol.LeiosNotify.Client.State
import Ouroboros.Consensus.MiniProtocol.LeiosNotify.Server
import Ouroboros.Consensus.MiniProtocol.LeiosNotify.Type
import Ouroboros.Consensus.Network.LeiosNotify
  ( leiosNotifyMiniProtocolNum
  , leiosNotifyPipelineDepth
  , runLookaheadFixedSenderPeerWithLimits
  )
import qualified Ouroboros.Consensus.Network.NodeToNode as NTN
import Ouroboros.Consensus.Node.ExitPolicy (NodeToNodeInitiatorResult)
import Ouroboros.Consensus.NodeKernel (getLeiosNotifyClientStates)
import qualified Ouroboros.Consensus.Storage.ChainDB.API as ChainDB
import Ouroboros.Consensus.Storage.ChainDB.API.Types.InvalidBlockPunishment (noPunishment)
import qualified Ouroboros.Consensus.Util.IOLike as IOLike
import Ouroboros.Network.Channel (Channel)
import Ouroboros.Network.Driver.Limits (ProtocolLimitFailure (..))
import Ouroboros.Network.Driver.Simple (DecoderFailure)
import Ouroboros.Network.Mux
  ( MiniProtocol (..)
  , TemperatureBundle (..)
  , WithProtocolTemperature (..)
  )
import Test.Consensus.Leios.Environment
import Test.Consensus.Leios.LeiosNotify.Codec (signedVote)
import Test.Consensus.Leios.LeiosNotify.Protocol
  ( ExcessiveOutcome (..)
  , WhetherDisconnected (..)
  , runPipelinedClient
  , sizeLimits
  )
import Test.Consensus.Leios.NodeUnderTest
import Test.Consensus.Leios.TestBlock
import Test.Tasty
import Test.Tasty.HUnit
import Test.Util.ChainDB (emptyNodeDBs)

tests :: TestTree
tests :: TestTree
tests =
  TestName -> [TestTree] -> TestTree
testGroup
    TestName
"node vs environment"
    [ TestName -> Assertion -> TestTree
testCase TestName
"the node's client keeps its pipeline full, and quits when the node demotes the peer" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$
        (forall s. IOSim s (Maybe NodeClientOutcome))
-> Maybe NodeClientOutcome
forall a. (forall s. IOSim s a) -> a
runSimOrThrow (DiffTime
-> IOSim s NodeClientOutcome -> IOSim s (Maybe NodeClientOutcome)
forall a. DiffTime -> IOSim s a -> IOSim s (Maybe a)
forall (m :: * -> *) a.
MonadTimer m =>
DiffTime -> m a -> m (Maybe a)
timeout DiffTime
100 IOSim s NodeClientOutcome
forall s. IOSim s NodeClientOutcome
nodeClientKeepsPipelineFull)
          Maybe NodeClientOutcome -> Maybe NodeClientOutcome -> Assertion
forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= NodeClientOutcome -> Maybe NodeClientOutcome
forall a. a -> Maybe a
Just (Int -> NodeClientOutcome
NodeClientOutcome Int
leiosNotifyPipelineDepth)
    , TestName -> Assertion -> TestTree
testCase TestName
"the node's client keeps requesting as replies arrive" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$
        (forall s. IOSim s (Maybe NodeClientOutcome))
-> Maybe NodeClientOutcome
forall a. (forall s. IOSim s a) -> a
runSimOrThrow (DiffTime
-> IOSim s NodeClientOutcome -> IOSim s (Maybe NodeClientOutcome)
forall a. DiffTime -> IOSim s a -> IOSim s (Maybe a)
forall (m :: * -> *) a.
MonadTimer m =>
DiffTime -> m a -> m (Maybe a)
timeout DiffTime
100 IOSim s NodeClientOutcome
forall s. IOSim s NodeClientOutcome
nodeClientRefillsPipeline)
          Maybe NodeClientOutcome -> Maybe NodeClientOutcome -> Assertion
forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= NodeClientOutcome -> Maybe NodeClientOutcome
forall a. a -> Maybe a
Just (Int -> NodeClientOutcome
NodeClientOutcome (Int
leiosNotifyPipelineDepth Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
6))
    , TestName -> Assertion -> TestTree
testCase TestName
"the node's client disconnects a peer that cancels a request unprompted" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$
        (forall s. IOSim s (Maybe NodeClientOutcome))
-> Maybe NodeClientOutcome
forall a. (forall s. IOSim s a) -> a
runSimOrThrow (DiffTime
-> IOSim s NodeClientOutcome -> IOSim s (Maybe NodeClientOutcome)
forall a. DiffTime -> IOSim s a -> IOSim s (Maybe a)
forall (m :: * -> *) a.
MonadTimer m =>
DiffTime -> m a -> m (Maybe a)
timeout DiffTime
100 IOSim s NodeClientOutcome
forall s. IOSim s NodeClientOutcome
nodeClientUnpromptedCancel)
          Maybe NodeClientOutcome -> Maybe NodeClientOutcome -> Assertion
forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= NodeClientOutcome -> Maybe NodeClientOutcome
forall a. a -> Maybe a
Just (DisconnectReason -> NodeClientOutcome
NodeClientDisconnected DisconnectReason
UnexpectedCancel)
    , TestName -> Assertion -> TestTree
testCase TestName
"the node's client sends no request until its immutable tip can forecast to now" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$
        (forall s. IOSim s (Maybe Int)) -> Maybe Int
forall a. (forall s. IOSim s a) -> a
runSimOrThrow (DiffTime -> IOSim s Int -> IOSim s (Maybe Int)
forall a. DiffTime -> IOSim s a -> IOSim s (Maybe a)
forall (m :: * -> *) a.
MonadTimer m =>
DiffTime -> m a -> m (Maybe a)
timeout DiffTime
100 IOSim s Int
forall s. IOSim s Int
nodeClientGated) Maybe Int -> Maybe Int -> Assertion
forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= Int -> Maybe Int
forall a. a -> Maybe a
Just Int
0
    , TestName -> Assertion -> TestTree
testCase TestName
"the node's client accepts a valid announcement" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$
        (forall s. IOSim s (Maybe NodeClientOutcome))
-> Maybe NodeClientOutcome
forall a. (forall s. IOSim s a) -> a
runSimOrThrow (DiffTime
-> IOSim s NodeClientOutcome -> IOSim s (Maybe NodeClientOutcome)
forall a. DiffTime -> IOSim s a -> IOSim s (Maybe a)
forall (m :: * -> *) a.
MonadTimer m =>
DiffTime -> m a -> m (Maybe a)
timeout DiffTime
100 ([LeiosTestBlock] -> IOSim s NodeClientOutcome
forall s. [LeiosTestBlock] -> IOSim s NodeClientOutcome
nodeClientAgainstAnnouncements [Word8 -> LeiosTestBlock -> LeiosTestBlock
ann Word8
1 (Word64 -> LeiosTestBlock
firstLeiosBlock Word64
0)]))
          Maybe NodeClientOutcome -> Maybe NodeClientOutcome -> Assertion
forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= NodeClientOutcome -> Maybe NodeClientOutcome
forall a. a -> Maybe a
Just (Int -> NodeClientOutcome
NodeClientOutcome (Int
leiosNotifyPipelineDepth Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1))
    , TestName -> Assertion -> TestTree
testCase TestName
"the node's client accepts two announcements for one election" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$
        (forall s. IOSim s (Maybe NodeClientOutcome))
-> Maybe NodeClientOutcome
forall a. (forall s. IOSim s a) -> a
runSimOrThrow
          ( DiffTime
-> IOSim s NodeClientOutcome -> IOSim s (Maybe NodeClientOutcome)
forall a. DiffTime -> IOSim s a -> IOSim s (Maybe a)
forall (m :: * -> *) a.
MonadTimer m =>
DiffTime -> m a -> m (Maybe a)
timeout DiffTime
100 (IOSim s NodeClientOutcome -> IOSim s (Maybe NodeClientOutcome))
-> IOSim s NodeClientOutcome -> IOSim s (Maybe NodeClientOutcome)
forall a b. (a -> b) -> a -> b
$
              [LeiosTestBlock] -> IOSim s NodeClientOutcome
forall s. [LeiosTestBlock] -> IOSim s NodeClientOutcome
nodeClientAgainstAnnouncements
                [Word8 -> LeiosTestBlock -> LeiosTestBlock
ann Word8
1 (Word64 -> LeiosTestBlock
firstLeiosBlock Word64
0), Word8 -> LeiosTestBlock -> LeiosTestBlock
ann Word8
2 (LeiosTestBlock -> LeiosTestBlock
forkLeiosBlock (Word64 -> LeiosTestBlock
firstLeiosBlock Word64
0))]
          )
          Maybe NodeClientOutcome -> Maybe NodeClientOutcome -> Assertion
forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= NodeClientOutcome -> Maybe NodeClientOutcome
forall a. a -> Maybe a
Just (Int -> NodeClientOutcome
NodeClientOutcome (Int
leiosNotifyPipelineDepth Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2))
    , TestName -> Assertion -> TestTree
testCase TestName
"the node's client accepts an announcement whose counter is below its immutable tip's" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$
        (forall s. IOSim s (Maybe NodeClientOutcome))
-> Maybe NodeClientOutcome
forall a. (forall s. IOSim s a) -> a
runSimOrThrow
          (DiffTime
-> IOSim s NodeClientOutcome -> IOSim s (Maybe NodeClientOutcome)
forall a. DiffTime -> IOSim s a -> IOSim s (Maybe a)
forall (m :: * -> *) a.
MonadTimer m =>
DiffTime -> m a -> m (Maybe a)
timeout DiffTime
100 ([LeiosTestBlock] -> IOSim s NodeClientOutcome
forall s. [LeiosTestBlock] -> IOSim s NodeClientOutcome
nodeClientAgainstAnnouncements [LeiosTestBlock -> LeiosTestBlock
setCounterBelowImmTips (Word8 -> LeiosTestBlock -> LeiosTestBlock
ann Word8
1 (Word64 -> LeiosTestBlock
firstLeiosBlock Word64
0))]))
          Maybe NodeClientOutcome -> Maybe NodeClientOutcome -> Assertion
forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= NodeClientOutcome -> Maybe NodeClientOutcome
forall a. a -> Maybe a
Just (Int -> NodeClientOutcome
NodeClientOutcome (Int
leiosNotifyPipelineDepth Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1))
    , TestName -> Assertion -> TestTree
testCase
        TestName
"the node's client counts an announcement whose counter is below its immutable tip's toward its election"
        (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$ (forall s. IOSim s (Maybe NodeClientOutcome))
-> Maybe NodeClientOutcome
forall a. (forall s. IOSim s a) -> a
runSimOrThrow
          ( DiffTime
-> IOSim s NodeClientOutcome -> IOSim s (Maybe NodeClientOutcome)
forall a. DiffTime -> IOSim s a -> IOSim s (Maybe a)
forall (m :: * -> *) a.
MonadTimer m =>
DiffTime -> m a -> m (Maybe a)
timeout DiffTime
100 (IOSim s NodeClientOutcome -> IOSim s (Maybe NodeClientOutcome))
-> IOSim s NodeClientOutcome -> IOSim s (Maybe NodeClientOutcome)
forall a b. (a -> b) -> a -> b
$
              [LeiosTestBlock] -> IOSim s NodeClientOutcome
forall s. [LeiosTestBlock] -> IOSim s NodeClientOutcome
nodeClientAgainstAnnouncements
                [ LeiosTestBlock -> LeiosTestBlock
setCounterBelowImmTips (Word8 -> LeiosTestBlock -> LeiosTestBlock
ann Word8
1 (Word64 -> LeiosTestBlock
firstLeiosBlock Word64
0))
                , Word8 -> LeiosTestBlock -> LeiosTestBlock
ann Word8
2 (LeiosTestBlock -> LeiosTestBlock
forkLeiosBlock (Word64 -> LeiosTestBlock
firstLeiosBlock Word64
0))
                , Word8 -> LeiosTestBlock -> LeiosTestBlock
ann Word8
3 (LeiosTestBlock -> LeiosTestBlock
forkLeiosBlock (LeiosTestBlock -> LeiosTestBlock
forkLeiosBlock (Word64 -> LeiosTestBlock
firstLeiosBlock Word64
0)))
                ]
          )
          Maybe NodeClientOutcome -> Maybe NodeClientOutcome -> Assertion
forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= NodeClientOutcome -> Maybe NodeClientOutcome
forall a. a -> Maybe a
Just (DisconnectReason -> NodeClientOutcome
NodeClientDisconnected DisconnectReason
AnnouncementThird)
    , TestName -> Assertion -> TestTree
testCase TestName
"the node's client disconnects a peer that repeats an announcement" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$
        (forall s. IOSim s (Maybe NodeClientOutcome))
-> Maybe NodeClientOutcome
forall a. (forall s. IOSim s a) -> a
runSimOrThrow
          ( DiffTime
-> IOSim s NodeClientOutcome -> IOSim s (Maybe NodeClientOutcome)
forall a. DiffTime -> IOSim s a -> IOSim s (Maybe a)
forall (m :: * -> *) a.
MonadTimer m =>
DiffTime -> m a -> m (Maybe a)
timeout DiffTime
100 (IOSim s NodeClientOutcome -> IOSim s (Maybe NodeClientOutcome))
-> IOSim s NodeClientOutcome -> IOSim s (Maybe NodeClientOutcome)
forall a b. (a -> b) -> a -> b
$
              [LeiosTestBlock] -> IOSim s NodeClientOutcome
forall s. [LeiosTestBlock] -> IOSim s NodeClientOutcome
nodeClientAgainstAnnouncements [Word8 -> LeiosTestBlock -> LeiosTestBlock
ann Word8
1 (Word64 -> LeiosTestBlock
firstLeiosBlock Word64
0), Word8 -> LeiosTestBlock -> LeiosTestBlock
ann Word8
1 (Word64 -> LeiosTestBlock
firstLeiosBlock Word64
0)]
          )
          Maybe NodeClientOutcome -> Maybe NodeClientOutcome -> Assertion
forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= NodeClientOutcome -> Maybe NodeClientOutcome
forall a. a -> Maybe a
Just (DisconnectReason -> NodeClientOutcome
NodeClientDisconnected DisconnectReason
AnnouncementRepeated)
    , TestName -> Assertion -> TestTree
testCase TestName
"the node's client disconnects a peer that announces a third time in one election" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$
        (forall s. IOSim s (Maybe NodeClientOutcome))
-> Maybe NodeClientOutcome
forall a. (forall s. IOSim s a) -> a
runSimOrThrow
          ( DiffTime
-> IOSim s NodeClientOutcome -> IOSim s (Maybe NodeClientOutcome)
forall a. DiffTime -> IOSim s a -> IOSim s (Maybe a)
forall (m :: * -> *) a.
MonadTimer m =>
DiffTime -> m a -> m (Maybe a)
timeout DiffTime
100 (IOSim s NodeClientOutcome -> IOSim s (Maybe NodeClientOutcome))
-> IOSim s NodeClientOutcome -> IOSim s (Maybe NodeClientOutcome)
forall a b. (a -> b) -> a -> b
$
              [LeiosTestBlock] -> IOSim s NodeClientOutcome
forall s. [LeiosTestBlock] -> IOSim s NodeClientOutcome
nodeClientAgainstAnnouncements
                [ Word8 -> LeiosTestBlock -> LeiosTestBlock
ann Word8
1 (Word64 -> LeiosTestBlock
firstLeiosBlock Word64
0)
                , Word8 -> LeiosTestBlock -> LeiosTestBlock
ann Word8
2 (LeiosTestBlock -> LeiosTestBlock
forkLeiosBlock (Word64 -> LeiosTestBlock
firstLeiosBlock Word64
0))
                , Word8 -> LeiosTestBlock -> LeiosTestBlock
ann Word8
3 (LeiosTestBlock -> LeiosTestBlock
forkLeiosBlock (LeiosTestBlock -> LeiosTestBlock
forkLeiosBlock (Word64 -> LeiosTestBlock
firstLeiosBlock Word64
0)))
                ]
          )
          Maybe NodeClientOutcome -> Maybe NodeClientOutcome -> Assertion
forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= NodeClientOutcome -> Maybe NodeClientOutcome
forall a. a -> Maybe a
Just (DisconnectReason -> NodeClientOutcome
NodeClientDisconnected DisconnectReason
AnnouncementThird)
    , TestName -> Assertion -> TestTree
testCase TestName
"the node's client disconnects a peer that relays a header without an announcement" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$
        (forall s. IOSim s (Maybe NodeClientOutcome))
-> Maybe NodeClientOutcome
forall a. (forall s. IOSim s a) -> a
runSimOrThrow (DiffTime
-> IOSim s NodeClientOutcome -> IOSim s (Maybe NodeClientOutcome)
forall a. DiffTime -> IOSim s a -> IOSim s (Maybe a)
forall (m :: * -> *) a.
MonadTimer m =>
DiffTime -> m a -> m (Maybe a)
timeout DiffTime
100 ([LeiosTestBlock] -> IOSim s NodeClientOutcome
forall s. [LeiosTestBlock] -> IOSim s NodeClientOutcome
nodeClientAgainstAnnouncements [Word64 -> LeiosTestBlock
firstLeiosBlock Word64
0]))
          Maybe NodeClientOutcome -> Maybe NodeClientOutcome -> Assertion
forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= NodeClientOutcome -> Maybe NodeClientOutcome
forall a. a -> Maybe a
Just (DisconnectReason -> NodeClientOutcome
NodeClientDisconnected DisconnectReason
AnnouncementMissing)
    , TestName -> Assertion -> TestTree
testCase TestName
"the node's client disconnects a peer that relays an invalid announcing header" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$
        (forall s. IOSim s (Maybe NodeClientOutcome))
-> Maybe NodeClientOutcome
forall a. (forall s. IOSim s a) -> a
runSimOrThrow
          (DiffTime
-> IOSim s NodeClientOutcome -> IOSim s (Maybe NodeClientOutcome)
forall a. DiffTime -> IOSim s a -> IOSim s (Maybe a)
forall (m :: * -> *) a.
MonadTimer m =>
DiffTime -> m a -> m (Maybe a)
timeout DiffTime
100 ([LeiosTestBlock] -> IOSim s NodeClientOutcome
forall s. [LeiosTestBlock] -> IOSim s NodeClientOutcome
nodeClientAgainstAnnouncements [LeiosTestBlock -> LeiosTestBlock
setInvalid (Word8 -> LeiosTestBlock -> LeiosTestBlock
ann Word8
1 (Word64 -> LeiosTestBlock
firstLeiosBlock Word64
0))]))
          Maybe NodeClientOutcome -> Maybe NodeClientOutcome -> Assertion
forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= NodeClientOutcome -> Maybe NodeClientOutcome
forall a. a -> Maybe a
Just (DisconnectReason -> NodeClientOutcome
NodeClientDisconnected DisconnectReason
AnnouncementInvalid)
    , TestName -> Assertion -> TestTree
testCase TestName
"the node's client disconnects a peer that relays a far-future announcement" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$
        (forall s. IOSim s (Maybe NodeClientOutcome))
-> Maybe NodeClientOutcome
forall a. (forall s. IOSim s a) -> a
runSimOrThrow
          (DiffTime
-> IOSim s NodeClientOutcome -> IOSim s (Maybe NodeClientOutcome)
forall a. DiffTime -> IOSim s a -> IOSim s (Maybe a)
forall (m :: * -> *) a.
MonadTimer m =>
DiffTime -> m a -> m (Maybe a)
timeout DiffTime
100 ([LeiosTestBlock] -> IOSim s NodeClientOutcome
forall s. [LeiosTestBlock] -> IOSim s NodeClientOutcome
nodeClientAgainstAnnouncements [Word8 -> LeiosTestBlock -> LeiosTestBlock
ann Word8
1 (SlotNo -> LeiosTestBlock -> LeiosTestBlock
setSlot SlotNo
1000 (Word64 -> LeiosTestBlock
firstLeiosBlock Word64
0))]))
          Maybe NodeClientOutcome -> Maybe NodeClientOutcome -> Assertion
forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= NodeClientOutcome -> Maybe NodeClientOutcome
forall a. a -> Maybe a
Just (DisconnectReason -> NodeClientOutcome
NodeClientDisconnected DisconnectReason
AnnouncementInFuture)
    , TestName -> Assertion -> TestTree
testCase TestName
"the node's client disconnects a peer that relays a too-old announcement" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$
        (forall s. IOSim s (Maybe NodeClientOutcome))
-> Maybe NodeClientOutcome
forall a. (forall s. IOSim s a) -> a
runSimOrThrow (DiffTime
-> IOSim s NodeClientOutcome -> IOSim s (Maybe NodeClientOutcome)
forall a. DiffTime -> IOSim s a -> IOSim s (Maybe a)
forall (m :: * -> *) a.
MonadTimer m =>
DiffTime -> m a -> m (Maybe a)
timeout DiffTime
1000 IOSim s NodeClientOutcome
forall s. IOSim s NodeClientOutcome
nodeClientTooOld)
          Maybe NodeClientOutcome -> Maybe NodeClientOutcome -> Assertion
forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= NodeClientOutcome -> Maybe NodeClientOutcome
forall a. a -> Maybe a
Just (DisconnectReason -> NodeClientOutcome
NodeClientDisconnected DisconnectReason
AnnouncementTooOld)
    , TestName -> Assertion -> TestTree
testCase TestName
"the node prunes its clients' state as its immutable tip advances" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$
        (forall s.
 IOSim s (Maybe ((Int, Int, Int, Int), (Int, Int, Int, Int))))
-> Maybe ((Int, Int, Int, Int), (Int, Int, Int, Int))
forall a. (forall s. IOSim s a) -> a
runSimOrThrow (DiffTime
-> IOSim s ((Int, Int, Int, Int), (Int, Int, Int, Int))
-> IOSim s (Maybe ((Int, Int, Int, Int), (Int, Int, Int, Int)))
forall a. DiffTime -> IOSim s a -> IOSim s (Maybe a)
forall (m :: * -> *) a.
MonadTimer m =>
DiffTime -> m a -> m (Maybe a)
timeout DiffTime
1000 IOSim s ((Int, Int, Int, Int), (Int, Int, Int, Int))
forall s. IOSim s ((Int, Int, Int, Int), (Int, Int, Int, Int))
nodePrunesClientState) Maybe ((Int, Int, Int, Int), (Int, Int, Int, Int))
-> Maybe ((Int, Int, Int, Int), (Int, Int, Int, Int)) -> Assertion
forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= ((Int, Int, Int, Int), (Int, Int, Int, Int))
-> Maybe ((Int, Int, Int, Int), (Int, Int, Int, Int))
forall a. a -> Maybe a
Just ((Int
1, Int
1, Int
1, Int
1), (Int
0, Int
0, Int
0, Int
0))
    , TestName -> Assertion -> TestTree
testCase TestName
"the node's client accepts an offer of an endorser block its peer announced" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$
        (forall s. IOSim s (Maybe NodeClientOutcome))
-> Maybe NodeClientOutcome
forall a. (forall s. IOSim s a) -> a
runSimOrThrow (DiffTime
-> IOSim s NodeClientOutcome -> IOSim s (Maybe NodeClientOutcome)
forall a. DiffTime -> IOSim s a -> IOSim s (Maybe a)
forall (m :: * -> *) a.
MonadTimer m =>
DiffTime -> m a -> m (Maybe a)
timeout DiffTime
100 ([Message
   (LeiosNotify LeiosPoint (Header LeiosTestBlock) LeiosVote)
   'StBusy
   'StIdle]
-> IOSim s NodeClientOutcome
forall s.
[Message
   (LeiosNotify LeiosPoint (Header LeiosTestBlock) LeiosVote)
   'StBusy
   'StIdle]
-> IOSim s NodeClientOutcome
nodeClientAgainstOffers [LeiosPoint
-> Word32
-> Message
     (LeiosNotify LeiosPoint (Header LeiosTestBlock) LeiosVote)
     'StBusy
     'StIdle
forall point announcement vote.
point
-> Word32
-> Message (LeiosNotify point announcement vote) 'StBusy 'StIdle
MsgLeiosBlockOffer LeiosPoint
someOfferedPoint Word32
1000]))
          Maybe NodeClientOutcome -> Maybe NodeClientOutcome -> Assertion
forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= NodeClientOutcome -> Maybe NodeClientOutcome
forall a. a -> Maybe a
Just (Int -> NodeClientOutcome
NodeClientOutcome (Int
leiosNotifyPipelineDepth Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2))
    , TestName -> Assertion -> TestTree
testCase TestName
"the node's client disconnects a peer that offers an endorser block it never announced" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$
        (forall s. IOSim s (Maybe NodeClientOutcome))
-> Maybe NodeClientOutcome
forall a. (forall s. IOSim s a) -> a
runSimOrThrow
          ( DiffTime
-> IOSim s NodeClientOutcome -> IOSim s (Maybe NodeClientOutcome)
forall a. DiffTime -> IOSim s a -> IOSim s (Maybe a)
forall (m :: * -> *) a.
MonadTimer m =>
DiffTime -> m a -> m (Maybe a)
timeout DiffTime
100 (IOSim s NodeClientOutcome -> IOSim s (Maybe NodeClientOutcome))
-> IOSim s NodeClientOutcome -> IOSim s (Maybe NodeClientOutcome)
forall a b. (a -> b) -> a -> b
$
              [Message
   (LeiosNotify LeiosPoint (Header LeiosTestBlock) LeiosVote)
   'StBusy
   'StIdle]
-> IOSim s NodeClientOutcome
forall s.
[Message
   (LeiosNotify LeiosPoint (Header LeiosTestBlock) LeiosVote)
   'StBusy
   'StIdle]
-> IOSim s NodeClientOutcome
nodeClientAgainstOffers
                [LeiosPoint
-> Word32
-> Message
     (LeiosNotify LeiosPoint (Header LeiosTestBlock) LeiosVote)
     'StBusy
     'StIdle
forall point announcement vote.
point
-> Word32
-> Message (LeiosNotify point announcement vote) 'StBusy 'StIdle
MsgLeiosBlockOffer (SlotNo -> EbHash -> LeiosPoint
MkLeiosPoint (Word64 -> SlotNo
SlotNo Word64
1) (ByteString -> EbHash
MkEbHash (Int -> Word8 -> ByteString
BS.replicate Int
32 Word8
2))) Word32
1000]
          )
          Maybe NodeClientOutcome -> Maybe NodeClientOutcome -> Assertion
forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= NodeClientOutcome -> Maybe NodeClientOutcome
forall a. a -> Maybe a
Just (DisconnectReason -> NodeClientOutcome
NodeClientDisconnected DisconnectReason
OfferWithoutAnnouncement)
    , TestName -> Assertion -> TestTree
testCase TestName
"the node's client disconnects a peer that repeats a body offer" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$
        (forall s. IOSim s (Maybe NodeClientOutcome))
-> Maybe NodeClientOutcome
forall a. (forall s. IOSim s a) -> a
runSimOrThrow
          ( DiffTime
-> IOSim s NodeClientOutcome -> IOSim s (Maybe NodeClientOutcome)
forall a. DiffTime -> IOSim s a -> IOSim s (Maybe a)
forall (m :: * -> *) a.
MonadTimer m =>
DiffTime -> m a -> m (Maybe a)
timeout DiffTime
100 (IOSim s NodeClientOutcome -> IOSim s (Maybe NodeClientOutcome))
-> IOSim s NodeClientOutcome -> IOSim s (Maybe NodeClientOutcome)
forall a b. (a -> b) -> a -> b
$
              [Message
   (LeiosNotify LeiosPoint (Header LeiosTestBlock) LeiosVote)
   'StBusy
   'StIdle]
-> IOSim s NodeClientOutcome
forall s.
[Message
   (LeiosNotify LeiosPoint (Header LeiosTestBlock) LeiosVote)
   'StBusy
   'StIdle]
-> IOSim s NodeClientOutcome
nodeClientAgainstOffers
                [LeiosPoint
-> Word32
-> Message
     (LeiosNotify LeiosPoint (Header LeiosTestBlock) LeiosVote)
     'StBusy
     'StIdle
forall point announcement vote.
point
-> Word32
-> Message (LeiosNotify point announcement vote) 'StBusy 'StIdle
MsgLeiosBlockOffer LeiosPoint
someOfferedPoint Word32
1000, LeiosPoint
-> Word32
-> Message
     (LeiosNotify LeiosPoint (Header LeiosTestBlock) LeiosVote)
     'StBusy
     'StIdle
forall point announcement vote.
point
-> Word32
-> Message (LeiosNotify point announcement vote) 'StBusy 'StIdle
MsgLeiosBlockOffer LeiosPoint
someOfferedPoint Word32
1000]
          )
          Maybe NodeClientOutcome -> Maybe NodeClientOutcome -> Assertion
forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= NodeClientOutcome -> Maybe NodeClientOutcome
forall a. a -> Maybe a
Just (DisconnectReason -> NodeClientOutcome
NodeClientDisconnected DisconnectReason
OfferRepeated)
    , TestName -> Assertion -> TestTree
testCase TestName
"the node's client disconnects a peer that offers an empty endorser block" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$
        (forall s. IOSim s (Maybe NodeClientOutcome))
-> Maybe NodeClientOutcome
forall a. (forall s. IOSim s a) -> a
runSimOrThrow (DiffTime
-> IOSim s NodeClientOutcome -> IOSim s (Maybe NodeClientOutcome)
forall a. DiffTime -> IOSim s a -> IOSim s (Maybe a)
forall (m :: * -> *) a.
MonadTimer m =>
DiffTime -> m a -> m (Maybe a)
timeout DiffTime
100 ([Message
   (LeiosNotify LeiosPoint (Header LeiosTestBlock) LeiosVote)
   'StBusy
   'StIdle]
-> IOSim s NodeClientOutcome
forall s.
[Message
   (LeiosNotify LeiosPoint (Header LeiosTestBlock) LeiosVote)
   'StBusy
   'StIdle]
-> IOSim s NodeClientOutcome
nodeClientAgainstOffers [LeiosPoint
-> Word32
-> Message
     (LeiosNotify LeiosPoint (Header LeiosTestBlock) LeiosVote)
     'StBusy
     'StIdle
forall point announcement vote.
point
-> Word32
-> Message (LeiosNotify point announcement vote) 'StBusy 'StIdle
MsgLeiosBlockOffer LeiosPoint
someOfferedPoint Word32
0]))
          Maybe NodeClientOutcome -> Maybe NodeClientOutcome -> Assertion
forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= NodeClientOutcome -> Maybe NodeClientOutcome
forall a. a -> Maybe a
Just (DisconnectReason -> NodeClientOutcome
NodeClientDisconnected DisconnectReason
OfferBadSize)
    , TestName -> Assertion -> TestTree
testCase
        TestName
"the node's client disconnects a peer that offers an endorser block bigger than the ledger allows"
        (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$ (forall s. IOSim s (Maybe NodeClientOutcome))
-> Maybe NodeClientOutcome
forall a. (forall s. IOSim s a) -> a
runSimOrThrow
          (DiffTime
-> IOSim s NodeClientOutcome -> IOSim s (Maybe NodeClientOutcome)
forall a. DiffTime -> IOSim s a -> IOSim s (Maybe a)
forall (m :: * -> *) a.
MonadTimer m =>
DiffTime -> m a -> m (Maybe a)
timeout DiffTime
100 ([Message
   (LeiosNotify LeiosPoint (Header LeiosTestBlock) LeiosVote)
   'StBusy
   'StIdle]
-> IOSim s NodeClientOutcome
forall s.
[Message
   (LeiosNotify LeiosPoint (Header LeiosTestBlock) LeiosVote)
   'StBusy
   'StIdle]
-> IOSim s NodeClientOutcome
nodeClientAgainstOffers [LeiosPoint
-> Word32
-> Message
     (LeiosNotify LeiosPoint (Header LeiosTestBlock) LeiosVote)
     'StBusy
     'StIdle
forall point announcement vote.
point
-> Word32
-> Message (LeiosNotify point announcement vote) 'StBusy 'StIdle
MsgLeiosBlockOffer LeiosPoint
someOfferedPoint (Word32
maxEbBodySize Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
+ Word32
1)]))
          Maybe NodeClientOutcome -> Maybe NodeClientOutcome -> Assertion
forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= NodeClientOutcome -> Maybe NodeClientOutcome
forall a. a -> Maybe a
Just (DisconnectReason -> NodeClientOutcome
NodeClientDisconnected DisconnectReason
OfferBadSize)
    , TestName -> Assertion -> TestTree
testCase
        TestName
"the node's client disconnects a peer that offers an endorser block older than its immutable tip"
        (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$ (forall s. IOSim s (Maybe NodeClientOutcome))
-> Maybe NodeClientOutcome
forall a. (forall s. IOSim s a) -> a
runSimOrThrow (DiffTime
-> IOSim s NodeClientOutcome -> IOSim s (Maybe NodeClientOutcome)
forall a. DiffTime -> IOSim s a -> IOSim s (Maybe a)
forall (m :: * -> *) a.
MonadTimer m =>
DiffTime -> m a -> m (Maybe a)
timeout DiffTime
1000 (Message
  (LeiosNotify LeiosPoint (Header LeiosTestBlock) LeiosVote)
  'StBusy
  'StIdle
-> IOSim s NodeClientOutcome
forall s.
Message
  (LeiosNotify LeiosPoint (Header LeiosTestBlock) LeiosVote)
  'StBusy
  'StIdle
-> IOSim s NodeClientOutcome
nodeClientOfferTooOld (LeiosPoint
-> Word32
-> Message
     (LeiosNotify LeiosPoint (Header LeiosTestBlock) LeiosVote)
     'StBusy
     'StIdle
forall point announcement vote.
point
-> Word32
-> Message (LeiosNotify point announcement vote) 'StBusy 'StIdle
MsgLeiosBlockOffer LeiosPoint
someOfferedPoint Word32
1000)))
          Maybe NodeClientOutcome -> Maybe NodeClientOutcome -> Assertion
forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= NodeClientOutcome -> Maybe NodeClientOutcome
forall a. a -> Maybe a
Just (DisconnectReason -> NodeClientOutcome
NodeClientDisconnected DisconnectReason
OfferTooOld)
    , TestName -> Assertion -> TestTree
testCase TestName
"the node's client accepts a closure offer of an endorser block its peer announced" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$
        (forall s. IOSim s (Maybe NodeClientOutcome))
-> Maybe NodeClientOutcome
forall a. (forall s. IOSim s a) -> a
runSimOrThrow (DiffTime
-> IOSim s NodeClientOutcome -> IOSim s (Maybe NodeClientOutcome)
forall a. DiffTime -> IOSim s a -> IOSim s (Maybe a)
forall (m :: * -> *) a.
MonadTimer m =>
DiffTime -> m a -> m (Maybe a)
timeout DiffTime
100 ([Message
   (LeiosNotify LeiosPoint (Header LeiosTestBlock) LeiosVote)
   'StBusy
   'StIdle]
-> IOSim s NodeClientOutcome
forall s.
[Message
   (LeiosNotify LeiosPoint (Header LeiosTestBlock) LeiosVote)
   'StBusy
   'StIdle]
-> IOSim s NodeClientOutcome
nodeClientAgainstOffers [LeiosPoint
-> Message
     (LeiosNotify LeiosPoint (Header LeiosTestBlock) LeiosVote)
     'StBusy
     'StIdle
forall point announcement vote.
point
-> Message (LeiosNotify point announcement vote) 'StBusy 'StIdle
MsgLeiosBlockTxsOffer LeiosPoint
someOfferedPoint]))
          Maybe NodeClientOutcome -> Maybe NodeClientOutcome -> Assertion
forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= NodeClientOutcome -> Maybe NodeClientOutcome
forall a. a -> Maybe a
Just (Int -> NodeClientOutcome
NodeClientOutcome (Int
leiosNotifyPipelineDepth Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2))
    , TestName -> Assertion -> TestTree
testCase TestName
"the node's client accepts a body offer and a closure offer of one endorser block" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$
        (forall s. IOSim s (Maybe NodeClientOutcome))
-> Maybe NodeClientOutcome
forall a. (forall s. IOSim s a) -> a
runSimOrThrow
          ( DiffTime
-> IOSim s NodeClientOutcome -> IOSim s (Maybe NodeClientOutcome)
forall a. DiffTime -> IOSim s a -> IOSim s (Maybe a)
forall (m :: * -> *) a.
MonadTimer m =>
DiffTime -> m a -> m (Maybe a)
timeout DiffTime
100 (IOSim s NodeClientOutcome -> IOSim s (Maybe NodeClientOutcome))
-> IOSim s NodeClientOutcome -> IOSim s (Maybe NodeClientOutcome)
forall a b. (a -> b) -> a -> b
$
              [Message
   (LeiosNotify LeiosPoint (Header LeiosTestBlock) LeiosVote)
   'StBusy
   'StIdle]
-> IOSim s NodeClientOutcome
forall s.
[Message
   (LeiosNotify LeiosPoint (Header LeiosTestBlock) LeiosVote)
   'StBusy
   'StIdle]
-> IOSim s NodeClientOutcome
nodeClientAgainstOffers
                [LeiosPoint
-> Message
     (LeiosNotify LeiosPoint (Header LeiosTestBlock) LeiosVote)
     'StBusy
     'StIdle
forall point announcement vote.
point
-> Message (LeiosNotify point announcement vote) 'StBusy 'StIdle
MsgLeiosBlockTxsOffer LeiosPoint
someOfferedPoint, LeiosPoint
-> Word32
-> Message
     (LeiosNotify LeiosPoint (Header LeiosTestBlock) LeiosVote)
     'StBusy
     'StIdle
forall point announcement vote.
point
-> Word32
-> Message (LeiosNotify point announcement vote) 'StBusy 'StIdle
MsgLeiosBlockOffer LeiosPoint
someOfferedPoint Word32
1000]
          )
          Maybe NodeClientOutcome -> Maybe NodeClientOutcome -> Assertion
forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= NodeClientOutcome -> Maybe NodeClientOutcome
forall a. a -> Maybe a
Just (Int -> NodeClientOutcome
NodeClientOutcome (Int
leiosNotifyPipelineDepth Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
3))
    , TestName -> Assertion -> TestTree
testCase
        TestName
"the node's client disconnects a peer that closure-offers an endorser block it never announced"
        (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$ (forall s. IOSim s (Maybe NodeClientOutcome))
-> Maybe NodeClientOutcome
forall a. (forall s. IOSim s a) -> a
runSimOrThrow
          ( DiffTime
-> IOSim s NodeClientOutcome -> IOSim s (Maybe NodeClientOutcome)
forall a. DiffTime -> IOSim s a -> IOSim s (Maybe a)
forall (m :: * -> *) a.
MonadTimer m =>
DiffTime -> m a -> m (Maybe a)
timeout DiffTime
100 (IOSim s NodeClientOutcome -> IOSim s (Maybe NodeClientOutcome))
-> IOSim s NodeClientOutcome -> IOSim s (Maybe NodeClientOutcome)
forall a b. (a -> b) -> a -> b
$
              [Message
   (LeiosNotify LeiosPoint (Header LeiosTestBlock) LeiosVote)
   'StBusy
   'StIdle]
-> IOSim s NodeClientOutcome
forall s.
[Message
   (LeiosNotify LeiosPoint (Header LeiosTestBlock) LeiosVote)
   'StBusy
   'StIdle]
-> IOSim s NodeClientOutcome
nodeClientAgainstOffers
                [LeiosPoint
-> Message
     (LeiosNotify LeiosPoint (Header LeiosTestBlock) LeiosVote)
     'StBusy
     'StIdle
forall point announcement vote.
point
-> Message (LeiosNotify point announcement vote) 'StBusy 'StIdle
MsgLeiosBlockTxsOffer (SlotNo -> EbHash -> LeiosPoint
MkLeiosPoint (Word64 -> SlotNo
SlotNo Word64
1) (ByteString -> EbHash
MkEbHash (Int -> Word8 -> ByteString
BS.replicate Int
32 Word8
2)))]
          )
          Maybe NodeClientOutcome -> Maybe NodeClientOutcome -> Assertion
forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= NodeClientOutcome -> Maybe NodeClientOutcome
forall a. a -> Maybe a
Just (DisconnectReason -> NodeClientOutcome
NodeClientDisconnected DisconnectReason
ClosureOfferWithoutAnnouncement)
    , TestName -> Assertion -> TestTree
testCase TestName
"the node's client disconnects a peer that repeats a closure offer" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$
        (forall s. IOSim s (Maybe NodeClientOutcome))
-> Maybe NodeClientOutcome
forall a. (forall s. IOSim s a) -> a
runSimOrThrow
          ( DiffTime
-> IOSim s NodeClientOutcome -> IOSim s (Maybe NodeClientOutcome)
forall a. DiffTime -> IOSim s a -> IOSim s (Maybe a)
forall (m :: * -> *) a.
MonadTimer m =>
DiffTime -> m a -> m (Maybe a)
timeout DiffTime
100 (IOSim s NodeClientOutcome -> IOSim s (Maybe NodeClientOutcome))
-> IOSim s NodeClientOutcome -> IOSim s (Maybe NodeClientOutcome)
forall a b. (a -> b) -> a -> b
$
              [Message
   (LeiosNotify LeiosPoint (Header LeiosTestBlock) LeiosVote)
   'StBusy
   'StIdle]
-> IOSim s NodeClientOutcome
forall s.
[Message
   (LeiosNotify LeiosPoint (Header LeiosTestBlock) LeiosVote)
   'StBusy
   'StIdle]
-> IOSim s NodeClientOutcome
nodeClientAgainstOffers
                [LeiosPoint
-> Message
     (LeiosNotify LeiosPoint (Header LeiosTestBlock) LeiosVote)
     'StBusy
     'StIdle
forall point announcement vote.
point
-> Message (LeiosNotify point announcement vote) 'StBusy 'StIdle
MsgLeiosBlockTxsOffer LeiosPoint
someOfferedPoint, LeiosPoint
-> Message
     (LeiosNotify LeiosPoint (Header LeiosTestBlock) LeiosVote)
     'StBusy
     'StIdle
forall point announcement vote.
point
-> Message (LeiosNotify point announcement vote) 'StBusy 'StIdle
MsgLeiosBlockTxsOffer LeiosPoint
someOfferedPoint]
          )
          Maybe NodeClientOutcome -> Maybe NodeClientOutcome -> Assertion
forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= NodeClientOutcome -> Maybe NodeClientOutcome
forall a. a -> Maybe a
Just (DisconnectReason -> NodeClientOutcome
NodeClientDisconnected DisconnectReason
ClosureOfferRepeated)
    , TestName -> Assertion -> TestTree
testCase
        TestName
"the node's client disconnects a peer that closure-offers an endorser block older than its immutable tip"
        (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$ (forall s. IOSim s (Maybe NodeClientOutcome))
-> Maybe NodeClientOutcome
forall a. (forall s. IOSim s a) -> a
runSimOrThrow (DiffTime
-> IOSim s NodeClientOutcome -> IOSim s (Maybe NodeClientOutcome)
forall a. DiffTime -> IOSim s a -> IOSim s (Maybe a)
forall (m :: * -> *) a.
MonadTimer m =>
DiffTime -> m a -> m (Maybe a)
timeout DiffTime
1000 (Message
  (LeiosNotify LeiosPoint (Header LeiosTestBlock) LeiosVote)
  'StBusy
  'StIdle
-> IOSim s NodeClientOutcome
forall s.
Message
  (LeiosNotify LeiosPoint (Header LeiosTestBlock) LeiosVote)
  'StBusy
  'StIdle
-> IOSim s NodeClientOutcome
nodeClientOfferTooOld (LeiosPoint
-> Message
     (LeiosNotify LeiosPoint (Header LeiosTestBlock) LeiosVote)
     'StBusy
     'StIdle
forall point announcement vote.
point
-> Message (LeiosNotify point announcement vote) 'StBusy 'StIdle
MsgLeiosBlockTxsOffer LeiosPoint
someOfferedPoint)))
          Maybe NodeClientOutcome -> Maybe NodeClientOutcome -> Assertion
forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= NodeClientOutcome -> Maybe NodeClientOutcome
forall a. a -> Maybe a
Just (DisconnectReason -> NodeClientOutcome
NodeClientDisconnected DisconnectReason
OfferTooOld)
    , TestName -> Assertion -> TestTree
testCase TestName
"the node's client accepts a vote within its window" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$
        (forall s. IOSim s (Maybe NodeClientOutcome))
-> Maybe NodeClientOutcome
forall a. (forall s. IOSim s a) -> a
runSimOrThrow
          ( DiffTime
-> IOSim s NodeClientOutcome -> IOSim s (Maybe NodeClientOutcome)
forall a. DiffTime -> IOSim s a -> IOSim s (Maybe a)
forall (m :: * -> *) a.
MonadTimer m =>
DiffTime -> m a -> m (Maybe a)
timeout
              DiffTime
100
              ([(DiffTime,
  Message
    (LeiosNotify LeiosPoint (Header LeiosTestBlock) LeiosVote)
    'StBusy
    'StIdle)]
-> IOSim s NodeClientOutcome
forall s.
[(DiffTime,
  Message
    (LeiosNotify LeiosPoint (Header LeiosTestBlock) LeiosVote)
    'StBusy
    'StIdle)]
-> IOSim s NodeClientOutcome
nodeClientAgainstSchedule [(DiffTime
5, NonEmpty LeiosVote
-> Message
     (LeiosNotify LeiosPoint (Header LeiosTestBlock) LeiosVote)
     'StBusy
     'StIdle
forall vote point announcement.
NonEmpty vote
-> Message (LeiosNotify point announcement vote) 'StBusy 'StIdle
MsgLeiosVotes ([LeiosVote] -> NonEmpty LeiosVote
forall a. HasCallStack => [a] -> NonEmpty a
NE.fromList [LeiosTestBlock -> Word16 -> LeiosVote
voteFor LeiosTestBlock
someAnnouncingBlock Word16
0]))])
          )
          Maybe NodeClientOutcome -> Maybe NodeClientOutcome -> Assertion
forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= NodeClientOutcome -> Maybe NodeClientOutcome
forall a. a -> Maybe a
Just (Int -> NodeClientOutcome
NodeClientOutcome (Int
leiosNotifyPipelineDepth Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2))
    , TestName -> Assertion -> TestTree
testCase TestName
"the node's client accepts votes from different seats in one slot" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$
        (forall s. IOSim s (Maybe NodeClientOutcome))
-> Maybe NodeClientOutcome
forall a. (forall s. IOSim s a) -> a
runSimOrThrow
          ( DiffTime
-> IOSim s NodeClientOutcome -> IOSim s (Maybe NodeClientOutcome)
forall a. DiffTime -> IOSim s a -> IOSim s (Maybe a)
forall (m :: * -> *) a.
MonadTimer m =>
DiffTime -> m a -> m (Maybe a)
timeout DiffTime
100 (IOSim s NodeClientOutcome -> IOSim s (Maybe NodeClientOutcome))
-> IOSim s NodeClientOutcome -> IOSim s (Maybe NodeClientOutcome)
forall a b. (a -> b) -> a -> b
$
              [(DiffTime,
  Message
    (LeiosNotify LeiosPoint (Header LeiosTestBlock) LeiosVote)
    'StBusy
    'StIdle)]
-> IOSim s NodeClientOutcome
forall s.
[(DiffTime,
  Message
    (LeiosNotify LeiosPoint (Header LeiosTestBlock) LeiosVote)
    'StBusy
    'StIdle)]
-> IOSim s NodeClientOutcome
nodeClientAgainstSchedule
                [(DiffTime
5, NonEmpty LeiosVote
-> Message
     (LeiosNotify LeiosPoint (Header LeiosTestBlock) LeiosVote)
     'StBusy
     'StIdle
forall vote point announcement.
NonEmpty vote
-> Message (LeiosNotify point announcement vote) 'StBusy 'StIdle
MsgLeiosVotes ([LeiosVote] -> NonEmpty LeiosVote
forall a. HasCallStack => [a] -> NonEmpty a
NE.fromList [LeiosTestBlock -> Word16 -> LeiosVote
voteFor LeiosTestBlock
someAnnouncingBlock Word16
0, LeiosTestBlock -> Word16 -> LeiosVote
voteFor LeiosTestBlock
someAnnouncingBlock Word16
1]))]
          )
          Maybe NodeClientOutcome -> Maybe NodeClientOutcome -> Assertion
forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= NodeClientOutcome -> Maybe NodeClientOutcome
forall a. a -> Maybe a
Just (Int -> NodeClientOutcome
NodeClientOutcome (Int
leiosNotifyPipelineDepth Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2))
    , TestName -> Assertion -> TestTree
testCase TestName
"the node's client disconnects a peer that votes for an announcement it never sent" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$
        (forall s. IOSim s (Maybe NodeClientOutcome))
-> Maybe NodeClientOutcome
forall a. (forall s. IOSim s a) -> a
runSimOrThrow
          ( DiffTime
-> IOSim s NodeClientOutcome -> IOSim s (Maybe NodeClientOutcome)
forall a. DiffTime -> IOSim s a -> IOSim s (Maybe a)
forall (m :: * -> *) a.
MonadTimer m =>
DiffTime -> m a -> m (Maybe a)
timeout DiffTime
100 (IOSim s NodeClientOutcome -> IOSim s (Maybe NodeClientOutcome))
-> IOSim s NodeClientOutcome -> IOSim s (Maybe NodeClientOutcome)
forall a b. (a -> b) -> a -> b
$
              [(DiffTime,
  Message
    (LeiosNotify LeiosPoint (Header LeiosTestBlock) LeiosVote)
    'StBusy
    'StIdle)]
-> IOSim s NodeClientOutcome
forall s.
[(DiffTime,
  Message
    (LeiosNotify LeiosPoint (Header LeiosTestBlock) LeiosVote)
    'StBusy
    'StIdle)]
-> IOSim s NodeClientOutcome
nodeClientAgainstSchedule
                [(DiffTime
5, NonEmpty LeiosVote
-> Message
     (LeiosNotify LeiosPoint (Header LeiosTestBlock) LeiosVote)
     'StBusy
     'StIdle
forall vote point announcement.
NonEmpty vote
-> Message (LeiosNotify point announcement vote) 'StBusy 'StIdle
MsgLeiosVotes ([LeiosVote] -> NonEmpty LeiosVote
forall a. HasCallStack => [a] -> NonEmpty a
NE.fromList [LeiosTestBlock -> Word16 -> LeiosVote
voteFor (Word8 -> LeiosTestBlock -> LeiosTestBlock
ann Word8
2 (LeiosTestBlock -> LeiosTestBlock
successorLeiosBlock (Word64 -> LeiosTestBlock
firstLeiosBlock Word64
0))) Word16
0]))]
          )
          Maybe NodeClientOutcome -> Maybe NodeClientOutcome -> Assertion
forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= NodeClientOutcome -> Maybe NodeClientOutcome
forall a. a -> Maybe a
Just (DisconnectReason -> NodeClientOutcome
NodeClientDisconnected DisconnectReason
VoteWithoutAnnouncement)
    , TestName -> Assertion -> TestTree
testCase TestName
"the node's client disconnects a peer that relays two votes from one seat in one slot" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$
        (forall s. IOSim s (Maybe NodeClientOutcome))
-> Maybe NodeClientOutcome
forall a. (forall s. IOSim s a) -> a
runSimOrThrow
          ( DiffTime
-> IOSim s NodeClientOutcome -> IOSim s (Maybe NodeClientOutcome)
forall a. DiffTime -> IOSim s a -> IOSim s (Maybe a)
forall (m :: * -> *) a.
MonadTimer m =>
DiffTime -> m a -> m (Maybe a)
timeout DiffTime
100 (IOSim s NodeClientOutcome -> IOSim s (Maybe NodeClientOutcome))
-> IOSim s NodeClientOutcome -> IOSim s (Maybe NodeClientOutcome)
forall a b. (a -> b) -> a -> b
$
              [(DiffTime,
  Message
    (LeiosNotify LeiosPoint (Header LeiosTestBlock) LeiosVote)
    'StBusy
    'StIdle)]
-> IOSim s NodeClientOutcome
forall s.
[(DiffTime,
  Message
    (LeiosNotify LeiosPoint (Header LeiosTestBlock) LeiosVote)
    'StBusy
    'StIdle)]
-> IOSim s NodeClientOutcome
nodeClientAgainstSchedule
                [ (DiffTime
0, Header LeiosTestBlock
-> Message
     (LeiosNotify LeiosPoint (Header LeiosTestBlock) LeiosVote)
     'StBusy
     'StIdle
forall announcement point vote.
announcement
-> Message (LeiosNotify point announcement vote) 'StBusy 'StIdle
MsgLeiosBlockAnnouncement (LeiosTestBlock -> Header LeiosTestBlock
ltbHeader LeiosTestBlock
equivocation))
                , (DiffTime
5, NonEmpty LeiosVote
-> Message
     (LeiosNotify LeiosPoint (Header LeiosTestBlock) LeiosVote)
     'StBusy
     'StIdle
forall vote point announcement.
NonEmpty vote
-> Message (LeiosNotify point announcement vote) 'StBusy 'StIdle
MsgLeiosVotes ([LeiosVote] -> NonEmpty LeiosVote
forall a. HasCallStack => [a] -> NonEmpty a
NE.fromList [LeiosTestBlock -> Word16 -> LeiosVote
voteFor LeiosTestBlock
someAnnouncingBlock Word16
0]))
                , (DiffTime
5, NonEmpty LeiosVote
-> Message
     (LeiosNotify LeiosPoint (Header LeiosTestBlock) LeiosVote)
     'StBusy
     'StIdle
forall vote point announcement.
NonEmpty vote
-> Message (LeiosNotify point announcement vote) 'StBusy 'StIdle
MsgLeiosVotes ([LeiosVote] -> NonEmpty LeiosVote
forall a. HasCallStack => [a] -> NonEmpty a
NE.fromList [LeiosTestBlock -> Word16 -> LeiosVote
voteFor LeiosTestBlock
equivocation Word16
0]))
                ]
          )
          Maybe NodeClientOutcome -> Maybe NodeClientOutcome -> Assertion
forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= NodeClientOutcome -> Maybe NodeClientOutcome
forall a. a -> Maybe a
Just (DisconnectReason -> NodeClientOutcome
NodeClientDisconnected DisconnectReason
VoteRepeated)
    , TestName -> Assertion -> TestTree
testCase TestName
"the node's client disconnects a peer that relays a vote too early" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$
        (forall s. IOSim s (Maybe NodeClientOutcome))
-> Maybe NodeClientOutcome
forall a. (forall s. IOSim s a) -> a
runSimOrThrow
          ( DiffTime
-> IOSim s NodeClientOutcome -> IOSim s (Maybe NodeClientOutcome)
forall a. DiffTime -> IOSim s a -> IOSim s (Maybe a)
forall (m :: * -> *) a.
MonadTimer m =>
DiffTime -> m a -> m (Maybe a)
timeout
              DiffTime
100
              ([(DiffTime,
  Message
    (LeiosNotify LeiosPoint (Header LeiosTestBlock) LeiosVote)
    'StBusy
    'StIdle)]
-> IOSim s NodeClientOutcome
forall s.
[(DiffTime,
  Message
    (LeiosNotify LeiosPoint (Header LeiosTestBlock) LeiosVote)
    'StBusy
    'StIdle)]
-> IOSim s NodeClientOutcome
nodeClientAgainstSchedule [(DiffTime
1.5, NonEmpty LeiosVote
-> Message
     (LeiosNotify LeiosPoint (Header LeiosTestBlock) LeiosVote)
     'StBusy
     'StIdle
forall vote point announcement.
NonEmpty vote
-> Message (LeiosNotify point announcement vote) 'StBusy 'StIdle
MsgLeiosVotes ([LeiosVote] -> NonEmpty LeiosVote
forall a. HasCallStack => [a] -> NonEmpty a
NE.fromList [LeiosTestBlock -> Word16 -> LeiosVote
voteFor LeiosTestBlock
someAnnouncingBlock Word16
0]))])
          )
          Maybe NodeClientOutcome -> Maybe NodeClientOutcome -> Assertion
forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= NodeClientOutcome -> Maybe NodeClientOutcome
forall a. a -> Maybe a
Just (DisconnectReason -> NodeClientOutcome
NodeClientDisconnected DisconnectReason
VoteTooEarly)
    , TestName -> Assertion -> TestTree
testCase TestName
"the node's client disconnects a peer that relays a vote too late" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$
        (forall s. IOSim s (Maybe NodeClientOutcome))
-> Maybe NodeClientOutcome
forall a. (forall s. IOSim s a) -> a
runSimOrThrow
          ( DiffTime
-> IOSim s NodeClientOutcome -> IOSim s (Maybe NodeClientOutcome)
forall a. DiffTime -> IOSim s a -> IOSim s (Maybe a)
forall (m :: * -> *) a.
MonadTimer m =>
DiffTime -> m a -> m (Maybe a)
timeout
              DiffTime
200
              ([(DiffTime,
  Message
    (LeiosNotify LeiosPoint (Header LeiosTestBlock) LeiosVote)
    'StBusy
    'StIdle)]
-> IOSim s NodeClientOutcome
forall s.
[(DiffTime,
  Message
    (LeiosNotify LeiosPoint (Header LeiosTestBlock) LeiosVote)
    'StBusy
    'StIdle)]
-> IOSim s NodeClientOutcome
nodeClientAgainstSchedule [(DiffTime
100, NonEmpty LeiosVote
-> Message
     (LeiosNotify LeiosPoint (Header LeiosTestBlock) LeiosVote)
     'StBusy
     'StIdle
forall vote point announcement.
NonEmpty vote
-> Message (LeiosNotify point announcement vote) 'StBusy 'StIdle
MsgLeiosVotes ([LeiosVote] -> NonEmpty LeiosVote
forall a. HasCallStack => [a] -> NonEmpty a
NE.fromList [LeiosTestBlock -> Word16 -> LeiosVote
voteFor LeiosTestBlock
someAnnouncingBlock Word16
0]))])
          )
          Maybe NodeClientOutcome -> Maybe NodeClientOutcome -> Assertion
forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= NodeClientOutcome -> Maybe NodeClientOutcome
forall a. a -> Maybe a
Just (DisconnectReason -> NodeClientOutcome
NodeClientDisconnected DisconnectReason
VoteTooLate)
    , TestName -> Assertion -> TestTree
testCase TestName
"the node's client disconnects a peer whose votes message holds more than the most votes" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$
        (forall s. IOSim s (Maybe NodeClientOutcome))
-> Maybe NodeClientOutcome
forall a. (forall s. IOSim s a) -> a
runSimOrThrow
          ( DiffTime
-> IOSim s NodeClientOutcome -> IOSim s (Maybe NodeClientOutcome)
forall a. DiffTime -> IOSim s a -> IOSim s (Maybe a)
forall (m :: * -> *) a.
MonadTimer m =>
DiffTime -> m a -> m (Maybe a)
timeout DiffTime
100 (IOSim s NodeClientOutcome -> IOSim s (Maybe NodeClientOutcome))
-> IOSim s NodeClientOutcome -> IOSim s (Maybe NodeClientOutcome)
forall a b. (a -> b) -> a -> b
$
              [(DiffTime,
  Message
    (LeiosNotify LeiosPoint (Header LeiosTestBlock) LeiosVote)
    'StBusy
    'StIdle)]
-> IOSim s NodeClientOutcome
forall s.
[(DiffTime,
  Message
    (LeiosNotify LeiosPoint (Header LeiosTestBlock) LeiosVote)
    'StBusy
    'StIdle)]
-> IOSim s NodeClientOutcome
nodeClientAgainstSchedule
                [(DiffTime
5, NonEmpty LeiosVote
-> Message
     (LeiosNotify LeiosPoint (Header LeiosTestBlock) LeiosVote)
     'StBusy
     'StIdle
forall vote point announcement.
NonEmpty vote
-> Message (LeiosNotify point announcement vote) 'StBusy 'StIdle
MsgLeiosVotes ([LeiosVote] -> NonEmpty LeiosVote
forall a. HasCallStack => [a] -> NonEmpty a
NE.fromList [LeiosTestBlock -> Word16 -> LeiosVote
voteFor LeiosTestBlock
someAnnouncingBlock Word16
seat | Word16
seat <- [Word16
0 .. Word16
16]]))]
          )
          Maybe NodeClientOutcome -> Maybe NodeClientOutcome -> Assertion
forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= NodeClientOutcome -> Maybe NodeClientOutcome
forall a. a -> Maybe a
Just (DisconnectReason -> NodeClientOutcome
NodeClientDisconnected DisconnectReason
Undecodable)
    , TestName -> Assertion -> TestTree
testCase TestName
"the node's client accepts a votes message holding the most votes" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$
        (forall s. IOSim s (Maybe NodeClientOutcome))
-> Maybe NodeClientOutcome
forall a. (forall s. IOSim s a) -> a
runSimOrThrow
          ( DiffTime
-> IOSim s NodeClientOutcome -> IOSim s (Maybe NodeClientOutcome)
forall a. DiffTime -> IOSim s a -> IOSim s (Maybe a)
forall (m :: * -> *) a.
MonadTimer m =>
DiffTime -> m a -> m (Maybe a)
timeout DiffTime
100 (IOSim s NodeClientOutcome -> IOSim s (Maybe NodeClientOutcome))
-> IOSim s NodeClientOutcome -> IOSim s (Maybe NodeClientOutcome)
forall a b. (a -> b) -> a -> b
$
              [(DiffTime,
  Message
    (LeiosNotify LeiosPoint (Header LeiosTestBlock) LeiosVote)
    'StBusy
    'StIdle)]
-> IOSim s NodeClientOutcome
forall s.
[(DiffTime,
  Message
    (LeiosNotify LeiosPoint (Header LeiosTestBlock) LeiosVote)
    'StBusy
    'StIdle)]
-> IOSim s NodeClientOutcome
nodeClientAgainstSchedule
                [(DiffTime
5, NonEmpty LeiosVote
-> Message
     (LeiosNotify LeiosPoint (Header LeiosTestBlock) LeiosVote)
     'StBusy
     'StIdle
forall vote point announcement.
NonEmpty vote
-> Message (LeiosNotify point announcement vote) 'StBusy 'StIdle
MsgLeiosVotes ([LeiosVote] -> NonEmpty LeiosVote
forall a. HasCallStack => [a] -> NonEmpty a
NE.fromList [LeiosTestBlock -> Word16 -> LeiosVote
voteFor LeiosTestBlock
someAnnouncingBlock Word16
seat | Word16
seat <- [Word16
0 .. Word16
15]]))]
          )
          Maybe NodeClientOutcome -> Maybe NodeClientOutcome -> Assertion
forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= NodeClientOutcome -> Maybe NodeClientOutcome
forall a. a -> Maybe a
Just (Int -> NodeClientOutcome
NodeClientOutcome (Int
leiosNotifyPipelineDepth Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2))
    , TestName -> Assertion -> TestTree
testCase TestName
"the node's server cancels a peer's outstanding requests when the peer quits" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$
        (forall s. IOSim s (Maybe NodeServerOutcome))
-> Maybe NodeServerOutcome
forall a. (forall s. IOSim s a) -> a
runSimOrThrow (DiffTime
-> IOSim s NodeServerOutcome -> IOSim s (Maybe NodeServerOutcome)
forall a. DiffTime -> IOSim s a -> IOSim s (Maybe a)
forall (m :: * -> *) a.
MonadTimer m =>
DiffTime -> m a -> m (Maybe a)
timeout DiffTime
100 IOSim s NodeServerOutcome
forall s. IOSim s NodeServerOutcome
nodeServerCancels) Maybe NodeServerOutcome -> Maybe NodeServerOutcome -> Assertion
forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= NodeServerOutcome -> Maybe NodeServerOutcome
forall a. a -> Maybe a
Just (Int -> NodeServerOutcome
NodeServerOutcome Int
0)
    , TestName -> Assertion -> TestTree
testCase TestName
"the node's server disconnects a peer that exceeds the pipelining bound" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$
        (forall s. IOSim s (Maybe ExcessiveOutcome))
-> Maybe ExcessiveOutcome
forall a. (forall s. IOSim s a) -> a
runSimOrThrow (DiffTime
-> IOSim s ExcessiveOutcome -> IOSim s (Maybe ExcessiveOutcome)
forall a. DiffTime -> IOSim s a -> IOSim s (Maybe a)
forall (m :: * -> *) a.
MonadTimer m =>
DiffTime -> m a -> m (Maybe a)
timeout DiffTime
100 IOSim s ExcessiveOutcome
forall s. IOSim s ExcessiveOutcome
nodeServerExcessive) Maybe ExcessiveOutcome -> Maybe ExcessiveOutcome -> Assertion
forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= ExcessiveOutcome -> Maybe ExcessiveOutcome
forall a. a -> Maybe a
Just (WhetherDisconnected -> ExcessiveOutcome
ExcessiveOutcome WhetherDisconnected
Disconnected)
    , TestName -> Assertion -> TestTree
testCase TestName
"the node runs LeiosNotify from NodeToNodeV_16 on" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$
        (forall s. IOSim s (Maybe (Bool, Bool))) -> Maybe (Bool, Bool)
forall a. (forall s. IOSim s a) -> a
runSimOrThrow (DiffTime -> IOSim s (Bool, Bool) -> IOSim s (Maybe (Bool, Bool))
forall a. DiffTime -> IOSim s a -> IOSim s (Maybe a)
forall (m :: * -> *) a.
MonadTimer m =>
DiffTime -> m a -> m (Maybe a)
timeout DiffTime
100 (NodeToNodeVersion -> IOSim s (Bool, Bool)
forall s. NodeToNodeVersion -> IOSim s (Bool, Bool)
nodeRunsLeiosNotify NodeToNodeVersion
NodeToNodeV_16)) Maybe (Bool, Bool) -> Maybe (Bool, Bool) -> Assertion
forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= (Bool, Bool) -> Maybe (Bool, Bool)
forall a. a -> Maybe a
Just (Bool
True, Bool
True)
    , TestName -> Assertion -> TestTree
testCase TestName
"the node does not run LeiosNotify before NodeToNodeV_16" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$
        (forall s. IOSim s (Maybe (Bool, Bool))) -> Maybe (Bool, Bool)
forall a. (forall s. IOSim s a) -> a
runSimOrThrow (DiffTime -> IOSim s (Bool, Bool) -> IOSim s (Maybe (Bool, Bool))
forall a. DiffTime -> IOSim s a -> IOSim s (Maybe a)
forall (m :: * -> *) a.
MonadTimer m =>
DiffTime -> m a -> m (Maybe a)
timeout DiffTime
100 (NodeToNodeVersion -> IOSim s (Bool, Bool)
forall s. NodeToNodeVersion -> IOSim s (Bool, Bool)
nodeRunsLeiosNotify NodeToNodeVersion
NodeToNodeV_15)) Maybe (Bool, Bool) -> Maybe (Bool, Bool) -> Assertion
forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= (Bool, Bool) -> Maybe (Bool, Bool)
forall a. a -> Maybe a
Just (Bool
False, Bool
False)
    ]

withNode :: (NodeUnderTest (IOSim s) -> IOSim s a) -> IOSim s a
withNode :: forall s a. (NodeUnderTest (IOSim s) -> IOSim s a) -> IOSim s a
withNode = SlotNo -> (NodeUnderTest (IOSim s) -> IOSim s a) -> IOSim s a
forall s a.
SlotNo -> (NodeUnderTest (IOSim s) -> IOSim s a) -> IOSim s a
withNodeForecasting SlotNo
100000

-- | A node whose ledger view forecasts this many slots past its immutable tip.
withNodeForecasting :: SlotNo -> (NodeUnderTest (IOSim s) -> IOSim s a) -> IOSim s a
withNodeForecasting :: forall s a.
SlotNo -> (NodeUnderTest (IOSim s) -> IOSim s a) -> IOSim s a
withNodeForecasting SlotNo
range NodeUnderTest (IOSim s) -> IOSim s a
body = do
  nodeDBs <- IOSim s (NodeDBs (StrictTMVar (IOSim s) MockFS))
forall (m :: * -> *).
MonadSTM m =>
m (NodeDBs (StrictTMVar m MockFS))
emptyNodeDBs
  withNodeUnderTest cfg nodeDBs body
 where
  k :: SecurityParam
k = NonZero Word64 -> SecurityParam
SecurityParam (NonZero Word64 -> SecurityParam)
-> NonZero Word64 -> SecurityParam
forall a b. (a -> b) -> a -> b
$ forall (n :: Natural) a.
(KnownNat n, 1 <= n, WithinBounds n a, Num a) =>
NonZero a
knownNonZeroBounded @10
  cfg :: NodeUnderTestConfig
cfg =
    SecurityParam -> LeiosTestLedgerConfig -> NodeUnderTestConfig
defaultNodeUnderTestConfig
      SecurityParam
k
      LeiosTestLedgerConfig
        { ltlcHardForkParams :: EraParams
ltlcHardForkParams =
            SecurityParam -> SlotLength -> PerasEnabled () -> EraParams
HardFork.defaultEraParams SecurityParam
k (Integer -> SlotLength
slotLengthFromSec Integer
1) PerasEnabled ()
forall a. PerasEnabled a
HardFork.NoPerasEnabled
        , ltlcForecastRange :: SlotNo
ltlcForecastRange = SlotNo
range
        , ltlcLeios :: LeiosLedgerView
ltlcLeios =
            MkLeiosLedgerView
              { llvCommittee :: LeiosCommittee
llvCommittee = LeiosCommittee
emptyLeiosCommittee
              , llvQuorumStakeThreshold :: UnitInterval
llvQuorumStakeThreshold = UnitInterval
forall a. Bounded a => a
maxBound
              , llvAnnouncementPeriod :: Milliseconds32
llvAnnouncementPeriod = Word32 -> Milliseconds32
Milliseconds32 Word32
1000
              , llvVotePeriod :: Milliseconds32
llvVotePeriod = Word32 -> Milliseconds32
Milliseconds32 Word32
4000
              , llvDiffusionPeriod :: Milliseconds32
llvDiffusionPeriod = Word32 -> Milliseconds32
Milliseconds32 Word32
1000
              , llvMaxEbBodySize :: Word32
llvMaxEbBodySize = Word32
maxEbBodySize
              , llvMaxEbTxsSize :: Word32
llvMaxEbTxsSize = Word32
maxEbBodySize
              }
        }

-- | The node's LeiosNotify client on the connection.
nodeLeiosNotifyClient ::
  NodeVsEnvConnection (IOSim s) ->
  IOSim s (STM (IOSim s) (Either SomeException NodeToNodeInitiatorResult))
nodeLeiosNotifyClient :: forall s.
NodeVsEnvConnection (IOSim s)
-> IOSim
     s (STM (IOSim s) (Either SomeException NodeToNodeInitiatorResult))
nodeLeiosNotifyClient NodeVsEnvConnection (IOSim s)
conn =
  IOSim
  s (STM (IOSim s) (Either SomeException NodeToNodeInitiatorResult))
-> (STM s (Either SomeException NodeToNodeInitiatorResult)
    -> IOSim
         s (STM (IOSim s) (Either SomeException NodeToNodeInitiatorResult)))
-> Maybe (STM s (Either SomeException NodeToNodeInitiatorResult))
-> IOSim
     s (STM (IOSim s) (Either SomeException NodeToNodeInitiatorResult))
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (IOError
-> IOSim
     s (STM (IOSim s) (Either SomeException NodeToNodeInitiatorResult))
forall e a. Exception e => e -> IOSim s a
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwIO (IOError
 -> IOSim
      s (STM (IOSim s) (Either SomeException NodeToNodeInitiatorResult)))
-> IOError
-> IOSim
     s (STM (IOSim s) (Either SomeException NodeToNodeInitiatorResult))
forall a b. (a -> b) -> a -> b
$ TestName -> IOError
userError TestName
"the node does not run a LeiosNotify client") STM s (Either SomeException NodeToNodeInitiatorResult)
-> IOSim
     s (STM (IOSim s) (Either SomeException NodeToNodeInitiatorResult))
STM s (Either SomeException NodeToNodeInitiatorResult)
-> IOSim s (STM s (Either SomeException NodeToNodeInitiatorResult))
forall a. a -> IOSim s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (STM s (Either SomeException NodeToNodeInitiatorResult))
 -> IOSim
      s (STM (IOSim s) (Either SomeException NodeToNodeInitiatorResult)))
-> Maybe (STM s (Either SomeException NodeToNodeInitiatorResult))
-> IOSim
     s (STM (IOSim s) (Either SomeException NodeToNodeInitiatorResult))
forall a b. (a -> b) -> a -> b
$
    MiniProtocolNum
-> Map
     MiniProtocolNum
     (STM s (Either SomeException NodeToNodeInitiatorResult))
-> Maybe (STM s (Either SomeException NodeToNodeInitiatorResult))
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup MiniProtocolNum
leiosNotifyMiniProtocolNum (NodeVsEnvConnection (IOSim s)
-> Map
     MiniProtocolNum
     (STM (IOSim s) (Either SomeException NodeToNodeInitiatorResult))
forall (m :: * -> *).
NodeVsEnvConnection m
-> Map
     MiniProtocolNum
     (STM m (Either SomeException NodeToNodeInitiatorResult))
connNodeInitiators NodeVsEnvConnection (IOSim s)
conn)

-- | The node's LeiosNotify server on the connection.
nodeLeiosNotifyServer ::
  NodeVsEnvConnection (IOSim s) -> IOSim s (STM (IOSim s) (Either SomeException ()))
nodeLeiosNotifyServer :: forall s.
NodeVsEnvConnection (IOSim s)
-> IOSim s (STM (IOSim s) (Either SomeException ()))
nodeLeiosNotifyServer NodeVsEnvConnection (IOSim s)
conn =
  IOSim s (STM (IOSim s) (Either SomeException ()))
-> (STM s (Either SomeException ())
    -> IOSim s (STM (IOSim s) (Either SomeException ())))
-> Maybe (STM s (Either SomeException ()))
-> IOSim s (STM (IOSim s) (Either SomeException ()))
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (IOError -> IOSim s (STM (IOSim s) (Either SomeException ()))
forall e a. Exception e => e -> IOSim s a
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwIO (IOError -> IOSim s (STM (IOSim s) (Either SomeException ())))
-> IOError -> IOSim s (STM (IOSim s) (Either SomeException ()))
forall a b. (a -> b) -> a -> b
$ TestName -> IOError
userError TestName
"the node does not run a LeiosNotify server") STM s (Either SomeException ())
-> IOSim s (STM (IOSim s) (Either SomeException ()))
STM s (Either SomeException ())
-> IOSim s (STM s (Either SomeException ()))
forall a. a -> IOSim s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (STM s (Either SomeException ()))
 -> IOSim s (STM (IOSim s) (Either SomeException ())))
-> Maybe (STM s (Either SomeException ()))
-> IOSim s (STM (IOSim s) (Either SomeException ()))
forall a b. (a -> b) -> a -> b
$
    MiniProtocolNum
-> Map MiniProtocolNum (STM s (Either SomeException ()))
-> Maybe (STM s (Either SomeException ()))
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup MiniProtocolNum
leiosNotifyMiniProtocolNum (NodeVsEnvConnection (IOSim s)
-> Map MiniProtocolNum (STM (IOSim s) (Either SomeException ()))
forall (m :: * -> *).
NodeVsEnvConnection m
-> Map MiniProtocolNum (STM m (Either SomeException ()))
connNodeResponders NodeVsEnvConnection (IOSim s)
conn)

data NodeClientOutcome
  = -- | how many requests the peer received
    NodeClientOutcome Int
  | NodeClientDisconnected DisconnectReason
  deriving (NodeClientOutcome -> NodeClientOutcome -> Bool
(NodeClientOutcome -> NodeClientOutcome -> Bool)
-> (NodeClientOutcome -> NodeClientOutcome -> Bool)
-> Eq NodeClientOutcome
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: NodeClientOutcome -> NodeClientOutcome -> Bool
== :: NodeClientOutcome -> NodeClientOutcome -> Bool
$c/= :: NodeClientOutcome -> NodeClientOutcome -> Bool
/= :: NodeClientOutcome -> NodeClientOutcome -> Bool
Eq, Int -> NodeClientOutcome -> ShowS
[NodeClientOutcome] -> ShowS
NodeClientOutcome -> TestName
(Int -> NodeClientOutcome -> ShowS)
-> (NodeClientOutcome -> TestName)
-> ([NodeClientOutcome] -> ShowS)
-> Show NodeClientOutcome
forall a.
(Int -> a -> ShowS) -> (a -> TestName) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> NodeClientOutcome -> ShowS
showsPrec :: Int -> NodeClientOutcome -> ShowS
$cshow :: NodeClientOutcome -> TestName
show :: NodeClientOutcome -> TestName
$cshowList :: [NodeClientOutcome] -> ShowS
showList :: [NodeClientOutcome] -> ShowS
Show)

data DisconnectReason
  = UnexpectedCancel
  | ExceededSize
  | ExceededTime
  | Undecodable
  | AnnouncementMissing
  | AnnouncementRepeated
  | AnnouncementThird
  | AnnouncementInvalid
  | AnnouncementTooOld
  | AnnouncementInFuture
  | OfferWithoutAnnouncement
  | OfferBadSize
  | OfferRepeated
  | ClosureOfferWithoutAnnouncement
  | ClosureOfferRepeated
  | OfferTooOld
  | VoteWithoutAnnouncement
  | VoteRepeated
  | VoteTooEarly
  | VoteTooLate
  | VoteOutsideHorizon
  | OfferOutsideHorizon
  deriving (DisconnectReason -> DisconnectReason -> Bool
(DisconnectReason -> DisconnectReason -> Bool)
-> (DisconnectReason -> DisconnectReason -> Bool)
-> Eq DisconnectReason
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: DisconnectReason -> DisconnectReason -> Bool
== :: DisconnectReason -> DisconnectReason -> Bool
$c/= :: DisconnectReason -> DisconnectReason -> Bool
/= :: DisconnectReason -> DisconnectReason -> Bool
Eq, Int -> DisconnectReason -> ShowS
[DisconnectReason] -> ShowS
DisconnectReason -> TestName
(Int -> DisconnectReason -> ShowS)
-> (DisconnectReason -> TestName)
-> ([DisconnectReason] -> ShowS)
-> Show DisconnectReason
forall a.
(Int -> a -> ShowS) -> (a -> TestName) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> DisconnectReason -> ShowS
showsPrec :: Int -> DisconnectReason -> ShowS
$cshow :: DisconnectReason -> TestName
show :: DisconnectReason -> TestName
$cshowList :: [DisconnectReason] -> ShowS
showList :: [DisconnectReason] -> ShowS
Show)

-- | Why the node's client disconnected its peer, if it did so on purpose.
disconnectReason :: SomeException -> Maybe DisconnectReason
disconnectReason :: SomeException -> Maybe DisconnectReason
disconnectReason SomeException
e
  | Just ExnLeiosNotifyUnexpectedCancel
ExnLeiosNotifyUnexpectedCancel <- SomeException -> Maybe ExnLeiosNotifyUnexpectedCancel
forall e. Exception e => SomeException -> Maybe e
fromException SomeException
e = DisconnectReason -> Maybe DisconnectReason
forall a. a -> Maybe a
Just DisconnectReason
UnexpectedCancel
  | Just (DecoderFailure
_ :: DecoderFailure) <- SomeException -> Maybe DecoderFailure
forall e. Exception e => SomeException -> Maybe e
fromException SomeException
e = DisconnectReason -> Maybe DisconnectReason
forall a. a -> Maybe a
Just DisconnectReason
Undecodable
  | Just (ProtocolLimitFailure
lf :: ProtocolLimitFailure) <- SomeException -> Maybe ProtocolLimitFailure
forall e. Exception e => SomeException -> Maybe e
fromException SomeException
e = DisconnectReason -> Maybe DisconnectReason
forall a. a -> Maybe a
Just (DisconnectReason -> Maybe DisconnectReason)
-> DisconnectReason -> Maybe DisconnectReason
forall a b. (a -> b) -> a -> b
$ case ProtocolLimitFailure
lf of
      ExceededSizeLimit{} -> DisconnectReason
ExceededSize
      ExceededTimeLimit{} -> DisconnectReason
ExceededTime
  | Just (ExnLeiosNotifyInvalidAnnouncement LeiosTestBlock
exn :: ExnLeiosNotifyInvalidAnnouncement Blk) <- SomeException
-> Maybe (ExnLeiosNotifyInvalidAnnouncement LeiosTestBlock)
forall e. Exception e => SomeException -> Maybe e
fromException SomeException
e = DisconnectReason -> Maybe DisconnectReason
forall a. a -> Maybe a
Just (DisconnectReason -> Maybe DisconnectReason)
-> DisconnectReason -> Maybe DisconnectReason
forall a b. (a -> b) -> a -> b
$ case ExnLeiosNotifyInvalidAnnouncement LeiosTestBlock
exn of
      ExnLeiosNotifyInvalidAnnouncement LeiosTestBlock
ExnLeiosNotifyAnnouncementMissing -> DisconnectReason
AnnouncementMissing
      ExnLeiosNotifyInvalidAnnouncement Error (AnnouncementInvalidity LeiosTestBlock)
err -> case Error (AnnouncementInvalidity LeiosTestBlock)
err of
        Error (AnnouncementInvalidity LeiosTestBlock)
Announcements.ErrRepeat -> DisconnectReason
AnnouncementRepeated
        Error (AnnouncementInvalidity LeiosTestBlock)
Announcements.ErrThird -> DisconnectReason
AnnouncementThird
        Announcements.ErrInvalid{} -> DisconnectReason
AnnouncementInvalid
        Error (AnnouncementInvalidity LeiosTestBlock)
Announcements.ErrTooOld -> DisconnectReason
AnnouncementTooOld
  | Just (HeaderArrivalException
_ :: InFutureCheck.HeaderArrivalException) <- SomeException -> Maybe HeaderArrivalException
forall e. Exception e => SomeException -> Maybe e
fromException SomeException
e = DisconnectReason -> Maybe DisconnectReason
forall a. a -> Maybe a
Just DisconnectReason
AnnouncementInFuture
  | Just (ExnLeiosNotifyInvalidOffer
exn :: ExnLeiosNotifyInvalidOffer) <- SomeException -> Maybe ExnLeiosNotifyInvalidOffer
forall e. Exception e => SomeException -> Maybe e
fromException SomeException
e = DisconnectReason -> Maybe DisconnectReason
forall a. a -> Maybe a
Just (DisconnectReason -> Maybe DisconnectReason)
-> DisconnectReason -> Maybe DisconnectReason
forall a b. (a -> b) -> a -> b
$ case ExnLeiosNotifyInvalidOffer
exn of
      ExnLeiosBlockOfferWithoutAnnouncement{} -> DisconnectReason
OfferWithoutAnnouncement
      ExnLeiosBlockOfferBadSize{} -> DisconnectReason
OfferBadSize
      ExnLeiosRepeatedBlockOffer{} -> DisconnectReason
OfferRepeated
      ExnLeiosClosureOfferWithoutAnnouncement{} -> DisconnectReason
ClosureOfferWithoutAnnouncement
      ExnLeiosRepeatedClosureOffer{} -> DisconnectReason
ClosureOfferRepeated
      ExnLeiosOfferTooOld{} -> DisconnectReason
OfferTooOld
      ExnLeiosBlockOfferOutsideHorizon{} -> DisconnectReason
OfferOutsideHorizon
  | Just (ExnLeiosNotifyInvalidVotes
exn :: ExnLeiosNotifyInvalidVotes) <- SomeException -> Maybe ExnLeiosNotifyInvalidVotes
forall e. Exception e => SomeException -> Maybe e
fromException SomeException
e = DisconnectReason -> Maybe DisconnectReason
forall a. a -> Maybe a
Just (DisconnectReason -> Maybe DisconnectReason)
-> DisconnectReason -> Maybe DisconnectReason
forall a b. (a -> b) -> a -> b
$ case ExnLeiosNotifyInvalidVotes
exn of
      ExnLeiosVoteWithoutAnnouncement{} -> DisconnectReason
VoteWithoutAnnouncement
      ExnLeiosRepeatedVote{} -> DisconnectReason
VoteRepeated
      ExnLeiosVoteTooEarly{} -> DisconnectReason
VoteTooEarly
      ExnLeiosVoteTooLate{} -> DisconnectReason
VoteTooLate
      ExnLeiosVoteOutsideHorizon{} -> DisconnectReason
VoteOutsideHorizon
  | Bool
otherwise = Maybe DisconnectReason
forall a. Maybe a
Nothing

-- | Run a peer's server that answers each request with whatever @next@ yields
-- next, counting requests.
runReplyingServer ::
  LeiosNotifyCodec s ->
  StrictTVar (IOSim s) Int ->
  STM (IOSim s) (Message (LeiosNotify LeiosPoint (Header Blk) LeiosVote) StBusy StIdle) ->
  Channel (IOSim s) BSL.ByteString ->
  IOSim s ()
runReplyingServer :: forall s.
LeiosNotifyCodec s
-> StrictTVar (IOSim s) Int
-> STM
     (IOSim s)
     (Message
        (LeiosNotify LeiosPoint (Header LeiosTestBlock) LeiosVote)
        'StBusy
        'StIdle)
-> Channel (IOSim s) ByteString
-> IOSim s ()
runReplyingServer LeiosNotifyCodec s
c StrictTVar (IOSim s) Int
requests STM
  (IOSim s)
  (Message
     (LeiosNotify LeiosPoint (Header LeiosTestBlock) LeiosVote)
     'StBusy
     'StIdle)
next Channel (IOSim s) ByteString
chan = do
  peer <-
    IOSim s WhetherExcessiveRequests
-> STM
     (IOSim s)
     (Message
        (LeiosNotify LeiosPoint (Header LeiosTestBlock) LeiosVote)
        'StBusy
        'StIdle)
-> IOSim
     s
     (LeiosNotifyServerPeerLookahead
        LeiosPoint (Header LeiosTestBlock) LeiosVote (IOSim s))
forall (m :: * -> *) point announcement vote.
(MonadThrow m, MonadSTM m) =>
m WhetherExcessiveRequests
-> STM
     m (Message (LeiosNotify point announcement vote) 'StBusy 'StIdle)
-> m (LeiosNotifyServerPeerLookahead point announcement vote m)
leiosNotifyServerPeerLookahead
      (WhetherExcessiveRequests
NotExcessiveRequests WhetherExcessiveRequests
-> IOSim s () -> IOSim s WhetherExcessiveRequests
forall a b. a -> IOSim s b -> IOSim s a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ STM (IOSim s) () -> IOSim s ()
forall a. HasCallStack => STM (IOSim s) a -> IOSim s a
forall (m :: * -> *) a.
(MonadSTM m, HasCallStack) =>
STM m a -> m a
atomically (StrictTVar (IOSim s) Int -> (Int -> Int) -> STM (IOSim s) ()
forall (m :: * -> *) a.
MonadSTM m =>
StrictTVar m a -> (a -> a) -> STM m ()
modifyTVar StrictTVar (IOSim s) Int
requests (Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)))
      STM
  (IOSim s)
  (Message
     (LeiosNotify LeiosPoint (Header LeiosTestBlock) LeiosVote)
     'StBusy
     'StIdle)
next
  fst
    <$> runLookaheadFixedSenderPeerWithLimits nullTracer c sizeLimits timeLimitsLeiosNotify chan peer

-- | The node's client, connected to a peer whose server answers with @next@;
-- the node demotes the peer once the peer has received @target@ requests.
runNodeClientAgainst ::
  NodeUnderTest (IOSim s) ->
  STM (IOSim s) (Message (LeiosNotify LeiosPoint (Header Blk) LeiosVote) StBusy StIdle) ->
  Int ->
  IOSim s NodeClientOutcome
runNodeClientAgainst :: forall s.
NodeUnderTest (IOSim s)
-> STM
     (IOSim s)
     (Message
        (LeiosNotify LeiosPoint (Header LeiosTestBlock) LeiosVote)
        'StBusy
        'StIdle)
-> Int
-> IOSim s NodeClientOutcome
runNodeClientAgainst NodeUnderTest (IOSim s)
nut STM
  (IOSim s)
  (Message
     (LeiosNotify LeiosPoint (Header LeiosTestBlock) LeiosVote)
     'StBusy
     'StIdle)
next Int
target = do
  requests <- Int -> IOSim s (StrictTVar (IOSim s) Int)
forall (m :: * -> *) a. MonadSTM m => a -> m (StrictTVar m a)
newTVarIO Int
0
  let envPeer =
        EnvPeer
          { epLeiosNotifyServer :: Channel (IOSim s) ByteString -> IOSim s ()
epLeiosNotifyServer = LeiosNotifyCodec s
-> StrictTVar (IOSim s) Int
-> STM
     (IOSim s)
     (Message
        (LeiosNotify LeiosPoint (Header LeiosTestBlock) LeiosVote)
        'StBusy
        'StIdle)
-> Channel (IOSim s) ByteString
-> IOSim s ()
forall s.
LeiosNotifyCodec s
-> StrictTVar (IOSim s) Int
-> STM
     (IOSim s)
     (Message
        (LeiosNotify LeiosPoint (Header LeiosTestBlock) LeiosVote)
        'StBusy
        'StIdle)
-> Channel (IOSim s) ByteString
-> IOSim s ()
runReplyingServer (NodeUnderTest (IOSim s) -> LeiosNotifyCodec s
forall s. NodeUnderTest (IOSim s) -> LeiosNotifyCodec s
envLeiosNotifyCodec NodeUnderTest (IOSim s)
nut) StrictTVar (IOSim s) Int
requests STM
  (IOSim s)
  (Message
     (LeiosNotify LeiosPoint (Header LeiosTestBlock) LeiosVote)
     'StBusy
     'StIdle)
next
          , epLeiosNotifyClient :: Maybe (Channel (IOSim s) ByteString -> IOSim s ())
epLeiosNotifyClient = Maybe (Channel (IOSim s) ByteString -> IOSim s ())
forall a. Maybe a
Nothing
          }
  withNodeVsEnvConnection nut (PeerAddr 1) envPeer $ \NodeVsEnvConnection (IOSim s)
conn -> do
    client <- NodeVsEnvConnection (IOSim s)
-> IOSim
     s (STM (IOSim s) (Either SomeException NodeToNodeInitiatorResult))
forall s.
NodeVsEnvConnection (IOSim s)
-> IOSim
     s (STM (IOSim s) (Either SomeException NodeToNodeInitiatorResult))
nodeLeiosNotifyClient NodeVsEnvConnection (IOSim s)
conn
    early <-
      atomically $
        (Just <$> client)
          `orElse` (Nothing <$ (readTVar requests >>= check . (>= target)))
    result <- case early of
      Just Either SomeException NodeToNodeInitiatorResult
result -> Either SomeException NodeToNodeInitiatorResult
-> IOSim s (Either SomeException NodeToNodeInitiatorResult)
forall a. a -> IOSim s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Either SomeException NodeToNodeInitiatorResult
result
      Maybe (Either SomeException NodeToNodeInitiatorResult)
Nothing -> do
        -- told to stop, the client drains its pipeline and ends
        NodeVsEnvConnection (IOSim s) -> IOSim s ()
forall (m :: * -> *). NodeVsEnvConnection m -> m ()
connTerminate NodeVsEnvConnection (IOSim s)
conn
        STM (IOSim s) (Either SomeException NodeToNodeInitiatorResult)
-> IOSim s (Either SomeException NodeToNodeInitiatorResult)
forall a. HasCallStack => STM (IOSim s) a -> IOSim s a
forall (m :: * -> *) a.
(MonadSTM m, HasCallStack) =>
STM m a -> m a
atomically STM (IOSim s) (Either SomeException NodeToNodeInitiatorResult)
STM s (Either SomeException NodeToNodeInitiatorResult)
client
    case result of
      Right NodeToNodeInitiatorResult
_ -> Int -> NodeClientOutcome
NodeClientOutcome (Int -> NodeClientOutcome)
-> IOSim s Int -> IOSim s NodeClientOutcome
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StrictTVar (IOSim s) Int -> IOSim s Int
forall (m :: * -> *) a. MonadSTM m => StrictTVar m a -> m a
readTVarIO StrictTVar (IOSim s) Int
requests
      Left SomeException
e -> IOSim s NodeClientOutcome
-> (DisconnectReason -> IOSim s NodeClientOutcome)
-> Maybe DisconnectReason
-> IOSim s NodeClientOutcome
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (SomeException -> IOSim s NodeClientOutcome
forall e a. Exception e => e -> IOSim s a
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwIO SomeException
e) (NodeClientOutcome -> IOSim s NodeClientOutcome
forall a. a -> IOSim s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (NodeClientOutcome -> IOSim s NodeClientOutcome)
-> (DisconnectReason -> NodeClientOutcome)
-> DisconnectReason
-> IOSim s NodeClientOutcome
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DisconnectReason -> NodeClientOutcome
NodeClientDisconnected) (SomeException -> Maybe DisconnectReason
disconnectReason SomeException
e)

-- | A peer that never has a notification: the node keeps exactly its
-- pipelining bound of requests outstanding.
nodeClientKeepsPipelineFull :: IOSim s NodeClientOutcome
nodeClientKeepsPipelineFull :: forall s. IOSim s NodeClientOutcome
nodeClientKeepsPipelineFull = (NodeUnderTest (IOSim s) -> IOSim s NodeClientOutcome)
-> IOSim s NodeClientOutcome
forall s a. (NodeUnderTest (IOSim s) -> IOSim s a) -> IOSim s a
withNode ((NodeUnderTest (IOSim s) -> IOSim s NodeClientOutcome)
 -> IOSim s NodeClientOutcome)
-> (NodeUnderTest (IOSim s) -> IOSim s NodeClientOutcome)
-> IOSim s NodeClientOutcome
forall a b. (a -> b) -> a -> b
$ \NodeUnderTest (IOSim s)
nut ->
  NodeUnderTest (IOSim s)
-> STM
     (IOSim s)
     (Message
        (LeiosNotify LeiosPoint (Header LeiosTestBlock) LeiosVote)
        'StBusy
        'StIdle)
-> Int
-> IOSim s NodeClientOutcome
forall s.
NodeUnderTest (IOSim s)
-> STM
     (IOSim s)
     (Message
        (LeiosNotify LeiosPoint (Header LeiosTestBlock) LeiosVote)
        'StBusy
        'StIdle)
-> Int
-> IOSim s NodeClientOutcome
runNodeClientAgainst NodeUnderTest (IOSim s)
nut STM
  (IOSim s)
  (Message
     (LeiosNotify LeiosPoint (Header LeiosTestBlock) LeiosVote)
     'StBusy
     'StIdle)
forall a. STM (IOSim s) a
forall (m :: * -> *) a. MonadSTM m => STM m a
retry Int
leiosNotifyPipelineDepth

-- | Six replies, announcements from six elections, free six slots in the
-- pipeline, which the node fills again.
nodeClientRefillsPipeline :: IOSim s NodeClientOutcome
nodeClientRefillsPipeline :: forall s. IOSim s NodeClientOutcome
nodeClientRefillsPipeline = (NodeUnderTest (IOSim s) -> IOSim s NodeClientOutcome)
-> IOSim s NodeClientOutcome
forall s a. (NodeUnderTest (IOSim s) -> IOSim s a) -> IOSim s a
withNode ((NodeUnderTest (IOSim s) -> IOSim s NodeClientOutcome)
 -> IOSim s NodeClientOutcome)
-> (NodeUnderTest (IOSim s) -> IOSim s NodeClientOutcome)
-> IOSim s NodeClientOutcome
forall a b. (a -> b) -> a -> b
$ \NodeUnderTest (IOSim s)
nut -> do
  queue <- IOSim
  s
  (StrictTQueue
     (IOSim s)
     (Message
        (LeiosNotify LeiosPoint (Header LeiosTestBlock) LeiosVote)
        'StBusy
        'StIdle))
forall (m :: * -> *) a. MonadSTM m => m (StrictTQueue m a)
newTQueueIO
  atomically $
    mapM_ (writeTQueue queue) $
      [ MsgLeiosBlockAnnouncement $ ltbHeader $ setIssuer issuer $ ann 1 $ firstLeiosBlock 0
      | issuer <- [0 .. 5]
      ]
  runNodeClientAgainst nut (readTQueue queue) (leiosNotifyPipelineDepth + 6)

nodeClientUnpromptedCancel :: IOSim s NodeClientOutcome
nodeClientUnpromptedCancel :: forall s. IOSim s NodeClientOutcome
nodeClientUnpromptedCancel = (NodeUnderTest (IOSim s) -> IOSim s NodeClientOutcome)
-> IOSim s NodeClientOutcome
forall s a. (NodeUnderTest (IOSim s) -> IOSim s a) -> IOSim s a
withNode ((NodeUnderTest (IOSim s) -> IOSim s NodeClientOutcome)
 -> IOSim s NodeClientOutcome)
-> (NodeUnderTest (IOSim s) -> IOSim s NodeClientOutcome)
-> IOSim s NodeClientOutcome
forall a b. (a -> b) -> a -> b
$ \NodeUnderTest (IOSim s)
nut ->
  NodeUnderTest (IOSim s)
-> STM
     (IOSim s)
     (Message
        (LeiosNotify LeiosPoint (Header LeiosTestBlock) LeiosVote)
        'StBusy
        'StIdle)
-> Int
-> IOSim s NodeClientOutcome
forall s.
NodeUnderTest (IOSim s)
-> STM
     (IOSim s)
     (Message
        (LeiosNotify LeiosPoint (Header LeiosTestBlock) LeiosVote)
        'StBusy
        'StIdle)
-> Int
-> IOSim s NodeClientOutcome
runNodeClientAgainst NodeUnderTest (IOSim s)
nut (Message
  (LeiosNotify LeiosPoint (Header LeiosTestBlock) LeiosVote)
  'StBusy
  'StIdle
-> STM
     s
     (Message
        (LeiosNotify LeiosPoint (Header LeiosTestBlock) LeiosVote)
        'StBusy
        'StIdle)
forall a. a -> STM s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Message
  (LeiosNotify LeiosPoint (Header LeiosTestBlock) LeiosVote)
  'StBusy
  'StIdle
forall point announcement vote.
Message (LeiosNotify point announcement vote) 'StBusy 'StIdle
MsgCanceled) Int
forall a. Bounded a => a
maxBound

-- | Announce an endorser block whose hash repeats the given byte 32 times.
ann :: Word8 -> LeiosTestBlock -> LeiosTestBlock
ann :: Word8 -> LeiosTestBlock -> LeiosTestBlock
ann Word8
n = EbHash -> Word32 -> LeiosTestBlock -> LeiosTestBlock
setAnnouncement (ByteString -> EbHash
MkEbHash (Int -> Word8 -> ByteString
BS.replicate Int
32 Word8
n)) Word32
1000

-- | A peer that relays these headers, one per request.
nodeClientAgainstAnnouncements :: [LeiosTestBlock] -> IOSim s NodeClientOutcome
nodeClientAgainstAnnouncements :: forall s. [LeiosTestBlock] -> IOSim s NodeClientOutcome
nodeClientAgainstAnnouncements [LeiosTestBlock]
blks = (NodeUnderTest (IOSim s) -> IOSim s NodeClientOutcome)
-> IOSim s NodeClientOutcome
forall s a. (NodeUnderTest (IOSim s) -> IOSim s a) -> IOSim s a
withNode ((NodeUnderTest (IOSim s) -> IOSim s NodeClientOutcome)
 -> IOSim s NodeClientOutcome)
-> (NodeUnderTest (IOSim s) -> IOSim s NodeClientOutcome)
-> IOSim s NodeClientOutcome
forall a b. (a -> b) -> a -> b
$ \NodeUnderTest (IOSim s)
nut -> do
  queue <- IOSim
  s
  (StrictTQueue
     (IOSim s)
     (Message
        (LeiosNotify LeiosPoint (Header LeiosTestBlock) LeiosVote)
        'StBusy
        'StIdle))
forall (m :: * -> *) a. MonadSTM m => m (StrictTQueue m a)
newTQueueIO
  atomically $ mapM_ (writeTQueue queue . MsgLeiosBlockAnnouncement . ltbHeader) blks
  runNodeClientAgainst nut (readTQueue queue) (leiosNotifyPipelineDepth + length blks)

-- | The announcement arrives long after its slot: the peer connects only then.
nodeClientTooOld :: IOSim s NodeClientOutcome
nodeClientTooOld :: forall s. IOSim s NodeClientOutcome
nodeClientTooOld = (NodeUnderTest (IOSim s) -> IOSim s NodeClientOutcome)
-> IOSim s NodeClientOutcome
forall s a. (NodeUnderTest (IOSim s) -> IOSim s a) -> IOSim s a
withNode ((NodeUnderTest (IOSim s) -> IOSim s NodeClientOutcome)
 -> IOSim s NodeClientOutcome)
-> (NodeUnderTest (IOSim s) -> IOSim s NodeClientOutcome)
-> IOSim s NodeClientOutcome
forall a b. (a -> b) -> a -> b
$ \NodeUnderTest (IOSim s)
nut -> do
  DiffTime -> IOSim s ()
forall (m :: * -> *). MonadDelay m => DiffTime -> m ()
threadDelay (NominalDiffTime -> DiffTime
forall a b. (Real a, Fractional b) => a -> b
realToFrac NominalDiffTime
maxAnnouncementAgeRecv DiffTime -> DiffTime -> DiffTime
forall a. Num a => a -> a -> a
+ DiffTime
100)
  queue <- IOSim
  s
  (StrictTQueue
     (IOSim s)
     (Message
        (LeiosNotify LeiosPoint (Header LeiosTestBlock) LeiosVote)
        'StBusy
        'StIdle))
forall (m :: * -> *) a. MonadSTM m => m (StrictTQueue m a)
newTQueueIO
  atomically $ writeTQueue queue $ MsgLeiosBlockAnnouncement $ ltbHeader $ ann 1 (firstLeiosBlock 0)
  runNodeClientAgainst nut (readTQueue queue) (leiosNotifyPipelineDepth + 1)

-- | By the time the node connects, the current slot is past what its
-- immutable tip, still at genesis, can forecast to.
nodeClientGated :: IOSim s Int
nodeClientGated :: forall s. IOSim s Int
nodeClientGated = SlotNo -> (NodeUnderTest (IOSim s) -> IOSim s Int) -> IOSim s Int
forall s a.
SlotNo -> (NodeUnderTest (IOSim s) -> IOSim s a) -> IOSim s a
withNodeForecasting SlotNo
5 ((NodeUnderTest (IOSim s) -> IOSim s Int) -> IOSim s Int)
-> (NodeUnderTest (IOSim s) -> IOSim s Int) -> IOSim s Int
forall a b. (a -> b) -> a -> b
$ \NodeUnderTest (IOSim s)
nut -> do
  DiffTime -> IOSim s ()
forall (m :: * -> *). MonadDelay m => DiffTime -> m ()
threadDelay DiffTime
10
  requests <- Int -> IOSim s (StrictTVar (IOSim s) Int)
forall (m :: * -> *) a. MonadSTM m => a -> m (StrictTVar m a)
newTVarIO Int
0
  let envPeer =
        EnvPeer
          { epLeiosNotifyServer :: Channel (IOSim s) ByteString -> IOSim s ()
epLeiosNotifyServer = LeiosNotifyCodec s
-> StrictTVar (IOSim s) Int
-> STM
     (IOSim s)
     (Message
        (LeiosNotify LeiosPoint (Header LeiosTestBlock) LeiosVote)
        'StBusy
        'StIdle)
-> Channel (IOSim s) ByteString
-> IOSim s ()
forall s.
LeiosNotifyCodec s
-> StrictTVar (IOSim s) Int
-> STM
     (IOSim s)
     (Message
        (LeiosNotify LeiosPoint (Header LeiosTestBlock) LeiosVote)
        'StBusy
        'StIdle)
-> Channel (IOSim s) ByteString
-> IOSim s ()
runReplyingServer (NodeUnderTest (IOSim s) -> LeiosNotifyCodec s
forall s. NodeUnderTest (IOSim s) -> LeiosNotifyCodec s
envLeiosNotifyCodec NodeUnderTest (IOSim s)
nut) StrictTVar (IOSim s) Int
requests STM
  (IOSim s)
  (Message
     (LeiosNotify LeiosPoint (Header LeiosTestBlock) LeiosVote)
     'StBusy
     'StIdle)
forall a. STM (IOSim s) a
forall (m :: * -> *) a. MonadSTM m => STM m a
retry
          , epLeiosNotifyClient :: Maybe (Channel (IOSim s) ByteString -> IOSim s ())
epLeiosNotifyClient = Maybe (Channel (IOSim s) ByteString -> IOSim s ())
forall a. Maybe a
Nothing
          }
  withNodeVsEnvConnection nut (PeerAddr 1) envPeer $ \NodeVsEnvConnection (IOSim s)
conn -> do
    DiffTime -> IOSim s ()
forall (m :: * -> *). MonadDelay m => DiffTime -> m ()
threadDelay DiffTime
10
    n <- StrictTVar (IOSim s) Int -> IOSim s Int
forall (m :: * -> *) a. MonadSTM m => StrictTVar m a -> m a
readTVarIO StrictTVar (IOSim s) Int
requests
    connTerminate conn
    client <- nodeLeiosNotifyClient conn
    atomically client >>= either throwIO (\NodeToNodeInitiatorResult
_ -> Int -> IOSim s Int
forall a. a -> IOSim s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Int
n)

-- | How many elections, body offers, closure offers and votes the client's state
-- holds once one of each is in, and once the immutable tip has passed them.
nodePrunesClientState :: IOSim s ((Int, Int, Int, Int), (Int, Int, Int, Int))
nodePrunesClientState :: forall s. IOSim s ((Int, Int, Int, Int), (Int, Int, Int, Int))
nodePrunesClientState = (NodeUnderTest (IOSim s)
 -> IOSim s ((Int, Int, Int, Int), (Int, Int, Int, Int)))
-> IOSim s ((Int, Int, Int, Int), (Int, Int, Int, Int))
forall s a. (NodeUnderTest (IOSim s) -> IOSim s a) -> IOSim s a
withNode ((NodeUnderTest (IOSim s)
  -> IOSim s ((Int, Int, Int, Int), (Int, Int, Int, Int)))
 -> IOSim s ((Int, Int, Int, Int), (Int, Int, Int, Int)))
-> (NodeUnderTest (IOSim s)
    -> IOSim s ((Int, Int, Int, Int), (Int, Int, Int, Int)))
-> IOSim s ((Int, Int, Int, Int), (Int, Int, Int, Int))
forall a b. (a -> b) -> a -> b
$ \NodeUnderTest (IOSim s)
nut -> do
  requests <- Int -> IOSim s (StrictTVar (IOSim s) Int)
forall (m :: * -> *) a. MonadSTM m => a -> m (StrictTVar m a)
newTVarIO Int
0
  queue <- newTQueueIO
  let envPeer =
        EnvPeer
          { epLeiosNotifyServer :: Channel (IOSim s) ByteString -> IOSim s ()
epLeiosNotifyServer = LeiosNotifyCodec s
-> StrictTVar (IOSim s) Int
-> STM
     (IOSim s)
     (Message
        (LeiosNotify LeiosPoint (Header LeiosTestBlock) LeiosVote)
        'StBusy
        'StIdle)
-> Channel (IOSim s) ByteString
-> IOSim s ()
forall s.
LeiosNotifyCodec s
-> StrictTVar (IOSim s) Int
-> STM
     (IOSim s)
     (Message
        (LeiosNotify LeiosPoint (Header LeiosTestBlock) LeiosVote)
        'StBusy
        'StIdle)
-> Channel (IOSim s) ByteString
-> IOSim s ()
runReplyingServer (NodeUnderTest (IOSim s) -> LeiosNotifyCodec s
forall s. NodeUnderTest (IOSim s) -> LeiosNotifyCodec s
envLeiosNotifyCodec NodeUnderTest (IOSim s)
nut) StrictTVar (IOSim s) Int
requests (StrictTQueue
  (IOSim s)
  (Message
     (LeiosNotify LeiosPoint (Header LeiosTestBlock) LeiosVote)
     'StBusy
     'StIdle)
-> STM
     (IOSim s)
     (Message
        (LeiosNotify LeiosPoint (Header LeiosTestBlock) LeiosVote)
        'StBusy
        'StIdle)
forall (m :: * -> *) a. MonadSTM m => StrictTQueue m a -> STM m a
readTQueue StrictTQueue
  (IOSim s)
  (Message
     (LeiosNotify LeiosPoint (Header LeiosTestBlock) LeiosVote)
     'StBusy
     'StIdle)
queue)
          , epLeiosNotifyClient :: Maybe (Channel (IOSim s) ByteString -> IOSim s ())
epLeiosNotifyClient = Maybe (Channel (IOSim s) ByteString -> IOSim s ())
forall a. Maybe a
Nothing
          }
  withAsync
    ( feedAt
        queue
        [ (0, someAnnouncement)
        , (0, MsgLeiosBlockOffer someOfferedPoint 1000)
        , (0, MsgLeiosBlockTxsOffer someOfferedPoint)
        , -- within the vote's window
          (5, MsgLeiosVotes (NE.fromList [voteFor someAnnouncingBlock 0]))
        ]
    )
    $ \Async (IOSim s) ()
_feeder ->
      NodeUnderTest (IOSim s)
-> PeerAddr
-> EnvPeer (IOSim s)
-> (NodeVsEnvConnection (IOSim s)
    -> IOSim s ((Int, Int, Int, Int), (Int, Int, Int, Int)))
-> IOSim s ((Int, Int, Int, Int), (Int, Int, Int, Int))
forall s a.
NodeUnderTest (IOSim s)
-> PeerAddr
-> EnvPeer (IOSim s)
-> (NodeVsEnvConnection (IOSim s) -> IOSim s a)
-> IOSim s a
withNodeVsEnvConnection NodeUnderTest (IOSim s)
nut (Int -> PeerAddr
PeerAddr Int
1) EnvPeer (IOSim s)
envPeer ((NodeVsEnvConnection (IOSim s)
  -> IOSim s ((Int, Int, Int, Int), (Int, Int, Int, Int)))
 -> IOSim s ((Int, Int, Int, Int), (Int, Int, Int, Int)))
-> (NodeVsEnvConnection (IOSim s)
    -> IOSim s ((Int, Int, Int, Int), (Int, Int, Int, Int)))
-> IOSim s ((Int, Int, Int, Int), (Int, Int, Int, Int))
forall a b. (a -> b) -> a -> b
$ \NodeVsEnvConnection (IOSim s)
_conn -> do
        STM (IOSim s) () -> IOSim s ()
forall a. HasCallStack => STM (IOSim s) a -> IOSim s a
forall (m :: * -> *) a.
(MonadSTM m, HasCallStack) =>
STM m a -> m a
atomically (STM (IOSim s) () -> IOSim s ()) -> STM (IOSim s) () -> IOSim s ()
forall a b. (a -> b) -> a -> b
$ StrictTVar (IOSim s) Int -> STM (IOSim s) Int
forall (m :: * -> *) a. MonadSTM m => StrictTVar m a -> STM m a
readTVar StrictTVar (IOSim s) Int
requests STM (IOSim s) Int -> (Int -> STM (IOSim s) ()) -> STM (IOSim s) ()
forall a b.
STM (IOSim s) a -> (a -> STM (IOSim s) b) -> STM (IOSim s) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Bool -> STM (IOSim s) ()
Bool -> STM s ()
forall (m :: * -> *). MonadSTM m => Bool -> STM m ()
check (Bool -> STM s ()) -> (Int -> Bool) -> Int -> STM s ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
leiosNotifyPipelineDepth Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
3)
        beforePruning <- NodeUnderTest (IOSim s) -> IOSim s (Int, Int, Int, Int)
forall s. NodeUnderTest (IOSim s) -> IOSim s (Int, Int, Int, Int)
clientStateSize NodeUnderTest (IOSim s)
nut
        advanceImmutableTip nut
        afterPruning <- clientStateSize nut
        pure (beforePruning, afterPruning)

-- | How many elections, body offers, closure offers and votes the node's
-- clients remember.
clientStateSize :: NodeUnderTest (IOSim s) -> IOSim s (Int, Int, Int, Int)
clientStateSize :: forall s. NodeUnderTest (IOSim s) -> IOSim s (Int, Int, Int, Int)
clientStateSize NodeUnderTest (IOSim s)
nut = STM (IOSim s) (Int, Int, Int, Int) -> IOSim s (Int, Int, Int, Int)
forall a. HasCallStack => STM (IOSim s) a -> IOSim s a
forall (m :: * -> *) a.
(MonadSTM m, HasCallStack) =>
STM m a -> m a
atomically (STM (IOSim s) (Int, Int, Int, Int)
 -> IOSim s (Int, Int, Int, Int))
-> STM (IOSim s) (Int, Int, Int, Int)
-> IOSim s (Int, Int, Int, Int)
forall a b. (a -> b) -> a -> b
$ do
  states <- StrictTVar
  (IOSim s)
  (Map
     (ConnectionId PeerAddr)
     (StrictTVar (IOSim s) (LeiosNotifyPeerState LeiosTestBlock)))
-> STM
     (IOSim s)
     (Map
        (ConnectionId PeerAddr)
        (StrictTVar (IOSim s) (LeiosNotifyPeerState LeiosTestBlock)))
forall (m :: * -> *) a. MonadSTM m => StrictTVar m a -> STM m a
IOLike.readTVar (NodeKernel (IOSim s) PeerAddr (ConnectionId ()) LeiosTestBlock
-> StrictTVar
     (IOSim s)
     (Map
        (ConnectionId PeerAddr)
        (StrictTVar (IOSim s) (LeiosNotifyPeerState LeiosTestBlock)))
forall (m :: * -> *) addrNTN addrNTC blk.
NodeKernel m addrNTN addrNTC blk
-> StrictTVar
     m
     (Map
        (ConnectionId addrNTN) (StrictTVar m (LeiosNotifyPeerState blk)))
getLeiosNotifyClientStates (NodeUnderTest (IOSim s)
-> NodeKernel (IOSim s) PeerAddr (ConnectionId ()) LeiosTestBlock
forall (m :: * -> *).
NodeUnderTest m
-> NodeKernel m PeerAddr (ConnectionId ()) LeiosTestBlock
nutKernel NodeUnderTest (IOSim s)
nut))
  sizes <- mapM (fmap size . IOLike.readTVar) (Map.elems states)
  pure
    ( sum [e | (e, _, _, _) <- sizes]
    , sum [b | (_, b, _, _) <- sizes]
    , sum [c | (_, _, c, _) <- sizes]
    , sum [v | (_, _, _, v) <- sizes]
    )
 where
  size :: LeiosNotifyPeerState blk -> (Int, Int, Int, Int)
size LeiosNotifyPeerState blk
st =
    ( Map ElectionId (SeenAnnouncements (AnnouncingHeader blk)) -> Int
forall k a. Map k a -> Int
Map.size (State (AnnouncingHeader blk)
-> Map ElectionId (SeenAnnouncements (AnnouncingHeader blk))
forall anc. State anc -> Map ElectionId (SeenAnnouncements anc)
Announcements.live (LeiosNotifyPeerState blk -> State (AnnouncingHeader blk)
forall blk.
LeiosNotifyPeerState blk -> State (AnnouncingHeader blk)
lnpsAnnouncements LeiosNotifyPeerState blk
st))
    , Set LeiosPoint -> Int
forall a. Set a -> Int
Set.size (LeiosNotifyPeerState blk -> Set LeiosPoint
forall blk. LeiosNotifyPeerState blk -> Set LeiosPoint
lnpsBodyOffers LeiosNotifyPeerState blk
st)
    , Set LeiosPoint -> Int
forall a. Set a -> Int
Set.size (LeiosNotifyPeerState blk -> Set LeiosPoint
forall blk. LeiosNotifyPeerState blk -> Set LeiosPoint
lnpsClosureOffers LeiosNotifyPeerState blk
st)
    , Set (SlotNo, LeiosSeatId) -> Int
forall a. Set a -> Int
Set.size (LeiosNotifyPeerState blk -> Set (SlotNo, LeiosSeatId)
forall blk. LeiosNotifyPeerState blk -> Set (SlotNo, LeiosSeatId)
lnpsVotes LeiosNotifyPeerState blk
st)
    )

-- | Put each reply in the queue at its time.
feedAt ::
  StrictTQueue (IOSim s) (Message (LeiosNotify LeiosPoint (Header Blk) LeiosVote) StBusy StIdle) ->
  [(DiffTime, Message (LeiosNotify LeiosPoint (Header Blk) LeiosVote) StBusy StIdle)] ->
  IOSim s ()
feedAt :: forall s.
StrictTQueue
  (IOSim s)
  (Message
     (LeiosNotify LeiosPoint (Header LeiosTestBlock) LeiosVote)
     'StBusy
     'StIdle)
-> [(DiffTime,
     Message
       (LeiosNotify LeiosPoint (Header LeiosTestBlock) LeiosVote)
       'StBusy
       'StIdle)]
-> IOSim s ()
feedAt StrictTQueue
  (IOSim s)
  (Message
     (LeiosNotify LeiosPoint (Header LeiosTestBlock) LeiosVote)
     'StBusy
     'StIdle)
queue = DiffTime
-> [(DiffTime,
     Message
       (LeiosNotify LeiosPoint (Header LeiosTestBlock) LeiosVote)
       'StBusy
       'StIdle)]
-> IOSim s ()
go DiffTime
0
 where
  go :: DiffTime
-> [(DiffTime,
     Message
       (LeiosNotify LeiosPoint (Header LeiosTestBlock) LeiosVote)
       'StBusy
       'StIdle)]
-> IOSim s ()
go DiffTime
_now [] = () -> IOSim s ()
forall a. a -> IOSim s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
  go DiffTime
now ((DiffTime
at, Message
  (LeiosNotify LeiosPoint (Header LeiosTestBlock) LeiosVote)
  'StBusy
  'StIdle
msg) : [(DiffTime,
  Message
    (LeiosNotify LeiosPoint (Header LeiosTestBlock) LeiosVote)
    'StBusy
    'StIdle)]
rest) = do
    DiffTime -> IOSim s ()
forall (m :: * -> *). MonadDelay m => DiffTime -> m ()
threadDelay (DiffTime -> DiffTime -> DiffTime
forall a. Ord a => a -> a -> a
max DiffTime
0 (DiffTime
at DiffTime -> DiffTime -> DiffTime
forall a. Num a => a -> a -> a
- DiffTime
now))
    STM (IOSim s) () -> IOSim s ()
forall a. HasCallStack => STM (IOSim s) a -> IOSim s a
forall (m :: * -> *) a.
(MonadSTM m, HasCallStack) =>
STM m a -> m a
atomically (STM (IOSim s) () -> IOSim s ()) -> STM (IOSim s) () -> IOSim s ()
forall a b. (a -> b) -> a -> b
$ StrictTQueue
  (IOSim s)
  (Message
     (LeiosNotify LeiosPoint (Header LeiosTestBlock) LeiosVote)
     'StBusy
     'StIdle)
-> Message
     (LeiosNotify LeiosPoint (Header LeiosTestBlock) LeiosVote)
     'StBusy
     'StIdle
-> STM (IOSim s) ()
forall (m :: * -> *) a.
MonadSTM m =>
StrictTQueue m a -> a -> STM m ()
writeTQueue StrictTQueue
  (IOSim s)
  (Message
     (LeiosNotify LeiosPoint (Header LeiosTestBlock) LeiosVote)
     'StBusy
     'StIdle)
queue Message
  (LeiosNotify LeiosPoint (Header LeiosTestBlock) LeiosVote)
  'StBusy
  'StIdle
msg
    DiffTime
-> [(DiffTime,
     Message
       (LeiosNotify LeiosPoint (Header LeiosTestBlock) LeiosVote)
       'StBusy
       'StIdle)]
-> IOSim s ()
go (DiffTime -> DiffTime -> DiffTime
forall a. Ord a => a -> a -> a
max DiffTime
now DiffTime
at) [(DiffTime,
  Message
    (LeiosNotify LeiosPoint (Header LeiosTestBlock) LeiosVote)
    'StBusy
    'StIdle)]
rest

-- | A peer that sends each reply at its time, the announcement of
-- 'someAnnouncingBlock' first.
nodeClientAgainstSchedule ::
  [(DiffTime, Message (LeiosNotify LeiosPoint (Header Blk) LeiosVote) StBusy StIdle)] ->
  IOSim s NodeClientOutcome
nodeClientAgainstSchedule :: forall s.
[(DiffTime,
  Message
    (LeiosNotify LeiosPoint (Header LeiosTestBlock) LeiosVote)
    'StBusy
    'StIdle)]
-> IOSim s NodeClientOutcome
nodeClientAgainstSchedule [(DiffTime,
  Message
    (LeiosNotify LeiosPoint (Header LeiosTestBlock) LeiosVote)
    'StBusy
    'StIdle)]
schedule = (NodeUnderTest (IOSim s) -> IOSim s NodeClientOutcome)
-> IOSim s NodeClientOutcome
forall s a. (NodeUnderTest (IOSim s) -> IOSim s a) -> IOSim s a
withNode ((NodeUnderTest (IOSim s) -> IOSim s NodeClientOutcome)
 -> IOSim s NodeClientOutcome)
-> (NodeUnderTest (IOSim s) -> IOSim s NodeClientOutcome)
-> IOSim s NodeClientOutcome
forall a b. (a -> b) -> a -> b
$ \NodeUnderTest (IOSim s)
nut -> do
  queue <- IOSim
  s
  (StrictTQueue
     (IOSim s)
     (Message
        (LeiosNotify LeiosPoint (Header LeiosTestBlock) LeiosVote)
        'StBusy
        'StIdle))
forall (m :: * -> *) a. MonadSTM m => m (StrictTQueue m a)
newTQueueIO
  let msgs = (DiffTime
0, Message
  (LeiosNotify LeiosPoint (Header LeiosTestBlock) LeiosVote)
  'StBusy
  'StIdle
someAnnouncement) (DiffTime,
 Message
   (LeiosNotify LeiosPoint (Header LeiosTestBlock) LeiosVote)
   'StBusy
   'StIdle)
-> [(DiffTime,
     Message
       (LeiosNotify LeiosPoint (Header LeiosTestBlock) LeiosVote)
       'StBusy
       'StIdle)]
-> [(DiffTime,
     Message
       (LeiosNotify LeiosPoint (Header LeiosTestBlock) LeiosVote)
       'StBusy
       'StIdle)]
forall a. a -> [a] -> [a]
: [(DiffTime,
  Message
    (LeiosNotify LeiosPoint (Header LeiosTestBlock) LeiosVote)
    'StBusy
    'StIdle)]
schedule
  withAsync (feedAt queue msgs) $ \Async (IOSim s) ()
_feeder ->
    NodeUnderTest (IOSim s)
-> STM
     (IOSim s)
     (Message
        (LeiosNotify LeiosPoint (Header LeiosTestBlock) LeiosVote)
        'StBusy
        'StIdle)
-> Int
-> IOSim s NodeClientOutcome
forall s.
NodeUnderTest (IOSim s)
-> STM
     (IOSim s)
     (Message
        (LeiosNotify LeiosPoint (Header LeiosTestBlock) LeiosVote)
        'StBusy
        'StIdle)
-> Int
-> IOSim s NodeClientOutcome
runNodeClientAgainst NodeUnderTest (IOSim s)
nut (StrictTQueue
  (IOSim s)
  (Message
     (LeiosNotify LeiosPoint (Header LeiosTestBlock) LeiosVote)
     'StBusy
     'StIdle)
-> STM
     (IOSim s)
     (Message
        (LeiosNotify LeiosPoint (Header LeiosTestBlock) LeiosVote)
        'StBusy
        'StIdle)
forall (m :: * -> *) a. MonadSTM m => StrictTQueue m a -> STM m a
readTQueue StrictTQueue
  (IOSim s)
  (Message
     (LeiosNotify LeiosPoint (Header LeiosTestBlock) LeiosVote)
     'StBusy
     'StIdle)
queue) (Int
leiosNotifyPipelineDepth Int -> Int -> Int
forall a. Num a => a -> a -> a
+ [(DiffTime,
  Message
    (LeiosNotify LeiosPoint (Header LeiosTestBlock) LeiosVote)
    'StBusy
    'StIdle)]
-> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(DiffTime,
  Message
    (LeiosNotify LeiosPoint (Header LeiosTestBlock) LeiosVote)
    'StBusy
    'StIdle)]
msgs)

-- | A vote from this seat for the announcement this block carries.
voteFor :: LeiosTestBlock -> Word16 -> LeiosVote
voteFor :: LeiosTestBlock -> Word16 -> LeiosVote
voteFor LeiosTestBlock
blk Word16
seat = RbHash -> Word16 -> LeiosVote
signedVote (ByteString -> RbHash
MkRbHash (Proxy LeiosTestBlock -> HeaderHash LeiosTestBlock -> ByteString
forall blk (proxy :: * -> *).
ConvertRawHash blk =>
proxy blk -> HeaderHash blk -> ByteString
forall (proxy :: * -> *).
proxy LeiosTestBlock -> HeaderHash LeiosTestBlock -> ByteString
toRawHash (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @LeiosTestBlock) (LeiosTestBlock -> HeaderHash LeiosTestBlock
forall b. HasHeader b => b -> HeaderHash b
blockHash LeiosTestBlock
blk))) Word16
seat

someAnnouncingBlock :: LeiosTestBlock
someAnnouncingBlock :: LeiosTestBlock
someAnnouncingBlock = Word8 -> LeiosTestBlock -> LeiosTestBlock
ann Word8
1 (Word64 -> LeiosTestBlock
firstLeiosBlock Word64
0)

-- | Another announcement in the election of 'someAnnouncingBlock'.
equivocation :: LeiosTestBlock
equivocation :: LeiosTestBlock
equivocation = Word8 -> LeiosTestBlock -> LeiosTestBlock
ann Word8
2 (LeiosTestBlock -> LeiosTestBlock
forkLeiosBlock (Word64 -> LeiosTestBlock
firstLeiosBlock Word64
0))

-- | Make the first two slots immutable: k is 10, so twelve blocks do it.
advanceImmutableTip :: NodeUnderTest (IOSim s) -> IOSim s ()
advanceImmutableTip :: forall s. NodeUnderTest (IOSim s) -> IOSim s ()
advanceImmutableTip NodeUnderTest (IOSim s)
nut = do
  DiffTime -> IOSim s ()
forall (m :: * -> *). MonadDelay m => DiffTime -> m ()
threadDelay DiffTime
20
  (LeiosTestBlock -> IOSim s ()) -> [LeiosTestBlock] -> IOSim s ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (ChainDB (IOSim s) LeiosTestBlock
-> InvalidBlockPunishment (IOSim s) -> LeiosTestBlock -> IOSim s ()
forall (m :: * -> *) blk.
IOLike m =>
ChainDB m blk -> InvalidBlockPunishment m -> blk -> m ()
ChainDB.addBlock_ (NodeUnderTest (IOSim s) -> ChainDB (IOSim s) LeiosTestBlock
forall (m :: * -> *). NodeUnderTest m -> ChainDB m LeiosTestBlock
nutChainDB NodeUnderTest (IOSim s)
nut) InvalidBlockPunishment (IOSim s)
forall (m :: * -> *). Applicative m => InvalidBlockPunishment m
noPunishment) ([LeiosTestBlock] -> IOSim s ()) -> [LeiosTestBlock] -> IOSim s ()
forall a b. (a -> b) -> a -> b
$
    Int -> [LeiosTestBlock] -> [LeiosTestBlock]
forall a. Int -> [a] -> [a]
take Int
12 ([LeiosTestBlock] -> [LeiosTestBlock])
-> [LeiosTestBlock] -> [LeiosTestBlock]
forall a b. (a -> b) -> a -> b
$
      (LeiosTestBlock -> LeiosTestBlock)
-> LeiosTestBlock -> [LeiosTestBlock]
forall a. (a -> a) -> a -> [a]
iterate LeiosTestBlock -> LeiosTestBlock
successorLeiosBlock (Word64 -> LeiosTestBlock
firstLeiosBlock Word64
1)
  DiffTime -> IOSim s ()
forall (m :: * -> *). MonadDelay m => DiffTime -> m ()
threadDelay DiffTime
1

-- | The peer sends this offer of an endorser block it announced, but only once
-- the immutable tip has passed it.
nodeClientOfferTooOld ::
  Message (LeiosNotify LeiosPoint (Header Blk) LeiosVote) StBusy StIdle -> IOSim s NodeClientOutcome
nodeClientOfferTooOld :: forall s.
Message
  (LeiosNotify LeiosPoint (Header LeiosTestBlock) LeiosVote)
  'StBusy
  'StIdle
-> IOSim s NodeClientOutcome
nodeClientOfferTooOld Message
  (LeiosNotify LeiosPoint (Header LeiosTestBlock) LeiosVote)
  'StBusy
  'StIdle
offer = (NodeUnderTest (IOSim s) -> IOSim s NodeClientOutcome)
-> IOSim s NodeClientOutcome
forall s a. (NodeUnderTest (IOSim s) -> IOSim s a) -> IOSim s a
withNode ((NodeUnderTest (IOSim s) -> IOSim s NodeClientOutcome)
 -> IOSim s NodeClientOutcome)
-> (NodeUnderTest (IOSim s) -> IOSim s NodeClientOutcome)
-> IOSim s NodeClientOutcome
forall a b. (a -> b) -> a -> b
$ \NodeUnderTest (IOSim s)
nut -> do
  queue <- IOSim
  s
  (StrictTQueue
     (IOSim s)
     (Message
        (LeiosNotify LeiosPoint (Header LeiosTestBlock) LeiosVote)
        'StBusy
        'StIdle))
forall (m :: * -> *) a. MonadSTM m => m (StrictTQueue m a)
newTQueueIO
  atomically $ writeTQueue queue someAnnouncement
  announced <- newEmptyTMVarIO
  let feed = do
        STM (IOSim s) () -> IOSim s ()
forall a. HasCallStack => STM (IOSim s) a -> IOSim s a
forall (m :: * -> *) a.
(MonadSTM m, HasCallStack) =>
STM m a -> m a
atomically (STM (IOSim s) () -> IOSim s ()) -> STM (IOSim s) () -> IOSim s ()
forall a b. (a -> b) -> a -> b
$ StrictTMVar (IOSim s) () -> STM (IOSim s) ()
forall (m :: * -> *) a. MonadSTM m => StrictTMVar m a -> STM m a
readTMVar StrictTMVar (IOSim s) ()
announced
        NodeUnderTest (IOSim s) -> IOSim s ()
forall s. NodeUnderTest (IOSim s) -> IOSim s ()
advanceImmutableTip NodeUnderTest (IOSim s)
nut
        STM (IOSim s) () -> IOSim s ()
forall a. HasCallStack => STM (IOSim s) a -> IOSim s a
forall (m :: * -> *) a.
(MonadSTM m, HasCallStack) =>
STM m a -> m a
atomically (STM (IOSim s) () -> IOSim s ()) -> STM (IOSim s) () -> IOSim s ()
forall a b. (a -> b) -> a -> b
$ StrictTQueue
  (IOSim s)
  (Message
     (LeiosNotify LeiosPoint (Header LeiosTestBlock) LeiosVote)
     'StBusy
     'StIdle)
-> Message
     (LeiosNotify LeiosPoint (Header LeiosTestBlock) LeiosVote)
     'StBusy
     'StIdle
-> STM (IOSim s) ()
forall (m :: * -> *) a.
MonadSTM m =>
StrictTQueue m a -> a -> STM m ()
writeTQueue StrictTQueue
  (IOSim s)
  (Message
     (LeiosNotify LeiosPoint (Header LeiosTestBlock) LeiosVote)
     'StBusy
     'StIdle)
queue Message
  (LeiosNotify LeiosPoint (Header LeiosTestBlock) LeiosVote)
  'StBusy
  'StIdle
offer
      next = do
        msg <- StrictTQueue
  (IOSim s)
  (Message
     (LeiosNotify LeiosPoint (Header LeiosTestBlock) LeiosVote)
     'StBusy
     'StIdle)
-> STM
     (IOSim s)
     (Message
        (LeiosNotify LeiosPoint (Header LeiosTestBlock) LeiosVote)
        'StBusy
        'StIdle)
forall (m :: * -> *) a. MonadSTM m => StrictTQueue m a -> STM m a
readTQueue StrictTQueue
  (IOSim s)
  (Message
     (LeiosNotify LeiosPoint (Header LeiosTestBlock) LeiosVote)
     'StBusy
     'StIdle)
queue
        _ <- tryPutTMVar announced ()
        pure msg
  withAsync feed $ \Async (IOSim s) ()
_feeder -> NodeUnderTest (IOSim s)
-> STM
     (IOSim s)
     (Message
        (LeiosNotify LeiosPoint (Header LeiosTestBlock) LeiosVote)
        'StBusy
        'StIdle)
-> Int
-> IOSim s NodeClientOutcome
forall s.
NodeUnderTest (IOSim s)
-> STM
     (IOSim s)
     (Message
        (LeiosNotify LeiosPoint (Header LeiosTestBlock) LeiosVote)
        'StBusy
        'StIdle)
-> Int
-> IOSim s NodeClientOutcome
runNodeClientAgainst NodeUnderTest (IOSim s)
nut STM
  (IOSim s)
  (Message
     (LeiosNotify LeiosPoint (Header LeiosTestBlock) LeiosVote)
     'StBusy
     'StIdle)
STM
  s
  (Message
     (LeiosNotify LeiosPoint (Header LeiosTestBlock) LeiosVote)
     'StBusy
     'StIdle)
next Int
forall a. Bounded a => a
maxBound

-- | A peer that announces 'someOfferedPoint', then sends these.
nodeClientAgainstOffers ::
  [Message (LeiosNotify LeiosPoint (Header Blk) LeiosVote) StBusy StIdle] -> IOSim s NodeClientOutcome
nodeClientAgainstOffers :: forall s.
[Message
   (LeiosNotify LeiosPoint (Header LeiosTestBlock) LeiosVote)
   'StBusy
   'StIdle]
-> IOSim s NodeClientOutcome
nodeClientAgainstOffers [Message
   (LeiosNotify LeiosPoint (Header LeiosTestBlock) LeiosVote)
   'StBusy
   'StIdle]
msgs = (NodeUnderTest (IOSim s) -> IOSim s NodeClientOutcome)
-> IOSim s NodeClientOutcome
forall s a. (NodeUnderTest (IOSim s) -> IOSim s a) -> IOSim s a
withNode ((NodeUnderTest (IOSim s) -> IOSim s NodeClientOutcome)
 -> IOSim s NodeClientOutcome)
-> (NodeUnderTest (IOSim s) -> IOSim s NodeClientOutcome)
-> IOSim s NodeClientOutcome
forall a b. (a -> b) -> a -> b
$ \NodeUnderTest (IOSim s)
nut -> do
  queue <- IOSim
  s
  (StrictTQueue
     (IOSim s)
     (Message
        (LeiosNotify LeiosPoint (Header LeiosTestBlock) LeiosVote)
        'StBusy
        'StIdle))
forall (m :: * -> *) a. MonadSTM m => m (StrictTQueue m a)
newTQueueIO
  atomically $ mapM_ (writeTQueue queue) (someAnnouncement : msgs)
  runNodeClientAgainst nut (readTQueue queue) (leiosNotifyPipelineDepth + 1 + length msgs)

someAnnouncement :: Message (LeiosNotify LeiosPoint (Header Blk) LeiosVote) StBusy StIdle
someAnnouncement :: Message
  (LeiosNotify LeiosPoint (Header LeiosTestBlock) LeiosVote)
  'StBusy
  'StIdle
someAnnouncement = Header LeiosTestBlock
-> Message
     (LeiosNotify LeiosPoint (Header LeiosTestBlock) LeiosVote)
     'StBusy
     'StIdle
forall announcement point vote.
announcement
-> Message (LeiosNotify point announcement vote) 'StBusy 'StIdle
MsgLeiosBlockAnnouncement (Header LeiosTestBlock
 -> Message
      (LeiosNotify LeiosPoint (Header LeiosTestBlock) LeiosVote)
      'StBusy
      'StIdle)
-> Header LeiosTestBlock
-> Message
     (LeiosNotify LeiosPoint (Header LeiosTestBlock) LeiosVote)
     'StBusy
     'StIdle
forall a b. (a -> b) -> a -> b
$ LeiosTestBlock -> Header LeiosTestBlock
ltbHeader (LeiosTestBlock -> Header LeiosTestBlock)
-> LeiosTestBlock -> Header LeiosTestBlock
forall a b. (a -> b) -> a -> b
$ Word8 -> LeiosTestBlock -> LeiosTestBlock
ann Word8
1 (Word64 -> LeiosTestBlock
firstLeiosBlock Word64
0)

-- | The endorser block 'someAnnouncement' announces.
someOfferedPoint :: LeiosPoint
someOfferedPoint :: LeiosPoint
someOfferedPoint = SlotNo -> EbHash -> LeiosPoint
MkLeiosPoint (Word64 -> SlotNo
SlotNo Word64
1) (ByteString -> EbHash
MkEbHash (Int -> Word8 -> ByteString
BS.replicate Int
32 Word8
1))

maxEbBodySize :: BytesSize
maxEbBodySize :: Word32
maxEbBodySize = Word32
5000

newtype NodeServerOutcome = NodeServerOutcome Int
  deriving (NodeServerOutcome -> NodeServerOutcome -> Bool
(NodeServerOutcome -> NodeServerOutcome -> Bool)
-> (NodeServerOutcome -> NodeServerOutcome -> Bool)
-> Eq NodeServerOutcome
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: NodeServerOutcome -> NodeServerOutcome -> Bool
== :: NodeServerOutcome -> NodeServerOutcome -> Bool
$c/= :: NodeServerOutcome -> NodeServerOutcome -> Bool
/= :: NodeServerOutcome -> NodeServerOutcome -> Bool
Eq, Int -> NodeServerOutcome -> ShowS
[NodeServerOutcome] -> ShowS
NodeServerOutcome -> TestName
(Int -> NodeServerOutcome -> ShowS)
-> (NodeServerOutcome -> TestName)
-> ([NodeServerOutcome] -> ShowS)
-> Show NodeServerOutcome
forall a.
(Int -> a -> ShowS) -> (a -> TestName) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> NodeServerOutcome -> ShowS
showsPrec :: Int -> NodeServerOutcome -> ShowS
$cshow :: NodeServerOutcome -> TestName
show :: NodeServerOutcome -> TestName
$cshowList :: [NodeServerOutcome] -> ShowS
showList :: [NodeServerOutcome] -> ShowS
Show)

-- | The node never has a notification, so the peer's requests are all
-- outstanding when it quits.
nodeServerCancels :: IOSim s NodeServerOutcome
nodeServerCancels :: forall s. IOSim s NodeServerOutcome
nodeServerCancels = (NodeUnderTest (IOSim s) -> IOSim s NodeServerOutcome)
-> IOSim s NodeServerOutcome
forall s a. (NodeUnderTest (IOSim s) -> IOSim s a) -> IOSim s a
withNode ((NodeUnderTest (IOSim s) -> IOSim s NodeServerOutcome)
 -> IOSim s NodeServerOutcome)
-> (NodeUnderTest (IOSim s) -> IOSim s NodeServerOutcome)
-> IOSim s NodeServerOutcome
forall a b. (a -> b) -> a -> b
$ \NodeUnderTest (IOSim s)
nut -> do
  requests <- Int -> IOSim s (StrictTVar (IOSim s) Int)
forall (m :: * -> *) a. MonadSTM m => a -> m (StrictTVar m a)
newTVarIO Int
0
  replies <- newTVarIO 0
  stop <- newEmptyTMVarIO
  let codec' = NodeUnderTest (IOSim s) -> LeiosNotifyCodec s
forall s. NodeUnderTest (IOSim s) -> LeiosNotifyCodec s
envLeiosNotifyCodec NodeUnderTest (IOSim s)
nut
      envPeer =
        EnvPeer
          { epLeiosNotifyServer :: Channel (IOSim s) ByteString -> IOSim s ()
epLeiosNotifyServer = LeiosNotifyCodec s
-> StrictTVar (IOSim s) Int
-> STM
     (IOSim s)
     (Message
        (LeiosNotify LeiosPoint (Header LeiosTestBlock) LeiosVote)
        'StBusy
        'StIdle)
-> Channel (IOSim s) ByteString
-> IOSim s ()
forall s.
LeiosNotifyCodec s
-> StrictTVar (IOSim s) Int
-> STM
     (IOSim s)
     (Message
        (LeiosNotify LeiosPoint (Header LeiosTestBlock) LeiosVote)
        'StBusy
        'StIdle)
-> Channel (IOSim s) ByteString
-> IOSim s ()
runReplyingServer LeiosNotifyCodec s
codec' StrictTVar (IOSim s) Int
requests STM
  (IOSim s)
  (Message
     (LeiosNotify LeiosPoint (Header LeiosTestBlock) LeiosVote)
     'StBusy
     'StIdle)
forall a. STM (IOSim s) a
forall (m :: * -> *) a. MonadSTM m => STM m a
retry
          , epLeiosNotifyClient :: Maybe (Channel (IOSim s) ByteString -> IOSim s ())
epLeiosNotifyClient = (Channel (IOSim s) ByteString -> IOSim s ())
-> Maybe (Channel (IOSim s) ByteString -> IOSim s ())
forall a. a -> Maybe a
Just ((Channel (IOSim s) ByteString -> IOSim s ())
 -> Maybe (Channel (IOSim s) ByteString -> IOSim s ()))
-> (Channel (IOSim s) ByteString -> IOSim s ())
-> Maybe (Channel (IOSim s) ByteString -> IOSim s ())
forall a b. (a -> b) -> a -> b
$ LeiosNotifyCodec s
-> StrictTVar (IOSim s) Int
-> Int
-> StrictTMVar (IOSim s) ()
-> Channel (IOSim s) ByteString
-> IOSim s ()
forall point announcement vote s.
(ShowProxy point, ShowProxy announcement, ShowProxy vote) =>
Codec
  (LeiosNotify point announcement vote)
  DeserialiseFailure
  (IOSim s)
  ByteString
-> StrictTVar (IOSim s) Int
-> Int
-> StrictTMVar (IOSim s) ()
-> Channel (IOSim s) ByteString
-> IOSim s ()
runPipelinedClient LeiosNotifyCodec s
codec' StrictTVar (IOSim s) Int
replies Int
3 StrictTMVar (IOSim s) ()
stop
          }
  withNodeVsEnvConnection nut (PeerAddr 1) envPeer $ \NodeVsEnvConnection (IOSim s)
conn -> do
    DiffTime -> IOSim s ()
forall (m :: * -> *). MonadDelay m => DiffTime -> m ()
threadDelay DiffTime
10
    STM (IOSim s) () -> IOSim s ()
forall a. HasCallStack => STM (IOSim s) a -> IOSim s a
forall (m :: * -> *) a.
(MonadSTM m, HasCallStack) =>
STM m a -> m a
atomically (STM (IOSim s) () -> IOSim s ()) -> STM (IOSim s) () -> IOSim s ()
forall a b. (a -> b) -> a -> b
$ StrictTMVar (IOSim s) () -> () -> STM (IOSim s) ()
forall (m :: * -> *) a.
MonadSTM m =>
StrictTMVar m a -> a -> STM m ()
putTMVar StrictTMVar (IOSim s) ()
stop ()
    Maybe (STM s (Either SomeException ()))
-> (STM s (Either SomeException ()) -> IOSim s ()) -> IOSim s ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ (NodeVsEnvConnection (IOSim s)
-> Maybe (STM (IOSim s) (Either SomeException ()))
forall (m :: * -> *).
NodeVsEnvConnection m -> Maybe (STM m (Either SomeException ()))
connPeerLeiosNotifyClient NodeVsEnvConnection (IOSim s)
conn) ((STM s (Either SomeException ()) -> IOSim s ()) -> IOSim s ())
-> (STM s (Either SomeException ()) -> IOSim s ()) -> IOSim s ()
forall a b. (a -> b) -> a -> b
$ \STM s (Either SomeException ())
client -> STM (IOSim s) (Either SomeException ())
-> IOSim s (Either SomeException ())
forall a. HasCallStack => STM (IOSim s) a -> IOSim s a
forall (m :: * -> *) a.
(MonadSTM m, HasCallStack) =>
STM m a -> m a
atomically STM (IOSim s) (Either SomeException ())
STM s (Either SomeException ())
client IOSim s (Either SomeException ())
-> (Either SomeException () -> IOSim s ()) -> IOSim s ()
forall a b. IOSim s a -> (a -> IOSim s b) -> IOSim s b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (SomeException -> IOSim s ())
-> (() -> IOSim s ()) -> Either SomeException () -> IOSim s ()
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either SomeException -> IOSim s ()
forall e a. Exception e => e -> IOSim s a
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwIO () -> IOSim s ()
forall a. a -> IOSim s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
    server <- NodeVsEnvConnection (IOSim s)
-> IOSim s (STM (IOSim s) (Either SomeException ()))
forall s.
NodeVsEnvConnection (IOSim s)
-> IOSim s (STM (IOSim s) (Either SomeException ()))
nodeLeiosNotifyServer NodeVsEnvConnection (IOSim s)
conn
    atomically server >>= either throwIO pure
    NodeServerOutcome <$> readTVarIO replies

-- | A peer pipelining one request more than the node's server allows, so the
-- node disconnects it.
nodeServerExcessive :: IOSim s ExcessiveOutcome
nodeServerExcessive :: forall s. IOSim s ExcessiveOutcome
nodeServerExcessive = (NodeUnderTest (IOSim s) -> IOSim s ExcessiveOutcome)
-> IOSim s ExcessiveOutcome
forall s a. (NodeUnderTest (IOSim s) -> IOSim s a) -> IOSim s a
withNode ((NodeUnderTest (IOSim s) -> IOSim s ExcessiveOutcome)
 -> IOSim s ExcessiveOutcome)
-> (NodeUnderTest (IOSim s) -> IOSim s ExcessiveOutcome)
-> IOSim s ExcessiveOutcome
forall a b. (a -> b) -> a -> b
$ \NodeUnderTest (IOSim s)
nut -> do
  requests <- Int -> IOSim s (StrictTVar (IOSim s) Int)
forall (m :: * -> *) a. MonadSTM m => a -> m (StrictTVar m a)
newTVarIO Int
0
  replies <- newTVarIO 0
  stop <- newEmptyTMVarIO
  let codec' = NodeUnderTest (IOSim s) -> LeiosNotifyCodec s
forall s. NodeUnderTest (IOSim s) -> LeiosNotifyCodec s
envLeiosNotifyCodec NodeUnderTest (IOSim s)
nut
      envPeer =
        EnvPeer
          { epLeiosNotifyServer :: Channel (IOSim s) ByteString -> IOSim s ()
epLeiosNotifyServer = LeiosNotifyCodec s
-> StrictTVar (IOSim s) Int
-> STM
     (IOSim s)
     (Message
        (LeiosNotify LeiosPoint (Header LeiosTestBlock) LeiosVote)
        'StBusy
        'StIdle)
-> Channel (IOSim s) ByteString
-> IOSim s ()
forall s.
LeiosNotifyCodec s
-> StrictTVar (IOSim s) Int
-> STM
     (IOSim s)
     (Message
        (LeiosNotify LeiosPoint (Header LeiosTestBlock) LeiosVote)
        'StBusy
        'StIdle)
-> Channel (IOSim s) ByteString
-> IOSim s ()
runReplyingServer LeiosNotifyCodec s
codec' StrictTVar (IOSim s) Int
requests STM
  (IOSim s)
  (Message
     (LeiosNotify LeiosPoint (Header LeiosTestBlock) LeiosVote)
     'StBusy
     'StIdle)
forall a. STM (IOSim s) a
forall (m :: * -> *) a. MonadSTM m => STM m a
retry
          , epLeiosNotifyClient :: Maybe (Channel (IOSim s) ByteString -> IOSim s ())
epLeiosNotifyClient =
              (Channel (IOSim s) ByteString -> IOSim s ())
-> Maybe (Channel (IOSim s) ByteString -> IOSim s ())
forall a. a -> Maybe a
Just ((Channel (IOSim s) ByteString -> IOSim s ())
 -> Maybe (Channel (IOSim s) ByteString -> IOSim s ()))
-> (Channel (IOSim s) ByteString -> IOSim s ())
-> Maybe (Channel (IOSim s) ByteString -> IOSim s ())
forall a b. (a -> b) -> a -> b
$ LeiosNotifyCodec s
-> StrictTVar (IOSim s) Int
-> Int
-> StrictTMVar (IOSim s) ()
-> Channel (IOSim s) ByteString
-> IOSim s ()
forall point announcement vote s.
(ShowProxy point, ShowProxy announcement, ShowProxy vote) =>
Codec
  (LeiosNotify point announcement vote)
  DeserialiseFailure
  (IOSim s)
  ByteString
-> StrictTVar (IOSim s) Int
-> Int
-> StrictTMVar (IOSim s) ()
-> Channel (IOSim s) ByteString
-> IOSim s ()
runPipelinedClient LeiosNotifyCodec s
codec' StrictTVar (IOSim s) Int
replies (Int
leiosNotifyPipelineDepth Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) StrictTMVar (IOSim s) ()
stop
          }
  withNodeVsEnvConnection nut (PeerAddr 1) envPeer $ \NodeVsEnvConnection (IOSim s)
conn -> do
    server <- NodeVsEnvConnection (IOSim s)
-> IOSim s (STM (IOSim s) (Either SomeException ()))
forall s.
NodeVsEnvConnection (IOSim s)
-> IOSim s (STM (IOSim s) (Either SomeException ()))
nodeLeiosNotifyServer NodeVsEnvConnection (IOSim s)
conn
    atomically server >>= \case
      Left SomeException
e | Just ExnLeiosNotifyExcessiveRequests
ExnLeiosNotifyExcessiveRequests <- SomeException -> Maybe ExnLeiosNotifyExcessiveRequests
forall e. Exception e => SomeException -> Maybe e
fromException SomeException
e -> ExcessiveOutcome -> IOSim s ExcessiveOutcome
forall a. a -> IOSim s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ExcessiveOutcome -> IOSim s ExcessiveOutcome)
-> ExcessiveOutcome -> IOSim s ExcessiveOutcome
forall a b. (a -> b) -> a -> b
$ WhetherDisconnected -> ExcessiveOutcome
ExcessiveOutcome WhetherDisconnected
Disconnected
      Either SomeException ()
_ -> ExcessiveOutcome -> IOSim s ExcessiveOutcome
forall a. a -> IOSim s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ExcessiveOutcome -> IOSim s ExcessiveOutcome)
-> ExcessiveOutcome -> IOSim s ExcessiveOutcome
forall a b. (a -> b) -> a -> b
$ WhetherDisconnected -> ExcessiveOutcome
ExcessiveOutcome WhetherDisconnected
NotDisconnected

-- | Whether the node's initiator bundle, and its initiator-and-responder bundle,
-- include LeiosNotify among their hot mini-protocols for this version.
nodeRunsLeiosNotify :: NodeToNodeVersion -> IOSim s (Bool, Bool)
nodeRunsLeiosNotify :: forall s. NodeToNodeVersion -> IOSim s (Bool, Bool)
nodeRunsLeiosNotify NodeToNodeVersion
ntnVersion = (NodeUnderTest (IOSim s) -> IOSim s (Bool, Bool))
-> IOSim s (Bool, Bool)
forall s a. (NodeUnderTest (IOSim s) -> IOSim s a) -> IOSim s a
withNode ((NodeUnderTest (IOSim s) -> IOSim s (Bool, Bool))
 -> IOSim s (Bool, Bool))
-> (NodeUnderTest (IOSim s) -> IOSim s (Bool, Bool))
-> IOSim s (Bool, Bool)
forall a b. (a -> b) -> a -> b
$ \NodeUnderTest (IOSim s)
nut ->
  (Bool, Bool) -> IOSim s (Bool, Bool)
forall a. a -> IOSim s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
    ( TemperatureBundle
  [MiniProtocol
     'InitiatorMode
     (ExpandedInitiatorContext PeerAddr PeerTrustable (IOSim s))
     (ResponderContext PeerAddr)
     ByteString
     (IOSim s)
     NodeToNodeInitiatorResult
     Void]
-> Bool
forall {mode :: Mode} {initiatorCtx} {responderCtx} {bytes}
       {m :: * -> *} {a} {b}.
TemperatureBundle
  [MiniProtocol mode initiatorCtx responderCtx bytes m a b]
-> Bool
runsLeiosNotify (TemperatureBundle
   [MiniProtocol
      'InitiatorMode
      (ExpandedInitiatorContext PeerAddr PeerTrustable (IOSim s))
      (ResponderContext PeerAddr)
      ByteString
      (IOSim s)
      NodeToNodeInitiatorResult
      Void]
 -> Bool)
-> TemperatureBundle
     [MiniProtocol
        'InitiatorMode
        (ExpandedInitiatorContext PeerAddr PeerTrustable (IOSim s))
        (ResponderContext PeerAddr)
        ByteString
        (IOSim s)
        NodeToNodeInitiatorResult
        Void]
-> Bool
forall a b. (a -> b) -> a -> b
$
        Set CardanoFeatureFlag
-> MiniProtocolParameters
-> NodeToNodeVersion
-> NodeToNodeVersionData
-> Apps
     (IOSim s)
     PeerAddr
     ByteString
     ByteString
     ByteString
     ByteString
     ByteString
     ByteString
     ByteString
     ByteString
     NodeToNodeInitiatorResult
     ()
-> TemperatureBundle
     [MiniProtocol
        'InitiatorMode
        (ExpandedInitiatorContext PeerAddr PeerTrustable (IOSim s))
        (ResponderContext PeerAddr)
        ByteString
        (IOSim s)
        NodeToNodeInitiatorResult
        Void]
forall (m :: * -> *) addr b a c.
Set CardanoFeatureFlag
-> MiniProtocolParameters
-> NodeToNodeVersion
-> NodeToNodeVersionData
-> Apps m addr b b b b b b b b a c
-> OuroborosBundleWithExpandedCtx
     'InitiatorMode addr PeerTrustable b m a Void
NTN.initiator Set CardanoFeatureFlag
forall a. Monoid a => a
mempty MiniProtocolParameters
defaultMiniProtocolParameters NodeToNodeVersion
ntnVersion NodeToNodeVersionData
versionData (NodeUnderTest (IOSim s)
-> BlockNodeToNodeVersion LeiosTestBlock
-> Apps
     (IOSim s)
     PeerAddr
     ByteString
     ByteString
     ByteString
     ByteString
     ByteString
     ByteString
     ByteString
     ByteString
     NodeToNodeInitiatorResult
     ()
forall (m :: * -> *).
NodeUnderTest m
-> BlockNodeToNodeVersion LeiosTestBlock -> NodeApps m
nutApps NodeUnderTest (IOSim s)
nut ())
    , TemperatureBundle
  [MiniProtocol
     'InitiatorResponderMode
     (ExpandedInitiatorContext PeerAddr PeerTrustable (IOSim s))
     (ResponderContext PeerAddr)
     ByteString
     (IOSim s)
     NodeToNodeInitiatorResult
     ()]
-> Bool
forall {mode :: Mode} {initiatorCtx} {responderCtx} {bytes}
       {m :: * -> *} {a} {b}.
TemperatureBundle
  [MiniProtocol mode initiatorCtx responderCtx bytes m a b]
-> Bool
runsLeiosNotify (TemperatureBundle
   [MiniProtocol
      'InitiatorResponderMode
      (ExpandedInitiatorContext PeerAddr PeerTrustable (IOSim s))
      (ResponderContext PeerAddr)
      ByteString
      (IOSim s)
      NodeToNodeInitiatorResult
      ()]
 -> Bool)
-> TemperatureBundle
     [MiniProtocol
        'InitiatorResponderMode
        (ExpandedInitiatorContext PeerAddr PeerTrustable (IOSim s))
        (ResponderContext PeerAddr)
        ByteString
        (IOSim s)
        NodeToNodeInitiatorResult
        ()]
-> Bool
forall a b. (a -> b) -> a -> b
$
        Set CardanoFeatureFlag
-> MiniProtocolParameters
-> NodeToNodeVersion
-> NodeToNodeVersionData
-> Apps
     (IOSim s)
     PeerAddr
     ByteString
     ByteString
     ByteString
     ByteString
     ByteString
     ByteString
     ByteString
     ByteString
     NodeToNodeInitiatorResult
     ()
-> TemperatureBundle
     [MiniProtocol
        'InitiatorResponderMode
        (ExpandedInitiatorContext PeerAddr PeerTrustable (IOSim s))
        (ResponderContext PeerAddr)
        ByteString
        (IOSim s)
        NodeToNodeInitiatorResult
        ()]
forall (m :: * -> *) addr b a c.
Set CardanoFeatureFlag
-> MiniProtocolParameters
-> NodeToNodeVersion
-> NodeToNodeVersionData
-> Apps m addr b b b b b b b b a c
-> OuroborosBundleWithExpandedCtx
     'InitiatorResponderMode addr PeerTrustable b m a c
NTN.initiatorAndResponder
          Set CardanoFeatureFlag
forall a. Monoid a => a
mempty
          MiniProtocolParameters
defaultMiniProtocolParameters
          NodeToNodeVersion
ntnVersion
          NodeToNodeVersionData
versionData
          (NodeUnderTest (IOSim s)
-> BlockNodeToNodeVersion LeiosTestBlock
-> Apps
     (IOSim s)
     PeerAddr
     ByteString
     ByteString
     ByteString
     ByteString
     ByteString
     ByteString
     ByteString
     ByteString
     NodeToNodeInitiatorResult
     ()
forall (m :: * -> *).
NodeUnderTest m
-> BlockNodeToNodeVersion LeiosTestBlock -> NodeApps m
nutApps NodeUnderTest (IOSim s)
nut ())
    )
 where
  versionData :: NodeToNodeVersionData
versionData = NodeToNodeVersion -> NodeToNodeVersionData
nodeVersionData NodeToNodeVersion
ntnVersion
  runsLeiosNotify :: TemperatureBundle
  [MiniProtocol mode initiatorCtx responderCtx bytes m a b]
-> Bool
runsLeiosNotify TemperatureBundle
  [MiniProtocol mode initiatorCtx responderCtx bytes m a b]
bundle = case TemperatureBundle
  [MiniProtocol mode initiatorCtx responderCtx bytes m a b]
-> WithProtocolTemperature
     'Hot [MiniProtocol mode initiatorCtx responderCtx bytes m a b]
forall a. TemperatureBundle a -> WithProtocolTemperature 'Hot a
withHot TemperatureBundle
  [MiniProtocol mode initiatorCtx responderCtx bytes m a b]
bundle of
    WithHot [MiniProtocol mode initiatorCtx responderCtx bytes m a b]
protocols -> MiniProtocolNum
leiosNotifyMiniProtocolNum MiniProtocolNum -> [MiniProtocolNum] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` (MiniProtocol mode initiatorCtx responderCtx bytes m a b
 -> MiniProtocolNum)
-> [MiniProtocol mode initiatorCtx responderCtx bytes m a b]
-> [MiniProtocolNum]
forall a b. (a -> b) -> [a] -> [b]
map MiniProtocol mode initiatorCtx responderCtx bytes m a b
-> MiniProtocolNum
forall (mode :: Mode) initiatorCtx responderCtx bytes (m :: * -> *)
       a b.
MiniProtocol mode initiatorCtx responderCtx bytes m a b
-> MiniProtocolNum
miniProtocolNum [MiniProtocol mode initiatorCtx responderCtx bytes m a b]
protocols