test app: same as before, but working

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

@@ -32,6 +32,8 @@ import Network.Wai.Middleware.RequestLogger
 import System.Remote.Monitoring.Wai
 import Network.HTTP.Types
 import qualified Data.Map as Map
+import qualified System.Metrics as EKG
+-- import qualified System.Metrics.Configuration as EKGF
 import Data.Map (Map)
 import Data.Time.Clock.POSIX (getPOSIXTime)
 
@@ -47,53 +49,58 @@ connectedNodes = unsafePerformIO do
 m :: Int -> IO ()
 m port = do
   stores :: [Store] <- genStores 5
-
+  dummyStore <- newStore
   say $
     "run port: " ++ show port
 
-  run port do logStdout do app stores
+  run port do logStdout do app dummyStore stores
 
   --_ <- forkServerWith (head stores) "localhost" port
   --forever $ threadDelay $ 1000 * 1000
 
 
 genStores :: Int -> IO [Store]
 genStores count = do
-  mapM genStore [1 .. fromIntegral count]
+  traverse genStore [1 .. fromIntegral count]
   where
     getTimeMs = (round . (* 1000)) `fmap` getPOSIXTime
 
+    -- genStore :: Int64 -> IO Store
     genStore ix = do
       let base = ix * 1000
-      s <- newStore
-      registerCounter "ekg.server_timestamp_ms" getTimeMs s
-      registerGauge "myval" ((base +) <$> randomRIO (1, 10)) s
-      pure s
+      store <- EKG.newStore
+      EKG.registerCounter "ekg.server_timestamp_ms" getTimeMs store
+      EKG.registerGauge "myval" ((base +) <$> randomRIO (1, 10)) store
+      EKG.registerGcMetrics store
+      pure store
 
 
-app :: [Store] -> Application
-app stores req send = do
+app :: Store -> [Store] -> Application
+app dummyStore stores req send = do
   let 
     ok :: Builder -> IO ResponseReceived
     ok = send . responseBuilder status200 []
 
   print (queryString req)
 
   case pathInfo req of
-    [] -> 
-      -- ok "Home page"
-      monitor (head stores) req send
-    ["0"] -> do
-      ok "/0"
-    ["1"] -> ok "/1"
-    ["2"] -> monitor (stores !! 2) req { pathInfo = tail (pathInfo req) } send
-    ["3"] -> monitor (stores !! 3) req { pathInfo = tail (pathInfo req) } send
-    ["4"] -> monitor (stores !! 4) req { pathInfo = tail (pathInfo req) } send
-    path -> send do 
-      responseBuilder 
-        do status404 
-        do [] 
-        do "Not found: " <> stringUtf8 (show path)
+    []      -> ok "the root directory can be safely made the list page"
+
+    ["0"]   -> ok "/0"
+    ["1"]   -> ok "/1"
+    ["2"]   -> monitor (stores !! 2) req { pathInfo = tail (pathInfo req) } send
+    ["3"]   -> monitor (stores !! 3) req { pathInfo = tail (pathInfo req) } send
+    ["4"]   -> monitor (stores !! 4) req { pathInfo = tail (pathInfo req) } send
+    path:_
+      -- all endings in ekg-wai's asset/ folder
+      | any (`T.isSuffixOf` path) [".html", ".css", ".js", ".png"] ->
+        -- we actually need an empty dummy store here, as we're sure monitor will internally invoke the staticApp to serve the assets
+          monitor dummyStore req send
+      | otherwise -> send do
+        responseBuilder
+          do status404
+          do []
+          do "Not found: " <> stringUtf8 (show path)
 
 -- run port $ do
 --    path <- pathInfo <$> getRequestBody

cardano-tracer/cardano-tracer.cabal

@@ -160,6 +160,7 @@ library
   build-depends:        aeson
                       , async
                       , async-extras
+                      , auto-update
                       , bimap
                       , blaze-html
                       , bytestring
@@ -182,9 +183,6 @@ library
                       , signal
                       , slugify
                       , smtp-mail == 0.3.0.0
-                      , snap-blaze
-                      , snap-core
-                      , snap-server
                       , stm
                       , string-qq
                       , text

cardano-tracer/docs/cardano-tracer.md

@@ -337,6 +337,8 @@ The fields `rpMaxAgeMinutes`, `rpMaxAgeHours` specify the lifetime of the log fi
 
 ## Prometheus
 
+At top-level route `/` Promtheus gives a list of connected nodes.
+
 The optional field `hasPrometheus` specifies the host and port of the web page with metrics. For example:
 
 ```
@@ -374,24 +376,16 @@ rts_gc_cumulative_bytes_used 184824
 
 ## EKG Monitoring
 
-The optional field `hasEKG` specifies the hosts and ports of two web pages:
-
-1. the list of identifiers of connected nodes,
-2. EKG monitoring page.
+At top-level route `/` EKG gives a list of connected nodes.
 
-For example, if you use JSON configuration file:
+The optional field `hasPrometheus` specifies the host and port of the
+web page with metrics. For example:
 
 ```
-"hasEKG": [
-  {
-    "epHost": "127.0.0.1",
-    "epPort": 3100
-  },
-  {
-    "epHost": "127.0.0.1",
-    "epPort": 3101
-  }
-]
+"hasEKG": {
+  "epHost": "127.0.0.1",
+  "epPort": 3100
+}
 ```
 
 The page with the list of identifiers of connected nodes will be available at `http://127.0.0.1:3100`, for example:

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

@@ -1,7 +1,6 @@
 {-# LANGUAGE NamedFieldPuns #-}
-#if RTVIEW
 {-# LANGUAGE OverloadedStrings #-}
-#endif
+{-# LANGUAGE TupleSections #-}
 
 module Cardano.Tracer.Acceptors.Utils
   ( prepareDataPointRequestor
@@ -26,6 +25,7 @@ import           Control.Concurrent.STM.TVar (TVar, modifyTVar', newTVarIO)
 import qualified Data.Bimap as BM
 import qualified Data.Map.Strict as M
 import qualified Data.Set as S
+import           Data.Time.Clock.POSIX (getPOSIXTime)
 #if RTVIEW
 import           Data.Time.Clock.System (getSystemTime, systemToUTCTime)
 #endif
@@ -51,12 +51,24 @@ prepareMetricsStores
   -> IO (EKG.Store, TVar MetricsLocalStore)
 prepareMetricsStores TracerEnv{teConnectedNodes, teAcceptedMetrics} connId = do
   addConnectedNode teConnectedNodes connId
-  storesForNewNode <- (,) <$> EKG.newStore
-                          <*> newTVarIO emptyMetricsLocalStore
+  store <- EKG.newStore
+
+  EKG.registerCounter "ekg.server_timestamp_ms" getTimeMs store
+  storesForNewNode <- (store ,) <$> newTVarIO emptyMetricsLocalStore
+
   atomically $
     modifyTVar' teAcceptedMetrics $ M.insert (connIdToNodeId connId) storesForNewNode
   return storesForNewNode
 
+  where
+    -- forkServer definition of `getTimeMs'. The ekg frontend relies
+    -- on the "ekg.server_timestamp_ms" metric being in every
+    -- store. While forkServer adds that that automatically we must
+    -- manually add it.
+    -- url 
+    --  + https://github.com/tvh/ekg-wai/blob/master/System/Remote/Monitoring/Wai.hs#L237-L238
+    getTimeMs = (round . (* 1000)) `fmap` getPOSIXTime
+
 addConnectedNode
   :: ConnectedNodes
   -> ConnectionId LocalAddress

cardano-tracer/src/Cardano/Tracer/Configuration.hs

@@ -1,14 +1,18 @@
 {-# LANGUAGE DeriveAnyClass #-}
+{-# LANGUAGE DuplicateRecordFields #-}
 {-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE PatternSynonyms #-}
 {-# LANGUAGE RecordWildCards #-}
 {-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE ViewPatterns #-}
 
 module Cardano.Tracer.Configuration
   ( Address (..)
   , Endpoint (..)
+  , setEndpoint
   , LogFormat (..)
   , LogMode (..)
   , LoggingParams (..)
@@ -24,19 +28,23 @@ import qualified Cardano.Logging.Types as Log
 import           Control.Applicative ((<|>))
 import           Data.Aeson (FromJSON (..), ToJSON, withObject, (.:))
 import           Data.Fixed (Pico)
+import           Data.Function ((&))
 import           Data.Functor ((<&>))
 import           Data.List (intercalate)
 import           Data.List.Extra (notNull)
 import           Data.List.NonEmpty (NonEmpty)
 import qualified Data.List.NonEmpty as NE
 import           Data.Map.Strict (Map)
 import           Data.Maybe (catMaybes)
+import           Data.String (fromString)
 import           Data.Text (Text)
 import           Data.Word (Word16, Word32, Word64)
 import           Data.Yaml (decodeFileEither)
 import           GHC.Generics (Generic)
 import           System.Exit (die)
 
+import Network.Wai.Handler.Warp (HostPreference, Port, Settings, setHost, setPort)
+
 -- | Only local socket is supported, to avoid unauthorized connections.
 newtype Address = LocalSocket FilePath
   deriving stock (Eq, Generic, Show)
@@ -45,11 +53,16 @@ newtype Address = LocalSocket FilePath
 -- | Endpoint for internal services.
 data Endpoint = Endpoint
   { epHost :: !String
-  , epPort :: !Word16
+  , epPort :: !Port
   }
   deriving stock (Eq, Generic, Show)
   deriving anyclass (FromJSON, ToJSON)
 
+setEndpoint :: Endpoint -> Settings -> Settings
+setEndpoint Endpoint{epHost, epPort} settings = settings
+  & setPort            (epPort :: Port)
+  & setHost (fromString epHost :: HostPreference)
+
 -- | Parameters of rotation mechanism for logs.
 data RotationParams = RotationParams
   { rpFrequencySecs :: !Word32  -- ^ Rotation period, in seconds.
@@ -113,7 +126,7 @@ data TracerConfig = TracerConfig
   , network        :: !Network                      -- ^ How cardano-tracer will be connected to node(s).
   , loRequestNum   :: !(Maybe Word16)               -- ^ How many 'TraceObject's will be asked in each request.
   , ekgRequestFreq :: !(Maybe Pico)                 -- ^ How often to request for EKG-metrics, in seconds.
-  , hasEKG         :: !(Maybe (Endpoint, Endpoint)) -- ^ Endpoint for EKG web-page (list of nodes, monitoring).
+  , hasEKG         :: !(Maybe Endpoint)             -- ^ Endpoint for EKG web-page.
   , hasPrometheus  :: !(Maybe Endpoint)             -- ^ Endpoint for Prometheus web-page.
   , hasRTView      :: !(Maybe Endpoint)             -- ^ Endpoint for RTView web-page.
     -- | Socket for tracer's to reforward on. Second member of the triplet is the list of prefixes to reforward.
@@ -160,23 +173,26 @@ checkMeaninglessValues TracerConfig
     then Right ()
     else Left $ intercalate ", " problems
  where
+  problems :: [String]
   problems = catMaybes
     [ case network of
         AcceptAt addr -> check "AcceptAt is empty" $ nullAddress addr
         ConnectTo addrs -> check "ConnectTo are empty" $ null . NE.filter (not . nullAddress) $ addrs
     , check "empty logRoot(s)" $ notNull . NE.filter invalidFileMode $ logging
-    , (check "no host(s) in hasEKG" . nullEndpoints) =<< hasEKG
+    , (check "no host(s) in hasEKG"     . nullEndpoint) =<< hasEKG
     , (check "no host in hasPrometheus" . nullEndpoint) =<< hasPrometheus
-    , (check "no host in hasRTView" . nullEndpoint) =<< hasRTView
+    , (check "no host in hasRTView"     . nullEndpoint) =<< hasRTView
     ]
 
+  check :: String -> Bool -> Maybe String
   check msg cond = if cond then Just msg else Nothing
 
+  nullAddress :: Address -> Bool
   nullAddress (LocalSocket p) = null p
 
+  nullEndpoint :: Endpoint -> Bool
   nullEndpoint (Endpoint h _) = null h
 
-  nullEndpoints (ep1, ep2) = nullEndpoint ep1 || nullEndpoint ep2
-
+  invalidFileMode :: LoggingParams -> Bool
   invalidFileMode (LoggingParams root FileMode    _) = null root
   invalidFileMode (LoggingParams _    JournalMode _) = False