Merge pull request #66 from IntersectMBO/coot/min-sig-delay

Added --min-sig-delay flag

Author: coot

dmq-node/app/Main.hs

@@ -33,7 +33,7 @@ import Data.Version (showVersion)
 import Data.Void (Void)
 import Options.Applicative
 import System.Directory qualified as Dir
-import System.Exit (die, exitSuccess)
+import System.Exit (die, exitFailure, exitSuccess)
 import System.IOManager (withIOManager)
 import System.Metrics qualified as EKG
 import System.Random qualified as Random
@@ -93,16 +93,25 @@ runDMQ commandLineConfig = do
     -- options
     let dmqConfig :: Configuration
         dmqConfig@Configuration {
+          dmqcNetworkMagic          = I dmqNetworkMagic,
           dmqcTopologyFile          = I topologyFile,
           dmqcCardanoNodeSocket     = I socketPath,
           dmqcVersion               = I version,
           dmqcShelleyGenesisFile    = I genesisFile,
-          dmqcShelleyGenesisHash    = I genesisHash
+          dmqcShelleyGenesisHash    = I genesisHash,
+          dmqcMinSigDelay           = I minSigDelay
+
         } =     fromRight mempty config'
              <> commandLineConfig
             `act`
             defaultConfiguration
 
+        validationCfg :: ValidationCfg
+        validationCfg =
+          ValidationCfg {
+            vcMinSigDelay = minSigDelay
+          }
+
     when version $ do
       let gitrev :: Text.Text
           gitrev = $(gitRev)
@@ -134,6 +143,11 @@ runDMQ commandLineConfig = do
       )
       <- mkDMQTracers ekgStore configFilePath
 
+    when (validationCfg /= Policy.defaultValidationCfg) $ do
+      traceWith dmqStartupTracer (DMQValidationCfgWarning dmqNetworkMagic validationCfg)
+      -- one cannot run on mainnet with a custom `ValidationCfg`
+      unless (dmqNetworkMagic == Policy.dmqMainnetNetworkMagic)
+        exitFailure
 
     case config' of
       Left e   -> traceWith dmqStartupTracer (DMQConfigurationError e)
@@ -193,7 +207,11 @@ runDMQ commandLineConfig = do
                     Mempool.getWriter SigDuplicate
                                       sigId
                                       (\(utcNow, now) sigs ->
-                                        withPoolValidationCtx (stakePools nodeKernel) utcNow now (validateSig sigs)
+                                        withPoolValidationCtx
+                                          (stakePools nodeKernel)
+                                          utcNow
+                                          now
+                                          (validateSig validationCfg sigs)
                                       )
                                       (traverse_ $ \(sigid, reason) -> do
                                         traceWith sigValidationTracer $ InvalidSignature sigid reason
@@ -222,7 +240,11 @@ runDMQ commandLineConfig = do
                     Mempool.getWriter SigDuplicate
                                       sigId
                                       (\(utcNow, now) sigs ->
-                                        withPoolValidationCtx (stakePools nodeKernel) utcNow now (validateSig sigs)
+                                        withPoolValidationCtx
+                                          (stakePools nodeKernel)
+                                          utcNow
+                                          now
+                                          (validateSig validationCfg sigs)
                                       )
                                       (traverse_ $ \(sigid, reason) ->
                                          traceWith localSigValidationTracer $ InvalidSignature sigid reason

dmq-node/changelog.d/20260701_124008_coot_min_sig_delay.md

@@ -0,0 +1,23 @@
+<!--
+A new scriv changelog fragment.
+
+Uncomment the section that is right (remove the HTML comment wrapper).
+For top level release notes, leave all the headers commented out.
+-->
+
+<!--
+### Breaking
+
+- A bullet item for the Breaking category.
+
+-->
+### Non-Breaking
+
+- Added `--min-sig-delay` internal flag.  One cannot use it on the mainnet.
+
+<!--
+### Patch
+
+- A bullet item for the Patch category.
+
+-->

dmq-node/src/DMQ/Configuration.hs

@@ -76,6 +76,7 @@ import Ouroboros.Network.Snocket (LocalAddress (..), RemoteAddress)
 
 import DMQ.Configuration.Topology (NoExtraConfig (..), NoExtraFlags (..))
 import DMQ.Genesis
+import DMQ.Policy qualified as Policy
 
 -- | Configuration comes in two flavours depending on the `f` functor:
 -- `PartialConfig` is using `Last` and `Configuration` is using an identity
@@ -136,6 +137,10 @@ data Configuration' f =
     dmqcTargetOfEstablishedBigLedgerPeers :: f Int,
     dmqcTargetOfActiveBigLedgerPeers      :: f Int,
 
+    -- | Minimal delay between signatures from the same peer.
+    --
+    dmqcMinSigDelay                       :: f DiffTime,
+
     -- | CLI only option to show version and exit.
     dmqcVersion                           :: f Bool
   }
@@ -195,7 +200,7 @@ defaultConfiguration = Configuration {
       dmqcIPv6                              = I Nothing,
       dmqcLocalAddress                      = I (LocalAddress "dmq-node.socket"),
       -- mainnet dmq protocol magic according to CIP#137
-      dmqcNetworkMagic                      = I NetworkMagic { unNetworkMagic = 2_912_307_721 },
+      dmqcNetworkMagic                      = I Policy.dmqMainnetNetworkMagic,
       dmqcCardanoNetworkMagic               =
         I (NetworkMagic . unProtocolMagicId $ mainnetProtocolMagicId),
       dmqcPortNumber                        = I 3_141,
@@ -218,6 +223,8 @@ defaultConfiguration = Configuration {
       dmqcPeerSharing                       = I PeerSharingEnabled,
       dmqcLedgerPeers                       = I False,
 
+      dmqcMinSigDelay                       = I Policy.minSigDelay,
+
       -- CLI only options
       dmqcVersion                           = I False
     }
@@ -271,6 +278,9 @@ instance FromJSON PartialConfig where
       dmqcProtocolIdleTimeout <- Last <$> v .:? "ProtocolIdleTimeout"
       dmqcChurnInterval <- Last <$> v .:? "ChurnInterval"
 
+      -- not configurable in a config file
+      let dmqcMinSigDelay = Last Nothing
+
       pure $
         Configuration
           { dmqcIPv4                = Last dmqcIPv4

dmq-node/src/DMQ/Configuration/CLIOptions.hs

@@ -97,6 +97,12 @@ parseCLIOptions =
           <> help "Show dmq-node version"
           )
         )
+    <*> optional (
+          option auto
+          (  long "min-sig-delay"
+          <> internal
+          )
+        )
   where
     -- NOTE: we cannot simply use `value <> showDefault`, because configuration
     -- will always overwrite values provided by configuration file.
@@ -108,9 +114,15 @@ parseCLIOptions =
         , Help.paragraph ("(default: " ++ show a ++ ")")
         ]
 
-    mkConfiguration ipv4 ipv6 portNumber localAddress
-                    configFile topologyFile cardanoNodeSocket cardanoNetworkMagic dmqNetworkMagic
-                    version =
+    mkConfiguration ipv4 ipv6 portNumber
+                    localAddress
+                    configFile
+                    topologyFile
+                    cardanoNodeSocket
+                    cardanoNetworkMagic
+                    dmqNetworkMagic
+                    version
+                    minSigDelay =
       mempty { dmqcIPv4                = Last (Just <$> ipv4),
                dmqcIPv6                = Last (Just <$> ipv6),
                dmqcLocalAddress        = Last (LocalAddress <$> localAddress),
@@ -120,5 +132,6 @@ parseCLIOptions =
                dmqcCardanoNodeSocket   = Last cardanoNodeSocket,
                dmqcCardanoNetworkMagic = Last (NetworkMagic <$> cardanoNetworkMagic),
                dmqcNetworkMagic        = Last (NetworkMagic <$> dmqNetworkMagic),
-               dmqcVersion             = Last version
+               dmqcVersion             = Last version,
+               dmqcMinSigDelay         = Last minSigDelay
              }

dmq-node/src/DMQ/Diffusion/NodeKernel/Types.hs

@@ -1,17 +1,20 @@
-{-# LANGUAGE DataKinds  #-}
-{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE DataKinds         #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RankNTypes        #-}
 
 module DMQ.Diffusion.NodeKernel.Types
   ( NodeKernel (..)
   , Readiness (..)
   , PoolId
   , StakePools (..)
   , PoolValidationCtx (..)
+  , ValidationCfg (..)
   ) where
 
 import Control.Concurrent.Class.MonadSTM.Strict
 import Control.Monad.Class.MonadTime.SI
 
+import Data.Aeson qualified as Aeson
 import Data.Map.Strict (Map)
 import Data.OrdPSQ (OrdPSQ)
 import Data.Word
@@ -104,3 +107,16 @@ data PoolValidationCtx =
       -- signatures
     }
   deriving Show
+
+
+newtype ValidationCfg = ValidationCfg {
+    vcMinSigDelay :: DiffTime
+    -- ^ minimal delay between signatures created by the same SPO.  It can be
+    -- modified with an internal CLI option.  The default value is
+    -- `DMQ.Policy.minSigDelay`.
+  }
+  deriving Eq
+
+instance Aeson.ToJSON ValidationCfg where
+  toJSON ValidationCfg { vcMinSigDelay } =
+    Aeson.object [ "minSigDelay" Aeson..= vcMinSigDelay ]

dmq-node/src/DMQ/Policy.hs

@@ -1,3 +1,5 @@
+{-# LANGUAGE NumericUnderscores #-}
+
 module DMQ.Policy
   ( sigDecisionPolicy
   , sigSubmissionIngressLimit
@@ -9,17 +11,21 @@ module DMQ.Policy
   , maxSigExpiresAtDelay
   , maxSigIdsInflight
   , cardanoEpochSlots
+  , defaultValidationCfg
+  , dmqMainnetNetworkMagic
   ) where
 
 import Data.Time (DiffTime, NominalDiffTime)
 
 import Cardano.Chain.Slotting (EpochSlots (..))
 
+import DMQ.Diffusion.NodeKernel.Types (ValidationCfg (..))
 import DMQ.Diffusion.PeerSelection.PeerMetric (PeerMetricConfiguration (..))
 import DMQ.Protocol.SigSubmission.Type (NumTxIdsToReq)
 
 import Network.Mux.Types (MiniProtocolLimits (..))
 
+import Ouroboros.Network.Magic (NetworkMagic (..))
 import Ouroboros.Network.SizeInBytes (SizeInBytes)
 import Ouroboros.Network.TxSubmission.Inbound.V2
 
@@ -55,6 +61,12 @@ maxSigExpiresAtDelay :: NominalDiffTime
 maxSigExpiresAtDelay = 1800
 
 
+defaultValidationCfg :: ValidationCfg
+defaultValidationCfg = ValidationCfg {
+    vcMinSigDelay = minSigDelay
+  }
+
+
 -- | Maximum numbers signatures in-flight per peer.
 --
 -- NOTE: it is used by:
@@ -128,3 +140,9 @@ cardanoEpochSlots :: EpochSlots
 cardanoEpochSlots = EpochSlots $ 10 * k
   where
     k = 2160
+
+
+-- | Mainnet `NetworkMagic` for dmq according to CIP#0137.
+--
+dmqMainnetNetworkMagic :: NetworkMagic
+dmqMainnetNetworkMagic = NetworkMagic 2_912_307_721

dmq-node/src/DMQ/Protocol/SigSubmission/Validate.hs

@@ -15,6 +15,7 @@ module DMQ.Protocol.SigSubmission.Validate
   , SigValidationException (..)
   , SigValidationError (..)
   , SigValidationTrace (..)
+  , ValidationCfg (..)
   ) where
 
 import Control.Monad.Class.MonadTime.SI
@@ -41,7 +42,8 @@ import Cardano.Ledger.Api.State.Query (StakeSnapshot (ssSetPool))
 import Cardano.Ledger.BaseTypes.NonZero qualified as Ledger
 import Cardano.Ledger.Keys qualified as Ledger
 
-import DMQ.Diffusion.NodeKernel (PoolValidationCtx (..), Readiness (..))
+import DMQ.Diffusion.NodeKernel (PoolValidationCtx (..), Readiness (..),
+           ValidationCfg (..))
 import DMQ.Policy qualified as Policy
 import DMQ.Protocol.SigSubmission.Type
 
@@ -62,17 +64,20 @@ validateSigId Sig { sigId = SigId hash, sigSignedBytes } =
   castHash (hashWith id (LBS.toStrict sigSignedBytes))
 
 
+
 validateSig :: forall crypto.
                ( Crypto crypto
                , DSIGN crypto ~ Ledger.DSIGN
                , DSIGN.Signable (DSIGN crypto) (OCertSignable crypto)
                , ContextKES (KES crypto) ~ ()
                , Signable (KES crypto) ByteString
                )
-            => [Sig crypto]
+            => ValidationCfg
+            -- ^ minimum signature delay produced by the same stake pool
+            -> [Sig crypto]
             -> PoolValidationCtx
             -> ([Either (SigId, SigValidationError) (Sig crypto)], PoolValidationCtx)
-validateSig sigs = State.runState (traverse (commute . validate) sigs)
+validateSig ValidationCfg { vcMinSigDelay } sigs = State.runState (traverse (commute . validate) sigs)
   where
     -- Commute `StateT` and `ExceptT` monads, e.g. a natural transformation
     -- `StateT s (Except e) ~> ExceptT e (State s)`. The latter monad allows us
@@ -127,7 +132,7 @@ validateSig sigs = State.runState (traverse (commute . validate) sigs)
                 = (Right (), Just (now, ()))
 
             fn a@(Just (lastSeen, _))
-                | sinceLast >= Policy.minSigDelay
+                | sinceLast >= vcMinSigDelay
                 = (Right (), Just (now, ()))
 
                 | otherwise

dmq-node/src/DMQ/Tracer.hs

@@ -46,6 +46,7 @@ import Ouroboros.Network.ConnectionId
 import Ouroboros.Network.Diffusion qualified as Diffusion
 import Ouroboros.Network.Diffusion.Topology (NetworkTopology)
 import Ouroboros.Network.Driver (TraceSendRecv)
+import Ouroboros.Network.Magic (NetworkMagic (..))
 import Ouroboros.Network.OrphanInstances ()
 import Ouroboros.Network.PeerSelection.PublicRootPeers (PublicRootPeers)
 import Ouroboros.Network.PeerSelection.PublicRootPeers qualified as PublicRootPeers
@@ -67,12 +68,14 @@ import Cardano.Logging qualified as Logging
 import Cardano.Logging.Prometheus.TCPServer qualified as Logging
 
 import DMQ.Configuration
+import DMQ.Diffusion.NodeKernel.Types (ValidationCfg)
 import DMQ.NodeToClient.LocalMsgNotification qualified as LMN
 import DMQ.NodeToClient.LocalMsgSubmission (TraceLocalMsgSubmission)
 import DMQ.NodeToClient.LocalStateQueryClient.Types
            (TraceLocalStateQueryClient (..))
 import DMQ.NodeToClient.Version as NtC
 import DMQ.NodeToNode.Version as NtN
+import DMQ.Policy qualified as Policy
 import DMQ.Protocol.LocalMsgNotification.Type (LocalMsgNotification)
 import DMQ.Protocol.LocalMsgNotification.Type qualified as LMN
 import DMQ.Protocol.LocalMsgSubmission.Type (LocalMsgSubmission,
@@ -132,6 +135,7 @@ data DMQStartupTrace
   | DMQTopology (NetworkTopology NoExtraConfig Diffusion.NoExtraFlags)
   | DMQTopologyError Text
   | DMQPrometheus Logging.TracePrometheusSimple
+  | DMQValidationCfgWarning NetworkMagic ValidationCfg
 
 
 instance Logging.LogFormatting DMQStartupTrace where
@@ -157,6 +161,11 @@ instance Logging.LogFormatting DMQStartupTrace where
             , "error" .= e
             ]
   forMachine dtal (DMQPrometheus msg) = Logging.forMachine dtal msg
+  forMachine _dtal (DMQValidationCfgWarning magic cfg) =
+    mconcat [ "kind" .= String "NonStandardValidationCfg"
+            , "networkMagic" .= unNetworkMagic magic
+            , "cfg"  .= cfg
+            ]
 
 instance Logging.MetaTrace DMQStartupTrace where
   namespaceFor DMQConfiguration{}          = Logging.Namespace [] ["Configuration"]
@@ -165,9 +174,15 @@ instance Logging.MetaTrace DMQStartupTrace where
   namespaceFor DMQTopology{}               = Logging.Namespace [] ["Topology"]
   namespaceFor DMQTopologyError{}          = Logging.Namespace [] ["Topology", "Error"]
   namespaceFor DMQPrometheus {}            = Logging.Namespace [] ["Prometheus"]
+  namespaceFor DMQValidationCfgWarning {}  = Logging.Namespace [] ["ValidationCfg"]
   severityFor _ (Just DMQConfigurationError{})     = Just Logging.Critical
   severityFor _ (Just DMQCardanoNodeSocketError{}) = Just Logging.Critical
   severityFor _ (Just DMQTopologyError{})          = Just Logging.Critical
+  severityFor _ (Just (DMQValidationCfgWarning magic _))
+                                                   | magic == Policy.dmqMainnetNetworkMagic
+                                                   = Just Logging.Critical
+                                                   | otherwise
+                                                   = Just Logging.Warning
   severityFor _ _                                  = Just Logging.Info
   documentFor _ = Nothing
   allNamespaces =