cardano-tracer: Allow switching EKG service between different nodes.

bench/ekg-restart-test/CHANGELOG.md

@@ -0,0 +1,5 @@
+# Revision history for ekg-restart-test
+
+## 0.1.0.0 -- YYYY-mm-dd
+
+* First version. Released on an unsuspecting world.

bench/ekg-restart-test/app/Main.hs

@@ -0,0 +1,100 @@
+{-# Language OverloadedStrings #-}
+{-# Language StandaloneKindSignatures #-}
+{-# Language BangPatterns #-}
+{-# Language LambdaCase #-}
+{-# Language RecordWildCards #-}
+{-# Language GADTs #-}
+{-# Language TemplateHaskell #-}
+{-# Language DeriveAnyClass #-}
+{-# Language DerivingStrategies #-}
+{-# Language NumericUnderscores #-}
+{-# Language ScopedTypeVariables #-}
+{-# Language TypeApplications #-}
+{-# Language BlockArguments #-}
+
+module Main where
+
+import System.IO.Unsafe
+import Data.ByteString.Builder
+import Data.Kind
+import qualified Data.Text as T
+import Data.Text (Text)
+import Control.Concurrent
+import Control.Exception
+import Control.Monad
+import GHC.IO.Exception
+import Network.Wai
+import Network.Wai.Handler.Warp
+import Network.Wai.Handler.Warp
+import System.Metrics
+import Network.Wai.Middleware.RequestLogger
+import System.Remote.Monitoring.Wai
+import Network.HTTP.Types
+import qualified Data.Map as Map
+import Data.Map (Map)
+
+main = m 8000
+
+type ConnectedNodes :: Type
+type ConnectedNodes = Map [Text] Store
+
+connectedNodes :: MVar ConnectedNodes
+connectedNodes = unsafePerformIO do 
+  newMVar (Map.fromList [])
+
+m :: Int -> IO ()
+m port = do
+  stores :: [Store] <- 
+    replicateM 5 newStore
+  say
+    "run port"
+  run port do logStdout do app stores
+
+app :: [Store] -> Application
+app stores req send = do
+  let 
+    ok :: Builder -> IO ResponseReceived
+    ok = send . responseBuilder status200 []
+
+  print (queryString req)
+
+  case pathInfo req of
+    [] -> do
+      print req
+      monitor (stores !! 2) req send
+    ["0"] -> do
+      ok "/0"
+    ["1"] -> ok "/1"
+    ["2"] -> monitor (stores !! 2) req send
+    ["3"] -> monitor (stores !! 3) req send
+    ["4"] -> monitor (stores !! 4) req send
+    path -> send do 
+      responseBuilder 
+        do status404 
+        do [] 
+        do "Not found: " <> stringUtf8 (show path)
+
+-- run port $ do
+--    path <- pathInfo <$> getRequestBody
+--    let store = lookup path connectedNodes
+--    case store of
+--        Just store' -> monitor store'
+--        Nothing -> response404
+
+-- main :: IO ()
+-- main = run 3000 $ \req send ->
+--   case pathInfo req of
+--     [] -> send $ responseBuilder
+--       status303
+--       [("Location", "/home")]
+--       "Redirecting"
+--     ["home"] -> send $ responseBuilder
+--       status200
+--       [("Content-Type", "text/plain")]
+--       "This is the home route"
+
+say :: String -> IO ()
+say msg = putStrLn (" + " ++ msg)
+
+sleep :: Int -> IO ()
+sleep n = threadDelay (fromIntegral n * 1_000_000)

bench/ekg-restart-test/ekg-restart-test.cabal

@@ -0,0 +1,54 @@
+cabal-version:      2.4
+name:               ekg-restart-test
+version:            0.1.0.0
+
+-- A short (one-line) description of the package.
+-- synopsis:
+
+-- A longer description of the package.
+-- description:
+
+-- A URL where users can report bugs.
+-- bug-reports:
+
+-- The license under which the package is released.
+-- license:
+author:             Baldur Blöndal
+maintainer:         baldur.blondal@iohk.io
+
+-- A copyright notice.
+-- copyright:
+-- category:
+extra-source-files: CHANGELOG.md
+
+executable ekg-restart-test
+    main-is:        Main.hs
+    other-modules:  
+
+    -- Modules included in this executable, other than Main.
+    -- other-modules:
+
+    -- LANGUAGE extensions used by modules in this package.
+    -- other-extensions:
+    build-depends:    base >= 4.14 && < 5
+                    , ekg
+                    , ekg-core
+                    , ekg-wai
+                    , warp
+                    , ekg-forward ^>= 0.5
+                    , random
+                    , bytestring
+                    , network
+                    , time
+                    , wai
+                    , wai-extra
+                    , http-types
+                    , ghc
+                    , template-haskell
+                    , text
+                    , containers
+                    , unordered-containers
+    ghc-options:      -threaded
+
+    hs-source-dirs:   app
+    default-language: Haskell2010

cabal.project

@@ -32,6 +32,10 @@ packages:
   trace-resources
   trace-forward
 
+  -- ||| TMP PACKAGE, DON'T MAKE PR
+  bench/ekg-restart-test
+  -- ||| TMP PACKAGE, DON'T MAKE PR
+
 extra-packages: Cabal
 
 program-options

cardano-tracer/cardano-tracer.cabal

@@ -168,18 +168,20 @@ library
                       , containers
                       , contra-tracer
                       , directory
-                      , ekg
                       , ekg-core
                       , ekg-forward ^>= 0.5
+                      , ekg-wai
                       , extra
                       , filepath
+                      , http-types
                       , mime-mail
                       , optparse-applicative
                       , ouroboros-network ^>= 0.17
                       , ouroboros-network-api
                       , ouroboros-network-framework
                       , signal
-                      , smtp-mail ^>= 0.5
+                      , slugify
+                      , smtp-mail == 0.3.0.0
                       , snap-blaze
                       , snap-core
                       , snap-server
@@ -191,6 +193,9 @@ library
                       , trace-forward
                       , trace-resources
                       , unordered-containers
+                      , wai
+                      , wai-extra
+                      , warp
                       , yaml
 
   if flag(systemd) && os(linux)