Add prometheus counter for package imports (#811)

app/cli/Main.hs

@@ -19,13 +19,16 @@ import Effectful.FileSystem
 import Effectful.Log (Log, runLog)
 import Effectful.Poolboy
 import Effectful.PostgreSQL.Transact.Effect
+import Effectful.Reader.Static (Reader)
+import Effectful.Reader.Static qualified as Reader
 import Effectful.State.Static.Shared (State)
 import Effectful.State.Static.Shared qualified as State
 import Effectful.Time (Time, runTime)
 import Effectful.Trace (Trace)
 import Effectful.Trace qualified as Trace
 import GHC.Conc
 import GHC.Generics (Generic)
+import GHC.Records
 import Log qualified
 import Log.Backend.StandardOutput qualified as Log
 import Monitor.Tracing.Zipkin (Zipkin (..))
@@ -36,7 +39,8 @@ import System.FilePath ((</>))
 
 import Advisories.Import (importAdvisories)
 import Advisories.Import.Error (AdvisoryImportError)
-import Flora.Environment
+import Flora.Environment (getFloraEnv)
+import Flora.Environment.Env
 import Flora.Import.Categories (importCategories)
 import Flora.Import.Package.Bulk (importAllFilesInRelativeDirectory, importFromIndex)
 import Flora.Model.BlobIndex.Update qualified as Update
@@ -108,6 +112,7 @@ main = Log.withStdOutLogger $ \logger -> do
         )
       . runFileSystem
       . runLog "flora-cli" logger Log.LogTrace
+      . Reader.runReader env
       $ runOptions cliArgs
   case result of
     Right _ -> pure ()
@@ -196,6 +201,9 @@ runOptions
      , Poolboy :> es
      , Error (NonEmpty AdvisoryImportError) :> es
      , Trace :> es
+     , HasField "metrics" r Metrics
+     , HasField "mltp" r MLTP
+     , Reader r :> es
      )
   => Options
   -> Eff es ()
@@ -245,6 +253,9 @@ importFolderOfCabalFiles
      , DB :> es
      , IOE :> es
      , State (Set (Namespace, PackageName, Version)) :> es
+     , HasField "metrics" r Metrics
+     , HasField "mltp" r MLTP
+     , Reader r :> es
      )
   => FilePath
   -> Text
@@ -264,6 +275,9 @@ importIndex
      , DB :> es
      , IOE :> es
      , State (Set (Namespace, PackageName, Version)) :> es
+     , HasField "metrics" r Metrics
+     , HasField "mltp" r MLTP
+     , Reader r :> es
      )
   => FilePath
   -> Text

app/server/Main.hs

@@ -4,12 +4,12 @@
 
 module Main where
 
-import Control.Monad (forM_, unless, void)
+import Control.Monad (forM_, unless)
 import Data.Function ((&))
 import Data.List qualified as List
-import Data.Pool (Pool)
 import Data.Set qualified as Set
 import Data.Text (Text)
+import Data.Text qualified as Text
 import Data.Vector (Vector)
 import Data.Vector qualified as Vector
 import Database.PostgreSQL.Entity
@@ -24,12 +24,11 @@ import Log qualified
 import System.Exit
 import System.IO
 
-import Data.Text qualified as Text
-import Database.PostgreSQL.Simple qualified as PG
-import Flora.Environment (FloraEnv (..), MLTP (..), getFloraEnv)
+import Flora.Environment (getFloraEnv)
+import Flora.Environment.Env (FloraEnv (..), MLTP (..))
 import Flora.Logging qualified as Logging
 import Flora.Model.PackageIndex.Types
-import FloraJobs.Scheduler (checkIfIndexRefreshJobIsPlanned, scheduleRefreshIndexes)
+import FloraJobs.Scheduler (checkIfIndexRefreshJobIsPlanned)
 import FloraWeb.Server
 
 main :: IO ()
@@ -47,17 +46,9 @@ main = do
           Log.LogTrace
         $ do
           checkRepositoriesAreConfigured
-          checkIndexRefreshScheduling env.pool
+          checkIfIndexRefreshJobIsPlanned env.pool
   runFlora
 
-checkIndexRefreshScheduling :: (DB :> es, Log :> es, IOE :> es) => Pool PG.Connection -> Eff es ()
-checkIndexRefreshScheduling pool = do
-  indexRefreshIsPlanned <-
-    checkIfIndexRefreshJobIsPlanned
-  unless indexRefreshIsPlanned $ do
-    Log.logInfo_ "Scheduling index refresh"
-    void $ liftIO $ scheduleRefreshIndexes pool
-
 checkRepositoriesAreConfigured :: (DB :> es, Log :> es, IOE :> es) => Eff es ()
 checkRepositoriesAreConfigured = do
   let expectedRepositories = Set.fromList ["hackage", "cardano", "horizon"]

cabal.project.repositories

@@ -9,10 +9,10 @@ repository cardano
     c00aae8461a256275598500ea0e187588c35a5d5d7454fb57eac18d9edb86a56
     d4a35cd3121aa00d18544bb0ac01c3e1691d618f462c46129271bccf39f7e8ee
 
-repository horizon
-  url: https://packages.horizon-haskell.net/
-  secure: True
-  root-keys:
-    272e995c7a74de109518100e1422193fe5e5971e52c92b98147c9355b47d7bb6
-    ea5c1bc0944dabe64d9d68c6813a8141d747cda042b870576d7af63a2326c31b
-    eb47482ddf51da1d3610094f5c57a626d42cfd7d9c248f53e23420b02b21c695
+-- repository horizon
+--   url: https://packages.horizon-haskell.net/
+--   secure: True
+--   root-keys:
+--     272e995c7a74de109518100e1422193fe5e5971e52c92b98147c9355b47d7bb6
+--     ea5c1bc0944dabe64d9d68c6813a8141d747cda042b870576d7af63a2326c31b
+--     eb47482ddf51da1d3610094f5c57a626d42cfd7d9c248f53e23420b02b21c695

changelog.d/811

@@ -0,0 +1,2 @@
+synopsis: Add prometheus counter for package imports
+prs: #811

environment.sh

@@ -20,7 +20,7 @@ export FLORA_HTTP_PORT=8083
 export FLORA_ENVIRONMENT="development"
 export FLORA_DOMAIN="localhost"
 
-# Either "stdout" or "json"
+# Either "stdout", "json" or "json-file"
 export FLORA_LOGGING_DESTINATION="stdout"
 
 # Compatibility mode for Hackage.

flora.cabal

@@ -97,6 +97,7 @@ library
     Effectful.Poolboy
     Flora.Environment
     Flora.Environment.Config
+    Flora.Environment.Env
     Flora.Import.Categories
     Flora.Import.Categories.Tuning
     Flora.Import.Package
@@ -146,6 +147,7 @@ library
     Flora.Model.User
     Flora.Model.User.Query
     Flora.Model.User.Update
+    Flora.Monitoring
     Flora.QRCode
     Flora.Tracing
     JSON
@@ -203,6 +205,7 @@ library
     , poolboy
     , postgresql-simple
     , pretty
+    , prometheus-client
     , qrcode-core
     , qrcode-juicypixels
     , resource-pool

src/core/Flora/Environment.hs

@@ -1,58 +1,23 @@
-{-# LANGUAGE PartialTypeSignatures #-}
-
 module Flora.Environment
-  ( FloraEnv (..)
-  , DeploymentEnv (..)
-  , MLTP (..)
-  , FeatureEnv (..)
-  , BlobStoreImpl (..)
-  , TestEnv (..)
-  , getFloraEnv
+  ( getFloraEnv
   , getFloraTestEnv
-  )
-where
+  ) where
 
 import Colourista.IO (blueMessage)
-import Data.Aeson (ToJSON)
 import Data.ByteString (ByteString)
 import Data.Pool (Pool)
 import Data.Pool qualified as Pool
 import Data.Pool.Introspection (defaultPoolConfig)
-import Data.Text
 import Data.Text.Encoding qualified as Text
 import Data.Time (NominalDiffTime)
-import Data.Word (Word16)
 import Database.PostgreSQL.Simple qualified as PG
 import Effectful
 import Effectful.Fail (Fail)
-import Env
-  ( parse
-  )
-import Flora.Environment.Config
-import GHC.Generics
+import Env (parse)
 
--- | The datatype that is used in the application
-data FloraEnv = FloraEnv
-  { pool :: Pool PG.Connection
-  , dbConfig :: PoolConfig
-  , jobsPool :: Pool PG.Connection
-  , httpPort :: Word16
-  , domain :: Text
-  , mltp :: MLTP
-  , environment :: DeploymentEnv
-  , features :: FeatureEnv
-  , config :: FloraConfig
-  , assets :: Assets
-  }
-  deriving stock (Generic)
-
-data TestEnv = TestEnv
-  { pool :: Pool PG.Connection
-  , dbConfig :: PoolConfig
-  , httpPort :: Word16
-  , mltp :: MLTP
-  }
-  deriving stock (Generic)
+import Flora.Environment.Config
+import Flora.Environment.Env
+import Flora.Monitoring
 
 mkPool
   :: IOE :> es
@@ -69,16 +34,6 @@ mkPool connectionInfo timeout' connections =
         (realToFrac timeout')
         connections
 
-data BlobStoreImpl = BlobStoreFS FilePath | BlobStorePure
-  deriving stock (Generic, Show)
-
-instance ToJSON BlobStoreImpl
-
-newtype FeatureEnv = FeatureEnv {blobStoreImpl :: Maybe BlobStoreImpl}
-  deriving stock (Generic, Show)
-
-instance ToJSON FeatureEnv
-
 -- In future we'll want to error for conflicting o ptions
 featureConfigToEnv :: FeatureConfig -> Eff es FeatureEnv
 featureConfigToEnv FeatureConfig{..} =
@@ -94,8 +49,8 @@ configToEnv floraConfig = do
   pool <- mkPool floraConfig.connectionInfo connectionTimeout connections
   jobsPool <- mkPool floraConfig.connectionInfo connectionTimeout connections
   assets <- getAssets floraConfig.environment
-  liftIO $ print assets
   featureEnv <- featureConfigToEnv floraConfig.features
+  metrics <- registerMetrics
   pure
     FloraEnv
       { pool = pool
@@ -108,12 +63,14 @@ configToEnv floraConfig = do
       , features = featureEnv
       , assets = assets
       , config = floraConfig
+      , metrics = metrics
       }
 
 testConfigToTestEnv :: TestConfig -> Eff '[IOE] TestEnv
 testConfigToTestEnv config@TestConfig{..} = do
   let PoolConfig{..} = config.dbConfig
   pool <- mkPool connectionInfo connectionTimeout connections
+  metrics <- registerMetrics
   pure TestEnv{..}
 
 getFloraEnv :: Eff '[Fail, IOE] FloraEnv

src/core/Flora/Environment/Env.hs

@@ -0,0 +1,57 @@
+module Flora.Environment.Env
+  ( FloraEnv (..)
+  , Metrics (..)
+  , DeploymentEnv (..)
+  , MLTP (..)
+  , FeatureEnv (..)
+  , BlobStoreImpl (..)
+  , TestEnv (..)
+  ) where
+
+import Data.Aeson
+import Data.Pool (Pool)
+import Data.Text (Text)
+import Data.Word
+import Database.PostgreSQL.Simple qualified as PG
+import Flora.Environment.Config
+import GHC.Generics
+import Prometheus qualified as P
+
+-- | The datatype that is used in the application
+data FloraEnv = FloraEnv
+  { pool :: Pool PG.Connection
+  , dbConfig :: PoolConfig
+  , jobsPool :: Pool PG.Connection
+  , httpPort :: Word16
+  , domain :: Text
+  , mltp :: MLTP
+  , environment :: DeploymentEnv
+  , features :: FeatureEnv
+  , config :: FloraConfig
+  , assets :: Assets
+  , metrics :: Metrics
+  }
+  deriving stock (Generic)
+
+data Metrics = Metrics
+  { packageImportCounter :: P.Vector P.Label1 P.Counter
+  }
+
+data TestEnv = TestEnv
+  { pool :: Pool PG.Connection
+  , dbConfig :: PoolConfig
+  , httpPort :: Word16
+  , mltp :: MLTP
+  , metrics :: Metrics
+  }
+  deriving stock (Generic)
+
+data BlobStoreImpl = BlobStoreFS FilePath | BlobStorePure
+  deriving stock (Generic, Show)
+
+instance ToJSON BlobStoreImpl
+
+newtype FeatureEnv = FeatureEnv {blobStoreImpl :: Maybe BlobStoreImpl}
+  deriving stock (Generic, Show)
+
+instance ToJSON FeatureEnv