Replace use of snap web framework with warp and wai

The `snap` framework is poorly maintained and depends on `HsOpenSSL`
regardless of whether TLS is used. Furthermore, `HsOpenSSL` will likely
break in early 2025 due to some low level APIs being deprecated:

  haskell-cryptography/HsOpenSSL#95

cabal.project

@@ -13,8 +13,8 @@ repository cardano-haskell-packages
 -- See CONTRIBUTING for information about these, including some Nix commands
 -- you need to run if you change them
 index-state:
-  , hackage.haskell.org 2024-08-20T21:35:22Z
-  , cardano-haskell-packages 2024-08-18T22:35:14Z
+  , hackage.haskell.org 2024-08-25T21:36:13Z
+  , cardano-haskell-packages 2024-08-25T15:05:06Z
 
 packages:
   contra-tracer
@@ -40,9 +40,6 @@ constraints:
   , text >= 2.0
 
 allow-newer:
-  , ekg:base
-  , ekg-core:base
-  , ekg-json:base
   , feed:base
   , snap-server:base
 

iohk-monitoring/iohk-monitoring.cabal

@@ -109,7 +109,8 @@ library
                        contra-tracer < 0.2,
                        contravariant,
                        directory,
-                       ekg,
+                       ekg-core,
+                       ekg-wai,
                        filepath,
                        katip,
                        libyaml,

iohk-monitoring/src/Cardano/BM/Backend/Switchboard.lhs

@@ -47,7 +47,7 @@ import qualified Data.Text.IO as TIO
 import           GHC.IO.Exception (BlockedIndefinitelyOnSTM)
 import qualified Katip as K
 import           System.IO (stderr)
-import           System.Remote.Monitoring (Server)
+import           System.Remote.Monitoring.Wai (Server)
 
 import           Cardano.BM.Configuration (Configuration)
 import qualified Cardano.BM.Configuration as Config

iohk-monitoring/src/Cardano/BM/Plugin.lhs

@@ -11,7 +11,7 @@ module Cardano.BM.Plugin
   )
   where
 
-import           System.Remote.Monitoring (Server)
+import           System.Remote.Monitoring.Wai (Server)
 
 import           Cardano.BM.Backend.Log (Scribe)
 import           Cardano.BM.Backend.Switchboard (Switchboard,

plugins/backend-ekg/lobemo-backend-ekg.cabal

@@ -23,15 +23,16 @@ library
                        aeson,
                        async,
                        bytestring,
-                       ekg,
                        ekg-core,
+                       ekg-wai,
+                       http-types,
                        iohk-monitoring,
                        safe-exceptions,
-                       snap-core,
-                       snap-server,
                        stm,
                        text,
                        time,
-                       unordered-containers
+                       unordered-containers,
+                       wai,
+                       warp
   hs-source-dirs:      src
   default-language:    Haskell2010

plugins/backend-ekg/src/Cardano/BM/Backend/EKGView.lhs

@@ -40,7 +40,7 @@ import           Data.Version (showVersion)
 import           System.IO (stderr)
 import qualified System.Metrics.Gauge as Gauge
 import qualified System.Metrics.Label as Label
-import           System.Remote.Monitoring (Server, forkServer,
+import           System.Remote.Monitoring.Wai (Server, forkServer,
                      getGauge, getLabel, serverThreadId)
 
 import           Paths_iohk_monitoring (version)

plugins/backend-ekg/src/Cardano/BM/Backend/Prometheus.lhs

@@ -20,18 +20,21 @@ import qualified Data.Aeson as A
 import           Data.Aeson ((.=))
 import           Data.ByteString.Builder
 import           Data.ByteString.Char8 (ByteString)
+import qualified Data.ByteString.Char8 as BS
+import qualified Data.ByteString.Lazy as LBS
 import           Data.List (find, partition)
 import           Data.Maybe (fromJust)
+import           Data.String (IsString)
 import           Data.Text (Text)
 import qualified Data.Text as T
 import           Data.Text.Encoding (encodeUtf8)
 import           Data.Text.Read (double)
 import           GHC.Generics
-import           Snap.Core (Snap, route, writeLBS)
-import           Snap.Http.Server (Config, ConfigLog (..), defaultConfig, setAccessLog,
-                     setBind, setErrorLog, setPort, simpleHttpServe)
+import           Network.HTTP.Types (status200)
+import qualified Network.Wai as Wai
+import qualified Network.Wai.Handler.Warp as Warp
 import           System.Metrics (Value (..), sampleAll)
-import qualified System.Remote.Monitoring as EKG
+import qualified System.Remote.Monitoring.Wai as Wai
 
 \end{code}
 %endif
@@ -67,29 +70,28 @@ instance A.ToJSON Number where
     toJSON (NumberInt i)  = A.Number $ fromInteger i
     toJSON (NumberReal r) = A.Number $ fromRational (toRational r)
 
-spawnPrometheus :: EKG.Server -> ByteString -> Int -> Maybe Text -> IO (Async.Async ())
-spawnPrometheus ekg host port prometheusOutput = Async.async $
-    simpleHttpServe config site
+spawnPrometheus :: Wai.Server -> Warp.HostPreference -> Int -> Maybe Text -> IO (Async.Async ())
+spawnPrometheus ekg host port prometheusOutput =
+    Async.async $ Warp.runSettings settings site
+    
   where
-    config :: Config Snap a
-    config = setPort port . setBind host . setAccessLog lg . setErrorLog lg $ defaultConfig
-    lg = ConfigNoLog
-    site :: Snap ()
-    site = route [ ("/metrics/", webhandler ekg) ]
-    webhandler :: EKG.Server -> Snap ()
-    webhandler srv = do
-        samples <- liftIO $ sampleAll $ EKG.serverMetricStore srv
+    settings :: Warp.Settings
+    settings = Warp.setPort port . Warp.setHost host $ Warp.defaultSettings
+    
+    site :: Wai.Application
+    site _request respond = do
+        -- We ignore the request and simple respond with the data.
+        samples <- sampleAll $ Wai.serverMetricStore ekg
         let output = case prometheusOutput of
-                         Nothing     -> renderSimpleOutput samples
                          Just "json" -> renderJSONOutput samples
-                         Just _      -> renderSimpleOutput samples
-        writeLBS output
-        pure ()
-
-    -- Simple output: key value.
-
-    renderSimpleOutput = toLazyByteString . renderSamples . HM.toList
+                         _other -> renderSimpleOutput samples
+        respond $ Wai.responseLBS status200 [] output
 
+-- Simple output: key value.
+renderSimpleOutput :: HM.HashMap Text Value -> LBS.ByteString
+renderSimpleOutput =
+    toLazyByteString . renderSamples . HM.toList
+  where
     renderSamples :: [(Text, Value)] -> Builder
     renderSamples [] = mempty
     renderSamples samples = mconcat
@@ -124,15 +126,16 @@ spawnPrometheus ekg host port prometheusOutput = Async.async $
         Right (_n, "") -> True  -- only floating point number parsed, no leftover
         _ -> False
 
-    -- JSON output
-
-    renderJSONOutput samples =
-        let rtsNamespace = "rts.gc"
-            (rtsSamples, otherSamples) = partition (\(sk, _) -> rtsNamespace `T.isPrefixOf` sk) $ HM.toList samples
-            rtsMetrics = extractRtsGcMetrics rtsNamespace rtsSamples
-            otherMetrics = extractOtherMetrics otherSamples
-        in A.encode [rtsMetrics, otherMetrics]
+-- JSON output
+renderJSONOutput :: HM.HashMap Text Value -> LBS.ByteString
+renderJSONOutput samples =
+    let rtsNamespace = "rts.gc"
+        (rtsSamples, otherSamples) = partition (\(sk, _) -> rtsNamespace `T.isPrefixOf` sk) $ HM.toList samples
+        rtsMetrics = extractRtsGcMetrics rtsNamespace rtsSamples
+        otherMetrics = extractOtherMetrics otherSamples
+    in A.encode [rtsMetrics, otherMetrics]
 
+  where
     -- rts.gc metrics are always here because they are predefined in ekg-core,
     -- so we can group them.
     extractRtsGcMetrics :: Text -> [(Text, Value)] -> MetricsGroup