From 2ea89a2256c6a9cb45099baa52d1f1021a498daa Mon Sep 17 00:00:00 2001 From: Michael Karg Date: Wed, 4 Sep 2024 17:52:34 +0200 Subject: [PATCH] test app: same as before, but working --- bench/ekg-restart-test/CHANGELOG.md | 5 - bench/ekg-restart-test/app/Main.hs | 121 ------ bench/ekg-restart-test/ekg-restart-test.cabal | 54 --- cabal.project | 9 +- cardano-tracer/CHANGELOG.md | 11 + cardano-tracer/cardano-tracer.cabal | 7 +- .../configuration/complete-example.json | 14 +- .../configuration/complete-example.yaml | 4 +- .../demo/multi/active-tracer-config.json | 10 +- .../demo/multi/passive-tracer-config.json | 14 +- cardano-tracer/docs/cardano-tracer.md | 24 +- .../src/Cardano/Tracer/Acceptors/Utils.hs | 26 +- .../src/Cardano/Tracer/Configuration.hs | 52 ++- .../Tracer/Handlers/Metrics/Monitoring.hs | 374 ++---------------- .../Tracer/Handlers/Metrics/Prometheus.hs | 166 ++++---- .../Tracer/Handlers/Metrics/Servers.hs | 24 +- .../Cardano/Tracer/Handlers/Metrics/Utils.hs | 81 +++- .../src/Cardano/Tracer/Handlers/RTView/Run.hs | 9 +- nix/nixos/cardano-tracer-service.nix | 8 +- 19 files changed, 315 insertions(+), 698 deletions(-) delete mode 100644 bench/ekg-restart-test/CHANGELOG.md delete mode 100644 bench/ekg-restart-test/app/Main.hs delete mode 100644 bench/ekg-restart-test/ekg-restart-test.cabal diff --git a/bench/ekg-restart-test/CHANGELOG.md b/bench/ekg-restart-test/CHANGELOG.md deleted file mode 100644 index b90defb5ff6..00000000000 --- a/bench/ekg-restart-test/CHANGELOG.md +++ /dev/null @@ -1,5 +0,0 @@ -# Revision history for ekg-restart-test - -## 0.1.0.0 -- YYYY-mm-dd - -* First version. Released on an unsuspecting world. diff --git a/bench/ekg-restart-test/app/Main.hs b/bench/ekg-restart-test/app/Main.hs deleted file mode 100644 index dc7b69fb1d1..00000000000 --- a/bench/ekg-restart-test/app/Main.hs +++ /dev/null @@ -1,121 +0,0 @@ -{-# 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 System.Random -import Network.Wai.Middleware.RequestLogger -import System.Remote.Monitoring.Wai -import Network.HTTP.Types -import qualified Data.Map as Map -import Data.Map (Map) -import Data.Time.Clock.POSIX (getPOSIXTime) - -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] <- genStores 5 - - say $ - "run port: " ++ show port - - run port do logStdout do app stores - - --_ <- forkServerWith (head stores) "localhost" port - --forever $ threadDelay $ 1000 * 1000 - - -genStores :: Int -> IO [Store] -genStores count = do - mapM genStore [1 .. fromIntegral count] - where - getTimeMs = (round . (* 1000)) `fmap` getPOSIXTime - - 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 - - -app :: [Store] -> Application -app 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) - --- 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) diff --git a/bench/ekg-restart-test/ekg-restart-test.cabal b/bench/ekg-restart-test/ekg-restart-test.cabal deleted file mode 100644 index 2f3eb0bc2a4..00000000000 --- a/bench/ekg-restart-test/ekg-restart-test.cabal +++ /dev/null @@ -1,54 +0,0 @@ -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: ImportHidden - - -- 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 "-with-rtsopts=-T" - - hs-source-dirs: app - default-language: Haskell2010 diff --git a/cabal.project b/cabal.project index 9f4332fef87..a6c32f1c049 100644 --- a/cabal.project +++ b/cabal.project @@ -32,10 +32,6 @@ 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 @@ -52,7 +48,7 @@ package cryptonite flags: -support_rdrand package snap-server - flags: +openssl + flags: -openssl package bitvec flags: -simd @@ -66,8 +62,9 @@ constraints: allow-newer: , katip:Win32 + , ekg-wai:time + -- , ekg-wai:Win32-network -- IMPORTANT -- Do NOT add more source-repository-package stanzas here unless they are strictly -- temporary! Please read the section in CONTRIBUTING about updating dependencies. - diff --git a/cardano-tracer/CHANGELOG.md b/cardano-tracer/CHANGELOG.md index 3eba079f520..f055f08eaec 100644 --- a/cardano-tracer/CHANGELOG.md +++ b/cardano-tracer/CHANGELOG.md @@ -1,5 +1,16 @@ # ChangeLog +## 0.3 (September 20, 2024) + +* Abondon `snap` webserver in favour of `wai`/`warp` for Prometheus and EKG Monitoring. +* Add dynamic routing to EKG stores of all connected nodes. +* Derive URL compliant routes from connected node names (instead of plain node names). +* Remove the requirement of two distinct ports for the EKG backend (changing `hasEKG` config type). +* For optional RTView component only: Disable SSL/https connections. Force `snap-server` + dependency to build with `-flag -openssl`. +* Add JSON responses when listing connected nodes for both Prometheus and EKG Monitoring. +* Add consistency check for redundant port values in the config. + ## 0.2.4 (August 13, 2024) * `systemd` is enabled by default. To disable it use the cabal diff --git a/cardano-tracer/cardano-tracer.cabal b/cardano-tracer/cardano-tracer.cabal index 35ac26b091c..4e3e28cd327 100644 --- a/cardano-tracer/cardano-tracer.cabal +++ b/cardano-tracer/cardano-tracer.cabal @@ -1,7 +1,7 @@ cabal-version: 3.0 name: cardano-tracer -version: 0.2.4 +version: 0.3 synopsis: A service for logging and monitoring over Cardano nodes description: A service for logging and monitoring over Cardano nodes. category: Cardano, @@ -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 @@ -194,7 +192,6 @@ library , trace-resources , unordered-containers , wai - , wai-extra , warp , yaml diff --git a/cardano-tracer/configuration/complete-example.json b/cardano-tracer/configuration/complete-example.json index f788e2bf821..eea7606ab44 100644 --- a/cardano-tracer/configuration/complete-example.json +++ b/cardano-tracer/configuration/complete-example.json @@ -6,16 +6,10 @@ }, "loRequestNum": 100, "ekgRequestFreq": 2, - "hasEKG": [ - { - "epHost": "127.0.0.1", - "epPort": 3100 - }, - { - "epHost": "127.0.0.1", - "epPort": 3101 - } - ], + "hasEKG": { + "epHost": "127.0.0.1", + "epPort": 3100 + }, "hasPrometheus": { "epHost": "127.0.0.1", "epPort": 3000 diff --git a/cardano-tracer/configuration/complete-example.yaml b/cardano-tracer/configuration/complete-example.yaml index 6afba4a652c..a4004864762 100644 --- a/cardano-tracer/configuration/complete-example.yaml +++ b/cardano-tracer/configuration/complete-example.yaml @@ -7,10 +7,8 @@ network: loRequestNum: 100 ekgRequestFreq: 2 hasEKG: -- epHost: 127.0.0.1 + epHost: 127.0.0.1 epPort: 3100 -- epHost: 127.0.0.1 - epPort: 3101 hasPrometheus: epHost: 127.0.0.1 epPort: 3000 diff --git a/cardano-tracer/demo/multi/active-tracer-config.json b/cardano-tracer/demo/multi/active-tracer-config.json index 00187fd1ac4..467a460f67f 100644 --- a/cardano-tracer/demo/multi/active-tracer-config.json +++ b/cardano-tracer/demo/multi/active-tracer-config.json @@ -8,16 +8,10 @@ "/run/user/1000/cardano-tracer-demo-3.sock" ] }, - "hasEKG": [ - { + "hasEKG": { "epHost": "127.0.0.1", "epPort": 3100 - }, - { - "epHost": "127.0.0.1", - "epPort": 3101 - } - ], + }, "hasPrometheus": { "epHost": "127.0.0.1", "epPort": 3000 diff --git a/cardano-tracer/demo/multi/passive-tracer-config.json b/cardano-tracer/demo/multi/passive-tracer-config.json index 7e06ca8dfd4..868781da7d2 100644 --- a/cardano-tracer/demo/multi/passive-tracer-config.json +++ b/cardano-tracer/demo/multi/passive-tracer-config.json @@ -4,16 +4,10 @@ "tag": "AcceptAt", "contents": "/run/user/1000/cardano-tracer-demo-1.sock" }, - "hasEKG": [ - { - "epHost": "127.0.0.1", - "epPort": 3100 - }, - { - "epHost": "127.0.0.1", - "epPort": 3101 - } - ], + "hasEKG": { + "epHost": "127.0.0.1", + "epPort": 3100 + }, "hasPrometheus": { "epHost": "127.0.0.1", "epPort": 3000 diff --git a/cardano-tracer/docs/cardano-tracer.md b/cardano-tracer/docs/cardano-tracer.md index 172e189cb4e..2ce759a89a8 100644 --- a/cardano-tracer/docs/cardano-tracer.md +++ b/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: diff --git a/cardano-tracer/src/Cardano/Tracer/Acceptors/Utils.hs b/cardano-tracer/src/Cardano/Tracer/Acceptors/Utils.hs index a28e89c6a9f..a07f911f046 100644 --- a/cardano-tracer/src/Cardano/Tracer/Acceptors/Utils.hs +++ b/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,26 @@ prepareMetricsStores -> IO (EKG.Store, TVar MetricsLocalStore) prepareMetricsStores TracerEnv{teConnectedNodes, teAcceptedMetrics} connId = do addConnectedNode teConnectedNodes connId - storesForNewNode <- (,) <$> EKG.newStore - <*> newTVarIO emptyMetricsLocalStore - atomically $ - modifyTVar' teAcceptedMetrics $ M.insert (connIdToNodeId connId) storesForNewNode + store <- EKG.newStore + + EKG.registerCounter "ekg.server_timestamp_ms" getTimeMs store + storesForNewNode <- (store ,) <$> newTVarIO emptyMetricsLocalStore + + atomically do + modifyTVar' teAcceptedMetrics do + 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 diff --git a/cardano-tracer/src/Cardano/Tracer/Configuration.hs b/cardano-tracer/src/Cardano/Tracer/Configuration.hs index 5dc607b1a1b..b52e028ab84 100644 --- a/cardano-tracer/src/Cardano/Tracer/Configuration.hs +++ b/cardano-tracer/src/Cardano/Tracer/Configuration.hs @@ -1,5 +1,6 @@ {-# LANGUAGE DeriveAnyClass #-} {-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE DuplicateRecordFields #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE OverloadedStrings #-} @@ -9,6 +10,7 @@ module Cardano.Tracer.Configuration ( Address (..) , Endpoint (..) + , setEndpoint , LogFormat (..) , LogMode (..) , LoggingParams (..) @@ -24,19 +26,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 (intercalate, nub) 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 +51,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 +124,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. @@ -137,8 +148,8 @@ readTracerConfig pathToConfig = decodeFileEither pathToConfig >>= \case Left e -> die $ "Invalid tracer's configuration: " <> show e Right (config :: TracerConfig) -> - case checkMeaninglessValues config of - Left problems -> die $ "Tracer's configuration is meaningless: " <> problems + case wellFormed config of + Left problems -> die $ "Tracer's configuration is ill-formed: " <> problems Right{} -> return (nubLogging config) where @@ -148,8 +159,8 @@ readTracerConfig pathToConfig = { logging = NE.nub logging } -checkMeaninglessValues :: TracerConfig -> Either String () -checkMeaninglessValues TracerConfig +wellFormed :: TracerConfig -> Either String () +wellFormed TracerConfig { network , hasEKG , hasPrometheus @@ -160,23 +171,34 @@ 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 in hasPrometheus" . nullEndpoint) =<< hasPrometheus - , (check "no host in hasRTView" . nullEndpoint) =<< hasRTView + 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" . nullEndpoint =<< hasEKG + , check "no host in hasPrometheus" . nullEndpoint =<< hasPrometheus + , check "no host in hasRTView" . nullEndpoint =<< hasRTView + , check "duplicate ports in config" (hasRepeats ports) ] - check msg cond = if cond then Just msg else Nothing + ports :: [Port] + ports = epPort <$> catMaybes [hasEKG, hasPrometheus, hasRTView] + + check :: String -> Bool -> Maybe String + check msg True = Just msg + check _ False = 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 + +hasRepeats :: Ord a => [a] -> Bool +hasRepeats xs = nub xs /= xs diff --git a/cardano-tracer/src/Cardano/Tracer/Handlers/Metrics/Monitoring.hs b/cardano-tracer/src/Cardano/Tracer/Handlers/Metrics/Monitoring.hs index 3968d4cd75f..50873a5d16b 100644 --- a/cardano-tracer/src/Cardano/Tracer/Handlers/Metrics/Monitoring.hs +++ b/cardano-tracer/src/Cardano/Tracer/Handlers/Metrics/Monitoring.hs @@ -1,13 +1,9 @@ -{-# Options_GHC -w #-} - -{-# LANGUAGE LambdaCase #-} {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-} module Cardano.Tracer.Handlers.Metrics.Monitoring ( runMonitoringServer - , runMonitoringServerWai ) where import Prelude hiding (head) @@ -19,60 +15,25 @@ import Cardano.Tracer.Handlers.SSL.Certs import Cardano.Tracer.MetaTrace import Cardano.Tracer.Types -import Control.Concurrent (ThreadId) -import Control.Concurrent.STM (atomically) -import Control.Concurrent.STM.TMVar (TMVar, newEmptyTMVarIO, putTMVar, tryReadTMVar) -import Control.Concurrent.STM.TVar (readTVar, readTVarIO) #if RTVIEW import Control.Monad (forM, void) #endif -import Control.Monad.Extra (whenJust) -import Control.Monad.IO.Class (liftIO) -import qualified Data.ByteString.Lazy as Lazy -#if !RTVIEW -import Data.Foldable -import Data.Function ((&)) -#endif -import qualified Data.Map.Strict as M -import Data.Map.Strict (Map) -import qualified Data.Set as Set -#if !RTVIEW -import Data.String -#endif import qualified Data.Text as T -import Data.Text (Text) -import Data.Text.Encoding (encodeUtf8) --- import System.Remote.Monitoring hiding (forkServerWith) import System.Time.Extra (sleep) -#if !RTVIEW -import System.IO.Unsafe (unsafePerformIO) -import Text.Blaze.Html5 hiding (map) -import Text.Blaze.Html5.Attributes hiding (head, title) -import qualified Text.Blaze.Html5.Attributes as Attr -#endif #if RTVIEW import qualified Graphics.UI.Threepenny as UI import Graphics.UI.Threepenny.Core (Element, UI, set, (#), (#+)) -#else -import Text.Blaze.Html.Renderer.Utf8 (renderHtml) -import Snap.Blaze (blaze) -import Snap.Core (Snap, route) -import Snap.Http.Server (Config, ConfigLog (..), defaultConfig, setAccessLog, setBind, - setErrorLog, setPort, simpleHttpServe) #endif -import Network.Wai.Middleware.Approot (approotMiddleware) +import qualified Cardano.Tracer.Handlers.Metrics.Utils as Utils +import Cardano.Tracer.Handlers.Metrics.Utils (renderListOfConnectedNodes) +import Data.ByteString.Builder (stringUtf8) +import Network.HTTP.Types +import Network.Wai +import Network.Wai.Handler.Warp (runSettings, defaultSettings) import qualified System.Metrics as EKG -import Text.Slugify -import Data.Bifunctor (first) -import Data.ByteString.Builder (stringUtf8) -import qualified Data.Bimap as Bimap -import System.Remote.Monitoring.Wai -import Network.Wai -import Network.Wai.Internal -import Network.Wai.Handler.Warp hiding (setPort) -import Network.HTTP.Types +import System.Remote.Monitoring.Wai -- | 'ekg' package allows to run only one EKG server, to display only one web page -- for particular EKG.Store. Since 'cardano-tracer' can be connected to any number @@ -81,301 +42,46 @@ import Network.HTTP.Types -- redirected to the monitoring web page (the second 'Endpoint') built by 'ekg' package. -- This page will display the metrics received from that node. -- --- If the user returns to the first web page and clicks to another node's href, + -- If the user returns to the first web page and clicks to another node's href, -- the EKG server will be restarted and the monitoring page will display the metrics -- received from that node. runMonitoringServer :: TracerEnv - -> (Endpoint, Endpoint) -- ^ (web page with list of connected nodes, EKG web page). + -> Endpoint -- ^ (web page with list of connected nodes, EKG web page). + -> IO Utils.RouteDictionary -> IO () -#if RTVIEW -runMonitoringServer tracerEnv (endpoint@(Endpoint listHost listPort), monitorEP) = do +runMonitoringServer TracerEnv{teTracer} endpoint computeRoutes_autoUpdate = do -- Pause to prevent collision between "Listening"-notifications from servers. sleep 0.2 - (certFile, keyFile) <- placeDefaultSSLFiles tracerEnv - traceWith (teTracer tracerEnv) TracerStartedMonitoring + traceWith teTracer TracerStartedMonitoring { ttMonitoringEndpoint = endpoint , ttMonitoringType = "list" } - UI.startGUI (config certFile keyFile) \window -> do - void $ return window # set UI.title "EKG Monitoring Nodes" - void $ mkPageBody window tracerEnv monitorEP - where - config cert key = - UI.defaultConfig - { UI.jsLog = const $ return () - , UI.jsUseSSL = - Just $ UI.ConfigSSL - { UI.jsSSLBind = encodeUtf8 $ T.pack listHost - , UI.jsSSLPort = fromIntegral listPort - , UI.jsSSLCert = cert - , UI.jsSSLKey = key - , UI.jsSSLChainCert = False - } - } -#else -runMonitoringServer tracerEnv (endpoint@(Endpoint listHost listPort), monitorEP) = do - -- Pause to prevent collision between "Listening"-notifications from servers. - sleep 0.2 - traceWith (teTracer tracerEnv) TracerStartedMonitoring - { ttMonitoringEndpoint = endpoint - , ttMonitoringType = "list" - } - simpleHttpServe config do - route - [ ("/", renderEkg) - ] - where - TracerEnv{teConnectedNodes} = tracerEnv - - config :: Config Snap () - config = defaultConfig - & setErrorLog ConfigNoLog - & setAccessLog ConfigNoLog - & setBind (encodeUtf8 (T.pack listHost)) - & setPort (fromIntegral listPort) - - renderEkg :: Snap () - renderEkg = do - nodes <- liftIO $ Set.toList <$> readTVarIO teConnectedNodes - -- HACK - case nodes of - [] -> - pure () - nodeId:_nodes -> liftIO do - restartEKGServer tracerEnv nodeId monitorEP currentServerHack - blaze do - docTypeHtml do - ekgHtml monitorEP nodes - -{-# NOINLINE currentServerHack #-} --- | There is supposed to be one EKG server per port. The desired EKG --- server for the connected node gets restarted always on the same --- port. We limit functionality to only run one EKG server, this will --- be resolved in a future PR. -currentServerHack :: CurrentEKGServer -currentServerHack = unsafePerformIO newEmptyTMVarIO - -ekgHtml - :: Endpoint - -> [NodeId] - -> Html -ekgHtml (Endpoint monitorHost monitorPort) = \case - [] -> - toHtml @T.Text "ekgHtml: There are no connected nodes yet" - connectedNodes -> do - for_ connectedNodes \(NodeId anId) -> - li do - a ! href (fromString ("http://" <> monitorHost <> ":" <> show monitorPort)) - ! target "_blank" - ! Attr.title "Open EKG monitor page for this node" - $ toHtml anId -#endif - -runMonitoringServerWai - :: TracerEnv - -> (Endpoint, Endpoint) -- ^ (web page with list of connected nodes, EKG web page). - -> IO () -runMonitoringServerWai tracerEnv (endpoint@(Endpoint listHost listPort), monitorEP) = do - -- Pause to prevent collision between "Listening"-notifications from servers. - sleep 0.2 - traceWith (teTracer tracerEnv) TracerStartedMonitoring - { ttMonitoringEndpoint = endpoint - , ttMonitoringType = "list" - } - run (fromIntegral listPort :: Port) do - renderEkg - -- simpleHttpServe config do - -- route - -- [ ("/", renderEkg) - -- ] - - -- run port do logStdout do app - - where - TracerEnv{teConnectedNodesNames, teAcceptedMetrics} = tracerEnv - - -- config :: Config Snap () - -- config = defaultConfig - -- & setErrorLog ConfigNoLog - -- & setAccessLog ConfigNoLog - -- & setBind (encodeUtf8 (T.pack listHost)) - -- & setPort (fromIntegral listPort) - - -- renderEkg :: Request -> (Response -> IO ..) -> IO .. - renderEkg :: Application - renderEkg request send = do - (nodeNames :: [NodeName], routeDictionary :: [(Text, MetricsStores)]) <- - atomically do - nIdsWithNames :: Map NodeId NodeName <- - Bimap.toMap <$> readTVar teConnectedNodesNames - - acceptedMetrics :: Map NodeId MetricsStores <- - readTVar teAcceptedMetrics - - let x :: [(NodeName, MetricsStores)] - x = M.elems (M.intersectionWith (,) nIdsWithNames acceptedMetrics) - - pure (M.elems nIdsWithNames, fmap (first slugify) x) - - case pathInfo request of - [] -> - case routeDictionary of - (_, (store :: EKG.Store, _)):_ -> monitor store request send - ["list"] -> - send $ responseLBS status200 [] (renderListOfConnectedNodes endpoint nodeNames) - route:_ - | Just (store :: EKG.Store, _tvar :: _TVar _MetricsLocalStore) <- lookup route routeDictionary - -> monitor store request { pathInfo = tail (pathInfo request) } send - | otherwise - -> send $ responseBuilder status404 [] do - "Route (" <> stringUtf8 (show route) <> ") not found\n" <> stringUtf8 (show nodeNames) <> "\n" <> stringUtf8 (show (fmap fst routeDictionary)) - path -> send $ responseBuilder status404 [] do - "Not found: " <> stringUtf8 (show path) <> "\n" <> stringUtf8 (show nodeNames) <> "\n" <> stringUtf8 (show (fmap fst routeDictionary)) --- run port $ do --- path <- pathInfo <$> getRequestBody --- let store = lookup path connectedNodes --- case store of --- Just store' -> monitor store' --- Nothing -> response404 - -- undefined - -- nodes <- liftIO $ S.toList <$> readTVarIO teConnectedNodes - -- -- HACK - -- case nodes of - -- [] -> - -- pure () - -- nodeId:_nodes -> liftIO do - -- restartEKGServer tracerEnv nodeId monitorEP currentServerHack - -- blaze do - -- docTypeHtml do - -- ekgHtml monitorEP nodes - -renderListOfConnectedNodes :: Endpoint -> [NodeName] -> Lazy.ByteString -renderListOfConnectedNodes (Endpoint host port) = \case - [] -> - "There are no connected nodes yet." - nodenames -> - renderHtml $ mkPage mkHref nodenames - where - - mkHref :: NodeName -> Markup - mkHref nodeName = - a ! href (textValue ("/" <> slugify nodeName)) - $ toHtml nodeName' - where - nodeName' = T.unpack nodeName - - mkPage :: (NodeName -> Markup) -> [NodeName] -> Html - mkPage f hrefs = html do - head . title $ "EKG metrics" - body . ul $ for_ hrefs (li . f) - -type CurrentEKGServer = TMVar (NodeId, ThreadId) -#if RTVIEW --- | The first web page contains only the list of hrefs --- corresponding to currently connected nodes. -mkPageBody - :: UI.Window - -> TracerEnv - -> Endpoint - -> UI Element -mkPageBody window tracerEnv mEP@(Endpoint monitorHost monitorPort) = do - nodes <- liftIO $ Set.toList <$> readTVarIO teConnectedNodes - nodesHrefs <- - if null nodes - then UI.string "There are no connected nodes yet" - else do - currentServer :: CurrentEKGServer <- liftIO newEmptyTMVarIO - nodesLinks <- - forM nodes \nodeId@(NodeId anId) -> do - nodeLink <- - UI.li #+ - [ UI.anchor # set UI.href ("http://" <> monitorHost <> ":" <> show monitorPort) - # set UI.target "_blank" - # set UI.title__ "Open EKG monitor page for this node" - # set UI.text (T.unpack anId) - ] - void $ UI.on UI.click nodeLink $ const do - liftIO do - restartEKGServer - tracerEnv nodeId mEP currentServer - return $ UI.element nodeLink - UI.ul #+ nodesLinks - UI.getBody window #+ [ UI.element nodesHrefs ] - where - TracerEnv{teConnectedNodes} = tracerEnv -#endif - --- | After clicking on the node's href, the user will be redirected to the monitoring page --- which is rendered by 'ekg' package. But before, we have to check if EKG server is --- already launched, and if so, restart the server if needed. -restartEKGServer - :: TracerEnv - -> NodeId - -> Endpoint - -> CurrentEKGServer - -> IO () -restartEKGServer TracerEnv{teAcceptedMetrics, teTracer} newNodeId - endpoint@(Endpoint monitorHost monitorPort) currentServer = do - metrics <- readTVarIO teAcceptedMetrics - whenJust (metrics M.!? newNodeId) \(storeForSelectedNode, _) -> do - atomically (tryReadTMVar currentServer) >>= \case - Just (_curNodeId, _sThread) -> - -- TODO: Currently we cannot restart EKG server, - -- please see https://github.com/tibbe/ekg/issues/87 - return () - -- unless (newNodeId == curNodeId) do - -- killThread sThread - -- runEKGAndSave storeForSelectedNode - Nothing -> - -- Current server wasn't stored yet, it's a first click on the href. - runEKGAndSave storeForSelectedNode - where - runEKGAndSave store = do - traceWith teTracer TracerStartedMonitoring - { ttMonitoringEndpoint = endpoint - , ttMonitoringType = "monitor" - } - ekgServer <- forkServerWith store - (encodeUtf8 . T.pack $ monitorHost) - (fromIntegral monitorPort) - atomically do - putTMVar currentServer (newNodeId, serverThreadId ekgServer) - -{- --- | After clicking on the node's href, the user will be redirected to the monitoring page --- which is rendered by 'ekg' package. But before, we have to check if EKG server is --- already launched, and if so, restart the server if needed. -restartEKGServer' - :: TracerEnv - -> NodeId - -> Endpoint - -> CurrentEKGServer - -> IO () -restartEKGServer' TracerEnv{teAcceptedMetrics, teTracer} newNodeId - endpoint@(Endpoint monitorHost monitorPort) currentServer = do - metrics <- readTVarIO teAcceptedMetrics - whenJust (metrics M.!? newNodeId) \(storeForSelectedNode, _) -> do - atomically (tryReadTMVar currentServer) >>= \case - Just (_curNodeId, _sThread) -> - -- TODO: Currently we cannot restart EKG server, - -- please see https://github.com/tibbe/ekg/issues/87 - return () - -- unless (newNodeId == curNodeId) do - -- killThread sThread - -- runEKGAndSave storeForSelectedNode - Nothing -> - -- Current server wasn't stored yet, it's a first click on the href. - runEKGAndSave storeForSelectedNode - where - runEKGAndSave store = do - traceWith teTracer TracerStartedMonitoring - { ttMonitoringEndpoint = endpoint - , ttMonitoringType = "monitor" - } - ekgServer <- forkServerWith store - (encodeUtf8 . T.pack $ monitorHost) - (fromIntegral monitorPort) - atomically do - putTMVar currentServer (newNodeId, serverThreadId ekgServer) --} + dummyStore <- EKG.newStore + runSettings (setEndpoint endpoint defaultSettings) do + renderEkg dummyStore computeRoutes_autoUpdate + +renderEkg :: EKG.Store -> IO Utils.RouteDictionary -> Application +renderEkg dummyStore computeRoutes_autoUpdate request send = do + routeDictionary :: Utils.RouteDictionary <- + computeRoutes_autoUpdate + + let nodeNames :: [NodeName] + nodeNames = Utils.nodeNames routeDictionary + + case pathInfo request of + [] -> + send $ responseLBS status200 [] (renderListOfConnectedNodes "EKG metrics" nodeNames) + route:rest + | Just (store :: EKG.Store, _ :: NodeName) + <- lookup route (Utils.getRouteDictionary routeDictionary) + -> monitor store request { pathInfo = rest } send + -- all endings in ekg-wai's asset/ folder + | any (`T.isSuffixOf` route) [".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 request send + | otherwise + -> send $ responseBuilder status404 [] do + "Not found: " + <> stringUtf8 (show route) + <> "\n" <> stringUtf8 (show nodeNames) diff --git a/cardano-tracer/src/Cardano/Tracer/Handlers/Metrics/Prometheus.hs b/cardano-tracer/src/Cardano/Tracer/Handlers/Metrics/Prometheus.hs index 4290e17a8da..20fad5fa3e1 100644 --- a/cardano-tracer/src/Cardano/Tracer/Handlers/Metrics/Prometheus.hs +++ b/cardano-tracer/src/Cardano/Tracer/Handlers/Metrics/Prometheus.hs @@ -1,4 +1,3 @@ -{-# LANGUAGE LambdaCase #-} {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-} @@ -10,32 +9,26 @@ module Cardano.Tracer.Handlers.Metrics.Prometheus import Cardano.Tracer.Configuration import Cardano.Tracer.Environment import Cardano.Tracer.MetaTrace -import Cardano.Tracer.Types -import Cardano.Tracer.Utils import Prelude hiding (head) -import Control.Concurrent.STM.TVar (readTVarIO) -import Control.Monad (forever) -import Control.Monad.IO.Class (liftIO) -import qualified Data.Bimap as BM -import Data.Function ((&)) +import Data.ByteString.Builder (stringUtf8) import Data.Functor ((<&>)) -import qualified Data.HashMap.Strict as HM -import qualified Data.Map.Strict as M -import Data.String (IsString (..)) +import Data.Map.Strict (Map) import Data.Text (Text) -import qualified Data.Text as T -import Data.Text.Encoding (decodeUtf8, encodeUtf8) +import Network.HTTP.Types +import Network.Wai hiding (responseHeaders) +import Network.Wai.Handler.Warp (runSettings, defaultSettings) import System.Metrics (Sample, Value (..), sampleAll) import System.Time.Extra (sleep) -import Text.Blaze.Html5 hiding (map) -import Text.Blaze.Html5.Attributes hiding (title) - -import Snap.Blaze (blaze) -import Snap.Core (Snap, getRequest, route, rqParams, writeText) -import Snap.Http.Server (Config, ConfigLog (..), defaultConfig, setAccessLog, setBind, - setErrorLog, setPort, simpleHttpServe) +import qualified Cardano.Tracer.Handlers.Metrics.Utils as Utils +import qualified Data.ByteString as ByteString +import qualified Data.HashMap.Strict as HM +import qualified Data.Map.Strict as Map +import qualified Data.Text as T +import qualified Data.Text.Lazy as Lazy.Text +import qualified Data.Text.Lazy.Encoding as Lazy.Text +import qualified System.Metrics as EKG -- | Runs simple HTTP server that listens host and port and returns -- the list of currently connected nodes in such a format: @@ -59,84 +52,78 @@ import Snap.Http.Server (Config, ConfigLog (..), defaultConfig, setAcc runPrometheusServer :: TracerEnv -> Endpoint + -> IO Utils.RouteDictionary -> IO () -runPrometheusServer tracerEnv endpoint@(Endpoint host port) = forever do +runPrometheusServer tracerEnv endpoint computeRoutes_autoUpdate = do -- Pause to prevent collision between "Listening"-notifications from servers. sleep 0.1 -- If everything is okay, the function 'simpleHttpServe' never returns. -- But if there is some problem, it never throws an exception, but just stops. -- So if it stopped - it will be re-started. - traceWith (teTracer tracerEnv) TracerStartedPrometheus + traceWith teTracer TracerStartedPrometheus { ttPrometheusEndpoint = endpoint } - simpleHttpServe config do - route - [ ("/", renderListOfConnectedNodes) - , ("/:nodename", renderMetricsFromNode) - ] - sleep 1.0 - where - TracerEnv{teConnectedNodesNames, teAcceptedMetrics} = tracerEnv - - config :: Config Snap () - config = defaultConfig - & setErrorLog ConfigNoLog - & setAccessLog ConfigNoLog - & setBind (encodeUtf8 (T.pack host)) - & setPort (fromIntegral port) - - renderListOfConnectedNodes :: Snap () - renderListOfConnectedNodes = do - nIdsWithNames <- liftIO $ readTVarIO teConnectedNodesNames - if BM.null nIdsWithNames - then writeText "There are no connected nodes yet." - else blaze . mkPage . map mkHref $ BM.toList nIdsWithNames - - mkHref (_, nodeName) = - a ! href (fromString $ "http://" <> host <> ":" <> show port <> "/" <> nodeName') - $ toHtml nodeName' - where - nodeName' = T.unpack nodeName - - mkPage hrefs = html $ do - head . title $ "Prometheus metrics" - body . ul $ mapM_ li hrefs - - renderMetricsFromNode :: Snap () - renderMetricsFromNode = do - reqParams <- rqParams <$> getRequest - case M.lookup "nodename" reqParams of - Just [nodeName] -> do - liftIO (askNodeId tracerEnv $ decodeUtf8 nodeName) >>= \case - Nothing -> writeText "No such a node!" - Just anId -> writeText =<< liftIO (getMetricsFromNode tracerEnv anId teAcceptedMetrics) - _ -> writeText "No such a node!" + runSettings (setEndpoint endpoint defaultSettings) do + renderPrometheus computeRoutes_autoUpdate metricsComp where + + TracerEnv + { teTracer + , teConfig = TracerConfig { metricsComp } + } = tracerEnv + +renderPrometheus :: IO Utils.RouteDictionary -> Maybe (Map Text Text) -> Application +renderPrometheus computeRoutes_autoUpdate metricsComp request send = do + -- TODO: I'll create a new store every time (tentative). + routeDictionary :: Utils.RouteDictionary <- + computeRoutes_autoUpdate + + let header :: RequestHeaders + header = requestHeaders request + + let wantsJson :: Bool + wantsJson = all @Maybe ("application/json" `ByteString.isInfixOf`) (lookup hAccept header) + + let responseHeaders :: ResponseHeaders + responseHeaders = [(hContentType, if wantsJson then "application/json" else "text/html")] + + case pathInfo request of + + [] -> + send $ responseLBS status200 responseHeaders if wantsJson + then Utils.renderJson routeDictionary + else Utils.renderListOfConnectedNodes "Prometheus metrics" (Utils.nodeNames routeDictionary) + + route:_ + | Just (store :: EKG.Store, _) <- lookup route (Utils.getRouteDictionary routeDictionary) + -> do metrics <- getMetricsFromNode metricsComp store + send $ responseLBS status200 [(hContentType, "text/plain")] (Lazy.Text.encodeUtf8 (Lazy.Text.fromStrict metrics)) + + -- all endings in ekg-wai's asset/ folder + | otherwise + -> send $ responseBuilder status404 [(hContentType, "text/plain")] do + "Not found: " + <> stringUtf8 (show route) type MetricName = Text type MetricValue = Text type MetricsList = [(MetricName, MetricValue)] getMetricsFromNode - :: TracerEnv - -> NodeId - -> AcceptedMetrics + :: Maybe (Map Text Text) + -> EKG.Store -> IO Text -getMetricsFromNode tracerEnv nodeId acceptedMetrics = - readTVarIO acceptedMetrics >>= - (\case - Nothing -> - return "No such a node!" - Just (ekgStore, _) -> - sampleAll ekgStore <&> renderListOfMetrics . getListOfMetrics - ) . M.lookup nodeId +getMetricsFromNode metricsComp ekgStore = + sampleAll ekgStore <&> renderListOfMetrics . getListOfMetrics where + getListOfMetrics :: Sample -> MetricsList getListOfMetrics = - metricsCompatibility - . filter (not . T.null . fst) - . map metricsWeNeed - . HM.toList + metricsCompatibility + . filter (not . T.null . fst) + . map metricsWeNeed + . HM.toList + metricsWeNeed :: (Text, Value) -> (Text, Text) metricsWeNeed (mName, mValue) = case mValue of Counter c -> (mName, T.pack $ show c) @@ -144,23 +131,24 @@ getMetricsFromNode tracerEnv nodeId acceptedMetrics = Label l -> (mName, l) _ -> ("", "") -- 'ekg-forward' doesn't support 'Distribution' yet. + metricsCompatibility :: MetricsList -> MetricsList + metricsCompatibility metricsList = + case metricsComp of + Nothing -> metricsList + Just mmap -> foldl (\ accu p'@(mn,mv) -> case Map.lookup mn mmap of + Nothing -> p' : accu + Just rep -> p' : (rep,mv) : accu) + [] + metricsList + renderListOfMetrics :: MetricsList -> Text renderListOfMetrics [] = "No metrics were received from this node." renderListOfMetrics mList = T.intercalate "\n" $ map (\(mName, mValue) -> prepareName mName <> " " <> mValue) mList + prepareName :: Text -> Text prepareName = T.filter (`elem` (['0'..'9'] ++ ['a'..'z'] ++ ['A'..'Z'] ++ ['_'])) . T.replace " " "_" . T.replace "-" "_" . T.replace "." "_" - - metricsCompatibility :: MetricsList -> MetricsList - metricsCompatibility metricsList = - case metricsComp (teConfig tracerEnv) of - Nothing -> metricsList - Just mmap -> foldl (\ accu p'@(mn,mv) -> case M.lookup mn mmap of - Nothing -> p' : accu - Just rep -> p' : (rep,mv) : accu) - [] - metricsList diff --git a/cardano-tracer/src/Cardano/Tracer/Handlers/Metrics/Servers.hs b/cardano-tracer/src/Cardano/Tracer/Handlers/Metrics/Servers.hs index 208d121c601..8ecbd0f874b 100644 --- a/cardano-tracer/src/Cardano/Tracer/Handlers/Metrics/Servers.hs +++ b/cardano-tracer/src/Cardano/Tracer/Handlers/Metrics/Servers.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE NumericUnderscores #-} {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE CPP #-} @@ -9,7 +10,9 @@ import Cardano.Tracer.Configuration import Cardano.Tracer.Environment import Cardano.Tracer.Handlers.Metrics.Monitoring import Cardano.Tracer.Handlers.Metrics.Prometheus +import qualified Cardano.Tracer.Handlers.Metrics.Utils as Utils +import Control.AutoUpdate import Control.Concurrent.Async.Extra (sequenceConcurrently) import Control.Monad (void) import Data.Maybe (catMaybes) @@ -22,14 +25,27 @@ import Data.Maybe (catMaybes) runMetricsServers :: TracerEnv -> IO () -runMetricsServers tracerEnv = void do sequenceConcurrently servers +runMetricsServers tracerEnv + | null servers + = pure () + | otherwise = do + computeRoutes_autoUpdate :: IO Utils.RouteDictionary <- + mkAutoUpdate defaultUpdateSettings + { updateAction = Utils.computeRoutes tracerEnv + , updateFreq = 1_000_000 -- 1/sec + } + + void do + sequenceConcurrently (servers `routing` computeRoutes_autoUpdate) where - servers :: [IO ()] + routing :: [IO Utils.RouteDictionary -> a] -> IO Utils.RouteDictionary -> [a] + routing = sequence + + servers :: [IO Utils.RouteDictionary -> IO ()] servers = catMaybes [ runPrometheusServer tracerEnv <$> hasPrometheus - , runMonitoringServerWai tracerEnv <$> hasEKG - -- , runMonitoringServer tracerEnv <$> hasEKG + , runMonitoringServer tracerEnv <$> hasEKG ] TracerEnv diff --git a/cardano-tracer/src/Cardano/Tracer/Handlers/Metrics/Utils.hs b/cardano-tracer/src/Cardano/Tracer/Handlers/Metrics/Utils.hs index 5f786d2c0f7..8e0168cfa74 100644 --- a/cardano-tracer/src/Cardano/Tracer/Handlers/Metrics/Utils.hs +++ b/cardano-tracer/src/Cardano/Tracer/Handlers/Metrics/Utils.hs @@ -1,15 +1,42 @@ +{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE OverloadedStrings #-} + module Cardano.Tracer.Handlers.Metrics.Utils ( MetricName , MetricValue , MetricsList + , RouteDictionary(..) , getListOfMetrics + , renderListOfConnectedNodes + , renderJson + , nodeNames + , computeRoutes ) where -import qualified Data.HashMap.Strict as HM +import qualified Data.ByteString.Lazy as Lazy import Data.Maybe (mapMaybe) +import Data.Foldable (for_) +import qualified Data.HashMap.Strict as HM +import qualified Data.Map as Map +import Data.Map (Map) import Data.Text (Text) import qualified Data.Text as T +import Prelude hiding (head) +import qualified Data.Bimap as Bimap + +import Control.Concurrent.STM (atomically) +import Control.Concurrent.STM.TVar (readTVar) +import Data.Aeson (encode) +import Cardano.Tracer.Environment (TracerEnv(..)) +import qualified System.Metrics as EKG +import Cardano.Tracer.Types (NodeName, NodeId, MetricsStores) import System.Metrics (Store, Value (..), sampleAll) +import Text.Blaze.Html (Html) +import Text.Blaze.Html.Renderer.Utf8 (renderHtml) +import Text.Blaze.Html5 (Markup, a, li, ul, body, title, head, (!), textValue, html, toHtml) -- hiding (map) +import Text.Blaze.Html5.Attributes hiding (title) +import Text.Slugify (slugify) + type MetricName = Text type MetricValue = Text @@ -24,3 +51,55 @@ getListOfMetrics = fmap (mapMaybe metricsWeNeed . HM.toList) . sampleAll Gauge g -> Just (mName, T.pack $ show g) Label l -> Just (mName, l) _ -> Nothing -- 'ekg-forward' doesn't support 'Distribution' yet. + +newtype RouteDictionary = RouteDictionary + { getRouteDictionary :: [(Text, (EKG.Store, NodeName))] + } + +renderListOfConnectedNodes :: Text -> [NodeName] -> Lazy.ByteString +renderListOfConnectedNodes metricsTitle nodenames + | [] <- nodenames + = "There are no connected nodes yet." + | otherwise + = renderHtml do mkPage mkHref nodenames + + where + mkHref :: NodeName -> Markup + mkHref nodeName = + a ! href (textValue ("/" <> slugify nodeName)) + $ toHtml nodeName' + where + nodeName' = T.unpack nodeName + + mkPage :: (NodeName -> Markup) -> [NodeName] -> Html + mkPage f hrefs = html do + head $ title $ toHtml metricsTitle + body $ ul $ for_ hrefs (li . f) + +renderJson :: RouteDictionary -> Lazy.ByteString +renderJson (RouteDictionary routeDict) = encode do + Map.fromList + [ (nodeName, "/" <> slug) + | (slug, (_store, nodeName)) <- routeDict + ] + +nodeNames :: RouteDictionary -> [NodeName] +nodeNames (RouteDictionary routeDict) = map (snd . snd) routeDict + +computeRoutes :: TracerEnv -> IO RouteDictionary +computeRoutes TracerEnv{teConnectedNodesNames, teAcceptedMetrics} = atomically do + nIdsWithNames :: Map NodeId NodeName <- + Bimap.toMap <$> readTVar teConnectedNodesNames + + acceptedMetrics :: Map NodeId MetricsStores <- + readTVar teAcceptedMetrics + + let mapFromNodeId :: Map NodeId (NodeName, MetricsStores) + mapFromNodeId = Map.intersectionWith (,) nIdsWithNames acceptedMetrics + + routes :: [(Text, (EKG.Store, NodeName))] + routes = [ (slugify nodeName, (metric, nodeName)) + | (nodeName, (metric, _)) <- Map.elems mapFromNodeId + ] + + pure (RouteDictionary routes) diff --git a/cardano-tracer/src/Cardano/Tracer/Handlers/RTView/Run.hs b/cardano-tracer/src/Cardano/Tracer/Handlers/RTView/Run.hs index cd2ce634db6..02b4f50dd72 100644 --- a/cardano-tracer/src/Cardano/Tracer/Handlers/RTView/Run.hs +++ b/cardano-tracer/src/Cardano/Tracer/Handlers/RTView/Run.hs @@ -77,12 +77,5 @@ runRTView tracerEnv@TracerEnv{teTracer} tracerEnvRTView = UI.defaultConfig { UI.jsLog = const $ return () -- To hide 'threepenny-gui' internal messages. , UI.jsWindowReloadOnDisconnect = False - , UI.jsUseSSL = - Just $ UI.ConfigSSL - { UI.jsSSLBind = encodeUtf8 $ T.pack h - , UI.jsSSLPort = fromIntegral p - , UI.jsSSLCert = cert - , UI.jsSSLKey = key - , UI.jsSSLChainCert = False - } + , UI.jsUseSSL = Nothing } diff --git a/nix/nixos/cardano-tracer-service.nix b/nix/nixos/cardano-tracer-service.nix index 71f2934c30d..b75fc48148c 100644 --- a/nix/nixos/cardano-tracer-service.nix +++ b/nix/nixos/cardano-tracer-service.nix @@ -28,10 +28,10 @@ let serviceConfigToJSON = rpMaxAgeHours = 24; } // (cfg.rotation or {}); - hasEKG = [ - { epHost = "127.0.0.1"; epPort = cfg.ekgPortBase; } - { epHost = "127.0.0.1"; epPort = cfg.ekgPortBase + 1; } - ]; + hasEKG = { + epHost = "127.0.0.1"; + epPort = cfg.ekgPortBase; + }; ekgRequestFreq = 1; hasPrometheus = { epHost = "127.0.0.1";