Add prometheus middleware to gundeck

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

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

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

services/gundeck/src/Main.hs

@@ -1,15 +1,15 @@
 module Main (main) where
 
 import Imports
-import Gundeck.API
+import Gundeck.Run (run)
 import OpenSSL (withOpenSSL)
 
 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"

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

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"

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
+

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
+