From 781a5ad5dd028784e104ff46a742d227f2813e4c Mon Sep 17 00:00:00 2001 From: Chris Penner Date: Thu, 21 Mar 2019 14:43:53 +0100 Subject: [PATCH 01/11] Add Prometheus middleware to Brig --- services/brig/package.yaml | 1 + services/brig/src/Brig/API.hs | 41 +------------- services/brig/src/Brig/Run.hs | 54 +++++++++++++++++++ services/brig/src/Main.hs | 4 +- services/brig/test/integration/API/Metrics.hs | 15 ++++-- 5 files changed, 70 insertions(+), 45 deletions(-) create mode 100644 services/brig/src/Brig/Run.hs diff --git a/services/brig/package.yaml b/services/brig/package.yaml index aa87314a6d5..35cd4f859ba 100644 --- a/services/brig/package.yaml +++ b/services/brig/package.yaml @@ -47,6 +47,7 @@ library: - Brig.Options - Brig.Provider.DB - Brig.RPC + - Brig.Run - Brig.User.Auth.Cookie.Limit - Brig.User.Search.Index - Brig.ZAuth diff --git a/services/brig/src/Brig/API.hs b/services/brig/src/Brig/API.hs index 4bbd0385ddd..3c16122056b 100644 --- a/services/brig/src/Brig/API.hs +++ b/services/brig/src/Brig/API.hs @@ -1,10 +1,9 @@ {-# LANGUAGE RecordWildCards #-} -module Brig.API (runServer) where +module Brig.API (sitemap) where import Imports hiding (head) import Brig.App -import Brig.AWS (sesQueue) import Brig.API.Error import Brig.API.Handler import Brig.API.Types @@ -17,15 +16,12 @@ import Brig.User.Email import Brig.User.Phone import Control.Error hiding (bool) import Control.Lens (view, (^.)) -import Control.Monad.Catch (finally) import Data.Aeson hiding (json) import Data.ByteString.Conversion import Data.Id import Data.Metrics.Middleware hiding (metrics) -import Data.Metrics.WaiRoute (treeToPaths) import Data.Misc (IpAddr (..)) import Data.Range -import Data.Text (unpack) import Data.Text.Encoding (decodeLatin1) import Data.Text.Lazy (pack) import Galley.Types (UserClients (..)) @@ -34,37 +30,27 @@ import Network.Wai (Request, Response, responseLBS, lazyRequestBody) import Network.Wai.Predicate hiding (setStatus, result) import Network.Wai.Routing import Network.Wai.Utilities -import Network.Wai.Utilities.Server import Network.Wai.Utilities.Swagger (document, mkSwaggerApi) -import Util.Options import qualified Data.Text.Ascii as Ascii import qualified Data.List1 as List1 -import qualified Control.Concurrent.Async as Async import qualified Brig.API.Client as API import qualified Brig.API.Connection as API import qualified Brig.API.Properties as API import qualified Brig.API.User as API import qualified Brig.Data.User as Data -import qualified Brig.Queue as Queue import qualified Brig.Team.Util as Team import qualified Brig.User.API.Auth as Auth import qualified Brig.User.API.Search as Search import qualified Brig.User.Auth.Cookie as Auth -import qualified Brig.AWS as AWS -import qualified Brig.AWS.SesNotification as SesNotification -import qualified Brig.InternalEvent.Process as Internal import qualified Brig.Types.Swagger as Doc import qualified Network.Wai.Utilities.Swagger as Doc import qualified Data.Swagger.Build.Api as Doc import qualified Galley.Types.Swagger as Doc import qualified Galley.Types.Teams as Team -import qualified Network.Wai.Middleware.Gzip as GZip -import qualified Network.Wai.Middleware.Gunzip as GZip import qualified Network.Wai.Utilities as Utilities import qualified Data.ByteString.Lazy as Lazy import qualified Data.Map.Strict as Map -import qualified Network.Wai.Utilities.Server as Server import qualified Data.Set as Set import qualified Data.Text as Text import qualified Brig.Provider.API as Provider @@ -73,31 +59,6 @@ import qualified Brig.Team.Email as Team import qualified Brig.TURN.API as TURN import qualified System.Logger.Class as Log -runServer :: Opts -> IO () -runServer o = do - e <- newEnv o - s <- Server.newSettings (server e) - emailListener <- for (e^.awsEnv.sesQueue) $ \q -> - Async.async $ - AWS.execute (e^.awsEnv) $ - AWS.listen q (runAppT e . SesNotification.onEvent) - internalEventListener <- Async.async $ - runAppT e $ Queue.listen (e^.internalEvents) Internal.onEvent - runSettingsWithShutdown s (pipeline e) 5 `finally` do - mapM_ Async.cancel emailListener - Async.cancel internalEventListener - closeEnv e - where - rtree = compile (sitemap o) - endpoint = brig o - server e = defaultServer (unpack $ endpoint^.epHost) (endpoint^.epPort) (e^.applog) (e^.metrics) - pipeline e = measureRequests (e^.metrics) (treeToPaths rtree) - . catchErrors (e^.applog) (e^.metrics) - . GZip.gunzip . GZip.gzip GZip.def - $ serve e - - serve e r k = runHandler e r (Server.route rtree r k) k - --------------------------------------------------------------------------- -- Sitemap diff --git a/services/brig/src/Brig/Run.hs b/services/brig/src/Brig/Run.hs new file mode 100644 index 00000000000..1bde17a1ca5 --- /dev/null +++ b/services/brig/src/Brig/Run.hs @@ -0,0 +1,54 @@ +module Brig.Run (run) where + +import Imports hiding (head) +import Brig.App +import Brig.API (sitemap) +import Brig.AWS (sesQueue) +import Brig.API.Handler +import Brig.Options hiding (internalEvents, sesQueue) +import Control.Monad.Catch (finally) +import Control.Lens ((^.)) +import Data.Metrics.WaiRoute (treeToPaths) +import Data.Text (unpack) +import Network.Wai.Utilities.Server +import Util.Options + +import qualified Control.Concurrent.Async as Async +import qualified Brig.Queue as Queue +import qualified Brig.AWS as AWS +import qualified Brig.AWS.SesNotification as SesNotification +import qualified Brig.InternalEvent.Process as Internal +import qualified Network.Wai as Wai +import qualified Network.Wai.Middleware.Gzip as GZip +import qualified Network.Wai.Middleware.Gunzip as GZip +import qualified Data.Metrics.Middleware.Prometheus as Metrics +import qualified Network.Wai.Utilities.Server as Server + + +run :: Opts -> IO () +run o = do + e <- newEnv o + s <- Server.newSettings (server e) + emailListener <- for (e^.awsEnv.sesQueue) $ \q -> + Async.async $ + AWS.execute (e^.awsEnv) $ + AWS.listen q (runAppT e . SesNotification.onEvent) + internalEventListener <- Async.async $ + runAppT e $ Queue.listen (e^.internalEvents) Internal.onEvent + runSettingsWithShutdown s (middleware e $ serve e) 5 `finally` do + mapM_ Async.cancel emailListener + Async.cancel internalEventListener + closeEnv e + where + rtree = compile (sitemap o) + endpoint = brig o + server e = defaultServer (unpack $ endpoint^.epHost) (endpoint^.epPort) (e^.applog) (e^.metrics) + middleware :: Env -> Wai.Middleware + middleware e = Metrics.waiPrometheusMiddleware (sitemap o) + . measureRequests (e^.metrics) (treeToPaths rtree) + . catchErrors (e^.applog) (e^.metrics) + . GZip.gunzip . GZip.gzip GZip.def + serve e r k = runHandler e r (Server.route rtree r k) k + + + diff --git a/services/brig/src/Main.hs b/services/brig/src/Main.hs index 06b67e06837..240d13d7f80 100644 --- a/services/brig/src/Main.hs +++ b/services/brig/src/Main.hs @@ -1,7 +1,7 @@ module Main (main) where import Imports -import Brig.API +import Brig.Run (run) import OpenSSL (withOpenSSL) import Util.Options @@ -11,4 +11,4 @@ main = withOpenSSL $ do let desc = "Brig - User Service" defaultPath = "/etc/wire/brig/conf/brig.yaml" options <- getOptions desc Nothing defaultPath - runServer options + run options diff --git a/services/brig/test/integration/API/Metrics.hs b/services/brig/test/integration/API/Metrics.hs index ceed603298e..c281b5f32d5 100644 --- a/services/brig/test/integration/API/Metrics.hs +++ b/services/brig/test/integration/API/Metrics.hs @@ -9,6 +9,7 @@ module API.Metrics (tests) where import Imports import Bilge +import Bilge.Assert import Brig.Types.User import Control.Lens import Data.ByteString.Conversion @@ -24,11 +25,19 @@ import Util tests :: Manager -> Brig -> IO TestTree tests manager brig = do return $ testGroup "metrics" - [ testCase "work" . void $ runHttpT manager (testMetricsWaiRoute brig) + [ testCase "prometheus" . void $ runHttpT manager (testPrometheusMetrics brig) + , testCase "work" . void $ runHttpT manager (testMonitoringEndpoint brig) ] -testMetricsWaiRoute :: Brig -> Http () -testMetricsWaiRoute brig = do +testPrometheusMetrics :: Brig -> Http () +testPrometheusMetrics brig = do + get (brig . path "/i/metrics") !!! do + const 200 === statusCode + -- Should contain the request duration metric in its output + const (Just "TYPE http_request_duration_seconds histogram") =~= responseBody + +testMonitoringEndpoint :: Brig -> Http () +testMonitoringEndpoint brig = do let p1 = "/self" p2 uid = "/users/" <> uid <> "/clients" From 89451fcbcd08a8d76fccc6d57df156e0e2501e40 Mon Sep 17 00:00:00 2001 From: Chris Penner Date: Thu, 21 Mar 2019 14:59:33 +0100 Subject: [PATCH 02/11] Add prometheus middleware to cannon MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Note that we don't have any integration tests for cannon; Adding the whole integration flow for cannon is a bunch of overhead for a pretty simple and mostly unimportant test so Me and Joé decided to skip it. --- services/cannon/package.yaml | 3 +- services/cannon/src/Cannon/API.hs | 48 +---------------------- services/cannon/src/Cannon/Run.hs | 63 +++++++++++++++++++++++++++++++ services/cannon/src/Main.hs | 2 +- 4 files changed, 67 insertions(+), 49 deletions(-) create mode 100644 services/cannon/src/Cannon/Run.hs diff --git a/services/cannon/package.yaml b/services/cannon/package.yaml index 88d67653e5c..c3caa8f7af9 100644 --- a/services/cannon/package.yaml +++ b/services/cannon/package.yaml @@ -17,9 +17,10 @@ library: exposed-modules: - Cannon.API - Cannon.Dict + - Cannon.Options + - Cannon.Run - Cannon.Types - Cannon.WS - - Cannon.Options dependencies: - base >=4.6 && <5 - aeson >=0.11 diff --git a/services/cannon/src/Cannon/API.hs b/services/cannon/src/Cannon/API.hs index fca9eae2523..b8c7558a160 100644 --- a/services/cannon/src/Cannon/API.hs +++ b/services/cannon/src/Cannon/API.hs @@ -1,20 +1,14 @@ -module Cannon.API (run) where +module Cannon.API (sitemap) where import Imports hiding (head) -import Bilge (newManager, defaultManagerSettings, ManagerSettings (..)) import Cannon.App import Cannon.Types -import Cannon.Options import Cannon.WS hiding (env) -import Control.Lens ((^.)) import Control.Monad.Catch import Data.Aeson (encode) import Data.Id (ClientId, UserId, ConnId) import Data.Metrics.Middleware -import Data.Metrics.WaiRoute (treeToPaths) import Data.Swagger.Build.Api hiding (def, Response) -import Data.Text (strip, pack) -import Data.Text.Encoding (encodeUtf8) import Network.HTTP.Types import Gundeck.Types import Gundeck.Types.BulkPush @@ -23,55 +17,15 @@ import Network.Wai.Predicate hiding (Error, (#)) import Network.Wai.Routing hiding (route, path) import Network.Wai.Utilities hiding (message) import Network.Wai.Utilities.Request (parseBody') -import Network.Wai.Utilities.Server import Network.Wai.Utilities.Swagger -import Network.Wai.Handler.Warp hiding (run) import Network.Wai.Handler.WebSockets import System.Logger (msg, val) -import System.Random.MWC (createSystemRandom) import qualified Cannon.Dict as D import qualified Data.ByteString.Lazy as L import qualified Data.Metrics.Middleware as Metrics -import qualified Network.Wai.Middleware.Gzip as Gzip import qualified Network.WebSockets as Ws -import qualified System.Logger as L -import qualified System.Logger.Extended as L import qualified System.Logger.Class as LC -import qualified System.IO.Strict as Strict - -run :: Opts -> IO () -run o = do - ext <- loadExternal - m <- metrics - g <- L.mkLogger (o ^. logLevel) (o ^. logNetStrings) - e <- mkEnv <$> pure m - <*> pure ext - <*> pure o - <*> pure g - <*> D.empty 128 - <*> newManager defaultManagerSettings { managerConnCount = 128 } - <*> createSystemRandom - <*> mkClock - s <- newSettings $ Server (o^.cannon.host) (o^.cannon.port) (applog e) m (Just idleTimeout) [] [] - let rtree = compile sitemap - measured = measureRequests m (treeToPaths rtree) - app r k = runCannon e (route rtree r k) r - start = measured . catchErrors g m $ Gzip.gzip Gzip.def app - runSettings s start `finally` L.close (applog e) - where - idleTimeout = fromIntegral $ maxPingInterval + 3 - - -- Each cannon instance advertises its own location (ip or dns name) to gundeck. - -- Either externalHost or externalHostFile must be set (externalHost takes precedence if both are defined) - loadExternal :: IO ByteString - loadExternal = do - let extFile = fromMaybe (error "One of externalHost or externalHostFile must be defined") (o^.cannon.externalHostFile) - fromMaybe (readExternal extFile) (return . encodeUtf8 <$> o^.cannon.externalHost) - - readExternal :: FilePath -> IO ByteString - readExternal f = encodeUtf8 . strip . pack <$> Strict.readFile f - sitemap :: Routes ApiBuilder Cannon () sitemap = do diff --git a/services/cannon/src/Cannon/Run.hs b/services/cannon/src/Cannon/Run.hs new file mode 100644 index 00000000000..069f541d1b0 --- /dev/null +++ b/services/cannon/src/Cannon/Run.hs @@ -0,0 +1,63 @@ +module Cannon.Run (run) where + +import Imports hiding (head) +import Bilge (newManager, defaultManagerSettings, ManagerSettings (..)) +import Cannon.App (maxPingInterval) +import Cannon.API (sitemap) +import Cannon.Types (mkEnv, applog, runCannon) +import Cannon.Options +import Cannon.WS hiding (env) +import Control.Lens ((^.)) +import Control.Monad.Catch (finally) +import Data.Metrics.Middleware.Prometheus (waiPrometheusMiddleware) +import Data.Metrics.WaiRoute (treeToPaths) +import Data.Text (strip, pack) +import Data.Text.Encoding (encodeUtf8) +import Network.Wai.Utilities.Server +import Network.Wai.Handler.Warp hiding (run) +import System.Random.MWC (createSystemRandom) + +import qualified Cannon.Dict as D +import qualified Data.Metrics.Middleware as Middleware +import qualified Network.Wai as Wai +import qualified Network.Wai.Middleware.Gzip as Gzip +import qualified System.IO.Strict as Strict +import qualified System.Logger as L +import qualified System.Logger.Extended as L + +run :: Opts -> IO () +run o = do + ext <- loadExternal + m <- Middleware.metrics + g <- L.mkLogger (o ^. logLevel) (o ^. logNetStrings) + e <- mkEnv <$> pure m + <*> pure ext + <*> pure o + <*> pure g + <*> D.empty 128 + <*> newManager defaultManagerSettings { managerConnCount = 128 } + <*> createSystemRandom + <*> mkClock + s <- newSettings $ Server (o^.cannon.host) (o^.cannon.port) (applog e) m (Just idleTimeout) [] [] + let rtree = compile sitemap + measured = measureRequests m (treeToPaths rtree) + app r k = runCannon e (route rtree r k) r + middleware :: Wai.Middleware + middleware = waiPrometheusMiddleware sitemap + . measured + . catchErrors g m + . Gzip.gzip Gzip.def + start = middleware app + runSettings s start `finally` L.close (applog e) + where + idleTimeout = fromIntegral $ maxPingInterval + 3 + + -- Each cannon instance advertises its own location (ip or dns name) to gundeck. + -- Either externalHost or externalHostFile must be set (externalHost takes precedence if both are defined) + loadExternal :: IO ByteString + loadExternal = do + let extFile = fromMaybe (error "One of externalHost or externalHostFile must be defined") (o^.cannon.externalHostFile) + fromMaybe (readExternal extFile) (return . encodeUtf8 <$> o^.cannon.externalHost) + + readExternal :: FilePath -> IO ByteString + readExternal f = encodeUtf8 . strip . pack <$> Strict.readFile f diff --git a/services/cannon/src/Main.hs b/services/cannon/src/Main.hs index ed4700ce9a6..41841a91fcb 100644 --- a/services/cannon/src/Main.hs +++ b/services/cannon/src/Main.hs @@ -1,7 +1,7 @@ module Main (main) where import Imports -import Cannon.API +import Cannon.Run (run) import Util.Options main :: IO () From beb4291b880d33e18d51589bfb418ac4cb9d8b15 Mon Sep 17 00:00:00 2001 From: Chris Penner Date: Thu, 21 Mar 2019 15:22:22 +0100 Subject: [PATCH 03/11] REFACTOR: refactor tests to use TestSetup module --- services/cargohold/test/integration/API/V3.hs | 17 +--------- services/cargohold/test/integration/Main.hs | 1 + .../cargohold/test/integration/Metrics.hs | 14 +++++++++ .../cargohold/test/integration/TestSetup.hs | 31 +++++++++++++++++++ 4 files changed, 47 insertions(+), 16 deletions(-) create mode 100644 services/cargohold/test/integration/Metrics.hs create mode 100644 services/cargohold/test/integration/TestSetup.hs diff --git a/services/cargohold/test/integration/API/V3.hs b/services/cargohold/test/integration/API/V3.hs index 577b8bcc7a0..305e0cd0eb0 100644 --- a/services/cargohold/test/integration/API/V3.hs +++ b/services/cargohold/test/integration/API/V3.hs @@ -1,6 +1,7 @@ module API.V3 where import Imports hiding (head) +import TestSetup import Bilge hiding (body) import Bilge.Assert import Control.Lens hiding (sets) @@ -28,22 +29,6 @@ import qualified Data.ByteString.Lazy as Lazy import qualified Data.ByteString.Char8 as C8 import qualified Data.UUID as UUID -type CargoHold = Request -> Request - -data TestSetup = TestSetup - { manager :: Manager - , cargohold :: CargoHold - } - -type TestSignature a = CargoHold -> Http a - -test :: IO TestSetup -> TestName -> (TestSignature a) -> TestTree -test s n h = testCase n runTest - where - runTest = do - setup <- s - (void $ runHttpT (manager setup) (h (cargohold setup))) - tests :: IO TestSetup -> TestTree tests s = testGroup "v3" [ testGroup "simple" diff --git a/services/cargohold/test/integration/Main.hs b/services/cargohold/test/integration/Main.hs index 109591da856..26e24733d00 100644 --- a/services/cargohold/test/integration/Main.hs +++ b/services/cargohold/test/integration/Main.hs @@ -57,6 +57,7 @@ main = withOpenSSL $ runTests go where go c i = withResource (getOpts c i) releaseOpts $ \opts -> testGroup "Cargohold API Integration" [API.V3.tests opts] + testGroup "Metrics" [testMetrics opts] getOpts _ i = do -- TODO: It would actually be useful to read some diff --git a/services/cargohold/test/integration/Metrics.hs b/services/cargohold/test/integration/Metrics.hs new file mode 100644 index 00000000000..cadd693cf4a --- /dev/null +++ b/services/cargohold/test/integration/Metrics.hs @@ -0,0 +1,14 @@ +module Metrics (tests) where + +tests :: IO TestSetup -> TestTree +tests s = test s "prometheus" testPrometheusMetrics + +testPrometheusMetrics :: TestSignature +testPrometheusMetrics cargohold = + g <- view cargohold + get (g . path "/i/metrics") !!! do + const 200 === statusCode + -- Should contain the request duration metric in its output + const (Just "TYPE http_request_duration_seconds histogram") =~= responseBody + + diff --git a/services/cargohold/test/integration/TestSetup.hs b/services/cargohold/test/integration/TestSetup.hs new file mode 100644 index 00000000000..deafc8d4cae --- /dev/null +++ b/services/cargohold/test/integration/TestSetup.hs @@ -0,0 +1,31 @@ +module TestSetup + ( test + , tsManager + , tsCargohold + , TestSignature + , TestSetup(..) + , CargoHold + ) where + +import Imports +import Bilge (Request) +import Bilge.IO (Http, Manager, runHttpT) +import Control.Lens ((^.), makeLenses) +import Test.Tasty +import Test.Tasty.HUnit + +type CargoHold = Request -> Request +type TestSignature a = CargoHold -> Http a + +data TestSetup = TestSetup + { _tsManager :: Manager + , _tsCargohold :: CargoHold + } +makeLenses ''TestSetup + +test :: IO TestSetup -> TestName -> (TestSignature a) -> TestTree +test s n h = testCase n runTest + where + runTest = do + setup <- s + (void $ runHttpT (setup ^. tsManager) (h (setup ^. tsCargohold))) From b3f3126455d9cd4c33d603d0f614eefae4c08a52 Mon Sep 17 00:00:00 2001 From: Chris Penner Date: Thu, 21 Mar 2019 15:40:34 +0100 Subject: [PATCH 04/11] Add prometheus middleware to cargohold --- services/cargohold/package.yaml | 1 + services/cargohold/src/CargoHold/API.hs | 25 +------------- services/cargohold/src/CargoHold/Run.hs | 34 +++++++++++++++++++ services/cargohold/src/Main.hs | 4 +-- services/cargohold/test/integration/API/V3.hs | 2 +- services/cargohold/test/integration/Main.hs | 9 +++-- .../cargohold/test/integration/Metrics.hs | 13 ++++--- 7 files changed, 54 insertions(+), 34 deletions(-) create mode 100644 services/cargohold/src/CargoHold/Run.hs diff --git a/services/cargohold/package.yaml b/services/cargohold/package.yaml index 001b28112ab..ccfe13b648a 100644 --- a/services/cargohold/package.yaml +++ b/services/cargohold/package.yaml @@ -36,6 +36,7 @@ library: exposed-modules: - CargoHold.API - CargoHold.Options + - CargoHold.Run dependencies: - base >=4 && <5 - attoparsec >=0.12 diff --git a/services/cargohold/src/CargoHold/API.hs b/services/cargohold/src/CargoHold/API.hs index b17a5089405..bdb96d439d8 100644 --- a/services/cargohold/src/CargoHold/API.hs +++ b/services/cargohold/src/CargoHold/API.hs @@ -1,18 +1,15 @@ -module CargoHold.API (runServer) where +module CargoHold.API (sitemap) where import Imports hiding (head) import CargoHold.App import CargoHold.Options import Control.Error import Control.Lens (view, (^.)) -import Control.Monad.Catch (finally) import Data.Aeson (encode) import Data.ByteString.Conversion import Data.Id import Data.Metrics.Middleware hiding (metrics) -import Data.Metrics.WaiRoute (treeToPaths) import Data.Predicate -import Data.Text (unpack) import Data.Text.Encoding (decodeLatin1) import Network.HTTP.Types.Status import Network.Wai (Response, Request, responseLBS) @@ -20,11 +17,9 @@ import Network.Wai.Conduit (sourceRequestBody) import Network.Wai.Predicate hiding (Error, setStatus) import Network.Wai.Routing import Network.Wai.Utilities hiding (message) -import Network.Wai.Utilities.Server import Network.Wai.Utilities.Swagger (document, mkSwaggerApi) import Network.Wai.Utilities.ZAuth import URI.ByteString -import Util.Options import qualified CargoHold.API.V3 as V3 import qualified CargoHold.API.V3.Resumable as Resumable @@ -34,26 +29,8 @@ import qualified CargoHold.TUS as TUS import qualified CargoHold.Types.V3 as V3 import qualified CargoHold.Types.V3.Resumable as V3 import qualified Data.Swagger.Build.Api as Doc -import qualified Network.Wai.Middleware.Gzip as GZip -import qualified Network.Wai.Utilities.Server as Server import qualified Network.Wai.Utilities.Swagger as Doc -runServer :: Opts -> IO () -runServer o = do - e <- newEnv o - s <- Server.newSettings (server e) - runSettingsWithShutdown s (pipeline e) 5 - `finally` closeEnv e - where - rtree = compile sitemap - server e = defaultServer (unpack $ o^.optCargohold.epHost) (o^.optCargohold.epPort) (e^.appLogger) (e^.metrics) - pipeline e = measureRequests (e^.metrics) (treeToPaths rtree) - . catchErrors (e^.appLogger) (e^.metrics) - . GZip.gzip GZip.def - $ serve e - - serve e r k = runHandler e r (Server.route rtree r k) k - sitemap :: Routes Doc.ApiBuilder Handler () sitemap = do get "/i/status" (continue $ const $ return empty) true diff --git a/services/cargohold/src/CargoHold/Run.hs b/services/cargohold/src/CargoHold/Run.hs new file mode 100644 index 00000000000..50ed7fd7fee --- /dev/null +++ b/services/cargohold/src/CargoHold/Run.hs @@ -0,0 +1,34 @@ +module CargoHold.Run (run) where + +import Imports +import Control.Lens ((^.)) +import Control.Monad.Catch (finally) +import Data.Metrics.WaiRoute (treeToPaths) +import Data.Metrics.Middleware.Prometheus (waiPrometheusMiddleware) +import Data.Text (unpack) +import Util.Options +import qualified Network.Wai as Wai +import qualified Network.Wai.Middleware.Gzip as GZip +import qualified Network.Wai.Utilities.Server as Server +import Network.Wai.Utilities.Server + +import CargoHold.Options +import CargoHold.App +import CargoHold.API (sitemap) + +run :: Opts -> IO () +run o = do + e <- newEnv o + s <- Server.newSettings (server e) + runSettingsWithShutdown s (middleware e $ serve e) 5 + `finally` closeEnv e + where + rtree = compile sitemap + server e = defaultServer (unpack $ o^.optCargohold.epHost) (o^.optCargohold.epPort) (e^.appLogger) (e^.metrics) + middleware :: Env -> Wai.Middleware + middleware e = waiPrometheusMiddleware sitemap + . measureRequests (e^.metrics) (treeToPaths rtree) + . catchErrors (e^.appLogger) (e^.metrics) + . GZip.gzip GZip.def + + serve e r k = runHandler e r (Server.route rtree r k) k diff --git a/services/cargohold/src/Main.hs b/services/cargohold/src/Main.hs index bcdf074f2fc..7d8acf6abb5 100644 --- a/services/cargohold/src/Main.hs +++ b/services/cargohold/src/Main.hs @@ -1,7 +1,7 @@ module Main (main) where import Imports -import CargoHold.API +import CargoHold.Run (run) import OpenSSL (withOpenSSL) import Util.Options @@ -9,7 +9,7 @@ import Util.Options main :: IO () main = withOpenSSL $ do options <- getOptions desc Nothing defaultPath - runServer options + run options where desc = "Cargohold - Asset Storage" defaultPath = "/etc/wire/cargohold/conf/cargohold.yaml" diff --git a/services/cargohold/test/integration/API/V3.hs b/services/cargohold/test/integration/API/V3.hs index 305e0cd0eb0..86adf630d17 100644 --- a/services/cargohold/test/integration/API/V3.hs +++ b/services/cargohold/test/integration/API/V3.hs @@ -30,7 +30,7 @@ import qualified Data.ByteString.Char8 as C8 import qualified Data.UUID as UUID tests :: IO TestSetup -> TestTree -tests s = testGroup "v3" +tests s = testGroup "API Integration v3" [ testGroup "simple" [ test s "roundtrip" testSimpleRoundtrip , test s "tokens" testSimpleTokens diff --git a/services/cargohold/test/integration/Main.hs b/services/cargohold/test/integration/Main.hs index 26e24733d00..b1a2da62797 100644 --- a/services/cargohold/test/integration/Main.hs +++ b/services/cargohold/test/integration/Main.hs @@ -16,7 +16,9 @@ import Util.Test import Test.Tasty import Test.Tasty.Options +import TestSetup import qualified API.V3 +import qualified Metrics data IntegrationConfig = IntegrationConfig -- internal endpoint @@ -56,8 +58,9 @@ main :: IO () main = withOpenSSL $ runTests go where go c i = withResource (getOpts c i) releaseOpts $ \opts -> - testGroup "Cargohold API Integration" [API.V3.tests opts] - testGroup "Metrics" [testMetrics opts] + testGroup "Cargohold" [ API.V3.tests opts + , Metrics.tests opts + ] getOpts _ i = do -- TODO: It would actually be useful to read some @@ -70,7 +73,7 @@ main = withOpenSSL $ runTests go let local p = Endpoint { _epHost = "127.0.0.1", _epPort = p } iConf <- handleParseError =<< decodeFileEither i cargo <- mkRequest <$> optOrEnv cargohold iConf (local . read) "CARGOHOLD_WEB_PORT" - return $ API.V3.TestSetup m cargo + return $ TestSetup m cargo mkRequest (Endpoint h p) = host (encodeUtf8 h) . port p diff --git a/services/cargohold/test/integration/Metrics.hs b/services/cargohold/test/integration/Metrics.hs index cadd693cf4a..956a0cd03be 100644 --- a/services/cargohold/test/integration/Metrics.hs +++ b/services/cargohold/test/integration/Metrics.hs @@ -1,12 +1,17 @@ module Metrics (tests) where +import Imports +import Bilge +import Bilge.Assert +import TestSetup +import Test.Tasty + tests :: IO TestSetup -> TestTree -tests s = test s "prometheus" testPrometheusMetrics +tests s = testGroup "Metrics" [test s "prometheus" testPrometheusMetrics] -testPrometheusMetrics :: TestSignature +testPrometheusMetrics :: TestSignature () testPrometheusMetrics cargohold = - g <- view cargohold - get (g . path "/i/metrics") !!! do + get (cargohold . path "/i/metrics") !!! do const 200 === statusCode -- Should contain the request duration metric in its output const (Just "TYPE http_request_duration_seconds histogram") =~= responseBody From 43a3e8957c66e0e9899c63698a702b6f3ff0e5e8 Mon Sep 17 00:00:00 2001 From: Chris Penner Date: Thu, 21 Mar 2019 16:01:16 +0100 Subject: [PATCH 05/11] REFACTOR: Gundeck tests refactor --- services/gundeck/test/integration/API.hs | 17 ++++---------- services/gundeck/test/integration/Main.hs | 22 +++++++++---------- .../gundeck/test/integration/TestSetup.hs | 22 +++++++++++++++++++ services/gundeck/test/integration/Types.hs | 7 ------ 4 files changed, 37 insertions(+), 31 deletions(-) create mode 100644 services/gundeck/test/integration/TestSetup.hs delete mode 100644 services/gundeck/test/integration/Types.hs diff --git a/services/gundeck/test/integration/API.hs b/services/gundeck/test/integration/API.hs index b1cc4e48a46..bc1f4486a68 100644 --- a/services/gundeck/test/integration/API.hs +++ b/services/gundeck/test/integration/API.hs @@ -1,6 +1,6 @@ {-# OPTIONS_GHC -fno-warn-incomplete-patterns #-} -module API (TestSetup(..), tests) where +module API (tests) where import Bilge import Bilge.Assert @@ -24,7 +24,7 @@ import System.Random (randomIO) import System.Timeout (timeout) import Test.Tasty import Test.Tasty.HUnit -import Types +import TestSetup import qualified Cassandra as Cql import qualified Data.Aeson.Types as Aeson @@ -45,15 +45,6 @@ import qualified Prelude appName :: AppName appName = AppName "test" -data TestSetup = TestSetup - { manager :: Manager - , gundeck :: Gundeck - , cannon :: Cannon - , cannon2 :: Cannon - , brig :: Brig - , cass :: Cql.ClientState - } - type TestSignature a = Gundeck -> Cannon -> Brig -> Cql.ClientState -> Http a type TestSignature2 a = Gundeck -> Cannon -> Cannon -> Brig -> Cql.ClientState -> Http a @@ -62,14 +53,14 @@ test setup n h = testCase n runTest where runTest = do s <- setup - void $ runHttpT (manager s) (h (gundeck s) (cannon s) (brig s) (cass s)) + void $ runHttpT (s ^. tsManager) (h (s ^. tsGundeck) (s ^. tsCannon) (s ^. tsBrig) (s ^. tsCass)) test2 :: IO TestSetup -> TestName -> (TestSignature2 a) -> TestTree test2 setup n h = testCase n runTest where runTest = do s <- setup - void $ runHttpT (manager s) (h (gundeck s) (cannon s) (cannon2 s) (brig s) (cass s)) + void $ runHttpT (s ^. tsManager) (h (s ^. tsGundeck) (s ^. tsCannon) (s ^. tsCannon2) (s ^. tsBrig) (s ^. tsCass)) tests :: IO TestSetup -> TestTree tests s = testGroup "Gundeck integration tests" [ diff --git a/services/gundeck/test/integration/Main.hs b/services/gundeck/test/integration/Main.hs index 4e5ca48c652..71b861c55cb 100644 --- a/services/gundeck/test/integration/Main.hs +++ b/services/gundeck/test/integration/Main.hs @@ -17,20 +17,20 @@ import OpenSSL (withOpenSSL) import Options.Applicative import Test.Tasty import Test.Tasty.Options -import Types import Util.Options import Util.Options.Common import Util.Test +import TestSetup import qualified API import qualified System.Logger as Logger data IntegrationConfig = IntegrationConfig -- internal endpoints - { gundeck :: Endpoint - , cannon :: Endpoint - , cannon2 :: Endpoint - , brig :: Endpoint + { gundeckEndpoint :: Endpoint + , cannonEndpoint :: Endpoint + , cannon2Endpoint :: Endpoint + , brigEndpoint :: Endpoint } deriving (Show, Generic) instance FromJSON IntegrationConfig @@ -39,7 +39,7 @@ newtype ServiceConfigFile = ServiceConfigFile String deriving (Eq, Ord, Typeable) instance IsOption ServiceConfigFile where - defaultValue = ServiceConfigFile "/etc/wire/gundeck/conf/gundeck.yaml" + defaultValue = ServiceConfigFile "/etc/wire/gundeckEndpoint/conf/gundeckEndpoint.yaml" parseValue = fmap ServiceConfigFile . safeRead optionName = return "service-config" optionHelp = return "Service config file to read from" @@ -74,10 +74,10 @@ main = withOpenSSL $ runTests go let local p = Endpoint { _epHost = "127.0.0.1", _epPort = p } gConf <- handleParseError =<< decodeFileEither gFile iConf <- handleParseError =<< decodeFileEither iFile - g <- Gundeck . mkRequest <$> optOrEnv gundeck iConf (local . read) "GUNDECK_WEB_PORT" - c <- Cannon . mkRequest <$> optOrEnv cannon iConf (local . read) "CANNON_WEB_PORT" - c2 <- Cannon . mkRequest <$> optOrEnv cannon2 iConf (local . read) "CANNON2_WEB_PORT" - b <- Brig . mkRequest <$> optOrEnv brig iConf (local . read) "BRIG_WEB_PORT" + g <- Gundeck . mkRequest <$> optOrEnv gundeckEndpoint iConf (local . read) "GUNDECK_WEB_PORT" + c <- Cannon . mkRequest <$> optOrEnv cannonEndpoint iConf (local . read) "CANNON_WEB_PORT" + c2 <- Cannon . mkRequest <$> optOrEnv cannon2Endpoint iConf (local . read) "CANNON2_WEB_PORT" + b <- Brig . mkRequest <$> optOrEnv brigEndpoint iConf (local . read) "BRIG_WEB_PORT" ch <- optOrEnv (\v -> v^.optCassandra.casEndpoint.epHost) gConf pack "GUNDECK_CASSANDRA_HOST" cp <- optOrEnv (\v -> v^.optCassandra.casEndpoint.epPort) gConf read "GUNDECK_CASSANDRA_PORT" ck <- optOrEnv (\v -> v^.optCassandra.casKeyspace) gConf pack "GUNDECK_CASSANDRA_KEYSPACE" @@ -85,7 +85,7 @@ main = withOpenSSL $ runTests go lg <- Logger.new Logger.defSettings db <- defInitCassandra ck ch cp lg - return $ API.TestSetup m g c c2 b db + return $ TestSetup m g c c2 b db releaseOpts _ = return () diff --git a/services/gundeck/test/integration/TestSetup.hs b/services/gundeck/test/integration/TestSetup.hs new file mode 100644 index 00000000000..73c6298a3e1 --- /dev/null +++ b/services/gundeck/test/integration/TestSetup.hs @@ -0,0 +1,22 @@ +module TestSetup where + +import Imports +import Util.Options +import Bilge +import Control.Lens (makeLenses) +import qualified Cassandra as Cql + +newtype Brig = Brig { runBrig :: Request -> Request } +newtype Cannon = Cannon { runCannon :: Request -> Request } +newtype Gundeck = Gundeck { runGundeck :: Request -> Request } + +data TestSetup = TestSetup + { _tsManager :: Manager + , _tsGundeck :: Gundeck + , _tsCannon :: Cannon + , _tsCannon2 :: Cannon + , _tsBrig :: Brig + , _tsCass :: Cql.ClientState + } + +makeLenses ''TestSetup diff --git a/services/gundeck/test/integration/Types.hs b/services/gundeck/test/integration/Types.hs deleted file mode 100644 index ca213f8c7db..00000000000 --- a/services/gundeck/test/integration/Types.hs +++ /dev/null @@ -1,7 +0,0 @@ -module Types where - -import Bilge (Request) - -newtype Brig = Brig { runBrig :: Request -> Request } -newtype Cannon = Cannon { runCannon :: Request -> Request } -newtype Gundeck = Gundeck { runGundeck :: Request -> Request } From 56655a3aeb632edfdc6e94d7f72090d3b384cd74 Mon Sep 17 00:00:00 2001 From: Chris Penner Date: Thu, 21 Mar 2019 16:12:23 +0100 Subject: [PATCH 06/11] Add prometheus middleware to gundeck --- services/gundeck/package.yaml | 1 + services/gundeck/src/Gundeck/API.hs | 39 +-------------- services/gundeck/src/Gundeck/Run.hs | 49 +++++++++++++++++++ services/gundeck/src/Main.hs | 4 +- services/gundeck/test/integration/API.hs | 2 +- services/gundeck/test/integration/Main.hs | 24 +++++---- services/gundeck/test/integration/Metrics.hs | 29 +++++++++++ .../gundeck/test/integration/TestSetup.hs | 3 +- 8 files changed, 98 insertions(+), 53 deletions(-) create mode 100644 services/gundeck/src/Gundeck/Run.hs create mode 100644 services/gundeck/test/integration/Metrics.hs diff --git a/services/gundeck/package.yaml b/services/gundeck/package.yaml index ea889163da2..876c4407055 100644 --- a/services/gundeck/package.yaml +++ b/services/gundeck/package.yaml @@ -37,6 +37,7 @@ library: - Gundeck.Push.Native.Types - Gundeck.Push.Websocket - Gundeck.React + - Gundeck.Run - Gundeck.Util - Gundeck.Util.DelayQueue - Gundeck.Util.Redis diff --git a/services/gundeck/src/Gundeck/API.hs b/services/gundeck/src/Gundeck/API.hs index 9a8540f6bda..75e9ff105e4 100644 --- a/services/gundeck/src/Gundeck/API.hs +++ b/services/gundeck/src/Gundeck/API.hs @@ -1,65 +1,28 @@ -module Gundeck.API where +module Gundeck.API (sitemap) where import Imports hiding (head) -import Cassandra (runClient, shutdown) -import Cassandra.Schema (versionCheck) -import Control.Exception (finally) import Control.Lens hiding (enum) import Data.Aeson (encode) import Data.Metrics.Middleware -import Data.Metrics.WaiRoute (treeToPaths) import Data.Range import Data.Swagger.Build.Api hiding (def, min, Response) import Data.Text.Encoding (decodeLatin1) -import Data.Text (unpack) import Gundeck.API.Error import Gundeck.Env import Gundeck.Monad -import Gundeck.Options -import Gundeck.React import Network.HTTP.Types import Network.Wai import Network.Wai.Predicate hiding (setStatus) import Network.Wai.Routing hiding (route) import Network.Wai.Utilities import Network.Wai.Utilities.Swagger -import Network.Wai.Utilities.Server hiding (serverPort) -import Util.Options -import qualified Control.Concurrent.Async as Async import qualified Data.Swagger.Build.Api as Swagger -import qualified Gundeck.Aws as Aws import qualified Gundeck.Client as Client import qualified Gundeck.Notification as Notification import qualified Gundeck.Push as Push import qualified Gundeck.Presence as Presence import qualified Gundeck.Types.Swagger as Model -import qualified Network.Wai.Middleware.Gzip as GZip -import qualified Network.Wai.Middleware.Gunzip as GZip -import qualified System.Logger as Log - -runServer :: Opts -> IO () -runServer o = do - m <- metrics - e <- createEnv m o - runClient (e^.cstate) $ - versionCheck schemaVersion - let l = e^.applog - s <- newSettings $ defaultServer (unpack $ o^.optGundeck.epHost) (o^.optGundeck.epPort) l m - app <- pipeline e - lst <- Async.async $ Aws.execute (e^.awsEnv) (Aws.listen (runDirect e . onEvent)) - runSettingsWithShutdown s app 5 `finally` do - Log.info l $ Log.msg (Log.val "Shutting down ...") - shutdown (e^.cstate) - Async.cancel lst - Log.close (e^.applog) - where - pipeline e = do - let routes = compile sitemap - return $ measureRequests (e^.monitor) (treeToPaths routes) - . catchErrors (e^.applog) (e^.monitor) - . GZip.gunzip . GZip.gzip GZip.def - $ \r k -> runGundeck e r (route routes r k) sitemap :: Routes ApiBuilder Gundeck () sitemap = do diff --git a/services/gundeck/src/Gundeck/Run.hs b/services/gundeck/src/Gundeck/Run.hs new file mode 100644 index 00000000000..ec9831491a3 --- /dev/null +++ b/services/gundeck/src/Gundeck/Run.hs @@ -0,0 +1,49 @@ +module Gundeck.Run where + +import Imports hiding (head) +import Cassandra (runClient, shutdown) +import Cassandra.Schema (versionCheck) +import Control.Exception (finally) +import Control.Lens hiding (enum) +import Data.Metrics.Middleware +import Data.Metrics.Middleware.Prometheus (waiPrometheusMiddleware) +import Data.Metrics.WaiRoute (treeToPaths) +import Data.Text (unpack) +import Gundeck.API (sitemap) +import Gundeck.Env +import Gundeck.Monad +import Gundeck.Options +import Gundeck.React +import Network.Wai as Wai +import Network.Wai.Utilities.Server hiding (serverPort) +import Util.Options + +import qualified Control.Concurrent.Async as Async +import qualified Gundeck.Aws as Aws +import qualified Network.Wai.Middleware.Gzip as GZip +import qualified Network.Wai.Middleware.Gunzip as GZip +import qualified System.Logger as Log + +run :: Opts -> IO () +run o = do + m <- metrics + e <- createEnv m o + runClient (e^.cstate) $ + versionCheck schemaVersion + let l = e^.applog + s <- newSettings $ defaultServer (unpack $ o^.optGundeck.epHost) (o^.optGundeck.epPort) l m + lst <- Async.async $ Aws.execute (e^.awsEnv) (Aws.listen (runDirect e . onEvent)) + runSettingsWithShutdown s (middleware e $ app e) 5 `finally` do + Log.info l $ Log.msg (Log.val "Shutting down ...") + shutdown (e^.cstate) + Async.cancel lst + Log.close (e^.applog) + where + middleware :: Env -> Wai.Middleware + middleware e = waiPrometheusMiddleware sitemap + . measureRequests (e^.monitor) (treeToPaths routes) + . catchErrors (e^.applog) (e^.monitor) + . GZip.gunzip . GZip.gzip GZip.def + app :: Env -> Wai.Application + app e r k = runGundeck e r (route routes r k) + routes = compile sitemap diff --git a/services/gundeck/src/Main.hs b/services/gundeck/src/Main.hs index 4eb72df51b4..aefa40a879c 100644 --- a/services/gundeck/src/Main.hs +++ b/services/gundeck/src/Main.hs @@ -1,7 +1,7 @@ module Main (main) where import Imports -import Gundeck.API +import Gundeck.Run (run) import OpenSSL (withOpenSSL) import Util.Options @@ -9,7 +9,7 @@ import Util.Options main :: IO () main = withOpenSSL $ do options <- getOptions desc Nothing defaultPath - runServer options + run options where desc = "Gundeck - Push Notification Hub Service" defaultPath = "/etc/wire/gundeck/conf/gundeck.yaml" diff --git a/services/gundeck/test/integration/API.hs b/services/gundeck/test/integration/API.hs index bc1f4486a68..4e4e9218cbc 100644 --- a/services/gundeck/test/integration/API.hs +++ b/services/gundeck/test/integration/API.hs @@ -63,7 +63,7 @@ test2 setup n h = testCase n runTest void $ runHttpT (s ^. tsManager) (h (s ^. tsGundeck) (s ^. tsCannon) (s ^. tsCannon2) (s ^. tsBrig) (s ^. tsCass)) tests :: IO TestSetup -> TestTree -tests s = testGroup "Gundeck integration tests" [ +tests s = testGroup "API tests" [ testGroup "Push" [ test s "Register a user" $ addUser , test s "Delete a user" $ removeUser diff --git a/services/gundeck/test/integration/Main.hs b/services/gundeck/test/integration/Main.hs index 71b861c55cb..9da1b396b73 100644 --- a/services/gundeck/test/integration/Main.hs +++ b/services/gundeck/test/integration/Main.hs @@ -23,14 +23,15 @@ import Util.Test import TestSetup import qualified API +import qualified Metrics import qualified System.Logger as Logger data IntegrationConfig = IntegrationConfig -- internal endpoints - { gundeckEndpoint :: Endpoint - , cannonEndpoint :: Endpoint - , cannon2Endpoint :: Endpoint - , brigEndpoint :: Endpoint + { gundeck :: Endpoint + , cannon :: Endpoint + , cannon2 :: Endpoint + , brig :: Endpoint } deriving (Show, Generic) instance FromJSON IntegrationConfig @@ -39,7 +40,7 @@ newtype ServiceConfigFile = ServiceConfigFile String deriving (Eq, Ord, Typeable) instance IsOption ServiceConfigFile where - defaultValue = ServiceConfigFile "/etc/wire/gundeckEndpoint/conf/gundeckEndpoint.yaml" + defaultValue = ServiceConfigFile "/etc/wire/gundeck/conf/gundeck.yaml" parseValue = fmap ServiceConfigFile . safeRead optionName = return "service-config" optionHelp = return "Service config file to read from" @@ -65,7 +66,10 @@ runTests run = defaultMainWithIngredients ings $ main :: IO () main = withOpenSSL $ runTests go where - go g i = withResource (getOpts g i) releaseOpts $ \opts -> API.tests opts + go g i = withResource (getOpts g i) releaseOpts $ \opts -> + testGroup "Gundeck" [ API.tests opts + , Metrics.tests opts + ] getOpts gFile iFile = do m <- newManager tlsManagerSettings { @@ -74,10 +78,10 @@ main = withOpenSSL $ runTests go let local p = Endpoint { _epHost = "127.0.0.1", _epPort = p } gConf <- handleParseError =<< decodeFileEither gFile iConf <- handleParseError =<< decodeFileEither iFile - g <- Gundeck . mkRequest <$> optOrEnv gundeckEndpoint iConf (local . read) "GUNDECK_WEB_PORT" - c <- Cannon . mkRequest <$> optOrEnv cannonEndpoint iConf (local . read) "CANNON_WEB_PORT" - c2 <- Cannon . mkRequest <$> optOrEnv cannon2Endpoint iConf (local . read) "CANNON2_WEB_PORT" - b <- Brig . mkRequest <$> optOrEnv brigEndpoint iConf (local . read) "BRIG_WEB_PORT" + g <- Gundeck . mkRequest <$> optOrEnv gundeck iConf (local . read) "GUNDECK_WEB_PORT" + c <- Cannon . mkRequest <$> optOrEnv cannon iConf (local . read) "CANNON_WEB_PORT" + c2 <- Cannon . mkRequest <$> optOrEnv cannon2 iConf (local . read) "CANNON2_WEB_PORT" + b <- Brig . mkRequest <$> optOrEnv brig iConf (local . read) "BRIG_WEB_PORT" ch <- optOrEnv (\v -> v^.optCassandra.casEndpoint.epHost) gConf pack "GUNDECK_CASSANDRA_HOST" cp <- optOrEnv (\v -> v^.optCassandra.casEndpoint.epPort) gConf read "GUNDECK_CASSANDRA_PORT" ck <- optOrEnv (\v -> v^.optCassandra.casKeyspace) gConf pack "GUNDECK_CASSANDRA_KEYSPACE" diff --git a/services/gundeck/test/integration/Metrics.hs b/services/gundeck/test/integration/Metrics.hs new file mode 100644 index 00000000000..7f6765e7258 --- /dev/null +++ b/services/gundeck/test/integration/Metrics.hs @@ -0,0 +1,29 @@ +module Metrics where + +import Imports +import TestSetup +import Bilge +import Bilge.Assert +import Test.Tasty +import Test.Tasty.HUnit +import Control.Lens ((^.)) + +type TestSignature a = Gundeck -> Http a + +test :: IO TestSetup -> TestName -> (TestSignature a) -> TestTree +test setup n h = testCase n runTest + where + runTest = do + s <- setup + void $ runHttpT (s ^. tsManager) (h (s ^. tsGundeck)) + +tests :: IO TestSetup -> TestTree +tests s = testGroup "Metrics" [test s "prometheus" testPrometheusMetrics] + +testPrometheusMetrics :: Gundeck -> Http () +testPrometheusMetrics gundeck = do + get (runGundeck gundeck . path "/i/metrics") !!! do + const 200 === statusCode + -- Should contain the request duration metric in its output + const (Just "TYPE http_request_duration_seconds histogram") =~= responseBody + diff --git a/services/gundeck/test/integration/TestSetup.hs b/services/gundeck/test/integration/TestSetup.hs index 73c6298a3e1..38bde346e59 100644 --- a/services/gundeck/test/integration/TestSetup.hs +++ b/services/gundeck/test/integration/TestSetup.hs @@ -1,7 +1,5 @@ module TestSetup where -import Imports -import Util.Options import Bilge import Control.Lens (makeLenses) import qualified Cassandra as Cql @@ -20,3 +18,4 @@ data TestSetup = TestSetup } makeLenses ''TestSetup + From b284f756b00bf24a79159e8253529768618d7b09 Mon Sep 17 00:00:00 2001 From: Chris Penner Date: Thu, 21 Mar 2019 16:30:27 +0100 Subject: [PATCH 07/11] Add prometheus middleware to proxy --- services/proxy/package.yaml | 1 + services/proxy/src/Main.hs | 2 +- services/proxy/src/Proxy/API.hs | 17 +---------------- services/proxy/src/Proxy/Run.hs | 27 +++++++++++++++++++++++++++ 4 files changed, 30 insertions(+), 17 deletions(-) create mode 100644 services/proxy/src/Proxy/Run.hs diff --git a/services/proxy/package.yaml b/services/proxy/package.yaml index c5459360b30..8971abac3bb 100644 --- a/services/proxy/package.yaml +++ b/services/proxy/package.yaml @@ -20,6 +20,7 @@ library: - Proxy.Env - Proxy.Options - Proxy.Proxy + - Proxy.Run dependencies: - base >=4.6 && <5 - aeson >=1.0 diff --git a/services/proxy/src/Main.hs b/services/proxy/src/Main.hs index 241cd819c59..e9f90a0f47d 100644 --- a/services/proxy/src/Main.hs +++ b/services/proxy/src/Main.hs @@ -1,7 +1,7 @@ module Main (main) where import Imports -import Proxy.API +import Proxy.Run (run) import Proxy.Options import Util.Options diff --git a/services/proxy/src/Proxy/API.hs b/services/proxy/src/Proxy/API.hs index 6916da069e1..8cfd5124135 100644 --- a/services/proxy/src/Proxy/API.hs +++ b/services/proxy/src/Proxy/API.hs @@ -1,4 +1,4 @@ -module Proxy.API (Proxy.API.run) where +module Proxy.API (sitemap) where import Imports hiding (head) import Control.Monad.Catch @@ -7,19 +7,15 @@ import Control.Retry import Data.ByteString (breakSubstring) import Data.CaseInsensitive (CI) import Data.Metrics.Middleware hiding (path) -import Data.Metrics.WaiRoute (treeToPaths) import Network.HTTP.ReverseProxy import Network.HTTP.Types import Network.Wai -import Network.Wai.Handler.Warp import Network.Wai.Predicate hiding (err, Error, setStatus) import Network.Wai.Predicate.Request (getRequest) import Network.Wai.Routing hiding (path, route) import Network.Wai.Utilities -import Network.Wai.Utilities.Server hiding (serverPort) import Proxy.Env import Proxy.Proxy -import Proxy.Options import System.Logger.Class hiding (Error, info, render) import qualified Bilge.Request as Req @@ -33,17 +29,6 @@ import qualified Network.HTTP.Client as Client import qualified Network.Wai.Internal as I import qualified System.Logger as Logger -run :: Opts -> IO () -run o = do - m <- metrics - e <- createEnv m o - s <- newSettings $ defaultServer (o^.host) (o^.port) (e^.applog) m - let rtree = compile (sitemap e) - let measured = measureRequests m (treeToPaths rtree) - let app r k = runProxy e r (route rtree r k) - let start = measured . catchErrors (e^.applog) m $ app - runSettings s start `finally` destroyEnv e - sitemap :: Env -> Routes a Proxy () sitemap e = do diff --git a/services/proxy/src/Proxy/Run.hs b/services/proxy/src/Proxy/Run.hs new file mode 100644 index 00000000000..ba58f878304 --- /dev/null +++ b/services/proxy/src/Proxy/Run.hs @@ -0,0 +1,27 @@ +module Proxy.Run (run) where + +import Imports hiding (head) +import Control.Monad.Catch +import Control.Lens hiding ((.=)) +import Data.Metrics.Middleware hiding (path) +import Data.Metrics.Middleware.Prometheus (waiPrometheusMiddleware) +import Data.Metrics.WaiRoute (treeToPaths) +import Network.Wai.Utilities.Server hiding (serverPort) +import Network.Wai.Handler.Warp (runSettings) +import Proxy.Env +import Proxy.Proxy +import Proxy.Options +import Proxy.API (sitemap) + +run :: Opts -> IO () +run o = do + m <- metrics + e <- createEnv m o + s <- newSettings $ defaultServer (o^.host) (o^.port) (e^.applog) m + let rtree = compile (sitemap e) + let measured = measureRequests m (treeToPaths rtree) + let app r k = runProxy e r (route rtree r k) + let middleware = waiPrometheusMiddleware (sitemap e) + . measured + . catchErrors (e^.applog) m + runSettings s (middleware app) `finally` destroyEnv e From 3e392fe48919ac5da1ed6df0e582f9ba3c939606 Mon Sep 17 00:00:00 2001 From: Chris Penner Date: Mon, 25 Mar 2019 15:07:18 +0100 Subject: [PATCH 08/11] Deprecate old monitoring strategy --- libs/wai-utilities/src/Network/Wai/Utilities/Server.hs | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/libs/wai-utilities/src/Network/Wai/Utilities/Server.hs b/libs/wai-utilities/src/Network/Wai/Utilities/Server.hs index 8825c930d42..33e5d8166c1 100644 --- a/libs/wai-utilities/src/Network/Wai/Utilities/Server.hs +++ b/libs/wai-utilities/src/Network/Wai/Utilities/Server.hs @@ -173,7 +173,8 @@ route rt rq k = Route.routeWith (Route.Config $ errorRs' noEndpoint) rt rq (lift -------------------------------------------------------------------------------- -- Middlewares --- | Create a middleware that tracks detailed request / response +-- | DEPRECATED; use 'waiPrometheusMiddleware' instead. +-- Create a middleware that tracks detailed request / response -- statistics, including timing information, for every path in the -- given routing tree. -- From 54f3f52ff62772bde55507960087565385f08b95 Mon Sep 17 00:00:00 2001 From: Chris Penner Date: Mon, 25 Mar 2019 15:14:41 +0100 Subject: [PATCH 09/11] Dont' rebuild the route paths tree on every request! --- .../src/Data/Metrics/Middleware/Prometheus.hs | 10 ++++++---- services/cargohold/test/integration/TestSetup.hs | 2 +- 2 files changed, 7 insertions(+), 5 deletions(-) diff --git a/libs/metrics-wai/src/Data/Metrics/Middleware/Prometheus.hs b/libs/metrics-wai/src/Data/Metrics/Middleware/Prometheus.hs index 85af747620a..9b0e07f79f5 100644 --- a/libs/metrics-wai/src/Data/Metrics/Middleware/Prometheus.hs +++ b/libs/metrics-wai/src/Data/Metrics/Middleware/Prometheus.hs @@ -7,6 +7,7 @@ import qualified Network.Wai.Middleware.Prometheus as Promth import qualified Data.Text.Encoding as T import Data.Metrics.WaiRoute (treeToPaths) +import Data.Metrics.Types (Paths) import Data.Metrics.Types (treeLookup) -- | Adds a prometheus metrics endpoint at @/i/metrics@ @@ -14,8 +15,9 @@ import Data.Metrics.Types (treeLookup) -- (e.g. removing params from calls) waiPrometheusMiddleware :: Monad m => Routes a m b -> Wai.Middleware waiPrometheusMiddleware routes = - Promth.prometheus conf . Promth.instrumentHandlerValue (normalizeWaiRequestRoute routes) + Promth.prometheus conf . Promth.instrumentHandlerValue (normalizeWaiRequestRoute paths) where + paths = treeToPaths $ prepare routes conf = Promth.def { Promth.prometheusEndPoint = ["i", "metrics"] -- We provide our own instrumentation so we can normalize routes @@ -25,11 +27,11 @@ waiPrometheusMiddleware routes = -- | Compute a normalized route for a given request. -- Normalized routes have route parameters replaced with their identifier -- e.g. @/user/1234@ might become @/user/userid@ -normalizeWaiRequestRoute :: Monad m => Routes a m b -> Wai.Request -> Text -normalizeWaiRequestRoute routes req = pathInfo +normalizeWaiRequestRoute :: Paths -> Wai.Request -> Text +normalizeWaiRequestRoute paths req = pathInfo where mPathInfo :: Maybe ByteString - mPathInfo = treeLookup (treeToPaths $ prepare routes) (T.encodeUtf8 <$> Wai.pathInfo req) + mPathInfo = treeLookup paths (T.encodeUtf8 <$> Wai.pathInfo req) -- Use the normalized path info if available; otherwise dump the raw path info for -- debugging purposes diff --git a/services/cargohold/test/integration/TestSetup.hs b/services/cargohold/test/integration/TestSetup.hs index deafc8d4cae..dfee5835085 100644 --- a/services/cargohold/test/integration/TestSetup.hs +++ b/services/cargohold/test/integration/TestSetup.hs @@ -23,7 +23,7 @@ data TestSetup = TestSetup } makeLenses ''TestSetup -test :: IO TestSetup -> TestName -> (TestSignature a) -> TestTree +test :: IO TestSetup -> TestName -> TestSignature a -> TestTree test s n h = testCase n runTest where runTest = do From 1f5dd7cf4af63a46323015f280a83db036ed62c0 Mon Sep 17 00:00:00 2001 From: Chris Penner Date: Mon, 25 Mar 2019 15:17:22 +0100 Subject: [PATCH 10/11] fixup! Add prometheus middleware to gundeck --- services/gundeck/test/integration/Metrics.hs | 16 +++++++++++++--- 1 file changed, 13 insertions(+), 3 deletions(-) diff --git a/services/gundeck/test/integration/Metrics.hs b/services/gundeck/test/integration/Metrics.hs index 86d5cde536f..e92c3d781a6 100644 --- a/services/gundeck/test/integration/Metrics.hs +++ b/services/gundeck/test/integration/Metrics.hs @@ -10,13 +10,23 @@ import Control.Lens (view) type TestSignature a = GundeckR -> Http a tests :: IO TestSetup -> TestTree -tests s = testGroup "Metrics" [test s "prometheus" testPrometheusMetrics] +tests s = testGroup "Metrics" [ test s "prometheus gundeck" testPrometheusMetricsGundeck + , test s "prometheus cannon" testPrometheusMetricsCannon + ] -testPrometheusMetrics :: TestM () -testPrometheusMetrics = do +testPrometheusMetricsGundeck :: TestM () +testPrometheusMetricsGundeck = do gundeck <- view tsGundeck get (runGundeckR gundeck . path "/i/metrics") !!! do const 200 === statusCode -- Should contain the request duration metric in its output const (Just "TYPE http_request_duration_seconds histogram") =~= responseBody +testPrometheusMetricsCannon :: TestM () +testPrometheusMetricsCannon = do + cannon <- view tsCannon + get (runCannonR cannon . path "/i/metrics") !!! do + const 200 === statusCode + -- Should contain the request duration metric in its output + const (Just "TYPE http_request_duration_seconds histogram") =~= responseBody + From ef8e4b433d1451b9f562d84c0de49486a8bbaad8 Mon Sep 17 00:00:00 2001 From: Chris Penner Date: Tue, 26 Mar 2019 14:20:08 +0100 Subject: [PATCH 11/11] Force CI rebuild