The following:

— Bump ekg-forward.
— Apply DDoS protection middleware to the timeseries server.
— Read the timeseries query string from request body rather than request query param.

Author: Russoul

cabal.project

@@ -81,7 +81,7 @@ if impl (ghc >= 9.12)
 source-repository-package
    type: git
    location: https://github.com/input-output-hk/ekg-forward.git
-   tag: d06caa8f53d945b9d252c9c7a719983767926140
-   --sha256: sha256-sQj2B5a9OwgLAIVoyGxSFww7aJ81Vf0DVUkYJepA4yo=
+   tag: c72c9a29045431df7484b665bed33c12ea71d0ac
+   --sha256: sha256-b87qt8RMI4gNPF8QTrRjfS5KK2/JhbxUp5ijscn2Vf8=
    subdir:
      .

cardano-tracer/cardano-tracer.cabal

@@ -202,6 +202,8 @@ library
                       , trace-forward ^>= 2.4.0
                       , trace-resources ^>= 0.2.4
                       , wai ^>= 3.2
+                      , wai-extra
+                      , wai-rate-limit
                       , warp ^>= 3.4
                       , warp-tls
                       , yaml

cardano-tracer/src/Cardano/Tracer/Acceptors/Client.hs

@@ -43,7 +43,7 @@ import           Data.Word (Word32)
 import qualified Network.Mux as Mux
 import qualified Network.Socket as Socket
 import qualified System.Metrics.Configuration as EKGF
-import           System.Metrics.Network.Acceptor (acceptEKGMetricsInit)
+import           System.Metrics.Network.Acceptor (acceptMetricsInit)
 
 import qualified Trace.Forward.Configuration.DataPoint as DPF
 import qualified Trace.Forward.Configuration.TraceObject as TF
@@ -194,7 +194,7 @@ runEKGAcceptorInit
                      respoinderCtx
                      LBS.ByteString IO () Void
 runEKGAcceptorInit tracerEnv ekgConfig errorHandler =
-  acceptEKGMetricsInit
+  acceptMetricsInit
     ekgConfig
     (prepareMetricsStores tracerEnv . micConnectionId)
     (store tracerEnv . connIdToNodeId . micConnectionId)

cardano-tracer/src/Cardano/Tracer/Acceptors/Server.hs

@@ -5,8 +5,6 @@ module Cardano.Tracer.Acceptors.Server
   ( runAcceptorsServer
   ) where
 
-import "contra-tracer" Control.Tracer (nullTracer)
-
 import           Cardano.Logging (TraceObject)
 import qualified Cardano.Logging.Types as Net
 import           Cardano.Tracer.Acceptors.Utils
@@ -25,25 +23,25 @@ import           Ouroboros.Network.Mux (MiniProtocol (..), MiniProtocolLimits (.
                    miniProtocolNum, miniProtocolRun)
 import           Ouroboros.Network.Protocol.Handshake (Handshake, HandshakeArguments (..))
 import qualified Ouroboros.Network.Protocol.Handshake as Handshake
+import qualified Ouroboros.Network.Server.Simple as Server
 import           Ouroboros.Network.Snocket (LocalAddress, LocalSocket, Snocket,
                    localAddressFromPath, localSnocket, makeLocalBearer, makeSocketBearer,
                    socketSnocket)
-import           Ouroboros.Network.Socket (ConnectionId (..),
-                   SomeResponderApplication (..))
-import qualified Ouroboros.Network.Server.Simple as Server
+import           Ouroboros.Network.Socket (ConnectionId (..), SomeResponderApplication (..))
 
 import           Codec.CBOR.Term (Term)
 import           Control.Concurrent.Async (wait)
+import           "contra-tracer" Control.Tracer (nullTracer)
 import qualified Data.ByteString.Lazy as LBS
+import           Data.Functor (void)
 import           Data.List.NonEmpty (NonEmpty ((:|)))
 import qualified Data.Text as Text
-import           Data.Functor (void)
 import           Data.Void (Void)
 import           Data.Word (Word32)
 import qualified Network.Mux as Mux
 import qualified Network.Socket as Socket
 import qualified System.Metrics.Configuration as EKGF
-import           System.Metrics.Network.Acceptor (acceptEKGMetricsResp)
+import           System.Metrics.Network.Acceptor (acceptMetricsResp)
 
 import qualified Trace.Forward.Configuration.DataPoint as DPF
 import qualified Trace.Forward.Configuration.TraceObject as TF
@@ -180,7 +178,7 @@ runEKGAcceptor
   -> (ConnectionId addr -> IO ())
   -> RunMiniProtocol 'Mux.ResponderMode initiatorCtx (ResponderContext addr) LBS.ByteString IO Void ()
 runEKGAcceptor tracerEnv ekgConfig errorHandler =
-  acceptEKGMetricsResp
+  acceptMetricsResp
     ekgConfig
     (prepareMetricsStores tracerEnv . rcConnectionId)
     (store tracerEnv . connIdToNodeId . rcConnectionId)

cardano-tracer/src/Cardano/Tracer/Handlers/Metrics/TimeseriesServer.hs

@@ -1,5 +1,5 @@
 {-# LANGUAGE LambdaCase #-}
-{-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE NumericUnderscores #-}
 {-# LANGUAGE OverloadedRecordDot #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE RecordWildCards #-}
@@ -15,27 +15,79 @@ import           Cardano.Tracer.Handlers.Metrics.Utils (contentHdrUtf8Text)
 import           Cardano.Tracer.MetaTrace
 import           Cardano.Tracer.Timeseries
 
+import           Control.Concurrent (threadDelay)
+import           Control.Concurrent.Extra (forkIO)
+import           Control.Concurrent.STM (atomically)
+import           Control.Concurrent.STM.TVar (modifyTVar', newTVarIO, readTVar, readTVarIO,
+                   writeTVar)
 import           Control.Monad (guard)
 import qualified Data.ByteString.Lazy as BL
+import           Data.Functor (void)
 import           Data.Maybe (fromMaybe)
-import           Data.Text (Text)
+import           Data.Text.Encoding (decodeUtf8Lenient)
 import qualified Data.Text.Encoding as T
 import           Network.HTTP.Types
 import           Network.Wai
 import           Network.Wai.Handler.Warp hiding (run)
 import           Network.Wai.Handler.WarpTLS
+import           Network.Wai.Middleware.RequestSizeLimit (defaultRequestSizeLimitSettings,
+                   requestSizeLimitMiddleware, setMaxLengthForRequest)
+import           Network.Wai.Middleware.Timeout (timeout)
+import           Network.Wai.RateLimit
+import           Network.Wai.RateLimit.Backend (Backend (..))
+import           Network.Wai.RateLimit.Strategy
 import           System.Time.Extra (sleep)
 
-parseTimeseriesQuery :: Request -> Maybe Text
+-- COMMENT: (@russoul) make the options below configurable?
+-- COMMENT: (@russoul) move the rate limiter backend to its own module?
+-- COMMENT: (@russoul) make the limiters applicable to every server we have?
+
+-- | Maximum request body size (KB).
+requestBodySizeLimiterKB :: Word
+requestBodySizeLimiterKB = 2 * 1024
+
+-- | Fixed time window of the request limiter (sec).
+requestRateLimiterWindowSec :: Word
+requestRateLimiterWindowSec = 60
+
+-- | Maximum number of requests in every window.
+requestRateLimiterLimitSec :: Word
+requestRateLimiterLimitSec = 30
+
+-- | Maximum duration of response generation per every request (sec).
+responseTimeoutSec :: Word
+responseTimeoutSec = 5
+
+-- | Simple request rate limiter backend that limits the rate of
+--   requests based on the total number of requests.
+totalRequestRateLimiterBackend :: IO (Backend ())
+totalRequestRateLimiterBackend = do
+  usage <- newTVarIO (0 :: Integer)
+
+  let
+    backendGetUsage :: () -> IO Integer
+    backendGetUsage _ = readTVarIO usage
+
+    backendIncAndGetUsage :: () -> Integer -> IO Integer
+    backendIncAndGetUsage _ k = atomically $ modifyTVar' usage (+ k) >> readTVar usage
+
+    backendExpireIn :: () -> Integer -> IO ()
+    backendExpireIn _ s = void $ forkIO $ do
+      threadDelay (fromIntegral (s * 1_000_000))
+      atomically $ writeTVar usage 0
+
+  pure $ MkBackend backendGetUsage backendIncAndGetUsage backendExpireIn
+
+-- | GET timeseries/query
+parseTimeseriesQuery :: Request -> Maybe ()
 parseTimeseriesQuery request = do
   guard (request.pathInfo == ["timeseries", "query"])
-  case queryToQueryText request.queryString of
-    [("query", Just str)] -> pure str
-    _ -> Nothing
+  guard (request.requestMethod == methodPost)
 
--- | timeseries/query?query=...
 timeseriesApp :: TimeseriesHandle -> Application
-timeseriesApp handle (parseTimeseriesQuery -> Just query) send = do
+timeseriesApp handle request@(parseTimeseriesQuery -> Just ()) send = do
+  bs <- consumeRequestBodyStrict request
+  let query = decodeUtf8Lenient (BL.toStrict bs)
   now <- getTimeMs
   execute handle (fromIntegral now) query >>= \case
     Left err -> send $
@@ -58,6 +110,8 @@ runTimeseriesServer tr tracerConfig endpoint handle = do
     { ttTimeseriesEndpoint = endpoint
     }
 
+  requestRateLimiterBackend <- totalRequestRateLimiterBackend
+
   let
     settings :: Settings
     settings = setEndpoint endpoint defaultSettings
@@ -67,7 +121,24 @@ runTimeseriesServer tr tracerConfig endpoint handle = do
       tlsSettingsChain certificateFile (fromMaybe [] certificateChain) certificateKeyFile
 
     application :: Application
-    application = timeseriesApp handle
+    application =
+      -- request body size limiter
+      requestSizeLimitMiddleware
+        (setMaxLengthForRequest (const (pure (Just (fromIntegral requestBodySizeLimiterKB * 1024))))
+        defaultRequestSizeLimitSettings)
+        .
+      -- request rate limiter (fixed window)
+      rateLimiting (fixedWindow requestRateLimiterBackend
+                      (fromIntegral requestRateLimiterWindowSec)
+                      (fromIntegral requestRateLimiterLimitSec)
+                      (const (pure ()))
+                   )
+        .
+      -- response time limiter
+      timeout (fromIntegral responseTimeoutSec)
+      $
+      timeseriesApp handle
+
 
     run :: IO ()
     run | Just True <- epForceSSL endpoint , Just cert <- tlsCertificate tracerConfig