[FLORA-214] Implement tracing with zipkin (#564)

app/cli/Main.hs

@@ -238,7 +238,6 @@ importIndex path repository = do
 importPackageTarball
   :: ( Log :> es
      , BlobStoreAPI :> es
-     , Time :> es
      , IOE :> es
      , DB :> es
      )

cabal.project

@@ -29,6 +29,14 @@ package warp
 package zlib
   flags: -pkg-config
 
+source-repository-package
+    type: git
+    location: https://github.com/scrive/tracing
+    tag: e49720d
+    subdir: 
+        .
+        ./tracing-effectful
+
 source-repository-package
     type: git
     location: https://github.com/haskell-cryptography/libsodium-bindings

changelog.d/564

@@ -0,0 +1,2 @@
+synopsis: Implement tracing with zipkin
+prs: #564

flora.cabal

@@ -133,6 +133,7 @@ library
     Flora.Publish
     Flora.QRCode
     Flora.Search
+    Flora.Tracing
     JSON
     Log.Backend.File
     Lucid.Orphans
@@ -194,6 +195,7 @@ library
     , text
     , text-display
     , time
+    , tracing
     , unliftio
     , utf8-string
     , uuid
@@ -334,6 +336,8 @@ library flora-web
     , text-display
     , time
     , torsor
+    , tracing
+    , tracing-effectful
     , uuid
     , vector
     , vector-algorithms

src/core/Flora/Model/BlobIndex/Update.hs

@@ -10,7 +10,6 @@ import Data.Text.Display (display)
 import Effectful (Eff, type (:>))
 import Effectful.Log (Log)
 import Effectful.PostgreSQL.Transact.Effect (DB, dbtToEff)
-import Effectful.Time (Time)
 import Log qualified
 
 import Database.PostgreSQL.Entity (Entity, _insert)
@@ -31,7 +30,7 @@ import Flora.Model.Release.Types (Release (..), ReleaseId (..))
 import Flora.Model.Release.Update qualified as Update
 
 insertTar
-  :: (Log :> es, DB :> es, BlobStoreAPI :> es, Time :> es)
+  :: (Log :> es, DB :> es, BlobStoreAPI :> es)
   => PackageName
   -> Version
   -> LazyByteString

src/core/Flora/Publish.hs

@@ -4,9 +4,7 @@ import Control.Monad
 import Data.Text.Display
 import Data.Text.IO qualified as T
 import Effectful
-import Effectful.Log
 import Effectful.PostgreSQL.Transact.Effect
-import Effectful.Time
 
 import Flora.Import.Categories.Tuning
 import Flora.Import.Categories.Tuning qualified as Tuning
@@ -25,7 +23,7 @@ import Flora.Model.Requirement (Requirement)
 -}
 
 publishPackage
-  :: (DB :> es, Log :> es, Time :> es, IOE :> es)
+  :: (DB :> es, IOE :> es)
   => [Requirement]
   -> [PackageComponent]
   -> Release

src/core/Flora/Tracing.hs

@@ -0,0 +1,25 @@
+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
+
+newZipkin
+  :: Text
+  -- ^ Zipkin server URL
+  -> Text
+  -- ^ Flora instance identifier
+  -> IO Zipkin
+newZipkin serverURL serviceName = do
+  let settings =
+        ZPK.defaultSettings
+          { ZPK.settingsEndpoint =
+              Just $
+                ZPK.defaultEndpoint
+                  { ZPK.endpointService = Just serviceName
+                  }
+          , ZPK.settingsHostname = Just $ Text.unpack serverURL
+          , ZPK.settingsPublishPeriod = 1
+          }
+  ZPK.new settings

src/jobs-worker/FloraJobs/Runner.hs

@@ -105,7 +105,6 @@ makeReadme pay@ReadmeJobPayload{..} =
 
 fetchTarball
   :: ( IOE :> es
-     , Time :> es
      , DB :> es
      , Reader JobsRunnerEnv :> es
      , Log :> es

src/web/FloraWeb/API/Server/Packages.hs

@@ -5,12 +5,11 @@ import Data.Maybe (fromMaybe)
 import Data.Vector qualified as Vector
 import Distribution.Version (Version)
 import Effectful (Eff, (:>))
-import Servant hiding ((:>))
-
 import Effectful.Error.Static (Error)
-import Effectful.Log (Log)
 import Effectful.PostgreSQL.Transact.Effect (DB)
-import Effectful.Time (Time)
+import Effectful.Trace
+import Servant hiding ((:>))
+
 import Flora.Model.Component.Query qualified as Query
 import Flora.Model.Package.Types
 import Flora.Model.Release.Query qualified as Query
@@ -35,7 +34,10 @@ withPackageServer namespace packageName =
     }
 
 getPackageHandler
-  :: (Time :> es, Log :> es, DB :> es, Error ServerError :> es)
+  :: ( DB :> es
+     , Error ServerError :> es
+     , Trace :> es
+     )
   => Namespace
   -> PackageName
   -> (Eff es) (PackageDTO 0)
@@ -56,7 +58,10 @@ getPackageHandler namespace packageName = do
   pure $ toPackageDTO package release components
 
 getVersionedPackageHandler
-  :: (Time :> es, Log :> es, DB :> es, Error ServerError :> es)
+  :: ( DB :> es
+     , Error ServerError :> es
+     , Trace :> es
+     )
   => Namespace
   -> PackageName
   -> Version

src/web/FloraWeb/Common/Guards.hs

@@ -5,11 +5,11 @@ module FloraWeb.Common.Guards where
 import Data.Text (Text)
 import Distribution.Types.Version (Version)
 import Effectful
-import Effectful.Log (Log)
 import Effectful.PostgreSQL.Transact.Effect
-import Effectful.Time (Time)
+import Effectful.Trace
 import FloraWeb.Pages.Templates
 import Log qualified
+import Monitor.Tracing qualified as Tracing
 import Optics.Core
 import Servant (respond)
 import Servant.API.UVerb
@@ -27,14 +27,16 @@ import FloraWeb.Session (Session)
 import FloraWeb.Types (FloraEff)
 
 guardThatPackageExists
-  :: (DB :> es, Log :> es, Time :> es)
+  :: (DB :> es, Trace :> es)
   => Namespace
   -> PackageName
   -> (Namespace -> PackageName -> Eff es Package)
   -- ^ Action to run if the package does not exist
   -> Eff es Package
 guardThatPackageExists namespace packageName action = do
-  result <- Query.getPackageByNamespaceAndName namespace packageName
+  result <-
+    Tracing.childSpan "Query.getPackageByNamespaceAndName " $
+      Query.getPackageByNamespaceAndName namespace packageName
   case result of
     Nothing -> action namespace packageName
     Just package ->
@@ -43,14 +45,16 @@ guardThatPackageExists namespace packageName action = do
         UnknownPackage -> action namespace packageName
 
 guardThatReleaseExists
-  :: DB :> es
+  :: (DB :> es, Trace :> es)
   => PackageId
   -> Version
   -> (Version -> Eff es Release)
   -- ^ Action to run if the package does not exist
   -> Eff es Release
 guardThatReleaseExists packageId version action = do
-  result <- Query.getReleaseByVersion packageId version
+  result <-
+    Tracing.childSpan "Query.getReleaseByVersion" $
+      Query.getReleaseByVersion packageId version
   case result of
     Just release -> pure release
     Nothing -> action version