import Codec.Serialise (Serialise (..))
import qualified Data.ByteString.Lazy as LBS
+
import Data.Foldable (traverse_)
import Data.List (foldl')
import qualified Data.Map.Strict as Map
import Network.TypedProtocol.Core
import Network.TypedProtocol.Peer.Client (Client)
-
import Ouroboros.Network.Mux (ControlMessageSTM)
+
import Ouroboros.Network.Mux (ControlMessage (..), ControlMessageSTM)
import Ouroboros.Network.BlockFetch
import Ouroboros.Network.BlockFetch.Client
(TraceSendRecv (BlockFetch Block (Point Block))))
-> Maybe DiffTime -- ^ client's channel delay
-> Maybe DiffTime -- ^ server's channel delay
-> AnchoredFragment Block -- ^ Fixed current chain
-> [AnchoredFragment Block] -- ^ Fixed candidate chains
blockFetchExample1 decisionTracer clientStateTracer clientMsgTracer
currentChain candidateChains = do
+
controlMessageVar <- newTVarIO Continue
+
let controlMessageSTM = readTVar controlMessageVar
registry <- newFetchClientRegistry
blockHeap <- mkTestFetchedBlockHeap (anchoredChainPoints currentChain)
-- fetch thread before the peer threads.
_ <- waitAnyCancel $ [ fetchAsync, driverAsync ]
-
| (client, server, sync, ks) <- peerAsyncs
-
, peerAsync <- [client, server, sync, ks] ]
+
| (_, server, sync, ks) <- peerAsyncs
+
, peerAsync <- [server, sync, ks] ]
+
-- let the client side protocols terminate gracefully.
+
atomically $ writeTVar controlMessageVar Terminate
+
traverse_ (\(client,_,_,_) -> waitCatch client) peerAsyncs
serverMsgTracer = nullTracer
