src/Gargantext/API/EKG.hs

   1 {-# OPTIONS_GHC -fno-warn-orphans #-}
   2 {-# LANGUAGE TypeOperators #-}
   3 {-# LANGUAGE ScopedTypeVariables #-}
   4 module Gargantext.API.EKG where
   5
   6 import Data.HashMap.Strict as HM
   7 import Data.Text as T
   8 import Data.Text.IO as T
   9 import Data.Time.Clock.POSIX (getPOSIXTime)
  10 import Network.Wai
  11 import Protolude
  12 import Servant
  13 import Servant.Auth
  14 import Servant.Ekg
  15 import System.Metrics
  16 import qualified System.Metrics.Json as J
  17
  18 -- Mimics https://github.com/tibbe/ekg/blob/master/System/Remote/Snap.hs#L98
  19 type EkgAPI =
  20   "ekg" :>
  21     ( "api" :>
  22        ( Get '[JSON] J.Sample :<|>
  23          CaptureAll "segments" Text :> Get '[JSON] J.Value
  24        ) :<|>
  25        Raw
  26     )
  27
  28 ekgServer :: FilePath -> Store -> Server EkgAPI
  29 ekgServer assetsDir store = (getAll :<|> getOne) :<|> serveDirectoryFileServer assetsDir
  30
  31   where getAll = J.Sample <$> liftIO (sampleAll store)
  32         getOne segments = do
  33           let metric = T.intercalate "." segments
  34           metrics <- liftIO (sampleAll store)
  35           maybe (liftIO (T.putStrLn "not found boohoo") >> throwError err404) (return . J.Value) (HM.lookup metric metrics)
  36
  37 newEkgStore :: HasEndpoint api => Proxy api -> IO (Store, Middleware)
  38 newEkgStore api = do
  39   s <- newStore
  40   registerGcMetrics s
  41   registerCounter "ekg.server_timestamp_ms" getTimeMs s -- used by UI
  42   mid <- monitorEndpoints api s
  43   return (s, mid)
  44
  45   where getTimeMs = (round . (* 1000)) `fmap` getPOSIXTime
  46
  47 instance HasEndpoint api => HasEndpoint (Auth xs a :> api) where
  48     getEndpoint        _ = getEndpoint        (Proxy :: Proxy api)
  49     enumerateEndpoints _ = enumerateEndpoints (Proxy :: Proxy api)