baikai-openai 0.4.0.0 → 0.5.0.0

raw patch · 13 files changed

+2549/−169 lines, 13 filesdep +stmdep +temporarydep ~baikaiPVP ok

version bump matches the API change (PVP)

Dependencies added: stm, temporary

Dependency ranges changed: baikai

API changes (from Hackage documentation)

Files

• baikai-openai.cabal +25/−3
• src/Baikai/Provider/OpenAI/Agent.hs +199/−0
• src/Baikai/Provider/OpenAI/Api.hs +390/−57
• src/Baikai/Provider/OpenAI/Cli.hs +168/−27
• src/Baikai/Provider/OpenAI/Interactive.hs +64/−28
• src/Baikai/Provider/OpenAI/Shape.hs +126/−18
• src/Baikai/Provider/OpenAI/Sse.hs +75/−4
• test/CliEvidenceSpec.hs +350/−0
• test/EvidenceSpec.hs +372/−0
• test/Main.hs +439/−23
• test/ReasoningSpec.hs +3/−1
• test/ShapeSpec.hs +204/−2
• test/SseSpec.hs +134/−6

@@ -1,6 +1,6 @@ cabal-version: 3.4 name:          baikai-openai-version:       0.4.0.0+version:       0.5.0.0 synopsis:      OpenAI providers for the baikai abstraction description:   Wraps the openai Haskell package as a Baikai Provider for OpenAI's Chat Completions API.@@ -20,6 +20,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@@ -31,6 +46,7 @@   import:          common-options   hs-source-dirs:  src   exposed-modules:+    Baikai.Provider.OpenAI.Agent     Baikai.Provider.OpenAI.Api     Baikai.Provider.OpenAI.Cli     Baikai.Provider.OpenAI.Interactive@@ -40,9 +56,11 @@     Baikai.Provider.OpenAI.Sse     Baikai.Provider.OpenAI.Transport +  other-modules:   Paths_baikai_openai+  autogen-modules: Paths_baikai_openai   build-depends:     , aeson              ^>=2.2-    , baikai             ^>=0.4.0+    , baikai             ^>=0.5.0     , base               >=4.20   && <5     , base64-bytestring  ^>=1.2     , bytestring         ^>=0.12@@ -68,7 +86,9 @@   hs-source-dirs: test   main-is:        Main.hs   other-modules:+    CliEvidenceSpec     ErrorClassSpec+    EvidenceSpec     ReasoningSpec     ShapeSpec     SseSpec@@ -76,7 +96,7 @@    build-depends:     , aeson-    , baikai            ^>=0.4.0+    , baikai            ^>=0.5.0     , baikai-openai     , base              >=4.20   && <5     , bytestring@@ -90,9 +110,11 @@     , lens              ^>=5.3     , openai     , servant-client+    , stm     , streamly-core     >=0.3    && <0.5     , tasty     , tasty-hunit+    , temporary     , text              ^>=2.1     , time     , vector

@@ -0,0 +1,199 @@+-- | Render the argument vector for an __unattended__ Codex run from+-- Baikai's provider-neutral unattended request type.+--+-- This module is intentionally separate from the other two Codex+-- surfaces. "Baikai.Provider.OpenAI.Cli" drives @codex exec --json@ as+-- a batch completion provider and returns a parsed response.+-- "Baikai.Provider.OpenAI.Interactive" starts the interactive terminal+-- UI and returns when the human quits. This module describes a run with+-- no terminal and no human, whose deliverable is the changed working+-- tree.+--+-- Every function here is pure: nothing is spawned, and the prompt is+-- carried as data rather than as an argument. A policy @codex exec@+-- cannot express is refused with an 'AgentRenderError' before a process+-- would ever be created — notably a tool allow-list, for which Codex+-- has no flag at all.+module Baikai.Provider.OpenAI.Agent+  ( CodexAgentConfig (executable, extraArgs, skipGitRepoCheck, ephemeral),+    defaultCodexAgentConfig,+    codexAgentCommand,+    codexAgentThinking,+  )+where++import Baikai.Agent+  ( AgentCapability (..),+    AgentCommand (..),+    AgentPromptTransport (..),+    AgentProvider (..),+    AgentRenderError (..),+    AgentRunRequest,+  )+import Baikai.Evidence+  ( ThinkingAdjustment (..),+    ThinkingMode (..),+    ThinkingTranslation (..),+    noThinkingRequested,+  )+import Baikai.Prelude+import Baikai.ThinkingLevel (ThinkingLevel, renderThinkingLevel)+import Data.Generics.Labels ()+import Data.Text qualified as Text++-- | Configuration for the unattended @codex@ process.+data CodexAgentConfig = CodexAgentConfig+  { -- | The program to run, either a bare name resolved on @PATH@ or+    -- an explicit path.+    executable :: !FilePath,+    -- | Raw provider defaults an application always wants. Rendered+    -- after every structured flag and before the request's own raw+    -- arguments.+    extraArgs :: ![Text],+    -- | Whether to emit @--skip-git-repo-check@. Defaults to 'True' so+    -- an unattended run works outside a Git repository.+    skipGitRepoCheck :: !Bool,+    -- | Whether to emit @--ephemeral@. Defaults to 'True' so the run+    -- leaves no session files behind.+    ephemeral :: !Bool+  }+  deriving stock (Eq, Show, Generic)++defaultCodexAgentConfig :: CodexAgentConfig+defaultCodexAgentConfig =+  CodexAgentConfig+    { executable = "codex",+      extraArgs = mempty,+      skipGitRepoCheck = True,+      ephemeral = True+    }++-- | Render the executable, argument vector, and prompt transport for an+-- unattended Codex run, or refuse the request.+--+-- The prompt appears nowhere in the argument vector: the transport is+-- 'PromptOnStdin'. That is not merely convenient here — @codex exec@+-- documents that if standard input is piped /and/ a positional prompt+-- is supplied, standard input is appended as a @\<stdin\>@ block, so+-- emitting both would silently corrupt the instruction.+--+-- Long flag spellings are used throughout, @--sandbox@ and @--cd@+-- rather than @-s@ and @-C@, because the rendered vector is printed to+-- operators and a long flag is self-describing.+-- The second half of the pair describes what the request's reasoning+-- effort became on that command line. The runner cannot derive it — it+-- never imports a vendor renderer — so it travels alongside the command.+codexAgentCommand ::+  CodexAgentConfig ->+  AgentRunRequest ->+  Either AgentRenderError (AgentCommand, ThinkingTranslation)+codexAgentCommand cfg req+  | req ^. #provider /= AgentCodex =+      Left (ProviderMismatch AgentCodex (req ^. #provider))+  | otherwise = do+      toolRestrictionGuard req+      sandbox <- sandboxArgs (req ^. #safety . #capability)+      pure+        ( AgentCommand+            { executable = cfg ^. #executable,+              arguments =+                ["exec"]+                  <> modelArgs req+                  <> effortArgs req+                  <> sandbox+                  <> ["--cd", req ^. #workingDir]+                  <> extraDirArgs req+                  <> ["--skip-git-repo-check" | cfg ^. #skipGitRepoCheck]+                  <> ["--ephemeral" | cfg ^. #ephemeral]+                  <> fmap Text.unpack (cfg ^. #extraArgs)+                  <> fmap Text.unpack (req ^. #safety . #providerArgs),+              promptTransport = PromptOnStdin,+              promptText = req ^. #prompt+            },+          codexAgentThinking req+        )++-- | What the request's reasoning effort became on the @codex exec@+-- command line.+--+-- The adjustment list is derived by comparing what 'effortArgs' actually+-- sends — through the same 'codexEffortValue' — with the canonical level+-- name, rather than being hardcoded empty. It is empty at every level,+-- because codex is the one tool baikai drives that accepts all six+-- verbatim; writing @[]@ by hand would keep claiming that after someone+-- changed the mapping.+--+-- A request with no effort at all yields 'noThinkingRequested', which is+-- a different fact from a request whose level the tool weakened.+codexAgentThinking :: AgentRunRequest -> ThinkingTranslation+codexAgentThinking req = case req ^. #effort of+  Nothing -> noThinkingRequested+  Just lvl ->+    let wire = codexEffortValue lvl+     in ThinkingTranslation+          { requested = Just lvl,+            mode = ThinkingModeFlag,+            effortText = Just wire,+            budgetTokens = Nothing,+            wireField = Just "model_reasoning_effort",+            adjustments = [EffortClamped lvl wire | wire /= renderThinkingLevel lvl]+          }++-- | Map a capability profile onto @codex exec@'s @--sandbox@. Kept an+-- 'Either' for the same reason as the Claude renderer's permission-mode+-- mapping: an unmappable capability must be refused, never+-- approximated.+sandboxArgs :: AgentCapability -> Either AgentRenderError [String]+sandboxArgs = \case+  AgentReadOnly -> Right ["--sandbox", "read-only"]+  AgentEditWorkspace -> Right ["--sandbox", "workspace-write"]+  AgentFullAccess -> Right ["--sandbox", "danger-full-access"]++-- | @codex exec@ has no tool allow-list flag, so a request that+-- restricts tools is refused rather than run with unrestricted tools. A+-- caller who narrows the tool set and gets a run with every tool+-- available has been given more authority than they asked for, which is+-- the silent downgrade this surface exists to prevent. The message names+-- the alternative so the error is actionable.+toolRestrictionGuard :: AgentRunRequest -> Either AgentRenderError ()+toolRestrictionGuard req = case req ^. #safety . #allowedTools of+  [] -> Right ()+  _ ->+    Left+      ( UnsupportedToolRestriction+          AgentCodex+          "codex exec has no tool allow-list flag; restrict Codex with a narrower \+          \sandbox mode, or pass an explicit provider argument if your operator \+          \policy permits raw arguments"+      )++-- | A blank model value must not produce @--model ""@.+modelArgs :: AgentRunRequest -> [String]+modelArgs req = case Text.strip <$> req ^. #modelId of+  Nothing -> []+  Just "" -> []+  Just mid -> ["--model", Text.unpack mid]++-- | Codex receives reasoning effort through a config override and+-- accepts all six canonical Baikai levels, so there is no clamp here —+-- unlike Claude, whose @--effort@ has no @minimal@ value. The+-- provider-only @none@ and @ultra@ values remain available through raw+-- provider arguments.+effortArgs :: AgentRunRequest -> [String]+effortArgs req = case req ^. #effort of+  Nothing -> []+  Just lvl ->+    ["-c", "model_reasoning_effort=" <> Text.unpack (codexEffortValue lvl)]++-- | The word codex's @model_reasoning_effort@ override receives. Codex+-- accepts all six baikai levels verbatim, which makes this the identity.+codexEffortValue :: ThinkingLevel -> Text+codexEffortValue = renderThinkingLevel++-- | On @codex exec@ @--add-dir@ grants /write/ access alongside the+-- primary workspace. The identically named Claude Code flag grants tool+-- /access/, so the shared @extraDirs@ field means "directories this run+-- may reach" and the precise authority is provider-dependent.+extraDirArgs :: AgentRunRequest -> [String]+extraDirArgs req =+  concatMap (\dir -> ["--add-dir", dir]) (req ^. #extraDirs)

@@ -32,6 +32,9 @@     registerWithRegistry,     openaiChatProvider,     openaiChatStream,+    openaiChatStreamWith,+    SseDriver,+    openaiStrength,     RawChunk (..),     RawToolDelta (..),     parseChunk,@@ -59,13 +62,15 @@ import Baikai.Cost (zeroCost) import Baikai.Cost.Pricing qualified as Pricing import Baikai.Error (BaikaiError, invalidRequest, providerError)+import Baikai.Evidence qualified as Ev+import Baikai.Evidence.Build qualified as Build import Baikai.Message qualified as Msg import Baikai.Model (Model, openaiCompletionsCompatFor) import Baikai.Options (Options (..)) import Baikai.Provider.OpenAI.Internal.ErrorClass (classifyException) import Baikai.Provider.OpenAI.Internal.Request (mapRequest)-import Baikai.Provider.OpenAI.Shape (streamRequestBody)-import Baikai.Provider.OpenAI.Sse (openaiSseStreamValueWithHeaders)+import Baikai.Provider.OpenAI.Shape (describeThinkingShape, streamRequestBody)+import Baikai.Provider.OpenAI.Sse (ResponseMetadata, capturedHeaderNames, openaiSseStreamValueWithHeaders) import Baikai.Provider.OpenAI.Transport qualified as Transport import Baikai.Provider.Registry   ( ApiProvider (..),@@ -97,6 +102,7 @@ import Data.Aeson.Key qualified as AesonKey import Data.Aeson.KeyMap qualified as KeyMap import Data.Aeson.Types qualified as Aeson+import Data.CaseInsensitive qualified as CI import Data.Generics.Labels () import Data.IORef (IORef, newIORef, readIORef, writeIORef) import Data.IntMap.Strict (IntMap)@@ -110,9 +116,11 @@ import Data.Time.Clock (UTCTime, getCurrentTime) import Data.Vector (Vector) import Data.Vector qualified as Vector+import Data.Version (showVersion) import GHC.Generics (Generic) import Network.HTTP.Types.Header (RequestHeaders) import Numeric.Natural (Natural)+import Paths_baikai_openai qualified as Paths import Servant.Client qualified as Client import Streamly.Data.Stream (Stream) import Streamly.Data.Stream qualified as Stream@@ -129,7 +137,11 @@   ApiProvider     { apiTag = OpenAIChatCompletions,       stream = openaiChatStream,-      complete = streamingComplete openaiChatStream+      complete = streamingComplete openaiChatStream,+      -- Runs the real shaping function and keeps only its description,+      -- so the gate's answer and the wire's behaviour cannot disagree.+      describeThinking = \m opts ->+        describeThinkingShape (openaiCompletionsCompatFor m) opts     }  -- | Install the OpenAI Chat Completions handler into an explicit registry.@@ -151,24 +163,69 @@ -- one 'EventDone' or 'EventError'. openaiChatStream ::   Model -> Context -> Options -> Stream IO AssistantMessageEvent-openaiChatStream m ctx opts =+openaiChatStream = openaiChatStreamWith liveSseDriver++-- | How a call physically reaches the host.+--+-- The arguments are exactly those of+-- 'Baikai.Provider.OpenAI.Sse.openaiSseStreamValueWithHeaders', which is+-- what 'liveSseDriver' is. A test passes a driver that replays a+-- recorded response through the same+-- 'Baikai.Provider.OpenAI.Sse.sseFromResponse' the live one uses, so the+-- request shaping, header allow-list, status classification, and chunk+-- decoding under test are all the real implementations and only the+-- socket is missing.+--+-- The request body arrives as an argument rather than inside a per-call+-- record, so a test driver can capture exactly what went out without+-- this module exporting the record that also holds the resolved API key.+type SseDriver =+  Client.ClientEnv ->+  RequestHeaders ->+  Aeson.Value ->+  (ResponseMetadata -> IO ()) ->+  (Either BaikaiError Aeson.Value -> IO ()) ->+  IO ()++liveSseDriver :: SseDriver+liveSseDriver = openaiSseStreamValueWithHeaders++-- | 'openaiChatStream' over an explicit transport driver.+openaiChatStreamWith ::+  SseDriver -> Model -> Context -> Options -> Stream IO AssistantMessageEvent+openaiChatStreamWith driver m ctx opts =   Stream.concatEffect $ do     setupResult <- trySync (prepareCall m ctx opts)     let setup = either (Left . exceptionToError) id setupResult     case setup of-      Left err -> Stream.fromList <$> immediateError err+      Left err -> Stream.fromList <$> immediateError m opts err       Right call -> do         ch <- newChan :: IO (Chan (Maybe (Either BaikaiError RawChunk)))         tref <- newIORef False-        _ <- forkIO (worker call ch)+        mref <- newIORef Nothing+        _ <- forkIO (worker driver call mref ch)         startTime <- getCurrentTime+        -- The request body is the envelope the two digests commit to:+        -- it is exactly the JSON this call is about to put on the wire.+        -- Credentials are not in it -- they travel in the headers built+        -- separately by 'Transport.requestHeaders'.+        mkEvidence <-+          Build.prepareEvidence+            m+            opts+            Ev.TransportHttpApi+            (call ^. #thinking)+            (call ^. #requestBody)+            startTime         let initialState =               ProducerState                 { chan = ch,                   pending = [EventStart StartPayload {partial = skeletonStart m startTime, responseId = Nothing}],                   assembler = emptyAssembler m startTime,                   finished = False,-                  terminalRef = tref+                  terminalRef = tref,+                  metadataRef = mref,+                  evidence = mkEvidence                 }         pure (Stream.unfoldrM step initialState) @@ -188,7 +245,12 @@   { clientEnv :: !Client.ClientEnv,     requestHeaders :: !RequestHeaders,     timeoutMs :: !(Maybe Int),-    requestBody :: !Aeson.Value+    requestBody :: !Aeson.Value,+    -- | What the caller's reasoning-effort preference became on this+    -- request, as 'streamRequestBody' described it. Carried from here+    -- rather than recomputed at the terminal: only the shaping step+    -- knows which of the seven host wire shapes was used.+    thinking :: !Ev.ThinkingTranslation   }   deriving stock (Generic) @@ -202,7 +264,7 @@     key <- Transport.resolveKey url opts     env <- Transport.getClientEnvCached url     let compat = openaiCompletionsCompatFor m-        body = streamRequestBody compat opts req+        (body, translation) = streamRequestBody compat opts req         headers = Transport.requestHeaders key m opts     pure       ( Right@@ -210,7 +272,8 @@             { clientEnv = env,               requestHeaders = headers,               timeoutMs = opts ^. #timeoutMs,-              requestBody = body+              requestBody = body,+              thinking = translation             }       ) @@ -223,7 +286,14 @@     reasoningDelta :: !(Maybe Text),     finishReason :: !(Maybe Text),     toolDeltas :: ![RawToolDelta],-    usage :: !(Maybe RawUsage)+    usage :: !(Maybe RawUsage),+    -- | The model the host says produced this chunk, from the chunk's+    -- top-level @model@ field. 'Nothing' means the host did not report+    -- one — never that it reported the configured model.+    model :: !(Maybe Text),+    -- | The host's identifier for this response, from the chunk's+    -- top-level @id@ field.+    responseId :: !(Maybe Text)   }   deriving stock (Show, Generic) @@ -244,16 +314,25 @@   deriving stock (Show, Generic)  worker ::-  OpenAICall -> Chan (Maybe (Either BaikaiError RawChunk)) -> IO ()-worker call ch = do+  SseDriver ->+  OpenAICall ->+  IORef (Maybe ResponseMetadata) ->+  Chan (Maybe (Either BaikaiError RawChunk)) ->+  IO ()+worker driver call metaRef ch = do   r <--    trySync $-      Transport.runWithTimeout (call ^. #timeoutMs) $-        openaiSseStreamValueWithHeaders (call ^. #clientEnv) (call ^. #requestHeaders) (call ^. #requestBody) $ \case-          Left be -> writeChan ch (Just (Left be))-          Right val -> case parseChunk val of-            Left err -> writeChan ch (Just (Left (providerError (Text.pack err))))-            Right chunk -> writeChan ch (Just (Right chunk))+    trySync+      $ Transport.runWithTimeout (call ^. #timeoutMs)+      $ driver+        (call ^. #clientEnv)+        (call ^. #requestHeaders)+        (call ^. #requestBody)+        (writeIORef metaRef . Just)+      $ \case+        Left be -> writeChan ch (Just (Left be))+        Right val -> case parseChunk val of+          Left err -> writeChan ch (Just (Left (providerError (Text.pack err))))+          Right chunk -> writeChan ch (Just (Right chunk))   case r of     Right Nothing -> pure ()     Right (Just be) -> writeChan ch (Just (Left be))@@ -296,7 +375,13 @@         reasoningDelta = reasoningDelta,         finishReason = finishR,         toolDeltas = toolDeltas,-        usage = ru+        usage = ru,+        -- Read as a lookup yielding 'Maybe' rather than a required+        -- field: chunks are decoded as raw JSON precisely because+        -- compatible hosts vary, and a host that omits either of these+        -- has reported nothing, which is not a decode failure.+        model = lookupText "model" o,+        responseId = lookupText "id" o       }  parseMessageObject ::@@ -391,41 +476,58 @@     pending :: ![AssistantMessageEvent],     assembler :: !Assembler,     finished :: !Bool,-    terminalRef :: !(IORef Bool)+    terminalRef :: !(IORef Bool),+    -- | Where the worker leaves the response-level metadata it captured+    -- before the first chunk. Read on this side rather than pushed+    -- through 'chan' so the channel keeps carrying exactly one kind of+    -- thing; 'absorbMetadata' folds it into the assembler.+    metadataRef :: !(IORef (Maybe ResponseMetadata)),+    -- | Everything about this call's evidence that was knowable before+    -- the first byte came back, waiting on the terminal timestamp and+    -- outcome. 'Nothing' when the caller did not ask for evidence.+    -- 'sealTerminal' applies it.+    evidence ::+      !(Maybe (UTCTime -> Ev.CallStatus -> Maybe BaikaiError -> Ev.ModelCallEvidence))   }   deriving stock (Generic)  step :: ProducerState -> IO (Maybe (AssistantMessageEvent, ProducerState)) step s   | (e : rest) <- s ^. #pending = do-      writeTerminal s e+      sealed <- sealTerminal s e       pure         ( Just-            ( e,+            ( sealed,               s                 & #pending .~ rest-                & #finished .~ (s ^. #finished || terminal e)+                & #finished .~ (s ^. #finished || terminal sealed)             )         )   | s ^. #finished = pure Nothing   | otherwise = do       mRaw <- readChan (s ^. #chan)+      -- After the read, because the worker writes the metadata before it+      -- writes anything onto the channel: taking it here means every+      -- path out of this branch — including the one where the channel+      -- closed without ever producing a chunk — sees it.+      ass0 <- absorbMetadata (s ^. #metadataRef) (s ^. #assembler)+      let s' = s & #assembler .~ ass0       case mRaw of         Nothing -> do-          alreadyTerminal <- readIORef (s ^. #terminalRef)+          alreadyTerminal <- readIORef (s' ^. #terminalRef)           if alreadyTerminal             then pure Nothing             else do               now <- getCurrentTime-              let (events, ass') = closeOpenStream now Nothing (s ^. #assembler)+              let (events, ass') = closeOpenStream now Nothing ass0               case events of                 [] -> pure Nothing                 (e : rest) -> do-                  writeTerminal s e+                  sealed <- sealTerminal (s' & #assembler .~ ass') e                   pure                     ( Just-                        ( e,-                          s+                        ( sealed,+                          s'                             & #pending .~ rest                             & #assembler .~ ass'                             & #finished .~ True@@ -433,26 +535,179 @@                     )         Just raw -> do           now <- getCurrentTime-          let (events, ass') = translate raw (s ^. #assembler) now+          let (events, ass') = translate raw ass0 now           case events of-            [] -> step (s & #assembler .~ ass')+            [] -> step (s' & #assembler .~ ass')             (e : rest) -> do-              writeTerminal s e+              sealed <- sealTerminal (s' & #assembler .~ ass') e               pure                 ( Just-                    ( e,-                      s+                    ( sealed,+                      s'                         & #pending .~ rest                         & #assembler .~ ass'-                        & #finished .~ (s ^. #finished || terminal e)+                        & #finished .~ (s' ^. #finished || terminal sealed)                     )                 ) -writeTerminal :: ProducerState -> AssistantMessageEvent -> IO ()-writeTerminal s ev-  | terminal ev = writeIORef (s ^. #terminalRef) True-  | otherwise = pure ()+-- | Fold whatever response-level metadata the worker has captured into+-- the assembler.+--+-- Idempotent: applying it again overwrites the same fields with the same+-- values, which is what lets 'step' call it on every pass rather than+-- tracking whether it has run.+absorbMetadata :: IORef (Maybe ResponseMetadata) -> Assembler -> IO Assembler+absorbMetadata ref ass = do+  meta <- readIORef ref+  pure $ case meta of+    Nothing -> ass+    Just md ->+      ass+        & #httpStatus .~ Just (md ^. #httpStatus)+        & #providerRequestId .~ correlationId md +-- | The host's correlation identifier for this response, or a gateway's+-- if the host's own is absent.+--+-- The preference order is+-- 'Baikai.Provider.OpenAI.Sse.capturedHeaderNames' itself, so the+-- allow-list and the preference cannot disagree. Nothing is invented: a+-- response carrying none of those headers leaves this 'Ev.Unobserved'.+correlationId :: ResponseMetadata -> Ev.Observed Text+correlationId md =+  case [v | n <- capturedHeaderNames, Just v <- [lookup (headerName n) (md ^. #headers)]] of+    (v : _) -> Ev.Observed v+    [] -> Ev.Unobserved+  where+    headerName = Text.decodeUtf8 . CI.foldedCase++-- | Mark the stream terminated and attach the call's evidence to the+-- terminal event.+--+-- Every event this producer yields goes through here, so the three+-- sites that can produce a terminal -- a translated upstream chunk, a+-- queued event drained from 'pending', and the channel-close path --+-- all seal identically. Doing it here rather than inside 'translate'+-- keeps that function pure; evidence construction needs 'IO' for the+-- call identifier.+--+-- A non-terminal event passes through unchanged, and so does a terminal+-- on a call whose caller asked for no evidence.+sealTerminal :: ProducerState -> AssistantMessageEvent -> IO AssistantMessageEvent+sealTerminal s ev+  | not (terminal ev) = pure ev+  | otherwise = do+      writeIORef (s ^. #terminalRef) True+      case s ^. #evidence of+        Nothing -> pure ev+        Just finish -> do+          now <- getCurrentTime+          let st = statusOf ev+              record = observeOpenAI st (s ^. #assembler) (finish now st (errorOf ev))+          pure (withEvidence record ev)+  where+    statusOf = \case+      EventDone {} -> Ev.CallSucceeded+      _ -> Ev.CallFailed+    -- The terminal payload already carries the normalized error, and+    -- 'errorTerminal' guarantees it is 'Just' on every 'EventError'.+    errorOf = \case+      EventError p -> p ^. #errorInfo+      _ -> Nothing+    -- Set through the generic-lens label rather than a record update:+    -- 'Baikai.Options.Options' also has an @evidence@ field, so under+    -- @DuplicateRecordFields@ a bare @p {evidence = ...}@ has no unique+    -- constructor to resolve to.+    withEvidence record = \case+      EventDone p -> EventDone (p & #evidence .~ Just record)+      EventError p -> EventError (p & #evidence .~ Just record)+      other -> other++-- | Replace the observed fields of a prepared evidence record with what+-- this call actually saw, and derive the strength from that.+--+-- Only ever reached on a call whose caller asked for evidence, which is+-- what makes it safe to compute the response commitment here: that+-- digest hashes the model's entire output and is the most expensive+-- thing this provider adds. The observations it reads were gathered+-- unconditionally, because each costs a lookup and each improves the+-- 'Baikai.Response.Response' for every caller.+--+-- Nothing here consults the request. An observation the host did not+-- make stays 'Ev.Unobserved'.+observeOpenAI ::+  Ev.CallStatus -> Assembler -> Ev.ModelCallEvidence -> Ev.ModelCallEvidence+observeOpenAI st ass ev =+  ev+    & #endpoint . #implementationVersion .~ Just openaiPackageVersion+    & #observedModel .~ (ass ^. #observedModel)+    & #providerRequestId .~ (ass ^. #providerRequestId)+    & #responseId .~ maybe Ev.Unobserved Ev.Observed (ass ^. #responseId)+    & #usage .~ observedUsage ass+    & #responseCommitment .~ responseCommitment st ass+    & #strength .~ openaiStrength (ass ^. #observedModel) (ass ^. #providerRequestId)++-- | How much an OpenAI-compatible evidence record proves, derived only+-- from what was actually observed.+--+-- No host in this ecosystem echoes the reasoning configuration it+-- applied, so 'Ev.EvidenceFullyObserved' is unreachable on this+-- transport. Reasoning-token counts in the usage block corroborate+-- output volume; they are not a statement of which effort setting was in+-- force and must not raise the strength.+--+-- A successful HTTP status deliberately does not raise it either. A 200+-- means the request was accepted, not that any particular model ran.+openaiStrength :: Ev.Observed Text -> Ev.Observed Text -> Ev.EvidenceStrength+openaiStrength observedModel providerRequestId =+  case (observedModel, providerRequestId) of+    (Ev.Observed _, Ev.Observed _) -> Ev.EvidenceModelObserved+    (_, Ev.Observed _) -> Ev.EvidenceCorrelated+    _ -> Ev.EvidenceRequestedOnly++-- | The token accounting, but only if the host actually reported it.+--+-- The assembler initialises 'usage' to zeroes, so reporting it+-- unconditionally would tell a reader the host said this call consumed+-- nothing — which for a call that failed before any usage arrived is a+-- fabrication, and exactly what 'Ev.Observed' exists to stop.+observedUsage :: Assembler -> Ev.Observed Usage.Usage+observedUsage ass+  | ass ^. #usageReported = Ev.Observed (finalUsage ass)+  | otherwise = Ev.Unobserved++-- | A commitment to what came back, on a call that produced a response.+--+-- Left 'Ev.Unobserved' otherwise: a digest of an empty envelope is a+-- real-looking value standing for a response that never arrived.+responseCommitment :: Ev.CallStatus -> Assembler -> Ev.Observed Text+responseCommitment Ev.CallSucceeded ass =+  Ev.Observed (Ev.commitmentDigest (responseEnvelope ass))+responseCommitment _ _ = Ev.Unobserved++-- | What that digest commits to: the assembled content blocks in order,+-- the stop reason, and the reported usage.+--+-- Deliberately the assembled response rather than the raw SSE bytes. Two+-- identical responses split into different chunks must produce the same+-- digest, and the chunk boundaries are a transport detail no verifier+-- holding the response could reproduce. The key names match the+-- Anthropic adapter's envelope so a consumer reading both does not have+-- to learn two spellings.+responseEnvelope :: Assembler -> Value+responseEnvelope ass =+  Aeson.object+    [ "content" Aeson..= blocksInOrder ass,+      "stop_reason" Aeson..= (ass ^. #stopReason),+      "usage" Aeson..= finalUsage ass+    ]++-- | The version of this package, for the evidence record's endpoint+-- identity. Read from the cabal-generated module rather than written as+-- a literal, which becomes a lie the first time a release misses it.+openaiPackageVersion :: Text+openaiPackageVersion = Text.pack (showVersion Paths.version)+ terminal :: AssistantMessageEvent -> Bool terminal = \case   EventDone {} -> True@@ -587,7 +842,33 @@     -- enabled) has a chance to land.     finishSeen :: !Bool,     pendingError :: !(Maybe BaikaiError),-    finishNote :: !(Maybe Text)+    finishNote :: !(Maybe Text),+    -- The five fields below are what this call /observed/, as distinct+    -- from what it requested. They live here because this record is the+    -- only state that survives from the first chunk to the last, and+    -- because an observation that never arrived must stay+    -- 'Ev.Unobserved' rather than falling back to the caller's+    -- configuration.++    -- | The host's own correlation identifier for this call, from the+    -- response headers.+    providerRequestId :: !(Ev.Observed Text),+    -- | The model identifier the host reported running, from the first+    -- chunk that carried one. Never the configured model.+    observedModel :: !(Ev.Observed Text),+    -- | The host's identifier for this response, from the first chunk+    -- that carried one.+    responseId :: !(Maybe Text),+    -- | The response's HTTP status. Recorded because the transport has+    -- it; 'Baikai.Evidence.ModelCallEvidence' has no field for it, and+    -- inventing one belongs to the vocabulary's plan, not to this+    -- module.+    httpStatus :: !(Maybe Int),+    -- | Whether the host actually reported token counts, as opposed to+    -- 'usage' still holding the zeroes it was initialised with. Without+    -- this a failed call would claim the host reported consuming+    -- nothing.+    usageReported :: !Bool   }   deriving stock (Generic) @@ -613,7 +894,12 @@       stopReason = Stop.Stop,       finishSeen = False,       pendingError = Nothing,-      finishNote = Nothing+      finishNote = Nothing,+      providerRequestId = Ev.Unobserved,+      observedModel = Ev.Unobserved,+      responseId = Nothing,+      httpStatus = Nothing,+      usageReported = False     }  translate ::@@ -624,10 +910,12 @@ translate chunk ass now   | Left be <- chunk =       let msg = finalMessage ass now (Just (be ^. #message)) Stop.ErrorReason-       in ([EventError (errorTerminal Nothing Stop.ErrorReason msg be)], ass)+       in ([EventError (errorTerminal Nothing (ass ^. #responseId) Stop.ErrorReason msg be)], ass)   | Right raw <- chunk =-      let -- 1. Apply field-based reasoning delta.-          (reasoningEvents, ass1) = applyReasoningDelta (raw ^. #reasoningDelta) ass+      let -- 0. Record what the host said about itself.+          ass0 = observeChunk raw ass+          -- 1. Apply field-based reasoning delta.+          (reasoningEvents, ass1) = applyReasoningDelta (raw ^. #reasoningDelta) ass0           -- 2. Apply content delta (open text block if needed).           (textEvents, ass2) = applyContentDelta (raw ^. #contentDelta) ass1           -- 3. Apply tool-call deltas.@@ -643,6 +931,27 @@             Nothing -> ([], ass4)        in (reasoningEvents <> textEvents <> toolEvents <> closeEvents, ass5) +-- | Record what the host reported about itself on this chunk.+--+-- Both values come from the /first/ chunk that carries them and are+-- never overwritten. Compatible hosts repeat both fields on every chunk+-- and they are expected to agree; a host where they disagree is a+-- genuine discovery worth recording rather than something to resolve+-- silently by last-write-wins.+--+-- A missing field means the host reported nothing, so the observation+-- stays 'Ev.Unobserved'. The configured model is never substituted —+-- that is the specific mistake 'Ev.Observed' exists to prevent.+observeChunk :: RawChunk -> Assembler -> Assembler+observeChunk raw ass =+  ass+    & #observedModel .~ firstObserved (ass ^. #observedModel) (raw ^. #model)+    & #responseId .~ ((ass ^. #responseId) <|> (raw ^. #responseId))++firstObserved :: Ev.Observed a -> Maybe a -> Ev.Observed a+firstObserved (Ev.Observed a) _ = Ev.Observed a+firstObserved Ev.Unobserved m = maybe Ev.Unobserved Ev.Observed m+ applyReasoningDelta ::   Maybe Text -> Assembler -> ([AssistantMessageEvent], Assembler) applyReasoningDelta Nothing ass = ([], ass)@@ -798,7 +1107,13 @@  applyUsage :: Maybe RawUsage -> Assembler -> Assembler applyUsage Nothing ass = ass-applyUsage (Just u) ass = ass & #usage .~ rawUsageToUsage u+applyUsage (Just u) ass =+  ass+    & #usage .~ rawUsageToUsage u+    -- A host that sent a usage block reported its counts, even if every+    -- one of them is zero. That is what distinguishes a reported zero+    -- from silence in the evidence record.+    & #usageReported .~ True  -- | Close all open content blocks and stash the resolved stop -- reason; defer 'EventDone' to channel close.@@ -909,8 +1224,8 @@                 else Nothing           msg = finalMessage ass now (fmap (^. #message) terminalErr) reason           terminalEvent = case terminalErr of-            Just be -> EventError (errorTerminal Nothing reason msg be)-            Nothing -> EventDone (doneTerminal Nothing reason msg)+            Just be -> EventError (errorTerminal Nothing (ass ^. #responseId) reason msg be)+            Nothing -> EventDone (doneTerminal Nothing (ass ^. #responseId) reason msg)        in ([terminalEvent], ass)   | otherwise =       -- Channel closed without a finish_reason. Force-close any@@ -927,21 +1242,26 @@             Nothing -> "openai stream ended without finish_reason"           msg = finalMessage ass3 now (Just errText) reason           errInfo = fromMaybe (providerError errText) mErr-          errEv = EventError (errorTerminal Nothing reason msg errInfo)+          errEv = EventError (errorTerminal Nothing (ass3 ^. #responseId) reason msg errInfo)        in (tagEvents <> closeReasoning <> closeText <> closeTools <> [errEv], ass3) +-- | The accumulated token counts with this model's price applied.+--+-- Shared by the assistant message and the evidence record so the two+-- cannot report different numbers for the same call.+finalUsage :: Assembler -> Usage.Usage+finalUsage ass =+  let usageBare = ass ^. #usage+   in usageBare & #cost .~ Pricing.computeCost (ass ^. #model) usageBare+ finalMessage ::   Assembler -> UTCTime -> Maybe Text -> Stop.StopReason -> Msg.Message finalMessage ass now errMsg sr =   let blocks = blocksInOrder ass-      m = ass ^. #model-      usageBare = ass ^. #usage-      computed = Pricing.computeCost m usageBare-      usage' = usageBare & #cost .~ computed    in Msg.AssistantMessage         Msg.AssistantPayload           { Msg.content = blocks,-            Msg.usage = usage',+            Msg.usage = finalUsage ass,             Msg.stopReason = sr,             Msg.errorMessage = errMsg <|> (ass ^. #finishNote),             Msg.timestamp = Just now@@ -952,8 +1272,10 @@  -- | Immediate error stream emitted when the request itself could not -- be built (e.g. message mapping failed).-immediateError :: BaikaiError -> IO [AssistantMessageEvent]-immediateError err = do+-- Nothing was sent, so there is no wire body to digest and the evidence+-- commits to 'Build.dispatchEnvelope' instead -- see its documentation.+immediateError :: Model -> Options -> BaikaiError -> IO [AssistantMessageEvent]+immediateError m opts err = do   now <- getCurrentTime   let errText = err ^. #message   let msg =@@ -965,9 +1287,20 @@               Msg.errorMessage = Just errText,               Msg.timestamp = Just now             }+  ev <-+    Build.minimalEvidence+      m+      opts+      Ev.TransportHttpApi+      Ev.noThinkingRequested+      (Build.dispatchEnvelope m opts)+      now+      now+      Ev.CallFailed+      (Just err)   pure     [ EventStart StartPayload {partial = msg, responseId = Nothing},-      EventError (errorTerminal Nothing Stop.ErrorReason msg err)+      EventError (errorTerminal ev Nothing Stop.ErrorReason msg err)     ]  mapFinishReason :: Text -> (Stop.StopReason, Maybe Text)

@@ -4,6 +4,19 @@ -- Call 'register' once (typically from @main@) to install the -- 'Baikai.Api.OpenAICompletionsCli' handler with default config. -- 'registerWith' accepts a caller-supplied 'CodexCliConfig'.+--+-- The 'Response' this provider returns carries whatever the tool+-- reported about its own run: the token counts from the event stream's+-- turn-completion event, and the thread identifier from its+-- thread-start event as the response identifier. A tool that reports+-- neither yields zeroes and 'Nothing', which is an accurate record of+-- its silence rather than a claim that the call consumed nothing.+--+-- Evidence from this transport is deliberately weaker than from the+-- Chat Completions API. A tool that exits zero has demonstrated that+-- it ran, not which model served the request, so a successful exit+-- never raises the recorded 'Baikai.Evidence.EvidenceStrength' — see+-- 'Baikai.Provider.Cli.Internal.subprocessStrength'. module Baikai.Provider.OpenAI.Cli   ( CodexCliConfig,     executable,@@ -13,6 +26,7 @@     ephemeral,     codexCliCommand,     codexCliPrompt,+    codexCliThinking,     defaultCodexCliConfig,     codexCliProvider,     register,@@ -26,6 +40,8 @@ import Baikai.Content (AssistantContent (..), TextContent (..)) import Baikai.Context (Context) import Baikai.Error (BaikaiError, processError, providerError)+import Baikai.Evidence qualified as Ev+import Baikai.Evidence.Build qualified as Build import Baikai.Message (AssistantPayload (..)) import Baikai.Model (Model) import Baikai.Options (Options)@@ -39,12 +55,12 @@ import Baikai.Response qualified as Resp import Baikai.StopReason (StopReason (..)) import Baikai.Stream (liftCompleteToStream)-import Baikai.ThinkingLevel (renderThinkingLevel)-import Baikai.Usage (zeroUsage)+import Baikai.ThinkingLevel (ThinkingLevel, renderThinkingLevel)+import Baikai.Usage (Usage, zeroUsage) import Control.Concurrent (forkIO) import Control.Concurrent.MVar (newEmptyMVar, putMVar, takeMVar)-import Control.Exception (SomeAsyncException (..), SomeException, displayException, fromException, throwIO, try)-import Control.Lens ((^.))+import Control.Exception (SomeException, displayException, fromException, try)+import Control.Lens ((&), (.~), (^.)) import Data.ByteString qualified as BS import Data.Generics.Labels () import Data.Maybe (fromMaybe)@@ -89,7 +105,10 @@   ApiProvider     { apiTag = OpenAICompletionsCli,       stream = liftCompleteToStream (runCodexCli cfg),-      complete = runCodexCli cfg+      complete = runCodexCli cfg,+      -- The model plays no part: this transport's only reasoning+      -- control is a command-line flag derived from Options alone.+      describeThinking = \_ opts -> codexCliThinking opts     }  -- | Install the Codex CLI handler with a caller-supplied config.@@ -165,8 +184,38 @@ effortArgs :: Options -> [String] effortArgs opts = case opts ^. #thinking of   Nothing -> []-  Just lvl -> ["-c", "model_reasoning_effort=" <> Text.unpack (renderThinkingLevel lvl)]+  Just lvl -> ["-c", "model_reasoning_effort=" <> Text.unpack (codexEffortValue lvl)] +-- | The word codex's @model_reasoning_effort@ override receives. Codex+-- accepts all six baikai levels verbatim, which makes this the identity+-- — and makes it the one transport in baikai that expresses every level+-- exactly.+codexEffortValue :: ThinkingLevel -> Text+codexEffortValue = renderThinkingLevel++-- | What the caller's reasoning-effort preference became on this+-- transport's command line.+--+-- The adjustment list is derived by comparing what 'effortArgs'+-- actually sends — through the same 'codexEffortValue' — with the+-- canonical level name, rather than being hardcoded empty. It is empty+-- today, but writing @[]@ by hand would keep claiming that after+-- someone changed the mapping, which is the class of silent divergence+-- this record exists to prevent.+codexCliThinking :: Options -> Ev.ThinkingTranslation+codexCliThinking opts = case opts ^. #thinking of+  Nothing -> Ev.noThinkingRequested+  Just lvl ->+    let wire = codexEffortValue lvl+     in Ev.ThinkingTranslation+          { requested = Just lvl,+            mode = Ev.ThinkingModeFlag,+            effortText = Just wire,+            budgetTokens = Nothing,+            wireField = Just "model_reasoning_effort",+            adjustments = [Ev.EffortClamped lvl wire | wire /= renderThinkingLevel lvl]+          }+ runCodexCli :: CodexCliConfig -> Model -> Context -> Options -> IO Resp.Response runCodexCli cfg m ctx opts = do   let (exe, args) = codexCliCommand cfg m ctx opts@@ -178,22 +227,48 @@             P.cwd = cfg ^. #workingDir           }   start <- getCurrentTime-  result <- trySync (P.withCreateProcess procSpec (consume start m))+  -- The argument vector is the envelope: for a subprocess it is what+  -- crossed the boundary, and there is nothing else to describe the+  -- launch with. Built lazily and dropped unforced when the caller+  -- asked for no evidence.+  let mkEv mReport end st mErr = do+        prepared <-+          Build.minimalEvidence+            m+            opts+            Ev.TransportSubprocess+            (codexCliThinking opts)+            (Internal.argvEnvelope exe args)+            start+            end+            st+            mErr+        traverse (observeCodexCli exe mReport st) prepared+  result <- Internal.trySync (P.withCreateProcess procSpec (consume start mkEv m))   case result of     Right resp -> pure resp     Left ex -> do       end <- getCurrentTime-      pure (Resp.errorResponse m end (millisBetween start end) (exceptionToError ex))+      let err = exceptionToError ex+      ev <- mkEv Nothing end Ev.CallFailed (Just err)+      let resp = Resp.errorResponse m end (millisBetween start end) err+      pure resp {Resp.evidence = ev}  consume ::   UTCTime ->+  ( Maybe Internal.CodexRunReport ->+    UTCTime ->+    Ev.CallStatus ->+    Maybe BaikaiError ->+    IO (Maybe Ev.ModelCallEvidence)+  ) ->   Model ->   Maybe Handle ->   Maybe Handle ->   Maybe Handle ->   P.ProcessHandle ->   IO Resp.Response-consume start m _ mOut mErr ph = do+consume start mkEv m _ mOut mErr ph = do   case (mOut, mErr) of     (Nothing, _) -> errorNow (providerError "codex: stdout handle missing")     (_, Nothing) -> errorNow (providerError "codex: stderr handle missing")@@ -203,20 +278,31 @@         forkIO $ do           result <- try (BS.hGetContents hErr) :: IO (Either SomeException BS.ByteString)           putMVar errVar (either (const BS.empty) id result)-      body <- Internal.parseCodexJsonlStream (handleStream hOut)+      report <- Internal.parseCodexJsonlStream (handleStream hOut)       errBytes <- takeMVar errVar       exitCode <- P.waitForProcess ph       end <- getCurrentTime       case exitCode of-        ExitFailure n -> pure (Resp.errorResponse m end (millisBetween start end) (processError n (Internal.decodeUtf8Lenient errBytes)))-        ExitSuccess ->+        ExitFailure n -> do+          let err = processError n (Internal.decodeUtf8Lenient errBytes)+          -- The event stream was drained before the exit status was+          -- known, so a failed run may still have named its thread and+          -- its token counts. Those are genuine observations and are+          -- kept; only the response commitment is withheld, because no+          -- complete response exists to commit to.+          ev <- mkEv (Just report) end Ev.CallFailed (Just err)+          let resp = Resp.errorResponse m end (millisBetween start end) err+          pure resp {Resp.evidence = ev, Resp.responseId = report ^. #threadId}+        ExitSuccess -> do+          ev <- mkEv (Just report) end Ev.CallSucceeded Nothing           pure             Resp.Response               { Resp.message =                   AssistantPayload                     { content =-                        Vector.singleton (AssistantText (TextContent (Text.strip body))),-                      usage = zeroUsage,+                        Vector.singleton+                          (AssistantText (TextContent (Text.strip (report ^. #message)))),+                      usage = reportedUsage report,                       stopReason = Stop,                       errorMessage = Nothing,                       timestamp = Just end@@ -224,27 +310,82 @@                 Resp.model = m,                 Resp.api = OpenAICompletionsCli,                 Resp.provider = m ^. #provider,-                Resp.responseId = Nothing,+                Resp.responseId = report ^. #threadId,                 Resp.latencyMs = millisBetween start end,-                Resp.errorInfo = Nothing+                Resp.errorInfo = Nothing,+                Resp.evidence = ev               }   where     errorNow err = do       end <- getCurrentTime-      pure (Resp.errorResponse m end (millisBetween start end) err)+      ev <- mkEv Nothing end Ev.CallFailed (Just err)+      let resp = Resp.errorResponse m end (millisBetween start end) err+      pure resp {Resp.evidence = ev} +-- | Fill in what the tool reported and what baikai knows about the+-- process it launched.+--+-- Only ever reached on a call whose caller asked for evidence, which is+-- what makes the version probe affordable here: it spawns a whole extra+-- subprocess, and charging that to a caller who only wanted an answer+-- from a tool they were about to run anyway would be a visible cost on+-- the cheapest possible call. The event-stream parsing it reads is the+-- opposite case and happens unconditionally, because the provider had+-- already decoded every event to find the assistant text.+--+-- Nothing here consults the request. A field the tool did not report+-- stays 'Ev.Unobserved' — which at @codex-cli 0.146.0@ includes the+-- model, because no event in its stream names one.+observeCodexCli ::+  FilePath ->+  Maybe Internal.CodexRunReport ->+  Ev.CallStatus ->+  Ev.ModelCallEvidence ->+  IO Ev.ModelCallEvidence+observeCodexCli exe mReport st ev = do+  identity <- Internal.executableIdentity exe+  let thread = observedOf (mReport >>= (^. #threadId))+      reported = observedOf (mReport >>= (^. #reportedModel))+      used = mReport >>= (^. #usage)+  pure $+    ev+      -- A subprocess has no endpoint URL. Recording the model's base+      -- URL here would suggest an HTTP request that was never made, so+      -- the resolved executable path takes its place.+      & #endpoint . #endpoint .~ Just (fromMaybe (Text.pack exe) (identity ^. #resolvedPath))+      -- For this transport the tool is the implementation, so its own+      -- version is what determines behaviour — not this package's.+      & #endpoint . #implementationVersion .~ (identity ^. #version)+      & #responseId .~ thread+      & #observedModel .~ reported+      & #usage .~ observedOf used+      & #responseCommitment .~ commitment used+      & #strength .~ Internal.subprocessStrength thread reported+  where+    commitment used = case (st, mReport) of+      (Ev.CallSucceeded, Just r) ->+        Ev.Observed+          ( Ev.commitmentDigest+              ( Internal.cliResponseEnvelope+                  (Text.strip (r ^. #message))+                  (fromMaybe zeroUsage used)+              )+          )+      _ -> Ev.Unobserved++observedOf :: Maybe a -> Ev.Observed a+observedOf = maybe Ev.Unobserved Ev.Observed++-- | The tool's own token counts, or zeroes when it reported none.+--+-- 'Resp.Response' has nowhere to say "the tool stayed silent", so a+-- silent tool still yields 'zeroUsage' here. The evidence record does+-- have somewhere to say it, and says it: see 'observeCodexCli'.+reportedUsage :: Internal.CodexRunReport -> Usage+reportedUsage r = fromMaybe zeroUsage (r ^. #usage)+ millisBetween :: UTCTime -> UTCTime -> Int millisBetween a b = round (realToFrac (diffUTCTime b a) * (1000 :: Double))--trySync :: IO a -> IO (Either SomeException a)-trySync action = do-  r <- try action-  case r of-    Left e-      | Just (SomeAsyncException _) <- (fromException e :: Maybe SomeAsyncException) ->-          throwIO e-      | otherwise -> pure (Left e)-    Right a -> pure (Right a)  exceptionToError :: SomeException -> BaikaiError exceptionToError e = fromMaybe (providerError (Text.pack (displayException e))) (fromException e)

@@ -5,6 +5,11 @@ -- "Baikai.Provider.OpenAI.Cli": that module drives @codex exec@ as a -- batch completion provider, while this module starts the interactive -- terminal UI and returns only after the CLI exits.+--+-- A safety policy Codex cannot express is refused before launch rather+-- than dropped: both the pure command builder and the launcher return+-- 'Either' 'AgentRenderError', and a 'Left' means no process was+-- started. module Baikai.Provider.OpenAI.Interactive   ( CodexInteractiveConfig,     executable,@@ -16,6 +21,7 @@   ) where +import Baikai.Agent (AgentProvider (..), AgentRenderError (..)) import Baikai.Interactive   ( CodexApprovalPolicy,     CodexSandboxMode,@@ -50,19 +56,27 @@  -- | Render the executable and arguments for an interactive Codex -- launch. The final positional argument is the initial prompt.+--+-- Returns 'Left' when the request's safety policy is one Codex cannot+-- express, so a caller who asked to be constrained never receives a+-- command that is not. codexInteractiveCommand ::-  CodexInteractiveConfig -> InteractiveLaunchRequest -> (FilePath, [String])-codexInteractiveCommand cfg req =-  ( cfg ^. #executable,-    modelArgs req-      <> effortArgs req-      <> workingDirArgs req-      <> extraDirArgs req-      <> safetyArgs req-      <> fmap Text.unpack (cfg ^. #extraArgs)-      <> fmap Text.unpack (req ^. #extraArgs)-      <> ["--", Text.unpack (codexInteractivePrompt req)]-  )+  CodexInteractiveConfig ->+  InteractiveLaunchRequest ->+  Either AgentRenderError (FilePath, [String])+codexInteractiveCommand cfg req = do+  safety <- safetyArgs req+  pure+    ( cfg ^. #executable,+      modelArgs req+        <> effortArgs req+        <> workingDirArgs req+        <> extraDirArgs req+        <> safety+        <> fmap Text.unpack (cfg ^. #extraArgs)+        <> fmap Text.unpack (req ^. #extraArgs)+        <> ["--", Text.unpack (codexInteractivePrompt req)]+    )  -- | Codex does not currently expose a top-level interactive -- system-prompt flag. Preserve Baikai's request shape by placing the@@ -73,19 +87,26 @@  -- | Launch Codex with inherited stdin, stdout, and stderr so the -- local CLI owns the interactive terminal experience.+--+-- A 'Left' result means no process was started: the requested safety+-- policy was refused before launch. A 'Right' carrying a non-zero+-- 'System.Exit.ExitCode' means the session ran and exited non-zero. launchCodexInteractive ::-  CodexInteractiveConfig -> InteractiveLaunchRequest -> IO InteractiveLaunchResult-launchCodexInteractive cfg req = do-  let (exe, args) = codexInteractiveCommand cfg req-      spec =-        (P.proc exe args)-          { P.std_in = P.Inherit,-            P.std_out = P.Inherit,-            P.std_err = P.Inherit,-            P.cwd = req ^. #workingDir-          }-  code <- P.withCreateProcess spec (\_ _ _ ph -> P.waitForProcess ph)-  pure (interactiveLaunchResult InteractiveCodex code)+  CodexInteractiveConfig ->+  InteractiveLaunchRequest ->+  IO (Either AgentRenderError InteractiveLaunchResult)+launchCodexInteractive cfg req = case codexInteractiveCommand cfg req of+  Left err -> pure (Left err)+  Right (exe, args) -> do+    let spec =+          (P.proc exe args)+            { P.std_in = P.Inherit,+              P.std_out = P.Inherit,+              P.std_err = P.Inherit,+              P.cwd = req ^. #workingDir+            }+    code <- P.withCreateProcess spec (\_ _ _ ph -> P.waitForProcess ph)+    pure (Right (interactiveLaunchResult InteractiveCodex code))  modelArgs :: InteractiveLaunchRequest -> [String] modelArgs req = case Text.strip <$> req ^. #modelId of@@ -111,11 +132,26 @@ extraDirArgs req =   concatMap (\dir -> ["--add-dir", dir]) (req ^. #extraDirs) -safetyArgs :: InteractiveLaunchRequest -> [String]+-- | 'DefaultSafety' means the caller declined to specify a policy, so+-- rendering nothing honors it rather than downgrading it.+safetyArgs :: InteractiveLaunchRequest -> Either AgentRenderError [String] safetyArgs req = case req ^. #safety of-  CodexSandbox sandbox approval -> codexSafetyArgs sandbox approval-  DefaultSafety -> []-  ClaudeAllowedTools _ -> []+  DefaultSafety -> Right []+  CodexSandbox sandbox approval -> Right (codexSafetyArgs sandbox approval)+  -- An empty allow-list restricts nothing, so there is nothing Codex+  -- fails to honor. Only a non-empty list is a restriction Codex+  -- cannot express. The asymmetry with the next case is deliberate.+  ClaudeAllowedTools [] -> Right []+  ClaudeAllowedTools tools ->+    Left+      ( SafetyNotExpressible+          AgentCodex+          ( "Codex has no tool allow-list flag, so it cannot honor the requested tools ("+              <> Text.intercalate ", " tools+              <> "); use CodexSandbox to restrict Codex, or DefaultSafety to accept its own \+                 \default"+          )+      )  codexSafetyArgs :: CodexSandboxMode -> CodexApprovalPolicy -> [String] codexSafetyArgs sandbox approval =

@@ -7,6 +7,7 @@     renameMaxTokens,     dropUnsupportedStrict,     injectThinkingShape,+    describeThinkingShape,     injectCacheControl,   ) where@@ -25,6 +26,12 @@       ),     ThinkingFormat (..),   )+import Baikai.Evidence+  ( ThinkingAdjustment (..),+    ThinkingMode (..),+    ThinkingTranslation (..),+    noThinkingRequested,+  ) import Baikai.Options (Options, cacheRetention, thinking) import Baikai.ThinkingLevel (ThinkingLevel (..), renderThinkingLevel) import Data.Aeson (Value (..), (.=))@@ -37,19 +44,28 @@ import Data.Vector qualified as Vector import OpenAI.V1.Chat.Completions qualified as Chat +-- | Reshape a request body for the target host, and describe what the+-- caller's reasoning-effort preference became while doing it.+--+-- The translation travels back out rather than staying inside+-- 'injectThinkingShape' because nothing downstream can recompute it: it+-- depends on the host's 'ThinkingFormat', which only the compat lookup+-- knows. Written as an explicit pipeline rather than the point-free+-- composition it used to be, so the description has somewhere to escape+-- to. shapeRequestBody ::-  OpenAICompletionsCompat -> Options -> Aeson.Value -> Aeson.Value-shapeRequestBody compat opts =-  injectCacheControl compat opts-    . injectThinkingShape compat opts-    . dropUnsupportedStrict compat-    . renameMaxTokens compat+  OpenAICompletionsCompat -> Options -> Aeson.Value -> (Aeson.Value, ThinkingTranslation)+shapeRequestBody compat opts body =+  let renamed = renameMaxTokens compat body+      stripped = dropUnsupportedStrict compat renamed+      (thought, translation) = injectThinkingShape compat opts stripped+   in (injectCacheControl compat opts thought, translation)  streamRequestBody ::   OpenAICompletionsCompat ->   Options ->   Chat.CreateChatCompletion ->-  Aeson.Value+  (Aeson.Value, ThinkingTranslation) streamRequestBody compat opts req =   shapeRequestBody compat opts (Aeson.toJSON req')   where@@ -87,26 +103,118 @@             adjustKey (key "json_schema") $               mapObject (KeyMap.delete (key "strict")) -injectThinkingShape :: OpenAICompletionsCompat -> Options -> Aeson.Value -> Aeson.Value+-- | Place the caller's reasoning-effort preference in whichever of the+-- seven shapes the host accepts, and describe what that did to it.+--+-- The body this produces is byte-for-byte what it produced before the+-- description existed. The three shapes that express less than the+-- caller asked for now say so: the five non-native effort shapes clamp+-- through 'compatibleEffort', the two toggle shapes carry no depth at+-- all, and 'ThinkingFormatNone' drops the request entirely.+--+-- The native shape is the one that records __no__ adjustment, because+-- it forwards the canonical level verbatim and therefore expresses all+-- six exactly. That is deliberate and guarded by @nativeHigherEffortTests@+-- in @baikai-openai/test/ShapeSpec.hs@; 'compatibleEffort' is scoped by+-- its own documentation to the non-native shapes and must not be+-- applied here.+injectThinkingShape ::+  OpenAICompletionsCompat -> Options -> Aeson.Value -> (Aeson.Value, ThinkingTranslation) injectThinkingShape compat opts body =   case thinking opts of-    Nothing -> body+    Nothing -> (body, noThinkingRequested)     Just lvl -> case thinkingFormat compat of       ThinkingFormatOpenAI ->-        insertTop "reasoning_effort" (String (renderThinkingLevel lvl)) body-      ThinkingFormatNone -> body+        let e = renderThinkingLevel lvl+         in ( insertTop "reasoning_effort" (String e) body,+              effortTranslation lvl e "reasoning_effort"+            )+      ThinkingFormatNone ->+        ( body,+          ThinkingTranslation+            { requested = Just lvl,+              mode = ThinkingModeUnsupported,+              effortText = Nothing,+              budgetTokens = Nothing,+              wireField = Nothing,+              adjustments = [ThinkingDroppedUnsupportedHost lvl]+            }+        )       ThinkingFormatOpenRouter ->-        insertTop "reasoning" (Aeson.object ["effort" .= compatibleEffort lvl]) body+        let e = compatibleEffort lvl+         in ( insertTop "reasoning" (Aeson.object ["effort" .= e]) body,+              effortTranslation lvl e "reasoning"+            )       ThinkingFormatDeepseek ->-        insertTop "reasoning_effort" (String (compatibleEffort lvl)) $-          insertTop "thinking" (Aeson.object ["type" .= ("enabled" :: Text)]) body+        let e = compatibleEffort lvl+         in ( insertTop "reasoning_effort" (String e) $+                insertTop "thinking" (Aeson.object ["type" .= ("enabled" :: Text)]) body,+              effortTranslation lvl e "reasoning_effort"+            )       ThinkingFormatTogether ->-        insertTop "reasoning_effort" (String (compatibleEffort lvl)) $-          insertTop "reasoning" (Aeson.object ["enabled" .= True]) body+        let e = compatibleEffort lvl+         in ( insertTop "reasoning_effort" (String e) $+                insertTop "reasoning" (Aeson.object ["enabled" .= True]) body,+              effortTranslation lvl e "reasoning_effort"+            )       ThinkingFormatZai ->-        insertTop "enable_thinking" (Bool True) body+        ( insertTop "enable_thinking" (Bool True) body,+          toggleTranslation lvl+        )       ThinkingFormatQwen ->-        insertTop "enable_thinking" (Bool True) body+        ( insertTop "enable_thinking" (Bool True) body,+          toggleTranslation lvl+        )++-- | A host that steers its own depth from an effort word.+--+-- The adjustment list is derived from the word that actually went on+-- the wire, never from a second table beside the mapping: a word equal+-- to the canonical level name expressed the request exactly, and any+-- other word replaced it with something weaker the host accepts. Seven+-- wire shapes share this one derivation precisely so that adding an+-- eighth cannot leave a hand-written table behind.+-- | What this host would do with the caller's reasoning-effort request,+-- without building or sending anything.+--+-- Derived by running the real 'injectThinkingShape' over an empty body+-- and keeping only its description, rather than by reimplementing the+-- seven-shape decision. Two descriptions of one mapping diverge the+-- first time either changes, and the divergence is silent; there is no+-- cheaper way to be sure this agrees with the wire than to ask the+-- function that writes the wire.+describeThinkingShape :: OpenAICompletionsCompat -> Options -> ThinkingTranslation+describeThinkingShape compat opts =+  snd (injectThinkingShape compat opts (Aeson.object []))++effortTranslation :: ThinkingLevel -> Text -> Text -> ThinkingTranslation+effortTranslation lvl wire field =+  ThinkingTranslation+    { requested = Just lvl,+      mode = ThinkingModeAdaptive,+      effortText = Just wire,+      budgetTokens = Nothing,+      wireField = Just field,+      adjustments =+        [EffortClamped lvl wire | wire /= renderThinkingLevel lvl]+    }++-- | A host that accepts thinking on or off and nothing more.+--+-- Every level collapses, including the ones whose canonical name a+-- richer host would have accepted, because the wire carries no depth:+-- a caller asking for @max@ and a caller asking for @low@ produce+-- byte-identical requests here.+toggleTranslation :: ThinkingLevel -> ThinkingTranslation+toggleTranslation lvl =+  ThinkingTranslation+    { requested = Just lvl,+      mode = ThinkingModeToggle,+      effortText = Nothing,+      budgetTokens = Nothing,+      wireField = Just "enable_thinking",+      adjustments = [EffortCollapsedToToggle lvl]+    }  injectCacheControl :: OpenAICompletionsCompat -> Options -> Aeson.Value -> Aeson.Value injectCacheControl compat opts body =

@@ -6,6 +6,8 @@     openaiSseStreamValue,     openaiSseStreamValueWithHeaders,     sseFromResponse,+    ResponseMetadata (..),+    capturedHeaderNames,   ) where @@ -14,25 +16,82 @@ import Data.Aeson qualified as Aeson import Data.ByteString qualified as SBS import Data.ByteString.Char8 qualified as S8+import Data.CaseInsensitive (CI) import Data.CaseInsensitive qualified as CI import Data.IORef qualified as IORef import Data.Text (Text) import Data.Text qualified as Text import Data.Text.Encoding qualified as Text import Data.Text.Encoding.Error qualified as Text+import GHC.Generics (Generic) import Network.HTTP.Client qualified as HTTP import Network.HTTP.Types.Header (RequestHeaders) import Network.HTTP.Types.Status qualified as Status import OpenAI.V1.Chat.Completions qualified as Chat import Servant.Client qualified as Client +-- | Response-level metadata captured once, before the first chunk.+--+-- Header capture is an allow-list: a response header is recorded only+-- if its name appears in 'capturedHeaderNames'. A denylist would leak+-- whatever header a future gateway decides to add, and this transport+-- speaks to an open-ended set of hosts.+--+-- Names are recorded folded to lowercase, so a reader can look one up+-- without case-folding first.+data ResponseMetadata = ResponseMetadata+  { httpStatus :: !Int,+    headers :: ![(Text, Text)]+  }+  deriving stock (Eq, Show, Generic)++-- | The response headers worth recording across the OpenAI-compatible+-- ecosystem. OpenAI itself issues @x-request-id@; other hosts spell+-- their own identifier @request-id@, and the gateways commonly sitting+-- in front of one of them add @x-amzn-requestid@, @x-ms-request-id@, or+-- @cf-ray@. None can carry a credential: they are values the server+-- chose, not values baikai sent.+--+-- The order is a preference order as well as an allow-list, matching+-- the discipline @Baikai.Provider.Claude.Sse@ established. A consumer+-- picking one correlation identifier out of a response takes the first+-- of these that is present, so the host's own identifier wins over a+-- gateway's when both are there.+capturedHeaderNames :: [CI SBS.ByteString]+capturedHeaderNames =+  [ "x-request-id",+    "request-id",+    "x-amzn-requestid",+    "x-ms-request-id",+    "cf-ray"+  ]++-- | Status and allow-listed headers, read straight off the response.+responseMetadata :: HTTP.Response body -> ResponseMetadata+responseMetadata response =+  ResponseMetadata+    { httpStatus = Status.statusCode (HTTP.responseStatus response),+      headers =+        [ (decodeLenient (CI.foldedCase name), decodeLenient value)+        | (name, value) <- HTTP.responseHeaders response,+          name `elem` capturedHeaderNames+        ]+    }+ -- | POST the request to @/v1/chat/completions@ and feed decoded SSE--- JSON payloads to the callback. A @data: [DONE]@ frame ends the+-- JSON payloads to the second callback. A @data: [DONE]@ frame ends the -- stream without producing a callback value.+--+-- The first callback receives the response's 'ResponseMetadata' exactly+-- once, before any chunk. It is a separate callback rather than a+-- widening of the per-chunk one because the per-chunk callback runs once+-- per SSE frame — potentially thousands of times per call — and+-- response-level data does not belong on that hot path. openaiSseStream ::   Client.ClientEnv ->   Text ->   Chat.CreateChatCompletion ->+  (ResponseMetadata -> IO ()) ->   (Either BaikaiError Aeson.Value -> IO ()) ->   IO () openaiSseStream env apiKey req =@@ -42,6 +101,7 @@   Client.ClientEnv ->   Text ->   Aeson.Value ->+  (ResponseMetadata -> IO ()) ->   (Either BaikaiError Aeson.Value -> IO ()) ->   IO () openaiSseStreamValue env apiKey =@@ -56,9 +116,10 @@   Client.ClientEnv ->   RequestHeaders ->   Aeson.Value ->+  (ResponseMetadata -> IO ()) ->   (Either BaikaiError Aeson.Value -> IO ()) ->   IO ()-openaiSseStreamValueWithHeaders env requestHeaders requestBody onEvent = do+openaiSseStreamValueWithHeaders env requestHeaders requestBody onMetadata onEvent = do   let base = Client.baseUrl env       secure = case Client.baseUrlScheme base of         Client.Http -> False@@ -75,14 +136,24 @@             -- EP-8 wires Options.timeoutMs through this local transport.             HTTP.responseTimeout = HTTP.responseTimeoutNone           }-  HTTP.withResponse request (Client.manager env) (`sseFromResponse` onEvent)+  HTTP.withResponse request (Client.manager env) $ \response ->+    sseFromResponse response onMetadata onEvent +-- | Consume an @http-client@ response as an OpenAI-compatible SSE+-- stream.+--+-- 'onMetadata' fires exactly once, before any chunk, on both the success+-- and the non-2xx path. A failed call's correlation identifier is if+-- anything more valuable than a successful one's, since it is precisely+-- what a provider support request needs. sseFromResponse ::   HTTP.Response HTTP.BodyReader ->+  (ResponseMetadata -> IO ()) ->   (Either BaikaiError Aeson.Value -> IO ()) ->   IO ()-sseFromResponse response onEvent = do+sseFromResponse response onMetadata onEvent = do   let st = HTTP.responseStatus response+  onMetadata (responseMetadata response)   if not (Status.statusIsSuccessful st)     then do       bodyChunks <- HTTP.brConsume (HTTP.responseBody response)

@@ -0,0 +1,350 @@+-- | End-to-end model-call evidence for the @codex exec --json@+-- subprocess provider.+--+-- Every case here runs a real child process — a few lines of @sh@+-- written into a temporary directory that print a recorded @codex@+-- event stream and exit. Nothing is stubbed: the argument vector is+-- rendered by 'CodexCli.codexCliCommand', the process is spawned by the+-- real provider, the event stream is folded by the real parser, and the+-- evidence is assembled and emitted through the real trace path. No+-- credential and no coding-agent binary is required.+--+-- Assertions go through the encoded JSON rather than through Haskell+-- record accessors, because the JSON is the contract other systems pin+-- against, and it spells its fields in snake_case where a Haskell+-- mirror would silently paper over a rename.+module CliEvidenceSpec (tests) where++import Baikai+import Baikai.Provider.OpenAI.Cli qualified as CodexCli+import Baikai.Trace (withTraceStreamWith)+import Baikai.Trace.Event (TraceEvent (..))+import Baikai.Trace.Sink (TraceSink (..))+import Control.Concurrent.STM (TVar, atomically, modifyTVar', newTVarIO, readTVarIO)+import Control.Lens ((&), (.~), (^.))+import Data.Aeson (Value (..))+import Data.Aeson qualified as Aeson+import Data.Aeson.Key qualified as Key+import Data.Aeson.KeyMap qualified as KeyMap+import Data.Generics.Labels ()+import Data.Text (Text)+import Data.Text qualified as Text+import Data.Text.IO qualified as TextIO+import Data.Vector qualified as Vector+import GHC.Generics (Generic)+import Streamly.Data.Fold qualified as Fold+import Streamly.Data.Stream qualified as Stream+import System.Directory (getPermissions, setOwnerExecutable, setPermissions)+import System.FilePath ((</>))+import System.IO.Temp (withSystemTempDirectory)+import Test.Tasty (TestTree, testGroup)+import Test.Tasty.HUnit (assertBool, assertFailure, testCase, (@?=))++tests :: TestTree+tests =+  testGroup+    -- Named so a documented @--test-options='--pattern CliEvidence'@+    -- actually selects it. A pattern that matches nothing reports+    -- "All 0 tests passed".+    "CliEvidenceSpec: Codex CLI model-call evidence"+    [ successEvidenceTest,+      silentToolTest,+      everyLevelSurvivesTest,+      partiallyObservedFailureTest,+      optOutTest+    ]++-- ============================================================+-- The cases+-- ============================================================++successEvidenceTest :: TestTree+successEvidenceTest =+  testCase "a recorded run records what the tool reported, and no more" $ do+    outcome <- replay recordedEvents baseOptions+    ev <- oneEvidence (outcome ^. #events)+    field "status" ev @?= Just (String "succeeded")+    field "run_id" ev @?= Just (String "run-55")+    field "requested_model" ev @?= Just (String "gpt-5.6")++    -- The thread identifier the parser used to filter out of the event+    -- stream along with everything that was not an agent_message.+    field "response_id" ev @?= Just (observedJson "019fd471-4a48-7c83-be67-6b7c49646e43")++    -- THE CODEX-SPECIFIC LIMIT. codex-cli 0.146.0 names no model+    -- anywhere in its event stream, so no codex run can reach+    -- model_observed however well it goes. Backfilling the --model+    -- flag baikai passed would report the request as an observation,+    -- and would make this transport look as strong as the API one.+    field "observed_model" ev @?= Just (String "unobserved")+    -- Tied to the declaration mechanically: raising declaredStrength for+    -- this transport without the transport reaching it fails here.+    field "strength" ev @?= Just (Aeson.toJSON (declaredStrength OpenAICompletionsCli))++    field "provider_request_id" ev @?= Just (String "unobserved")+    field "observed_thinking" ev @?= Just (String "unobserved")++    assertDigest "request_commitment" ev+    assertDigest "request_configuration" ev+    assertObservedDigest "response_commitment" ev++    -- Not zeroUsage, and normalized: codex reports OpenAI-style+    -- inclusive prompt counts, so the cached tokens come out of+    -- input_tokens (16071 - 6912).+    case observedObject "usage" ev of+      Nothing -> assertFailure ("expected an observed usage, got: " <> show (field "usage" ev))+      Just u -> do+        KeyMap.lookup "input_tokens" u @?= Just (Number 9159)+        KeyMap.lookup "cache_read_tokens" u @?= Just (Number 6912)+        KeyMap.lookup "output_tokens" u @?= Just (Number 5)+        KeyMap.lookup "reasoning_tokens" u @?= Just (Number 0)++    case field "endpoint" ev of+      Just (Object o) -> do+        KeyMap.lookup "transport" o @?= Just (String "subprocess")+        KeyMap.lookup "endpoint" o @?= Just (String (Text.pack (outcome ^. #executable)))+        KeyMap.lookup "implementation_version" o @?= Just (String "codex-cli 9.9.9")+      other -> assertFailure ("expected an endpoint object, got: " <> show other)++silentToolTest :: TestTree+silentToolTest =+  testCase "A ZERO EXIT WITH NO IDENTIFIER AND NO MODEL STAYS AT requested_only" $ do+    -- IR-3's rule and the reason this plan exists. A coding-agent CLI+    -- that exits zero has demonstrated that it ran and did not crash.+    -- Subprocess calls almost always exit zero, so encoding that as+    -- corroboration would make the weakest evidence in the system look+    -- like the strongest.+    outcome <- replay silentEvents baseOptions+    ev <- oneEvidence (outcome ^. #events)+    field "status" ev @?= Just (String "succeeded")+    field "strength" ev @?= Just (String "requested_only")+    field "response_id" ev @?= Just (String "unobserved")+    field "observed_model" ev @?= Just (String "unobserved")+    field "usage" ev @?= Just (String "unobserved")++everyLevelSurvivesTest :: TestTree+everyLevelSurvivesTest =+  testGroup+    -- Codex is the only transport in baikai that expresses all six+    -- levels exactly, which is worth asserting precisely because every+    -- other transport clamps, collapses, or drops something.+    "every canonical level reaches the command line verbatim"+    [ testCase (Text.unpack (renderThinkingLevel level)) $ do+        outcome <- replay recordedEvents (baseOptions & #thinking .~ Just level)+        let expected = "model_reasoning_effort=" <> renderThinkingLevel level+        assertBool+          ("the argument vector must carry " <> Text.unpack expected <> ": " <> show (outcome ^. #argv))+          (["-c", expected] `isSublistOf` (outcome ^. #argv))+        ev <- oneEvidence (outcome ^. #events)+        case field "thinking" ev of+          Just (Object t) -> do+            KeyMap.lookup "requested" t @?= Just (String (renderThinkingLevel level))+            KeyMap.lookup "mode" t @?= Just (String "flag")+            KeyMap.lookup "effort_text" t @?= Just (String (renderThinkingLevel level))+            KeyMap.lookup "wire_field" t @?= Just (String "model_reasoning_effort")+            KeyMap.lookup "budget_tokens" t @?= Just Null+            -- Nothing happened to the request on the way to the wire.+            KeyMap.lookup "adjustments" t @?= Just (Array Vector.empty)+          other -> assertFailure ("expected a thinking translation, got: " <> show other)+    | level <-+        [ ThinkingMinimal,+          ThinkingLow,+          ThinkingMedium,+          ThinkingHigh,+          ThinkingXHigh,+          ThinkingMax+        ]+    ]++partiallyObservedFailureTest :: TestTree+partiallyObservedFailureTest =+  testCase "a failed run keeps the identifier it saw and commits to no response" $ do+    -- The event stream is drained before the exit status is known, so a+    -- run that named its thread and then failed really did name it.+    -- Discarding that would throw away the single most useful thing to+    -- have when opening a vendor support request.+    outcome <- replay failingEvents baseOptions+    ev <- oneEvidence (outcome ^. #events)+    field "status" ev @?= Just (String "failed")+    field "response_id" ev @?= Just (observedJson "019fd471-dead-7c83-be67-6b7c49646e43")+    field "strength" ev @?= Just (String "correlated")+    -- No complete response exists, so there is nothing to commit to. A+    -- digest of an empty envelope would be a real-looking value+    -- standing for a response that never arrived.+    field "response_commitment" ev @?= Just (String "unobserved")+    field "usage" ev @?= Just (String "unobserved")++optOutTest :: TestTree+optOutTest =+  testCase "a call that asked for no evidence emits none" $ do+    outcome <- replay recordedEvents emptyOptions+    [e | e@CallEvidence {} <- outcome ^. #events] @?= []+    length [e | e@CallStarted {} <- outcome ^. #events] @?= 1+    length [e | e@CallFinished {} <- outcome ^. #events] @?= 1++-- ============================================================+-- Replay harness+-- ============================================================++-- | What one replayed call produced.+data Replay = Replay+  { events :: ![TraceEvent],+    -- | The argument vector the fake executable actually received.+    argv :: ![Text],+    -- | The path the fake executable was written to.+    executable :: !FilePath+  }+  deriving stock (Generic)++-- | Run one call against a fake @codex@ that prints the given+-- newline-delimited event stream on standard output.+replay :: ([Text], Int) -> Options -> IO Replay+replay recording opts =+  withSystemTempDirectory "baikai-openai-cli-evidence" $ \dir -> do+    let argvPath = dir </> "argv"+    exe <- writeFakeExecutable dir "codex" (fakeCodex argvPath recording)+    reg <- newProviderRegistry+    registerApiProviderWith+      reg+      ( CodexCli.codexCliProvider+          CodexCli.defaultCodexCliConfig {CodexCli.executable = exe}+      )+    (ref, sink) <- memorySink+    _ <- Stream.fold Fold.drain (withTraceStreamWith reg sink testModel testContext opts)+    recorded <- reverse <$> readTVarIO ref+    received <- Text.lines <$> TextIO.readFile argvPath+    pure Replay {events = recorded, argv = received, executable = exe}++-- | A fake @codex@ in a few lines of @sh@: the recorded event lines and+-- the exit status to leave with.+--+-- It answers @--version@ before recording anything, exactly as the real+-- tool does. That is not decoration: the evidence path probes the+-- executable's version with a second invocation, and a fake that+-- recorded that invocation's argument vector would overwrite the one+-- the test is about to assert on.+fakeCodex :: FilePath -> ([Text], Int) -> String+fakeCodex argvPath (eventLines, status) =+  unlines+    ( [ "#!/bin/sh",+        "if [ \"$1\" = \"--version\" ]; then echo 'codex-cli 9.9.9'; exit 0; fi",+        "printf '%s\\n' \"$@\" > '" <> argvPath <> "'",+        "cat <<'BAIKAI_FIXTURE'"+      ]+        <> map Text.unpack eventLines+        <> [ "BAIKAI_FIXTURE",+             "exit " <> show status+           ]+    )++writeFakeExecutable :: FilePath -> String -> String -> IO FilePath+writeFakeExecutable dir name body = do+  let path = dir </> name+  writeFile path body+  perms <- getPermissions path+  setPermissions path (setOwnerExecutable True perms)+  pure path++memorySink :: IO (TVar [TraceEvent], TraceSink)+memorySink = do+  ref <- newTVarIO []+  let step () e = atomically (modifyTVar' ref (e :))+  pure (ref, TraceSink (Fold.foldlM' step (pure ())))++-- ============================================================+-- Fixtures+-- ============================================================++testModel :: Model+testModel =+  emptyModel+    & #modelId .~ "gpt-5.6"+    & #api .~ OpenAICompletionsCli+    & #provider .~ "openai"++testContext :: Context+testContext = emptyContext & #messages .~ Vector.singleton (user "PROMPT-BODY-MARKER")++baseOptions :: Options+baseOptions = emptyOptions & #evidence .~ Just (evidenceRequest "run-55")++-- | The event stream @codex-cli 0.146.0@ emits, with the thread+-- identifier kept exactly as recorded.+recordedEvents :: ([Text], Int)+recordedEvents =+  ( [ "{\"type\":\"thread.started\",\"thread_id\":\"019fd471-4a48-7c83-be67-6b7c49646e43\"}",+      "{\"type\":\"turn.started\"}",+      "{\"type\":\"item.completed\",\"item\":{\"id\":\"item_0\",\"type\":\"agent_message\",\"text\":\"ok\"}}",+      "{\"type\":\"turn.completed\",\"usage\":{\"input_tokens\":16071,\"cached_input_tokens\":6912,\+      \\"cache_write_input_tokens\":0,\"output_tokens\":5,\"reasoning_output_tokens\":0}}"+    ],+    0+  )++-- | A run that succeeded and said nothing about itself.+silentEvents :: ([Text], Int)+silentEvents =+  ( ["{\"type\":\"item.completed\",\"item\":{\"type\":\"agent_message\",\"text\":\"ok\"}}"],+    0+  )++-- | A run that named its thread and then failed.+failingEvents :: ([Text], Int)+failingEvents =+  ( ["{\"type\":\"thread.started\",\"thread_id\":\"019fd471-dead-7c83-be67-6b7c49646e43\"}"],+    4+  )++-- ============================================================+-- Assertions on the encoded record+-- ============================================================++oneEvidence :: [TraceEvent] -> IO ModelCallEvidence+oneEvidence recorded = case [ev | CallEvidence {evidence = ev} <- recorded] of+  [ev] -> pure ev+  other ->+    assertFailure+      ("expected exactly one CallEvidence, got " <> show (length other) <> ": " <> show recorded)++field :: Text -> ModelCallEvidence -> Maybe Value+field k ev = case Aeson.toJSON ev of+  Object o -> KeyMap.lookup (Key.fromText k) o+  _ -> Nothing++-- | How 'Baikai.Evidence.Observed' encodes a present value.+observedJson :: Text -> Value+observedJson v = Object (KeyMap.singleton "observed" (String v))++observedObject :: Text -> ModelCallEvidence -> Maybe (KeyMap.KeyMap Value)+observedObject k ev = case field k ev of+  Just (Object o) -> case KeyMap.lookup "observed" o of+    Just (Object inner) -> Just inner+    _ -> Nothing+  _ -> Nothing++assertDigest :: Text -> ModelCallEvidence -> IO ()+assertDigest k ev = case field k ev of+  Just (String d) -> assertSha256 k d+  other -> assertFailure (Text.unpack k <> " missing or not a string: " <> show other)++assertObservedDigest :: Text -> ModelCallEvidence -> IO ()+assertObservedDigest k ev = case field k ev of+  Just (Object o) -> case KeyMap.lookup "observed" o of+    Just (String d) -> assertSha256 k d+    other -> assertFailure (Text.unpack k <> " not a digest: " <> show other)+  other -> assertFailure ("expected an observed " <> Text.unpack k <> ", got: " <> show other)++assertSha256 :: Text -> Text -> IO ()+assertSha256 k d =+  assertBool+    (Text.unpack k <> " must be a sha256 digest, got: " <> show d)+    ("sha256:" `Text.isPrefixOf` d && Text.length d == 71)++isSublistOf :: (Eq a) => [a] -> [a] -> Bool+isSublistOf needle haystack =+  any (\suffix -> needle == take (length needle) suffix) (suffixes haystack)+  where+    suffixes xs =+      xs : case xs of+        [] -> []+        (_ : rest) -> suffixes rest

@@ -0,0 +1,372 @@+-- | End-to-end model-call evidence for the OpenAI-compatible Chat+-- Completions provider.+--+-- Every case here replays a recorded HTTP response through the real+-- adapter and reads the evidence back out of a trace sink. Nothing is+-- stubbed but the socket: the request is built by @mapRequest@ and+-- shaped by @streamRequestBody@, the response is decoded by+-- @sseFromResponse@, the headers are captured by the real allow-list,+-- and the record is assembled and emitted by the real trace path.+--+-- Assertions go through the encoded JSON rather than through Haskell+-- record accessors, because the JSON is the contract other systems pin+-- against, and it spells its fields in snake_case where a Haskell+-- mirror would silently paper over a rename.+module EvidenceSpec (tests) where++import Baikai+import Baikai.Models.Generated (openai_gpt_4o_mini)+import Baikai.Provider.OpenAI.Api (SseDriver, openaiChatStreamWith)+import Baikai.Provider.OpenAI.Shape (describeThinkingShape)+import Baikai.Provider.OpenAI.Sse (sseFromResponse)+import Baikai.Trace (withTraceStreamWith)+import Baikai.Trace.Event (TraceEvent (..))+import Baikai.Trace.Sink (TraceSink (..))+import Control.Concurrent.STM (TVar, atomically, modifyTVar', newTVarIO, readTVarIO)+import Control.Lens ((&), (.~), (^.))+import Data.Aeson (Value (..))+import Data.Aeson qualified as Aeson+import Data.Aeson.Key qualified as Key+import Data.Aeson.KeyMap qualified as KeyMap+import Data.ByteString (ByteString)+import Data.CaseInsensitive qualified as CI+import Data.Generics.Labels ()+import Data.IORef (IORef, newIORef, readIORef, writeIORef)+import Data.Text (Text)+import Data.Text qualified as Text+import Data.Vector qualified as Vector+import Network.HTTP.Client.Internal qualified as HTTP+import Network.HTTP.Types.Status (mkStatus)+import Network.HTTP.Types.Version (http11)+import Streamly.Data.Fold qualified as Fold+import Streamly.Data.Stream qualified as Stream+import Test.Tasty (TestTree, testGroup)+import Test.Tasty.HUnit (assertBool, assertFailure, testCase, (@?=))++tests :: TestTree+tests =+  testGroup+    -- Named so this plan's documented+    -- @--test-options='--pattern Evidence'@ actually selects it. A+    -- pattern that matches nothing reports "All 0 tests passed".+    "EvidenceSpec: OpenAI-compatible model-call evidence"+    [ successEvidenceTest,+      rateLimitEvidenceTest,+      toggleHostIndistinguishabilityTest,+      optOutTest+    ]++-- ============================================================+-- The cases+-- ============================================================++successEvidenceTest :: TestTree+successEvidenceTest =+  testCase "a replayed successful call records what the host reported" $ do+    ev <- oneEvidence =<< replayEvents 200 successHeaders successBody baseOptions+    field "status" ev @?= Just (String "succeeded")+    field "error_info" ev @?= Just Null+    field "run_id" ev @?= Just (String "run-54")++    -- The heart of it: requested and observed are different values, and+    -- the observed one came from the host's own chunks.+    field "requested_model" ev @?= Just (String (openai_gpt_4o_mini ^. #modelId))+    field "observed_model" ev @?= Just (observedJson "gpt-4o-mini-20990101-server-side")+    assertBool+      "observed_model must not be the configured model"+      (field "observed_model" ev /= Just (observedJson (openai_gpt_4o_mini ^. #modelId)))++    field "provider_request_id" ev @?= Just (observedJson "req_success_1")+    field "response_id" ev @?= Just (observedJson "chatcmpl-observed")+    -- Tied to the declaration mechanically: raising declaredStrength+    -- for this transport without the transport reaching it fails here.+    field "strength" ev @?= Just (Aeson.toJSON (declaredStrength OpenAIChatCompletions))++    -- No OpenAI-compatible host echoes the reasoning configuration it+    -- applied, so this transport cannot reach fully_observed and must+    -- not pretend a reasoning-token count is such an echo.+    field "observed_thinking" ev @?= Just (String "unobserved")++    assertDigest "request_commitment" ev+    assertDigest "request_configuration" ev+    case field "response_commitment" ev of+      Just (Object o) -> case KeyMap.lookup "observed" o of+        Just (String d) -> assertSha256 "response_commitment" d+        other -> assertFailure ("response_commitment not a digest: " <> show other)+      other -> assertFailure ("expected an observed response_commitment, got: " <> show other)++    -- Usage is Observed because the host reported it, and carries the+    -- fixture's counts rather than the assembler's initial zeroes.+    case field "usage" ev of+      Just (Object o) -> case KeyMap.lookup "observed" o of+        Just (Object u) -> do+          KeyMap.lookup "input_tokens" u @?= Just (Number 11)+          KeyMap.lookup "output_tokens" u @?= Just (Number 5)+        other -> assertFailure ("usage.observed not an object: " <> show other)+      other -> assertFailure ("expected an observed usage, got: " <> show other)++    -- The endpoint names this package's own version, read from the+    -- cabal-generated module, and carries no query string.+    case field "endpoint" ev of+      Just (Object o) -> do+        KeyMap.lookup "transport" o @?= Just (String "http_api")+        KeyMap.lookup "endpoint" o @?= Just (String "https://api.openai.com")+        case KeyMap.lookup "implementation_version" o of+          Just (String v) ->+            assertBool "implementation_version must not be empty" (not (Text.null v))+          other -> assertFailure ("expected an implementation_version, got: " <> show other)+      other -> assertFailure ("expected an endpoint object, got: " <> show other)++rateLimitEvidenceTest :: TestTree+rateLimitEvidenceTest =+  testCase "a replayed 429 records the correlation id and observes nothing else" $ do+    ev <-+      oneEvidence+        =<< replayEvents+          429+          [("x-request-id", "req_rate_limited"), ("Retry-After", "7")]+          ["{\"error\":{\"message\":\"slow down\",\"type\":\"tokens\"}}"]+          baseOptions+    field "status" ev @?= Just (String "failed")+    case field "error_info" ev of+      Just (Object o) ->+        assertBool+          ("expected the rate-limit message, got: " <> show o)+          (KeyMap.member "message" o)+      other -> assertFailure ("expected a populated error_info, got: " <> show other)++    -- The header is present on errors too, and it is the single most+    -- useful thing to have when opening a provider support request.+    field "provider_request_id" ev @?= Just (observedJson "req_rate_limited")++    -- Absent metadata stays absent. None of these is backfilled.+    field "observed_model" ev @?= Just (String "unobserved")+    field "response_id" ev @?= Just (String "unobserved")+    field "response_commitment" ev @?= Just (String "unobserved")+    field "usage" ev @?= Just (String "unobserved")+    field "strength" ev @?= Just (String "correlated")++-- | Two calls a toggle host cannot tell apart, which baikai's record+-- can.+--+-- Z.ai and Qwen accept @enable_thinking: true@ and carry no depth, so a+-- caller asking for @max@ and a caller asking for @low@ put the same+-- bytes on the wire. Without the translation there is nothing anywhere+-- in baikai's output that distinguishes the two; with it, the request+-- each caller made is recorded beside the request that was actually+-- sent.+toggleHostIndistinguishabilityTest :: TestTree+toggleHostIndistinguishabilityTest =+  testCase "a toggle host receives identical bytes for max and for low" $ do+    (lowBody, lowEv) <- toggleCall ThinkingLow+    (maxBody, maxEv) <- toggleCall ThinkingMax++    Aeson.encode lowBody @?= Aeson.encode maxBody+    lookupIn "enable_thinking" lowBody @?= Just (Bool True)+    lookupIn "reasoning_effort" lowBody @?= Nothing++    thinkingOf lowEv "requested" @?= Just (String "low")+    thinkingOf maxEv "requested" @?= Just (String "max")+    thinkingOf lowEv "mode" @?= Just (String "toggle")+    thinkingOf lowEv "wire_field" @?= Just (String "enable_thinking")+    thinkingOf lowEv "effort_text" @?= Just Null++    collapsedLevels lowEv @?= ["low"]+    collapsedLevels maxEv @?= ["max"]+  where+    toggleCall lvl = do+      bodyRef <- newIORef Null+      events <-+        replayWith+          bodyRef+          toggleModel+          200+          successHeaders+          successBody+          (baseOptions & #thinking .~ Just lvl)+      ev <- oneEvidence events+      body <- readIORef bodyRef+      pure (body, ev)++    -- Every adjustment must be the collapse, and this returns the level+    -- each one names — so a run that recorded some other adjustment+    -- fails rather than quietly matching an empty list.+    collapsedLevels ev = case thinkingOf ev "adjustments" of+      Just (Array adjs) ->+        [ lvl+        | Object a <- Vector.toList adjs,+          KeyMap.lookup "kind" a == Just (String "effort_collapsed_to_toggle"),+          Just (String lvl) <- [KeyMap.lookup "requested" a]+        ]+      _ -> []++optOutTest :: TestTree+optOutTest =+  testCase "a call that asked for no evidence emits none" $ do+    events <- replayEvents 200 successHeaders successBody emptyCallOptions+    [e | e@CallEvidence {} <- events] @?= []+    -- The call itself still succeeded and still traced normally.+    length [e | e@CallStarted {} <- events] @?= 1+    length [e | e@CallFinished {} <- events] @?= 1++-- ============================================================+-- Replay harness+-- ============================================================++-- | Run one recorded response through the real adapter and the real+-- trace path, and return every trace event it produced.+replayEvents :: Int -> [(ByteString, ByteString)] -> [ByteString] -> Options -> IO [TraceEvent]+replayEvents status headers chunks opts = do+  sink <- newIORef Null+  replayWith sink testModel status headers chunks opts++-- | 'replayEvents' against an explicit model, recording the request body+-- the adapter handed to the transport.+replayWith ::+  IORef Value ->+  Model ->+  Int ->+  [(ByteString, ByteString)] ->+  [ByteString] ->+  Options ->+  IO [TraceEvent]+replayWith bodyRef model status headers chunks opts = do+  reg <- newProviderRegistry+  let driver = replayDriver bodyRef status headers chunks+      provider =+        ApiProvider+          { apiTag = OpenAIChatCompletions,+            stream = openaiChatStreamWith driver,+            complete = streamingComplete (openaiChatStreamWith driver),+            describeThinking = \m opts' ->+              describeThinkingShape (openaiCompletionsCompatFor m) opts'+          }+  registerApiProviderWith reg provider+  (ref, sink) <- memorySink+  _ <-+    Stream.fold+      Fold.drain+      (withTraceStreamWith reg sink model emptyContext opts)+  reverse <$> readTVarIO ref++-- | A transport driver that serves a recorded response instead of+-- opening a socket, and records the request body it was given.+--+-- It goes through 'sseFromResponse', so the status classification,+-- header allow-list, and SSE frame decoding under test are the ones+-- production uses. Only 'HTTP.withResponse' is replaced.+replayDriver ::+  IORef Value -> Int -> [(ByteString, ByteString)] -> [ByteString] -> SseDriver+replayDriver bodyRef status headers chunks _env _headers body onMetadata onEvent = do+  writeIORef bodyRef body+  resp <- mkResponse status headers chunks+  sseFromResponse resp onMetadata onEvent++mkResponse ::+  Int -> [(ByteString, ByteString)] -> [ByteString] -> IO (HTTP.Response HTTP.BodyReader)+mkResponse status headers chunks = do+  ref <- newIORef chunks+  let bodyReader = do+        remaining <- readIORef ref+        case remaining of+          [] -> pure ""+          (x : xs) -> writeIORef ref xs >> pure x+  pure+    HTTP.Response+      { HTTP.responseStatus = mkStatus status "",+        HTTP.responseVersion = http11,+        HTTP.responseHeaders = [(CI.mk k, v) | (k, v) <- headers],+        HTTP.responseBody = bodyReader,+        HTTP.responseCookieJar = HTTP.createCookieJar [],+        HTTP.responseClose' = HTTP.ResponseClose (pure ()),+        HTTP.responseOriginalRequest = HTTP.defaultRequest,+        HTTP.responseEarlyHints = []+      }++memorySink :: IO (TVar [TraceEvent], TraceSink)+memorySink = do+  ref <- newTVarIO []+  let step () e = atomically (modifyTVar' ref (e :))+  pure (ref, TraceSink (Fold.foldlM' step (pure ())))++-- ============================================================+-- Fixtures+-- ============================================================++testModel :: Model+testModel =+  openai_gpt_4o_mini+    & #api .~ OpenAIChatCompletions+    & #baseUrl .~ "https://api.openai.com"++-- | The same model pinned to a host that accepts a bare thinking+-- toggle, which is the shape the indistinguishability case is about.+toggleModel :: Model+toggleModel =+  testModel+    & #compat+      .~ CompatOpenAICompletions+        defaultOpenAICompletionsCompat {thinkingFormat = ThinkingFormatZai}++-- | A literal key, so 'prepareCall' resolves one without reading the+-- environment. It never reaches the replayed response.+emptyCallOptions :: Options+emptyCallOptions = emptyOptions & #apiKey .~ Just (ApiKeyLiteral "test-key")++baseOptions :: Options+baseOptions = emptyCallOptions & #evidence .~ Just (evidenceRequest "run-54")++successHeaders :: [(ByteString, ByteString)]+successHeaders = [("x-request-id", "req_success_1")]++-- | A complete successful stream whose reported model is deliberately+-- not any model in the catalog, so it cannot be confused with a+-- configured one.+successBody :: [ByteString]+successBody =+  [ "data: {\"id\":\"chatcmpl-observed\",\"object\":\"chat.completion.chunk\",",+    "\"model\":\"gpt-4o-mini-20990101-server-side\",",+    "\"choices\":[{\"index\":0,\"delta\":{\"content\":\"pong\"}}]}\n\n",+    "data: {\"id\":\"chatcmpl-observed\",\"model\":\"gpt-4o-mini-20990101-server-side\",",+    "\"choices\":[{\"index\":0,\"delta\":{},\"finish_reason\":\"stop\"}]}\n\n",+    "data: {\"id\":\"chatcmpl-observed\",\"model\":\"gpt-4o-mini-20990101-server-side\",",+    "\"choices\":[],\"usage\":{\"prompt_tokens\":11,\"completion_tokens\":5}}\n\n",+    "data: [DONE]\n\n"+  ]++-- ============================================================+-- Assertions on the encoded record+-- ============================================================++oneEvidence :: [TraceEvent] -> IO ModelCallEvidence+oneEvidence events = case [ev | CallEvidence {evidence = ev} <- events] of+  [ev] -> pure ev+  other ->+    assertFailure+      ("expected exactly one CallEvidence, got " <> show (length other) <> ": " <> show events)++field :: Text -> ModelCallEvidence -> Maybe Value+field k ev = lookupIn k (Aeson.toJSON ev)++lookupIn :: Text -> Value -> Maybe Value+lookupIn k = \case+  Object o -> KeyMap.lookup (Key.fromText k) o+  _ -> Nothing++thinkingOf :: ModelCallEvidence -> Text -> Maybe Value+thinkingOf ev k = field "thinking" ev >>= lookupIn k++-- | How 'Baikai.Evidence.Observed' encodes a present value.+observedJson :: Text -> Value+observedJson v = Object (KeyMap.singleton "observed" (String v))++assertDigest :: Text -> ModelCallEvidence -> IO ()+assertDigest k ev = case field k ev of+  Just (String d) -> assertSha256 k d+  other -> assertFailure (Text.unpack k <> " missing or not a string: " <> show other)++assertSha256 :: Text -> Text -> IO ()+assertSha256 k d =+  assertBool+    (Text.unpack k <> " must be a sha256 digest, got: " <> show d)+    ("sha256:" `Text.isPrefixOf` d && Text.length d == 71)

@@ -1,8 +1,20 @@ module Main (main) where  import Baikai+import Baikai.Agent+  ( AgentCapability (..),+    AgentCommand,+    AgentPromptTransport (..),+    AgentProvider (..),+    AgentRenderError (..),+    AgentRunRequest,+    agentRunRequest,+    agentSafety,+    renderAgentRenderError,+  ) import Baikai.Cost qualified as Cost import Baikai.Cost.Pricing (computeCost)+import Baikai.Provider.OpenAI.Agent qualified as CodexAgent import Baikai.Provider.OpenAI.Api   ( RawChunk (..),     closeOpenStream,@@ -15,6 +27,8 @@ import Baikai.Provider.OpenAI.Cli qualified as CodexCli import Baikai.Provider.OpenAI.Interactive import Baikai.Provider.OpenAI.Internal.Request (mapRequest)+import Baikai.Provider.OpenAI.Shape (describeThinkingShape)+import CliEvidenceSpec qualified import Control.Exception (bracket) import Control.Lens ((&), (.~), (^.)) import Data.Aeson qualified as Aeson@@ -24,6 +38,7 @@ import Data.Text qualified as Text import Data.Vector qualified as Vector import ErrorClassSpec qualified+import EvidenceSpec qualified import OpenAI.V1.Chat.Completions qualified as Chat import OpenAI.V1.ResponseFormat qualified as RF import ReasoningSpec qualified@@ -45,6 +60,18 @@       "Baikai.Provider.OpenAI"       [ commandRenderingTest,         effortRenderingTests,+        safetyRefusalTest,+        safetyStillRendersTest,+        agentCommandRenderingTest,+        agentCapabilityRenderingTests,+        agentEffortRenderingTests,+        agentThinkingTranslationTests,+        strictEvidenceTests,+        agentToolRestrictionRefusalTest,+        agentPromptTransportTest,+        agentBlankModelTest,+        agentConfigBooleanTest,+        agentProviderGuardTest,         batchCommandRenderingTest,         batchEffortRenderingTest,         batchSystemPromptTest,@@ -58,7 +85,9 @@         finishReasonTests,         responseFormatMappingTest,         optionsMappingTest,+        CliEvidenceSpec.tests,         ErrorClassSpec.tests,+        EvidenceSpec.tests,         ReasoningSpec.tests,         ShapeSpec.tests,         SseSpec.tests,@@ -215,6 +244,344 @@           cacheWriteCost = 5 / 4         } +-- | Render an unattended command or fail the test with the refusal's+-- own message.+renderedAgentCommand ::+  CodexAgent.CodexAgentConfig -> AgentRunRequest -> IO AgentCommand+renderedAgentCommand cfg req = fst <$> renderedAgentPair cfg req++-- | The command and the reasoning-effort translation the renderer+-- produced together.+renderedAgentPair ::+  CodexAgent.CodexAgentConfig ->+  AgentRunRequest ->+  IO (AgentCommand, ThinkingTranslation)+renderedAgentPair cfg req =+  either+    (assertFailure . Text.unpack . renderAgentRenderError)+    pure+    (CodexAgent.codexAgentCommand cfg req)++agentCommandRenderingTest :: TestTree+agentCommandRenderingTest =+  testCase "unattended codex argv renders every structured flag in a fixed order" $ do+    let cfg =+          CodexAgent.defaultCodexAgentConfig+            & #executable .~ "/bin/codex"+            & #extraArgs .~ ["--color", "never"]+        req =+          agentRunRequest AgentCodex "/work/project" "reconcile the grammar"+            & #modelId .~ Just "gpt-5.6-terra"+            & #effort .~ Just ThinkingMedium+            & #extraDirs .~ ["/work/shared"]+            & #safety .~ agentSafety AgentEditWorkspace+    cmd <- renderedAgentCommand cfg req+    cmd ^. #executable @?= "/bin/codex"+    cmd ^. #arguments+      @?= [ "exec",+            "--model",+            "gpt-5.6-terra",+            "-c",+            "model_reasoning_effort=medium",+            "--sandbox",+            "workspace-write",+            "--cd",+            "/work/project",+            "--add-dir",+            "/work/shared",+            "--skip-git-repo-check",+            "--ephemeral",+            "--color",+            "never"+          ]+    cmd ^. #promptTransport @?= PromptOnStdin+    cmd ^. #promptText @?= "reconcile the grammar"++agentCapabilityRenderingTests :: TestTree+agentCapabilityRenderingTests =+  testGroup+    "unattended codex argv maps every capability onto a sandbox mode"+    [ testCase name $ do+        let req =+              agentRunRequest AgentCodex "/work/project" "prompt"+                & #safety .~ agentSafety cap+        cmd <- renderedAgentCommand CodexAgent.defaultCodexAgentConfig req+        cmd ^. #arguments+          @?= [ "exec",+                "--sandbox",+                expected,+                "--cd",+                "/work/project",+                "--skip-git-repo-check",+                "--ephemeral"+              ]+    | (name, cap, expected) <-+        [ ("read-only", AgentReadOnly, "read-only"),+          ("edit-workspace as workspace-write", AgentEditWorkspace, "workspace-write"),+          ("full-access as danger-full-access", AgentFullAccess, "danger-full-access")+        ]+    ]++-- | Codex accepts all six canonical levels through its config+-- override, so nothing is clamped here — unlike Claude, whose+-- @--effort@ has no @minimal@ value. Pinning both sides stops someone+-- later \"unifying\" them.+agentEffortRenderingTests :: TestTree+agentEffortRenderingTests =+  testGroup+    "unattended codex argv passes every reasoning level through unclamped"+    [ testCase name $ do+        let req =+              agentRunRequest AgentCodex "/work/project" "prompt"+                & #effort .~ Just level+        cmd <- renderedAgentCommand CodexAgent.defaultCodexAgentConfig req+        cmd ^. #arguments+          @?= [ "exec",+                "-c",+                "model_reasoning_effort=" <> expected,+                "--sandbox",+                "read-only",+                "--cd",+                "/work/project",+                "--skip-git-repo-check",+                "--ephemeral"+              ]+    | (name, level, expected) <-+        [ ("minimal", ThinkingMinimal, "minimal"),+          ("low", ThinkingLow, "low"),+          ("medium", ThinkingMedium, "medium"),+          ("high", ThinkingHigh, "high"),+          ("xhigh", ThinkingXHigh, "xhigh"),+          ("max", ThinkingMax, "max")+        ]+    ]++-- | @codex exec@ has no tool allow-list flag, so a narrowed tool set is+-- refused rather than run with every tool available. The message must+-- name the alternative.+agentToolRestrictionRefusalTest :: TestTree+agentToolRestrictionRefusalTest =+  testCase "the codex renderer refuses a tool allow-list it cannot express" $ do+    let req =+          agentRunRequest AgentCodex "/work/project" "prompt"+            & #safety .~ (agentSafety AgentEditWorkspace & #allowedTools .~ ["Read", "Edit"])+    case CodexAgent.codexAgentCommand CodexAgent.defaultCodexAgentConfig req of+      Right (cmd, _) ->+        assertFailure ("expected a refusal, rendered: " <> show (cmd ^. #arguments))+      Left (UnsupportedToolRestriction provider message) -> do+        provider @?= AgentCodex+        assertBool+          ("expected the sandbox alternative in: " <> Text.unpack message)+          ("sandbox" `Text.isInfixOf` message)+      Left other ->+        assertFailure ("unexpected refusal: " <> Text.unpack (renderAgentRenderError other))++-- | The prompt travels on standard input, so a prompt that begins with+-- a dash cannot be parsed as a flag, and Codex's documented+-- @\<stdin\>@-block behavior — which appends piped input when a+-- positional prompt is also given — can never be triggered.+agentPromptTransportTest :: TestTree+agentPromptTransportTest =+  testCase "unattended codex argv never contains the prompt, even a dash-leading one" $ do+    let dashPrompt = "-rm -rf /"+        req =+          agentRunRequest AgentCodex "-/work/dashdir" dashPrompt+            & #extraDirs .~ ["-/work/dashshared"]+    cmd <- renderedAgentCommand CodexAgent.defaultCodexAgentConfig req+    assertBool+      ("prompt leaked into argv: " <> show (cmd ^. #arguments))+      (Text.unpack dashPrompt `notElem` cmd ^. #arguments)+    cmd ^. #promptText @?= dashPrompt+    cmd ^. #promptTransport @?= PromptOnStdin+    cmd ^. #arguments+      @?= [ "exec",+            "--sandbox",+            "read-only",+            "--cd",+            "-/work/dashdir",+            "--add-dir",+            "-/work/dashshared",+            "--skip-git-repo-check",+            "--ephemeral"+          ]++agentBlankModelTest :: TestTree+agentBlankModelTest =+  testCase "unattended codex argv omits --model for a blank model value" $ do+    let req =+          agentRunRequest AgentCodex "/work/project" "prompt"+            & #modelId .~ Just "   "+    cmd <- renderedAgentCommand CodexAgent.defaultCodexAgentConfig req+    cmd ^. #arguments+      @?= [ "exec",+            "--sandbox",+            "read-only",+            "--cd",+            "/work/project",+            "--skip-git-repo-check",+            "--ephemeral"+          ]++agentConfigBooleanTest :: TestTree+agentConfigBooleanTest =+  testCase "unattended codex argv omits the git-check and ephemeral flags when disabled" $ do+    let cfg =+          CodexAgent.defaultCodexAgentConfig+            & #skipGitRepoCheck .~ False+            & #ephemeral .~ False+        req = agentRunRequest AgentCodex "/work/project" "prompt"+    cmd <- renderedAgentCommand cfg req+    cmd ^. #arguments+      @?= ["exec", "--sandbox", "read-only", "--cd", "/work/project"]++-- | The unattended renderer describes what it did with the caller's+-- reasoning-effort request, and the description agrees with the argument+-- vector it produced.+--+-- Every level records an empty adjustment list, because codex is the one+-- tool baikai drives that accepts all six verbatim. That is worth+-- asserting precisely because every other transport clamps, collapses,+-- or drops something.+agentThinkingTranslationTests :: TestTree+agentThinkingTranslationTests =+  testGroup+    "the unattended codex renderer records what model_reasoning_effort received"+    ( testCase+        "no effort requested is not a downgrade"+        ( do+            (cmd, translation) <- renderedAgentPair CodexAgent.defaultCodexAgentConfig (effortRequest Nothing)+            assertBool+              ("no effort override is rendered: " <> show (cmd ^. #arguments))+              (not (any (Text.isInfixOf "model_reasoning_effort" . Text.pack) (cmd ^. #arguments)))+            translation @?= noThinkingRequested+        )+        : [ testCase (Text.unpack (renderThinkingLevel level)) $ do+              (cmd, translation) <-+                renderedAgentPair CodexAgent.defaultCodexAgentConfig (effortRequest (Just level))+              let override = "model_reasoning_effort=" <> Text.unpack (renderThinkingLevel level)+              assertBool+                ("-c " <> override <> " in " <> show (cmd ^. #arguments))+                (["-c", override] `isConsecutiveIn` (cmd ^. #arguments))+              translation+                @?= ThinkingTranslation+                  { requested = Just level,+                    mode = ThinkingModeFlag,+                    effortText = Just (renderThinkingLevel level),+                    budgetTokens = Nothing,+                    wireField = Just "model_reasoning_effort",+                    adjustments = []+                  }+          | level <-+              [ ThinkingMinimal,+                ThinkingLow,+                ThinkingMedium,+                ThinkingHigh,+                ThinkingXHigh,+                ThinkingMax+              ]+          ]+    )+  where+    effortRequest level =+      agentRunRequest AgentCodex "/work/project" "prompt" & #effort .~ level++-- | Whether the needle appears as consecutive elements of the haystack.+isConsecutiveIn :: (Eq a) => [a] -> [a] -> Bool+isConsecutiveIn needle haystack =+  any (\suffix -> needle == take (length needle) suffix) (suffixes haystack)+  where+    suffixes xs =+      xs : case xs of+        [] -> []+        (_ : rest) -> suffixes rest++-- | The pre-dispatch strictness gate, fed by this package's __real__+-- shaping function rather than by hand-built adjustments.+--+-- The generic gate is exhaustively covered in+-- @baikai/test/StrictEvidenceSpec.hs@; what only this package can prove+-- is that its own seven wire shapes actually reach the gate — and,+-- just as importantly, which of them do not.+strictEvidenceTests :: TestTree+strictEvidenceTests =+  testGroup+    "strict evidence refuses this provider's real downgrades"+    [ testCase "a non-native host clamping max to high is refused" $+        expectDowngrade+          (EffortClamped ThinkingMax "high")+          (shapeFor "https://api.deepseek.com" ThinkingMax),+      testCase "a toggle-only host is refused at every level, including max" $+        -- Z.ai accepts a bare enable_thinking with no depth, so a caller+        -- asking for max and a caller asking for low send byte-identical+        -- requests. Only the evidence can tell them apart, which is+        -- exactly what a strict caller is refusing to accept.+        expectDowngrade+          (EffortCollapsedToToggle ThinkingMax)+          (shapeFor "https://api.z.ai/api/paas/v4" ThinkingMax),+      testCase "a host with no reasoning controls is refused" $+        -- No host in the auto-detect table selects ThinkingFormatNone,+        -- so this shape is reachable only through an explicitly+        -- configured compat record. That is exactly the caller who most+        -- needs the refusal: they told baikai the host has no reasoning+        -- controls, and baikai would otherwise drop their level in+        -- silence.+        expectDowngrade+          (ThinkingDroppedUnsupportedHost ThinkingMax)+          ( describeThinkingShape+              (defaultOpenAICompletionsCompat {thinkingFormat = ThinkingFormatNone})+              (emptyOptions & #thinking .~ Just ThinkingMax)+          ),+      testCase "THE NATIVE OPENAI SHAPE IS NOT A DOWNGRADE AND MUST NOT BE REFUSED" $ do+        -- The one OpenAI-compatible configuration that honours every+        -- level in full. It looks like a seventh downgrade site beside+        -- the six real ones, and refusing it would reject the caller+        -- baikai serves best. See plan 54's Decision Log.+        checkEvidenceRequirements+          (EvidenceRequired EvidenceModelObserved)+          OpenAIChatCompletions+          (shapeFor "https://api.openai.com/v1" ThinkingXHigh)+          @?= []+        checkEvidenceRequirements+          (EvidenceRequired EvidenceModelObserved)+          OpenAIChatCompletions+          (shapeFor "https://api.openai.com/v1" ThinkingMax)+          @?= [],+      testCase "the codex CLI expresses every level, so only its strength refuses" $ do+        -- Nothing is downgraded at any level, but codex names no model,+        -- so a caller requiring model_observed is refused on strength+        -- alone.+        checkEvidenceRequirements+          (EvidenceRequired EvidenceCorrelated)+          OpenAICompletionsCli+          (CodexCli.codexCliThinking (emptyOptions & #thinking .~ Just ThinkingMax))+          @?= []+        case checkEvidenceRequirements+          (EvidenceRequired EvidenceModelObserved)+          OpenAICompletionsCli+          (CodexCli.codexCliThinking (emptyOptions & #thinking .~ Just ThinkingMax)) of+          [StrengthUnreachable _ declared] -> declared @?= EvidenceCorrelated+          other -> assertFailure ("expected a strength refusal, got: " <> show other)+    ]+  where+    shapeFor url lvl =+      describeThinkingShape+        (openaiCompletionsCompatFor (emptyModel & #baseUrl .~ url & #api .~ OpenAIChatCompletions))+        (emptyOptions & #thinking .~ Just lvl)+    expectDowngrade expected translation =+      case checkEvidenceRequirements+        (EvidenceRequired EvidenceRequestedOnly)+        OpenAIChatCompletions+        translation of+        [ThinkingWouldDowngrade [reported]] -> reported @?= expected+        other -> assertFailure ("expected one downgrade refusal, got: " <> show other)++agentProviderGuardTest :: TestTree+agentProviderGuardTest =+  testCase "the codex renderer refuses a request that names claude" $ do+    let req = agentRunRequest AgentClaude "/work/project" "prompt"+    fmap fst (CodexAgent.codexAgentCommand CodexAgent.defaultCodexAgentConfig req)+      @?= Left (ProviderMismatch AgentCodex AgentClaude)+ commandRenderingTest :: TestTree commandRenderingTest =   testCase "renders model, working directory, extra dirs, sandbox, approval, and extra args" $ do@@ -232,25 +599,73 @@             & #safety .~ CodexSandbox CodexWorkspaceWrite CodexApprovalOnRequest             & #extraArgs .~ ["--search"]     codexInteractiveCommand cfg req-      @?= ( "/bin/codex",-            [ "--model",-              "gpt-5-codex",-              "--cd",-              "/work/project",-              "--add-dir",-              "/work/shared",-              "--add-dir",-              "/work/docs",-              "--sandbox",-              "workspace-write",+      @?= Right+        ( "/bin/codex",+          [ "--model",+            "gpt-5-codex",+            "--cd",+            "/work/project",+            "--add-dir",+            "/work/shared",+            "--add-dir",+            "/work/docs",+            "--sandbox",+            "workspace-write",+            "--ask-for-approval",+            "on-request",+            "--no-alt-screen",+            "--search",+            "--",+            "System instructions:\nBe precise.\n\nUser request:\ninspect the repo"+          ]+        )++safetyRefusalTest :: TestTree+safetyRefusalTest =+  testCase "refuses a Claude tool allow-list instead of launching unrestricted" $ do+    let req =+          interactiveLaunchRequest "inspect the repo"+            & #safety .~ ClaudeAllowedTools ["Read"]+    case codexInteractiveCommand defaultCodexInteractiveConfig req of+      Right rendered -> assertFailure ("expected refusal, rendered: " <> show rendered)+      Left err -> do+        case err of+          SafetyNotExpressible p _ -> p @?= AgentCodex+          other -> assertFailure ("expected SafetyNotExpressible, got: " <> show other)+        let message = renderAgentRenderError err+        assertBool "names the provider" ("codex" `Text.isInfixOf` message)+        assertBool "names the rejected tools" ("Read" `Text.isInfixOf` message)+        assertBool "suggests an alternative" ("CodexSandbox" `Text.isInfixOf` message)++-- | The fix refuses only what Codex cannot express. A sandbox policy is+-- expressible and must still render, and an empty allow-list restricts+-- nothing so it renders no safety flag rather than being refused.+safetyStillRendersTest :: TestTree+safetyStillRendersTest =+  testGroup+    "still renders every safety policy Codex can express"+    [ testCase "a sandbox policy" $ do+        let req =+              interactiveLaunchRequest "inspect"+                & #safety .~ CodexSandbox CodexReadOnly CodexApprovalNever+        fmap snd (codexInteractiveCommand defaultCodexInteractiveConfig req)+          @?= Right+            [ "--sandbox",+              "read-only",               "--ask-for-approval",-              "on-request",-              "--no-alt-screen",-              "--search",+              "never",               "--",-              "System instructions:\nBe precise.\n\nUser request:\ninspect the repo"-            ]-          )+              "inspect"+            ],+      testCase "an empty allow-list renders no safety flag" $ do+        let req = interactiveLaunchRequest "inspect" & #safety .~ ClaudeAllowedTools []+        fmap snd (codexInteractiveCommand defaultCodexInteractiveConfig req)+          @?= Right ["--", "inspect"],+      testCase "DefaultSafety renders no safety flag" $ do+        let req = interactiveLaunchRequest "inspect" & #safety .~ DefaultSafety+        fmap snd (codexInteractiveCommand defaultCodexInteractiveConfig req)+          @?= Right ["--", "inspect"]+    ]  effortRenderingTests :: TestTree effortRenderingTests =@@ -259,9 +674,10 @@     [ testCase name $ do         let req = interactiveLaunchRequest "prompt" & #effort .~ Just level         codexInteractiveCommand defaultCodexInteractiveConfig req-          @?= ( "codex",-                ["-c", "model_reasoning_effort=" <> expected, "--", "prompt"]-              )+          @?= Right+            ( "codex",+              ["-c", "model_reasoning_effort=" <> expected, "--", "prompt"]+            )     | (name, level, expected) <-         [ ("minimal", ThinkingMinimal, "minimal"),           ("low", ThinkingLow, "low"),@@ -455,12 +871,12 @@     [ testCase "content_filter terminates as EventError" $ do         let (_events1, ass1) =               translate-                (Right RawChunk {contentDelta = Just "partial", reasoningDelta = Nothing, finishReason = Nothing, toolDeltas = [], usage = Nothing})+                (Right RawChunk {contentDelta = Just "partial", reasoningDelta = Nothing, finishReason = Nothing, toolDeltas = [], usage = Nothing, model = Nothing, responseId = Nothing})                 (emptyAssembler openaiTestModel (read "2026-06-05 00:00:00 UTC"))                 (read "2026-06-05 00:00:01 UTC")             (events2, ass2) =               translate-                (Right RawChunk {contentDelta = Nothing, reasoningDelta = Nothing, finishReason = Just "content_filter", toolDeltas = [], usage = Nothing})+                (Right RawChunk {contentDelta = Nothing, reasoningDelta = Nothing, finishReason = Just "content_filter", toolDeltas = [], usage = Nothing, model = Nothing, responseId = Nothing})                 ass1                 (read "2026-06-05 00:00:02 UTC")             (events3, _) = closeOpenStream (read "2026-06-05 00:00:03 UTC") Nothing ass2@@ -474,7 +890,7 @@       testCase "unknown finish_reason is a successful diagnostic" $ do         let (_events, ass1) =               translate-                (Right RawChunk {contentDelta = Nothing, reasoningDelta = Nothing, finishReason = Just "mystery", toolDeltas = [], usage = Nothing})+                (Right RawChunk {contentDelta = Nothing, reasoningDelta = Nothing, finishReason = Just "mystery", toolDeltas = [], usage = Nothing, model = Nothing, responseId = Nothing})                 (emptyAssembler openaiTestModel (read "2026-06-05 00:00:00 UTC"))                 (read "2026-06-05 00:00:01 UTC")             (terminalEvents, _) = closeOpenStream (read "2026-06-05 00:00:02 UTC") Nothing ass1

@@ -208,7 +208,9 @@       reasoningDelta = Nothing,       finishReason = Nothing,       toolDeltas = [],-      usage = Nothing+      usage = Nothing,+      model = Nothing,+      responseId = Nothing     }  runChunks :: Model -> [RawChunk] -> [AssistantMessageEvent]

@@ -33,6 +33,8 @@     [ deepseekShapeTest,       nativeHigherEffortTests,       compatibleHigherEffortClampTest,+      translationTableTests,+      nativeVersusCompatibleTests,       openRouterCacheControlTest,       strictModeGateTest,       usageStreamingGateTest,@@ -81,6 +83,199 @@         emptyContext     lookupTop "reasoning_effort" value @?= Just (String "high") +-- ============================================================+-- The forty-two-row translation table+-- ============================================================++-- | Every canonical level against every wire shape: what goes on the+-- wire, and what the evidence record says went on it.+--+-- Both halves are asserted on every row. Checking only the description+-- would let it drift away from the request it claims to describe, which+-- is the one failure this whole record exists to prevent.+translationTableTests :: TestTree+translationTableTests =+  testGroup+    "thinking translation across all seven wire shapes"+    [ testCase (shapeName fmt <> " at " <> Text.unpack (renderThinkingLevel lvl)) $ do+        (body, translation) <-+          shapedCall (hostWith fmt) (emptyOptions & #thinking .~ Just lvl) emptyContext+        translation @?= expected+        mapM_ (\(k, v) -> lookupTop k body @?= Just v) present+        mapM_ (\k -> lookupTop k body @?= Nothing) absent+    | (lvl, nativeWord, compatWord, clamps) <- effortRows,+      fmt <- everyThinkingFormat,+      let (expected, present, absent) = expectationFor fmt lvl nativeWord compatWord clamps+    ]++-- | The seven shapes, listed so a new constructor added to+-- 'ThinkingFormat' shows up here as a missing case in 'expectationFor'+-- and 'shapeName' rather than as a silently untested shape.+everyThinkingFormat :: [ThinkingFormat]+everyThinkingFormat =+  [ ThinkingFormatOpenAI,+    ThinkingFormatOpenRouter,+    ThinkingFormatDeepseek,+    ThinkingFormatTogether,+    ThinkingFormatZai,+    ThinkingFormatQwen,+    ThinkingFormatNone+  ]++-- | The exact effort word each of the two vocabularies sends for each+-- canonical level, and the adjustment a clamping vocabulary records.+--+-- Every value is written out rather than computed from the code under+-- test, so this is an independent statement of the intended behaviour+-- and not a second copy of the implementation. The native column never+-- clamps: it forwards the canonical name, which is exactly what an+-- empty adjustment list means.+effortRows :: [(ThinkingLevel, Text.Text, Text.Text, [ThinkingAdjustment])]+effortRows =+  [ (ThinkingMinimal, "minimal", "low", [EffortClamped ThinkingMinimal "low"]),+    (ThinkingLow, "low", "low", []),+    (ThinkingMedium, "medium", "medium", []),+    (ThinkingHigh, "high", "high", []),+    (ThinkingXHigh, "xhigh", "high", [EffortClamped ThinkingXHigh "high"]),+    (ThinkingMax, "max", "high", [EffortClamped ThinkingMax "high"])+  ]++-- | The translation, the body keys that must be present, and the body+-- keys that must be absent, for one shape at one level.+expectationFor ::+  ThinkingFormat ->+  ThinkingLevel ->+  -- | The word the native vocabulary sends.+  Text.Text ->+  -- | The word the compatible vocabulary sends.+  Text.Text ->+  -- | The adjustment the compatible vocabulary records, if any.+  [ThinkingAdjustment] ->+  (ThinkingTranslation, [(Text.Text, Value)], [Text.Text])+expectationFor fmt lvl nativeWord compatWord clamps = case fmt of+  ThinkingFormatOpenAI ->+    ( adaptiveTranslation lvl nativeWord "reasoning_effort" [],+      [("reasoning_effort", String nativeWord)],+      ["reasoning", "thinking", "enable_thinking"]+    )+  ThinkingFormatOpenRouter ->+    ( adaptiveTranslation lvl compatWord "reasoning" clamps,+      [("reasoning", Aeson.object ["effort" .= compatWord])],+      ["reasoning_effort", "thinking", "enable_thinking"]+    )+  ThinkingFormatDeepseek ->+    ( adaptiveTranslation lvl compatWord "reasoning_effort" clamps,+      [ ("reasoning_effort", String compatWord),+        ("thinking", Aeson.object ["type" .= ("enabled" :: Text.Text)])+      ],+      ["reasoning", "enable_thinking"]+    )+  ThinkingFormatTogether ->+    ( adaptiveTranslation lvl compatWord "reasoning_effort" clamps,+      [ ("reasoning_effort", String compatWord),+        ("reasoning", Aeson.object ["enabled" .= True])+      ],+      ["thinking", "enable_thinking"]+    )+  ThinkingFormatZai -> collapsed+  ThinkingFormatQwen -> collapsed+  ThinkingFormatNone ->+    ( ThinkingTranslation+        { requested = Just lvl,+          mode = ThinkingModeUnsupported,+          effortText = Nothing,+          budgetTokens = Nothing,+          wireField = Nothing,+          adjustments = [ThinkingDroppedUnsupportedHost lvl]+        },+      [],+      ["reasoning_effort", "reasoning", "thinking", "enable_thinking"]+    )+  where+    -- Z.ai and Qwen carry no depth at all, so every level collapses --+    -- including the ones a richer host would have accepted verbatim.+    collapsed =+      ( ThinkingTranslation+          { requested = Just lvl,+            mode = ThinkingModeToggle,+            effortText = Nothing,+            budgetTokens = Nothing,+            wireField = Just "enable_thinking",+            adjustments = [EffortCollapsedToToggle lvl]+          },+        [("enable_thinking", Bool True)],+        ["reasoning_effort", "reasoning", "thinking"]+      )++adaptiveTranslation ::+  ThinkingLevel -> Text.Text -> Text.Text -> [ThinkingAdjustment] -> ThinkingTranslation+adaptiveTranslation lvl wire field adjs =+  ThinkingTranslation+    { requested = Just lvl,+      mode = ThinkingModeAdaptive,+      effortText = Just wire,+      budgetTokens = Nothing,+      wireField = Just field,+      adjustments = adjs+    }++shapeName :: ThinkingFormat -> String+shapeName = \case+  ThinkingFormatOpenAI -> "openai-native"+  ThinkingFormatOpenRouter -> "openrouter"+  ThinkingFormatDeepseek -> "deepseek"+  ThinkingFormatTogether -> "together"+  ThinkingFormatZai -> "zai"+  ThinkingFormatQwen -> "qwen"+  ThinkingFormatNone -> "no-reasoning-controls"++-- | A reasoning-capable model pinned to one wire shape, so the table+-- exercises a shape rather than whichever host a catalog entry happens+-- to point at.+hostWith :: ThinkingFormat -> Model+hostWith fmt =+  Models.openai_gpt_5_6_terra+    & #compat+      .~ CompatOpenAICompletions+        defaultOpenAICompletionsCompat {thinkingFormat = fmt}++-- | The same request against a native host and against a clamping one,+-- written side by side because the contrast is the design.+--+-- The native rows are the ones that look wrong at a glance and are not:+-- `xhigh` and `max` reach the wire intact and the translation records no+-- adjustment, because nothing was adjusted. Clamping them here would+-- silently weaken every high-effort request against a current OpenAI+-- model.+nativeVersusCompatibleTests :: TestTree+nativeVersusCompatibleTests =+  testGroup+    "the native vocabulary forwards what the compatible one clamps"+    [ testCase "native xhigh reaches the wire and adjusts nothing" $+        assertEffort Models.openai_gpt_5_6_terra ThinkingXHigh "xhigh" [],+      testCase "deepseek xhigh clamps to high and records it" $+        assertEffort+          Models.deepseek_deepseek_chat+          ThinkingXHigh+          "high"+          [EffortClamped ThinkingXHigh "high"],+      testCase "native max reaches the wire and adjusts nothing" $+        assertEffort Models.openai_gpt_5_6_terra ThinkingMax "max" [],+      testCase "deepseek max clamps to high and records it" $+        assertEffort+          Models.deepseek_deepseek_chat+          ThinkingMax+          "high"+          [EffortClamped ThinkingMax "high"]+    ]+  where+    assertEffort model lvl wire adjs = do+      (body, translation) <-+        shapedCall model (emptyOptions & #thinking .~ Just lvl) emptyContext+      lookupTop "reasoning_effort" body @?= Just (String wire)+      effortText translation @?= Just wire+      adjustments translation @?= adjs+ openRouterCacheControlTest :: TestTree openRouterCacheControlTest =   testCase "OpenRouter cache marker lands on the system content part with ttl" $ do@@ -184,7 +379,12 @@           ]  shapedBody :: Model -> Options -> Context -> IO Value-shapedBody model opts ctx = do+shapedBody model opts ctx = fst <$> shapedCall model opts ctx++-- | The shaped request body together with the description of what the+-- caller's reasoning-effort preference became inside it.+shapedCall :: Model -> Options -> Context -> IO (Value, ThinkingTranslation)+shapedCall model opts ctx = do   req <- either (assertFailure . Text.unpack) pure (mapRequest model ctx opts)   pure (streamRequestBody (openaiCompletionsCompatFor model) opts req) @@ -225,7 +425,9 @@       reasoningDelta = Nothing,       finishReason = Nothing,       toolDeltas = [],-      usage = Nothing+      usage = Nothing,+      model = Nothing,+      responseId = Nothing     }  runChunks :: [RawChunk] -> [AssistantMessageEvent]

@@ -1,16 +1,23 @@ module SseSpec (tests) where -import Baikai.Error (ErrorCategory (..), category, httpStatus, retryAfterSeconds)-import Baikai.Provider.OpenAI.Sse (sseFromResponse)+import Baikai.Error (BaikaiError, ErrorCategory (..), category, httpStatus, providerError, retryAfterSeconds)+import Baikai.Evidence (Observed (..))+import Baikai.Models.Generated (openai_gpt_4o_mini)+import Baikai.Provider.OpenAI.Api (Assembler, RawChunk, emptyAssembler, parseChunk, translate)+import Baikai.Provider.OpenAI.Sse (ResponseMetadata, sseFromResponse)+import Control.Lens ((^.)) import Data.Aeson qualified as Aeson import Data.ByteString (ByteString) import Data.CaseInsensitive qualified as CI+import Data.Generics.Labels () import Data.IORef (modifyIORef', newIORef, readIORef, writeIORef)+import Data.Text qualified as Text+import Data.Time.Clock (UTCTime) import Network.HTTP.Client.Internal qualified as HTTP import Network.HTTP.Types.Status (mkStatus) import Network.HTTP.Types.Version (http11) import Test.Tasty (TestTree, testGroup)-import Test.Tasty.HUnit (assertFailure, testCase, (@?=))+import Test.Tasty.HUnit (assertBool, assertFailure, testCase, (@?=))  tests :: TestTree tests =@@ -18,8 +25,9 @@     "Baikai.Provider.OpenAI.Sse"     [ testCase "non-2xx response preserves Retry-After and status" $ do         eventsRef <- newIORef []+        metaRef <- newIORef []         resp <- mkResponse 429 [("Retry-After", "9")] ["{\"error\":{\"message\":\"rate limited\",\"type\":\"tokens\"}}"]-        sseFromResponse resp (\ev -> modifyIORef' eventsRef (<> [ev]))+        sseFromResponse resp (\md -> modifyIORef' metaRef (<> [md])) (\ev -> modifyIORef' eventsRef (<> [ev]))         events <- readIORef eventsRef         case events of           [Left e] -> do@@ -29,13 +37,133 @@           other -> assertFailure ("expected one classified error, got: " <> show other),       testCase "[DONE] terminates without emitting a JSON event" $ do         eventsRef <- newIORef []+        metaRef <- newIORef []         resp <- mkResponse 200 [] ["data: {\"choices\":[]}\n\n", "data: [DONE]\n\n", "data: {\"ignored\":true}\n\n"]-        sseFromResponse resp (\ev -> modifyIORef' eventsRef (<> [ev]))+        sseFromResponse resp (\md -> modifyIORef' metaRef (<> [md])) (\ev -> modifyIORef' eventsRef (<> [ev]))         events <- readIORef eventsRef         case events of           [Right (Aeson.Object _)] -> pure ()-          other -> assertFailure ("expected one JSON event before [DONE], got: " <> show other)+          other -> assertFailure ("expected one JSON event before [DONE], got: " <> show other),+      observationTests     ]++-- | What the transport and the assembler between them can say about+-- what the host reported, as opposed to what was configured.+--+-- The fixture's @model@ deliberately differs from the model the+-- assembler was built with. If they matched, a bug that read the+-- caller's configuration instead of the host's chunk would pass these+-- assertions, which is exactly the substitution the 'Observed' type+-- exists to prevent.+observationTests :: TestTree+observationTests =+  testGroup+    "response observation"+    [ testCase "a 200 response yields one metadata value carrying x-request-id" $ do+        (metas, _) <- replay 200 [("x-request-id", "req_abc123"), ("authorization", "Bearer sk-leak")] successBody+        case metas of+          [md] -> do+            md ^. #httpStatus @?= 200+            -- Allow-list, not denylist: the credential-shaped header the+            -- fixture also carries must not be recorded.+            md ^. #headers @?= [("x-request-id", "req_abc123")]+          other -> assertFailure ("expected exactly one metadata value, got: " <> show other),+      testCase "the observed model comes from the chunks, not the configured model" $ do+        (_, ass) <- replay 200 [("x-request-id", "req_abc123")] successBody+        ass ^. #observedModel @?= Observed "gpt-4o-mini-20990101-server-side"+        -- Asserted as a difference rather than against a literal catalog+        -- id, which is generated and moves.+        assertBool+          "the fixture's model must differ from the configured one"+          (ass ^. #observedModel /= Observed (openai_gpt_4o_mini ^. #modelId))+        ass ^. #responseId @?= Just "chatcmpl-observed"+        ass ^. #usageReported @?= True,+      testCase "the first reported model wins over a later one" $ do+        (_, ass) <- replay 200 [] disagreeingBody+        ass ^. #observedModel @?= Observed "first-reported-model"+        ass ^. #responseId @?= Just "chatcmpl-first",+      testCase "a failed response still yields metadata, and observes no model" $ do+        (metas, ass) <-+          replay+            429+            [("x-request-id", "req_failed")]+            ["{\"error\":{\"message\":\"rate limited\",\"type\":\"tokens\"}}"]+        case metas of+          [md] -> do+            md ^. #httpStatus @?= 429+            md ^. #headers @?= [("x-request-id", "req_failed")]+          other -> assertFailure ("expected exactly one metadata value, got: " <> show other)+        ass ^. #observedModel @?= Unobserved+        ass ^. #responseId @?= Nothing+        ass ^. #usageReported @?= False,+      testCase "a gateway header is captured when the host's own is absent" $ do+        (metas, _) <- replay 200 [("cf-ray", "ray-9"), ("x-amzn-requestid", "gw-1")] successBody+        case metas of+          -- Recorded in the order the response listed them; the+          -- adapter's preference order lives in capturedHeaderNames.+          [md] -> md ^. #headers @?= [("cf-ray", "ray-9"), ("x-amzn-requestid", "gw-1")]+          other -> assertFailure ("expected exactly one metadata value, got: " <> show other)+    ]++-- | A complete successful stream whose reported model is not any model+-- in the catalog, so it cannot be confused with a configured one.+successBody :: [ByteString]+successBody =+  [ "data: {\"id\":\"chatcmpl-observed\",\"object\":\"chat.completion.chunk\",",+    "\"model\":\"gpt-4o-mini-20990101-server-side\",",+    "\"choices\":[{\"index\":0,\"delta\":{\"content\":\"pong\"}}]}\n\n",+    "data: {\"id\":\"chatcmpl-observed\",\"model\":\"gpt-4o-mini-20990101-server-side\",",+    "\"choices\":[{\"index\":0,\"delta\":{},\"finish_reason\":\"stop\"}]}\n\n",+    "data: {\"id\":\"chatcmpl-observed\",\"model\":\"gpt-4o-mini-20990101-server-side\",",+    "\"choices\":[],\"usage\":{\"prompt_tokens\":11,\"completion_tokens\":5}}\n\n",+    "data: [DONE]\n\n"+  ]++-- | Two chunks reporting different identities. Compatible hosts repeat+-- both fields on every chunk and they are expected to agree; this pins+-- which one is kept if one ever does not, so the answer is a recorded+-- decision rather than whichever chunk happened to arrive last.+disagreeingBody :: [ByteString]+disagreeingBody =+  [ "data: {\"id\":\"chatcmpl-first\",\"model\":\"first-reported-model\",",+    "\"choices\":[{\"index\":0,\"delta\":{\"content\":\"a\"}}]}\n\n",+    "data: {\"id\":\"chatcmpl-second\",\"model\":\"second-reported-model\",",+    "\"choices\":[{\"index\":0,\"delta\":{\"content\":\"b\"},\"finish_reason\":\"stop\"}]}\n\n",+    "data: [DONE]\n\n"+  ]++-- | Drive a recorded response through the real transport and fold the+-- chunks it produces through the real parser and translator.+replay ::+  Int -> [(ByteString, ByteString)] -> [ByteString] -> IO ([ResponseMetadata], Assembler)+replay status headers chunks = do+  metaRef <- newIORef []+  eventsRef <- newIORef []+  resp <- mkResponse status headers chunks+  sseFromResponse+    resp+    (\md -> modifyIORef' metaRef (<> [md]))+    (\ev -> modifyIORef' eventsRef (<> [ev]))+  metas <- readIORef metaRef+  events <- readIORef eventsRef+  let ass =+        foldl'+          (\acc ev -> snd (translate (parsed ev) acc testTime))+          (emptyAssembler openai_gpt_4o_mini testTime)+          events+  pure (metas, ass)++-- | Chunks reach the assembler through 'parseChunk', exactly as the+-- worker sends them.+parsed :: Either BaikaiError Aeson.Value -> Either BaikaiError RawChunk+parsed = \case+  Left e -> Left e+  Right v -> case parseChunk v of+    Left err -> Left (providerError (Text.pack err))+    Right chunk -> Right chunk++testTime :: UTCTime+testTime = read "2026-07-03 12:00:00 UTC"  mkResponse :: Int -> [(ByteString, ByteString)] -> [ByteString] -> IO (HTTP.Response HTTP.BodyReader) mkResponse status headers chunks = do