ouroboros-network-framework: make runMiniProtocolCb & ExpandedInitiat…

…orContext strict
IntersectMBO · Jun 2, 2023 · eb63cda · eb63cda
1 parent 5db6560
commit eb63cda
Show file tree

Hide file tree

Showing 2 changed files with 7 additions and 6 deletions.
diff --git a/ouroboros-network-framework/src/Ouroboros/Network/Context.hs b/ouroboros-network-framework/src/Ouroboros/Network/Context.hs
@@ -19,9 +19,9 @@ import           Ouroboros.Network.ControlMessage
 -- | Context passed to initiator mini-protocol execution.
 --
 data ExpandedInitiatorContext addr m = ExpandedInitiatorContext {
-    eicConnectionId    :: ConnectionId addr,
-    eicControlMessage  :: ControlMessageSTM m,
-    eicIsBigLedgerPeer :: IsBigLedgerPeer
+    eicConnectionId    :: !(ConnectionId addr),
+    eicControlMessage  :: !(ControlMessageSTM m),
+    eicIsBigLedgerPeer :: !IsBigLedgerPeer
   }
 
 -- | A context passed to initiator mini-protocol execution for non-p2p

diff --git a/ouroboros-network-framework/src/Ouroboros/Network/Mux.hs b/ouroboros-network-framework/src/Ouroboros/Network/Mux.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE BangPatterns          #-}
 {-# LANGUAGE DataKinds             #-}
 {-# LANGUAGE DeriveFoldable        #-}
 {-# LANGUAGE DeriveFunctor         #-}
@@ -412,9 +413,9 @@ runMiniProtocolCb :: ( MonadAsync m
                   -> ctx
                   -> Mux.Channel m
                   -> m (a, Maybe LBS.ByteString)
-runMiniProtocolCb (MiniProtocolCb run)  ctx = run ctx . fromChannel
-runMiniProtocolCb (MuxPeer fn)          ctx = runMiniProtocolCb (mkMiniProtocolCbFromPeer fn) ctx
-runMiniProtocolCb (MuxPeerPipelined fn) ctx = runMiniProtocolCb (mkMiniProtocolCbFromPeerPipelined fn) ctx
+runMiniProtocolCb (MiniProtocolCb run)  !ctx = run ctx . fromChannel
+runMiniProtocolCb (MuxPeer fn)          !ctx = runMiniProtocolCb (mkMiniProtocolCbFromPeer fn) ctx
+runMiniProtocolCb (MuxPeerPipelined fn) !ctx = runMiniProtocolCb (mkMiniProtocolCbFromPeerPipelined fn) ctx
 
 contramapMiniProtocolCbCtx :: (ctx -> ctx')
                            -> MiniProtocolCb ctx' bytes m a