Metrics

src/M.hs

@@ -1,8 +1,8 @@
 {-# LANGUAGE FunctionalDependencies #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE TemplateHaskell #-}
-{-# OPTIONS_GHC -Wall #-}
 {-# LANGUAGE UndecidableInstances #-}
+{-# OPTIONS_GHC -Wall #-}
 
 module M where
 
@@ -10,23 +10,28 @@ import Control.Concurrent.STM
 import Control.Exception (bracket)
 import Control.Lens (over, view)
 import Control.Lens.TH (makeFields)
+import Control.Monad.Base (MonadBase)
 import Control.Monad.Catch (MonadCatch, MonadThrow)
 import Control.Monad.Reader (MonadIO, MonadReader, ReaderT, local, runReaderT)
+import Control.Monad.Trans.Control (MonadBaseControl)
 import Creds
 import GHC.Generics (Generic)
+import HTTP (HTTPMetric (HTTPMetric))
 import Katip qualified as K
 import System.IO (stdout)
+import System.Metrics qualified as EKG
 import UnliftIO (MonadUnliftIO)
-import Wallabag (Auth, Auth' (..))
-import Control.Monad.Trans.Control (MonadBaseControl)
-import Control.Monad.Base (MonadBase)
+import Wallabag.Auth (Auth, Auth' (..))
+import qualified Data.HashMap.Strict as HM
 
 data S = S
   { _sTokenCache :: Auth,
     _sLogNamespace :: K.Namespace,
     _sLogEnv :: K.LogEnv,
     _sLogContext :: K.LogContexts,
-    _sCreds :: Creds
+    _sCreds :: Creds,
+    _sWallabagMetrics :: HTTPMetric,
+    _sOpenrouterMetrics :: HTTPMetric
   }
   deriving (Generic)
 
@@ -61,9 +66,23 @@ instance K.KatipContext M where
 
 initialS :: K.Severity -> (S -> IO a) -> IO a
 initialS severity f = do
+  store <- EKG.newStore
+  wbMetrics <-
+    HTTPMetric
+      <$> EKG.createDistribution "wallabag.requests" store
+      <*> EKG.createCounter "wallabag.retries" store
+      <*> EKG.createCounter "wallabag.failures" store
+  orMetrics <-
+    HTTPMetric
+      <$> EKG.createDistribution "openrouter.requests" store
+      <*> EKG.createCounter "openrouter.retries" store
+      <*> EKG.createCounter "openrouter.failures" store
   c <- getCreds
   handleScribe <- K.mkHandleScribe K.ColorIfTerminal stdout (K.permitItem severity) K.V2
   let makeLogEnv = K.registerScribe "stdout" handleScribe K.defaultScribeSettings =<< K.initLogEnv "wallabag" "production"
-  bracket makeLogEnv K.closeScribes $ \le -> do
+  res <- bracket makeLogEnv K.closeScribes $ \le -> do
     cache <- newTVarIO Unauthenticated
-    f (S cache "main" le mempty c)
+    f (S cache "main" le mempty c wbMetrics orMetrics)
+  -- TODO: This is just for debug purposes
+  EKG.sampleAll store >>= mapM_ print . HM.toList
+  pure res