p2p-governor: introduce PeerStateActions

It's good to keep peer state changes callbacks in a seprate recrod, they will likely not change much as we go towards decentralisation.
IntersectMBO · Jan 26, 2021 · dac7d44 · dac7d44
1 parent 763f2c4
commit dac7d44
Show file tree

Hide file tree

Showing 6 changed files with 47 additions and 20 deletions.
diff --git a/ouroboros-network/src/Ouroboros/Network/PeerSelection/Governor.hs b/ouroboros-network/src/Ouroboros/Network/PeerSelection/Governor.hs
@@ -18,6 +18,7 @@ module Ouroboros.Network.PeerSelection.Governor (
     PeerSelectionPolicy(..),
     PeerSelectionTargets(..),
     PeerSelectionActions(..),
+    PeerStateActions(..),
     TracePeerSelection(..),
     DebugPeerSelection(..),
     peerSelectionGovernor,

diff --git a/ouroboros-network/src/Ouroboros/Network/PeerSelection/Governor/ActivePeers.hs b/ouroboros-network/src/Ouroboros/Network/PeerSelection/Governor/ActivePeers.hs
@@ -102,7 +102,7 @@ jobPromoteWarmPeer :: forall peeraddr peerconn m.
                    -> peeraddr
                    -> peerconn
                    -> Job m (Completion m peeraddr peerconn)
-jobPromoteWarmPeer PeerSelectionActions{activatePeerConnection}
+jobPromoteWarmPeer PeerSelectionActions{peerStateActions = PeerStateActions {activatePeerConnection}}
                    peeraddr peerconn =
     Job job handler "promoteWarmPeer"
   where
@@ -210,7 +210,7 @@ jobDemoteActivePeer :: forall peeraddr peerconn m.
                     -> peeraddr
                     -> peerconn
                     -> Job m (Completion m peeraddr peerconn)
-jobDemoteActivePeer PeerSelectionActions{deactivatePeerConnection}
+jobDemoteActivePeer PeerSelectionActions{peerStateActions = PeerStateActions {deactivatePeerConnection}}
                     peeraddr peerconn =
     Job job handler "demoteActivePeer"
   where

diff --git a/ouroboros-network/src/Ouroboros/Network/PeerSelection/Governor/EstablishedPeers.hs b/ouroboros-network/src/Ouroboros/Network/PeerSelection/Governor/EstablishedPeers.hs
@@ -107,7 +107,7 @@ jobPromoteColdPeer :: forall peeraddr peerconn m.
                    => PeerSelectionActions peeraddr peerconn m
                    -> peeraddr
                    -> Job m (Completion m peeraddr peerconn)
-jobPromoteColdPeer PeerSelectionActions{establishPeerConnection} peeraddr =
+jobPromoteColdPeer PeerSelectionActions{peerStateActions = PeerStateActions {establishPeerConnection}} peeraddr =
     Job job handler "promoteColdPeer"
   where
     handler :: SomeException -> Completion m peeraddr peerconn
@@ -228,7 +228,7 @@ jobDemoteEstablishedPeer :: forall peeraddr peerconn m.
                          -> peeraddr
                          -> peerconn
                          -> Job m (Completion m peeraddr peerconn)
-jobDemoteEstablishedPeer PeerSelectionActions{closePeerConnection}
+jobDemoteEstablishedPeer PeerSelectionActions{peerStateActions = PeerStateActions {closePeerConnection}}
                          peeraddr peerconn =
     Job job handler "demoteEstablishedPeer"
   where

diff --git a/ouroboros-network/src/Ouroboros/Network/PeerSelection/Governor/Monitor.hs b/ouroboros-network/src/Ouroboros/Network/PeerSelection/Governor/Monitor.hs
@@ -87,7 +87,7 @@ connections :: forall m peeraddr peerconn.
             => PeerSelectionActions peeraddr peerconn m
             -> PeerSelectionState peeraddr peerconn
             -> Guarded (STM m) (Decision m peeraddr peerconn)
-connections PeerSelectionActions{monitorPeerConnection}
+connections PeerSelectionActions{peerStateActions = PeerStateActions {monitorPeerConnection}}
             st@PeerSelectionState {
               activePeers,
               establishedPeers,

diff --git a/ouroboros-network/src/Ouroboros/Network/PeerSelection/Governor/Types.hs b/ouroboros-network/src/Ouroboros/Network/PeerSelection/Governor/Types.hs
@@ -163,14 +163,36 @@ data PeerSelectionActions peeraddr peerconn m = PeerSelectionActions {
        --
        requestPeerGossip :: peeraddr -> m [peeraddr],
 
-       establishPeerConnection  :: peeraddr -> m peerconn,
-       monitorPeerConnection    :: peerconn -> STM m PeerStatus,
-       activatePeerConnection   :: peerconn -> m (),
-       deactivatePeerConnection :: peerconn -> m (),
-       closePeerConnection      :: peerconn -> m ()
+       -- | Core actions run by the governor to change 'PeerStatus'.
+       --
+       peerStateActions :: PeerStateActions peeraddr peerconn m
      }
 
 
+-- | Callbacks which are performed to change peer state.
+--
+data PeerStateActions peeraddr peerconn m = PeerStateActions {
+    -- | Monitor peer state.
+    --
+    monitorPeerConnection    :: peerconn -> STM m PeerStatus,
+
+    -- | Establish new connection.
+    --
+    establishPeerConnection  :: peeraddr -> m peerconn,
+
+    -- | Activate a connection: warm to hot promotion.
+    --
+    activatePeerConnection   :: peerconn -> m (),
+
+    -- | Deactive a peer: hot to warm demotion.
+    --
+    deactivatePeerConnection :: peerconn -> m (),
+
+    -- | Close a connection: warm to cold transition.
+    --
+    closePeerConnection      :: peerconn -> m ()
+  }
+
 -----------------------
 -- Peer Selection State
 --

diff --git a/ouroboros-network/test/Ouroboros/Network/PeerSelection/Test.hs b/ouroboros-network/test/Ouroboros/Network/PeerSelection/Test.hs
@@ -238,11 +238,13 @@ mockPeerSelectionActions' tracer
       requestPublicRootPeers   = \_ -> return (publicRootPeers, 60),
       readPeerSelectionTargets = readTVar targetsVar,
       requestPeerGossip,
-      establishPeerConnection,
-      monitorPeerConnection,
-      activatePeerConnection,
-      deactivatePeerConnection,
-      closePeerConnection
+      peerStateActions         = PeerStateActions {
+          establishPeerConnection,
+          monitorPeerConnection,
+          activatePeerConnection,
+          deactivatePeerConnection,
+          closePeerConnection
+        }
     }
   where
     requestPeerGossip addr = do
@@ -1057,11 +1059,13 @@ _governorFindingPublicRoots targetNumberOfRootPeers domains =
                 readPeerSelectionTargets = return targets,
                 requestPeerGossip        = \_ -> return [],
                 requestPublicRootPeers   = \_ -> return (Set.empty, 0),
-                establishPeerConnection  = error "establishPeerConnection",
-                monitorPeerConnection    = error "monitorPeerConnection",
-                activatePeerConnection   = error "activatePeerConnection",
-                deactivatePeerConnection = error "deactivatePeerConnection",
-                closePeerConnection      = error "closePeerConnection"
+                peerStateActions         = PeerStateActions {
+                  establishPeerConnection  = error "establishPeerConnection",
+                  monitorPeerConnection    = error "monitorPeerConnection",
+                  activatePeerConnection   = error "activatePeerConnection",
+                  deactivatePeerConnection = error "deactivatePeerConnection",
+                  closePeerConnection      = error "closePeerConnection"
+                }
               }
 
     targets :: PeerSelectionTargets