Skip to content

Commit

Permalink
Integration of eclipse-evasion
Browse files Browse the repository at this point in the history
  • Loading branch information
@coot
coot committed May 31, 2023
1 parent 3d13e4d commit ecaa89e
Show file tree
Hide file tree
Showing 18 changed files with 586 additions and 164 deletions.
53 changes: 33 additions & 20 deletions bench/tx-generator/src/Cardano/Benchmarking/GeneratorTx/NodeToNode.hs
View file
@@ -1,4 +1,5 @@
{-# LANGUAGE GADTs #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE PackageImports #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
Expand All @@ -16,9 +17,11 @@ import Prelude
import Codec.Serialise (DeserialiseFailure)
import Control.Concurrent.Class.MonadSTM.Strict (newTVarIO)
import Control.Monad.Class.MonadTimer (MonadTimer, threadDelay)
import Data.Foldable (fold)
import Data.ByteString.Lazy (ByteString)
import qualified Data.Map.Strict as Map
import Data.Proxy (Proxy (..))
import Data.Void (Void)
import Network.Socket (AddrInfo (..))
import System.Random (newStdGen)

Expand All @@ -32,14 +35,15 @@ import Ouroboros.Consensus.Node.NetworkProtocolVersion
import Ouroboros.Consensus.Node.Run (RunNode)
import Ouroboros.Consensus.Shelley.Eras (StandardCrypto)

import Ouroboros.Network.Context
import Ouroboros.Network.Channel (Channel (..))
import Ouroboros.Network.ControlMessage (continueForever)
import Ouroboros.Network.DeltaQ (defaultGSV)
import Ouroboros.Network.Driver (runPeerWithLimits)
import Ouroboros.Network.Driver (runPeer, runPeerWithLimits)
import Ouroboros.Network.KeepAlive
import Ouroboros.Network.Magic
import Ouroboros.Network.Mux (MuxPeer (..), OuroborosApplication (..), OuroborosBundle,
RunMiniProtocol (..))
import Ouroboros.Network.Mux (MiniProtocolCb (..), OuroborosApplication (..), OuroborosBundle,
RunMiniProtocol (..), MuxMode (..))
import Ouroboros.Network.NodeToClient (IOManager, chainSyncPeerNull)
import Ouroboros.Network.NodeToNode (NetworkConnectTracers (..))
import qualified Ouroboros.Network.NodeToNode as NtN
Expand Down Expand Up @@ -86,11 +90,10 @@ benchmarkConnectTxSubmit ioManager handshakeTracer submissionTracer codecConfig
(addrAddress remoteAddr)
where
ownPeerSharing = NoPeerSharing
mkApp :: OuroborosBundle mode addr bs m a b
-> OuroborosApplication mode addr bs m a b
mkApp :: OuroborosBundle mode initiatorCtx responderCtx bs m a b
-> OuroborosApplication mode initiatorCtx responderCtx bs m a b
mkApp bundle =
OuroborosApplication $ \connId controlMessageSTM ->
foldMap (\p -> p connId controlMessageSTM) bundle
OuroborosApplication $ fold bundle

n2nVer :: NodeToNodeVersion
n2nVer = NodeToNodeV_10
Expand All @@ -102,6 +105,13 @@ benchmarkConnectTxSubmit ioManager handshakeTracer submissionTracer codecConfig
ByteString ByteString ByteString ByteString ByteString ByteString
ByteString
myCodecs = defaultCodecs codecConfig blkN2nVer encodeRemoteAddress decodeRemoteAddress n2nVer
peerMultiplex :: NtN.Versions NodeToNodeVersion
NtN.NodeToNodeVersionData
(OuroborosApplication
'InitiatorMode
(MinimalInitiatorContext NtN.RemoteAddress)
(ResponderContext NtN.RemoteAddress)
ByteString IO () Void)
peerMultiplex =
simpleSingletonVersions
n2nVer
Expand All @@ -112,32 +122,35 @@ benchmarkConnectTxSubmit ioManager handshakeTracer submissionTracer codecConfig
, NtN.query = False
}) $
mkApp $
NtN.nodeToNodeProtocols NtN.defaultMiniProtocolParameters ( \them _ ->
NtN.nodeToNodeProtocols NtN.defaultMiniProtocolParameters
NtN.NodeToNodeProtocols
{ NtN.chainSyncProtocol = InitiatorProtocolOnly $
MuxPeer
{ NtN.chainSyncProtocol = InitiatorProtocolOnly $ MiniProtocolCb $ \_ctx channel ->
runPeer
nullTracer
(cChainSyncCodec myCodecs)
channel
chainSyncPeerNull
, NtN.blockFetchProtocol = InitiatorProtocolOnly $
MuxPeer
, NtN.blockFetchProtocol = InitiatorProtocolOnly $ MiniProtocolCb $ \_ctx channel ->
runPeer
nullTracer
(cBlockFetchCodec myCodecs)
channel
(blockFetchClientPeer blockFetchClientNull)
, NtN.keepAliveProtocol = InitiatorProtocolOnly $
MuxPeerRaw
(kaClient n2nVer them)
, NtN.txSubmissionProtocol = InitiatorProtocolOnly $
MuxPeer
, NtN.keepAliveProtocol = InitiatorProtocolOnly $ MiniProtocolCb $ \ctx channel ->
kaClient n2nVer (remoteAddress $ micConnectionId ctx) channel
, NtN.txSubmissionProtocol = InitiatorProtocolOnly $ MiniProtocolCb $ \_ctx channel ->
runPeer
submissionTracer
(cTxSubmission2Codec myCodecs)
channel
(txSubmissionClientPeer myTxSubClient)
, NtN.peerSharingProtocol = InitiatorProtocolOnly $
MuxPeer
, NtN.peerSharingProtocol = InitiatorProtocolOnly $ MiniProtocolCb $ \_ctx channel ->
runPeer
nullTracer
(cPeerSharingCodec myCodecs)
channel
(peerSharingClientPeer peerSharingClientNull)
} )
}
n2nVer
ownPeerSharing
-- Stolen from: Ouroboros/Consensus/Network/NodeToNode.hs
Expand Down
4 changes: 2 additions & 2 deletions cabal.project
View file
Expand Up @@ -109,6 +109,6 @@ package snap-server

source-repository-package
type: git
location: https://github.com/GaloisInc/ekg-forward
tag: 9c58cef6b476cbf6b86e656eb2fc8f96301f4df9
location: https://github.com/input-output-hk/ekg-forward
tag: 61d6e739ce7015a44cf8acecb64528cd87a962ad
--sha256: caae341a02e1908454b2f0f5c86a07774550cd3912a0fd2e6f2bb64bfac46fa9
35 changes: 31 additions & 4 deletions cardano-node/src/Cardano/Node/Configuration/POM.hs
View file
Expand Up @@ -138,6 +138,9 @@ data NodeConfiguration
, ncTargetNumberOfKnownPeers :: Int
, ncTargetNumberOfEstablishedPeers :: Int
, ncTargetNumberOfActivePeers :: Int
, ncTargetNumberOfKnownBigLedgerPeers :: Int
, ncTargetNumberOfEstablishedBigLedgerPeers :: Int
, ncTargetNumberOfActiveBigLedgerPeers :: Int

-- Enable experimental P2P mode
, ncEnableP2P :: SomeNetworkP2PMode
Expand Down Expand Up @@ -193,6 +196,9 @@ data PartialNodeConfiguration
, pncTargetNumberOfKnownPeers :: !(Last Int)
, pncTargetNumberOfEstablishedPeers :: !(Last Int)
, pncTargetNumberOfActivePeers :: !(Last Int)
, pncTargetNumberOfKnownBigLedgerPeers :: !(Last Int)
, pncTargetNumberOfEstablishedBigLedgerPeers :: !(Last Int)
, pncTargetNumberOfActiveBigLedgerPeers :: !(Last Int)

-- Enable experimental P2P mode
, pncEnableP2P :: !(Last NetworkP2PMode)
Expand Down Expand Up @@ -279,6 +285,9 @@ instance FromJSON PartialNodeConfiguration where
pncTargetNumberOfKnownPeers <- Last <$> v .:? "TargetNumberOfKnownPeers"
pncTargetNumberOfEstablishedPeers <- Last <$> v .:? "TargetNumberOfEstablishedPeers"
pncTargetNumberOfActivePeers <- Last <$> v .:? "TargetNumberOfActivePeers"
pncTargetNumberOfKnownBigLedgerPeers <- Last <$> v .:? "TargetNumberOfKnownBigLedgerPeers"
pncTargetNumberOfEstablishedBigLedgerPeers <- Last <$> v .:? "TargetNumberOfEstablishedBigLedgerPeers"
pncTargetNumberOfActiveBigLedgerPeers <- Last <$> v .:? "TargetNumberOfActiveBigLedgerPeers"

-- Enable P2P switch
p2pSwitch <- v .:? "EnableP2P" .!= Just False
Expand Down Expand Up @@ -318,6 +327,9 @@ instance FromJSON PartialNodeConfiguration where
, pncTargetNumberOfKnownPeers
, pncTargetNumberOfEstablishedPeers
, pncTargetNumberOfActivePeers
, pncTargetNumberOfKnownBigLedgerPeers
, pncTargetNumberOfEstablishedBigLedgerPeers
, pncTargetNumberOfActiveBigLedgerPeers
, pncEnableP2P
, pncPeerSharing
}
Expand Down Expand Up @@ -489,10 +501,13 @@ defaultPartialNodeConfiguration =
, acceptedConnectionsSoftLimit = 384
, acceptedConnectionsDelay = 5
}
, pncTargetNumberOfRootPeers = Last (Just 100)
, pncTargetNumberOfKnownPeers = Last (Just 100)
, pncTargetNumberOfEstablishedPeers = Last (Just 50)
, pncTargetNumberOfActivePeers = Last (Just 20)
, pncTargetNumberOfRootPeers = Last (Just 85)
, pncTargetNumberOfKnownPeers = Last (Just 85)
, pncTargetNumberOfEstablishedPeers = Last (Just 40)
, pncTargetNumberOfActivePeers = Last (Just 15)
, pncTargetNumberOfKnownBigLedgerPeers = Last (Just 10)
, pncTargetNumberOfEstablishedBigLedgerPeers = Last (Just 8)
, pncTargetNumberOfActiveBigLedgerPeers = Last (Just 5)
, pncEnableP2P = Last (Just DisabledP2PMode)
, pncPeerSharing = Last (Just NoPeerSharing)
}
Expand Down Expand Up @@ -527,6 +542,15 @@ makeNodeConfiguration pnc = do
ncTargetNumberOfActivePeers <-
lastToEither "Missing TargetNumberOfActivePeers"
$ pncTargetNumberOfActivePeers pnc
ncTargetNumberOfKnownBigLedgerPeers <-
lastToEither "Missing TargetNumberOfKnownBigLedgerPeers"
$ pncTargetNumberOfKnownBigLedgerPeers pnc
ncTargetNumberOfEstablishedBigLedgerPeers <-
lastToEither "Missing TargetNumberOfEstablishedBigLedgerPeers"
$ pncTargetNumberOfEstablishedBigLedgerPeers pnc
ncTargetNumberOfActiveBigLedgerPeers <-
lastToEither "Missing TargetNumberOfActiveBigLedgerPeers"
$ pncTargetNumberOfActiveBigLedgerPeers pnc
ncProtocolIdleTimeout <-
lastToEither "Missing ProtocolIdleTimeout"
$ pncProtocolIdleTimeout pnc
Expand Down Expand Up @@ -581,6 +605,9 @@ makeNodeConfiguration pnc = do
, ncTargetNumberOfKnownPeers
, ncTargetNumberOfEstablishedPeers
, ncTargetNumberOfActivePeers
, ncTargetNumberOfKnownBigLedgerPeers
, ncTargetNumberOfEstablishedBigLedgerPeers
, ncTargetNumberOfActiveBigLedgerPeers
, ncEnableP2P = case enableP2P of
EnabledP2PMode -> SomeNetworkP2PMode Consensus.EnabledP2PMode
DisabledP2PMode -> SomeNetworkP2PMode Consensus.DisabledP2PMode
Expand Down
3 changes: 3 additions & 0 deletions cardano-node/src/Cardano/Node/Parsers.hs
View file
Expand Up @@ -117,6 +117,9 @@ nodeRunParser = do
, pncTargetNumberOfKnownPeers = mempty
, pncTargetNumberOfEstablishedPeers = mempty
, pncTargetNumberOfActivePeers = mempty
, pncTargetNumberOfKnownBigLedgerPeers = mempty
, pncTargetNumberOfEstablishedBigLedgerPeers = mempty
, pncTargetNumberOfActiveBigLedgerPeers = mempty
, pncEnableP2P = mempty
, pncPeerSharing = mempty
}
Expand Down
8 changes: 7 additions & 1 deletion cardano-node/src/Cardano/Node/Run.hs
View file
Expand Up @@ -627,6 +627,9 @@ mkP2PArguments NodeConfiguration {
ncTargetNumberOfKnownPeers,
ncTargetNumberOfEstablishedPeers,
ncTargetNumberOfActivePeers,
ncTargetNumberOfKnownBigLedgerPeers,
ncTargetNumberOfEstablishedBigLedgerPeers,
ncTargetNumberOfActiveBigLedgerPeers,
ncProtocolIdleTimeout,
ncTimeWaitTimeout,
ncPeerSharing
Expand All @@ -650,7 +653,10 @@ mkP2PArguments NodeConfiguration {
targetNumberOfRootPeers = ncTargetNumberOfRootPeers,
targetNumberOfKnownPeers = ncTargetNumberOfKnownPeers,
targetNumberOfEstablishedPeers = ncTargetNumberOfEstablishedPeers,
targetNumberOfActivePeers = ncTargetNumberOfActivePeers
targetNumberOfActivePeers = ncTargetNumberOfActivePeers,
targetNumberOfKnownBigLedgerPeers = ncTargetNumberOfKnownBigLedgerPeers,
targetNumberOfEstablishedBigLedgerPeers = ncTargetNumberOfEstablishedBigLedgerPeers,
targetNumberOfActiveBigLedgerPeers = ncTargetNumberOfActiveBigLedgerPeers
}

mkNonP2PArguments
Expand Down
38 changes: 28 additions & 10 deletions cardano-node/src/Cardano/Node/Tracing/Tracers/Diffusion.hs
View file
Expand Up @@ -479,23 +479,37 @@ instance MetaTrace (ND.DiffusionTracer ntnAddr ntcAddr) where
--------------------------------------------------------------------------------

instance LogFormatting TraceLedgerPeers where
forMachine _dtal (PickedPeer addr _ackStake stake) =
forMachine _dtal (PickedLedgerPeer addr _ackStake stake) =
mconcat
[ "kind" .= String "PickedPeer"
[ "kind" .= String "PickedLedgerPeer"
, "address" .= show addr
, "relativeStake" .= (realToFrac (unPoolStake stake) :: Double)
]
forMachine _dtal (PickedPeers (NumberOfPeers n) addrs) =
forMachine _dtal (PickedLedgerPeers (NumberOfPeers n) addrs) =
mconcat
[ "kind" .= String "PickedPeers"
[ "kind" .= String "PickedLedgerPeers"
, "desiredCount" .= n
, "count" .= List.length addrs
, "addresses" .= show addrs
]
forMachine _dtal (FetchingNewLedgerState cnt) =
forMachine _dtal (PickedBigLedgerPeer addr _ackStake stake) =
mconcat
[ "kind" .= String "PickedBigLedgerPeer"
, "address" .= show addr
, "relativeStake" .= (realToFrac (unPoolStake stake) :: Double)
]
forMachine _dtal (PickedBigLedgerPeers (NumberOfPeers n) addrs) =
mconcat
[ "kind" .= String "PickedBigLedgerPeers"
, "desiredCount" .= n
, "count" .= List.length addrs
, "addresses" .= show addrs
]
forMachine _dtal (FetchingNewLedgerState cnt bigCnt) =
mconcat
[ "kind" .= String "FetchingNewLedgerState"
, "numberOfPools" .= cnt
, "numberOfLedgerPeers" .= cnt
, "numberOfBigLedgerPeers" .= bigCnt
]
forMachine _dtal DisabledLedgerPeers =
mconcat
Expand Down Expand Up @@ -527,10 +541,14 @@ instance LogFormatting TraceLedgerPeers where
]

instance MetaTrace TraceLedgerPeers where
namespaceFor PickedPeer {} =
Namespace [] ["PickedPeer"]
namespaceFor PickedPeers {} =
Namespace [] ["PickedPeers"]
namespaceFor PickedLedgerPeer {} =
Namespace [] ["PickedLedgerPeer"]
namespaceFor PickedLedgerPeers {} =
Namespace [] ["PickedLedgerPeers"]
namespaceFor PickedBigLedgerPeer {} =
Namespace [] ["PickedBigLedgerPeer"]
namespaceFor PickedBigLedgerPeers {} =
Namespace [] ["PickedBigLedgerPeers"]
namespaceFor FetchingNewLedgerState {} =
Namespace [] ["FetchingNewLedgerState"]
namespaceFor DisabledLedgerPeers {} =
Expand Down

0 comments on commit ecaa89e

Please sign in to comment.