diff --git a/baikai-trace-otel.cabal b/baikai-trace-otel.cabal --- a/baikai-trace-otel.cabal +++ b/baikai-trace-otel.cabal @@ -1,6 +1,6 @@ cabal-version: 3.4 name: baikai-trace-otel -version: 0.3.0.2 +version: 0.3.0.3 synopsis: OpenTelemetry TraceSink for baikai. description: Provides an opt-in OpenTelemetry adapter for the baikai 'TraceSink' @@ -23,6 +23,21 @@ -fhide-source-paths -Wmissing-export-lists -Wpartial-fields -Wmissing-deriving-strategies + -- Exhaustiveness is an error, not a warning. A non-exhaustive match + -- is a crash the compiler already found: it fails at runtime, on + -- whichever input reaches the missing branch, usually in front of a + -- user. This is not hypothetical here — adding a constructor to + -- AgentRunFailure left `failureExitCode` non-exhaustive and shipped a + -- pattern-match failure on `baikai agent run --require-evidence`, + -- because the warning scrolled past in a build log. + -- + -- Promoted individually rather than through -Werror, which would also + -- fail the build on warnings that are stylistic or that a future GHC + -- invents, and would push people toward blanket suppression. + ghc-options: + -Werror=incomplete-patterns -Werror=incomplete-uni-patterns + -Werror=incomplete-record-updates + default-language: GHC2024 default-extensions: DeriveAnyClass @@ -35,7 +50,7 @@ hs-source-dirs: src exposed-modules: Baikai.Trace.Sink.OpenTelemetry build-depends: - , baikai ^>=0.4.0 + , baikai ^>=0.5.0 , base >=4.20 && <5 , containers ^>=0.7 , hs-opentelemetry-api >=1.0 && <1.1 @@ -53,7 +68,8 @@ main-is: Main.hs ghc-options: -threaded -with-rtsopts=-N build-depends: - , baikai ^>=0.4.0 + , aeson ^>=2.2 + , baikai ^>=0.5.0 , baikai-trace-otel , base , generic-lens diff --git a/src/Baikai/Trace/Sink/OpenTelemetry.hs b/src/Baikai/Trace/Sink/OpenTelemetry.hs --- a/src/Baikai/Trace/Sink/OpenTelemetry.hs +++ b/src/Baikai/Trace/Sink/OpenTelemetry.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE LambdaCase #-} {-# LANGUAGE NamedFieldPuns #-} -- | OpenTelemetry adapter for the baikai 'TraceSink' interface. @@ -23,6 +24,7 @@ ) where +import Baikai.Evidence qualified as Ev import Baikai.Trace.Event (TraceEvent (..)) import Baikai.Trace.Sink (TraceSink (..)) import Control.Monad (forM_) @@ -140,6 +142,80 @@ Otel.setStatus sp (Otel.Error errorMessage) Otel.endSpan sp (Just (utcToTimestamp timestamp)) pure (Map.delete eventId m) + CallEvidence {eventId, evidence} -> + -- Evidence neither opens nor closes a span: it is additional + -- description of a call the started/terminal pair already delimits. + -- + -- The salient fields go on as flat attributes rather than one + -- serialised blob, because observability backends index flat + -- attributes and treat embedded JSON as opaque text. The two + -- digests are the only content-adjacent values that belong here; + -- nothing from the prompt, the thinking text, or a tool payload + -- appears in an evidence record at all. + -- + -- "Baikai.Trace" emits this event /before/ the matching + -- 'CallFinished' or 'CallFailed', which is what makes the lookup + -- below find an open span. It did not always: the terminal came + -- first, the span was ended and removed, and this branch was + -- unreachable from a live stream. If that ordering is ever changed + -- back, these attributes silently stop appearing — the lookup + -- misses and nothing fails. + -- + -- A miss is still tolerated rather than treated as an error, + -- because a hand-fed or replayed stream may legitimately carry + -- evidence for a call this sink never saw start. + case Map.lookup eventId m of + Nothing -> pure m + Just sp -> do + Otel.addAttributes sp (evidenceAttributes evidence) + pure m + +-- | The flat attribute set for one 'ModelCallEvidence'. +-- +-- 'Ev.observedModel' is attached only when the provider actually +-- reported one. Attaching the requested model under an "observed" key +-- when the provider said nothing would be exactly the backfill the +-- 'Ev.Observed' type exists to prevent, and an observability backend +-- gives no way to tell the two apart after the fact. +-- +-- Read through a record pattern rather than bare selectors: +-- 'Ev.ModelCallEvidence' and 'Ev.EvidenceRequest' both carry @runId@, +-- so under @DuplicateRecordFields@ a bare @Ev.runId ev@ is an ambiguous +-- occurrence. Matching on the constructor resolves every field at once +-- and costs this package no new dependency. +evidenceAttributes :: Ev.ModelCallEvidence -> HashMap.HashMap Text Attr.Attribute +evidenceAttributes + Ev.ModelCallEvidence + { Ev.schemaVersion, + Ev.runId, + Ev.callId, + Ev.requestedModel, + Ev.observedModel, + Ev.strength, + Ev.requestCommitment, + Ev.requestConfiguration + } = + maybe id (HashMap.insert "gen_ai.response.model" . Attr.toAttribute) observed $ + HashMap.fromList + [ ("baikai.evidence.schema_version", Attr.toAttribute schemaVersion), + ("baikai.evidence.run_id", Attr.toAttribute runId), + ("baikai.evidence.call_id", Attr.toAttribute callId), + ("baikai.evidence.strength", Attr.toAttribute (strengthText strength)), + ("gen_ai.request.model", Attr.toAttribute requestedModel), + ("baikai.evidence.request_commitment", Attr.toAttribute requestCommitment), + ("baikai.evidence.request_configuration", Attr.toAttribute requestConfiguration) + ] + where + observed = Ev.observedValue observedModel + +-- | Render an 'Ev.EvidenceStrength' with the same spelling the JSON +-- encoding uses, so a span attribute and a trace line agree. +strengthText :: Ev.EvidenceStrength -> Text +strengthText = \case + Ev.EvidenceRequestedOnly -> "requested_only" + Ev.EvidenceCorrelated -> "correlated" + Ev.EvidenceModelObserved -> "model_observed" + Ev.EvidenceFullyObserved -> "fully_observed" -- | Convert a 'UTCTime' to an OpenTelemetry 'Timestamp'. -- diff --git a/test/Main.hs b/test/Main.hs --- a/test/Main.hs +++ b/test/Main.hs @@ -6,6 +6,14 @@ import Baikai.Content (AssistantContent (..), TextContent (..)) import Baikai.Context (Context (..), emptyContext) import Baikai.Error (BaikaiError, providerError) +import Baikai.Evidence + ( CallStatus (..), + EvidenceRequest, + TransportKind (..), + evidenceRequest, + noThinkingRequested, + ) +import Baikai.Evidence.Build (minimalEvidence) import Baikai.Message (AssistantPayload (..), user) import Baikai.Model (Model (..), emptyModel) import Baikai.Options (Options, emptyOptions) @@ -14,16 +22,20 @@ import Baikai.StopReason (StopReason (..)) import Baikai.Stream (liftCompleteToStream) import Baikai.Trace (withTrace, withTraceStream) +import Baikai.Trace.Event (TraceEvent (..)) +import Baikai.Trace.Sink (TraceSink (..)) import Baikai.Trace.Sink.OpenTelemetry (otelSink) import Baikai.Usage (Usage, zeroUsage) import Control.Concurrent (threadDelay) import Control.Exception (throwIO) import Control.Lens ((&), (.~), (^.)) +import Data.Aeson qualified as Aeson import Data.Generics.Labels () import Data.HashMap.Strict qualified as HashMap import Data.IORef (IORef, readIORef) import Data.Text (Text) import Data.Text qualified as Text +import Data.Time (getCurrentTime) import Data.Vector qualified as V import OpenTelemetry.Attributes qualified as Attr import OpenTelemetry.Exporter.InMemory.Span (inMemoryListExporter) @@ -40,7 +52,9 @@ "baikai-trace-otel" [ successSpanTest, failureSpanTest, - abortSpanTest + abortSpanTest, + evidenceSpanTest, + liveEvidenceSpanTest ] -- | Build a stub 'Model' under a private 'Api' tag. Each test uses @@ -83,7 +97,8 @@ provider = "stub.otel", responseId = Nothing, latencyMs = 0, - errorInfo = Nothing + errorInfo = Nothing, + evidence = Nothing } registerOk :: Api -> IO () @@ -93,7 +108,8 @@ ApiProvider { apiTag = a, stream = liftCompleteToStream handler, - complete = handler + complete = handler, + describeThinking = \_ _ -> noThinkingRequested } registerFail :: Api -> BaikaiError -> IO () @@ -103,7 +119,8 @@ ApiProvider { apiTag = a, stream = liftCompleteToStream handler, - complete = handler + complete = handler, + describeThinking = \_ _ -> noThinkingRequested } newTracerWithInMemory :: IO (Otel.Tracer, IO [Otel.ImmutableSpan]) @@ -220,3 +237,151 @@ if length spans >= n then pure spans else threadDelay 50000 >> go (k - 1) + +-- | A 'CallEvidence' event describes a call the started/terminal pair +-- already delimits, so it must neither open a span nor close one. +-- +-- The sink is fed a hand-built sequence rather than driven through +-- 'withTrace', for two reasons. It isolates the claim to the sink's own +-- behaviour, and it is the only way to reach the attach path at all: +-- "Baikai.Trace" pushes the evidence event /after/ the terminal, by +-- which point the span has been ended and removed from the map. +-- | The evidence attributes reach a span from a __live__ call, not only +-- from a hand-fed stream. +-- +-- They did not until "Baikai.Trace" was changed to emit @CallEvidence@ +-- before the terminal event. Before that the span had already been +-- ended and removed by the time the evidence arrived, so the sink's +-- attach branch was unreachable outside a replay and every real +-- OpenTelemetry backend saw a span with no evidence on it. Nothing +-- failed; the attributes were simply never there. +-- +-- This is the test that would catch a revert of that ordering. The +-- hand-fed 'evidenceSpanTest' above would not: it feeds the events in +-- the order it chooses. +liveEvidenceSpanTest :: TestTree +liveEvidenceSpanTest = + testCase "A REAL CALL'S EVIDENCE REACHES ITS SPAN" $ do + let a = Custom "baikai-otel-live-evidence" + registerOkWithEvidence a + (tracer, getSpans) <- newTracerWithInMemory + _ <- + withTrace + (otelSink tracer) + (stubModel a) + stubContext + (stubOptions & #evidence .~ Just (evidenceRequest "run-otel-live" :: EvidenceRequest)) + spans <- getSpans + assertEqual "exactly one span recorded" 1 (length spans) + case spans of + [sp] -> do + hot <- spanHotSnapshot sp + let attrs = Attr.getAttributeMap (Otel.hotAttributes hot) + mapM_ + ( \k -> + assertBool + ( "evidence attribute " + <> Text.unpack k + <> " missing from a live call's span; got: " + <> show (HashMap.keys attrs) + ) + (HashMap.member k attrs) + ) + [ "baikai.evidence.run_id", + "baikai.evidence.call_id", + "baikai.evidence.strength" + ] + _ -> assertFailure "expected exactly one span" + +-- | A provider that builds evidence the way a real adapter does, so the +-- record reaches the trace layer through the terminal event rather than +-- being fed in by hand. +registerOkWithEvidence :: Api -> IO () +registerOkWithEvidence a = + let handler m _ctx opts = do + now <- getCurrentTime + ev <- + minimalEvidence + m + opts + TransportHttpApi + noThinkingRequested + (Aeson.object ["model" Aeson..= (m ^. #modelId :: Text)]) + now + now + CallSucceeded + Nothing + pure (stubResponse a & #evidence .~ ev) + in registerApiProvider + ApiProvider + { apiTag = a, + stream = liftCompleteToStream handler, + complete = handler, + describeThinking = \_ _ -> noThinkingRequested + } + +evidenceSpanTest :: TestTree +evidenceSpanTest = + testCase "a CallEvidence event neither opens nor closes a span" $ do + let a = Custom "baikai-otel-evidence" + m = stubModel a + (tracer, getSpans) <- newTracerWithInMemory + let TraceSink fold' = otelSink tracer + now <- getCurrentTime + mev <- + minimalEvidence + m + (stubOptions & #evidence .~ Just (evidenceRequest "run-otel" :: EvidenceRequest)) + TransportHttpApi + noThinkingRequested + (Aeson.object ["model" Aeson..= ("stub-1" :: Text)]) + now + now + CallSucceeded + Nothing + ev <- maybe (assertFailure "expected an evidence record") pure mev + let started = + CallStarted + { eventId = "otel-1", + timestamp = now, + provider = "stub.otel", + model = "stub-1", + maxTokens = 16, + promptSummary = "hello" + } + evidenceEvent = + CallEvidence + { eventId = "otel-1", + timestamp = now, + provider = "stub.otel", + model = "stub-1", + evidence = ev + } + -- Feed started then evidence, and stop. The span is opened by the + -- first and left open by the second; the fold's finalizer is what + -- eventually closes it, so exactly one span is exported. + Stream.fold fold' (Stream.fromList [started, evidenceEvent]) + spans <- getSpans + assertEqual "exactly one span recorded" 1 (length spans) + case spans of + [sp] -> do + hot <- spanHotSnapshot sp + let attrs = Attr.getAttributeMap (Otel.hotAttributes hot) + mapM_ + ( \k -> + assertBool + ("evidence attribute " <> Text.unpack k <> " missing; got: " <> show (HashMap.keys attrs)) + (HashMap.member k attrs) + ) + [ "baikai.evidence.schema_version", + "baikai.evidence.run_id", + "baikai.evidence.call_id", + "baikai.evidence.strength", + "baikai.evidence.request_commitment", + "baikai.evidence.request_configuration" + ] + -- The provider reported no model, so nothing may claim it did. + assertBool + "gen_ai.response.model must be absent when observedModel is Unobserved" + (not (HashMap.member "gen_ai.response.model" attrs)) + _ -> assertFailure "expected exactly one span"