Merge pull request #4792 from IntersectMBO/coot/cleanup

Codebase cleanup
IntersectMBO · Jan 29, 2024 · 3b67786 · 3b67786
2 parents 9dd0edb + 59283d9
commit 3b67786
Show file tree

Hide file tree

Showing 46 changed files with 34 additions and 164 deletions.
diff --git a/flake.lock b/flake.lock
diff --git a/flake.nix b/flake.nix
@@ -115,7 +115,7 @@
             }
             // lib.optionalAttrs (config.compiler-nix-name == defaultCompiler) {
               # tools that work only with default compiler
-              stylish-haskell = "0.14.5.0";
+              stylish-haskell = "0.14.6.0";
               haskell-language-server = "2.0.0.1";
             };
           # and from nixpkgs or other inputs

diff --git a/network-mux/src/Network/Mux/Bearer.hs b/network-mux/src/Network/Mux/Bearer.hs
@@ -1,11 +1,9 @@
 {-# LANGUAGE CPP                    #-}
 {-# LANGUAGE FlexibleInstances      #-}
-{-# LANGUAGE FunctionalDependencies #-}
 {-# LANGUAGE GADTs                  #-}
 {-# LANGUAGE MultiParamTypeClasses  #-}
 {-# LANGUAGE NumericUnderscores     #-}
 {-# LANGUAGE ScopedTypeVariables    #-}
-{-# LANGUAGE TypeApplications       #-}
 {-# LANGUAGE UndecidableInstances   #-}
 
 module Network.Mux.Bearer

diff --git a/network-mux/src/Network/Mux/Bearer/AttenuatedChannel.hs b/network-mux/src/Network/Mux/Bearer/AttenuatedChannel.hs
@@ -267,7 +267,7 @@ attenuationChannelAsMuxBearer sduSize sduTimeout muxTracer chan =
   where
     readMux :: TimeoutFn m -> m (MuxSDU, Time)
     readMux timeoutFn = do
-      traceWith muxTracer $ MuxTraceRecvHeaderStart
+      traceWith muxTracer MuxTraceRecvHeaderStart
       mbuf <- timeoutFn sduTimeout $ acRead chan
       case mbuf of
         Nothing -> do
@@ -294,7 +294,7 @@ attenuationChannelAsMuxBearer sduSize sduTimeout muxTracer chan =
       traceWith muxTracer $ MuxTraceSendStart (msHeader sdu')
       acWrite chan buf
 
-      traceWith muxTracer $ MuxTraceSendEnd
+      traceWith muxTracer MuxTraceSendEnd
       return ts
 
 --

diff --git a/network-mux/src/Network/Mux/Bearer/Pipe.hs b/network-mux/src/Network/Mux/Bearer/Pipe.hs
@@ -82,7 +82,7 @@ pipeAsMuxBearer sduSize tracer channel =
     where
       readPipe :: Mx.TimeoutFn IO -> IO (Mx.MuxSDU, Time)
       readPipe _ = do
-          traceWith tracer $ Mx.MuxTraceRecvHeaderStart
+          traceWith tracer Mx.MuxTraceRecvHeaderStart
           hbuf <- recvLen' 8 []
           case Mx.decodeMuxSDU hbuf of
               Left e -> throwIO e
@@ -114,6 +114,6 @@ pipeAsMuxBearer sduSize tracer channel =
           traceWith tracer $ Mx.MuxTraceSendStart (Mx.msHeader sdu')
           writeHandle channel buf
             `catch` Mx.handleIOException "writeHandle errored"
-          traceWith tracer $ Mx.MuxTraceSendEnd
+          traceWith tracer Mx.MuxTraceSendEnd
           return ts
 
diff --git a/network-mux/src/Network/Mux/Bearer/Queues.hs b/network-mux/src/Network/Mux/Bearer/Queues.hs
@@ -47,7 +47,7 @@ queueChannelAsMuxBearer sduSize tracer QueueChannel { writeQueue, readQueue } =
     where
       readMux :: Mx.TimeoutFn m -> m (Mx.MuxSDU, Time)
       readMux _ = do
-          traceWith tracer $ Mx.MuxTraceRecvHeaderStart
+          traceWith tracer Mx.MuxTraceRecvHeaderStart
           buf <- atomically $ readTBQueue readQueue
           let (hbuf, payload) = BL.splitAt 8 buf
           case Mx.decodeMuxSDU hbuf of
@@ -66,6 +66,6 @@ queueChannelAsMuxBearer sduSize tracer QueueChannel { writeQueue, readQueue } =
               buf  = Mx.encodeMuxSDU sdu'
           traceWith tracer $ Mx.MuxTraceSendStart (Mx.msHeader sdu')
           atomically $ writeTBQueue writeQueue buf
-          traceWith tracer $ Mx.MuxTraceSendEnd
+          traceWith tracer Mx.MuxTraceSendEnd
           return ts
 
diff --git a/network-mux/src/Network/Mux/Bearer/Socket.hs b/network-mux/src/Network/Mux/Bearer/Socket.hs
@@ -60,7 +60,7 @@ socketAsMuxBearer sduSize sduTimeout tracer sd =
 
       readSocket :: Mx.TimeoutFn IO -> IO (Mx.MuxSDU, Time)
       readSocket timeout = do
-          traceWith tracer $ Mx.MuxTraceRecvHeaderStart
+          traceWith tracer Mx.MuxTraceRecvHeaderStart
 
           -- Wait for the first part of the header without any timeout
           h0 <- recvAtMost True hdrLenght
@@ -69,7 +69,7 @@ socketAsMuxBearer sduSize sduTimeout tracer sd =
           r_m <- timeout sduTimeout $ recvRem h0
           case r_m of
                 Nothing -> do
-                    traceWith tracer $ Mx.MuxTraceSDUReadTimeoutException
+                    traceWith tracer Mx.MuxTraceSDUReadTimeoutException
                     throwIO $ Mx.MuxError Mx.MuxSDUReadTimeout "Mux SDU Timeout"
                 Just r -> return r
 
@@ -104,7 +104,7 @@ socketAsMuxBearer sduSize sduTimeout tracer sd =
                     `catch` Mx.handleIOException "recv errored"
           if BL.null buf
               then do
-                  when (waitingOnNxtHeader) $
+                  when waitingOnNxtHeader $
                       {- This may not be an error, but could be an orderly shutdown.
                        - We wait 1 seconds to give the mux protocols time to perform
                        - a clean up and exit.
@@ -133,10 +133,10 @@ socketAsMuxBearer sduSize sduTimeout tracer sd =
               `catch` Mx.handleIOException "sendAll errored"
           case r of
                Nothing -> do
-                    traceWith tracer $ Mx.MuxTraceSDUWriteTimeoutException
+                    traceWith tracer Mx.MuxTraceSDUWriteTimeoutException
                     throwIO $ Mx.MuxError Mx.MuxSDUWriteTimeout "Mux SDU Timeout"
                Just _ -> do
-                   traceWith tracer $ Mx.MuxTraceSendEnd
+                   traceWith tracer Mx.MuxTraceSendEnd
 #if defined(linux_HOST_OS) && defined(MUX_TRACE_TCPINFO)
                    -- If it was possible to detect if the MuxTraceTCPInfo was
                    -- enable we wouldn't have to hide the getSockOpt

diff --git a/network-mux/src/Network/Mux/Compat.hs b/network-mux/src/Network/Mux/Compat.hs
@@ -2,7 +2,6 @@
 {-# LANGUAGE ExistentialQuantification #-}
 {-# LANGUAGE FlexibleContexts          #-}
 {-# LANGUAGE GADTSyntax                #-}
-{-# LANGUAGE KindSignatures            #-}
 {-# LANGUAGE NamedFieldPuns            #-}
 {-# LANGUAGE RankNTypes                #-}
 {-# LANGUAGE ScopedTypeVariables       #-}

diff --git a/network-mux/src/Network/Mux/Trace.hs b/network-mux/src/Network/Mux/Trace.hs
@@ -1,11 +1,9 @@
 {-# LANGUAGE CPP                       #-}
 {-# LANGUAGE DeriveFunctor             #-}
 {-# LANGUAGE DeriveGeneric             #-}
-{-# LANGUAGE DerivingStrategies        #-}
 {-# LANGUAGE DerivingVia               #-}
 {-# LANGUAGE ExistentialQuantification #-}
 {-# LANGUAGE NamedFieldPuns            #-}
-{-# LANGUAGE StandaloneDeriving        #-}
 
 module Network.Mux.Trace
   ( MuxError (..)

diff --git a/network-mux/src/Network/Mux/Types.hs b/network-mux/src/Network/Mux/Types.hs
@@ -3,7 +3,6 @@
 {-# LANGUAGE DerivingVia                #-}
 {-# LANGUAGE GADTs                      #-}
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
-{-# LANGUAGE KindSignatures             #-}
 {-# LANGUAGE NamedFieldPuns             #-}
 {-# LANGUAGE RankNTypes                 #-}
 {-# LANGUAGE ScopedTypeVariables        #-}

diff --git a/ouroboros-network-framework/src/Ouroboros/Network/Mux.hs b/ouroboros-network-framework/src/Ouroboros/Network/Mux.hs
@@ -1,7 +1,5 @@
 {-# LANGUAGE BangPatterns          #-}
 {-# LANGUAGE DataKinds             #-}
-{-# LANGUAGE DeriveFoldable        #-}
-{-# LANGUAGE DeriveFunctor         #-}
 {-# LANGUAGE DeriveTraversable     #-}
 {-# LANGUAGE ExplicitNamespaces    #-}
 {-# LANGUAGE FlexibleContexts      #-}

diff --git a/ouroboros-network-framework/src/Ouroboros/Network/Socket.hs b/ouroboros-network-framework/src/Ouroboros/Network/Socket.hs
@@ -1,12 +1,10 @@
 {-# LANGUAGE CPP                 #-}
 {-# LANGUAGE DataKinds           #-}
-{-# LANGUAGE DeriveGeneric       #-}
 {-# LANGUAGE DerivingVia         #-}
 {-# LANGUAGE FlexibleContexts    #-}
 {-# LANGUAGE GADTs               #-}
 {-# LANGUAGE NamedFieldPuns      #-}
 {-# LANGUAGE RankNTypes          #-}
-{-# LANGUAGE RecordWildCards     #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TypeApplications    #-}
 {-# LANGUAGE TypeOperators       #-}

diff --git a/ouroboros-network-protocols/src/Ouroboros/Network/Protocol/BlockFetch/Client.hs b/ouroboros-network-protocols/src/Ouroboros/Network/Protocol/BlockFetch/Client.hs
@@ -4,6 +4,7 @@
 {-# LANGUAGE NamedFieldPuns      #-}
 {-# LANGUAGE PolyKinds           #-}
 {-# LANGUAGE ScopedTypeVariables #-}
+
 module Ouroboros.Network.Protocol.BlockFetch.Client where
 
 import           Network.TypedProtocol.Core

diff --git a/ouroboros-network-protocols/src/Ouroboros/Network/Protocol/BlockFetch/Codec.hs b/ouroboros-network-protocols/src/Ouroboros/Network/Protocol/BlockFetch/Codec.hs
@@ -125,7 +125,7 @@ codecBlockFetchId
      Monad m
   => Codec (BlockFetch block point) CodecFailure m
            (AnyMessage (BlockFetch block point))
-codecBlockFetchId = Codec encode decode
+codecBlockFetchId = Codec { encode, decode }
  where
   encode :: forall (pr :: PeerRole) st st'.
             PeerHasAgency pr st

diff --git a/ouroboros-network-protocols/src/Ouroboros/Network/Protocol/BlockFetch/Server.hs b/ouroboros-network-protocols/src/Ouroboros/Network/Protocol/BlockFetch/Server.hs
@@ -1,6 +1,7 @@
 {-# LANGUAGE DataKinds           #-}
 {-# LANGUAGE GADTs               #-}
 {-# LANGUAGE ScopedTypeVariables #-}
+
 module Ouroboros.Network.Protocol.BlockFetch.Server where
 
 import           Network.TypedProtocol.Core (Peer (..), PeerHasAgency (..),

diff --git a/ouroboros-network-protocols/src/Ouroboros/Network/Protocol/BlockFetch/Type.hs b/ouroboros-network-protocols/src/Ouroboros/Network/Protocol/BlockFetch/Type.hs
@@ -1,6 +1,5 @@
 {-# LANGUAGE DataKinds             #-}
 {-# LANGUAGE EmptyCase             #-}
-{-# LANGUAGE ExplicitForAll        #-}
 {-# LANGUAGE FlexibleInstances     #-}
 {-# LANGUAGE GADTs                 #-}
 {-# LANGUAGE InstanceSigs          #-}

diff --git a/ouroboros-network-protocols/src/Ouroboros/Network/Protocol/ChainSync/Codec.hs b/ouroboros-network-protocols/src/Ouroboros/Network/Protocol/ChainSync/Codec.hs
@@ -216,7 +216,7 @@ decodeList dec = do
 codecChainSyncId :: forall header point tip m. Monad m
                  => Codec (ChainSync header point tip)
                           CodecFailure m (AnyMessage (ChainSync header point tip))
-codecChainSyncId = Codec encode decode
+codecChainSyncId = Codec { encode, decode }
  where
   encode :: forall (pr :: PeerRole) st st'.
             PeerHasAgency pr st

diff --git a/ouroboros-network-protocols/src/Ouroboros/Network/Protocol/KeepAlive/Codec.hs b/ouroboros-network-protocols/src/Ouroboros/Network/Protocol/KeepAlive/Codec.hs
@@ -1,6 +1,5 @@
 {-# LANGUAGE DataKinds           #-}
 {-# LANGUAGE GADTs               #-}
-{-# LANGUAGE KindSignatures      #-}
 {-# LANGUAGE NamedFieldPuns      #-}
 {-# LANGUAGE PolyKinds           #-}
 {-# LANGUAGE RankNTypes          #-}

diff --git a/ouroboros-network-protocols/src/Ouroboros/Network/Protocol/LocalStateQuery/Codec.hs b/ouroboros-network-protocols/src/Ouroboros/Network/Protocol/LocalStateQuery/Codec.hs
@@ -211,7 +211,7 @@ codecLocalStateQueryId
            CodecFailure m
            (AnyMessage (LocalStateQuery block point query))
 codecLocalStateQueryId eqQuery =
-  Codec encode decode
+  Codec { encode, decode }
  where
   encode :: forall (pr :: PeerRole) st st'.
             PeerHasAgency pr st

diff --git a/ouroboros-network-protocols/src/Ouroboros/Network/Protocol/LocalStateQuery/Server.hs b/ouroboros-network-protocols/src/Ouroboros/Network/Protocol/LocalStateQuery/Server.hs
@@ -4,6 +4,7 @@
 {-# LANGUAGE NamedFieldPuns      #-}
 {-# LANGUAGE RankNTypes          #-}
 {-# LANGUAGE ScopedTypeVariables #-}
+
 module Ouroboros.Network.Protocol.LocalStateQuery.Server
   ( -- * Protocol type for the server
     -- | The protocol states from the point of view of the server.

diff --git a/ouroboros-network-protocols/src/Ouroboros/Network/Protocol/LocalStateQuery/Type.hs b/ouroboros-network-protocols/src/Ouroboros/Network/Protocol/LocalStateQuery/Type.hs
@@ -1,6 +1,4 @@
 {-# LANGUAGE DataKinds             #-}
-{-# LANGUAGE DeriveFoldable        #-}
-{-# LANGUAGE DeriveFunctor         #-}
 {-# LANGUAGE DeriveGeneric         #-}
 {-# LANGUAGE DeriveTraversable     #-}
 {-# LANGUAGE EmptyCase             #-}

diff --git a/ouroboros-network-protocols/src/Ouroboros/Network/Protocol/LocalTxMonitor/Codec.hs b/ouroboros-network-protocols/src/Ouroboros/Network/Protocol/LocalTxMonitor/Codec.hs
@@ -155,7 +155,7 @@ codecLocalTxMonitorId ::
      )
   => Codec ptcl CodecFailure m (AnyMessage ptcl)
 codecLocalTxMonitorId =
-    Codec encode decode
+    Codec { encode, decode }
   where
     encode ::
          forall (pr :: PeerRole) st st'. ()

diff --git a/ouroboros-network-protocols/src/Ouroboros/Network/Protocol/LocalTxSubmission/Client.hs b/ouroboros-network-protocols/src/Ouroboros/Network/Protocol/LocalTxSubmission/Client.hs
@@ -1,11 +1,8 @@
 {-# LANGUAGE DataKinds           #-}
 {-# LANGUAGE GADTs               #-}
-{-# LANGUAGE NamedFieldPuns      #-}
 {-# LANGUAGE RankNTypes          #-}
-{-# LANGUAGE RecordWildCards     #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 
-
 -- | A view of the transaction submission protocol from the point of view of
 -- the client.
 --

diff --git a/ouroboros-network-protocols/src/Ouroboros/Network/Protocol/LocalTxSubmission/Codec.hs b/ouroboros-network-protocols/src/Ouroboros/Network/Protocol/LocalTxSubmission/Codec.hs
@@ -88,7 +88,7 @@ codecLocalTxSubmissionId
             CodecFailure m
            (AnyMessage (LocalTxSubmission tx reject))
 codecLocalTxSubmissionId =
-    Codec encode decode
+    Codec { encode, decode }
   where
     encode :: forall (pr :: PeerRole) st st'.
               PeerHasAgency pr st

diff --git a/ouroboros-network-protocols/src/Ouroboros/Network/Protocol/PeerSharing/Client.hs b/ouroboros-network-protocols/src/Ouroboros/Network/Protocol/PeerSharing/Client.hs
@@ -35,4 +35,4 @@ peerSharingClientPeer (SendMsgShareRequest amount k) =
 peerSharingClientPeer (SendMsgDone result) =
     -- Perform some finishing action
     -- Perform a transition to the 'StDone' state
-    Effect $ (Yield (ClientAgency TokIdle) MsgDone . Done TokDone) <$> result
+    Effect $ Yield (ClientAgency TokIdle) MsgDone . Done TokDone <$> result
diff --git a/ouroboros-network-protocols/src/Ouroboros/Network/Protocol/PeerSharing/Type.hs b/ouroboros-network-protocols/src/Ouroboros/Network/Protocol/PeerSharing/Type.hs
@@ -7,7 +7,6 @@
 {-# LANGUAGE PolyKinds           #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE StandaloneDeriving  #-}
-{-# LANGUAGE TypeApplications    #-}
 {-# LANGUAGE TypeFamilies        #-}
 
 module Ouroboros.Network.Protocol.PeerSharing.Type where

diff --git a/ouroboros-network-protocols/src/Ouroboros/Network/Protocol/TxSubmission2/Client.hs b/ouroboros-network-protocols/src/Ouroboros/Network/Protocol/TxSubmission2/Client.hs
@@ -2,7 +2,6 @@
 {-# LANGUAGE GADTs               #-}
 {-# LANGUAGE NamedFieldPuns      #-}
 {-# LANGUAGE RankNTypes          #-}
-{-# LANGUAGE RecordWildCards     #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 
 -- | A view of the transaction submission protocol from the point of view of

diff --git a/ouroboros-network-protocols/src/Ouroboros/Network/Protocol/TxSubmission2/Codec.hs b/ouroboros-network-protocols/src/Ouroboros/Network/Protocol/TxSubmission2/Codec.hs
@@ -224,7 +224,7 @@ decodeTxSubmission2 decodeTxId decodeTx = decode
 codecTxSubmission2Id
   :: forall txid tx m. Monad m
   => Codec (TxSubmission2 txid tx) CodecFailure m (AnyMessage (TxSubmission2 txid tx))
-codecTxSubmission2Id = Codec encode decode
+codecTxSubmission2Id = Codec { encode, decode }
  where
   encode :: forall (pr :: PeerRole) st st'.
             PeerHasAgency pr st

diff --git a/ouroboros-network-protocols/src/Ouroboros/Network/Protocol/TxSubmission2/Hello/Codec.hs b/ouroboros-network-protocols/src/Ouroboros/Network/Protocol/TxSubmission2/Hello/Codec.hs