Run Fourmolu

Author: Niols

ouroboros-consensus-diffusion/src/ouroboros-consensus-diffusion/Ouroboros/Consensus/Node/Tracers.hs

@@ -88,8 +88,10 @@ data Tracers' remotePeer localPeer blk f = Tracers
   , csjTracer ::
       f (TraceLabelPeer remotePeer (CSJumping.TraceEventCsj remotePeer blk))
   , dbfTracer :: f (CSJumping.TraceEventDbf remotePeer)
-  , perasCertDiffusionInboundTracer :: f (TraceLabelPeer remotePeer (TracePerasCertDiffusionInbound blk))
-  , perasCertDiffusionOutboundTracer :: f (TraceLabelPeer remotePeer (TracePerasCertDiffusionOutbound blk))
+  , perasCertDiffusionInboundTracer ::
+      f (TraceLabelPeer remotePeer (TracePerasCertDiffusionInbound blk))
+  , perasCertDiffusionOutboundTracer ::
+      f (TraceLabelPeer remotePeer (TracePerasCertDiffusionOutbound blk))
   }
 
 instance

ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/MiniProtocol/ObjectDiffusion/Inbound.hs

@@ -1,15 +1,15 @@
 {-# LANGUAGE BangPatterns #-}
 {-# LANGUAGE CPP #-}
 {-# LANGUAGE DataKinds #-}
+{-# LANGUAGE DeriveAnyClass #-}
 {-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE DerivingStrategies #-}
 {-# LANGUAGE GADTs #-}
 {-# LANGUAGE ImportQualifiedPost #-}
 {-# LANGUAGE KindSignatures #-}
 {-# LANGUAGE RecordWildCards #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# OPTIONS_GHC -Wno-partial-fields #-}
-{-# LANGUAGE DerivingStrategies #-}
-{-# LANGUAGE DeriveAnyClass #-}
 
 module Ouroboros.Consensus.MiniProtocol.ObjectDiffusion.Inbound
   ( objectDiffusionInbound
@@ -34,21 +34,21 @@ import Data.Sequence.Strict (StrictSeq)
 import Data.Sequence.Strict qualified as Seq
 import Data.Set (Set)
 import Data.Set qualified as Set
+import Data.Word (Word64)
 import GHC.Generics (Generic)
 import Network.TypedProtocol.Core (N (Z), Nat (..), natToInt)
 import NoThunks.Class (NoThunks (..), unsafeNoThunks)
 import Ouroboros.Consensus.MiniProtocol.ObjectDiffusion.ObjectPool.API
 import Ouroboros.Network.NodeToNode.Version (NodeToNodeVersion)
 import Ouroboros.Network.Protocol.ObjectDiffusion.Inbound
 import Ouroboros.Network.Protocol.ObjectDiffusion.Type
-import Data.Word (Word64)
 
 -- Note: This module is inspired from TxSubmission inbound side.
 
 newtype NumObjectsProcessed
   = NumObjectsProcessed
-    { getNumObjectsProcessed :: Word64
-    }
+  { getNumObjectsProcessed :: Word64
+  }
   deriving (Eq, Show)
 
 data TraceObjectDiffusionInbound objectId object
@@ -243,15 +243,15 @@ objectDiffusionInbound tracer (maxFifoLength, maxNumIdsToReq, maxNumObjectsToReq
         else do
           traceWith tracer (TraceObjectInboundCannotRequestMoreObjects (natToInt n))
           -- In this case we can theoretically only collect replies or request
-          -- new object IDs. 
+          -- new object IDs.
           --
           -- But it's important not to pipeline more requests for objectIds now
           -- because if we did, then immediately after sending the request (but
           -- having not yet received a response to either this or the other
-          -- pipelined requests), we would directly re-enter this code path, 
+          -- pipelined requests), we would directly re-enter this code path,
           -- resulting us in filling the pipeline with an unbounded number of
           -- requests.
-          -- 
+          --
           -- So we instead block until we collect a reply.
           pure $
             CollectPipelined

ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/MiniProtocol/ObjectDiffusion/PerasCert.hs

@@ -1,6 +1,5 @@
 -- | This module defines type aliases for the ObjectDiffusion protocol applied
 -- to PerasCert diffusion.
---
 module Ouroboros.Consensus.MiniProtocol.ObjectDiffusion.PerasCert
   ( TracePerasCertDiffusionInbound
   , TracePerasCertDiffusionOutbound

ouroboros-consensus/test/consensus-test/Test/Consensus/MiniProtocol/ObjectDiffusion/Smoke.hs

@@ -1,12 +1,12 @@
 {-# LANGUAGE DerivingVia #-}
 {-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE FunctionalDependencies #-}
 {-# LANGUAGE GADTs #-}
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
 {-# LANGUAGE KindSignatures #-}
 {-# LANGUAGE RankNTypes #-}
 {-# LANGUAGE ScopedTypeVariables #-}
-{-# LANGUAGE FlexibleInstances #-}
 
 -- | Smoke tests for the object diffusion protocol. This uses a trivial object
 -- pool and checks that a few objects can indeed be transferred from the
@@ -22,8 +22,8 @@ module Test.Consensus.MiniProtocol.ObjectDiffusion.Smoke
 import Control.Monad.IOSim (runSimStrictShutdown)
 import Control.ResourceRegistry (forkLinkedThread, waitAnyThread, withRegistry)
 import Control.Tracer (Tracer, nullTracer, traceWith)
-import Data.Functor.Contravariant (contramap)
 import Data.Containers.ListUtils (nubOrdOn)
+import Data.Functor.Contravariant (contramap)
 import Network.TypedProtocol.Channel (Channel, createConnectedChannels)
 import Network.TypedProtocol.Codec (AnyMessage)
 import Network.TypedProtocol.Driver.Simple (runPeer, runPipelinedPeer)
@@ -168,9 +168,9 @@ mkMockPoolInterfaces objects = do
 
 newtype ProtocolConstants
   = ProtocolConstants (NumObjectsOutstanding, NumObjectIdsReq, NumObjectsReq)
-  deriving (Show)
+  deriving Show
 
-instance Arbitrary ProtocolConstants
+instance Arbitrary ProtocolConstants where
   -- REVIEW: not sure about those constraints at all, and don't have the
   -- brainspace right now to reason about them
   arbitrary = do
@@ -179,17 +179,22 @@ instance Arbitrary ProtocolConstants
     maxObjectsToReq <- choose (2, maxIdsToReq)
     pure $
       ProtocolConstants
-        ( NumObjectsOutstanding maxFifoSize,
-          NumObjectIdsReq maxIdsToReq,
-          NumObjectsReq maxObjectsToReq
+        ( NumObjectsOutstanding maxFifoSize
+        , NumObjectIdsReq maxIdsToReq
+        , NumObjectsReq maxObjectsToReq
         )
 
 nodeToNodeVersion :: NodeToNodeVersion
 nodeToNodeVersion = NodeToNodeV_14
 
 prop_smoke_init_inbound :: ProtocolConstants -> ListWithUniqueIds SmokeObject idTy -> Property
 prop_smoke_init_inbound protocolConstants (ListWithUniqueIds objects) =
-  prop_smoke_object_diffusion protocolConstants objects runOutboundPeer runInboundPeer (mkMockPoolInterfaces objects)
+  prop_smoke_object_diffusion
+    protocolConstants
+    objects
+    runOutboundPeer
+    runInboundPeer
+    (mkMockPoolInterfaces objects)
  where
   runOutboundPeer outbound outboundChannel tracer =
     runPeer
@@ -207,9 +212,15 @@ prop_smoke_init_inbound protocolConstants (ListWithUniqueIds objects) =
       (objectDiffusionInboundClientPeerPipelined inbound)
       >> pure ()
 
-prop_smoke_init_outbound :: ProtocolConstants -> ListWithUniqueIds SmokeObject SmokeObjectId -> Property
+prop_smoke_init_outbound ::
+  ProtocolConstants -> ListWithUniqueIds SmokeObject SmokeObjectId -> Property
 prop_smoke_init_outbound protocolConstants (ListWithUniqueIds objects) =
-  prop_smoke_object_diffusion protocolConstants objects runOutboundPeer runInboundPeer (mkMockPoolInterfaces objects)
+  prop_smoke_object_diffusion
+    protocolConstants
+    objects
+    runOutboundPeer
+    runInboundPeer
+    (mkMockPoolInterfaces objects)
  where
   runOutboundPeer outbound outboundChannel tracer =
     runPeer
@@ -264,59 +275,61 @@ prop_smoke_object_diffusion ::
   Property
 prop_smoke_object_diffusion
   (ProtocolConstants (maxFifoSize, maxIdsToReq, maxObjectsToReq))
-  objects runOutboundPeer runInboundPeer mkPoolInterfaces
-  =
-  let
-    simulationResult = runSimStrictShutdown $ do
-      let tracer = nullTracer
-
-      traceWith tracer "========== [ Starting ObjectDiffusion smoke test ] =========="
-      traceWith tracer (show objects)
-
-      (outboundPoolReader, inboundPoolWriter, getAllInboundPoolContent) <- mkPoolInterfaces
-      controlMessage <- uncheckedNewTVarM Continue
-
-      let
-        inbound =
-          objectDiffusionInbound
-            tracer
-            ( maxFifoSize
-            , maxIdsToReq
-            , maxObjectsToReq
-            )
-            inboundPoolWriter
-            nodeToNodeVersion
-
-        outbound =
-          objectDiffusionOutbound
-            tracer
-            maxFifoSize
-            outboundPoolReader
-            nodeToNodeVersion
-            (readTVar controlMessage)
-
-      withRegistry $ \reg -> do
-        (outboundChannel, inboundChannel) <- createConnectedChannels
-        outboundThread <-
-          forkLinkedThread reg "ObjectDiffusion Outbound peer thread" $
-            runOutboundPeer outbound outboundChannel tracer
-        inboundThread <-
-          forkLinkedThread reg "ObjectDiffusion Inbound peer thread" $
-            runInboundPeer inbound inboundChannel tracer
-        controlMessageThread <- forkLinkedThread reg "ObjectDiffusion Control thread" $ do
-          threadDelay 1000 -- give a head start to the other threads
-          atomically $ writeTVar controlMessage Terminate
-          threadDelay 1000 -- wait for the other threads to finish
-        waitAnyThread [outboundThread, inboundThread, controlMessageThread]
-
-      traceWith tracer "========== [ ObjectDiffusion smoke test finished ] =========="
-      poolContent <- getAllInboundPoolContent
-
-      traceWith tracer "inboundPoolContent:"
-      traceWith tracer (show poolContent)
-      traceWith tracer "========== ======================================= =========="
-      pure poolContent
-   in
-    case simulationResult of
-      Right inboundPoolContent -> inboundPoolContent === objects
-      Left msg -> counterexample (show msg) $ property False
+  objects
+  runOutboundPeer
+  runInboundPeer
+  mkPoolInterfaces =
+    let
+      simulationResult = runSimStrictShutdown $ do
+        let tracer = nullTracer
+
+        traceWith tracer "========== [ Starting ObjectDiffusion smoke test ] =========="
+        traceWith tracer (show objects)
+
+        (outboundPoolReader, inboundPoolWriter, getAllInboundPoolContent) <- mkPoolInterfaces
+        controlMessage <- uncheckedNewTVarM Continue
+
+        let
+          inbound =
+            objectDiffusionInbound
+              tracer
+              ( maxFifoSize
+              , maxIdsToReq
+              , maxObjectsToReq
+              )
+              inboundPoolWriter
+              nodeToNodeVersion
+
+          outbound =
+            objectDiffusionOutbound
+              tracer
+              maxFifoSize
+              outboundPoolReader
+              nodeToNodeVersion
+              (readTVar controlMessage)
+
+        withRegistry $ \reg -> do
+          (outboundChannel, inboundChannel) <- createConnectedChannels
+          outboundThread <-
+            forkLinkedThread reg "ObjectDiffusion Outbound peer thread" $
+              runOutboundPeer outbound outboundChannel tracer
+          inboundThread <-
+            forkLinkedThread reg "ObjectDiffusion Inbound peer thread" $
+              runInboundPeer inbound inboundChannel tracer
+          controlMessageThread <- forkLinkedThread reg "ObjectDiffusion Control thread" $ do
+            threadDelay 1000 -- give a head start to the other threads
+            atomically $ writeTVar controlMessage Terminate
+            threadDelay 1000 -- wait for the other threads to finish
+          waitAnyThread [outboundThread, inboundThread, controlMessageThread]
+
+        traceWith tracer "========== [ ObjectDiffusion smoke test finished ] =========="
+        poolContent <- getAllInboundPoolContent
+
+        traceWith tracer "inboundPoolContent:"
+        traceWith tracer (show poolContent)
+        traceWith tracer "========== ======================================= =========="
+        pure poolContent
+     in
+      case simulationResult of
+        Right inboundPoolContent -> inboundPoolContent === objects
+        Left msg -> counterexample (show msg) $ property False