Merge branch 'development'

CHANGELOG.md

@@ -7,6 +7,7 @@
 - Remove the enqueueImportJob function [#558](https://github.com/flora-pm/flora-server/pull/558)
 - Store archive hashes [#560](https://github.com/flora-pm/flora-server/pull/560)
 - Implement tracing with zipkin [#564](https://github.com/flora-pm/flora-server/pull/564)
+- Parametrise tracing options [#566](https://github.com/flora-pm/flora-server/pull/566)
 
 ## 1.0.18 -- 2024-05-18
 

app/server/Main.hs

@@ -26,7 +26,7 @@ import System.IO
 
 import Data.Text qualified as Text
 import Database.PostgreSQL.Simple qualified as PG
-import Flora.Environment (FloraEnv (..), LoggingEnv (..), getFloraEnv)
+import Flora.Environment (FloraEnv (..), MLTP (..), getFloraEnv)
 import Flora.Logging qualified as Logging
 import Flora.Model.PackageIndex.Types
 import FloraJobs.Scheduler (checkIfIndexRefreshJobIsPlanned, scheduleRefreshIndexes)
@@ -37,7 +37,7 @@ main = do
   hSetBuffering stdout LineBuffering
   env <- getFloraEnv & runFailIO & runEff
   runEff $ do
-    let withLogger = Logging.makeLogger env.logging.logger
+    let withLogger = Logging.makeLogger env.mltp.logger
     withLogger $ \appLogger ->
       runDB env.pool
         . withUnliftStrategy (ConcUnlift Ephemeral Unlimited)

environment.sh

@@ -33,4 +33,6 @@ export FLORA_COMPATIBILITY_MODE="True"
 # Set these variables in `environment.local.sh`, which is not tracked by git.
 #export SENTRY_DSN="" # Set this variable to connect to to your Sentry instance
 #export FLORA_PROMETHEUS_ENABLED="true" # Set this variable to true or false to enable Prometheus metrics export
-
+#export FLORA_ZIPKIN_ENABLED="true" # Set this variable to true to enable Zipkin traces export
+#export FLORA_ZIPKIN_AGENT_HOST="localhost" # Set this variable to true to set the hostname of the agent to which the traces are shipped
+#export FLORA_ZIPKIN_AGENT_PORT="localhost" # Set this variable to true to set the port of the agent to which the traces are shipped

flora.cabal

@@ -170,6 +170,7 @@ library
     , lucid
     , memory
     , monad-time-effectful
+    , network
     , odd-jobs
     , openapi3
     , optics-core

src/core/Flora/Environment.hs

@@ -3,7 +3,7 @@
 module Flora.Environment
   ( FloraEnv (..)
   , DeploymentEnv (..)
-  , LoggingEnv (..)
+  , MLTP (..)
   , FeatureEnv (..)
   , BlobStoreImpl (..)
   , TestEnv (..)
@@ -38,7 +38,7 @@ data FloraEnv = FloraEnv
   , jobsPool :: Pool PG.Connection
   , httpPort :: Word16
   , domain :: Text
-  , logging :: LoggingEnv
+  , mltp :: MLTP
   , environment :: DeploymentEnv
   , features :: FeatureEnv
   , config :: FloraConfig
@@ -102,7 +102,7 @@ configToEnv floraConfig = do
       , jobsPool = jobsPool
       , httpPort = floraConfig.httpPort
       , domain = floraConfig.domain
-      , logging = floraConfig.logging
+      , mltp = floraConfig.mltp
       , environment = floraConfig.environment
       , features = featureEnv
       , assets = assets

src/core/Flora/Environment/Config.hs

@@ -1,7 +1,7 @@
 -- | Externally facing config parsed from the environment.
 module Flora.Environment.Config
   ( FloraConfig (..)
-  , LoggingEnv (..)
+  , MLTP (..)
   , FeatureConfig (..)
   , ConnectionInfo (..)
   , TestConfig (..)
@@ -42,6 +42,7 @@ import Env
   , Error (..)
   , Parser
   , Reader
+  , auto
   , def
   , help
   , nonempty
@@ -52,6 +53,7 @@ import Env
   , (<=<)
   )
 import GHC.Generics (Generic)
+import Network.Socket (HostName, PortNumber)
 import System.FilePath (isValid)
 import Text.Read (readMaybe)
 
@@ -97,10 +99,14 @@ data AssetBundle = AssetBundle
   }
   deriving stock (Show, Generic)
 
-data LoggingEnv = LoggingEnv
+-- | MLTP stands for Metrics, Logs, Traces and Profiles
+data MLTP = MLTP
   { sentryDSN :: Maybe String
   , prometheusEnabled :: Bool
   , logger :: LoggingDestination
+  , zipkinEnabled :: Bool
+  , zipkinHost :: Maybe HostName
+  , zipkinPort :: Maybe PortNumber
   }
   deriving stock (Show, Generic)
 
@@ -116,7 +122,7 @@ data FloraConfig = FloraConfig
   , connectionInfo :: ByteString
   , domain :: Text
   , httpPort :: Word16
-  , logging :: LoggingEnv
+  , mltp :: MLTP
   , features :: FeatureConfig
   , environment :: DeploymentEnv
   }
@@ -148,12 +154,15 @@ parsePoolConfig =
       "FLORA_DB_POOL_CONNECTIONS"
       (help "Number of connections across all sub-pools")
 
-parseLoggingEnv :: Parser Error LoggingEnv
-parseLoggingEnv =
-  LoggingEnv
+parseMLTP :: Parser Error MLTP
+parseMLTP =
+  MLTP
     <$> var (pure . Just <=< nonempty) "FLORA_SENTRY_DSN" (help "Sentry DSN" <> def Nothing)
-    <*> switch "FLORA_PROMETHEUS_ENABLED" (help "Whether or not Prometheus is enabled")
+    <*> switch "FLORA_PROMETHEUS_ENABLED" (help "Is Prometheus metrics export enabled (default false)")
     <*> var loggingDestination "FLORA_LOGGING_DESTINATION" (help "Where do the logs go")
+    <*> switch "FLORA_ZIPKIN_ENABLED" (help "Is Zipkin trace collection enabled? (default false)")
+    <*> var (pure . Just <=< nonempty) "FLORA_ZIPKIN_AGENT_HOST" (help "The hostname of the Zipkin collection agent" <> def Nothing)
+    <*> var auto "FLORA_ZIPKIN_AGENT_PORT" (help "The port of the Zipkin collection agent")
 
 parseFeatures :: Parser Error FeatureConfig
 parseFeatures =
@@ -181,7 +190,7 @@ parseConfig =
     <*> parseConnectionInfo
     <*> parseDomain
     <*> parsePort
-    <*> parseLoggingEnv
+    <*> parseMLTP
     <*> parseFeatures
     <*> parseDeploymentEnv
 

src/core/Flora/Tracing.hs

@@ -1,12 +1,12 @@
 module Flora.Tracing where
 
 import Data.Text (Text)
-import Data.Text qualified as Text
 import Monitor.Tracing.Zipkin (Zipkin)
 import Monitor.Tracing.Zipkin qualified as ZPK
+import Network.Socket (HostName)
 
 newZipkin
-  :: Text
+  :: Maybe HostName
   -- ^ Zipkin server URL
   -> Text
   -- ^ Flora instance identifier
@@ -19,7 +19,7 @@ newZipkin serverURL serviceName = do
                 ZPK.defaultEndpoint
                   { ZPK.endpointService = Just serviceName
                   }
-          , ZPK.settingsHostname = Just $ Text.unpack serverURL
+          , ZPK.settingsHostname = serverURL
           , ZPK.settingsPublishPeriod = 1
           }
   ZPK.new settings

src/web/FloraWeb/Common/Tracing.hs

@@ -7,7 +7,6 @@ import Data.Aeson qualified as Aeson
 import Data.ByteString.Char8 (unpack)
 import Data.Maybe (isJust)
 import Data.Text.Display (display)
-import Flora.Environment
 import GHC.IO.Exception (IOErrorType (..))
 import Log (LogLevel (..), Logger, logAttention, runLogT)
 import Network.Wai
@@ -17,10 +16,12 @@ import System.Log.Raven (initRaven, register, silentFallback)
 import System.Log.Raven.Transport.HttpConduit (sendRecord)
 import System.Log.Raven.Types (SentryLevel (Error), SentryRecord (..))
 
-onException :: Logger -> DeploymentEnv -> LoggingEnv -> Maybe Request -> SomeException -> IO ()
-onException logger environment tracingEnv mRequest exception =
+import Flora.Environment
+
+onException :: Logger -> DeploymentEnv -> MLTP -> Maybe Request -> SomeException -> IO ()
+onException logger environment mltp mRequest exception =
   Log.runLogT "flora" logger LogAttention $ do
-    case tracingEnv.sentryDSN of
+    case mltp.sentryDSN of
       Nothing -> do
         logAttention "Unhandled exception" $
           Aeson.object ["exception" .= display (show exception)]

src/web/FloraWeb/Server.hs

@@ -59,7 +59,7 @@ import Flora.Environment
   , DeploymentEnv
   , FeatureEnv (..)
   , FloraEnv (..)
-  , LoggingEnv (..)
+  , MLTP (..)
   , getFloraEnv
   )
 import Flora.Environment.Config (Assets, DeploymentEnv (..))
@@ -103,9 +103,9 @@ runFlora =
           runEff . withUnliftStrategy (ConcUnlift Ephemeral Unlimited) . runTime . runConcurrent $ do
             let baseURL = "http://localhost:" <> display env.httpPort
             liftIO $ blueMessage $ "🌺 Starting Flora server on " <> baseURL
-            liftIO $ when (isJust env.logging.sentryDSN) (blueMessage "📋 Connected to Sentry endpoint")
-            liftIO $ when (env.environment == Production) (blueMessage "🖊️ Connected to Zipkin endpoint")
-            let withLogger = Logging.makeLogger env.logging.logger
+            liftIO $ when (isJust env.mltp.sentryDSN) (blueMessage "📋 Connecting to Sentry endpoint")
+            liftIO $ when env.mltp.zipkinEnabled (blueMessage "🖊️ Connecting to Zipkin endpoint")
+            let withLogger = Logging.makeLogger env.mltp.logger
             withLogger
               ( \appLogger ->
                   runServer appLogger env
@@ -131,7 +131,7 @@ logException env logger exception =
 runServer :: (Concurrent :> es, IOE :> es) => Logger -> FloraEnv -> Eff es ()
 runServer appLogger floraEnv = do
   httpManager <- liftIO $ HTTP.newManager tlsManagerSettings
-  zipkin <- liftIO $ Tracing.newZipkin "localhost" "flora-server-local"
+  zipkin <- liftIO $ Tracing.newZipkin floraEnv.mltp.zipkinHost "flora-server"
   let runnerEnv = JobsRunnerEnv httpManager
   let oddjobsUiCfg = makeUIConfig floraEnv.config appLogger floraEnv.jobsPool
       oddJobsCfg =
@@ -157,7 +157,7 @@ runServer appLogger floraEnv = do
             ( onException
                 appLogger
                 floraEnv.environment
-                floraEnv.logging
+                floraEnv.mltp
             )
             defaultSettings
   liftIO
@@ -199,7 +199,7 @@ floraServer cfg jobsRunnerEnv =
 naturalTransform :: FloraEnv -> Logger -> WebEnvStore -> Zipkin -> FloraEff a -> Handler a
 naturalTransform floraEnv logger _webEnvStore zipkin app = do
   let runTrace =
-        if floraEnv.environment == Development
+        if floraEnv.environment == Production
           then Trace.runTrace zipkin.zipkinTracer
           else Trace.runNoTrace
   result <-