peer-selection: use HasCallStack where pickPeers is used

IntersectMBO · Apr 16, 2024 · edc011a · edc011a
1 parent 42f9cc6
commit edc011a
Show file tree

Hide file tree

Showing 5 changed files with 22 additions and 13 deletions.
diff --git a/ouroboros-network/src/Ouroboros/Network/PeerSelection/Governor/ActivePeers.hs b/ouroboros-network/src/Ouroboros/Network/PeerSelection/Governor/ActivePeers.hs
@@ -12,6 +12,7 @@ import Data.Map.Strict (Map)
 import Data.Map.Strict qualified as Map
 import Data.Set (Set)
 import Data.Set qualified as Set
+import GHC.Stack (HasCallStack)
 
 import Control.Applicative (Alternative)
 import Control.Concurrent.JobPool (Job (..))
@@ -45,6 +46,7 @@ belowTarget :: forall peeraddr peerconn m.
                , MonadDelay m
                , MonadSTM m
                , Ord peeraddr
+               , HasCallStack
                )
             => PeerSelectionActions peeraddr peerconn m
             -> MkGuardedDecision peeraddr peerconn m
@@ -137,7 +139,7 @@ belowTargetBigLedgerPeers actions
 
 
 belowTargetLocal :: forall peeraddr peerconn m.
-                    (MonadDelay m, MonadSTM m, Ord peeraddr)
+                    (MonadDelay m, MonadSTM m, Ord peeraddr, HasCallStack)
                  => PeerSelectionActions peeraddr peerconn m
                  -> MkGuardedDecision peeraddr peerconn m
 belowTargetLocal actions
@@ -234,7 +236,8 @@ belowTargetLocal actions
       ]
 
 belowTargetOther :: forall peeraddr peerconn m.
-                    (MonadDelay m, MonadSTM m, Ord peeraddr)
+                    (MonadDelay m, MonadSTM m, Ord peeraddr,
+                     HasCallStack)
                  => PeerSelectionActions peeraddr peerconn m
                  -> MkGuardedDecision peeraddr peerconn m
 belowTargetOther actions
@@ -472,6 +475,7 @@ aboveTarget :: forall peeraddr peerconn m.
                ( Alternative (STM m)
                , MonadSTM m
                , Ord peeraddr
+               , HasCallStack
                )
             => PeerSelectionActions peeraddr peerconn m
             -> MkGuardedDecision peeraddr peerconn m
@@ -559,7 +563,7 @@ aboveTargetBigLedgerPeers actions
 
 
 aboveTargetLocal :: forall peeraddr peerconn m.
-                    (MonadSTM m, Ord peeraddr)
+                    (MonadSTM m, Ord peeraddr, HasCallStack)
                  => PeerSelectionActions peeraddr peerconn m
                  -> MkGuardedDecision peeraddr peerconn m
 aboveTargetLocal actions
@@ -639,7 +643,7 @@ aboveTargetLocal actions
 
 
 aboveTargetOther :: forall peeraddr peerconn m.
-                    (MonadSTM m, Ord peeraddr)
+                    (MonadSTM m, Ord peeraddr, HasCallStack)
                  => PeerSelectionActions peeraddr peerconn m
                  -> MkGuardedDecision peeraddr peerconn m
 aboveTargetOther actions

diff --git a/ouroboros-network/src/Ouroboros/Network/PeerSelection/Governor/BigLedgerPeers.hs b/ouroboros-network/src/Ouroboros/Network/PeerSelection/Governor/BigLedgerPeers.hs
@@ -10,6 +10,7 @@ module Ouroboros.Network.PeerSelection.Governor.BigLedgerPeers
 import Data.Map.Strict qualified as Map
 import Data.Set (Set)
 import Data.Set qualified as Set
+import GHC.Stack (HasCallStack)
 
 import Control.Applicative (Alternative)
 import Control.Concurrent.JobPool (Job (..))
@@ -172,7 +173,7 @@ jobReqBigLedgerPeers PeerSelectionActions{ requestPublicRootPeers }
 
 
 aboveTarget :: forall m peeraddr peerconn.
-               (Alternative (STM m), MonadSTM m, Ord peeraddr)
+               (Alternative (STM m), MonadSTM m, Ord peeraddr, HasCallStack)
             => MkGuardedDecision peeraddr peerconn m
 aboveTarget PeerSelectionPolicy {policyPickColdPeersToForget}
             st@PeerSelectionState {

diff --git a/ouroboros-network/src/Ouroboros/Network/PeerSelection/Governor/EstablishedPeers.hs b/ouroboros-network/src/Ouroboros/Network/PeerSelection/Governor/EstablishedPeers.hs
@@ -12,6 +12,7 @@ import Data.Map.Strict (Map)
 import Data.Map.Strict qualified as Map
 import Data.Set (Set)
 import Data.Set qualified as Set
+import GHC.Stack (HasCallStack)
 
 import Control.Applicative (Alternative)
 import Control.Concurrent.JobPool (Job (..))
@@ -69,7 +70,7 @@ belowTarget =  belowTargetBigLedgerPeers <> belowTargetLocal <> belowTargetOther
 -- configuration.
 --
 belowTargetLocal :: forall peeraddr peerconn m.
-                   (MonadSTM m, Ord peeraddr)
+                    (MonadSTM m, Ord peeraddr, HasCallStack)
                  => PeerSelectionActions peeraddr peerconn m
                  -> MkGuardedDecision peeraddr peerconn m
 belowTargetLocal actions
@@ -166,7 +167,7 @@ belowTargetLocal actions
 
 
 belowTargetOther :: forall peeraddr peerconn m.
-                    (MonadSTM m, Ord peeraddr)
+                    (MonadSTM m, Ord peeraddr, HasCallStack)
                  => PeerSelectionActions peeraddr peerconn m
                  -> MkGuardedDecision peeraddr peerconn m
 belowTargetOther actions
@@ -250,7 +251,7 @@ belowTargetOther actions
 -- state) then this monitoring action will be disabled.
 --
 belowTargetBigLedgerPeers :: forall peeraddr peerconn m.
-                             (MonadSTM m, Ord peeraddr)
+                             (MonadSTM m, Ord peeraddr, HasCallStack)
                           => PeerSelectionActions peeraddr peerconn m
                           -> MkGuardedDecision peeraddr peerconn m
 belowTargetBigLedgerPeers actions
@@ -497,7 +498,7 @@ aboveTarget :: forall peeraddr peerconn m.
 aboveTarget =  aboveTargetBigLedgerPeers <> aboveTargetOther
 
 aboveTargetOther :: forall peeraddr peerconn m.
-               (MonadSTM m, Ord peeraddr)
+               (MonadSTM m, Ord peeraddr, HasCallStack)
             => PeerSelectionActions peeraddr peerconn m
             -> MkGuardedDecision peeraddr peerconn m
 aboveTargetOther actions
@@ -582,7 +583,7 @@ aboveTargetOther actions
 
 
 aboveTargetBigLedgerPeers :: forall peeraddr peerconn m.
-                             (MonadSTM m, Ord peeraddr)
+                             (MonadSTM m, Ord peeraddr, HasCallStack)
                           => PeerSelectionActions peeraddr peerconn m
                           -> MkGuardedDecision peeraddr peerconn m
 aboveTargetBigLedgerPeers actions

diff --git a/ouroboros-network/src/Ouroboros/Network/PeerSelection/Governor/KnownPeers.hs b/ouroboros-network/src/Ouroboros/Network/PeerSelection/Governor/KnownPeers.hs
@@ -13,6 +13,7 @@ import Data.Hashable
 import Data.List (sortBy)
 import Data.Maybe (fromMaybe)
 import Data.Set qualified as Set
+import GHC.Stack (HasCallStack)
 import System.Random (random)
 
 import Control.Concurrent.JobPool (Job (..))
@@ -44,7 +45,8 @@ import Ouroboros.Network.Protocol.PeerSharing.Type (PeerSharingAmount)
 -- It should be noted if the node is in bootstrap mode (i.e. in a sensitive
 -- state) then this monitoring action will be disabled.
 --
-belowTarget :: (MonadAsync m, MonadTimer m, Ord peeraddr, Hashable peeraddr)
+belowTarget :: (MonadAsync m, MonadTimer m, Ord peeraddr, Hashable peeraddr,
+                HasCallStack)
             => PeerSelectionActions peeraddr peerconn m
             -> MkGuardedDecision peeraddr peerconn m
 belowTarget actions
@@ -356,7 +358,7 @@ jobPeerShare PeerSelectionActions{requestPeerShare}
 -- 'targetNumberOfRootPeers' (from combined sets of /local/ and /public root/
 -- peers). 'policyPickColdPeersToForget' policy is used to pick the peers.
 --
-aboveTarget :: (MonadSTM m, Ord peeraddr)
+aboveTarget :: (MonadSTM m, Ord peeraddr, HasCallStack)
             => MkGuardedDecision peeraddr peerconn m
 aboveTarget PeerSelectionPolicy {
               policyPickColdPeersToForget

diff --git a/ouroboros-network/src/Ouroboros/Network/PeerSelection/Governor/Types.hs b/ouroboros-network/src/Ouroboros/Network/PeerSelection/Governor/Types.hs
@@ -58,6 +58,7 @@ import Data.OrdPSQ qualified as PSQ
 import Data.Semigroup (Min (..))
 import Data.Set (Set)
 import Data.Set qualified as Set
+import GHC.Stack (HasCallStack)
 
 import Control.Applicative (Alternative)
 import Control.Concurrent.JobPool (Job)
@@ -1043,7 +1044,7 @@ establishedPeersStatus PeerSelectionState{establishedPeers, activePeers} =
 -- | Check pre-conditions and post-conditions on the pick policies,
 -- and supply additional peer attributes from the current state.
 --
-pickPeers :: (Ord peeraddr, Functor m)
+pickPeers :: (Ord peeraddr, Functor m, HasCallStack)
           => PeerSelectionState peeraddr peerconn
           -> PickPolicy peeraddr m
           -> Set peeraddr -> Int -> m (Set peeraddr)