FIXUP: fix demos and framework sim-tests

Make demos and framework sim-tests compile.
IntersectMBO · Oct 17, 2024 · b681619 · b681619
1 parent 64b8292
commit b681619
Show file tree

Hide file tree

Showing 5 changed files with 12 additions and 7 deletions.
diff --git a/network-mux/demo/mux-demo.hs b/network-mux/demo/mux-demo.hs
@@ -133,7 +133,7 @@ serverWorker bearer = do
       putStrLn $ "Result: " ++ show result
       stopMux mux
 
-    runMux nullTracer mux bearer
+    runMux nullTracer 1 mux bearer
   where
     ptcls ::  MiniProtocolBundle ResponderMode
     ptcls = MiniProtocolBundle
@@ -193,7 +193,7 @@ clientWorker bearer n msg = do
       putStrLn $ "Result: " ++ show result
       stopMux mux
 
-    runMux nullTracer mux bearer
+    runMux nullTracer 0 mux bearer
   where
     ptcls :: MiniProtocolBundle InitiatorMode
     ptcls = MiniProtocolBundle

diff --git a/ouroboros-network-framework/demo/connection-manager.hs b/ouroboros-network-framework/demo/connection-manager.hs
@@ -37,6 +37,7 @@ import Control.Tracer (Tracer (..), contramap, nullTracer, traceWith)
 import Data.ByteString.Lazy (ByteString)
 import Data.Either (partitionEithers)
 import Data.Functor (($>))
+import Data.Hashable
 import Data.List.NonEmpty (NonEmpty (..))
 import Data.Typeable (Typeable)
 
@@ -77,6 +78,7 @@ import Ouroboros.Network.Server2 qualified as Server
 import Ouroboros.Network.Snocket (Snocket, socketSnocket)
 import Ouroboros.Network.Snocket qualified as Snocket
 import Ouroboros.Network.Util.ShowProxy
+import Ouroboros.Network.Socket
 
 
 instance ShowProxy (ReqResp req resp) where
@@ -173,7 +175,7 @@ withBidirectionalConnectionManager
     :: forall peerAddr socket m a.
        ( ConnectionManagerMonad m
 
-       , Ord peerAddr, Show peerAddr, Typeable peerAddr
+       , Ord peerAddr, Show peerAddr, Typeable peerAddr, Hashable peerAddr
 
        -- debugging
        , MonadFix m
@@ -438,6 +440,7 @@ bidirectionalExperiment
        , Show peerAddr
        , Typeable peerAddr
        , Eq peerAddr
+       , Hashable peerAddr
        )
     => Snocket IO socket peerAddr
     -> Mux.MakeBearer IO socket
@@ -618,7 +621,6 @@ optionParser =
             <> showDefault
             )
 
-
 run :: (Addr, Port)
     -> (Addr, Port)
     -> DiffTime -- ^ protocol idle timeout

diff --git a/ouroboros-network-framework/ouroboros-network-framework.cabal b/ouroboros-network-framework/ouroboros-network-framework.cabal
@@ -186,6 +186,7 @@ test-suite sim-tests
                      , cborg
                      , containers
                      , dns
+                     , hashable
                      , iproute
                      , network
                      , pretty-simple
@@ -329,6 +330,7 @@ executable demo-connection-manager
   main-is:             connection-manager.hs
   build-depends:       base >=4.14 && <4.21,
                        bytestring,
+                       hashable,
                        network,
                        optparse-applicative,
                        random,

diff --git a/ouroboros-network-framework/sim-tests/Test/Ouroboros/Network/Server2/Sim.hs b/ouroboros-network-framework/sim-tests/Test/Ouroboros/Network/Server2/Sim.hs
@@ -46,6 +46,7 @@ import Data.ByteString.Lazy (ByteString)
 import Data.Dynamic (fromDynamic)
 import Data.Foldable (foldMap')
 import Data.Functor (void, ($>), (<&>))
+import Data.Hashable
 import Data.List as List (delete, foldl', intercalate, nub, (\\))
 import Data.List.Trace qualified as Trace
 import Data.Map.Strict (Map)
@@ -625,7 +626,7 @@ multinodeExperiment
        , MonadTraceSTM m
        , MonadSay m
        , acc ~ [req], resp ~ [req]
-       , Ord peerAddr, Show peerAddr, Typeable peerAddr, Eq peerAddr
+       , Ord peerAddr, Show peerAddr, Typeable peerAddr, Eq peerAddr, Hashable peerAddr
        , Serialise req, Show req
        , Serialise resp, Show resp, Eq resp
        , Typeable req, Typeable resp

diff --git a/ouroboros-network-framework/sim-tests/Test/Simulation/Network/Snocket.hs b/ouroboros-network-framework/sim-tests/Test/Simulation/Network/Snocket.hs
@@ -271,7 +271,7 @@ clientServerSimulation payloads =
                     runMux (("server", connId,)
                              `contramap`
                              traceTime (Tracer (say . show)))
-                           mux bearer)
+                           0 mux bearer)
                 $ \_muxThread -> do
                   res <- atomically resSTM
                   say $ "SERVER HANDLER " ++ show res
@@ -316,7 +316,7 @@ clientServerSimulation payloads =
                         runMux (("client", connId,)
                                  `contramap`
                                  traceTime (Tracer (say . show)))
-                               mux bearer)
+                               1 mux bearer)
                     $ \_ -> do
                       res <- atomically resSTM
                       stopMux mux