feat(users/Profpatsch/whatcd-resolver): add basic otel tracing
For it to work, you need otel (e.g. jaeger) to run on port 4317. Change-Id: I36f0493b9be26af256769ae5af8916029036a76e Reviewed-on: https://cl.tvl.fyi/c/depot/+/9488 Tested-by: BuildkiteCI Autosubmit: Profpatsch <mail@profpatsch.de> Reviewed-by: Profpatsch <mail@profpatsch.de>
This commit is contained in:
parent
cd47d188ae
commit
0dcc72a31c
4 changed files with 55 additions and 5 deletions
|
@ -54,6 +54,7 @@ pkgs.mkShell {
|
|||
h.postgresql-simple
|
||||
h.resource-pool
|
||||
h.xmonad-contrib
|
||||
h.hs-opentelemetry-sdk
|
||||
]))
|
||||
|
||||
pkgs.rustup
|
||||
|
|
|
@ -26,6 +26,7 @@ let
|
|||
pkgs.haskellPackages.aeson-better-errors
|
||||
pkgs.haskellPackages.blaze-html
|
||||
pkgs.haskellPackages.dlist
|
||||
pkgs.haskellPackages.hs-opentelemetry-sdk
|
||||
pkgs.haskellPackages.http-conduit
|
||||
pkgs.haskellPackages.http-types
|
||||
pkgs.haskellPackages.ihp-hsx
|
||||
|
|
|
@ -40,6 +40,9 @@ import Network.HTTP.Types
|
|||
import Network.HTTP.Types qualified as Http
|
||||
import Network.Wai qualified as Wai
|
||||
import Network.Wai.Handler.Warp qualified as Warp
|
||||
import OpenTelemetry.Trace qualified as Otel hiding (getTracer, inSpan)
|
||||
import OpenTelemetry.Trace qualified as OtelTrace
|
||||
import OpenTelemetry.Trace.Monad qualified as Otel
|
||||
import PossehlAnalyticsPrelude
|
||||
import Postgres.Decoder qualified as Dec
|
||||
import Postgres.MonadPostgres
|
||||
|
@ -47,6 +50,7 @@ import Pretty
|
|||
import RunCommand (runCommandExpect0)
|
||||
import System.Directory qualified as Dir
|
||||
import System.Directory qualified as Xdg
|
||||
import System.Environment qualified as Env
|
||||
import System.FilePath ((</>))
|
||||
import System.IO qualified as IO
|
||||
import Text.Blaze.Html (Html)
|
||||
|
@ -60,8 +64,10 @@ main :: IO ()
|
|||
main =
|
||||
runAppWith
|
||||
( do
|
||||
_ <- runTransaction migrate
|
||||
htmlUi
|
||||
-- todo: trace that to the init functions as well
|
||||
Otel.inSpan "whatcd-resolver main function" Otel.defaultSpanArguments $ do
|
||||
_ <- runTransaction migrate
|
||||
htmlUi
|
||||
)
|
||||
<&> first showToError
|
||||
>>= expectIOError "could not start whatcd-resolver"
|
||||
|
@ -906,8 +912,13 @@ assertOneUpdated name x = case x.numberOfRowsAffected of
|
|||
1 -> pure ()
|
||||
n -> appThrowTree ([fmt|{name :: Text}: Expected to update exactly one row, but updated {n :: Natural} row(s)|])
|
||||
|
||||
migrate :: (MonadPostgres m) => Transaction m (Label "numberOfRowsAffected" Natural)
|
||||
migrate = do
|
||||
migrate ::
|
||||
( MonadPostgres m,
|
||||
MonadUnliftIO m,
|
||||
Otel.MonadTracer m
|
||||
) =>
|
||||
Transaction m (Label "numberOfRowsAffected" Natural)
|
||||
migrate = inSpanT "Database Migration" $ do
|
||||
execute_
|
||||
[sql|
|
||||
CREATE SCHEMA IF NOT EXISTS redacted;
|
||||
|
@ -1034,6 +1045,21 @@ getBestTorrents = do
|
|||
}
|
||||
)
|
||||
|
||||
inSpan :: (MonadUnliftIO m, Otel.MonadTracer m) => Text -> m a -> m a
|
||||
inSpan name = Otel.inSpan name Otel.defaultSpanArguments
|
||||
|
||||
inSpanT :: (Otel.MonadTracer m, MonadUnliftIO m) => Text -> Transaction m b -> Transaction m b
|
||||
inSpanT name transaction = do
|
||||
tracer <- lift @Transaction $ Otel.getTracer
|
||||
-- I don’t want to implement MonadTracer for Transaction,
|
||||
-- so I’m unlifting it via IO, that should work :P
|
||||
withRunInIO $ \runInIO -> do
|
||||
OtelTrace.inSpan
|
||||
tracer
|
||||
name
|
||||
Otel.defaultSpanArguments
|
||||
(runInIO transaction)
|
||||
|
||||
hush :: Either a1 a2 -> Maybe a2
|
||||
hush (Left _) = Nothing
|
||||
hush (Right a) = Just a
|
||||
|
@ -1114,7 +1140,7 @@ assertM f v = case f v of
|
|||
Left err -> appThrowTree err
|
||||
|
||||
runAppWith :: AppT IO a -> IO (Either TmpPg.StartError a)
|
||||
runAppWith appT = withDb $ \db -> do
|
||||
runAppWith appT = withTracer $ \tracer -> withDb $ \db -> do
|
||||
pgFormat <- readTools (label @"toolsEnvVar" "WHATCD_RESOLVER_TOOLS") (readTool "pg_format")
|
||||
let config = label @"logDatabaseQueries" LogDatabaseQueries
|
||||
pgConnPool <-
|
||||
|
@ -1131,6 +1157,23 @@ runAppWith appT = withDb $ \db -> do
|
|||
appT
|
||||
runReaderT newAppT.unAppT Context {..}
|
||||
|
||||
withTracer :: (Otel.Tracer -> IO c) -> IO c
|
||||
withTracer f = do
|
||||
setDefaultEnv "OTEL_SERVICE_NAME" "whatcd-resolver"
|
||||
bracket
|
||||
-- Install the SDK, pulling configuration from the environment
|
||||
Otel.initializeGlobalTracerProvider
|
||||
-- Ensure that any spans that haven't been exported yet are flushed
|
||||
Otel.shutdownTracerProvider
|
||||
-- Get a tracer so you can create spans
|
||||
(\tracerProvider -> f $ Otel.makeTracer tracerProvider "whatcd-resolver" Otel.tracerOptions)
|
||||
|
||||
setDefaultEnv :: String -> String -> IO ()
|
||||
setDefaultEnv envName defaultValue = do
|
||||
Env.lookupEnv envName >>= \case
|
||||
Just _env -> pure ()
|
||||
Nothing -> Env.setEnv envName defaultValue
|
||||
|
||||
withDb :: (TmpPg.DB -> IO a) -> IO (Either TmpPg.StartError a)
|
||||
withDb act = do
|
||||
dataDir <- Xdg.getXdgDirectory Xdg.XdgData "whatcd-resolver"
|
||||
|
@ -1158,6 +1201,7 @@ withDb act = do
|
|||
|
||||
data Context = Context
|
||||
{ config :: Label "logDatabaseQueries" DebugLogDatabaseQueries,
|
||||
tracer :: Otel.Tracer,
|
||||
pgFormat :: Tool,
|
||||
pgConnPool :: Pool Postgres.Connection,
|
||||
transmissionSessionId :: MVar ByteString
|
||||
|
@ -1183,6 +1227,9 @@ orAppThrowTree = \case
|
|||
instance (MonadIO m) => MonadLogger (AppT m) where
|
||||
monadLoggerLog loc src lvl msg = liftIO $ Logger.defaultOutput IO.stderr loc src lvl (Logger.toLogStr msg)
|
||||
|
||||
instance (Monad m) => Otel.MonadTracer (AppT m) where
|
||||
getTracer = AppT $ asks (.tracer)
|
||||
|
||||
class MonadTransmission m where
|
||||
getTransmissionId :: m (Maybe ByteString)
|
||||
setTransmissionId :: ByteString -> m ()
|
||||
|
|
|
@ -79,6 +79,7 @@ library
|
|||
directory,
|
||||
dlist,
|
||||
filepath,
|
||||
hs-opentelemetry-sdk,
|
||||
http-conduit,
|
||||
http-types,
|
||||
ihp-hsx,
|
||||
|
|
Loading…
Reference in a new issue