baikai 0.2.0.0 → 0.3.0.0

raw patch · 47 files changed

+4155/−1711 lines, 47 filesdep +tasty-quickcheckdep ~lensPVP ok

version bump matches the API change (PVP)

Dependencies added: tasty-quickcheck

Dependency ranges changed: lens

API changes (from Hackage documentation)

Files

• CHANGELOG.md +96/−0
• baikai.cabal +17/−3
• fetch/FetchModels.hs +42/−29
• fetch/FetchModelsCore.hs +266/−119
• gen/GenModels.hs +9/−408
• gen/GenModelsCore.hs +490/−0
• src/Baikai.hs +12/−0
• src/Baikai/Auth.hs +46/−0
• src/Baikai/Compat.hs +127/−51
• src/Baikai/Content.hs +31/−9
• src/Baikai/Context.hs +55/−4
• src/Baikai/Cost.hs +16/−6
• src/Baikai/Cost/Log.hs +38/−19
• src/Baikai/Cost/Pricing.hs +1/−1
• src/Baikai/Embedding.hs +29/−5
• src/Baikai/Error.hs +25/−0
• src/Baikai/Interactive.hs +24/−7
• src/Baikai/Message.hs +67/−33
• src/Baikai/Model.hs +52/−17
• src/Baikai/Models/Generated.hs +718/−675
• src/Baikai/Options.hs +58/−8
• src/Baikai/Prelude.hs +6/−0
• src/Baikai/Provider.hs +10/−0
• src/Baikai/Provider/Cli/Internal.hs +22/−3
• src/Baikai/Provider/Registry.hs +146/−14
• src/Baikai/Response.hs +70/−17
• src/Baikai/Stream.hs +238/−93
• src/Baikai/Stream/Event.hs +61/−34
• src/Baikai/Tool.hs +7/−2
• src/Baikai/Trace.hs +75/−19
• src/Baikai/Trace/Event.hs +2/−2
• src/Baikai/Usage.hs +55/−13
• test/CliInternalSpec.hs +32/−0
• test/ContextSpec.hs +133/−0
• test/CostSpec.hs +38/−15
• test/EmbeddingSpec.hs +13/−1
• test/ErrorInfoSpec.hs +51/−8
• test/ErrorSpec.hs +21/−0
• test/FetchModelsSpec.hs +88/−27
• test/GenModelsSpec.hs +56/−0
• test/HelpersSpec.hs +339/−0
• test/InteractiveSpec.hs +5/−5
• test/Main.hs +116/−38
• test/StreamSpec.hs +186/−0
• test/SurfaceSpec.hs +53/−0
• test/TraceSpec.hs +76/−11
• test/UsageSpec.hs +37/−15

@@ -7,6 +7,102 @@  ## [Unreleased] +## [baikai 0.3.0.0] - 2026-07-03++### Added++- Added the documented record-update bases `emptyOptions`, `emptyContext`,+  `emptyModel`, `emptyResponse`, `emptyTool`, `emptyTextContent`,+  `emptyThinkingContent`, `emptyToolCall`, `emptyImageContent`,+  `emptyEmbeddingModel`, plus zero-valued bases `zeroUsage`, `zeroCost`,+  `zeroCostBreakdown`, and `zeroModelCost`.+- Added `firstEmbedding`, a total accessor for OpenAI-compatible embedding+  responses.+- Added `responseError`, `errorResponse`, `httpError`, and+  `parseRetryAfterSeconds` for the in-band error contract.++### Changed++- **Breaking:** Constructors for evolvable records are no longer exported:+  `Options`, `Context`, `Model`, `OpenAICompletionsCompat`,+  `AnthropicMessagesCompat`, and `InteractiveLaunchRequest` are built from+  exported base values plus record updates.+- **Breaking:** The `_X` base values are deprecated in favor of the new+  `empty*` and `zero*` names; the aliases remain for this release.+- **Breaking:** Removed `unModel`; use `mkModel` or `emptyModel` record+  updates.+- **Breaking:** Renamed `InteractiveLaunchRequest.model` to `modelId`.+- **Breaking:** `Response.latencyMs` and trace event `latencyMs` fields are+  now `Int`.+- **Breaking:** `completeRequest` / `completeRequestWith` no longer throw+  `BaikaiError` for unregistered API tags; they return an error-shaped+  `Response`.+- **Breaking:** CLI providers now report subprocess/decode/provider failures+  in-band as error-shaped `Response`s.+- **Breaking:** `errorTerminal` now requires a `BaikaiError`, enforcing+  structured error details for `EventError` construction sites.+- Documented that `Baikai.Prelude` is a convenience module outside the PVP+  stability contract and that `.Internal` modules have no compatibility+  guarantees.++### Fixed++- Empty embedding `data` arrays now produce a typed `decodeError` instead of+  crashing on an empty vector.+- The model-fetch JSON renderer now delegates string escaping to aeson.+- The model generator now fails on sanitized Haskell identifier collisions+  instead of rendering duplicate bindings.+- Live HTTP status, `Retry-After`, and network-failure classification now+  works on both API providers.+- `content_filter` / Anthropic refusals terminate as classified `EventError`+  terminals, and `liftCompleteToStream` preserves error-shaped responses.++## [baikai-claude 0.3.0.0] - 2026-07-03++### Changed++- **Breaking:** `Baikai.Provider.Claude.ErrorClass` moved to+  `Baikai.Provider.Claude.Internal.ErrorClass`.+- **Breaking:** `mapRequest` and pure request-shaping helpers moved from+  `Baikai.Provider.Claude.Api` to+  `Baikai.Provider.Claude.Internal.Request`.+- **Breaking:** `ClaudeCliConfig` and `ClaudeInteractiveConfig` constructors+  are no longer exported; start from their default config values and update+  fields.+- **Breaking:** CLI and interactive `extraArgs` fields are now `[Text]`.++## [baikai-openai 0.3.0.0] - 2026-07-03++### Changed++- **Breaking:** `Baikai.Provider.OpenAI.ErrorClass` moved to+  `Baikai.Provider.OpenAI.Internal.ErrorClass`.+- **Breaking:** `mapRequest` and pure request-shaping helpers moved from+  `Baikai.Provider.OpenAI.Api` to+  `Baikai.Provider.OpenAI.Internal.Request`.+- **Breaking:** `CodexCliConfig` and `CodexInteractiveConfig` constructors are+  no longer exported; start from their default config values and update fields.+- **Breaking:** CLI and interactive `extraArgs` fields are now `[Text]`.++## [baikai-trace-otel 0.3.0.0] - 2026-07-03++### Changed++- Updated the `baikai` dependency bound to `^>=0.3.0`.+- Adjusted to the core trace event `latencyMs :: Int` type.++## [baikai-effectful 0.3.0.0] - 2026-07-03++### Changed++- Updated the `baikai` dependency bound to `^>=0.3.0`.++## [baikai-kit 0.1.0.1] - 2026-07-03++### Changed++- Updated the `baikai` dependency bound to `^>=0.3.0`.+ ## [baikai 0.2.0.0] - 2026-06-21  ### Added

@@ -1,6 +1,6 @@ cabal-version:   3.4 name:            baikai-version:         0.2.0.0+version:         0.3.0.0 synopsis:        Unified Haskell interface for multiple AI providers description:   baikai provides a unified, provider-agnostic Haskell interface for working@@ -91,6 +91,7 @@   import:         common-options   hs-source-dirs: gen   main-is:        GenModels.hs+  other-modules:  GenModelsCore   build-depends:     , aeson     , baikai@@ -120,8 +121,10 @@     , containers     , directory     , filepath+    , generic-lens     , http-client     , http-client-tls+    , lens     , scientific     , text             ^>=2.1     , vector@@ -129,18 +132,25 @@ test-suite baikai-test   import:             common-options   type:               exitcode-stdio-1.0-  hs-source-dirs:     test fetch+  hs-source-dirs:     test fetch gen   main-is:            Main.hs   other-modules:     AgentAssetsSpec     CatalogSpec+    CliInternalSpec+    ContextSpec     CostSpec     EmbeddingSpec     ErrorInfoSpec     ErrorSpec     FetchModelsCore     FetchModelsSpec+    GenModelsCore+    GenModelsSpec+    HelpersSpec     InteractiveSpec+    StreamSpec+    SurfaceSpec     TraceSpec     UsageSpec @@ -153,13 +163,17 @@     , containers     , directory     , filepath+    , generic-lens+    , lens     , openai     , process     , scientific     , stm-    , streamly-core  >=0.3 && <0.5+    , streamly-core     >=0.3 && <0.5     , tasty     , tasty-hunit+    , tasty-quickcheck     , temporary     , text+    , time     , vector

@@ -1,6 +1,3 @@-{-# LANGUAGE LambdaCase #-}-{-# LANGUAGE OverloadedStrings #-}- -- | Executable @baikai-fetch-models@: refresh baikai's catalog JSON -- from upstream sources (primarily @https:\/\/models.dev\/api.json@). --@@ -33,12 +30,13 @@ -- writing). module FetchModels (main, fetchUpstream) where +import Baikai.Prelude import Control.Exception (catch) import Data.ByteString qualified as BS import Data.ByteString.Lazy qualified as BSL+import Data.Generics.Labels () import Data.Map.Strict (Map) import Data.Map.Strict qualified as Map-import Data.Text (Text) import Data.Text qualified as Text import FetchModelsCore import Network.HTTP.Client (HttpException, httpLbs, parseUrlThrow, responseBody)@@ -47,6 +45,7 @@ import System.Environment (getArgs) import System.Exit (die) import System.FilePath (takeDirectory, (</>))+import System.IO (hPutStrLn, stderr)  -- | Which provider(s) to emit. data ProviderSel = SelOpenAI | SelAnthropic | SelAll@@ -54,21 +53,22 @@  -- | Parsed command-line options. data Options = Options-  { optFromUrl :: !String,-    optFromFile :: !(Maybe FilePath),-    optOutDir :: !(Maybe FilePath),-    optProvider :: !ProviderSel,-    optStdout :: !Bool+  { fromUrl :: !String,+    fromFile :: !(Maybe FilePath),+    outDir :: !(Maybe FilePath),+    provider :: !ProviderSel,+    stdout :: !Bool   }+  deriving stock (Generic)  defaultOptions :: Options defaultOptions =   Options-    { optFromUrl = "https://models.dev/api.json",-      optFromFile = Nothing,-      optOutDir = Nothing,-      optProvider = SelAll,-      optStdout = False+    { fromUrl = "https://models.dev/api.json",+      fromFile = Nothing,+      outDir = Nothing,+      provider = SelAll,+      stdout = False     }  main :: IO ()@@ -79,26 +79,28 @@   upstream <- case parseUpstream raw of     Left err -> die $ "baikai-fetch-models: failed to parse upstream JSON: " <> err     Right u -> pure u-  let catalogs = map (catalogFor upstream) (selectedSpecs (optProvider opts))-  if optStdout opts+  let catalogs =+        map (applyOverrides overrides . catalogFor upstream) (selectedSpecs (opts ^. #provider))+  mapM_ warnStale (staleOverrides overrides catalogs)+  if opts ^. #stdout     then mapM_ (BS.putStr . renderCatalog) catalogs     else do-      outDir <- resolveOutDir (optOutDir opts)-      mapM_ (writeCatalog outDir) catalogs+      dir <- resolveOutDir (opts ^. #outDir)+      mapM_ (writeCatalog dir) catalogs  -- | Obtain the raw upstream bytes: a local file when @--from-file@ is -- set, otherwise a live GET. A network/HTTP failure ('HttpException', -- which 'parseUrlThrow' raises for non-2xx responses) is turned into a -- clean non-zero exit with nothing written. loadUpstreamBytes :: Options -> IO BSL.ByteString-loadUpstreamBytes opts = case optFromFile opts of+loadUpstreamBytes opts = case opts ^. #fromFile of   Just path -> BSL.readFile path   Nothing ->-    fetchUpstream (optFromUrl opts)+    fetchUpstream (opts ^. #fromUrl)       `catch` \e ->         die $           "baikai-fetch-models: failed to fetch "-            <> optFromUrl opts+            <> opts ^. #fromUrl             <> ": "             <> show (e :: HttpException) @@ -111,21 +113,32 @@   req <- parseUrlThrow url   responseBody <$> httpLbs req manager +-- | Warn (to stderr, without failing) about an override that matched+-- no fetched model, so stale corrections get noticed.+warnStale :: (Text, Text) -> IO ()+warnStale (prov, mid) =+  hPutStrLn stderr $+    "baikai-fetch-models: warning: override for ("+      <> Text.unpack prov+      <> ", "+      <> Text.unpack mid+      <> ") matched no fetched model (stale?)"+ -- | Build a provider's catalog from the parsed upstream document, -- defaulting to an empty model map if the provider is absent. catalogFor :: Map Text (Map Text UpstreamModel) -> ProviderSpec -> Catalog catalogFor upstream spec =-  normalizeProvider spec (Map.findWithDefault Map.empty (psProvider spec) upstream)+  normalizeProvider spec (Map.findWithDefault Map.empty (spec ^. #provider) upstream)  -- | Write one catalog to @\<dir\>\/\<provider\>.json@ in a single -- 'BS.writeFile' (so a crash mid-run cannot leave a truncated file) -- and report what was written. writeCatalog :: FilePath -> Catalog -> IO () writeCatalog dir cat = do-  let path = dir </> (Text.unpack (cProvider cat) <> ".json")+  let path = dir </> (Text.unpack (cat ^. #provider) <> ".json")   BS.writeFile path (renderCatalog cat)   putStrLn $-    "Wrote " <> path <> " (" <> show (length (cModels cat)) <> " models)"+    "Wrote " <> path <> " (" <> show (length (cat ^. #models)) <> " models)"  -- | The provider specs selected by @--provider@. selectedSpecs :: ProviderSel -> [ProviderSpec]@@ -172,13 +185,13 @@ parseArgs = go defaultOptions   where     go o [] = pure o-    go o ("--from-url" : v : rest) = go o {optFromUrl = v} rest-    go o ("--from-file" : v : rest) = go o {optFromFile = Just v} rest-    go o ("--out-dir" : v : rest) = go o {optOutDir = Just v} rest+    go o ("--from-url" : v : rest) = go (o & #fromUrl .~ v) rest+    go o ("--from-file" : v : rest) = go (o & #fromFile ?~ v) rest+    go o ("--out-dir" : v : rest) = go (o & #outDir ?~ v) rest     go o ("--provider" : v : rest) = do       sel <- parseProvider v-      go o {optProvider = sel} rest-    go o ("--stdout" : rest) = go o {optStdout = True} rest+      go (o & #provider .~ sel) rest+    go o ("--stdout" : rest) = go (o & #stdout .~ True) rest     go _ (a : _) = die $ "baikai-fetch-models: unknown argument " <> show a  parseProvider :: String -> IO ProviderSel

@@ -1,6 +1,3 @@-{-# LANGUAGE LambdaCase #-}-{-# LANGUAGE OverloadedStrings #-}- -- | Pure core of the @baikai-fetch-models@ tool: parse a -- models.dev-shaped payload, normalize it into baikai's catalog JSON -- shape, and render that JSON with formatting matched to the@@ -20,6 +17,21 @@ -- @openai@ this excludes Responses-API-only ids (@*-pro@, @*-codex@, -- @*-deep-research@) because @baikai/data/models/openai.json@ speaks -- @openai-chat-completions@ and 'Baikai.Api' has no Responses tag.+--+-- == Override philosophy+--+-- models.dev is not fully trustworthy, so a small, explicit override+-- layer ('overrides') is applied after normalization. Each entry is a+-- per-@(provider, modelId)@ correction that overwrites only the fields+-- it sets, and each MUST carry a dated comment justifying why upstream+-- is wrong (mirroring pi-mono's @generate-models.ts@). Keep the table+-- minimal: prefer fixing upstream or curating ids out over piling on+-- overrides. Overrides that match no fetched model are warned about+-- ('staleOverrides') rather than silently kept.+--+-- Records follow the project convention: no field prefixes; field+-- access and updates go through generic-lens @#label@ optics rather+-- than bare selectors or record-update syntax. module FetchModelsCore   ( -- * Upstream shape (subset of models.dev fields we consume)     UpstreamModel (..),@@ -38,16 +50,26 @@     anthropicInclude,     normalizeProvider, +    -- * Override layer+    Override (..),+    emptyOverride,+    overrides,+    applyOverrides,+    staleOverrides,+     -- * Rendering     renderCatalog,   ) where  import Baikai.Model (InputModality (..))-import Data.Aeson (FromJSON (..), (.!=), (.:), (.:?))-import Data.Aeson qualified as Aeson+import Baikai.Prelude+import Data.Aeson (Value (String), eitherDecode, encode, withObject, (.!=), (.:), (.:?))+import Data.Aeson.Types (Parser) import Data.ByteString (ByteString) import Data.ByteString.Lazy qualified as BSL+import Data.ByteString.Lazy qualified as LBS+import Data.Generics.Labels () import Data.List (sortOn) import Data.Map.Strict (Map) import Data.Map.Strict qualified as Map@@ -55,9 +77,8 @@ import Data.Scientific (FPFormat (Fixed), Scientific, formatScientific) import Data.Set (Set) import Data.Set qualified as Set-import Data.Text (Text) import Data.Text qualified as Text-import Data.Text.Encoding (encodeUtf8)+import Data.Text.Encoding (decodeUtf8, encodeUtf8)  -- * Upstream shape ---------------------------------------------------- @@ -65,64 +86,66 @@ -- optional field defaults the way pi-mono's scraper does: missing -- numbers become 0 at normalization time, missing arrays become empty. data UpstreamModel = UpstreamModel-  { uId :: !Text,-    uName :: !(Maybe Text),-    uToolCall :: !Bool,-    uReasoning :: !Bool,-    uCtx :: !(Maybe Integer),-    uMaxOut :: !(Maybe Integer),-    uCostIn :: !(Maybe Scientific),-    uCostOut :: !(Maybe Scientific),-    uCacheRead :: !(Maybe Scientific),-    uCacheWrite :: !(Maybe Scientific),-    uInputMods :: ![Text]+  { modelId :: !Text,+    name :: !(Maybe Text),+    toolCall :: !Bool,+    reasoning :: !Bool,+    contextWindow :: !(Maybe Integer),+    maxOutputTokens :: !(Maybe Integer),+    inputCost :: !(Maybe Scientific),+    outputCost :: !(Maybe Scientific),+    cacheReadCost :: !(Maybe Scientific),+    cacheWriteCost :: !(Maybe Scientific),+    inputModalities :: ![Text]   }-  deriving stock (Eq, Show)+  deriving stock (Eq, Show, Generic)  instance FromJSON UpstreamModel where-  parseJSON = Aeson.withObject "UpstreamModel" $ \o -> do-    uId <- o .: "id"-    uName <- o .:? "name"-    uToolCall <- o .:? "tool_call" .!= False-    uReasoning <- o .:? "reasoning" .!= False-    mLimit <- o .:? "limit"-    mCost <- o .:? "cost"-    mMods <- o .:? "modalities"+  parseJSON = withObject "UpstreamModel" $ \o -> do+    mid <- o .: "id"+    nm <- o .:? "name"+    tc <- o .:? "tool_call" .!= False+    rs <- o .:? "reasoning" .!= False+    lim <- o .:? "limit" :: Parser (Maybe Limit)+    cst <- o .:? "cost" :: Parser (Maybe Cost)+    mods <- o .:? "modalities" :: Parser (Maybe Modalities)     pure       UpstreamModel-        { uId = uId,-          uName = uName,-          uToolCall = uToolCall,-          uReasoning = uReasoning,-          uCtx = mLimit >>= limitContext,-          uMaxOut = mLimit >>= limitOutput,-          uCostIn = mCost >>= costIn,-          uCostOut = mCost >>= costOut,-          uCacheRead = mCost >>= costCacheRead,-          uCacheWrite = mCost >>= costCacheWrite,-          uInputMods = maybe [] modalitiesInput mMods+        { modelId = mid,+          name = nm,+          toolCall = tc,+          reasoning = rs,+          contextWindow = lim >>= (^. #context),+          maxOutputTokens = lim >>= (^. #output),+          inputCost = cst >>= (^. #input),+          outputCost = cst >>= (^. #output),+          cacheReadCost = cst >>= (^. #cacheRead),+          cacheWriteCost = cst >>= (^. #cacheWrite),+          inputModalities = maybe [] (^. #input) mods         }  -- | @limit@ sub-object. data Limit = Limit-  { limitContext :: !(Maybe Integer),-    limitOutput :: !(Maybe Integer)+  { context :: !(Maybe Integer),+    output :: !(Maybe Integer)   }+  deriving stock (Show, Generic)  instance FromJSON Limit where-  parseJSON = Aeson.withObject "limit" $ \o ->+  parseJSON = withObject "limit" $ \o ->     Limit <$> o .:? "context" <*> o .:? "output"  -- | @cost@ sub-object (US dollars per million tokens). data Cost = Cost-  { costIn :: !(Maybe Scientific),-    costOut :: !(Maybe Scientific),-    costCacheRead :: !(Maybe Scientific),-    costCacheWrite :: !(Maybe Scientific)+  { input :: !(Maybe Scientific),+    output :: !(Maybe Scientific),+    cacheRead :: !(Maybe Scientific),+    cacheWrite :: !(Maybe Scientific)   }+  deriving stock (Show, Generic)  instance FromJSON Cost where-  parseJSON = Aeson.withObject "cost" $ \o ->+  parseJSON = withObject "cost" $ \o ->     Cost       <$> o .:? "input"       <*> o .:? "output"@@ -130,58 +153,62 @@       <*> o .:? "cache_write"  -- | @modalities@ sub-object; we only read @input@.-newtype Modalities = Modalities {modalitiesInput :: [Text]}+newtype Modalities = Modalities {input :: [Text]}+  deriving stock (Show, Generic)  instance FromJSON Modalities where-  parseJSON = Aeson.withObject "modalities" $ \o ->+  parseJSON = withObject "modalities" $ \o ->     Modalities <$> o .:? "input" .!= []  -- | One provider object in the models.dev document. We only read the -- @models@ map; every other provider field is ignored.-newtype UpstreamProvider = UpstreamProvider {upModels :: Map Text UpstreamModel}+newtype UpstreamProvider = UpstreamProvider {models :: Map Text UpstreamModel}+  deriving stock (Generic)  instance FromJSON UpstreamProvider where-  parseJSON = Aeson.withObject "UpstreamProvider" $ \o ->+  parseJSON = withObject "UpstreamProvider" $ \o ->     UpstreamProvider <$> o .:? "models" .!= Map.empty  -- | Parse a full models.dev document into @provider -> (modelId -> -- model)@. The top-level document is a JSON object keyed by provider -- id; each provider object carries a @models@ map keyed by model id. parseUpstream :: BSL.ByteString -> Either String (Map Text (Map Text UpstreamModel))-parseUpstream bs = Map.map upModels <$> Aeson.eitherDecode bs+parseUpstream bs =+  Map.map (^. #models) <$> (eitherDecode bs :: Either String (Map Text UpstreamProvider))  -- * Output catalog shape --------------------------------------------- --- | Per-million-token cost rates, in the catalog's field names.+-- | Per-million-token cost rates, named to mirror+-- 'Baikai.Model.ModelCost'. data CatalogCost = CatalogCost-  { ccInput :: !Scientific,-    ccOutput :: !Scientific,-    ccCacheRead :: !Scientific,-    ccCacheWrite :: !Scientific+  { inputCost :: !Scientific,+    outputCost :: !Scientific,+    cacheReadCost :: !Scientific,+    cacheWriteCost :: !Scientific   }-  deriving stock (Eq, Show)+  deriving stock (Eq, Show, Generic)  -- | One emitted catalog model. @enabled@ is always @true@ for emitted -- models, so it is not stored here; the renderer writes it literally. data CatalogModel = CatalogModel-  { cmId :: !Text,-    cmName :: !Text,-    cmReasoning :: !Bool,-    cmInput :: ![InputModality],-    cmCost :: !CatalogCost,-    cmContextWindow :: !Integer,-    cmMaxOutputTokens :: !Integer+  { modelId :: !Text,+    name :: !Text,+    reasoning :: !Bool,+    input :: ![InputModality],+    cost :: !CatalogCost,+    contextWindow :: !Integer,+    maxOutputTokens :: !Integer   }-  deriving stock (Eq, Show)+  deriving stock (Eq, Show, Generic)  -- | A whole catalog file: one provider and its curated models. data Catalog = Catalog-  { cProvider :: !Text,-    cBaseUrl :: !Text,-    cApi :: !Text,-    cModels :: ![CatalogModel]+  { provider :: !Text,+    baseUrl :: !Text,+    api :: !Text,+    models :: ![CatalogModel]   }-  deriving stock (Eq, Show)+  deriving stock (Eq, Show, Generic)  -- * Provider specs and normalization --------------------------------- @@ -189,11 +216,12 @@ -- catalog and the curation predicate selecting which upstream model -- ids to keep. data ProviderSpec = ProviderSpec-  { psProvider :: !Text,-    psBaseUrl :: !Text,-    psApi :: !Text,-    psInclude :: !(Text -> Bool)+  { provider :: !Text,+    baseUrl :: !Text,+    api :: !Text,+    include :: !(Text -> Bool)   }+  deriving stock (Generic)  -- | Curation include set for OpenAI: the chat-completions-compatible -- current line. Responses-API-only ids (@*-pro@, @*-codex@,@@ -239,20 +267,20 @@ openaiSpec :: ProviderSpec openaiSpec =   ProviderSpec-    { psProvider = "openai",-      psBaseUrl = "https://api.openai.com",-      psApi = "openai-chat-completions",-      psInclude = (`Set.member` openaiInclude)+    { provider = "openai",+      baseUrl = "https://api.openai.com",+      api = "openai-chat-completions",+      include = (`Set.member` openaiInclude)     }  -- | Provider spec for Anthropic's first-party messages endpoint. anthropicSpec :: ProviderSpec anthropicSpec =   ProviderSpec-    { psProvider = "anthropic",-      psBaseUrl = "https://api.anthropic.com",-      psApi = "anthropic-messages",-      psInclude = (`Set.member` anthropicInclude)+    { provider = "anthropic",+      baseUrl = "https://api.anthropic.com",+      api = "anthropic-messages",+      include = (`Set.member` anthropicInclude)     }  -- | Normalize one provider's upstream models into a 'Catalog'. Keeps@@ -263,38 +291,158 @@ normalizeProvider :: ProviderSpec -> Map Text UpstreamModel -> Catalog normalizeProvider spec upstream =   Catalog-    { cProvider = psProvider spec,-      cBaseUrl = psBaseUrl spec,-      cApi = psApi spec,-      cModels = sortOn cmId (map toCatalogModel kept)+    { provider = spec ^. #provider,+      baseUrl = spec ^. #baseUrl,+      api = spec ^. #api,+      models = sortOn (^. #modelId) (map toCatalogModel kept)     }   where     kept =       [ m       | m <- Map.elems upstream,-        uToolCall m,-        psInclude spec (uId m)+        m ^. #toolCall,+        (spec ^. #include) (m ^. #modelId)       ]     toCatalogModel m =       CatalogModel-        { cmId = uId m,-          cmName = fromMaybe (uId m) (uName m),-          cmReasoning = uReasoning m,-          cmInput =-            if "image" `elem` uInputMods m+        { modelId = m ^. #modelId,+          name = normalizeName (fromMaybe (m ^. #modelId) (m ^. #name)),+          reasoning = m ^. #reasoning,+          input =+            if "image" `elem` (m ^. #inputModalities)               then [InputText, InputImage]               else [InputText],-          cmCost =+          cost =             CatalogCost-              { ccInput = fromMaybe 0 (uCostIn m),-                ccOutput = fromMaybe 0 (uCostOut m),-                ccCacheRead = fromMaybe 0 (uCacheRead m),-                ccCacheWrite = fromMaybe 0 (uCacheWrite m)+              { inputCost = fromMaybe 0 (m ^. #inputCost),+                outputCost = fromMaybe 0 (m ^. #outputCost),+                cacheReadCost = fromMaybe 0 (m ^. #cacheReadCost),+                cacheWriteCost = fromMaybe 0 (m ^. #cacheWriteCost)               },-          cmContextWindow = fromMaybe 0 (uCtx m),-          cmMaxOutputTokens = fromMaybe 0 (uMaxOut m)+          contextWindow = fromMaybe 0 (m ^. #contextWindow),+          maxOutputTokens = fromMaybe 0 (m ^. #maxOutputTokens)         } +-- | Strip a trailing @" (latest)"@ display-name suffix that models.dev+-- attaches to the "latest" aliases (e.g. @"Claude Opus 4.5 (latest)"@).+-- This is a systematic upstream wart, so it is normalized for every+-- provider rather than via a per-model override.+normalizeName :: Text -> Text+normalizeName n = fromMaybe n (Text.stripSuffix " (latest)" n)++-- * Override layer ----------------------------------------------------++-- | A hand-maintained correction for one @(provider, modelId)@ pair.+-- Every field except the key is a @Maybe@: 'Nothing' leaves the+-- normalized value untouched, 'Just' overwrites it. Build entries from+-- 'emptyOverride' and set only the fields that need correcting.+data Override = Override+  { provider :: !Text,+    modelId :: !Text,+    name :: !(Maybe Text),+    reasoning :: !(Maybe Bool),+    inputCost :: !(Maybe Scientific),+    outputCost :: !(Maybe Scientific),+    cacheReadCost :: !(Maybe Scientific),+    cacheWriteCost :: !(Maybe Scientific),+    contextWindow :: !(Maybe Integer),+    maxOutputTokens :: !(Maybe Integer)+  }+  deriving stock (Eq, Show, Generic)++-- | An override that changes nothing, keyed by provider and model id.+emptyOverride :: Text -> Text -> Override+emptyOverride prov mid =+  Override+    { provider = prov,+      modelId = mid,+      name = Nothing,+      reasoning = Nothing,+      inputCost = Nothing,+      outputCost = Nothing,+      cacheReadCost = Nothing,+      cacheWriteCost = Nothing,+      contextWindow = Nothing,+      maxOutputTokens = Nothing+    }++-- | The hand-maintained correction table, applied after normalization.+-- Each entry MUST carry a dated comment explaining why upstream is+-- wrong, exactly as pi-mono's @generate-models.ts@ documents its+-- corrections. Order does not matter; entries are keyed by+-- @(provider, modelId)@.+overrides :: [Override]+overrides =+  [ -- 2026-06-21: models.dev has periodically reported Claude Opus+    -- cache_read at 3x the published rate (1.5 instead of 0.5 /Mtok) —+    -- the same wart pi-mono hard-corrects in generate-models.ts+    -- ("models.dev has 3x the correct pricing"). Pin cache_read to+    -- Anthropic's published 0.5 so an upstream regression cannot+    -- silently inflate cached-input cost.+    emptyOverride "anthropic" "claude-opus-4-5" & #cacheReadCost ?~ 0.5+  ]++-- | Apply all overrides matching this catalog's provider to its+-- models. A model with no matching override is returned unchanged.+applyOverrides :: [Override] -> Catalog -> Catalog+applyOverrides ovs cat = cat & #models %~ map applyMatching+  where+    prov = cat ^. #provider+    byKey =+      Map.fromList+        [((o ^. #provider, o ^. #modelId), o) | o <- ovs]+    applyMatching m =+      maybe m (`applyOne` m) (Map.lookup (prov, m ^. #modelId) byKey)++-- | Overwrite each 'CatalogModel' field for which the override carries+-- a 'Just'. 'Nothing' fields are left as normalized.+applyOne :: Override -> CatalogModel -> CatalogModel+applyOne o m =+  m+    & #name+    %~ overwrite (o ^. #name)+    & #reasoning+    %~ overwrite (o ^. #reasoning)+    & #cost+    . #inputCost+    %~ overwrite (o ^. #inputCost)+    & #cost+    . #outputCost+    %~ overwrite (o ^. #outputCost)+    & #cost+    . #cacheReadCost+    %~ overwrite (o ^. #cacheReadCost)+    & #cost+    . #cacheWriteCost+    %~ overwrite (o ^. #cacheWriteCost)+    & #contextWindow+    %~ overwrite (o ^. #contextWindow)+    & #maxOutputTokens+    %~ overwrite (o ^. #maxOutputTokens)+  where+    overwrite :: Maybe a -> a -> a+    overwrite = maybe id const++-- | Override keys @(provider, modelId)@ that match no model in any of+-- the given catalogs (restricted to providers actually present, so an+-- override for an unfetched provider is not falsely flagged). The tool+-- warns on these so stale overrides get noticed without failing.+staleOverrides :: [Override] -> [Catalog] -> [(Text, Text)]+staleOverrides ovs cats =+  [ (o ^. #provider, o ^. #modelId)+  | o <- ovs,+    (o ^. #provider) `Set.member` provs,+    (o ^. #provider, o ^. #modelId) `Set.notMember` present+  ]+  where+    provs = Set.fromList (map (^. #provider) cats)+    present =+      Set.fromList+        [ (cat ^. #provider, m ^. #modelId)+        | cat <- cats,+          m <- cat ^. #models+        ]+ -- * Rendering ---------------------------------------------------------  -- | Render a 'Catalog' as catalog JSON, byte-for-byte in the style of@@ -307,12 +455,12 @@ renderLines :: Catalog -> [Text] renderLines cat =   ["{"]-    ++ [ "  \"provider\": " <> jsonString (cProvider cat) <> ",",-         "  \"baseUrl\": " <> jsonString (cBaseUrl cat) <> ",",-         "  \"api\": " <> jsonString (cApi cat) <> ",",+    ++ [ "  \"provider\": " <> jsonString (cat ^. #provider) <> ",",+         "  \"baseUrl\": " <> jsonString (cat ^. #baseUrl) <> ",",+         "  \"api\": " <> jsonString (cat ^. #api) <> ",",          "  \"compat\": \"auto\","        ]-    ++ modelsSection (cModels cat)+    ++ modelsSection (cat ^. #models)     ++ ["}"]  modelsSection :: [CatalogModel] -> [Text]@@ -336,23 +484,23 @@ renderModel :: CatalogModel -> [Text] renderModel m =   [ "    {",-    "      \"id\": " <> jsonString (cmId m) <> ",",-    "      \"name\": " <> jsonString (cmName m) <> ",",-    "      \"reasoning\": " <> jsonBool (cmReasoning m) <> ",",-    "      \"input\": " <> renderInput (cmInput m) <> ",",+    "      \"id\": " <> jsonString (m ^. #modelId) <> ",",+    "      \"name\": " <> jsonString (m ^. #name) <> ",",+    "      \"reasoning\": " <> jsonBool (m ^. #reasoning) <> ",",+    "      \"input\": " <> renderInput (m ^. #input) <> ",",     "      \"cost\": {",-    "        \"input\": " <> renderNum (ccInput c) <> ",",-    "        \"output\": " <> renderNum (ccOutput c) <> ",",-    "        \"cacheRead\": " <> renderNum (ccCacheRead c) <> ",",-    "        \"cacheWrite\": " <> renderNum (ccCacheWrite c),+    "        \"input\": " <> renderNum (c ^. #inputCost) <> ",",+    "        \"output\": " <> renderNum (c ^. #outputCost) <> ",",+    "        \"cacheRead\": " <> renderNum (c ^. #cacheReadCost) <> ",",+    "        \"cacheWrite\": " <> renderNum (c ^. #cacheWriteCost),     "      },",-    "      \"contextWindow\": " <> Text.pack (show (cmContextWindow m)) <> ",",-    "      \"maxOutputTokens\": " <> Text.pack (show (cmMaxOutputTokens m)) <> ",",+    "      \"contextWindow\": " <> Text.pack (show (m ^. #contextWindow)) <> ",",+    "      \"maxOutputTokens\": " <> Text.pack (show (m ^. #maxOutputTokens)) <> ",",     "      \"enabled\": true",     "    }"   ]   where-    c = cmCost m+    c = m ^. #cost  renderInput :: [InputModality] -> Text renderInput ms = "[" <> Text.intercalate ", " (map one ms) <> "]"@@ -370,8 +518,7 @@ renderNum :: Scientific -> Text renderNum = Text.pack . formatScientific Fixed Nothing --- | Render a 'Text' as a JSON string literal, escaping backslashes and--- double quotes (sufficient for model ids and display names).+-- | Render a 'Text' as a JSON string literal. Delegate escaping to aeson so+-- control characters, quotes, and backslashes follow the JSON encoder exactly. jsonString :: Text -> Text-jsonString t =-  "\"" <> Text.replace "\"" "\\\"" (Text.replace "\\" "\\\\" t) <> "\""+jsonString = decodeUtf8 . LBS.toStrict . encode . String

@@ -1,5 +1,3 @@-{-# LANGUAGE LambdaCase #-}-{-# LANGUAGE OverloadedRecordDot #-} {-# LANGUAGE OverloadedStrings #-}  -- | Generator executable that reads JSON catalog files from@@ -29,29 +27,17 @@ -- (enforced by @CatalogSpec@ in @baikai\/test\/@). module Main (main) where -import Baikai.Api (Api (..), parseApi)-import Baikai.Compat-  ( AnthropicMessagesCompat (..),-    CacheControlFormat (..),-    MaxTokensField (..),-    OpenAICompletionsCompat (..),-    ThinkingFormat (..),-    defaultAnthropicMessagesCompat,-    defaultOpenAICompletionsCompat,-  )-import Baikai.Model (InputModality (..)) import Control.Monad (forM)-import Data.Aeson (FromJSON (..), (.!=), (.:), (.:?)) import Data.Aeson qualified as Aeson-import Data.Aeson.Types (Parser, typeMismatch) import Data.ByteString.Lazy qualified as BSL import Data.List (sort, sortOn)-import Data.Ratio (denominator, numerator)-import Data.Scientific (Scientific)-import Data.Text (Text) import Data.Text qualified as Text import Data.Text.IO qualified as TIO-import Numeric.Natural (Natural)+import GenModelsCore+  ( checkIdentifierCollisions,+    flattenEntries,+    renderModule,+  ) import System.Directory (doesFileExist, getCurrentDirectory, listDirectory) import System.Environment (getArgs) import System.Exit (die)@@ -69,7 +55,10 @@       Left err -> die $ f <> ": " <> err       Right c -> pure c   let allEntries = concatMap flattenEntries catalogs-      sorted = sortOn fst allEntries+  case checkIdentifierCollisions allEntries of+    Left err -> die (Text.unpack err)+    Right () -> pure ()+  let sorted = sortOn fst allEntries       rendered = renderModule sorted   TIO.writeFile outputPath rendered   putStrLn $@@ -134,391 +123,3 @@ listCatalogFiles dir = do   entries <- listDirectory dir   pure $ sort [f | f <- entries, takeExtension f == ".json"]---- * Catalog data types --------------------------------------------------- | One catalog file, in source form.-data CatalogFile = CatalogFile-  { provider :: !Text,-    baseUrl :: !Text,-    api :: !Api,-    compat :: !CatalogCompat,-    models :: ![ModelEntry]-  }--instance FromJSON CatalogFile where-  parseJSON = Aeson.withObject "CatalogFile" $ \o ->-    CatalogFile-      <$> o .: "provider"-      <*> o .: "baseUrl"-      <*> (parseApi <$> o .: "api")-      <*> o .: "compat"-      <*> o .: "models"---- | A compat directive in the catalog. @"auto"@ defers to EP-5's--- @baseUrl@-driven auto-detection (rendered as 'CompatNone'). The two--- structured constructors carry a full override record.-data CatalogCompat-  = CatalogCompatAuto-  | CatalogCompatOpenAI !OpenAICompletionsCompat-  | CatalogCompatAnthropic !AnthropicMessagesCompat-  deriving stock (Show)--instance FromJSON CatalogCompat where-  parseJSON = \case-    Aeson.String "auto" -> pure CatalogCompatAuto-    Aeson.Object o -> do-      kind <- o .: "kind" :: Parser Text-      case kind of-        "openai-completions" ->-          CatalogCompatOpenAI <$> parseOpenAICompat o-        "anthropic-messages" ->-          CatalogCompatAnthropic <$> parseAnthropicCompat o-        _ ->-          fail $ "CatalogCompat: unknown kind " <> show kind-    v -> typeMismatch "CatalogCompat (expected \"auto\" or {\"kind\": ...})" v--parseOpenAICompat :: Aeson.Object -> Parser OpenAICompletionsCompat-parseOpenAICompat o = do-  let d = defaultOpenAICompletionsCompat-  mtf <- optionalField o "maxTokensField" parseMaxTokensField (maxTokensField d)-  sdr <- o .:? "supportsDeveloperRole" .!= supportsDeveloperRole d-  sst <- o .:? "supportsStrictMode" .!= supportsStrictMode d-  rtat <- o .:? "requiresThinkingAsText" .!= requiresThinkingAsText d-  tf <- optionalField o "thinkingFormat" parseThinkingFormat (thinkingFormat d)-  ccf <- optionalMaybeField o "cacheControlFormat" parseCacheControlFormat (cacheControlFormat d)-  sus <- o .:? "supportsUsageInStreaming" .!= d.supportsUsageInStreaming-  slcr <- o .:? "supportsLongCacheRetention" .!= d.supportsLongCacheRetention-  pure-    OpenAICompletionsCompat-      { maxTokensField = mtf,-        supportsDeveloperRole = sdr,-        supportsStrictMode = sst,-        requiresThinkingAsText = rtat,-        thinkingFormat = tf,-        cacheControlFormat = ccf,-        supportsUsageInStreaming = sus,-        supportsLongCacheRetention = slcr-      }--parseAnthropicCompat :: Aeson.Object -> Parser AnthropicMessagesCompat-parseAnthropicCompat o = do-  let d = defaultAnthropicMessagesCompat-  slcr <- o .:? "supportsLongCacheRetention" .!= d.supportsLongCacheRetention-  scot <- o .:? "supportsCacheControlOnTools" .!= d.supportsCacheControlOnTools-  seti <- o .:? "supportsEagerToolInputStreaming" .!= d.supportsEagerToolInputStreaming-  ssah <- o .:? "sendSessionAffinityHeaders" .!= d.sendSessionAffinityHeaders-  pure-    AnthropicMessagesCompat-      { supportsLongCacheRetention = slcr,-        supportsCacheControlOnTools = scot,-        supportsEagerToolInputStreaming = seti,-        sendSessionAffinityHeaders = ssah-      }--parseMaxTokensField :: Text -> Parser MaxTokensField-parseMaxTokensField = \case-  "max_tokens" -> pure MaxTokensField-  "max_completion_tokens" -> pure MaxCompletionTokensField-  t -> fail $ "unknown maxTokensField: " <> Text.unpack t--parseThinkingFormat :: Text -> Parser ThinkingFormat-parseThinkingFormat = \case-  "openai" -> pure ThinkingFormatOpenAI-  "openrouter" -> pure ThinkingFormatOpenRouter-  "deepseek" -> pure ThinkingFormatDeepseek-  "together" -> pure ThinkingFormatTogether-  "zai" -> pure ThinkingFormatZai-  "qwen" -> pure ThinkingFormatQwen-  "none" -> pure ThinkingFormatNone-  t -> fail $ "unknown thinkingFormat: " <> Text.unpack t--parseCacheControlFormat :: Text -> Parser CacheControlFormat-parseCacheControlFormat = \case-  "anthropic" -> pure CacheControlFormatAnthropic-  t -> fail $ "unknown cacheControlFormat: " <> Text.unpack t---- | Look up an optional field; missing returns @def@.-optionalField :: Aeson.Object -> Aeson.Key -> (Text -> Parser a) -> a -> Parser a-optionalField o key parser def = do-  mv <- o .:? key-  case mv of-    Nothing -> pure def-    Just v -> parser v---- | Look up an optional @Maybe@-typed field. JSON @null@ or absence--- yields @def@; otherwise the value is parsed through @parser@ and--- wrapped in 'Just'.-optionalMaybeField ::-  Aeson.Object ->-  Aeson.Key ->-  (Text -> Parser a) ->-  Maybe a ->-  Parser (Maybe a)-optionalMaybeField o key parser def = do-  mv <- o .:? key-  case mv of-    Nothing -> pure def-    Just Aeson.Null -> pure Nothing-    Just (Aeson.String t) -> Just <$> parser t-    Just v -> typeMismatch "string or null" v---- | One model row in a catalog file.-data ModelEntry = ModelEntry-  { entryId :: !Text,-    entryName :: !Text,-    entryReasoning :: !Bool,-    entryInput :: ![InputModality],-    entryCost :: !CostEntry,-    entryContextWindow :: !Natural,-    entryMaxOutputTokens :: !Natural,-    entryEnabled :: !Bool,-    entryCompatOverride :: !(Maybe CatalogCompat)-  }--instance FromJSON ModelEntry where-  parseJSON = Aeson.withObject "ModelEntry" $ \o ->-    ModelEntry-      <$> o .: "id"-      <*> o .: "name"-      <*> o .:? "reasoning" .!= False-      <*> (o .: "input" >>= traverse parseInputModality)-      <*> o .: "cost"-      <*> o .: "contextWindow"-      <*> o .: "maxOutputTokens"-      <*> o .:? "enabled" .!= True-      <*> o .:? "compat"--parseInputModality :: Text -> Parser InputModality-parseInputModality = \case-  "text" -> pure InputText-  "image" -> pure InputImage-  t -> fail $ "unknown input modality: " <> Text.unpack t---- | Per-million-token cost rates. Parsed as 'Scientific' so the--- round-trip into 'Rational' produces a small, canonical fraction--- (@1.5@ → @3 % 2@) rather than an arbitrary IEEE-754 approximation.-data CostEntry = CostEntry-  { costInput :: !Scientific,-    costOutput :: !Scientific,-    costCacheRead :: !Scientific,-    costCacheWrite :: !Scientific-  }--instance FromJSON CostEntry where-  parseJSON = Aeson.withObject "CostEntry" $ \o ->-    CostEntry-      <$> o .: "input"-      <*> o .: "output"-      <*> o .:? "cacheRead" .!= 0-      <*> o .:? "cacheWrite" .!= 0---- * Flattening ------------------------------------------------------------- | One generated Haskell identifier plus the 'Model'-shaped record--- it should be rendered as. Keeping these together lets the renderer--- stay a pure transformation over a flat list.-data GeneratedEntry = GeneratedEntry-  { genIdent :: !Text,-    genModelId :: !Text,-    genName :: !Text,-    genApi :: !Api,-    genProvider :: !Text,-    genBaseUrl :: !Text,-    genReasoning :: !Bool,-    genInput :: ![InputModality],-    genCost :: !CostEntry,-    genContextWindow :: !Natural,-    genMaxOutputTokens :: !Natural,-    genCompat :: !CatalogCompat-  }--flattenEntries :: CatalogFile -> [(Text, GeneratedEntry)]-flattenEntries c =-  [ (genIdent g, g)-  | m <- models c,-    entryEnabled m,-    let g =-          GeneratedEntry-            { genIdent =-                sanitizeIdentifier (provider c <> "_" <> entryId m),-              genModelId = entryId m,-              genName = entryName m,-              genApi = api c,-              genProvider = provider c,-              genBaseUrl = baseUrl c,-              genReasoning = entryReasoning m,-              genInput = entryInput m,-              genCost = entryCost m,-              genContextWindow = entryContextWindow m,-              genMaxOutputTokens = entryMaxOutputTokens m,-              genCompat =-                case entryCompatOverride m of-                  Just c' -> c'-                  Nothing -> compat c-            }-  ]---- | Replace any non-identifier character with @_@. Haskell allows--- letters, digits, underscore, and apostrophe; everything else--- (slash, dash, dot, colon, …) becomes an underscore.-sanitizeIdentifier :: Text -> Text-sanitizeIdentifier = Text.map replace-  where-    replace c-      | (c >= 'a' && c <= 'z')-          || (c >= 'A' && c <= 'Z')-          || (c >= '0' && c <= '9')-          || c == '_'-          || c == '\'' =-          c-      | otherwise = '_'---- * Source rendering ----------------------------------------------------renderModule :: [(Text, GeneratedEntry)] -> Text-renderModule entries =-  Text.unlines-    ( header-        ++ concatMap (renderEntry . snd) entries-    )-  where-    header =-      [ "-- AUTO-GENERATED by baikai-gen-models. Do not edit by hand.",-        "-- Regenerate with: cabal run baikai-gen-models",-        "{-# LANGUAGE OverloadedStrings #-}",-        "{-# OPTIONS_GHC -Wno-missing-export-lists #-}",-        "{-# OPTIONS_GHC -Wno-unused-imports #-}",-        "",-        "module Baikai.Models.Generated where",-        "",-        "import Baikai.Api (Api (..))",-        "import Baikai.Compat",-        "  ( AnthropicMessagesCompat (..)",-        "  , CacheControlFormat (..)",-        "  , MaxTokensField (..)",-        "  , OpenAICompletionsCompat (..)",-        "  , ThinkingFormat (..)",-        "  )",-        "import Baikai.Model",-        "  ( Compat (..)",-        "  , InputModality (..)",-        "  , Model (..)",-        "  , ModelCost (..)",-        "  )",-        "import Data.Map.Strict qualified as Map",-        "import Data.Ratio ((%))",-        ""-      ]--renderEntry :: GeneratedEntry -> [Text]-renderEntry g =-  [ genIdent g <> " :: Model",-    genIdent g <> " =",-    "  Model",-    "    { modelId = " <> renderText (genModelId g),-    "    , name = " <> renderText (genName g),-    "    , api = " <> renderApiCtor (genApi g),-    "    , provider = " <> renderText (genProvider g),-    "    , baseUrl = " <> renderText (genBaseUrl g),-    "    , reasoning = " <> renderBool (genReasoning g),-    "    , input = " <> renderInputList (genInput g),-    "    , cost = " <> renderCost (genCost g),-    "    , contextWindow = " <> Text.pack (show (genContextWindow g)),-    "    , maxOutputTokens = " <> Text.pack (show (genMaxOutputTokens g)),-    "    , headers = Map.empty",-    "    , compat = " <> renderCompat (genCompat g),-    "    }",-    ""-  ]--renderText :: Text -> Text-renderText t =-  "\""-    <> Text.replace "\"" "\\\"" (Text.replace "\\" "\\\\" t)-    <> "\""--renderBool :: Bool -> Text-renderBool True = "True"-renderBool False = "False"--renderInputList :: [InputModality] -> Text-renderInputList ms =-  "[" <> Text.intercalate ", " (map renderInput ms) <> "]"-  where-    renderInput InputText = "InputText"-    renderInput InputImage = "InputImage"--renderApiCtor :: Api -> Text-renderApiCtor = \case-  OpenAIChatCompletions -> "OpenAIChatCompletions"-  AnthropicMessages -> "AnthropicMessages"-  OpenAICompletionsCli -> "OpenAICompletionsCli"-  AnthropicMessagesCli -> "AnthropicMessagesCli"-  Custom t -> "Custom " <> renderText t--renderCost :: CostEntry -> Text-renderCost c =-  Text.intercalate-    "\n"-    [ "ModelCost",-      "        { inputCost = " <> renderRational (toRational (costInput c)),-      "        , outputCost = " <> renderRational (toRational (costOutput c)),-      "        , cacheReadCost = " <> renderRational (toRational (costCacheRead c)),-      "        , cacheWriteCost = " <> renderRational (toRational (costCacheWrite c)),-      "        }"-    ]--renderRational :: Rational -> Text-renderRational r =-  Text.pack (show (numerator r)) <> " % " <> Text.pack (show (denominator r))--renderCompat :: CatalogCompat -> Text-renderCompat = \case-  CatalogCompatAuto -> "CompatNone"-  CatalogCompatOpenAI c ->-    Text.intercalate-      "\n"-      [ "CompatOpenAICompletions",-        "        OpenAICompletionsCompat",-        "          { maxTokensField = " <> renderMaxTokensField c.maxTokensField,-        "          , supportsDeveloperRole = " <> renderBool c.supportsDeveloperRole,-        "          , supportsStrictMode = " <> renderBool c.supportsStrictMode,-        "          , requiresThinkingAsText = " <> renderBool c.requiresThinkingAsText,-        "          , thinkingFormat = " <> renderThinkingFormat c.thinkingFormat,-        "          , cacheControlFormat = " <> renderMaybeCacheControl c.cacheControlFormat,-        "          , supportsUsageInStreaming = " <> renderBool c.supportsUsageInStreaming,-        "          , supportsLongCacheRetention = " <> renderBool c.supportsLongCacheRetention,-        "          }"-      ]-  CatalogCompatAnthropic c ->-    Text.intercalate-      "\n"-      [ "CompatAnthropicMessages",-        "        AnthropicMessagesCompat",-        "          { supportsLongCacheRetention = " <> renderBool c.supportsLongCacheRetention,-        "          , supportsCacheControlOnTools = " <> renderBool c.supportsCacheControlOnTools,-        "          , supportsEagerToolInputStreaming = " <> renderBool c.supportsEagerToolInputStreaming,-        "          , sendSessionAffinityHeaders = " <> renderBool c.sendSessionAffinityHeaders,-        "          }"-      ]--renderMaxTokensField :: MaxTokensField -> Text-renderMaxTokensField = \case-  MaxCompletionTokensField -> "MaxCompletionTokensField"-  MaxTokensField -> "MaxTokensField"--renderThinkingFormat :: ThinkingFormat -> Text-renderThinkingFormat = \case-  ThinkingFormatOpenAI -> "ThinkingFormatOpenAI"-  ThinkingFormatOpenRouter -> "ThinkingFormatOpenRouter"-  ThinkingFormatDeepseek -> "ThinkingFormatDeepseek"-  ThinkingFormatTogether -> "ThinkingFormatTogether"-  ThinkingFormatZai -> "ThinkingFormatZai"-  ThinkingFormatQwen -> "ThinkingFormatQwen"-  ThinkingFormatNone -> "ThinkingFormatNone"--renderMaybeCacheControl :: Maybe CacheControlFormat -> Text-renderMaybeCacheControl = \case-  Nothing -> "Nothing"-  Just CacheControlFormatAnthropic -> "Just CacheControlFormatAnthropic"

@@ -0,0 +1,490 @@+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE OverloadedRecordDot #-}+{-# LANGUAGE OverloadedStrings #-}++-- | Pure core for @baikai-gen-models@: parse catalog JSON, flatten enabled+-- entries, reject generated identifier collisions, and render the generated+-- Haskell module. The executable wrapper owns only argument parsing, file IO,+-- and default path resolution.+module GenModelsCore+  ( CatalogFile (..),+    CatalogCompat (..),+    ModelEntry (..),+    CostEntry (..),+    GeneratedEntry (..),+    flattenEntries,+    checkIdentifierCollisions,+    sanitizeIdentifier,+    renderModule,+  )+where++import Baikai.Api (Api (..), parseApi)+import Baikai.Compat+  ( AnthropicMessagesCompat+      ( sendSessionAffinityHeaders,+        supportsCacheControlOnTools,+        supportsLongCacheRetention,+        thinkingStyle+      ),+    AnthropicThinkingStyle (..),+    CacheControlFormat (..),+    MaxTokensField (..),+    OpenAICompletionsCompat+      ( cacheControlFormat,+        maxTokensField,+        requiresThinkingAsText,+        supportsLongCacheRetention,+        supportsStrictMode,+        supportsUsageInStreaming,+        thinkingFormat+      ),+    ThinkingFormat (..),+    defaultAnthropicMessagesCompat,+    defaultOpenAICompletionsCompat,+  )+import Baikai.Model (InputModality (..))+import Data.Aeson (FromJSON (..), (.!=), (.:), (.:?))+import Data.Aeson qualified as Aeson+import Data.Aeson.Types (Parser, typeMismatch)+import Data.Map.Strict qualified as Map+import Data.Ratio (denominator, numerator)+import Data.Scientific (Scientific)+import Data.Text (Text)+import Data.Text qualified as Text+import Numeric.Natural (Natural)++-- * Catalog data types -----------------------------------------------++-- | One catalog file, in source form.+data CatalogFile = CatalogFile+  { provider :: !Text,+    baseUrl :: !Text,+    api :: !Api,+    compat :: !CatalogCompat,+    models :: ![ModelEntry]+  }++instance FromJSON CatalogFile where+  parseJSON = Aeson.withObject "CatalogFile" $ \o ->+    CatalogFile+      <$> o .: "provider"+      <*> o .: "baseUrl"+      <*> (parseApi <$> o .: "api")+      <*> o .: "compat"+      <*> o .: "models"++-- | A compat directive in the catalog. @"auto"@ defers to EP-5's+-- @baseUrl@-driven auto-detection (rendered as 'CompatNone'). The two+-- structured constructors carry a full override record.+data CatalogCompat+  = CatalogCompatAuto+  | CatalogCompatOpenAI !OpenAICompletionsCompat+  | CatalogCompatAnthropic !AnthropicMessagesCompat+  deriving stock (Show)++instance FromJSON CatalogCompat where+  parseJSON = \case+    Aeson.String "auto" -> pure CatalogCompatAuto+    Aeson.Object o -> do+      kind <- o .: "kind" :: Parser Text+      case kind of+        "openai-completions" ->+          CatalogCompatOpenAI <$> parseOpenAICompat o+        "anthropic-messages" ->+          CatalogCompatAnthropic <$> parseAnthropicCompat o+        _ ->+          fail $ "CatalogCompat: unknown kind " <> show kind+    v -> typeMismatch "CatalogCompat (expected \"auto\" or {\"kind\": ...})" v++parseOpenAICompat :: Aeson.Object -> Parser OpenAICompletionsCompat+parseOpenAICompat o = do+  let d = defaultOpenAICompletionsCompat+  mtf <- optionalField o "maxTokensField" parseMaxTokensField (maxTokensField d)+  sst <- o .:? "supportsStrictMode" .!= supportsStrictMode d+  rtat <- o .:? "requiresThinkingAsText" .!= requiresThinkingAsText d+  tf <- optionalField o "thinkingFormat" parseThinkingFormat (thinkingFormat d)+  ccf <- optionalMaybeField o "cacheControlFormat" parseCacheControlFormat (cacheControlFormat d)+  sus <- o .:? "supportsUsageInStreaming" .!= d.supportsUsageInStreaming+  slcr <- o .:? "supportsLongCacheRetention" .!= d.supportsLongCacheRetention+  pure+    d+      { maxTokensField = mtf,+        supportsStrictMode = sst,+        requiresThinkingAsText = rtat,+        thinkingFormat = tf,+        cacheControlFormat = ccf,+        supportsUsageInStreaming = sus,+        supportsLongCacheRetention = slcr+      }++parseAnthropicCompat :: Aeson.Object -> Parser AnthropicMessagesCompat+parseAnthropicCompat o = do+  let d = defaultAnthropicMessagesCompat+  slcr <- o .:? "supportsLongCacheRetention" .!= d.supportsLongCacheRetention+  scot <- o .:? "supportsCacheControlOnTools" .!= d.supportsCacheControlOnTools+  ssah <- o .:? "sendSessionAffinityHeaders" .!= d.sendSessionAffinityHeaders+  ts <- o .:? "thinkingStyle" .!= d.thinkingStyle+  pure+    d+      { supportsLongCacheRetention = slcr,+        supportsCacheControlOnTools = scot,+        sendSessionAffinityHeaders = ssah,+        thinkingStyle = ts+      }++parseMaxTokensField :: Text -> Parser MaxTokensField+parseMaxTokensField = \case+  "max_tokens" -> pure MaxTokensField+  "max_completion_tokens" -> pure MaxCompletionTokensField+  t -> fail $ "unknown maxTokensField: " <> Text.unpack t++parseThinkingFormat :: Text -> Parser ThinkingFormat+parseThinkingFormat = \case+  "openai" -> pure ThinkingFormatOpenAI+  "openrouter" -> pure ThinkingFormatOpenRouter+  "deepseek" -> pure ThinkingFormatDeepseek+  "together" -> pure ThinkingFormatTogether+  "zai" -> pure ThinkingFormatZai+  "qwen" -> pure ThinkingFormatQwen+  "none" -> pure ThinkingFormatNone+  t -> fail $ "unknown thinkingFormat: " <> Text.unpack t++parseCacheControlFormat :: Text -> Parser CacheControlFormat+parseCacheControlFormat = \case+  "anthropic" -> pure CacheControlFormatAnthropic+  t -> fail $ "unknown cacheControlFormat: " <> Text.unpack t++-- | Look up an optional field; missing returns @def@.+optionalField :: Aeson.Object -> Aeson.Key -> (Text -> Parser a) -> a -> Parser a+optionalField o key parser def = do+  mv <- o .:? key+  case mv of+    Nothing -> pure def+    Just v -> parser v++-- | Look up an optional @Maybe@-typed field. JSON @null@ or absence+-- yields @def@; otherwise the value is parsed through @parser@ and+-- wrapped in 'Just'.+optionalMaybeField ::+  Aeson.Object ->+  Aeson.Key ->+  (Text -> Parser a) ->+  Maybe a ->+  Parser (Maybe a)+optionalMaybeField o key parser def = do+  mv <- o .:? key+  case mv of+    Nothing -> pure def+    Just Aeson.Null -> pure Nothing+    Just (Aeson.String t) -> Just <$> parser t+    Just v -> typeMismatch "string or null" v++-- | One model row in a catalog file.+data ModelEntry = ModelEntry+  { entryId :: !Text,+    entryName :: !Text,+    entryReasoning :: !Bool,+    entryInput :: ![InputModality],+    entryCost :: !CostEntry,+    entryContextWindow :: !Natural,+    entryMaxOutputTokens :: !Natural,+    entryEnabled :: !Bool,+    entryCompatOverride :: !(Maybe CatalogCompat)+  }++instance FromJSON ModelEntry where+  parseJSON = Aeson.withObject "ModelEntry" $ \o ->+    ModelEntry+      <$> o .: "id"+      <*> o .: "name"+      <*> o .:? "reasoning" .!= False+      <*> (o .: "input" >>= traverse parseInputModality)+      <*> o .: "cost"+      <*> o .: "contextWindow"+      <*> o .: "maxOutputTokens"+      <*> o .:? "enabled" .!= True+      <*> o .:? "compat"++parseInputModality :: Text -> Parser InputModality+parseInputModality = \case+  "text" -> pure InputText+  "image" -> pure InputImage+  t -> fail $ "unknown input modality: " <> Text.unpack t++-- | Per-million-token cost rates. Parsed as 'Scientific' so the+-- round-trip into 'Rational' produces a small, canonical fraction+-- (@1.5@ -> @3 % 2@) rather than an arbitrary IEEE-754 approximation.+data CostEntry = CostEntry+  { costInput :: !Scientific,+    costOutput :: !Scientific,+    costCacheRead :: !Scientific,+    costCacheWrite :: !Scientific+  }++instance FromJSON CostEntry where+  parseJSON = Aeson.withObject "CostEntry" $ \o ->+    CostEntry+      <$> o .: "input"+      <*> o .: "output"+      <*> o .:? "cacheRead" .!= 0+      <*> o .:? "cacheWrite" .!= 0++-- * Flattening ---------------------------------------------------------++-- | One generated Haskell identifier plus the 'Model'-shaped record+-- it should be rendered as. Keeping these together lets the renderer+-- stay a pure transformation over a flat list.+data GeneratedEntry = GeneratedEntry+  { ident :: !Text,+    modelId :: !Text,+    name :: !Text,+    api :: !Api,+    provider :: !Text,+    baseUrl :: !Text,+    reasoning :: !Bool,+    input :: ![InputModality],+    cost :: !CostEntry,+    contextWindow :: !Natural,+    maxOutputTokens :: !Natural,+    compat :: !CatalogCompat+  }++flattenEntries :: CatalogFile -> [(Text, GeneratedEntry)]+flattenEntries c =+  [ (g.ident, g)+  | m <- models c,+    entryEnabled m,+    let g =+          GeneratedEntry+            { ident =+                sanitizeIdentifier (c.provider <> "_" <> entryId m),+              modelId = entryId m,+              name = entryName m,+              api = c.api,+              provider = c.provider,+              baseUrl = c.baseUrl,+              reasoning = entryReasoning m,+              input = entryInput m,+              cost = entryCost m,+              contextWindow = entryContextWindow m,+              maxOutputTokens = entryMaxOutputTokens m,+              compat =+                case entryCompatOverride m of+                  Just c' -> c'+                  Nothing -> c.compat+            }+  ]++-- | Reject catalogs whose sanitized generated Haskell binding names collide.+-- Without this check, two distinct upstream model ids such as @foo-bar@ and+-- @foo_bar@ would silently render duplicate top-level declarations.+checkIdentifierCollisions :: [(Text, GeneratedEntry)] -> Either Text ()+checkIdentifierCollisions entries =+  case Map.toList collisions of+    [] -> Right ()+    dupes ->+      Left $+        "duplicate generated model identifiers: "+          <> Text.intercalate "; " (map renderCollision dupes)+  where+    grouped =+      Map.fromListWith+        (++)+        [(i, [entry]) | (i, entry) <- entries]+    collisions = Map.filter ((> 1) . length) grouped+    renderCollision (i, es) =+      i+        <> " from "+        <> Text.intercalate ", " (map origin (reverse es))+    origin e = e.provider <> "/" <> e.modelId++-- | Replace any non-identifier character with @_@. Haskell allows+-- letters, digits, underscore, and apostrophe; everything else+-- (slash, dash, dot, colon, ...) becomes an underscore.+sanitizeIdentifier :: Text -> Text+sanitizeIdentifier = Text.map replace+  where+    replace c+      | (c >= 'a' && c <= 'z')+          || (c >= 'A' && c <= 'Z')+          || (c >= '0' && c <= '9')+          || c == '_'+          || c == '\'' =+          c+      | otherwise = '_'++-- * Source rendering --------------------------------------------------++renderModule :: [(Text, GeneratedEntry)] -> Text+renderModule entries =+  Text.unlines $+    dropTrailingEmpty+      ( header+          ++ concatMap (renderEntry . snd) entries+      )+  where+    dropTrailingEmpty = \case+      [] -> []+      xs+        | last xs == "" -> init xs+        | otherwise -> xs++    header =+      [ "-- AUTO-GENERATED by baikai-gen-models. Do not edit by hand.",+        "-- Regenerate with: cabal run baikai-gen-models",+        "{-# LANGUAGE OverloadedStrings #-}",+        "{-# OPTIONS_GHC -Wno-missing-export-lists #-}",+        "{-# OPTIONS_GHC -Wno-unused-imports #-}",+        "",+        "module Baikai.Models.Generated where",+        "",+        "import Baikai.Api (Api (..))",+        "import Baikai.Compat",+        "  ( AnthropicThinkingStyle (..),",+        "    CacheControlFormat (..),",+        "    MaxTokensField (..),",+        "    ThinkingFormat (..),",+        "    defaultAnthropicMessagesCompat,",+        "    defaultOpenAICompletionsCompat,",+        "  )",+        "import Baikai.Model",+        "  ( Compat (..),",+        "    InputModality (..),",+        "    Model,",+        "    ModelCost (..),",+        "    api,",+        "    baseUrl,",+        "    compat,",+        "    contextWindow,",+        "    cost,",+        "    emptyModel,",+        "    headers,",+        "    input,",+        "    maxOutputTokens,",+        "    modelId,",+        "    name,",+        "    provider,",+        "    reasoning,",+        "  )",+        "import Data.Map.Strict qualified as Map",+        "import Data.Ratio ((%))",+        ""+      ]++renderEntry :: GeneratedEntry -> [Text]+renderEntry g =+  [ g.ident <> " :: Model",+    g.ident <> " =",+    "  emptyModel",+    "    { modelId = " <> renderText g.modelId <> ",",+    "      name = " <> renderText g.name <> ",",+    "      api = " <> renderApiCtor g.api <> ",",+    "      provider = " <> renderText g.provider <> ",",+    "      baseUrl = " <> renderText g.baseUrl <> ",",+    "      reasoning = " <> renderBool g.reasoning <> ",",+    "      input = " <> renderInputList g.input <> ",",+    "      cost =",+    renderCost g.cost <> ",",+    "      contextWindow = " <> Text.pack (show g.contextWindow) <> ",",+    "      maxOutputTokens = " <> Text.pack (show g.maxOutputTokens) <> ",",+    "      headers = Map.empty,",+    "      compat = " <> renderCompat g.compat,+    "    }",+    ""+  ]++renderText :: Text -> Text+renderText t =+  "\""+    <> Text.replace "\"" "\\\"" (Text.replace "\\" "\\\\" t)+    <> "\""++renderBool :: Bool -> Text+renderBool True = "True"+renderBool False = "False"++renderInputList :: [InputModality] -> Text+renderInputList ms =+  "[" <> Text.intercalate ", " (map renderInput ms) <> "]"+  where+    renderInput InputText = "InputText"+    renderInput InputImage = "InputImage"++renderApiCtor :: Api -> Text+renderApiCtor = \case+  OpenAIChatCompletions -> "OpenAIChatCompletions"+  AnthropicMessages -> "AnthropicMessages"+  OpenAICompletionsCli -> "OpenAICompletionsCli"+  AnthropicMessagesCli -> "AnthropicMessagesCli"+  Custom t -> "Custom " <> renderText t++renderCost :: CostEntry -> Text+renderCost c =+  Text.intercalate+    "\n"+    [ "        ModelCost",+      "          { inputCost = " <> renderRational (toRational (costInput c)) <> ",",+      "            outputCost = " <> renderRational (toRational (costOutput c)) <> ",",+      "            cacheReadCost = " <> renderRational (toRational (costCacheRead c)) <> ",",+      "            cacheWriteCost = " <> renderRational (toRational (costCacheWrite c)),+      "          }"+    ]++renderRational :: Rational -> Text+renderRational r =+  Text.pack (show (numerator r)) <> " % " <> Text.pack (show (denominator r))++renderCompat :: CatalogCompat -> Text+renderCompat = \case+  CatalogCompatAuto -> "CompatNone"+  CatalogCompatOpenAI c ->+    Text.intercalate+      "\n"+      [ "CompatOpenAICompletions",+        "        defaultOpenAICompletionsCompat",+        "          { maxTokensField = " <> renderMaxTokensField c.maxTokensField <> ",",+        "            supportsStrictMode = " <> renderBool c.supportsStrictMode <> ",",+        "            requiresThinkingAsText = " <> renderBool c.requiresThinkingAsText <> ",",+        "            thinkingFormat = " <> renderThinkingFormat c.thinkingFormat <> ",",+        "            cacheControlFormat = " <> renderMaybeCacheControl c.cacheControlFormat <> ",",+        "            supportsUsageInStreaming = " <> renderBool c.supportsUsageInStreaming <> ",",+        "            supportsLongCacheRetention = " <> renderBool c.supportsLongCacheRetention,+        "          }"+      ]+  CatalogCompatAnthropic c ->+    Text.intercalate+      "\n"+      [ "CompatAnthropicMessages",+        "        defaultAnthropicMessagesCompat",+        "          { supportsLongCacheRetention = " <> renderBool c.supportsLongCacheRetention <> ",",+        "            supportsCacheControlOnTools = " <> renderBool c.supportsCacheControlOnTools <> ",",+        "            sendSessionAffinityHeaders = " <> renderBool c.sendSessionAffinityHeaders <> ",",+        "            thinkingStyle = " <> renderAnthropicThinkingStyle c.thinkingStyle,+        "          }"+      ]++renderMaxTokensField :: MaxTokensField -> Text+renderMaxTokensField = \case+  MaxCompletionTokensField -> "MaxCompletionTokensField"+  MaxTokensField -> "MaxTokensField"++renderThinkingFormat :: ThinkingFormat -> Text+renderThinkingFormat = \case+  ThinkingFormatOpenAI -> "ThinkingFormatOpenAI"+  ThinkingFormatOpenRouter -> "ThinkingFormatOpenRouter"+  ThinkingFormatDeepseek -> "ThinkingFormatDeepseek"+  ThinkingFormatTogether -> "ThinkingFormatTogether"+  ThinkingFormatZai -> "ThinkingFormatZai"+  ThinkingFormatQwen -> "ThinkingFormatQwen"+  ThinkingFormatNone -> "ThinkingFormatNone"++renderAnthropicThinkingStyle :: AnthropicThinkingStyle -> Text+renderAnthropicThinkingStyle = \case+  AnthropicThinkingBudget -> "AnthropicThinkingBudget"+  AnthropicThinkingAdaptive -> "AnthropicThinkingAdaptive"++renderMaybeCacheControl :: Maybe CacheControlFormat -> Text+renderMaybeCacheControl = \case+  Nothing -> "Nothing"+  Just CacheControlFormatAnthropic -> "Just CacheControlFormatAnthropic"

@@ -2,6 +2,18 @@ -- gives a downstream consumer everything needed to declare a -- 'Model', build a 'Context' and 'Options', and dispatch a call -- through the registered handler.+--+-- This umbrella intentionally omits opt-in subsystems with their own+-- vocabularies: tracing, OpenTelemetry sinks, embeddings, call-log+-- plumbing, pricing lookup internals, the generated model catalog, and+-- "Baikai.Prelude". Import those modules directly when you need them.+--+-- Evolvable configuration records expose their type, field selectors,+-- and an @empty*@ or @default*@ base value rather than their data+-- constructor. Build those records by record update so adding fields in+-- a later release does not force source changes. Closed sums and+-- provider-produced payload records remain constructible where callers+-- need to pattern match or build fixtures. module Baikai   ( -- * Types     module Baikai.AgentAssets,

@@ -8,11 +8,13 @@ -- value does not read the environment. module Baikai.Auth   ( ApiKeySource (..),+    defaultApiKeyEnvForBaseUrl,     renderApiKeySourceForDebug,     resolveApiKey,   ) where +import Baikai.Compat (hostMatchesSuffix, urlHost) import Baikai.Error (authError) import Control.Exception (throwIO) import Control.Monad.IO.Class (MonadIO, liftIO)@@ -24,6 +26,7 @@ data ApiKeySource   = ApiKeyLiteral !Text   | ApiKeyEnv !String+  | ApiKeyEnvChain ![String]   deriving stock (Eq)  instance Show ApiKeySource where@@ -39,13 +42,43 @@       [ "source" .= ("env" :: Text),         "name" .= name       ]+  toJSON (ApiKeyEnvChain names) =+    object+      [ "source" .= ("env-chain" :: Text),+        "names" .= names+      ] +-- | Conventional API-key environment variable for a known provider+-- host. Unknown hosts return 'Nothing' so callers can require an+-- explicit 'ApiKeySource' instead of leaking another provider's+-- credential.+defaultApiKeyEnvForBaseUrl :: Text -> Maybe String+defaultApiKeyEnvForBaseUrl baseUrl = do+  host <- urlHost baseUrl+  match host+  where+    match host+      | hostMatchesSuffix host "api.openai.com" = Just "OPENAI_API_KEY"+      | hostMatchesSuffix host "api.deepseek.com" = Just "DEEPSEEK_API_KEY"+      | hostMatchesSuffix host "openrouter.ai" = Just "OPENROUTER_API_KEY"+      | hostMatchesSuffix host "together.xyz" = Just "TOGETHER_API_KEY"+      | hostMatchesSuffix host "together.ai" = Just "TOGETHER_API_KEY"+      | hostMatchesSuffix host "z.ai" = Just "ZAI_API_KEY"+      | hostMatchesSuffix host "dashscope.aliyuncs.com" = Just "DASHSCOPE_API_KEY"+      | hostMatchesSuffix host "dashscope-intl.aliyuncs.com" = Just "DASHSCOPE_API_KEY"+      | hostMatchesSuffix host "qwen.ai" = Just "DASHSCOPE_API_KEY"+      | hostMatchesSuffix host "api.anthropic.com" = Just "ANTHROPIC_API_KEY"+      | hostMatchesSuffix host "fireworks.ai" = Just "FIREWORKS_API_KEY"+      | otherwise = Nothing+ -- | Render a credential source for logs, test failures, and debugging without -- exposing literal secret material. renderApiKeySourceForDebug :: ApiKeySource -> Text renderApiKeySourceForDebug (ApiKeyLiteral _) = "ApiKeyLiteral <redacted>" renderApiKeySourceForDebug (ApiKeyEnv name) =   "ApiKeyEnv " <> Text.pack (show name)+renderApiKeySourceForDebug (ApiKeyEnvChain names) =+  "ApiKeyEnvChain " <> Text.pack (show names)  -- | Resolve a key source to a plain 'Text'. Throws a 'BaikaiError' in the -- 'Baikai.Error.AuthError' category if 'ApiKeyEnv' is used and the named variable@@ -57,3 +90,16 @@     Environment.lookupEnv name >>= \case       Just v -> pure (Text.pack v)       Nothing -> throwIO (authError ("env var " <> Text.pack name <> " is not set"))+resolveApiKey (ApiKeyEnvChain names) =+  liftIO (go names)+  where+    go [] =+      throwIO+        (authError ("none of the env vars " <> renderedNames <> " are set"))+    go (name : rest) =+      Environment.lookupEnv name >>= \case+        Just v -> pure (Text.pack v)+        Nothing -> go rest+    renderedNames = case names of+      [] -> "<empty>"+      _ -> Text.intercalate ", " (Text.pack <$> names)

@@ -14,31 +14,44 @@ -- on a per-'Baikai.Model.Model' record means the same provider -- handler can serve both hosts without any per-host code branching. ----- These record constructors are intentionally public in baikai 0.1.--- They are the supported escape hatch for hand-rolled models and--- generated catalog overrides when a host speaks a familiar protocol--- but rejects or requires a small request-shaping difference. New--- fields or enum constructors may be added in later minor versions as--- new provider quirks are discovered; callers that want fewer upgrade--- edits should start from the @default*@ values and use record updates--- rather than constructing every field from scratch.+-- The records export their field selectors but not their data+-- constructors. They are expected to grow as provider quirks are+-- discovered, so callers should start from the @default*@ values and+-- use record updates for the fields they need to override. -- -- Auto-detection from a 'Baikai.Model.Model' @baseUrl@ provides -- reasonable defaults so callers rarely need to spell out a full -- compat record. module Baikai.Compat   ( -- * OpenAI Chat Completions compat-    OpenAICompletionsCompat (..),+    OpenAICompletionsCompat+      ( maxTokensField,+        supportsStrictMode,+        requiresThinkingAsText,+        thinkingFormat,+        cacheControlFormat,+        supportsUsageInStreaming,+        supportsLongCacheRetention+      ),     defaultOpenAICompletionsCompat,     MaxTokensField (..),     ThinkingFormat (..),     CacheControlFormat (..),      -- * Anthropic Messages compat-    AnthropicMessagesCompat (..),+    AnthropicMessagesCompat+      ( supportsLongCacheRetention,+        supportsCacheControlOnTools,+        sendSessionAffinityHeaders,+        thinkingStyle+      ),+    AnthropicThinkingStyle (..),     defaultAnthropicMessagesCompat,+    defaultAnthropicThinkingStyle,      -- * Auto-detection from baseUrl+    urlHost,+    hostMatchesSuffix,     autoDetectOpenAICompletions,     autoDetectAnthropicMessages,   )@@ -91,6 +104,16 @@   deriving stock (Eq, Show, Generic)   deriving anyclass (FromJSON, ToJSON) +-- | Which request shape an Anthropic-compatible host/model accepts+-- for extended thinking. Budget-era models take+-- @{"type":"enabled","budget_tokens":N}@; adaptive-era models take+-- @{"type":"adaptive"}@ with depth guided by @output_config.effort@.+data AnthropicThinkingStyle+  = AnthropicThinkingBudget+  | AnthropicThinkingAdaptive+  deriving stock (Eq, Show, Generic)+  deriving anyclass (FromJSON, ToJSON)+ -- | Feature flags for one OpenAI-compatible host. -- -- Every flag has a default that reproduces OpenAI's own behaviour —@@ -98,34 +121,45 @@ -- override the differing fields only. data OpenAICompletionsCompat = OpenAICompletionsCompat   { -- | Where the max-output-tokens cap goes in the request body.+    --   Consumed by @Baikai.Provider.OpenAI.Shape.renameMaxTokens@,+    --   which rewrites @max_completion_tokens@ to @max_tokens@+    --   for hosts that require the legacy key.     maxTokensField :: !MaxTokensField,-    -- | Whether the host accepts the @developer@ message role-    --   (OpenAI's o-series) or only @system@.-    supportsDeveloperRole :: !Bool,     -- | Whether the host accepts @strict: true@ on function tool-    --   definitions. Set 'False' to drop the field on hosts that-    --   reject it.+    --   definitions. Consumed by+    --   @Baikai.Provider.OpenAI.Api.mkOpenAIResponseFormat@ and+    --   @Baikai.Provider.OpenAI.Shape.dropUnsupportedStrict@ to+    --   omit JSON-schema @strict@ on hosts that reject it.     supportsStrictMode :: !Bool,     -- | Whether the host smuggles thinking into the assistant text as-    --   @\<thinking\>...\</thinking\>@ markers. When 'True', the-    --   provider's stream transformer extracts those markers into-    --   typed thinking deltas on the way out. (The transformer itself-    --   is wired in by EP-3; EP-5 only flips the switch.)+    --   @\<think\>...\</think\>@ or+    --   @\<thinking\>...\</thinking\>@ markers. Field-based reasoning+    --   extraction (for @reasoning_content@ / @reasoning@ deltas) is+    --   unconditional; this flag enables the incremental tag scanner+    --   in @Baikai.Provider.OpenAI.Api.translateTextLikeDelta@ for+    --   hosts that do not split reasoning into a separate field.     requiresThinkingAsText :: !Bool,     -- | The wire shape the host accepts for reasoning-effort-    --   preferences.+    --   preferences. Consumed by+    --   @Baikai.Provider.OpenAI.Api.applyThinkingFormat@ for the+    --   OpenAI-native field and by+    --   @Baikai.Provider.OpenAI.Shape.injectThinkingShape@ for+    --   OpenAI-compatible host-specific JSON keys.     thinkingFormat :: !ThinkingFormat,     -- | Whether the host accepts Anthropic-style @cache_control@     --   markers (some OpenRouter routes pass them through to an-    --   Anthropic backend).+    --   Anthropic backend). Consumed by+    --   @Baikai.Provider.OpenAI.Shape.injectCacheControl@.     cacheControlFormat :: !(Maybe CacheControlFormat),     -- | Whether the host emits a final @usage@ chunk in streaming-    --   responses. OpenAI does; older OpenAI-compatible servers may-    --   not. Currently advisory.+    --   responses. Consumed by+    --   @Baikai.Provider.OpenAI.Shape.streamRequestBody@ to include+    --   or omit @stream_options.include_usage@.     supportsUsageInStreaming :: !Bool,     -- | Whether the host honours long (1h) cache TTLs through the-    --   Anthropic-style cache_control marker. Currently only relevant-    --   when 'cacheControlFormat' is 'Just CacheControlFormatAnthropic'.+    --   Anthropic-style cache_control marker. Consumed by+    --   @Baikai.Provider.OpenAI.Shape.injectCacheControl@ when+    --   'cacheControlFormat' is 'Just CacheControlFormatAnthropic'.     supportsLongCacheRetention :: !Bool   }   deriving stock (Eq, Show, Generic)@@ -136,7 +170,6 @@ defaultOpenAICompletionsCompat =   OpenAICompletionsCompat     { maxTokensField = MaxCompletionTokensField,-      supportsDeveloperRole = True,       supportsStrictMode = True,       requiresThinkingAsText = False,       thinkingFormat = ThinkingFormatOpenAI,@@ -150,17 +183,24 @@   { -- | Whether the host honours Anthropic's     --   @cache_control.ttl: "1h"@ long-retention marker. When 'False',     --   long-retention preferences silently downgrade to ephemeral.+    --   Consumed by @Baikai.Provider.Claude.Api.computeCacheControl@+    --   for top-level cache markers and by+    --   @Baikai.Provider.Claude.Shape.injectToolCacheControl@ for+    --   tool cache markers.     supportsLongCacheRetention :: !Bool,     -- | Whether tool definitions accept @cache_control@ markers.+    --   Consumed by+    --   @Baikai.Provider.Claude.Shape.injectToolCacheControl@.     --   Anthropic's own host does; some compatible hosts do not.     supportsCacheControlOnTools :: !Bool,-    -- | Whether the host supports per-tool eager input streaming-    --   (Anthropic's @fine-grained-tool-streaming@ beta). Currently-    --   advisory; the SDK does not expose the field directly.-    supportsEagerToolInputStreaming :: !Bool,     -- | Whether to add session-affinity headers on every request-    --   (Fireworks-style routing).-    sendSessionAffinityHeaders :: !Bool+    --   (Fireworks-style routing). Consumed by+    --   @Baikai.Provider.Claude.Transport.requestHeaders@.+    sendSessionAffinityHeaders :: !Bool,+    -- | Which extended-thinking request shape to send for the+    --   selected model generation. Consumed by+    --   @Baikai.Provider.Claude.Api.computeThinking@.+    thinkingStyle :: !AnthropicThinkingStyle   }   deriving stock (Eq, Show, Generic)   deriving anyclass (FromJSON, ToJSON)@@ -171,52 +211,64 @@   AnthropicMessagesCompat     { supportsLongCacheRetention = True,       supportsCacheControlOnTools = True,-      supportsEagerToolInputStreaming = True,-      sendSessionAffinityHeaders = False+      sendSessionAffinityHeaders = False,+      thinkingStyle = AnthropicThinkingBudget     } +-- | The thinking style a first-party Anthropic model id defaults to+-- when the model carries no explicit compat record. Unknown ids+-- default to the budget style used by earlier model generations.+defaultAnthropicThinkingStyle :: Text -> AnthropicThinkingStyle+defaultAnthropicThinkingStyle modelId+  | adaptive "claude-opus-4-6" = AnthropicThinkingAdaptive+  | adaptive "claude-opus-4-7" = AnthropicThinkingAdaptive+  | adaptive "claude-opus-4-8" = AnthropicThinkingAdaptive+  | adaptive "claude-fable-5" = AnthropicThinkingAdaptive+  | otherwise = AnthropicThinkingBudget+  where+    adaptive prefix = prefix `Text.isPrefixOf` modelId+ -- | Pick a sensible compat record for an unknown OpenAI-compatible -- host based on its @baseUrl@. Falls back to -- 'defaultOpenAICompletionsCompat' for hosts the table does not -- recognise. autoDetectOpenAICompletions :: Text -> OpenAICompletionsCompat autoDetectOpenAICompletions url-  | hasInfix "api.openai.com" = defaultOpenAICompletionsCompat-  | hasInfix "api.deepseek.com" =+  | matches "api.openai.com" = defaultOpenAICompletionsCompat+  | matches "api.deepseek.com" =       defaultOpenAICompletionsCompat         { thinkingFormat = ThinkingFormatDeepseek,           requiresThinkingAsText = True,           maxTokensField = MaxTokensField,-          supportsStrictMode = False,-          supportsDeveloperRole = False+          supportsStrictMode = False         }-  | hasInfix "openrouter.ai" =+  | matches "openrouter.ai" =       defaultOpenAICompletionsCompat         { thinkingFormat = ThinkingFormatOpenRouter,           supportsStrictMode = False,-          supportsDeveloperRole = False,           cacheControlFormat = Just CacheControlFormatAnthropic         }-  | hasInfix "together.xyz" || hasInfix "api.together.ai" =+  | matches "together.xyz" || matches "together.ai" =       defaultOpenAICompletionsCompat         { thinkingFormat = ThinkingFormatTogether,-          supportsStrictMode = False,-          supportsDeveloperRole = False+          supportsStrictMode = False         }-  | hasInfix "z.ai" =+  | matches "z.ai" =       defaultOpenAICompletionsCompat         { thinkingFormat = ThinkingFormatZai,           supportsStrictMode = False         }-  | hasInfix "dashscope" || hasInfix "qwen" =+  | matches "dashscope.aliyuncs.com"+      || matches "dashscope-intl.aliyuncs.com"+      || matches "qwen.ai" =       defaultOpenAICompletionsCompat         { thinkingFormat = ThinkingFormatQwen,           supportsStrictMode = False         }   | otherwise = defaultOpenAICompletionsCompat   where-    hasInfix :: Text -> Bool-    hasInfix needle = needle `Text.isInfixOf` url+    host = urlHost url+    matches suffix = maybe False (`hostMatchesSuffix` suffix) host  -- | Pick a sensible compat record for an unknown -- Anthropic-compatible host based on its @baseUrl@. Falls back to@@ -224,8 +276,8 @@ -- recognise. autoDetectAnthropicMessages :: Text -> AnthropicMessagesCompat autoDetectAnthropicMessages url-  | hasInfix "api.anthropic.com" = defaultAnthropicMessagesCompat-  | hasInfix "fireworks.ai" =+  | matches "api.anthropic.com" = defaultAnthropicMessagesCompat+  | matches "fireworks.ai" =       defaultAnthropicMessagesCompat         { supportsCacheControlOnTools = False,           sendSessionAffinityHeaders = True,@@ -233,5 +285,29 @@         }   | otherwise = defaultAnthropicMessagesCompat   where-    hasInfix :: Text -> Bool-    hasInfix needle = needle `Text.isInfixOf` url+    host = urlHost url+    matches suffix = maybe False (`hostMatchesSuffix` suffix) host++-- | Extract a hostname from a URL-ish value. This is intentionally+-- small and total rather than a validating URI parser: it drops an+-- optional scheme, optional userinfo, then stops at '/', ':', '?', or+-- '#'. Empty results return 'Nothing'.+urlHost :: Text -> Maybe Text+urlHost raw =+  let noScheme = case Text.breakOn "://" raw of+        (_, rest) | not (Text.null rest) -> Text.drop 3 rest+        _ -> raw+      noUser = last (Text.splitOn "@" noScheme)+      host = Text.toLower (Text.strip (Text.takeWhile hostChar noUser))+   in if Text.null host then Nothing else Just host+  where+    hostChar c = c /= '/' && c /= ':' && c /= '?' && c /= '#'++-- | Match a hostname against a suffix at a label boundary.+hostMatchesSuffix :: Text -> Text -> Bool+hostMatchesSuffix host suffix =+  let h = Text.toLower (Text.strip host)+      s = Text.toLower (Text.strip suffix)+   in not (Text.null h)+        && not (Text.null s)+        && (h == s || ("." <> s) `Text.isSuffixOf` h)

@@ -28,6 +28,10 @@     ToolResultContent (..),      -- * Smart defaults+    emptyTextContent,+    emptyThinkingContent,+    emptyToolCall,+    emptyImageContent,     _TextContent,     _ThinkingContent,     _ToolCall,@@ -70,7 +74,9 @@ -- provider; it must be threaded back into the next request unchanged for -- the model to resume from the same state. @redacted@ is 'True' when the -- provider hid the underlying content (Anthropic flags this when its--- safety system removes a thinking block from the wire response).+-- safety system removes a thinking block from the wire response). When+-- @redacted@ is 'True', @thinking@ holds the provider's opaque encrypted+-- payload verbatim; callers must not display or edit it. data ThinkingContent = ThinkingContent   { thinking :: !Text,     signature :: !(Maybe Text),@@ -116,27 +122,27 @@   | ToolResultImage !ImageContent   deriving stock (Eq, Show, Generic) -_TextContent :: TextContent-_TextContent = TextContent {text = Text.empty}+emptyTextContent :: TextContent+emptyTextContent = TextContent {text = Text.empty} -_ThinkingContent :: ThinkingContent-_ThinkingContent =+emptyThinkingContent :: ThinkingContent+emptyThinkingContent =   ThinkingContent     { thinking = Text.empty,       signature = Nothing,       redacted = False     } -_ToolCall :: ToolCall-_ToolCall =+emptyToolCall :: ToolCall+emptyToolCall =   ToolCall     { id_ = Text.empty,       name = Text.empty,       arguments = Null     } -_ImageContent :: ImageContent-_ImageContent =+emptyImageContent :: ImageContent+emptyImageContent =   ImageContent     { imageData = BS.empty,       mimeType = Text.empty@@ -210,3 +216,19 @@  instance ToJSON ToolResultContent where   toJSON = genericToJSON contentSumOptions++{-# DEPRECATED _TextContent "Use emptyTextContent instead." #-}+_TextContent :: TextContent+_TextContent = emptyTextContent++{-# DEPRECATED _ThinkingContent "Use emptyThinkingContent instead." #-}+_ThinkingContent :: ThinkingContent+_ThinkingContent = emptyThinkingContent++{-# DEPRECATED _ToolCall "Use emptyToolCall instead." #-}+_ToolCall :: ToolCall+_ToolCall = emptyToolCall++{-# DEPRECATED _ImageContent "Use emptyImageContent instead." #-}+_ImageContent :: ImageContent+_ImageContent = emptyImageContent

@@ -14,17 +14,27 @@ -- referenced by the @tools@ field, so 'Baikai.Tool' cannot itself -- depend on 'Context'). module Baikai.Context-  ( Context (..),+  ( Context,+    systemPrompt,+    messages,+    tools,+    emptyContext,     _Context,+    contextOf,+    systemUser,+    addUser,+    addMessage,+    addResponse,     appendToolResult,     appendToolResultText,   ) where  import Baikai.Content (AssistantContent (..), ToolCall (..))-import Baikai.Message (Message (..), ToolResult, toolResultFromCallNow, toolResultText)+import Baikai.Message (Message (..), ToolResult, toolResultFromCallNow, toolResultText, user) import Baikai.Response (Response (..), responseMessage) import Baikai.Tool (Tool)+import Control.Applicative ((<|>)) import Control.Lens ((&), (.~), (^.)) import Data.Aeson (ToJSON) import Data.Generics.Labels ()@@ -41,14 +51,51 @@   deriving stock (Eq, Show, Generic)   deriving anyclass (ToJSON) -_Context :: Context-_Context =+emptyContext :: Context+emptyContext =   Context     { systemPrompt = Nothing,       messages = V.empty,       tools = V.empty     } +instance Semigroup Context where+  a <> b =+    Context+      { systemPrompt = systemPrompt a <|> systemPrompt b,+        messages = messages a <> messages b,+        tools = tools a <> tools b+      }++instance Monoid Context where+  mempty = emptyContext++-- | Build a context from an existing list of messages.+contextOf :: [Message] -> Context+contextOf msgs =+  emptyContext {messages = V.fromList msgs}++-- | Build a context with a system prompt and one user message.+systemUser :: Text -> Text -> Context+systemUser sys prompt =+  emptyContext+    { systemPrompt = Just sys,+      messages = V.singleton (user prompt)+    }++-- | Append a one-text-block user message.+addUser :: Text -> Context -> Context+addUser t = addMessage (user t)++-- | Append a message to the conversation.+addMessage :: Message -> Context -> Context+addMessage msg ctx =+  ctx {messages = V.snoc (messages ctx) msg}++-- | Append a provider response as an assistant message.+addResponse :: Response -> Context -> Context+addResponse resp = addMessage (responseMessage resp)+ -- | Execute every 'AssistantToolCall' in @resp@'s message via the -- caller-supplied dispatcher, then append the assistant message and -- one 'Baikai.Message.ToolResultMessage' per call to @ctx@. The@@ -92,3 +139,7 @@   IO Context appendToolResultText ctx resp dispatcher =   appendToolResult ctx resp (fmap toolResultText . dispatcher)++{-# DEPRECATED _Context "Use emptyContext instead." #-}+_Context :: Context+_Context = emptyContext

@@ -1,6 +1,8 @@ module Baikai.Cost   ( Cost (..),     CostBreakdown (..),+    zeroCost,+    zeroCostBreakdown,     _Cost,     _CostBreakdown,     usdAsScientific,@@ -25,8 +27,8 @@   }   deriving stock (Eq, Show, Generic) -_CostBreakdown :: CostBreakdown-_CostBreakdown =+zeroCostBreakdown :: CostBreakdown+zeroCostBreakdown =   CostBreakdown     { inputUsd = 0,       outputUsd = 0,@@ -34,8 +36,8 @@       cachedWriteUsd = 0     } -_Cost :: Cost-_Cost = Cost {usd = 0, breakdown = _CostBreakdown}+zeroCost :: Cost+zeroCost = Cost {usd = 0, breakdown = zeroCostBreakdown}  -- Field-wise combination so callers can total per-call costs with -- '(<>)'/'mconcat'. 'mempty' reuses the existing zero value, so the@@ -51,13 +53,13 @@       }  instance Monoid CostBreakdown where-  mempty = _CostBreakdown+  mempty = zeroCostBreakdown  instance Semigroup Cost where   a <> b = Cost {usd = usd a + usd b, breakdown = breakdown a <> breakdown b}  instance Monoid Cost where-  mempty = _Cost+  mempty = zeroCost  instance ToJSON CostBreakdown where   toJSON cb =@@ -80,3 +82,11 @@  ratToSci :: Rational -> Scientific ratToSci = fst . fromRationalRepetendUnlimited++{-# DEPRECATED _CostBreakdown "Use zeroCostBreakdown instead." #-}+_CostBreakdown :: CostBreakdown+_CostBreakdown = zeroCostBreakdown++{-# DEPRECATED _Cost "Use zeroCost instead." #-}+_Cost :: Cost+_Cost = zeroCost

@@ -11,6 +11,10 @@ -- > withCallLog (CallLogConfig "/tmp/baikai.jsonl" True) $ \h -> do -- >   _ <- runRequestWithLog h model context options -- >   pure ()+--+-- If the worker cannot open or write the log file, the close path+-- reports one warning on stderr and returns. Logging failures do not+-- mask the request body or hang release actions. module Baikai.Cost.Log   ( CallLogConfig (..),     CallLogEntry (..),@@ -45,8 +49,9 @@ import Control.Concurrent (forkIO) import Control.Concurrent.Chan (Chan, newChan, readChan, writeChan) import Control.Concurrent.MVar (MVar, newEmptyMVar, putMVar, takeMVar)-import Control.Exception (bracket)+import Control.Exception (SomeException, bracket, displayException, try) import Control.Lens ((^.))+import Control.Monad (forM_) import Control.Monad.IO.Class (MonadIO, liftIO) import Control.Monad.IO.Unlift (MonadUnliftIO, withRunInIO) import Data.Aeson (FromJSON, ToJSON)@@ -55,6 +60,7 @@ import Data.Foldable (find) import Data.Function ((&)) import Data.Generics.Labels ()+import Data.IORef (IORef, newIORef, readIORef, writeIORef) import Data.Scientific (Scientific) import Data.Text (Text) import Data.Text qualified as Text@@ -64,7 +70,7 @@ import Numeric.Natural (Natural) import Streamly.Data.Fold qualified as Fold import Streamly.Data.Stream qualified as Stream-import System.IO (BufferMode (LineBuffering), IOMode (AppendMode), hSetBuffering, withFile)+import System.IO (BufferMode (LineBuffering), IOMode (AppendMode), hPutStrLn, hSetBuffering, stderr, withFile)  -- | Where (and whether) to write the call log. data CallLogConfig = CallLogConfig@@ -85,7 +91,7 @@     cachedInputTokens :: !(Maybe Natural),     reasoningTokens :: !(Maybe Natural),     usd :: !(Maybe Scientific),-    latencyMs :: !Integer,+    latencyMs :: !Int,     promptSummary :: !Text   }   deriving stock (Eq, Show, Generic)@@ -95,7 +101,8 @@ data CallLogHandle = CallLogHandle   { chan :: !(Chan (Maybe CallLogEntry)),     done :: !(MVar ()),-    cfg :: !CallLogConfig+    cfg :: !CallLogConfig,+    workerError :: !(IORef (Maybe SomeException))   }  -- | Open a handle. When @enabled = True@, fork the worker thread@@ -104,12 +111,13 @@ openCallLog c = liftIO $ do   ch <- newChan   d <- newEmptyMVar+  e <- newIORef Nothing   case enabled c of     False -> putMVar d ()     True -> do-      _ <- forkIO (worker (path c) ch d)+      _ <- forkIO (worker (path c) ch d e)       pure ()-  pure CallLogHandle {chan = ch, done = d, cfg = c}+  pure CallLogHandle {chan = ch, done = d, cfg = c, workerError = e}  -- | Signal shutdown and block until the worker has drained every -- pending entry to disk.@@ -119,6 +127,11 @@     True -> writeChan (chan h) Nothing     False -> pure ()   takeMVar (done h)+  merr <- readIORef (workerError h)+  forM_ merr $ \e ->+    hPutStrLn+      stderr+      ("baikai: call log worker failed; pending entries were dropped: " <> displayException e)  -- | Bracketed lifetime: open the handle, run the body, close -- exactly once on every path (including exceptions).@@ -185,20 +198,26 @@  -- | Worker loop: pull 'Maybe CallLogEntry' off the channel, drain -- through a streamly fold that writes each entry as one JSON line.-worker :: FilePath -> Chan (Maybe CallLogEntry) -> MVar () -> IO ()-worker p ch d =-  withFile p AppendMode $ \fh -> do-    hSetBuffering fh LineBuffering-    let step :: () -> IO (Maybe (CallLogEntry, ()))-        step () = do-          msg <- readChan ch-          case msg of-            Nothing -> pure Nothing-            Just e -> pure (Just (e, ()))-    Stream.unfoldrM step ()-      & Stream.fold (Fold.drainMapM (writeEntry fh))-    putMVar d ()+worker :: FilePath -> Chan (Maybe CallLogEntry) -> MVar () -> IORef (Maybe SomeException) -> IO ()+worker p ch d errRef = do+  result <- try drainToFile :: IO (Either SomeException ())+  case result of+    Left e -> writeIORef errRef (Just e)+    Right () -> pure ()+  putMVar d ()   where+    drainToFile =+      withFile p AppendMode $ \fh -> do+        hSetBuffering fh LineBuffering+        let step :: () -> IO (Maybe (CallLogEntry, ()))+            step () = do+              msg <- readChan ch+              case msg of+                Nothing -> pure Nothing+                Just e -> pure (Just (e, ()))+        Stream.unfoldrM step ()+          & Stream.fold (Fold.drainMapM (writeEntry fh))+     writeEntry fh entry =       BSL.hPut fh (Aeson.encode entry <> "\n") 

@@ -4,7 +4,7 @@ -- Pricing rates live on 'Baikai.Model.Model.cost' directly, so the -- computation collapses to a record-field access. Models without -- published pricing carry a zero 'Baikai.Model.ModelCost' (the--- default in '_Model'), producing a zero 'Cost'.+-- default in 'emptyModel'), producing a zero 'Cost'. module Baikai.Cost.Pricing   ( computeCost,     attachCost,

@@ -16,15 +16,19 @@ -- for embeddings. module Baikai.Embedding   ( EmbeddingModel (..),+    emptyEmbeddingModel,     _EmbeddingModel,     openAIEmbeddingModel,     mkEmbeddingRequest,+    firstEmbedding,     embed,     embedOne,   ) where  import Baikai.Auth (ApiKeySource (..), resolveApiKey)+import Baikai.Error (BaikaiError, decodeError)+import Control.Exception (throwIO) import Data.Text (Text) import Data.Vector (Vector) import Data.Vector qualified as V@@ -48,8 +52,8 @@  -- | A blank embedding model; a record-update target for hand-built models. Keyed -- on @OPENAI_API_KEY@ by default.-_EmbeddingModel :: EmbeddingModel-_EmbeddingModel =+emptyEmbeddingModel :: EmbeddingModel+emptyEmbeddingModel =   EmbeddingModel     { modelId = "",       baseUrl = "",@@ -61,7 +65,7 @@ -- dimensionality. openAIEmbeddingModel :: Text -> EmbeddingModel openAIEmbeddingModel mid =-  _EmbeddingModel+  emptyEmbeddingModel     { modelId = mid,       baseUrl = "https://api.openai.com",       dimensions = Nothing,@@ -78,6 +82,18 @@       Emb.dimensions = dimensions m     } +-- | Extract the first embedding vector from an SDK response. OpenAI's+-- embeddings endpoint normally returns one item per input, but a malformed or+-- compatible endpoint can return an empty @data@ array. Treat that as a typed+-- decode failure instead of indexing the empty vector.+firstEmbedding :: Vector Emb.EmbeddingObject -> Either BaikaiError (Vector Double)+firstEmbedding objs =+  case V.uncons objs of+    Nothing ->+      Left (decodeError "embeddings response contained no data")+    Just (obj, _) ->+      Right (Emb.embedding obj)+ -- | Embed a batch of texts: one vector per input text, in input order. The SDK's -- @CreateEmbeddings.input@ is a single 'Text', so this loops one call per text. The -- transport exception (a Servant client error) is let propagate — error remapping@@ -92,14 +108,22 @@   where     embedText create t = do       objs <- create (mkEmbeddingRequest m t)-      pure (Emb.embedding (V.head objs))+      either throwIO pure (firstEmbedding objs)  -- | Embed a single text. embedOne :: EmbeddingModel -> Text -> IO (Vector Double)-embedOne m t = V.head <$> embed m [t]+embedOne m t = do+  vs <- embed m [t]+  case V.uncons vs of+    Just (v, _) -> pure v+    Nothing -> throwIO (decodeError "embedding batch unexpectedly returned no vectors")  -- | Substitute the OpenAI default for an empty base URL (as the chat provider does). urlOf :: EmbeddingModel -> Text urlOf m = case baseUrl m of   "" -> "https://api.openai.com"   u -> u++{-# DEPRECATED _EmbeddingModel "Use emptyEmbeddingModel instead." #-}+_EmbeddingModel :: EmbeddingModel+_EmbeddingModel = emptyEmbeddingModel

@@ -15,6 +15,8 @@     isRetryable,      -- * Pure classification helpers for provider packages+    httpError,+    parseRetryAfterSeconds,     classifyHttpStatus,     classifyHttpStatusWithBody,     bodyIndicatesOverflow,@@ -34,6 +36,7 @@ import Data.Text (Text) import Data.Text qualified as Text import GHC.Generics (Generic)+import Text.Read (readMaybe)  -- | A provider-neutral category for a failed call. Callers switch on -- this to decide policy (retry, surface to user, abort). The set is@@ -162,6 +165,28 @@   RateLimited -> True   TransientError -> True   _ -> False++-- | Parse an integer-valued @Retry-After@ header as seconds. HTTP-date+-- values and malformed values yield 'Nothing'.+parseRetryAfterSeconds :: Text -> Maybe Int+parseRetryAfterSeconds raw = do+  n <- readMaybe (Text.unpack (Text.strip raw))+  if n >= 0 then Just n else Nothing++-- | Build a classified error from an HTTP failure's status, optional+-- parsed @Retry-After@ seconds, and response body text.+httpError :: Int -> Maybe Int -> Text -> BaikaiError+httpError status retryAfter body =+  (baseError (classifyHttpStatusWithBody status retryAfter body) msg)+    { httpStatus = Just status,+      retryAfterSeconds = retryAfter+    }+  where+    snippet = Text.take 300 body+    msg =+      "HTTP "+        <> Text.pack (show status)+        <> if Text.null snippet then "" else ": " <> snippet  -- | Map an HTTP status code (and an optional already-parsed -- retry-after-seconds value) to a category. Pure and network-free so it

@@ -7,11 +7,20 @@ module Baikai.Interactive   ( InteractiveProvider (..),     InteractiveScope (..),-    InteractiveLaunchRequest (..),+    InteractiveLaunchRequest,+    systemPrompt,+    userPrompt,+    modelId,+    workingDir,+    extraDirs,+    safety,+    extraArgs,     InteractiveSafety (..),     CodexSandboxMode (..),     CodexApprovalPolicy (..),     InteractiveLaunchResult (..),+    interactiveLaunchRequest,+    interactiveLaunchResult,     _InteractiveLaunchRequest,     _InteractiveLaunchResult,     renderInteractiveProvider,@@ -43,7 +52,7 @@ data InteractiveLaunchRequest = InteractiveLaunchRequest   { systemPrompt :: !(Maybe Text),     userPrompt :: !Text,-    model :: !(Maybe Text),+    modelId :: !(Maybe Text),     workingDir :: !(Maybe FilePath),     extraDirs :: ![FilePath],     safety :: !InteractiveSafety,@@ -80,24 +89,32 @@   }   deriving stock (Eq, Show, Generic) -_InteractiveLaunchRequest :: Text -> InteractiveLaunchRequest-_InteractiveLaunchRequest prompt =+interactiveLaunchRequest :: Text -> InteractiveLaunchRequest+interactiveLaunchRequest prompt =   InteractiveLaunchRequest     { systemPrompt = Nothing,       userPrompt = prompt,-      model = Nothing,+      modelId = Nothing,       workingDir = Nothing,       extraDirs = [],       safety = DefaultSafety,       extraArgs = []     } -_InteractiveLaunchResult :: InteractiveProvider -> ExitCode -> InteractiveLaunchResult-_InteractiveLaunchResult p code =+interactiveLaunchResult :: InteractiveProvider -> ExitCode -> InteractiveLaunchResult+interactiveLaunchResult p code =   InteractiveLaunchResult     { provider = p,       exitCode = code     }++{-# DEPRECATED _InteractiveLaunchRequest "Use interactiveLaunchRequest instead." #-}+_InteractiveLaunchRequest :: Text -> InteractiveLaunchRequest+_InteractiveLaunchRequest = interactiveLaunchRequest++{-# DEPRECATED _InteractiveLaunchResult "Use interactiveLaunchResult instead." #-}+_InteractiveLaunchResult :: InteractiveProvider -> ExitCode -> InteractiveLaunchResult+_InteractiveLaunchResult = interactiveLaunchResult  renderInteractiveProvider :: InteractiveProvider -> Text renderInteractiveProvider InteractiveClaude = "claude"

@@ -3,17 +3,17 @@ -- A 'Message' is one of three constructors: -- -- * 'UserMessage' — caller input, carrying a 'UserPayload' (its---   'content' is a vector of text and inline image blocks, plus a---   creation timestamp).+--   'content' is a vector of text and inline image blocks, plus an+--   optional creation timestamp). -- * 'AssistantMessage' — model output, carrying an 'AssistantPayload' --   (its 'content' holds 'AssistantText', 'AssistantThinking', and --   'AssistantToolCall' blocks, alongside the call's 'Usage' (which now --   embeds 'Cost' in-place), the 'StopReason' the model reported, an---   optional 'errorMessage', and a timestamp).+--   optional 'errorMessage', and an optional timestamp). -- * 'ToolResultMessage' — caller-supplied output for a model-issued --   tool call, carrying a 'ToolResultPayload' (the tool-call id it --   answers, the tool's name, the result 'content' (text or image), an---   'isError' flag, and a timestamp).+--   'isError' flag, and an optional timestamp). -- -- The 'system' constructor from prior versions is removed: system -- prompts live on 'Baikai.Request.Request.systemPrompt'. The 'Role'@@ -70,7 +70,7 @@     UserContent (..),   ) import Baikai.StopReason (StopReason (..))-import Baikai.Usage (Usage, _Usage)+import Baikai.Usage (Usage, zeroUsage) import Data.Aeson (ToJSON) import Data.Text (Text) import Data.Time (UTCTime, getCurrentTime)@@ -85,11 +85,11 @@   deriving stock (Eq, Show, Generic)   deriving anyclass (ToJSON) --- | Caller input: a vector of text and inline image blocks plus a--- creation timestamp.+-- | Caller input: a vector of text and inline image blocks plus an+-- optional creation timestamp. data UserPayload = UserPayload   { content :: !(Vector UserContent),-    timestamp :: !UTCTime+    timestamp :: !(Maybe UTCTime)   }   deriving stock (Eq, Show, Generic)   deriving anyclass (ToJSON)@@ -97,26 +97,28 @@ -- | Model output: the assistant content blocks ('AssistantText', -- 'AssistantThinking', 'AssistantToolCall'), the call's 'Usage' (which -- embeds 'Cost' in-place), the reported 'StopReason', an optional--- 'errorMessage', and a creation timestamp.+-- 'errorMessage' (failure text or a non-fatal provider diagnostic;+-- use 'stopReason'/'Response.errorInfo' to detect failures), and a+-- optional creation timestamp. data AssistantPayload = AssistantPayload   { content :: !(Vector AssistantContent),     usage :: !Usage,     stopReason :: !StopReason,     errorMessage :: !(Maybe Text),-    timestamp :: !UTCTime+    timestamp :: !(Maybe UTCTime)   }   deriving stock (Eq, Show, Generic)   deriving anyclass (ToJSON)  -- | Caller-supplied output for a model-issued tool call: the tool-call -- id it answers, the tool's name, the result 'content' (text or--- image), an 'isError' flag, and a creation timestamp.+-- image), an 'isError' flag, and an optional creation timestamp. data ToolResultPayload = ToolResultPayload   { toolCallId :: !Text,     toolName :: !Text,     content :: !(Vector ToolResultContent),     isError :: !Bool,-    timestamp :: !UTCTime+    timestamp :: !(Maybe UTCTime)   }   deriving stock (Eq, Show, Generic)   deriving anyclass (ToJSON)@@ -134,14 +136,16 @@   deriving stock (Eq, Show, Generic)   deriving anyclass (ToJSON) -defaultTimestamp :: UTCTime-defaultTimestamp = read "2000-01-01 00:00:00 UTC"---- | Build a one-text-block user message with a deterministic fixture--- timestamp. Prefer 'userAt' when the timestamp matters, or 'userNow'--- when the timestamp should be sampled in 'IO'.+-- | Build a one-text-block user message without recording a timestamp.+-- Prefer 'userAt' when the timestamp matters, or 'userNow' when the+-- timestamp should be sampled in 'IO'. user :: Text -> Message-user = userAt defaultTimestamp+user t =+  UserMessage+    UserPayload+      { content = V.singleton (UserText (TextContent t)),+        timestamp = Nothing+      }  -- | Build a one-text-block user message at an explicit timestamp. userAt :: UTCTime -> Text -> Message@@ -149,7 +153,7 @@   UserMessage     UserPayload       { content = V.singleton (UserText (TextContent t)),-        timestamp = ts+        timestamp = Just ts       }  -- | Build a one-text-block user message using the current time.@@ -159,9 +163,17 @@   pure (userAt now t)  -- | Build a user message carrying one inline image alongside optional--- preceding text, using a deterministic fixture timestamp.+-- preceding text, without recording a timestamp. userImage :: ImageContent -> Maybe Text -> Message-userImage = userImageAt defaultTimestamp+userImage img mPrefix =+  let prefix = case mPrefix of+        Nothing -> V.empty+        Just t -> V.singleton (UserText (TextContent t))+   in UserMessage+        UserPayload+          { content = prefix <> V.singleton (UserImage img),+            timestamp = Nothing+          }  -- | Build a user image message at an explicit timestamp. Bytes are -- stored decoded; the JSON encoding base64-encodes them on the wire.@@ -173,7 +185,7 @@    in UserMessage         UserPayload           { content = prefix <> V.singleton (UserImage img),-            timestamp = ts+            timestamp = Just ts           }  -- | Build a user image message using the current time.@@ -182,10 +194,18 @@   now <- getCurrentTime   pure (userImageAt now img mPrefix) --- | Build a one-text-block assistant message with zero usage and a--- @stop@ stop reason, using a deterministic fixture timestamp.+-- | Build a one-text-block assistant message with zero usage, a @stop@+-- stop reason, and no recorded timestamp. assistant :: Text -> Message-assistant = assistantAt defaultTimestamp+assistant t =+  AssistantMessage+    AssistantPayload+      { content = V.singleton (AssistantText (TextContent t)),+        usage = zeroUsage,+        stopReason = Stop,+        errorMessage = Nothing,+        timestamp = Nothing+      }  -- | Build a one-text-block assistant message at an explicit timestamp. assistantAt :: UTCTime -> Text -> Message@@ -193,10 +213,10 @@   AssistantMessage     AssistantPayload       { content = V.singleton (AssistantText (TextContent t)),-        usage = _Usage,+        usage = zeroUsage,         stopReason = Stop,         errorMessage = Nothing,-        timestamp = ts+        timestamp = Just ts       }  -- | Build a one-text-block assistant message using the current time.@@ -206,10 +226,17 @@   pure (assistantAt now t)  -- | Build a tool-result message answering a prior 'AssistantToolCall'--- using rich content blocks and a deterministic fixture timestamp.+-- using rich content blocks, without recording a timestamp. toolResultMessage :: Text -> Text -> ToolResult -> Message-toolResultMessage callId name =-  toolResultMessageAt defaultTimestamp callId name+toolResultMessage callId name ToolResult {content = blocks, isError = err} =+  ToolResultMessage+    ToolResultPayload+      { toolCallId = callId,+        toolName = name,+        content = blocks,+        isError = err,+        timestamp = Nothing+      }  -- | Build a tool-result message at an explicit timestamp. toolResultMessageAt :: UTCTime -> Text -> Text -> ToolResult -> Message@@ -220,7 +247,7 @@         toolName = name,         content = blocks,         isError = err,-        timestamp = ts+        timestamp = Just ts       }  -- | Build a tool-result message using the current time.@@ -251,7 +278,14 @@ -- when the result has multiple blocks or image content. toolResult :: Text -> Text -> Text -> Bool -> Message toolResult callId name body err =-  toolResultAt defaultTimestamp callId name body err+  toolResultMessage+    callId+    name+    ( ToolResult+        { content = V.singleton (ToolResultText (TextContent body)),+          isError = err+        }+    )  -- | Build a one-text-block tool-result message at an explicit timestamp. toolResultAt :: UTCTime -> Text -> Text -> Text -> Bool -> Message

@@ -7,16 +7,30 @@ -- placeholder until EP-5 populates the real shims). -- -- The previous newtype @Model = Model Text@ — a thin tag for the--- model id — is retired. The 'unModel' accessor is preserved as a--- convenience until callers fully migrate to 'modelId'.+-- model id — is retired. Use 'modelId' to read the selected upstream+-- model identifier, or 'mkModel' to build a dispatchable record. module Baikai.Model   ( -- * Model-    Model (..),+    Model,+    modelId,+    name,+    api,+    provider,+    baseUrl,+    reasoning,+    input,+    cost,+    contextWindow,+    maxOutputTokens,+    headers,+    compat,+    emptyModel,     _Model,-    unModel,+    mkModel,      -- * Cost rates     ModelCost (..),+    zeroModelCost,     _ModelCost,      -- * Capabilities@@ -29,12 +43,13 @@   ) where -import Baikai.Api (Api (..))+import Baikai.Api (Api (..), renderApi) import Baikai.Compat-  ( AnthropicMessagesCompat,+  ( AnthropicMessagesCompat (..),     OpenAICompletionsCompat,     autoDetectAnthropicMessages,     autoDetectOpenAICompletions,+    defaultAnthropicThinkingStyle,   ) import Data.Aeson (FromJSON, ToJSON) import Data.Map.Strict (Map)@@ -90,7 +105,10 @@ anthropicMessagesCompatFor :: Model -> AnthropicMessagesCompat anthropicMessagesCompatFor m = case compat m of   CompatAnthropicMessages c -> c-  _ -> autoDetectAnthropicMessages (baseUrl m)+  _ ->+    (autoDetectAnthropicMessages (baseUrl m))+      { thinkingStyle = defaultAnthropicThinkingStyle (modelId m)+      }  -- | The data record baikai dispatches on. data Model = Model@@ -110,15 +128,10 @@   deriving stock (Eq, Show, Generic)   deriving anyclass (FromJSON, ToJSON) --- | The model id as 'Text'. Kept for ergonomic access from call--- sites that previously held a newtype-wrapped 'Text'.-unModel :: Model -> Text-unModel = modelId- -- | A zero 'ModelCost' across all rates. Useful as a default for -- models without published pricing (CLI providers, custom hosts).-_ModelCost :: ModelCost-_ModelCost =+zeroModelCost :: ModelCost+zeroModelCost =   ModelCost     { inputCost = 0,       outputCost = 0,@@ -128,8 +141,8 @@  -- | A blank 'Model'. Useful as a record-update base for hand-rolled -- 'Model' values in tests and one-shot scripts.-_Model :: Model-_Model =+emptyModel :: Model+emptyModel =   Model     { modelId = "",       name = "",@@ -138,9 +151,31 @@       baseUrl = "",       reasoning = False,       input = [InputText],-      cost = _ModelCost,+      cost = zeroModelCost,       contextWindow = 0,       maxOutputTokens = 0,       headers = Map.empty,       compat = CompatNone     }++-- | Build a dispatchable 'Model' from its three discriminators: the+-- 'Api' tag used for handler lookup, the upstream model id, and the+-- base URL. 'name' defaults to the model id, 'provider' defaults to+-- 'renderApi' of the tag, and all other fields come from 'emptyModel'.+mkModel :: Api -> Text -> Text -> Model+mkModel apiTag modelId_ baseUrl_ =+  emptyModel+    { modelId = modelId_,+      name = modelId_,+      api = apiTag,+      provider = renderApi apiTag,+      baseUrl = baseUrl_+    }++{-# DEPRECATED _ModelCost "Use zeroModelCost instead." #-}+_ModelCost :: ModelCost+_ModelCost = zeroModelCost++{-# DEPRECATED _Model "Use emptyModel instead." #-}+_Model :: Model+_Model = emptyModel

@@ -8,678 +8,721 @@  import Baikai.Api (Api (..)) import Baikai.Compat-  ( AnthropicMessagesCompat (..)-  , CacheControlFormat (..)-  , MaxTokensField (..)-  , OpenAICompletionsCompat (..)-  , ThinkingFormat (..)-  )-import Baikai.Model-  ( Compat (..)-  , InputModality (..)-  , Model (..)-  , ModelCost (..)-  )-import Data.Map.Strict qualified as Map-import Data.Ratio ((%))--anthropic_claude_fable_5 :: Model-anthropic_claude_fable_5 =-  Model-    { modelId = "claude-fable-5"-    , name = "Claude Fable 5"-    , api = AnthropicMessages-    , provider = "anthropic"-    , baseUrl = "https://api.anthropic.com"-    , reasoning = True-    , input = [InputText, InputImage]-    , cost = ModelCost-        { inputCost = 10 % 1-        , outputCost = 50 % 1-        , cacheReadCost = 1 % 1-        , cacheWriteCost = 25 % 2-        }-    , contextWindow = 1000000-    , maxOutputTokens = 128000-    , headers = Map.empty-    , compat = CompatNone-    }--anthropic_claude_haiku_4_5 :: Model-anthropic_claude_haiku_4_5 =-  Model-    { modelId = "claude-haiku-4-5"-    , name = "Claude Haiku 4.5"-    , api = AnthropicMessages-    , provider = "anthropic"-    , baseUrl = "https://api.anthropic.com"-    , reasoning = True-    , input = [InputText, InputImage]-    , cost = ModelCost-        { inputCost = 1 % 1-        , outputCost = 5 % 1-        , cacheReadCost = 1 % 10-        , cacheWriteCost = 5 % 4-        }-    , contextWindow = 200000-    , maxOutputTokens = 64000-    , headers = Map.empty-    , compat = CompatNone-    }--anthropic_claude_opus_4_5 :: Model-anthropic_claude_opus_4_5 =-  Model-    { modelId = "claude-opus-4-5"-    , name = "Claude Opus 4.5"-    , api = AnthropicMessages-    , provider = "anthropic"-    , baseUrl = "https://api.anthropic.com"-    , reasoning = True-    , input = [InputText, InputImage]-    , cost = ModelCost-        { inputCost = 5 % 1-        , outputCost = 25 % 1-        , cacheReadCost = 1 % 2-        , cacheWriteCost = 25 % 4-        }-    , contextWindow = 200000-    , maxOutputTokens = 64000-    , headers = Map.empty-    , compat = CompatNone-    }--anthropic_claude_opus_4_6 :: Model-anthropic_claude_opus_4_6 =-  Model-    { modelId = "claude-opus-4-6"-    , name = "Claude Opus 4.6"-    , api = AnthropicMessages-    , provider = "anthropic"-    , baseUrl = "https://api.anthropic.com"-    , reasoning = True-    , input = [InputText, InputImage]-    , cost = ModelCost-        { inputCost = 5 % 1-        , outputCost = 25 % 1-        , cacheReadCost = 1 % 2-        , cacheWriteCost = 25 % 4-        }-    , contextWindow = 1000000-    , maxOutputTokens = 128000-    , headers = Map.empty-    , compat = CompatNone-    }--anthropic_claude_opus_4_7 :: Model-anthropic_claude_opus_4_7 =-  Model-    { modelId = "claude-opus-4-7"-    , name = "Claude Opus 4.7"-    , api = AnthropicMessages-    , provider = "anthropic"-    , baseUrl = "https://api.anthropic.com"-    , reasoning = True-    , input = [InputText, InputImage]-    , cost = ModelCost-        { inputCost = 5 % 1-        , outputCost = 25 % 1-        , cacheReadCost = 1 % 2-        , cacheWriteCost = 25 % 4-        }-    , contextWindow = 1000000-    , maxOutputTokens = 128000-    , headers = Map.empty-    , compat = CompatNone-    }--anthropic_claude_opus_4_8 :: Model-anthropic_claude_opus_4_8 =-  Model-    { modelId = "claude-opus-4-8"-    , name = "Claude Opus 4.8"-    , api = AnthropicMessages-    , provider = "anthropic"-    , baseUrl = "https://api.anthropic.com"-    , reasoning = True-    , input = [InputText, InputImage]-    , cost = ModelCost-        { inputCost = 5 % 1-        , outputCost = 25 % 1-        , cacheReadCost = 1 % 2-        , cacheWriteCost = 25 % 4-        }-    , contextWindow = 1000000-    , maxOutputTokens = 128000-    , headers = Map.empty-    , compat = CompatNone-    }--anthropic_claude_sonnet_4_5 :: Model-anthropic_claude_sonnet_4_5 =-  Model-    { modelId = "claude-sonnet-4-5"-    , name = "Claude Sonnet 4.5"-    , api = AnthropicMessages-    , provider = "anthropic"-    , baseUrl = "https://api.anthropic.com"-    , reasoning = True-    , input = [InputText, InputImage]-    , cost = ModelCost-        { inputCost = 3 % 1-        , outputCost = 15 % 1-        , cacheReadCost = 3 % 10-        , cacheWriteCost = 15 % 4-        }-    , contextWindow = 200000-    , maxOutputTokens = 64000-    , headers = Map.empty-    , compat = CompatNone-    }--anthropic_claude_sonnet_4_6 :: Model-anthropic_claude_sonnet_4_6 =-  Model-    { modelId = "claude-sonnet-4-6"-    , name = "Claude Sonnet 4.6"-    , api = AnthropicMessages-    , provider = "anthropic"-    , baseUrl = "https://api.anthropic.com"-    , reasoning = True-    , input = [InputText, InputImage]-    , cost = ModelCost-        { inputCost = 3 % 1-        , outputCost = 15 % 1-        , cacheReadCost = 3 % 10-        , cacheWriteCost = 15 % 4-        }-    , contextWindow = 1000000-    , maxOutputTokens = 64000-    , headers = Map.empty-    , compat = CompatNone-    }--deepseek_deepseek_chat :: Model-deepseek_deepseek_chat =-  Model-    { modelId = "deepseek-chat"-    , name = "DeepSeek Chat"-    , api = OpenAIChatCompletions-    , provider = "deepseek"-    , baseUrl = "https://api.deepseek.com"-    , reasoning = False-    , input = [InputText]-    , cost = ModelCost-        { inputCost = 27 % 100-        , outputCost = 11 % 10-        , cacheReadCost = 7 % 100-        , cacheWriteCost = 0 % 1-        }-    , contextWindow = 64000-    , maxOutputTokens = 8192-    , headers = Map.empty-    , compat = CompatNone-    }--deepseek_deepseek_reasoner :: Model-deepseek_deepseek_reasoner =-  Model-    { modelId = "deepseek-reasoner"-    , name = "DeepSeek Reasoner"-    , api = OpenAIChatCompletions-    , provider = "deepseek"-    , baseUrl = "https://api.deepseek.com"-    , reasoning = True-    , input = [InputText]-    , cost = ModelCost-        { inputCost = 11 % 20-        , outputCost = 219 % 100-        , cacheReadCost = 7 % 50-        , cacheWriteCost = 0 % 1-        }-    , contextWindow = 64000-    , maxOutputTokens = 8192-    , headers = Map.empty-    , compat = CompatNone-    }--openai_gpt_4_1 :: Model-openai_gpt_4_1 =-  Model-    { modelId = "gpt-4.1"-    , name = "GPT-4.1"-    , api = OpenAIChatCompletions-    , provider = "openai"-    , baseUrl = "https://api.openai.com"-    , reasoning = False-    , input = [InputText, InputImage]-    , cost = ModelCost-        { inputCost = 2 % 1-        , outputCost = 8 % 1-        , cacheReadCost = 1 % 2-        , cacheWriteCost = 0 % 1-        }-    , contextWindow = 1047576-    , maxOutputTokens = 32768-    , headers = Map.empty-    , compat = CompatNone-    }--openai_gpt_4_1_mini :: Model-openai_gpt_4_1_mini =-  Model-    { modelId = "gpt-4.1-mini"-    , name = "GPT-4.1 mini"-    , api = OpenAIChatCompletions-    , provider = "openai"-    , baseUrl = "https://api.openai.com"-    , reasoning = False-    , input = [InputText, InputImage]-    , cost = ModelCost-        { inputCost = 2 % 5-        , outputCost = 8 % 5-        , cacheReadCost = 1 % 10-        , cacheWriteCost = 0 % 1-        }-    , contextWindow = 1047576-    , maxOutputTokens = 32768-    , headers = Map.empty-    , compat = CompatNone-    }--openai_gpt_4_1_nano :: Model-openai_gpt_4_1_nano =-  Model-    { modelId = "gpt-4.1-nano"-    , name = "GPT-4.1 nano"-    , api = OpenAIChatCompletions-    , provider = "openai"-    , baseUrl = "https://api.openai.com"-    , reasoning = False-    , input = [InputText, InputImage]-    , cost = ModelCost-        { inputCost = 1 % 10-        , outputCost = 2 % 5-        , cacheReadCost = 1 % 40-        , cacheWriteCost = 0 % 1-        }-    , contextWindow = 1047576-    , maxOutputTokens = 32768-    , headers = Map.empty-    , compat = CompatNone-    }--openai_gpt_4o :: Model-openai_gpt_4o =-  Model-    { modelId = "gpt-4o"-    , name = "GPT-4o"-    , api = OpenAIChatCompletions-    , provider = "openai"-    , baseUrl = "https://api.openai.com"-    , reasoning = False-    , input = [InputText, InputImage]-    , cost = ModelCost-        { inputCost = 5 % 2-        , outputCost = 10 % 1-        , cacheReadCost = 5 % 4-        , cacheWriteCost = 0 % 1-        }-    , contextWindow = 128000-    , maxOutputTokens = 16384-    , headers = Map.empty-    , compat = CompatNone-    }--openai_gpt_4o_mini :: Model-openai_gpt_4o_mini =-  Model-    { modelId = "gpt-4o-mini"-    , name = "GPT-4o mini"-    , api = OpenAIChatCompletions-    , provider = "openai"-    , baseUrl = "https://api.openai.com"-    , reasoning = False-    , input = [InputText, InputImage]-    , cost = ModelCost-        { inputCost = 3 % 20-        , outputCost = 3 % 5-        , cacheReadCost = 3 % 40-        , cacheWriteCost = 0 % 1-        }-    , contextWindow = 128000-    , maxOutputTokens = 16384-    , headers = Map.empty-    , compat = CompatNone-    }--openai_gpt_5 :: Model-openai_gpt_5 =-  Model-    { modelId = "gpt-5"-    , name = "GPT-5"-    , api = OpenAIChatCompletions-    , provider = "openai"-    , baseUrl = "https://api.openai.com"-    , reasoning = True-    , input = [InputText, InputImage]-    , cost = ModelCost-        { inputCost = 5 % 4-        , outputCost = 10 % 1-        , cacheReadCost = 1 % 8-        , cacheWriteCost = 0 % 1-        }-    , contextWindow = 400000-    , maxOutputTokens = 128000-    , headers = Map.empty-    , compat = CompatNone-    }--openai_gpt_5_1 :: Model-openai_gpt_5_1 =-  Model-    { modelId = "gpt-5.1"-    , name = "GPT-5.1"-    , api = OpenAIChatCompletions-    , provider = "openai"-    , baseUrl = "https://api.openai.com"-    , reasoning = True-    , input = [InputText, InputImage]-    , cost = ModelCost-        { inputCost = 5 % 4-        , outputCost = 10 % 1-        , cacheReadCost = 1 % 8-        , cacheWriteCost = 0 % 1-        }-    , contextWindow = 400000-    , maxOutputTokens = 128000-    , headers = Map.empty-    , compat = CompatNone-    }--openai_gpt_5_2 :: Model-openai_gpt_5_2 =-  Model-    { modelId = "gpt-5.2"-    , name = "GPT-5.2"-    , api = OpenAIChatCompletions-    , provider = "openai"-    , baseUrl = "https://api.openai.com"-    , reasoning = True-    , input = [InputText, InputImage]-    , cost = ModelCost-        { inputCost = 7 % 4-        , outputCost = 14 % 1-        , cacheReadCost = 7 % 40-        , cacheWriteCost = 0 % 1-        }-    , contextWindow = 400000-    , maxOutputTokens = 128000-    , headers = Map.empty-    , compat = CompatNone-    }--openai_gpt_5_4 :: Model-openai_gpt_5_4 =-  Model-    { modelId = "gpt-5.4"-    , name = "GPT-5.4"-    , api = OpenAIChatCompletions-    , provider = "openai"-    , baseUrl = "https://api.openai.com"-    , reasoning = True-    , input = [InputText, InputImage]-    , cost = ModelCost-        { inputCost = 5 % 2-        , outputCost = 15 % 1-        , cacheReadCost = 1 % 4-        , cacheWriteCost = 0 % 1-        }-    , contextWindow = 1050000-    , maxOutputTokens = 128000-    , headers = Map.empty-    , compat = CompatNone-    }--openai_gpt_5_4_mini :: Model-openai_gpt_5_4_mini =-  Model-    { modelId = "gpt-5.4-mini"-    , name = "GPT-5.4 mini"-    , api = OpenAIChatCompletions-    , provider = "openai"-    , baseUrl = "https://api.openai.com"-    , reasoning = True-    , input = [InputText, InputImage]-    , cost = ModelCost-        { inputCost = 3 % 4-        , outputCost = 9 % 2-        , cacheReadCost = 3 % 40-        , cacheWriteCost = 0 % 1-        }-    , contextWindow = 400000-    , maxOutputTokens = 128000-    , headers = Map.empty-    , compat = CompatNone-    }--openai_gpt_5_4_nano :: Model-openai_gpt_5_4_nano =-  Model-    { modelId = "gpt-5.4-nano"-    , name = "GPT-5.4 nano"-    , api = OpenAIChatCompletions-    , provider = "openai"-    , baseUrl = "https://api.openai.com"-    , reasoning = True-    , input = [InputText, InputImage]-    , cost = ModelCost-        { inputCost = 1 % 5-        , outputCost = 5 % 4-        , cacheReadCost = 1 % 50-        , cacheWriteCost = 0 % 1-        }-    , contextWindow = 400000-    , maxOutputTokens = 128000-    , headers = Map.empty-    , compat = CompatNone-    }--openai_gpt_5_5 :: Model-openai_gpt_5_5 =-  Model-    { modelId = "gpt-5.5"-    , name = "GPT-5.5"-    , api = OpenAIChatCompletions-    , provider = "openai"-    , baseUrl = "https://api.openai.com"-    , reasoning = True-    , input = [InputText, InputImage]-    , cost = ModelCost-        { inputCost = 5 % 1-        , outputCost = 30 % 1-        , cacheReadCost = 1 % 2-        , cacheWriteCost = 0 % 1-        }-    , contextWindow = 1050000-    , maxOutputTokens = 128000-    , headers = Map.empty-    , compat = CompatNone-    }--openai_gpt_5_mini :: Model-openai_gpt_5_mini =-  Model-    { modelId = "gpt-5-mini"-    , name = "GPT-5 Mini"-    , api = OpenAIChatCompletions-    , provider = "openai"-    , baseUrl = "https://api.openai.com"-    , reasoning = True-    , input = [InputText, InputImage]-    , cost = ModelCost-        { inputCost = 1 % 4-        , outputCost = 2 % 1-        , cacheReadCost = 1 % 40-        , cacheWriteCost = 0 % 1-        }-    , contextWindow = 400000-    , maxOutputTokens = 128000-    , headers = Map.empty-    , compat = CompatNone-    }--openai_gpt_5_nano :: Model-openai_gpt_5_nano =-  Model-    { modelId = "gpt-5-nano"-    , name = "GPT-5 Nano"-    , api = OpenAIChatCompletions-    , provider = "openai"-    , baseUrl = "https://api.openai.com"-    , reasoning = True-    , input = [InputText, InputImage]-    , cost = ModelCost-        { inputCost = 1 % 20-        , outputCost = 2 % 5-        , cacheReadCost = 1 % 200-        , cacheWriteCost = 0 % 1-        }-    , contextWindow = 400000-    , maxOutputTokens = 128000-    , headers = Map.empty-    , compat = CompatNone-    }--openai_o1 :: Model-openai_o1 =-  Model-    { modelId = "o1"-    , name = "o1"-    , api = OpenAIChatCompletions-    , provider = "openai"-    , baseUrl = "https://api.openai.com"-    , reasoning = True-    , input = [InputText, InputImage]-    , cost = ModelCost-        { inputCost = 15 % 1-        , outputCost = 60 % 1-        , cacheReadCost = 15 % 2-        , cacheWriteCost = 0 % 1-        }-    , contextWindow = 200000-    , maxOutputTokens = 100000-    , headers = Map.empty-    , compat = CompatNone-    }--openai_o3 :: Model-openai_o3 =-  Model-    { modelId = "o3"-    , name = "o3"-    , api = OpenAIChatCompletions-    , provider = "openai"-    , baseUrl = "https://api.openai.com"-    , reasoning = True-    , input = [InputText, InputImage]-    , cost = ModelCost-        { inputCost = 2 % 1-        , outputCost = 8 % 1-        , cacheReadCost = 1 % 2-        , cacheWriteCost = 0 % 1-        }-    , contextWindow = 200000-    , maxOutputTokens = 100000-    , headers = Map.empty-    , compat = CompatNone-    }--openai_o3_mini :: Model-openai_o3_mini =-  Model-    { modelId = "o3-mini"-    , name = "o3-mini"-    , api = OpenAIChatCompletions-    , provider = "openai"-    , baseUrl = "https://api.openai.com"-    , reasoning = True-    , input = [InputText]-    , cost = ModelCost-        { inputCost = 11 % 10-        , outputCost = 22 % 5-        , cacheReadCost = 11 % 20-        , cacheWriteCost = 0 % 1-        }-    , contextWindow = 200000-    , maxOutputTokens = 100000-    , headers = Map.empty-    , compat = CompatNone-    }--openai_o4_mini :: Model-openai_o4_mini =-  Model-    { modelId = "o4-mini"-    , name = "o4-mini"-    , api = OpenAIChatCompletions-    , provider = "openai"-    , baseUrl = "https://api.openai.com"-    , reasoning = True-    , input = [InputText, InputImage]-    , cost = ModelCost-        { inputCost = 11 % 10-        , outputCost = 22 % 5-        , cacheReadCost = 11 % 40-        , cacheWriteCost = 0 % 1-        }-    , contextWindow = 200000-    , maxOutputTokens = 100000-    , headers = Map.empty-    , compat = CompatNone-    }--openrouter_anthropic_claude_sonnet_4 :: Model-openrouter_anthropic_claude_sonnet_4 =-  Model-    { modelId = "anthropic/claude-sonnet-4"-    , name = "Claude Sonnet 4 via OpenRouter"-    , api = OpenAIChatCompletions-    , provider = "openrouter"-    , baseUrl = "https://openrouter.ai/api"-    , reasoning = False-    , input = [InputText, InputImage]-    , cost = ModelCost-        { inputCost = 3 % 1-        , outputCost = 15 % 1-        , cacheReadCost = 3 % 10-        , cacheWriteCost = 15 % 4-        }-    , contextWindow = 200000-    , maxOutputTokens = 8192-    , headers = Map.empty-    , compat = CompatNone-    }--openrouter_openai_gpt_4o_mini :: Model-openrouter_openai_gpt_4o_mini =-  Model-    { modelId = "openai/gpt-4o-mini"-    , name = "GPT-4o mini via OpenRouter"-    , api = OpenAIChatCompletions-    , provider = "openrouter"-    , baseUrl = "https://openrouter.ai/api"-    , reasoning = False-    , input = [InputText, InputImage]-    , cost = ModelCost-        { inputCost = 3 % 20-        , outputCost = 3 % 5-        , cacheReadCost = 3 % 40-        , cacheWriteCost = 0 % 1-        }-    , contextWindow = 128000-    , maxOutputTokens = 16384-    , headers = Map.empty-    , compat = CompatNone-    }-+  ( AnthropicThinkingStyle (..),+    CacheControlFormat (..),+    MaxTokensField (..),+    ThinkingFormat (..),+    defaultAnthropicMessagesCompat,+    defaultOpenAICompletionsCompat,+  )+import Baikai.Model+  ( Compat (..),+    InputModality (..),+    Model,+    ModelCost (..),+    api,+    baseUrl,+    compat,+    contextWindow,+    cost,+    emptyModel,+    headers,+    input,+    maxOutputTokens,+    modelId,+    name,+    provider,+    reasoning,+  )+import Data.Map.Strict qualified as Map+import Data.Ratio ((%))++anthropic_claude_fable_5 :: Model+anthropic_claude_fable_5 =+  emptyModel+    { modelId = "claude-fable-5",+      name = "Claude Fable 5",+      api = AnthropicMessages,+      provider = "anthropic",+      baseUrl = "https://api.anthropic.com",+      reasoning = True,+      input = [InputText, InputImage],+      cost =+        ModelCost+          { inputCost = 10 % 1,+            outputCost = 50 % 1,+            cacheReadCost = 1 % 1,+            cacheWriteCost = 25 % 2+          },+      contextWindow = 1000000,+      maxOutputTokens = 128000,+      headers = Map.empty,+      compat = CompatNone+    }++anthropic_claude_haiku_4_5 :: Model+anthropic_claude_haiku_4_5 =+  emptyModel+    { modelId = "claude-haiku-4-5",+      name = "Claude Haiku 4.5",+      api = AnthropicMessages,+      provider = "anthropic",+      baseUrl = "https://api.anthropic.com",+      reasoning = True,+      input = [InputText, InputImage],+      cost =+        ModelCost+          { inputCost = 1 % 1,+            outputCost = 5 % 1,+            cacheReadCost = 1 % 10,+            cacheWriteCost = 5 % 4+          },+      contextWindow = 200000,+      maxOutputTokens = 64000,+      headers = Map.empty,+      compat = CompatNone+    }++anthropic_claude_opus_4_5 :: Model+anthropic_claude_opus_4_5 =+  emptyModel+    { modelId = "claude-opus-4-5",+      name = "Claude Opus 4.5",+      api = AnthropicMessages,+      provider = "anthropic",+      baseUrl = "https://api.anthropic.com",+      reasoning = True,+      input = [InputText, InputImage],+      cost =+        ModelCost+          { inputCost = 5 % 1,+            outputCost = 25 % 1,+            cacheReadCost = 1 % 2,+            cacheWriteCost = 25 % 4+          },+      contextWindow = 200000,+      maxOutputTokens = 64000,+      headers = Map.empty,+      compat = CompatNone+    }++anthropic_claude_opus_4_6 :: Model+anthropic_claude_opus_4_6 =+  emptyModel+    { modelId = "claude-opus-4-6",+      name = "Claude Opus 4.6",+      api = AnthropicMessages,+      provider = "anthropic",+      baseUrl = "https://api.anthropic.com",+      reasoning = True,+      input = [InputText, InputImage],+      cost =+        ModelCost+          { inputCost = 5 % 1,+            outputCost = 25 % 1,+            cacheReadCost = 1 % 2,+            cacheWriteCost = 25 % 4+          },+      contextWindow = 1000000,+      maxOutputTokens = 128000,+      headers = Map.empty,+      compat = CompatNone+    }++anthropic_claude_opus_4_7 :: Model+anthropic_claude_opus_4_7 =+  emptyModel+    { modelId = "claude-opus-4-7",+      name = "Claude Opus 4.7",+      api = AnthropicMessages,+      provider = "anthropic",+      baseUrl = "https://api.anthropic.com",+      reasoning = True,+      input = [InputText, InputImage],+      cost =+        ModelCost+          { inputCost = 5 % 1,+            outputCost = 25 % 1,+            cacheReadCost = 1 % 2,+            cacheWriteCost = 25 % 4+          },+      contextWindow = 1000000,+      maxOutputTokens = 128000,+      headers = Map.empty,+      compat = CompatNone+    }++anthropic_claude_opus_4_8 :: Model+anthropic_claude_opus_4_8 =+  emptyModel+    { modelId = "claude-opus-4-8",+      name = "Claude Opus 4.8",+      api = AnthropicMessages,+      provider = "anthropic",+      baseUrl = "https://api.anthropic.com",+      reasoning = True,+      input = [InputText, InputImage],+      cost =+        ModelCost+          { inputCost = 5 % 1,+            outputCost = 25 % 1,+            cacheReadCost = 1 % 2,+            cacheWriteCost = 25 % 4+          },+      contextWindow = 1000000,+      maxOutputTokens = 128000,+      headers = Map.empty,+      compat = CompatNone+    }++anthropic_claude_sonnet_4_5 :: Model+anthropic_claude_sonnet_4_5 =+  emptyModel+    { modelId = "claude-sonnet-4-5",+      name = "Claude Sonnet 4.5",+      api = AnthropicMessages,+      provider = "anthropic",+      baseUrl = "https://api.anthropic.com",+      reasoning = True,+      input = [InputText, InputImage],+      cost =+        ModelCost+          { inputCost = 3 % 1,+            outputCost = 15 % 1,+            cacheReadCost = 3 % 10,+            cacheWriteCost = 15 % 4+          },+      contextWindow = 200000,+      maxOutputTokens = 64000,+      headers = Map.empty,+      compat = CompatNone+    }++anthropic_claude_sonnet_4_6 :: Model+anthropic_claude_sonnet_4_6 =+  emptyModel+    { modelId = "claude-sonnet-4-6",+      name = "Claude Sonnet 4.6",+      api = AnthropicMessages,+      provider = "anthropic",+      baseUrl = "https://api.anthropic.com",+      reasoning = True,+      input = [InputText, InputImage],+      cost =+        ModelCost+          { inputCost = 3 % 1,+            outputCost = 15 % 1,+            cacheReadCost = 3 % 10,+            cacheWriteCost = 15 % 4+          },+      contextWindow = 1000000,+      maxOutputTokens = 64000,+      headers = Map.empty,+      compat = CompatNone+    }++deepseek_deepseek_chat :: Model+deepseek_deepseek_chat =+  emptyModel+    { modelId = "deepseek-chat",+      name = "DeepSeek Chat",+      api = OpenAIChatCompletions,+      provider = "deepseek",+      baseUrl = "https://api.deepseek.com",+      reasoning = False,+      input = [InputText],+      cost =+        ModelCost+          { inputCost = 27 % 100,+            outputCost = 11 % 10,+            cacheReadCost = 7 % 100,+            cacheWriteCost = 0 % 1+          },+      contextWindow = 64000,+      maxOutputTokens = 8192,+      headers = Map.empty,+      compat = CompatNone+    }++deepseek_deepseek_reasoner :: Model+deepseek_deepseek_reasoner =+  emptyModel+    { modelId = "deepseek-reasoner",+      name = "DeepSeek Reasoner",+      api = OpenAIChatCompletions,+      provider = "deepseek",+      baseUrl = "https://api.deepseek.com",+      reasoning = True,+      input = [InputText],+      cost =+        ModelCost+          { inputCost = 11 % 20,+            outputCost = 219 % 100,+            cacheReadCost = 7 % 50,+            cacheWriteCost = 0 % 1+          },+      contextWindow = 64000,+      maxOutputTokens = 8192,+      headers = Map.empty,+      compat = CompatNone+    }++openai_gpt_4_1 :: Model+openai_gpt_4_1 =+  emptyModel+    { modelId = "gpt-4.1",+      name = "GPT-4.1",+      api = OpenAIChatCompletions,+      provider = "openai",+      baseUrl = "https://api.openai.com",+      reasoning = False,+      input = [InputText, InputImage],+      cost =+        ModelCost+          { inputCost = 2 % 1,+            outputCost = 8 % 1,+            cacheReadCost = 1 % 2,+            cacheWriteCost = 0 % 1+          },+      contextWindow = 1047576,+      maxOutputTokens = 32768,+      headers = Map.empty,+      compat = CompatNone+    }++openai_gpt_4_1_mini :: Model+openai_gpt_4_1_mini =+  emptyModel+    { modelId = "gpt-4.1-mini",+      name = "GPT-4.1 mini",+      api = OpenAIChatCompletions,+      provider = "openai",+      baseUrl = "https://api.openai.com",+      reasoning = False,+      input = [InputText, InputImage],+      cost =+        ModelCost+          { inputCost = 2 % 5,+            outputCost = 8 % 5,+            cacheReadCost = 1 % 10,+            cacheWriteCost = 0 % 1+          },+      contextWindow = 1047576,+      maxOutputTokens = 32768,+      headers = Map.empty,+      compat = CompatNone+    }++openai_gpt_4_1_nano :: Model+openai_gpt_4_1_nano =+  emptyModel+    { modelId = "gpt-4.1-nano",+      name = "GPT-4.1 nano",+      api = OpenAIChatCompletions,+      provider = "openai",+      baseUrl = "https://api.openai.com",+      reasoning = False,+      input = [InputText, InputImage],+      cost =+        ModelCost+          { inputCost = 1 % 10,+            outputCost = 2 % 5,+            cacheReadCost = 1 % 40,+            cacheWriteCost = 0 % 1+          },+      contextWindow = 1047576,+      maxOutputTokens = 32768,+      headers = Map.empty,+      compat = CompatNone+    }++openai_gpt_4o :: Model+openai_gpt_4o =+  emptyModel+    { modelId = "gpt-4o",+      name = "GPT-4o",+      api = OpenAIChatCompletions,+      provider = "openai",+      baseUrl = "https://api.openai.com",+      reasoning = False,+      input = [InputText, InputImage],+      cost =+        ModelCost+          { inputCost = 5 % 2,+            outputCost = 10 % 1,+            cacheReadCost = 5 % 4,+            cacheWriteCost = 0 % 1+          },+      contextWindow = 128000,+      maxOutputTokens = 16384,+      headers = Map.empty,+      compat = CompatNone+    }++openai_gpt_4o_mini :: Model+openai_gpt_4o_mini =+  emptyModel+    { modelId = "gpt-4o-mini",+      name = "GPT-4o mini",+      api = OpenAIChatCompletions,+      provider = "openai",+      baseUrl = "https://api.openai.com",+      reasoning = False,+      input = [InputText, InputImage],+      cost =+        ModelCost+          { inputCost = 3 % 20,+            outputCost = 3 % 5,+            cacheReadCost = 3 % 40,+            cacheWriteCost = 0 % 1+          },+      contextWindow = 128000,+      maxOutputTokens = 16384,+      headers = Map.empty,+      compat = CompatNone+    }++openai_gpt_5 :: Model+openai_gpt_5 =+  emptyModel+    { modelId = "gpt-5",+      name = "GPT-5",+      api = OpenAIChatCompletions,+      provider = "openai",+      baseUrl = "https://api.openai.com",+      reasoning = True,+      input = [InputText, InputImage],+      cost =+        ModelCost+          { inputCost = 5 % 4,+            outputCost = 10 % 1,+            cacheReadCost = 1 % 8,+            cacheWriteCost = 0 % 1+          },+      contextWindow = 400000,+      maxOutputTokens = 128000,+      headers = Map.empty,+      compat = CompatNone+    }++openai_gpt_5_1 :: Model+openai_gpt_5_1 =+  emptyModel+    { modelId = "gpt-5.1",+      name = "GPT-5.1",+      api = OpenAIChatCompletions,+      provider = "openai",+      baseUrl = "https://api.openai.com",+      reasoning = True,+      input = [InputText, InputImage],+      cost =+        ModelCost+          { inputCost = 5 % 4,+            outputCost = 10 % 1,+            cacheReadCost = 1 % 8,+            cacheWriteCost = 0 % 1+          },+      contextWindow = 400000,+      maxOutputTokens = 128000,+      headers = Map.empty,+      compat = CompatNone+    }++openai_gpt_5_2 :: Model+openai_gpt_5_2 =+  emptyModel+    { modelId = "gpt-5.2",+      name = "GPT-5.2",+      api = OpenAIChatCompletions,+      provider = "openai",+      baseUrl = "https://api.openai.com",+      reasoning = True,+      input = [InputText, InputImage],+      cost =+        ModelCost+          { inputCost = 7 % 4,+            outputCost = 14 % 1,+            cacheReadCost = 7 % 40,+            cacheWriteCost = 0 % 1+          },+      contextWindow = 400000,+      maxOutputTokens = 128000,+      headers = Map.empty,+      compat = CompatNone+    }++openai_gpt_5_4 :: Model+openai_gpt_5_4 =+  emptyModel+    { modelId = "gpt-5.4",+      name = "GPT-5.4",+      api = OpenAIChatCompletions,+      provider = "openai",+      baseUrl = "https://api.openai.com",+      reasoning = True,+      input = [InputText, InputImage],+      cost =+        ModelCost+          { inputCost = 5 % 2,+            outputCost = 15 % 1,+            cacheReadCost = 1 % 4,+            cacheWriteCost = 0 % 1+          },+      contextWindow = 1050000,+      maxOutputTokens = 128000,+      headers = Map.empty,+      compat = CompatNone+    }++openai_gpt_5_4_mini :: Model+openai_gpt_5_4_mini =+  emptyModel+    { modelId = "gpt-5.4-mini",+      name = "GPT-5.4 mini",+      api = OpenAIChatCompletions,+      provider = "openai",+      baseUrl = "https://api.openai.com",+      reasoning = True,+      input = [InputText, InputImage],+      cost =+        ModelCost+          { inputCost = 3 % 4,+            outputCost = 9 % 2,+            cacheReadCost = 3 % 40,+            cacheWriteCost = 0 % 1+          },+      contextWindow = 400000,+      maxOutputTokens = 128000,+      headers = Map.empty,+      compat = CompatNone+    }++openai_gpt_5_4_nano :: Model+openai_gpt_5_4_nano =+  emptyModel+    { modelId = "gpt-5.4-nano",+      name = "GPT-5.4 nano",+      api = OpenAIChatCompletions,+      provider = "openai",+      baseUrl = "https://api.openai.com",+      reasoning = True,+      input = [InputText, InputImage],+      cost =+        ModelCost+          { inputCost = 1 % 5,+            outputCost = 5 % 4,+            cacheReadCost = 1 % 50,+            cacheWriteCost = 0 % 1+          },+      contextWindow = 400000,+      maxOutputTokens = 128000,+      headers = Map.empty,+      compat = CompatNone+    }++openai_gpt_5_5 :: Model+openai_gpt_5_5 =+  emptyModel+    { modelId = "gpt-5.5",+      name = "GPT-5.5",+      api = OpenAIChatCompletions,+      provider = "openai",+      baseUrl = "https://api.openai.com",+      reasoning = True,+      input = [InputText, InputImage],+      cost =+        ModelCost+          { inputCost = 5 % 1,+            outputCost = 30 % 1,+            cacheReadCost = 1 % 2,+            cacheWriteCost = 0 % 1+          },+      contextWindow = 1050000,+      maxOutputTokens = 128000,+      headers = Map.empty,+      compat = CompatNone+    }++openai_gpt_5_mini :: Model+openai_gpt_5_mini =+  emptyModel+    { modelId = "gpt-5-mini",+      name = "GPT-5 Mini",+      api = OpenAIChatCompletions,+      provider = "openai",+      baseUrl = "https://api.openai.com",+      reasoning = True,+      input = [InputText, InputImage],+      cost =+        ModelCost+          { inputCost = 1 % 4,+            outputCost = 2 % 1,+            cacheReadCost = 1 % 40,+            cacheWriteCost = 0 % 1+          },+      contextWindow = 400000,+      maxOutputTokens = 128000,+      headers = Map.empty,+      compat = CompatNone+    }++openai_gpt_5_nano :: Model+openai_gpt_5_nano =+  emptyModel+    { modelId = "gpt-5-nano",+      name = "GPT-5 Nano",+      api = OpenAIChatCompletions,+      provider = "openai",+      baseUrl = "https://api.openai.com",+      reasoning = True,+      input = [InputText, InputImage],+      cost =+        ModelCost+          { inputCost = 1 % 20,+            outputCost = 2 % 5,+            cacheReadCost = 1 % 200,+            cacheWriteCost = 0 % 1+          },+      contextWindow = 400000,+      maxOutputTokens = 128000,+      headers = Map.empty,+      compat = CompatNone+    }++openai_o1 :: Model+openai_o1 =+  emptyModel+    { modelId = "o1",+      name = "o1",+      api = OpenAIChatCompletions,+      provider = "openai",+      baseUrl = "https://api.openai.com",+      reasoning = True,+      input = [InputText, InputImage],+      cost =+        ModelCost+          { inputCost = 15 % 1,+            outputCost = 60 % 1,+            cacheReadCost = 15 % 2,+            cacheWriteCost = 0 % 1+          },+      contextWindow = 200000,+      maxOutputTokens = 100000,+      headers = Map.empty,+      compat = CompatNone+    }++openai_o3 :: Model+openai_o3 =+  emptyModel+    { modelId = "o3",+      name = "o3",+      api = OpenAIChatCompletions,+      provider = "openai",+      baseUrl = "https://api.openai.com",+      reasoning = True,+      input = [InputText, InputImage],+      cost =+        ModelCost+          { inputCost = 2 % 1,+            outputCost = 8 % 1,+            cacheReadCost = 1 % 2,+            cacheWriteCost = 0 % 1+          },+      contextWindow = 200000,+      maxOutputTokens = 100000,+      headers = Map.empty,+      compat = CompatNone+    }++openai_o3_mini :: Model+openai_o3_mini =+  emptyModel+    { modelId = "o3-mini",+      name = "o3-mini",+      api = OpenAIChatCompletions,+      provider = "openai",+      baseUrl = "https://api.openai.com",+      reasoning = True,+      input = [InputText],+      cost =+        ModelCost+          { inputCost = 11 % 10,+            outputCost = 22 % 5,+            cacheReadCost = 11 % 20,+            cacheWriteCost = 0 % 1+          },+      contextWindow = 200000,+      maxOutputTokens = 100000,+      headers = Map.empty,+      compat = CompatNone+    }++openai_o4_mini :: Model+openai_o4_mini =+  emptyModel+    { modelId = "o4-mini",+      name = "o4-mini",+      api = OpenAIChatCompletions,+      provider = "openai",+      baseUrl = "https://api.openai.com",+      reasoning = True,+      input = [InputText, InputImage],+      cost =+        ModelCost+          { inputCost = 11 % 10,+            outputCost = 22 % 5,+            cacheReadCost = 11 % 40,+            cacheWriteCost = 0 % 1+          },+      contextWindow = 200000,+      maxOutputTokens = 100000,+      headers = Map.empty,+      compat = CompatNone+    }++openrouter_anthropic_claude_sonnet_4 :: Model+openrouter_anthropic_claude_sonnet_4 =+  emptyModel+    { modelId = "anthropic/claude-sonnet-4",+      name = "Claude Sonnet 4 via OpenRouter",+      api = OpenAIChatCompletions,+      provider = "openrouter",+      baseUrl = "https://openrouter.ai/api",+      reasoning = False,+      input = [InputText, InputImage],+      cost =+        ModelCost+          { inputCost = 3 % 1,+            outputCost = 15 % 1,+            cacheReadCost = 3 % 10,+            cacheWriteCost = 15 % 4+          },+      contextWindow = 200000,+      maxOutputTokens = 8192,+      headers = Map.empty,+      compat = CompatNone+    }++openrouter_openai_gpt_4o_mini :: Model+openrouter_openai_gpt_4o_mini =+  emptyModel+    { modelId = "openai/gpt-4o-mini",+      name = "GPT-4o mini via OpenRouter",+      api = OpenAIChatCompletions,+      provider = "openrouter",+      baseUrl = "https://openrouter.ai/api",+      reasoning = False,+      input = [InputText, InputImage],+      cost =+        ModelCost+          { inputCost = 3 % 20,+            outputCost = 3 % 5,+            cacheReadCost = 3 % 40,+            cacheWriteCost = 0 % 1+          },+      contextWindow = 128000,+      maxOutputTokens = 16384,+      headers = Map.empty,+      compat = CompatNone+    }

@@ -1,12 +1,31 @@ -- | The 'Options' record — the per-call knobs that vary between -- requests on the same conversation. ----- 'apiKey' is 'Nothing' by default; the registered handler then--- consults a provider-specific env var--- (@ANTHROPIC_API_KEY@ for Anthropic, @OPENAI_API_KEY@ for OpenAI).+-- 'apiKey' is 'Nothing' by default; API providers then consult the+-- host-specific env var from 'Baikai.Auth.defaultApiKeyEnvForBaseUrl'+-- after substituting their default base URL. Unknown hosts require an+-- explicit key source instead of falling back to another provider's+-- credential. -- 'maxTokens' defaults to 'Nothing'; the handler falls back to the -- chosen model's 'Baikai.Model.maxOutputTokens'.+-- 'topP' and 'stopSequences' are honored by the Anthropic and+-- OpenAI-compatible API providers. 'seed', 'frequencyPenalty', and+-- 'presencePenalty' are honored by the OpenAI-compatible API+-- provider. Providers with no corresponding upstream parameter+-- silently omit the field, matching the existing drop policy for+-- unsupported per-call knobs on CLI providers. --+-- 'timeoutMs' is a wall-clock bound on the entire API streaming call+-- in the OpenAI and Claude providers: connection setup, response+-- headers, and full stream drain. On expiry the stream terminates+-- in-band with a retryable transient 'Baikai.Error.BaikaiError'.+--+-- 'headers' are per-call HTTP header overrides for API providers.+-- Provider defaults are built first, then 'Baikai.Model.headers',+-- then this field; later values replace earlier ones by+-- case-insensitive header name, including auth headers for callers+-- intentionally fronting a gateway.+-- -- EP-4 added @toolChoice@. EP-5 adds @cacheRetention@ and @thinking@ -- (provider-agnostic preferences that each provider maps to its own -- primitive — see 'Baikai.CacheRetention' and 'Baikai.ThinkingLevel'@@ -14,7 +33,23 @@ -- provider-agnostic structured-output preference — see -- 'Baikai.ResponseFormat'. module Baikai.Options-  ( Options (..),+  ( Options,+    maxTokens,+    temperature,+    apiKey,+    timeoutMs,+    headers,+    metadata,+    toolChoice,+    cacheRetention,+    thinking,+    responseFormat,+    topP,+    stopSequences,+    seed,+    frequencyPenalty,+    presencePenalty,+    emptyOptions,     _Options,   ) where@@ -28,6 +63,7 @@ import Data.Map.Strict (Map) import Data.Map.Strict qualified as Map import Data.Text (Text)+import Data.Vector (Vector) import GHC.Generics (Generic) import Numeric.Natural (Natural) @@ -41,13 +77,18 @@     toolChoice :: !(Maybe ToolChoice),     cacheRetention :: !(Maybe CacheRetention),     thinking :: !(Maybe ThinkingLevel),-    responseFormat :: !(Maybe ResponseFormat)+    responseFormat :: !(Maybe ResponseFormat),+    topP :: !(Maybe Double),+    stopSequences :: !(Maybe (Vector Text)),+    seed :: !(Maybe Integer),+    frequencyPenalty :: !(Maybe Double),+    presencePenalty :: !(Maybe Double)   }   deriving stock (Eq, Show, Generic)   deriving anyclass (ToJSON) -_Options :: Options-_Options =+emptyOptions :: Options+emptyOptions =   Options     { maxTokens = Nothing,       temperature = Nothing,@@ -58,5 +99,14 @@       toolChoice = Nothing,       cacheRetention = Nothing,       thinking = Nothing,-      responseFormat = Nothing+      responseFormat = Nothing,+      topP = Nothing,+      stopSequences = Nothing,+      seed = Nothing,+      frequencyPenalty = Nothing,+      presencePenalty = Nothing     }++{-# DEPRECATED _Options "Use emptyOptions instead." #-}+_Options :: Options+_Options = emptyOptions

@@ -7,6 +7,12 @@ --   `Data.Generics.Labels` is imported for its orphan `IsLabel` instance --   only (no values are re-exported); the instance still propagates to --   anything that imports this Prelude.+--+--   This module is a convenience prelude, not a PVP-stable public API+--   contract. Its re-export set follows baikai's internal needs and may+--   change when upstream prelude, lens, or generic-lens usage changes.+--   Application code that needs a stable import surface should import+--   the upstream modules it uses directly. module Baikai.Prelude   ( -- * Lens vocabulary     module Control.Lens,

@@ -13,25 +13,35 @@   ( ApiProvider (..),     ProviderRegistry,     newProviderRegistry,+    newProviderRegistryFrom,     globalProviderRegistry,     registerApiProviderWith,     registerApiProvider,+    assertRegistered,     lookupApiProviderWith,     lookupApiProvider,     completeRequestWith,     completeRequest,+    runToolLoopWith,+    runToolLoop,+    completeText,   ) where  import Baikai.Provider.Registry   ( ApiProvider (..),     ProviderRegistry,+    assertRegistered,     completeRequest,     completeRequestWith,+    completeText,     globalProviderRegistry,     lookupApiProvider,     lookupApiProviderWith,     newProviderRegistry,+    newProviderRegistryFrom,     registerApiProvider,     registerApiProviderWith,+    runToolLoop,+    runToolLoopWith,   )

@@ -2,11 +2,13 @@ -- and @baikai-openai@. -- -- Not re-exported from "Baikai"; vendor packages import this module--- directly. Anything exported here is considered part of the core--- library's interface to the CLI provider packages and should not be--- relied on by application code.+-- directly. This is an internal interface and is not covered by PVP+-- stability guarantees: names, types, and semantics may change in+-- minor releases. Application code should use the public provider+-- modules instead. module Baikai.Provider.Cli.Internal   ( renderPrompt,+    wrapSystemPrompt,     maybeApply,     decodeUtf8Lenient,     extractAgentMessage,@@ -92,6 +94,23 @@       where         pickT (ToolResultText (TextContent t)) = Just t         pickT _ = Nothing++-- | Wrap a rendered prompt with a system-instruction preamble for+-- CLIs that expose no native system-prompt flag. 'Nothing' and+-- blank system prompts return the body unchanged. The textual+-- format is shared by the codex batch provider and the codex+-- interactive launcher.+wrapSystemPrompt :: Maybe Text -> Text -> Text+wrapSystemPrompt msp body = case Text.strip <$> msp of+  Nothing -> body+  Just "" -> body+  Just sp ->+    Text.concat+      [ "System instructions:\n",+        sp,+        "\n\nUser request:\n",+        body+      ]  -- | @maybeApply ma f x@ applies @f a x@ when @ma = Just a@, -- otherwise returns @x@. Useful for threading optional configuration

@@ -9,34 +9,49 @@ -- sets, or use the global convenience registry for simple scripts. -- -- 'completeRequest' looks the handler up by the 'Model'\'s 'Api'--- tag and dispatches; it throws a 'Baikai.Error.BaikaiError' in the--- 'Baikai.Error.ProviderUnavailable' category when no handler is--- registered for that tag.+-- tag and dispatches; when no handler is registered it returns an+-- error-shaped 'Response' in the 'Baikai.Error.ProviderUnavailable'+-- category. module Baikai.Provider.Registry   ( ApiProvider (..),     ProviderRegistry,     newProviderRegistry,+    newProviderRegistryFrom,     globalProviderRegistry,     registerApiProviderWith,     registerApiProvider,+    assertRegistered,     lookupApiProviderWith,     lookupApiProvider,     completeRequestWith,     completeRequest,+    runToolLoopWith,+    runToolLoop,+    completeText,   ) where  import Baikai.Api (Api, renderApi)-import Baikai.Context (Context)+import Baikai.Content (AssistantContent (..), ToolCall)+import Baikai.Context (Context, appendToolResult, contextOf) import Baikai.Error (providerUnavailable)-import Baikai.Model (Model (..))-import Baikai.Options (Options)-import Baikai.Response (Response)+import Baikai.Message (AssistantPayload (..), ToolResult, toolResultErrorText, user)+import Baikai.Model (Model)+import Baikai.Model qualified as Model+import Baikai.Options (Options, emptyOptions)+import Baikai.Response (Response (..), errorResponse, flattenAssistantBlocks, flattenAssistantText, responseError)+import Baikai.StopReason (StopReason (..)) import Baikai.Stream.Event (AssistantMessageEvent)-import Control.Exception (throwIO)+import Control.Exception qualified as Exception+import Control.Monad (forM, unless)+import Data.Foldable (traverse_) import Data.IORef (IORef, atomicModifyIORef', newIORef, readIORef) import Data.Map.Strict (Map) import Data.Map.Strict qualified as Map+import Data.Text (Text)+import Data.Text qualified as Text+import Data.Time (getCurrentTime)+import Data.Vector qualified as Vector import Streamly.Data.Stream (Stream) import System.IO.Unsafe (unsafePerformIO) @@ -59,6 +74,14 @@ newProviderRegistry :: IO ProviderRegistry newProviderRegistry = ProviderRegistry <$> newIORef Map.empty +-- | Construct a registry pre-populated with the given providers. Later entries+-- win on tag collisions, matching 'registerApiProviderWith'.+newProviderRegistryFrom :: [ApiProvider] -> IO ProviderRegistry+newProviderRegistryFrom providers = do+  reg <- newProviderRegistry+  traverse_ (registerApiProviderWith reg) providers+  pure reg+ -- | Process-global handler registry used by the legacy convenience functions. -- The 'unsafePerformIO' + 'NOINLINE' pattern mirrors 'Baikai.Trace'\'s -- @eventCounter@; this is a single shared handle for the lifetime of the@@ -78,6 +101,25 @@ registerApiProvider :: ApiProvider -> IO () registerApiProvider = registerApiProviderWith globalProviderRegistry +-- | Startup preflight: throw 'Baikai.Error.ProviderUnavailable' listing every+-- requested API tag that has no registered handler.+assertRegistered :: ProviderRegistry -> [Api] -> IO ()+assertRegistered reg tags = do+  missing <-+    fmap concat $+      forM tags $ \tag -> do+        found <- lookupApiProviderWith reg tag+        pure $ case found of+          Nothing -> [tag]+          Just _ -> []+  unless (null missing) $+    Exception.throwIO+      ( providerUnavailable+          ( "no provider registered for: "+              <> Text.intercalate ", " (renderApi <$> missing)+          )+      )+ -- | Look up the handler registered for an 'Api' tag. lookupApiProviderWith :: ProviderRegistry -> Api -> IO (Maybe ApiProvider) lookupApiProviderWith reg tag = Map.lookup tag <$> readIORef (registryRef reg)@@ -88,17 +130,107 @@ lookupApiProvider = lookupApiProviderWith globalProviderRegistry  -- | Dispatch a synchronous request through the registered handler--- for the model's 'Api' tag. Throws a 'ProviderUnavailable' error when no handler--- is registered for that tag.+-- for the model's 'Api' tag. Returns an error-shaped 'Response' when+-- no handler is registered for that tag. completeRequestWith :: ProviderRegistry -> Model -> Context -> Options -> IO Response completeRequestWith reg m ctx opts = do-  mProvider <- lookupApiProviderWith reg (api m)+  mProvider <- lookupApiProviderWith reg (Model.api m)   case mProvider of     Just p -> complete p m ctx opts-    Nothing ->-      throwIO $-        providerUnavailable ("No provider registered for API: " <> renderApi (api m))+    Nothing -> do+      now <- getCurrentTime+      pure $+        errorResponse+          m+          now+          0+          (providerUnavailable ("No provider registered for API: " <> renderApi (Model.api m)))  -- | Dispatch a synchronous request through the process-global registry. completeRequest :: Model -> Context -> Options -> IO Response completeRequest = completeRequestWith globalProviderRegistry++-- | Drive a tool-using conversation through the process-global registry.+--+-- The returned 'Context' contains the input context plus only fully resolved+-- assistant/tool-result exchanges, so it is always valid to replay. The final+-- 'Response' is not appended; callers that want the full transcript can use+-- 'Baikai.Context.addResponse'. 'Options' is passed unchanged each turn, so+-- forcing tools in options can exhaust the budget; loops should usually let+-- the provider choose tools automatically.+runToolLoop ::+  Int ->+  (ToolCall -> IO ToolResult) ->+  Model ->+  Context ->+  Options ->+  IO (Context, Response)+runToolLoop = runToolLoopWith globalProviderRegistry++-- | Drive a tool-using conversation through an explicit registry.+--+-- The turn budget is clamped to at least one model call. Synchronous dispatcher+-- exceptions become error tool results so the model can recover; asynchronous+-- exceptions are rethrown. Dispatchers should return 'toolResultErrorText' for+-- unknown tool names rather than throwing.+runToolLoopWith ::+  ProviderRegistry ->+  Int ->+  (ToolCall -> IO ToolResult) ->+  Model ->+  Context ->+  Options ->+  IO (Context, Response)+runToolLoopWith reg budget dispatcher model ctx0 opts =+  go (max 1 budget) ctx0+  where+    go remaining ctx = do+      resp <- completeRequestWith reg model ctx opts+      if shouldStop remaining resp+        then pure (ctx, resp)+        else do+          ctx' <- appendToolResult ctx resp (safeDispatcher dispatcher)+          go (remaining - 1) ctx'++    shouldStop remaining resp =+      responseError resp /= Nothing+        || responseStopReason resp /= ToolUse+        || Vector.null (responseToolCalls resp)+        || remaining <= 1++-- | One-shot text completion through the global registry. Throws the+-- 'Baikai.Error.BaikaiError' when the response is error-shaped.+completeText :: Model -> Text -> IO Text+completeText model prompt = do+  resp <- completeRequest model (contextOf [user prompt]) emptyOptions+  case responseError resp of+    Just err -> Exception.throwIO err+    Nothing -> pure (flattenAssistantText (flattenAssistantBlocks resp))++safeDispatcher :: (ToolCall -> IO ToolResult) -> ToolCall -> IO ToolResult+safeDispatcher dispatcher tc = do+  result <- trySync (dispatcher tc)+  case result of+    Right ok -> pure ok+    Left e -> pure (toolResultErrorText (Text.pack (Exception.displayException e)))++trySync :: IO a -> IO (Either Exception.SomeException a)+trySync action = do+  result <- Exception.try action+  case result of+    Left e+      | Just (Exception.SomeAsyncException _) <-+          (Exception.fromException e :: Maybe Exception.SomeAsyncException) ->+          Exception.throwIO e+      | otherwise -> pure (Left e)+    Right a -> pure (Right a)++responseStopReason :: Response -> StopReason+responseStopReason Response {message = AssistantPayload {stopReason = sr}} = sr++responseToolCalls :: Response -> Vector.Vector ToolCall+responseToolCalls Response {message = AssistantPayload {content = blocks}} =+  Vector.mapMaybe toolCallOf blocks+  where+    toolCallOf (AssistantToolCall tc) = Just tc+    toolCallOf _ = Nothing

@@ -5,26 +5,34 @@ -- 'Baikai.Api'), the input 'Model' echoed back, the provider name, -- an optional 'responseId', and the measured 'latencyMs'. The -- 'message' carries only assistant content blocks, 'Usage' (with--- 'Cost' embedded), 'StopReason', optional error text, and timestamp.+-- 'Cost' embedded), 'StopReason', optional error text, and an optional+-- timestamp. ----- 'flattenAssistantBlocks' is a convenience accessor that flattens--- the message's content blocks.+-- 'flattenAssistantBlocks' and 'flattenAssistantText' are convenience+-- accessors for the message's content blocks. module Baikai.Response   ( Response (..),+    emptyResponse,     _Response,     responseMessage,     flattenAssistantBlocks,+    flattenAssistantText,+    responseError,+    errorResponse,   ) where  import Baikai.Api (Api (..))-import Baikai.Content (AssistantContent)-import Baikai.Error (BaikaiError)+import Baikai.Content (AssistantContent (..), TextContent (..))+import Baikai.Error (BaikaiError, providerError)+import Baikai.Error qualified as Error import Baikai.Message (AssistantPayload (..), Message (..))-import Baikai.Model (Model, _Model)+import Baikai.Model (Model, emptyModel)+import Baikai.Model qualified as Model import Baikai.StopReason (StopReason (..))-import Baikai.Usage (_Usage)+import Baikai.Usage (zeroUsage) import Data.Text (Text)+import Data.Text qualified as Text import Data.Time (UTCTime) import Data.Vector (Vector) import Data.Vector qualified as V@@ -37,13 +45,13 @@     api :: !Api,     provider :: !Text,     responseId :: !(Maybe Text),-    latencyMs :: !Integer,+    latencyMs :: !Int,     -- | Structured error detail when the call failed in-band     -- (@stopReason = ErrorReason@): the category, HTTP status, and any-    -- retry-after hint. 'Nothing' on success or when the provider could-    -- not classify the failure. Lets a caller branch on-    -- 'Baikai.Error.category' / 'Baikai.Error.isRetryable' without-    -- parsing 'errorMessage' text.+    -- retry-after hint. Conforming providers set this to 'Just' for+    -- error-shaped responses and 'Nothing' on success. Use+    -- 'responseError' for the normalized failure view; it synthesizes+    -- an 'OtherError' if a nonconforming provider omits this field.     errorInfo :: !(Maybe BaikaiError)   }   deriving stock (Eq, Show, Generic)@@ -51,18 +59,18 @@ -- | A blank assistant turn at epoch start. Useful as a fixture base -- for tests and as the default in error paths where no message was -- received.-_Response :: Response-_Response =+emptyResponse :: Response+emptyResponse =   Response     { message =         AssistantPayload           { content = V.empty,-            usage = _Usage,+            usage = zeroUsage,             stopReason = Stop,             errorMessage = Nothing,-            timestamp = read "2000-01-01 00:00:00 UTC" :: UTCTime+            timestamp = Nothing           },-      model = _Model,+      model = emptyModel,       api = Custom "",       provider = "",       responseId = Nothing,@@ -77,3 +85,48 @@ -- | Pull the response's assistant content blocks out. flattenAssistantBlocks :: Response -> Vector AssistantContent flattenAssistantBlocks Response {message = AssistantPayload {content = c}} = c++-- | Concatenate all assistant text blocks, ignoring thinking and tool+-- call blocks.+flattenAssistantText :: Vector AssistantContent -> Text+flattenAssistantText =+  Text.concat . V.toList . V.mapMaybe textOf+  where+    textOf (AssistantText (TextContent t)) = Just t+    textOf _ = Nothing++-- | The single question callers ask about failure. Returns 'Just'+-- exactly when the response is error-shaped (@stopReason =+-- ErrorReason@): the provider's classified 'errorInfo' when present,+-- otherwise a synthesized 'OtherError' carrying the response's+-- 'errorMessage' text.+responseError :: Response -> Maybe BaikaiError+responseError Response {message = AssistantPayload {stopReason = sr, errorMessage = em}, errorInfo = ei}+  | sr == ErrorReason = Just (maybe (providerError fallback) id ei)+  | otherwise = Nothing+  where+    fallback = maybe "call failed with no error detail" id em++-- | Build a conformant error-shaped 'Response' for a failed call.+errorResponse :: Model -> UTCTime -> Int -> BaikaiError -> Response+errorResponse m ts latency err =+  Response+    { message =+        AssistantPayload+          { content = V.empty,+            usage = zeroUsage,+            stopReason = ErrorReason,+            errorMessage = Just (Error.message err),+            timestamp = Just ts+          },+      model = m,+      api = Model.api m,+      provider = Model.provider m,+      responseId = Nothing,+      latencyMs = latency,+      errorInfo = Just err+    }++{-# DEPRECATED _Response "Use emptyResponse instead." #-}+_Response :: Response+_Response = emptyResponse

@@ -4,9 +4,9 @@ -- -- 'streamRequest' looks up the per-API handler registered for a -- model's 'Api' tag and returns its event stream. When no handler is--- registered the function returns a one-event error stream (a single--- 'EventError' with @stopReason = ErrorReason@) so a caller iterating--- the stream always gets at least one terminal event.+-- registered the function returns a synthetic 'EventStart' followed by+-- a terminal 'EventError' with @stopReason = ErrorReason@, preserving+-- the protocol that every core-owned stream starts with 'EventStart'. -- -- 'streamingComplete' folds an event stream into the synchronous -- 'Response' shape. Vendor providers register both the @stream@@@ -17,6 +17,10 @@ module Baikai.Stream   ( streamRequest,     streamRequestWith,+    streamRequestEach,+    streamRequestEachWith,+    streamRequestList,+    streamRequestListWith,     streamingComplete,     reassembleResponse,     liftCompleteToStream,@@ -31,7 +35,7 @@   ) import Baikai.Content qualified as Content import Baikai.Context (Context)-import Baikai.Error (BaikaiError, providerUnavailable)+import Baikai.Error (BaikaiError, providerError, providerUnavailable) import Baikai.Message (AssistantPayload (..), Message (AssistantMessage)) import Baikai.Message qualified as Msg import Baikai.Model (Model)@@ -42,7 +46,7 @@     globalProviderRegistry,     lookupApiProviderWith,   )-import Baikai.Response (Response (..), responseMessage)+import Baikai.Response (Response (..), responseError, responseMessage) import Baikai.StopReason (StopReason (..)) import Baikai.Stream.Event   ( AssistantMessageEvent (..),@@ -51,11 +55,13 @@     IndexPayload (..),     StartPayload (..),     TerminalPayload (..),+    ThinkingEndPayload (..),     ToolCallEndPayload (..),     doneTerminal,     errorTerminal,   )-import Baikai.Usage (_Usage)+import Baikai.Usage (zeroUsage)+import Control.Applicative ((<|>)) import Control.Exception (fromException) import Control.Exception qualified import Control.Lens ((%~), (&), (.~), (^.))@@ -78,9 +84,8 @@ import Streamly.Data.Stream qualified as Stream  -- | Dispatch a streaming call through the registered handler for the--- model's 'Api' tag. Returns a one-event error stream when no handler--- is registered for that tag — the caller always sees at least one--- terminal event.+-- model's 'Api' tag. Returns an 'EventStart' then 'EventError' stream+-- when no handler is registered for that tag. streamRequest :: Model -> Context -> Options -> Stream IO AssistantMessageEvent streamRequest = streamRequestWith globalProviderRegistry @@ -97,8 +102,54 @@     mProvider <- lookupApiProviderWith reg (m ^. #api)     case mProvider of       Just p -> pure (stream p m ctx opts)-      Nothing -> pure (Stream.fromEffect (noProviderEvent m))+      Nothing -> Stream.fromList <$> noProviderEvents m +-- | Stream a request through the process-global registry, invoking the+-- callback once per event, then return the same reassembled 'Response'+-- that 'streamingComplete' would produce. Callback exceptions propagate.+streamRequestEach ::+  (AssistantMessageEvent -> IO ()) ->+  Model ->+  Context ->+  Options ->+  IO Response+streamRequestEach = streamRequestEachWith globalProviderRegistry++-- | Stream a request through an explicit registry, invoking the callback once+-- per event. The underlying event protocol is the same as 'streamRequest':+-- provider streams emit exactly one terminal event.+streamRequestEachWith ::+  ProviderRegistry ->+  (AssistantMessageEvent -> IO ()) ->+  Model ->+  Context ->+  Options ->+  IO Response+streamRequestEachWith reg callback m ctx opts =+  Stream.fold+    (reassembleResponse m)+    ( Stream.mapM+        ( \event -> do+            callback event+            pure event+        )+        (streamRequestWith reg m ctx opts)+    )++-- | Collect the event stream from the process-global registry into a list.+streamRequestList :: Model -> Context -> Options -> IO [AssistantMessageEvent]+streamRequestList = streamRequestListWith globalProviderRegistry++-- | Collect the event stream from an explicit registry into a list.+streamRequestListWith ::+  ProviderRegistry ->+  Model ->+  Context ->+  Options ->+  IO [AssistantMessageEvent]+streamRequestListWith reg m ctx opts =+  Stream.toList (streamRequestWith reg m ctx opts)+ -- | Drain an event stream into a 'Response' by folding events into -- the assembled message. streamingComplete ::@@ -115,34 +166,46 @@ -- reassembly logic. reassembleResponse :: Model -> Fold IO AssistantMessageEvent Response reassembleResponse m =-  Fold.rmapM finalizeState (Fold.foldl' step (initialState m))+  Fold.rmapM+    finalizeState+    (Fold.foldlM' (\s e -> pure (step s e)) (initialState m <$> getCurrentTime))  -- | One frozen-in-time view of the partial assembly. data ReassemblyState = ReassemblyState   { model :: !Model,     -- | 'Just' once 'EventStart' has been observed.     skeleton :: !(Maybe Message),-    -- | Captured from the EventStart message's timestamp.-    startTime :: !(Maybe UTCTime),+    -- | Captured by the reassembler when the fold starts driving the stream.+    wallStart :: !UTCTime,+    -- | Provider message id, preferring the terminal payload over the start payload.+    responseId :: !(Maybe Text),     -- | Content blocks closed so far, keyed by @contentIndex@.     blocks :: !(IntMap AssistantContent),     -- | Open text accumulators, indexed by @contentIndex@.     textBuf :: !(IntMap Text),     thinkBuf :: !(IntMap Text),     toolArgsBuf :: !(IntMap Text),-    -- | 'Just (reason, msg, errorInfo)' once 'EventDone' or 'EventError'-    -- fires. @errorInfo@ is the structured error from an 'EventError'-    -- terminal (if the provider classified it), 'Nothing' otherwise.-    terminal :: !(Maybe (StopReason, Message, Maybe BaikaiError))+    -- | 'Just' once 'EventDone' or 'EventError' fires.+    terminal :: !(Maybe TerminalSeen)   }   deriving stock (Show, Generic) -initialState :: Model -> ReassemblyState-initialState m =+-- | What the terminal event told us, plus which terminal it was.+data TerminalSeen = TerminalSeen+  { reason :: !StopReason,+    message :: !Message,+    errorInfo :: !(Maybe BaikaiError),+    failed :: !Bool+  }+  deriving stock (Show, Generic)++initialState :: Model -> UTCTime -> ReassemblyState+initialState m start =   ReassemblyState     { model = m,       skeleton = Nothing,-      startTime = Nothing,+      wallStart = start,+      responseId = Nothing,       blocks = IntMap.empty,       textBuf = IntMap.empty,       thinkBuf = IntMap.empty,@@ -152,11 +215,8 @@  step :: ReassemblyState -> AssistantMessageEvent -> ReassemblyState step s = \case-  EventStart StartPayload {partial = sk} ->-    let t = case sk of-          AssistantMessage AssistantPayload {Msg.timestamp = ts} -> Just ts-          _ -> Nothing-     in s & #skeleton .~ Just sk & #startTime .~ t+  EventStart StartPayload {partial = sk, responseId = rid} ->+    s & #skeleton .~ Just sk & #responseId .~ rid   TextStart IndexPayload {contentIndex = i} ->     s & #textBuf %~ IntMap.insert i Text.empty   TextDelta DeltaPayload {contentIndex = i, delta = d} ->@@ -169,14 +229,12 @@     s & #thinkBuf %~ IntMap.insert i Text.empty   ThinkingDelta DeltaPayload {contentIndex = i, delta = d} ->     s & #thinkBuf %~ IntMap.insertWith (\new old -> old <> new) i d-  ThinkingEnd BlockEndPayload {contentIndex = i, content = body} ->+  ThinkingEnd ThinkingEndPayload {contentIndex = i, content = tc} ->     s       & #blocks         %~ IntMap.insert           i-          ( AssistantThinking-              ThinkingContent {thinking = body, signature = Nothing, redacted = False}-          )+          (AssistantThinking tc)       & #thinkBuf %~ IntMap.delete i   ToolCallStart IndexPayload {contentIndex = i} ->     s & #toolArgsBuf %~ IntMap.insert i Text.empty@@ -186,55 +244,116 @@     s       & #blocks %~ IntMap.insert i (AssistantToolCall tc)       & #toolArgsBuf %~ IntMap.delete i-  EventDone TerminalPayload {reason = r, message = msg} ->-    s & #terminal .~ Just (r, msg, Nothing)-  EventError TerminalPayload {reason = r, message = msg, errorInfo = ei} ->-    s & #terminal .~ Just (r, msg, ei)+  EventDone TerminalPayload {reason = r, message = msg, responseId = rid} ->+    s+      & #terminal+        .~ Just TerminalSeen {reason = r, message = msg, errorInfo = Nothing, failed = False}+      & #responseId %~ (\old -> rid <|> old)+  EventError TerminalPayload {reason = r, message = msg, responseId = rid, errorInfo = ei} ->+    s+      & #terminal+        .~ Just TerminalSeen {reason = r, message = msg, errorInfo = ei, failed = True}+      & #responseId %~ (\old -> rid <|> old)  finalizeState :: ReassemblyState -> IO Response finalizeState s = do   now <- getCurrentTime   let m = s ^. #model-      assembled = assembleBlocks s-      (terminalMsg, terminalReason, terminalError) = case s ^. #terminal of-        Just (r, msg, ei) -> (msg, r, ei)-        Nothing -> (synthesizeTerminal now assembled, Stop, Nothing)-      message' = overrideBlocksAndReason terminalReason terminalMsg assembled now-      endTs = message' ^. #timestamp-      latency = case s ^. #startTime of-        Just startTs ->-          round (realToFrac (Data.Time.Clock.diffUTCTime endTs startTs) * (1000 :: Double))-        Nothing -> 0+      assembled = assembledBlocks s+      dangling = danglingBlocks s+      (terminalMsg, terminalReason, terminalError, terminalFailed, sawTerminal) =+        case s ^. #terminal of+          Just TerminalSeen {reason = r, message = msg, errorInfo = ei, failed = failed'} ->+            (msg, r, ei, failed', True)+          Nothing -> (synthesizeTerminal now assembled, Stop, Nothing, False, False)+      terminalContent = messageContent terminalMsg+      normalizedError = case (terminalReason, terminalError) of+        (ErrorReason, Nothing) -> Just (providerError (messageErrorText terminalMsg))+        _ -> terminalError+      finalContent+        | not sawTerminal = assembled+        | Vector.null terminalContent = assembled+        | terminalFailed = terminalContent <> Vector.fromList (IntMap.elems dangling)+        | otherwise = terminalContent+      message' = overrideBlocksAndReason terminalReason terminalMsg finalContent now+      latency = case (s ^. #skeleton >>= messageTimestamp, assistantPayloadTimestamp message') of+        (Just startTs, Just endTs) -> millisBetween startTs endTs+        _ -> 0   pure     Response       { message = message',         model = m,         api = m ^. #api,         provider = m ^. #provider,-        responseId = Nothing,+        responseId = s ^. #responseId,         latencyMs = latency,-        errorInfo = terminalError+        errorInfo = normalizedError       } --- | Project the closed content blocks in 'contentIndex' order, plus--- any still-open text/thinking accumulators flushed as best-effort--- content (recovery path; providers should not exercise this).-assembleBlocks :: ReassemblyState -> Vector AssistantContent-assembleBlocks s =-  let closed = IntMap.elems (s ^. #blocks)-      danglingText =-        [ AssistantText (TextContent t)-        | (_, t) <- IntMap.toAscList (s ^. #textBuf),-          not (Text.null t)-        ]-      danglingThink =-        [ AssistantThinking-            ThinkingContent {thinking = t, signature = Nothing, redacted = False}-        | (_, t) <- IntMap.toAscList (s ^. #thinkBuf),-          not (Text.null t)-        ]-   in Vector.fromList (closed <> danglingText <> danglingThink)+-- | Project the event-assembled content in 'contentIndex' order,+-- including still-open buffers as best-effort recovery content.+assembledBlocks :: ReassemblyState -> Vector AssistantContent+assembledBlocks s =+  Vector.fromList (IntMap.elems (IntMap.union (s ^. #blocks) (danglingBlocks s))) +-- | Convert any still-open buffers into inspectable content. This is+-- the recovery path for streams that die before an @_End@ event. Partial+-- tool arguments are preserved as decoded JSON when possible, otherwise+-- as an 'Aeson.String' carrying the raw accumulated text.+danglingBlocks :: ReassemblyState -> IntMap AssistantContent+danglingBlocks s =+  IntMap.unions+    [ IntMap.mapMaybe textBlock (s ^. #textBuf),+      IntMap.mapMaybe thinkingBlock (s ^. #thinkBuf),+      IntMap.mapMaybe toolBlock (s ^. #toolArgsBuf)+    ]+  where+    textBlock t+      | Text.null t = Nothing+      | otherwise = Just (AssistantText (TextContent t))++    thinkingBlock t+      | Text.null t = Nothing+      | otherwise =+          Just (AssistantThinking ThinkingContent {thinking = t, signature = Nothing, redacted = False})++    toolBlock raw+      | Text.null raw = Nothing+      | otherwise =+          let decoded = case Aeson.eitherDecodeStrict (Text.encodeUtf8 raw) of+                Right v -> v+                Left _ -> Aeson.String raw+           in Just+                ( AssistantToolCall+                    Content.ToolCall+                      { Content.id_ = "",+                        Content.name = "",+                        Content.arguments = decoded+                      }+                )++messageContent :: Message -> Vector AssistantContent+messageContent = \case+  AssistantMessage AssistantPayload {Msg.content = c} -> c+  _ -> Vector.empty++messageErrorText :: Message -> Text+messageErrorText = \case+  AssistantMessage AssistantPayload {Msg.errorMessage = Just em} -> em+  _ -> "call failed with no error detail"++messageTimestamp :: Message -> Maybe UTCTime+messageTimestamp = \case+  AssistantMessage AssistantPayload {Msg.timestamp = ts} -> ts+  _ -> Nothing++assistantPayloadTimestamp :: AssistantPayload -> Maybe UTCTime+assistantPayloadTimestamp AssistantPayload {Msg.timestamp = ts} = ts++millisBetween :: UTCTime -> UTCTime -> Int+millisBetween start end =+  max 0 (round (realToFrac (Data.Time.Clock.diffUTCTime end start) * (1000 :: Double)))+ -- | Replace the content vector and stop reason of an assistant -- message, preserving usage, errorMessage, and timestamp. overrideBlocksAndReason ::@@ -251,10 +370,10 @@   _ ->     AssistantPayload       { Msg.content = blocks,-        Msg.usage = _Usage,+        Msg.usage = zeroUsage,         Msg.stopReason = sr,         Msg.errorMessage = Just "stream terminated with a non-assistant message",-        Msg.timestamp = fallbackTs+        Msg.timestamp = Just fallbackTs       }  -- | Build a placeholder 'AssistantMessage' for streams that ended@@ -264,10 +383,10 @@   AssistantMessage     AssistantPayload       { Msg.content = blocks,-        Msg.usage = _Usage,+        Msg.usage = zeroUsage,         Msg.stopReason = Stop,         Msg.errorMessage = Just "stream ended without terminal event",-        Msg.timestamp = now+        Msg.timestamp = Just now       }  -- | Wrap a synchronous @complete@ handler in a one-shot event@@ -283,11 +402,14 @@ --   matching @_Start@ / @_Delta@ / @_End@ trio. Text blocks emit --   one 'TextDelta' with the whole text; tool calls emit one --   'ToolCallDelta' with the JSON-encoded arguments.--- * 'EventDone' carrying the fully assembled assistant message.+-- * 'EventDone' carrying the fully assembled assistant message, or+--   'EventError' when the response is error-shaped according to+--   'responseError'. ----- An exception from @complete@ becomes a single-'EventError' stream--- with @stopReason = ErrorReason@ and 'errorMessage' set from the--- exception's display.+-- A synchronous exception from @complete@ becomes a synthetic+-- 'EventStart' followed by 'EventError' with @stopReason = ErrorReason@+-- and 'errorMessage' set from the exception's display. Asynchronous+-- exceptions are rethrown so cancellation works. liftCompleteToStream ::   (Model -> Context -> Options -> IO Response) ->   Model ->@@ -297,14 +419,26 @@ liftCompleteToStream f m ctx opts =   Stream.concatEffect $ do     startTs <- getCurrentTime-    er <- tryAny (f m ctx opts)+    er <- trySync (f m ctx opts)     case er of       Right resp -> pure (Stream.fromList (eventsFor startTs resp))-      Left e -> pure (Stream.fromEffect (errorEvent e))+      Left e -> Stream.fromList <$> errorEvents e --- | A typed 'try' over any synchronous exception.-tryAny :: IO a -> IO (Either Control.Exception.SomeException a)-tryAny = Control.Exception.try+-- | 'try' for synchronous exceptions only. Anything delivered+-- asynchronously (wrapped in 'Control.Exception.SomeAsyncException' by+-- 'Control.Exception.throwTo', 'System.Timeout.timeout', Ctrl-C) is+-- rethrown so cancellation works; converting it into an 'EventError'+-- would defeat it.+trySync :: IO a -> IO (Either Control.Exception.SomeException a)+trySync action = do+  r <- Control.Exception.try action+  case r of+    Left e+      | Just (Control.Exception.SomeAsyncException _) <-+          (fromException e :: Maybe Control.Exception.SomeAsyncException) ->+          Control.Exception.throwIO e+      | otherwise -> pure (Left e)+    Right a -> pure (Right a)  -- | Build the synthetic event list for a fully resolved 'Response'. -- The 'EventStart' carries the supplied @startTs@ on its message@@ -321,7 +455,7 @@               Msg.usage = payload ^. #usage,               Msg.stopReason = payload ^. #stopReason,               Msg.errorMessage = payload ^. #errorMessage,-              Msg.timestamp = startTs+              Msg.timestamp = Just startTs             }       blocks = Vector.toList (payload ^. #content)       blockEvents =@@ -330,9 +464,13 @@           | (i, b) <- zip [0 ..] blocks           ]       reason = payload ^. #stopReason-   in [EventStart StartPayload {partial = skeleton}]+      rid = resp ^. #responseId+      terminalEvent = case responseError resp of+        Just be -> EventError (errorTerminal rid reason msg be)+        Nothing -> EventDone (doneTerminal rid reason msg)+   in [EventStart StartPayload {partial = skeleton, responseId = rid}]         <> blockEvents-        <> [EventDone (doneTerminal reason msg)]+        <> [terminalEvent]  blockEvent :: Int -> AssistantContent -> [AssistantMessageEvent] blockEvent i = \case@@ -341,10 +479,10 @@       TextDelta DeltaPayload {contentIndex = i, delta = t},       TextEnd BlockEndPayload {contentIndex = i, content = t}     ]-  AssistantThinking ThinkingContent {thinking = t} ->+  AssistantThinking th@ThinkingContent {thinking = t} ->     [ ThinkingStart IndexPayload {contentIndex = i},       ThinkingDelta DeltaPayload {contentIndex = i, delta = t},-      ThinkingEnd BlockEndPayload {contentIndex = i, content = t}+      ThinkingEnd ThinkingEndPayload {contentIndex = i, content = th}     ]   AssistantToolCall tc ->     let argsText =@@ -354,8 +492,8 @@           ToolCallEnd ToolCallEndPayload {contentIndex = i, toolCall = tc}         ] -errorEvent :: Control.Exception.SomeException -> IO AssistantMessageEvent-errorEvent e = do+errorEvents :: Control.Exception.SomeException -> IO [AssistantMessageEvent]+errorEvents e = do   now <- getCurrentTime   -- When a @complete@ handler threw a typed 'BaikaiError' (the CLI,   -- 'Baikai.Auth', and registry paths do), preserve it structurally so a@@ -369,17 +507,21 @@         AssistantMessage           AssistantPayload             { Msg.content = Vector.empty,-              Msg.usage = _Usage,+              Msg.usage = zeroUsage,               Msg.stopReason = ErrorReason,               Msg.errorMessage = Just errText,-              Msg.timestamp = now+              Msg.timestamp = Just now             }-  pure (EventError (errorTerminal ErrorReason msg mErr))+      err = maybe (providerError errText) id mErr+  pure+    [ EventStart StartPayload {partial = msg, responseId = Nothing},+      EventError (errorTerminal Nothing ErrorReason msg err)+    ] --- | The single 'EventError' value used when no provider is--- registered for the model's API tag.-noProviderEvent :: Model -> IO AssistantMessageEvent-noProviderEvent m = do+-- | The synthetic error stream used when no provider is registered for+-- the model's API tag.+noProviderEvents :: Model -> IO [AssistantMessageEvent]+noProviderEvents m = do   now <- getCurrentTime   let detail = "No provider registered for API: " <> renderApi (m ^. #api)       be = providerUnavailable detail@@ -387,9 +529,12 @@         AssistantMessage           AssistantPayload             { Msg.content = Vector.empty,-              Msg.usage = _Usage,+              Msg.usage = zeroUsage,               Msg.stopReason = ErrorReason,               Msg.errorMessage = Just detail,-              Msg.timestamp = now+              Msg.timestamp = Just now             }-  pure (EventError (errorTerminal ErrorReason msg (Just be)))+  pure+    [ EventStart StartPayload {partial = msg, responseId = Nothing},+      EventError (errorTerminal Nothing ErrorReason msg be)+    ]

@@ -8,27 +8,32 @@ -- provider, model id), interleaves per-content-block lifecycle events -- (@_Start@ / @_Delta@ / @_End@) keyed by 'contentIndex', and -- terminates with exactly one 'EventDone' (success) or 'EventError'--- (any failure that bubbled out of the producer). The terminal event--- carries the fully assembled 'AssistantMessage' so a consumer that--- only pattern-matches on the terminal event still gets a correct--- response without folding deltas.+-- (any failure that bubbled out of the producer). This EventStart-first+-- invariant includes error-only streams produced by core dispatch and+-- request-preparation failures; they emit a synthetic skeleton before+-- the terminal error. One temporary provider-side gap remains: a Claude+-- mid-call failure before @message_start@ can still terminate without a+-- start event until the EP-7 Claude streaming rewrite pre-seeds its+-- skeleton. The terminal event carries the fully assembled+-- 'AssistantMessage' so a consumer that only pattern-matches on the+-- terminal event still gets a correct response without folding deltas. ----- The algebra is closed and shared by every provider in baikai 0.1.--- Adding a new variant is a breaking change to baikai's public--- surface. Consumers that prefer source resilience over exhaustiveness--- can include a final wildcard branch in their pattern match, but--- providers MUST NOT emit untyped provider-specific events through--- this algebra. Providers MUST emit @_Start@, then zero or more--- @_Delta@, then @_End@ for each content block in increasing--- @contentIndex@ order; the reassembler defends against missing--- @_End@ events but no built-in provider should rely on the recovery--- path.+-- The algebra is closed and shared by every provider. Adding a new+-- variant is a breaking change to baikai's public surface. Consumers+-- that prefer source resilience over exhaustiveness can include a+-- final wildcard branch in their pattern match, but providers MUST NOT+-- emit untyped provider-specific events through this algebra. Providers+-- MUST emit @_Start@, then zero or more @_Delta@, then @_End@ for each+-- content block in increasing @contentIndex@ order; the reassembler+-- defends against missing @_End@ events but no built-in provider should+-- rely on the recovery path. module Baikai.Stream.Event   ( AssistantMessageEvent (..),     StartPayload (..),     IndexPayload (..),     DeltaPayload (..),     BlockEndPayload (..),+    ThinkingEndPayload (..),     ToolCallEndPayload (..),     TerminalPayload (..),     doneTerminal,@@ -37,7 +42,7 @@   ) where -import Baikai.Content (ToolCall)+import Baikai.Content (ThinkingContent, ToolCall) import Baikai.Error (BaikaiError) import Baikai.Message (Message) import Baikai.StopReason (StopReason)@@ -59,8 +64,9 @@ -- partial (e.g. a @delta@ that throws on 'EventStart'); @-Wpartial-fields@ -- flags that latent runtime hazard. Same-shaped constructors share one -- payload type ('IndexPayload', 'DeltaPayload', 'BlockEndPayload',--- 'TerminalPayload'), so the payloads also collapse the repetition the--- flat encoding spread across twelve constructors.+-- 'ThinkingEndPayload', 'TerminalPayload'), so the payloads also+-- collapse the repetition the flat encoding spread across twelve+-- constructors. data AssistantMessageEvent   = -- | The first event in every stream. The payload's 'partial' is an     -- 'AssistantMessage' with empty content; downstream consumers that@@ -79,8 +85,10 @@     ThinkingStart IndexPayload   | -- | A chunk of reasoning text appended to the thinking block.     ThinkingDelta DeltaPayload-  | -- | The thinking block at @contentIndex@ is closed.-    ThinkingEnd BlockEndPayload+  | -- | The thinking block at @contentIndex@ is closed. The payload+    -- carries the full 'ThinkingContent', including provider+    -- signature and redacted flag when available.+    ThinkingEnd ThinkingEndPayload   | -- | A tool-call content block is about to receive argument-JSON     -- chunks. The tool's @id_@ and @name@ become known on this event     -- when the upstream API delivers them up front (Anthropic), or on@@ -107,9 +115,12 @@   deriving stock (Eq, Show, Generic)   deriving anyclass (ToJSON) --- | Payload of 'EventStart': the message skeleton observed up front.-newtype StartPayload = StartPayload-  { partial :: Message+-- | Payload of 'EventStart': the message skeleton observed up front,+-- plus the provider's message id when the provider learns it this+-- early (Anthropic's @message_start.id@). 'Nothing' otherwise.+data StartPayload = StartPayload+  { partial :: !Message,+    responseId :: !(Maybe Text)   }   deriving stock (Eq, Show, Generic)   deriving anyclass (ToJSON)@@ -130,8 +141,8 @@   deriving stock (Eq, Show, Generic)   deriving anyclass (ToJSON) --- | Payload of the text/thinking @_End@ events: the closed block's--- fully concatenated 'content'.+-- | Payload of the text @_End@ event: the closed block's fully+-- concatenated 'content'. data BlockEndPayload = BlockEndPayload   { contentIndex :: !Int,     content :: !Text@@ -139,6 +150,17 @@   deriving stock (Eq, Show, Generic)   deriving anyclass (ToJSON) +-- | Payload of 'ThinkingEnd': the closed thinking block in full —+-- concatenated reasoning text plus the provider 'signature' and+-- 'redacted' flag. The concatenation of the preceding+-- 'ThinkingDelta's equals the payload's @content.thinking@.+data ThinkingEndPayload = ThinkingEndPayload+  { contentIndex :: !Int,+    content :: !ThinkingContent+  }+  deriving stock (Eq, Show, Generic)+  deriving anyclass (ToJSON)+ -- | Payload of 'ToolCallEnd': the fully parsed 'toolCall'. data ToolCallEndPayload = ToolCallEndPayload   { contentIndex :: !Int,@@ -152,10 +174,12 @@ data TerminalPayload = TerminalPayload   { reason :: !StopReason,     message :: !Message,-    -- | Structured error detail for an 'EventError' terminal: the-    -- category, HTTP status, and any retry-after hint a caller needs to-    -- decide retry policy. 'Nothing' for a successful 'EventDone'-    -- terminal and for error terminals a provider could not classify.+    -- | The provider's message id when known by stream end. Consumers+    -- should prefer this over 'StartPayload.responseId'.+    responseId :: !(Maybe Text),+    -- | Structured error detail. Always 'Nothing' on 'EventDone' and+    -- always 'Just' on 'EventError'; use 'errorTerminal' to enforce the+    -- error-side invariant at construction sites.     errorInfo :: !(Maybe BaikaiError)   }   deriving stock (Eq, Show, Generic)@@ -164,13 +188,16 @@ -- | Build a success terminal payload ('errorInfo' is always 'Nothing'). -- Prefer this over the raw 'TerminalPayload' constructor so a new field -- can never be left uninitialised at a construction site.-doneTerminal :: StopReason -> Message -> TerminalPayload-doneTerminal r m = TerminalPayload {reason = r, message = m, errorInfo = Nothing}+doneTerminal :: Maybe Text -> StopReason -> Message -> TerminalPayload+doneTerminal rid r m =+  TerminalPayload {reason = r, message = m, responseId = rid, errorInfo = Nothing} --- | Build an error terminal payload carrying optional structured error--- detail. Prefer this over the raw 'TerminalPayload' constructor.-errorTerminal :: StopReason -> Message -> Maybe BaikaiError -> TerminalPayload-errorTerminal r m e = TerminalPayload {reason = r, message = m, errorInfo = e}+-- | Build an error terminal payload carrying structured error detail.+-- Prefer this over the raw 'TerminalPayload' constructor so an+-- 'EventError' cannot be constructed without 'errorInfo'.+errorTerminal :: Maybe Text -> StopReason -> Message -> BaikaiError -> TerminalPayload+errorTerminal rid r m e =+  TerminalPayload {reason = r, message = m, responseId = rid, errorInfo = Just e}  -- | 'True' when the event terminates the stream — exactly one -- 'EventDone' or 'EventError' is emitted per call.

@@ -20,6 +20,7 @@ module Baikai.Tool   ( Tool (..),     ToolChoice (..),+    emptyTool,     _Tool,   ) where@@ -76,10 +77,14 @@   toJSON = genericToJSON toolChoiceOptions  -- | An empty tool — useful as a base for record updates.-_Tool :: Tool-_Tool =+emptyTool :: Tool+emptyTool =   Tool     { name = Text.empty,       description = Text.empty,       parameters = Null     }++{-# DEPRECATED _Tool "Use emptyTool instead." #-}+_Tool :: Tool+_Tool = emptyTool

@@ -18,8 +18,10 @@ -- matching 'CallFinished' / 'CallFailed' before yielding the -- terminal event to the consumer. Cleanup ('Nothing' sentinel on -- the channel + 'takeMVar' on the worker) is idempotent and runs--- through 'Stream.finallyIO' so an early-aborting consumer never--- leaks the worker.+-- through 'Stream.finallyIO' so an early-aborting consumer eventually+-- records a synthetic 'CallFailed' and never leaks the worker. Sink+-- exceptions are captured by the worker and reported once on stderr+-- during cleanup; they do not propagate into the provider call. module Baikai.Trace   ( -- * Re-exports     TraceEvent (..),@@ -63,19 +65,21 @@ import Control.Concurrent (forkIO) import Control.Concurrent.Chan (Chan, newChan, readChan, writeChan) import Control.Concurrent.MVar (MVar, newEmptyMVar, putMVar, takeMVar)--- Control.Exception no longer needed; producer errors flow through--- the stream as 'EventError'.-import Control.Monad (unless)+import Control.Exception (SomeException, displayException, try)+import Control.Monad (forM_, unless) import Control.Monad.IO.Unlift (MonadUnliftIO, withRunInIO) import Data.Bits (unsafeShiftL, (.&.), (.|.))-import Data.IORef (IORef, atomicModifyIORef', newIORef)+import Data.IORef (IORef, atomicModifyIORef', newIORef, readIORef, writeIORef) import Data.Maybe (fromMaybe) import Data.Text qualified as Text import Data.Time (UTCTime, diffUTCTime, getCurrentTime) import Data.Time.Clock.POSIX (getPOSIXTime)+import Data.Word (Word64)+import Foreign.StablePtr (StablePtr, freeStablePtr, newStablePtr) import Numeric (showHex) import Streamly.Data.Stream (Stream) import Streamly.Data.Stream qualified as Stream+import System.IO (hPutStrLn, stderr) import System.IO.Unsafe (unsafePerformIO)  -- ============================================================@@ -119,8 +123,15 @@         let stepDrain () = do               msg <- readChan c               pure (fmap (\e -> (e, ())) msg)-        Stream.unfoldrM stepDrain ()-          & Stream.fold sinkFold+        result <-+          try+            ( Stream.unfoldrM stepDrain ()+                & Stream.fold sinkFold+            ) ::+            IO (Either SomeException ())+        case result of+          Left e -> writeIORef (state ^. #sinkError) (Just e)+          Right () -> pure ()         putMVar d ()     eid <- newEventId     start <- getCurrentTime@@ -136,7 +147,7 @@           }     pure $       Stream.finallyIO-        (cleanupTrace state)+        (finalizeTrace state eid start m)         (Stream.mapM (traceEvent state eid start m) (streamRequestWith reg m ctx opts))  -- | Synchronous trace wrapper. Drains 'withTraceStream' into a@@ -180,7 +191,10 @@ data TraceState = TraceState   { chan :: !(Chan (Maybe TraceEvent)),     done :: !(MVar ()),-    closed :: !(IORef Bool)+    closed :: !(IORef Bool),+    sinkError :: !(IORef (Maybe SomeException)),+    terminalSent :: !(IORef Bool),+    stableRoot :: !(IORef (Maybe (StablePtr TraceState)))   }   deriving stock (Generic) @@ -189,16 +203,50 @@   c <- newChan   d <- newEmptyMVar   r <- newIORef False-  pure TraceState {chan = c, done = d, closed = r}+  e <- newIORef Nothing+  t <- newIORef False+  root <- newIORef Nothing+  let state = TraceState {chan = c, done = d, closed = r, sinkError = e, terminalSent = t, stableRoot = root}+  sp <- newStablePtr state+  writeIORef root (Just sp)+  pure state -cleanupTrace :: TraceState -> IO ()-cleanupTrace s = do+finalizeTrace :: TraceState -> Text -> UTCTime -> Model -> IO ()+finalizeTrace s eid start m = do   alreadyClosed <-     atomicModifyIORef' (s ^. #closed) (\b -> (True, b))   unless alreadyClosed $ do+    sent <- readIORef (s ^. #terminalSent)+    unless sent $ do+      now <- getCurrentTime+      writeChan (s ^. #chan) $+        Just+          CallFailed+            { eventId = eid,+              timestamp = now,+              provider = m ^. #provider,+              model = m ^. #modelId,+              latencyMs = millisBetween start now,+              errorMessage = "aborted: stream consumer stopped before the terminal event"+            }     writeChan (s ^. #chan) Nothing     takeMVar (s ^. #done)+    reportSinkError s+    releaseStableRoot s +releaseStableRoot :: TraceState -> IO ()+releaseStableRoot s = do+  msp <- atomicModifyIORef' (s ^. #stableRoot) (\sp -> (Nothing, sp))+  forM_ msp freeStablePtr++reportSinkError :: TraceState -> IO ()+reportSinkError s = do+  merr <- readIORef (s ^. #sinkError)+  forM_ merr $ \e ->+    hPutStrLn+      stderr+      ("baikai: trace sink failed; trace events for this call were dropped: " <> displayException e)+ traceEvent ::   TraceState ->   Text ->@@ -228,7 +276,8 @@                     else Nothing               }       writeChan (state ^. #chan) (Just finished)-      cleanupTrace state+      writeIORef (state ^. #terminalSent) True+      finalizeTrace state eid start m     EventError TerminalPayload {message = msg} -> do       now <- getCurrentTime       let latency = millisBetween start now@@ -245,7 +294,8 @@                 errorMessage = errMsg               }       writeChan (state ^. #chan) (Just failed)-      cleanupTrace state+      writeIORef (state ^. #terminalSent) True+      finalizeTrace state eid start m     _ -> pure ()   pure ev @@ -324,20 +374,26 @@ resolvedMaxTokens :: Model -> Options -> Natural resolvedMaxTokens m opts = fromMaybe (m ^. #maxOutputTokens) (opts ^. #maxTokens) -millisBetween :: UTCTime -> UTCTime -> Integer+millisBetween :: UTCTime -> UTCTime -> Int millisBetween a b = round (realToFrac (diffUTCTime b a) * (1000 :: Double))  -- ============================================================ -- Event id -- ============================================================ +-- | Generate a 16-character lowercase hexadecimal event id. The high+-- 32 bits are derived from process-start POSIX seconds and the low+-- 32 bits are a process-local counter, so ids are unique within a+-- process for 2^32 calls. newEventId :: IO Text newEventId = do   n <- atomicModifyIORef' eventCounter (\k -> (k + 1, k))-  let raw :: Word-      raw = (eventBase .&. 0xFFFF) `unsafeShiftL` 16 .|. (n .&. 0xFFFF)+  let raw :: Word64+      raw =+        (fromIntegral eventBase .&. 0xFFFFFFFF) `unsafeShiftL` 32+          .|. (fromIntegral n .&. 0xFFFFFFFF)       hex = showHex raw ""-      padded = replicate (8 - length hex) '0' <> hex+      padded = replicate (16 - length hex) '0' <> hex   pure (Text.pack padded)  eventCounter :: IORef Word

@@ -51,7 +51,7 @@         timestamp :: !UTCTime,         provider :: !Text,         model :: !Text,-        latencyMs :: !Integer,+        latencyMs :: !Int,         inputTokens :: !(Maybe Natural),         outputTokens :: !(Maybe Natural),         usd :: !(Maybe Scientific)@@ -61,7 +61,7 @@         timestamp :: !UTCTime,         provider :: !Text,         model :: !Text,-        latencyMs :: !Integer,+        latencyMs :: !Int,         errorMessage :: !Text       }   deriving stock (Eq, Show, Generic)

@@ -1,14 +1,30 @@ -- | Token-usage accounting for a single provider call. ----- The shape splits cache-read tokens (the prompt fragment served from a--- prior cache write) from cache-write tokens (the prompt fragment the--- provider stored for future calls), so callers can reason about both--- billing dimensions. 'cost' is always populated — providers without--- pricing data fill it with '_Cost' (zero across all rates) rather than--- a 'Nothing' that every cost-reading caller would have to handle.-module Baikai.Usage (Usage (..), _Usage, sumUsage) where+-- The prompt-side fields are provider-normalized into disjoint token+-- classes. 'inputTokens' counts only non-cached prompt tokens and+-- excludes both cache counters. 'cacheReadTokens' counts prompt tokens+-- served from a provider-side cache; 'cacheWriteTokens' counts prompt+-- tokens stored for future cache reads. Providers whose wire format is+-- inclusive, such as OpenAI Chat Completions where @prompt_tokens@+-- includes @prompt_tokens_details.cached_tokens@, must normalize by+-- subtraction when constructing 'Usage'.+--+-- 'totalTokens' is the sum of the billed token classes:+-- 'inputTokens' + 'outputTokens' + 'cacheReadTokens' ++-- 'cacheWriteTokens'. Provider mappings compute it from the normalized+-- parts rather than trusting a wire total. 'reasoningTokens', when+-- present, is an informational subset of 'outputTokens'; it is already+-- counted in 'outputTokens' and 'totalTokens' and is not billed+-- separately.+--+-- 'cost' is always populated — providers without pricing data fill it+-- with 'zeroCost' (zero across all rates) rather than a 'Nothing' that+-- every cost-reading caller would have to handle. 'Baikai.Cost.Pricing.computeCost'+-- depends on the token classes being disjoint so each class is billed+-- exactly once.+module Baikai.Usage (Usage (..), zeroUsage, _Usage, sumUsage) where -import Baikai.Cost (Cost, _Cost)+import Baikai.Cost (Cost, zeroCost) import Data.Aeson   ( Options (fieldLabelModifier),     ToJSON (toJSON),@@ -20,13 +36,34 @@ import GHC.Generics (Generic) import Numeric.Natural (Natural) +-- | Provider-normalized token usage for one model call.+--+-- The prompt-side classes are disjoint: 'inputTokens' excludes+-- 'cacheReadTokens' and 'cacheWriteTokens'. 'totalTokens' is the sum+-- of all billed token classes, and 'reasoningTokens' is an optional+-- breakdown already included in 'outputTokens'. data Usage = Usage-  { inputTokens :: !Natural,+  { -- | Non-cached prompt tokens. Excludes 'cacheReadTokens' and+    -- 'cacheWriteTokens'.+    inputTokens :: !Natural,+    -- | Output tokens billed at the model's output rate. Any+    -- 'reasoningTokens' are already included here.     outputTokens :: !Natural,+    -- | Prompt tokens served from a provider-side cache.     cacheReadTokens :: !Natural,+    -- | Prompt tokens written into a provider-side cache for future+    -- reads.     cacheWriteTokens :: !Natural,+    -- | Optional reasoning/thinking-token breakdown. These tokens are+    -- an informational subset of 'outputTokens', not an additional+    -- billed class.     reasoningTokens :: !(Maybe Natural),+    -- | Sum of the billed token classes:+    -- 'inputTokens' + 'outputTokens' + 'cacheReadTokens' ++    -- 'cacheWriteTokens'.     totalTokens :: !Natural,+    -- | Computed cost for this usage. Providers without pricing data+    -- use 'zeroCost'.     cost :: !Cost   }   deriving stock (Eq, Show, Generic)@@ -36,8 +73,9 @@  instance ToJSON Usage where toJSON = genericToJSON usageOptions -_Usage :: Usage-_Usage =+-- | Empty usage with every count and cost set to zero.+zeroUsage :: Usage+zeroUsage =   Usage     { inputTokens = 0,       outputTokens = 0,@@ -45,7 +83,7 @@       cacheWriteTokens = 0,       reasoningTokens = Nothing,       totalTokens = 0,-      cost = _Cost+      cost = zeroCost     }  -- | Combine two optional reasoning-token counts. Presence wins: an@@ -69,8 +107,12 @@       }  instance Monoid Usage where-  mempty = _Usage+  mempty = zeroUsage  -- | Total a collection of per-call usages into one. sumUsage :: (Foldable f) => f Usage -> Usage sumUsage = foldl' (<>) mempty++{-# DEPRECATED _Usage "Use zeroUsage instead." #-}+_Usage :: Usage+_Usage = zeroUsage

@@ -0,0 +1,32 @@+module CliInternalSpec (tests) where++import Baikai+import Baikai.Provider.Cli.Internal+import Control.Lens ((&), (.~))+import Data.Vector qualified as Vector+import Test.Tasty (TestTree, testGroup)+import Test.Tasty.HUnit (testCase, (@?=))++tests :: TestTree+tests =+  testGroup+    "CLI internal helpers"+    [ testCase "renderPrompt returns a single user text message verbatim" $ do+        let ctx = emptyContext & #messages .~ Vector.singleton (user "hello")+        renderPrompt ctx @?= "hello",+      testCase "renderPrompt tags multi-message contexts" $ do+        let ctx =+              emptyContext+                & #messages+                  .~ Vector.fromList+                    [ user "hello",+                      assistant "hi"+                    ]+        renderPrompt ctx @?= "[user]: hello\n[assistant]: hi",+      testCase "wrapSystemPrompt leaves missing and blank prompts alone" $ do+        wrapSystemPrompt Nothing "hello" @?= "hello"+        wrapSystemPrompt (Just "  ") "hello" @?= "hello",+      testCase "wrapSystemPrompt prefixes nonblank system instructions" $+        wrapSystemPrompt (Just "Be terse.") "hi"+          @?= "System instructions:\nBe terse.\n\nUser request:\nhi"+    ]

@@ -0,0 +1,133 @@+module ContextSpec (tests) where++import Baikai+import Control.Lens ((&), (.~), (^.))+import Data.Aeson qualified as Aeson+import Data.Time (UTCTime)+import Data.Vector qualified as V+import Test.Tasty (TestTree, testGroup)+import Test.Tasty.HUnit (testCase, (@?=))++tests :: TestTree+tests =+  testGroup+    "Context helpers"+    [ monoidTests,+      constructorTests,+      timestampTests,+      flattenTextTests+    ]++monoidTests :: TestTree+monoidTests =+  testGroup+    "Monoid"+    [ testCase "has left and right identity" $ do+        let ctx =+              emptyContext+                { systemPrompt = Just "sys",+                  messages = V.fromList [user "one"],+                  tools = V.singleton sampleTool+                }+        mempty <> ctx @?= ctx+        ctx <> mempty @?= ctx,+      testCase "is associative and keeps the first system prompt" $ do+        let a = systemUser "a-system" "a"+            b = addUser "b" emptyContext+            c =+              emptyContext+                { systemPrompt = Just "c-system",+                  messages = V.fromList [assistant "c"],+                  tools = V.singleton sampleTool+                }+        (a <> b) <> c @?= a <> (b <> c)+        (a <> b <> c) ^. #systemPrompt @?= Just "a-system"+        (b <> c) ^. #systemPrompt @?= Just "c-system"+    ]++constructorTests :: TestTree+constructorTests =+  testGroup+    "constructors"+    [ testCase "contextOf preserves message order" $ do+        contextOf [user "one", assistant "two"] ^. #messages+          @?= V.fromList [user "one", assistant "two"],+      testCase "systemUser creates a system prompt and one user message" $ do+        let ctx = systemUser "system" "prompt"+        ctx ^. #systemPrompt @?= Just "system"+        ctx ^. #messages @?= V.singleton (user "prompt"),+      testCase "addMessage, addUser, and addResponse append in order" $ do+        let resp =+              emptyResponse+                & #message+                  .~ AssistantPayload+                    { content = V.singleton (AssistantText (TextContent "response")),+                      usage = zeroUsage,+                      stopReason = Stop,+                      errorMessage = Nothing,+                      timestamp = Nothing+                    }+            ctx =+              emptyContext+                |> addUser "first"+                |> addMessage (assistant "second")+                |> addResponse resp+        ctx ^. #messages+          @?= V.fromList+            [ user "first",+              assistant "second",+              responseMessage resp+            ]+    ]++timestampTests :: TestTree+timestampTests =+  testGroup+    "timestamps"+    [ testCase "pure constructors do not invent timestamps" $ do+        payloadTimestamp (user "plain") @?= Nothing+        payloadTimestamp (assistant "plain") @?= Nothing+        payloadTimestamp (toolResult "call" "tool" "ok" False) @?= Nothing,+      testCase "explicit constructors preserve timestamps" $ do+        let ts = read "2026-06-05 01:02:03 UTC"+        payloadTimestamp (userAt ts "plain") @?= Just ts+        payloadTimestamp (assistantAt ts "plain") @?= Just ts+        payloadTimestamp (toolResultAt ts "call" "tool" "ok" False) @?= Just ts+    ]++flattenTextTests :: TestTree+flattenTextTests =+  testGroup+    "flattenAssistantText"+    [ testCase "concatenates only text blocks" $ do+        flattenAssistantText+          ( V.fromList+              [ AssistantText (TextContent "hello"),+                AssistantThinking+                  ThinkingContent+                    { thinking = "hidden",+                      signature = Nothing,+                      redacted = False+                    },+                AssistantToolCall emptyToolCall {name = "lookup", arguments = Aeson.object []},+                AssistantText (TextContent " world")+              ]+          )+          @?= "hello world"+    ]++sampleTool :: Tool+sampleTool =+  emptyTool+    { name = "lookup",+      description = "Lookup a value",+      parameters = Aeson.object []+    }++payloadTimestamp :: Message -> Maybe UTCTime+payloadTimestamp (UserMessage UserPayload {timestamp = ts}) = ts+payloadTimestamp (AssistantMessage AssistantPayload {timestamp = ts}) = ts+payloadTimestamp (ToolResultMessage ToolResultPayload {timestamp = ts}) = ts++(|>) :: a -> (a -> b) -> b+(|>) x f = f x

@@ -2,18 +2,19 @@  import Baikai.Api (Api (..)) import Baikai.Content (AssistantContent (..), TextContent (..))-import Baikai.Context (Context (..), _Context)+import Baikai.Context (Context (..), emptyContext) import Baikai.Cost qualified as Cost import Baikai.Cost.Log   ( CallLogConfig (..),-    CallLogEntry,+    CallLogEntry (..),+    appendEntry,     runRequestWithLog,     withCallLog,   ) import Baikai.Cost.Pricing (attachCost, computeCost) import Baikai.Message (AssistantPayload (..), user)-import Baikai.Model (Model (..), ModelCost (..), _Model)-import Baikai.Options (Options, _Options)+import Baikai.Model (Model (..), ModelCost (..), emptyModel)+import Baikai.Options (Options, emptyOptions) import Baikai.Prelude import Baikai.Provider   ( ApiProvider (..),@@ -22,14 +23,16 @@ import Baikai.Response (Response (..), flattenAssistantBlocks) import Baikai.StopReason (StopReason (..)) import Baikai.Stream (liftCompleteToStream)-import Baikai.Usage (Usage, _Usage)+import Baikai.Usage (Usage, zeroUsage) import Data.Aeson qualified as Aeson import Data.ByteString.Lazy.Char8 qualified as BSL import Data.List.NonEmpty (NonEmpty ((:|)), nonEmpty) import Data.Maybe (fromJust, isJust)+import Data.Time (getCurrentTime) import Data.Vector qualified as V import System.Directory (getTemporaryDirectory, removeFile) import System.FilePath ((</>))+import System.Timeout (timeout) import Test.Tasty (TestTree, testGroup) import Test.Tasty.HUnit (testCase, (@?=)) @@ -47,7 +50,7 @@ -- 1000*(1/1_000_000) + 500*(5/1_000_000) = 7/2000 USD. sampleUsage :: Usage sampleUsage =-  _Usage+  zeroUsage     & #inputTokens     .~ 1000     & #outputTokens@@ -58,7 +61,7 @@ -- cache-read $0.10/M, cache-write $1.25/M. knownModel :: Model knownModel =-  _Model+  emptyModel     & #modelId     .~ "claude-haiku-4-5-20251001"     & #api@@ -75,7 +78,7 @@  unknownModel :: Model unknownModel =-  _Model+  emptyModel     & #modelId     .~ "totally-fake-model"     & #api@@ -94,14 +97,14 @@       testCase "cacheReadTokens contribute when present" $ do         let u :: Usage             u =-              _Usage+              zeroUsage                 & #cacheReadTokens                 .~ 1000         Cost.usd (computeCost knownModel u) @?= 1 / 10000,       testCase "cacheWriteTokens contribute against the known model" $ do         let u :: Usage             u =-              _Usage+              zeroUsage                 & #cacheWriteTokens                 .~ 1000         Cost.usd (computeCost knownModel u) @?= 1 / 800@@ -132,7 +135,7 @@                 usage = sampleUsage,                 stopReason = Stop,                 errorMessage = Nothing,-                timestamp = read "2026-05-14 00:00:00 UTC"+                timestamp = Just (read "2026-05-14 00:00:00 UTC")               },           model = m,           api = Custom "test",@@ -157,7 +160,7 @@                 usage = u,                 stopReason = Stop,                 errorMessage = Nothing,-                timestamp = read "2026-05-14 00:00:00 UTC"+                timestamp = Just (read "2026-05-14 00:00:00 UTC")               },           model = knownModel & #api .~ cannedApi,           api = cannedApi,@@ -181,10 +184,10 @@ cannedModel = knownModel & #api .~ cannedApi  ctxHello :: Context-ctxHello = _Context & #messages .~ V.fromList [user "Hello world"]+ctxHello = emptyContext & #messages .~ V.fromList [user "Hello world"]  optsZero :: Options-optsZero = _Options+optsZero = emptyOptions  callLogTests :: TestTree callLogTests =@@ -223,5 +226,25 @@         entry ^. #latencyMs @?= 7         entry ^. #promptSummary @?= "Hello world"         isJust (entry ^. #usd) @?= True-        removeFile path'+        removeFile path',+      testCase "closeCallLog returns even when the log path is unwritable" $ do+        tmp <- getTemporaryDirectory+        let missing = tmp </> "baikai-costspec-no-such-dir" </> "entries.jsonl"+            cfg = CallLogConfig {path = missing, enabled = True}+        now <- getCurrentTime+        let entry =+              CallLogEntry+                { timestamp = now,+                  provider = "test",+                  model = "m",+                  inputTokens = Nothing,+                  outputTokens = Nothing,+                  cachedInputTokens = Nothing,+                  reasoningTokens = Nothing,+                  usd = Nothing,+                  latencyMs = 0,+                  promptSummary = ""+                }+        result <- timeout 5000000 (withCallLog cfg (\h -> appendEntry h entry))+        result @?= Just ()     ]

@@ -7,7 +7,8 @@ -- default run stays offline. module EmbeddingSpec (tests) where -import Baikai.Embedding (embedOne, mkEmbeddingRequest, openAIEmbeddingModel)+import Baikai.Embedding (embedOne, firstEmbedding, mkEmbeddingRequest, openAIEmbeddingModel)+import Baikai.Error (decodeError) import Data.Vector qualified as V import OpenAI.V1.Embeddings qualified as Emb import OpenAI.V1.Models qualified as OpenAIModels@@ -24,6 +25,17 @@         Emb.input req @?= "hello"         OpenAIModels.text (Emb.model req) @?= "text-embedding-3-small"         Emb.dimensions req @?= Nothing,+      testCase "firstEmbedding reports an empty data array as a typed decode error" $ do+        firstEmbedding V.empty @?= Left (decodeError "embeddings response contained no data"),+      testCase "firstEmbedding extracts the first vector" $ do+        let vec = V.fromList [0.1, 0.2, 0.3]+            obj =+              Emb.EmbbeddingObject+                { Emb.index = 0,+                  Emb.embedding = vec,+                  Emb.object = "embedding"+                }+        firstEmbedding (V.singleton obj) @?= Right vec,       testCase "live embedding returns a 1536-length vector" $ do         live <- lookupEnv "BAIKAI_EMBEDDING_LIVE"         case live of

@@ -9,14 +9,14 @@ import Baikai.Prelude import Streamly.Data.Stream qualified as Stream import Test.Tasty (TestTree, testGroup)-import Test.Tasty.HUnit (assertFailure, testCase, (@?=))+import Test.Tasty.HUnit (assertBool, assertFailure, testCase, (@?=))  errApi :: Api errApi = Custom "baikai-errinfo"  errModel :: Model errModel =-  _Model+  emptyModel     & #modelId     .~ "err-model"     & #api@@ -29,18 +29,24 @@ errStream :: Model -> Context -> Options -> Stream.Stream IO AssistantMessageEvent errStream _ _ _ =   let payload =-        (_Response ^. #message)+        (emptyResponse ^. #message)           & #stopReason           .~ ErrorReason           & #errorMessage           .~ Just "rate limited, slow down"       term =         errorTerminal+          Nothing           ErrorReason           (AssistantMessage payload)-          (Just (rateLimited (Just 5) "rate limited, slow down"))-   in Stream.fromList [EventError term]+          (rateLimited (Just 5) "rate limited, slow down")+      start = EventStart StartPayload {partial = AssistantMessage payload, responseId = Nothing}+   in Stream.fromList [start, EventError term] +errResponse :: Model -> Context -> Options -> IO Response+errResponse m _ _ =+  pure (errorResponse m (read "2026-06-05 00:00:00 UTC") 0 (rateLimited (Just 5) "rate limited, slow down"))+ registerErr :: IO () registerErr =   registerApiProvider@@ -56,10 +62,47 @@     "Response.errorInfo threading"     [ testCase "completeRequest surfaces structured errorInfo" $ do         registerErr-        resp <- completeRequest errModel _Context _Options-        case resp ^. #errorInfo of+        resp <- completeRequest errModel emptyContext emptyOptions+        case responseError resp of           Just be -> do             be ^. #category @?= RateLimited             be ^. #retryAfterSeconds @?= Just 5-          Nothing -> assertFailure "expected Response.errorInfo to be populated"+          Nothing -> assertFailure "expected Response.errorInfo to be populated",+      testCase "completeRequestWith reports missing provider in-band" $ do+        reg <- newProviderRegistry+        resp <- completeRequestWith reg errModel emptyContext emptyOptions+        case responseError resp of+          Just be -> be ^. #category @?= ProviderUnavailable+          Nothing -> assertFailure "expected ProviderUnavailable response",+      testCase "liftCompleteToStream preserves error-shaped responses as EventError" $ do+        let stream = liftCompleteToStream errResponse+        events <- Stream.toList (stream errModel emptyContext emptyOptions)+        assertBool "expected exactly one terminal" (length (filter isTerminal events) == 1)+        case last events of+          EventError TerminalPayload {errorInfo = Just be} -> do+            be ^. #category @?= RateLimited+            be ^. #retryAfterSeconds @?= Just 5+          other -> assertFailure ("expected terminal EventError, got: " <> show other),+      testCase "reassembly normalizes ErrorReason terminals without errorInfo" $ do+        let payload =+              (emptyResponse ^. #message)+                & #stopReason+                .~ ErrorReason+                & #errorMessage+                .~ Just "legacy unclassified failure"+            terminal =+              doneTerminal+                Nothing+                ErrorReason+                (AssistantMessage payload)+            events =+              [ EventStart StartPayload {partial = AssistantMessage payload, responseId = Nothing},+                EventDone terminal+              ]+        resp <- Stream.fold (reassembleResponse errModel) (Stream.fromList events)+        case responseError resp of+          Just be -> do+            be ^. #category @?= OtherError+            be ^. #message @?= "legacy unclassified failure"+          Nothing -> assertFailure "expected synthesized errorInfo"     ]

@@ -6,8 +6,10 @@     classifyHttpStatus,     classifyHttpStatusWithBody,     decodeError,+    httpError,     invalidRequest,     isRetryable,+    parseRetryAfterSeconds,     processError,     rateLimited,   )@@ -20,8 +22,27 @@     "Baikai.Error"     [ classifyTests,       bodyClassifyTests,+      httpHelperTests,       retryTests,       constructorTests+    ]++httpHelperTests :: TestTree+httpHelperTests =+  testGroup+    "httpError / parseRetryAfterSeconds"+    [ testCase "429 + retry-after -> RateLimited with hint" $ do+        let e = httpError 429 (Just 12) "slow down"+        category e @?= RateLimited+        httpStatus e @?= Just 429+        retryAfterSeconds e @?= Just 12,+      testCase "400 + overflow body -> ContextOverflow" $+        category (httpError 400 Nothing "maximum context length exceeded")+          @?= ContextOverflow,+      testCase "integer Retry-After parses as seconds" $+        parseRetryAfterSeconds "12" @?= Just 12,+      testCase "HTTP-date Retry-After is ignored" $+        parseRetryAfterSeconds "Wed, 21 Oct 2026 07:28:00 GMT" @?= Nothing     ]  bodyClassifyTests :: TestTree

@@ -1,5 +1,3 @@-{-# LANGUAGE OverloadedStrings #-}- -- | Unit tests for the pure core of @baikai-fetch-models@ -- ('FetchModelsCore'): filtering, curation, modality mapping, cost -- defaulting, and rendering, exercised against a checked-in@@ -7,15 +5,21 @@ module FetchModelsSpec (tests) where  import Baikai.Model (InputModality (..))+import Baikai.Prelude+import Data.Aeson qualified as Aeson+import Data.Aeson.KeyMap qualified as KeyMap import Data.ByteString.Lazy qualified as BSL+import Data.Generics.Labels () import Data.Map.Strict (Map) import Data.Map.Strict qualified as Map-import Data.Text (Text)+import Data.Maybe (listToMaybe)+import Data.Scientific (Scientific) import Data.Text qualified as Text import Data.Text.Encoding (decodeUtf8)+import Data.Vector qualified as V import FetchModelsCore import Test.Tasty (TestTree, testGroup)-import Test.Tasty.HUnit (assertBool, testCase, (@?=))+import Test.Tasty.HUnit (assertBool, assertFailure, testCase, (@?=))  -- | Path to the fixture, relative to the @baikai@ package directory -- (tests run with that as the working directory, as 'CatalogSpec'@@ -33,7 +37,7 @@ -- | Build a provider catalog from the fixture. catalogFor :: Map Text (Map Text UpstreamModel) -> ProviderSpec -> Catalog catalogFor upstream spec =-  normalizeProvider spec (Map.findWithDefault Map.empty (psProvider spec) upstream)+  normalizeProvider spec (Map.findWithDefault Map.empty (spec ^. #provider) upstream)  -- | Expected OpenAI catalog after normalization. @gpt-5-pro@ is -- excluded by curation (Responses-API-only) and @gpt-legacy-nontool@@@ -42,27 +46,27 @@ expectedOpenAI :: Catalog expectedOpenAI =   Catalog-    { cProvider = "openai",-      cBaseUrl = "https://api.openai.com",-      cApi = "openai-chat-completions",-      cModels =+    { provider = "openai",+      baseUrl = "https://api.openai.com",+      api = "openai-chat-completions",+      models =         [ CatalogModel-            { cmId = "gpt-5-nano",-              cmName = "GPT-5 Nano",-              cmReasoning = True,-              cmInput = [InputText, InputImage],-              cmCost = CatalogCost 0.05 0.4 0 0,-              cmContextWindow = 400000,-              cmMaxOutputTokens = 128000+            { modelId = "gpt-5-nano",+              name = "GPT-5 Nano",+              reasoning = True,+              input = [InputText, InputImage],+              cost = CatalogCost 0.05 0.4 0 0,+              contextWindow = 400000,+              maxOutputTokens = 128000             },           CatalogModel-            { cmId = "gpt-5.4",-              cmName = "GPT-5.4",-              cmReasoning = True,-              cmInput = [InputText, InputImage],-              cmCost = CatalogCost 2.5 15 0.25 0,-              cmContextWindow = 1050000,-              cmMaxOutputTokens = 128000+            { modelId = "gpt-5.4",+              name = "GPT-5.4",+              reasoning = True,+              input = [InputText, InputImage],+              cost = CatalogCost 2.5 15 0.25 0,+              contextWindow = 1050000,+              maxOutputTokens = 128000             }         ]     }@@ -76,11 +80,11 @@         catalogFor upstream openaiSpec @?= expectedOpenAI,       testCase "tool_call: false model is excluded" $ do         upstream <- loadUpstream-        let ids = map cmId (cModels (catalogFor upstream openaiSpec))+        let ids = map (^. #modelId) (catalogFor upstream openaiSpec ^. #models)         assertBool "gpt-legacy-nontool must be filtered" ("gpt-legacy-nontool" `notElem` ids),       testCase "Responses-API-only id is excluded by curation" $ do         upstream <- loadUpstream-        let ids = map cmId (cModels (catalogFor upstream openaiSpec))+        let ids = map (^. #modelId) (catalogFor upstream openaiSpec ^. #models)         assertBool "gpt-5-pro must be excluded" ("gpt-5-pro" `notElem` ids),       testCase "pdf modality is dropped" $ do         upstream <- loadUpstream@@ -104,10 +108,67 @@         assertBool           "output 15 renders as 15.0"           ("\"output\": 15.0" `Text.isInfixOf` rendered),+      testCase "renderCatalog escapes control characters as valid JSON strings" $ do+        let modelIdWithControls = "model-\n-tab\t-quote\"-slash\\"+            nameWithControls = "Name with \r carriage return"+            catalog =+              Catalog+                { provider = "openai",+                  baseUrl = "https://api.openai.com",+                  api = "openai-chat-completions",+                  models =+                    [ CatalogModel+                        { modelId = modelIdWithControls,+                          name = nameWithControls,+                          reasoning = False,+                          input = [InputText],+                          cost = CatalogCost 0 0 0 0,+                          contextWindow = 1,+                          maxOutputTokens = 1+                        }+                    ]+                }+            rendered = renderText catalog+            raw = BSL.fromStrict (renderCatalog catalog)+            decoded = Aeson.eitherDecode raw :: Either String Aeson.Value+        case decoded of+          Left err -> assertFailure ("decode failed: " <> err)+          Right (Aeson.Object root) ->+            case KeyMap.lookup "models" root of+              Just (Aeson.Array models)+                | Just (Aeson.Object model) <- models V.!? 0 -> do+                    KeyMap.lookup "id" model @?= Just (Aeson.String modelIdWithControls)+                    KeyMap.lookup "name" model @?= Just (Aeson.String nameWithControls)+              _ -> assertFailure "decoded catalog did not contain a model object"+          Right other -> assertFailure ("decoded catalog was not an object: " <> show other)+        assertBool "newline escaped" ("\\n" `Text.isInfixOf` rendered)+        assertBool "tab escaped" ("\\t" `Text.isInfixOf` rendered),       testCase "Anthropic curation keeps exactly the one fixture model" $ do         upstream <- loadUpstream-        let ids = map cmId (cModels (catalogFor upstream anthropicSpec))-        ids @?= ["claude-opus-4-5"]+        let ids = map (^. #modelId) (catalogFor upstream anthropicSpec ^. #models)+        ids @?= ["claude-opus-4-5"],+      testCase "\" (latest)\" suffix is stripped from display names" $ do+        upstream <- loadUpstream+        let cat = catalogFor upstream anthropicSpec+        map (^. #name) (cat ^. #models) @?= ["Claude Opus 4.5"],+      testCase "override corrects a deliberately-wrong upstream cache price" $ do+        upstream <- loadUpstream+        -- Fixture upstream reports cache_read 1.5 for claude-opus-4-5+        -- (the 3x wart); normalization alone preserves it, the override+        -- pins it to the published 0.5.+        let normalized = catalogFor upstream anthropicSpec+            corrected = applyOverrides overrides normalized+        opusCacheRead normalized @?= Just 1.5+        opusCacheRead corrected @?= Just 0.5+    ]++-- | The @claude-opus-4-5@ cacheRead cost in an Anthropic catalog.+opusCacheRead :: Catalog -> Maybe Scientific+opusCacheRead cat =+  listToMaybe+    [ m ^. #cost . #cacheReadCost+    | m <- cat ^. #models,+      m ^. #modelId == "claude-opus-4-5"     ]  renderText :: Catalog -> Text

@@ -0,0 +1,56 @@+module GenModelsSpec (tests) where++import Baikai.Api (Api (OpenAIChatCompletions))+import Baikai.Model (InputModality (InputText))+import Data.Text (Text)+import Data.Text qualified as Text+import GenModelsCore+import Test.Tasty (TestTree, testGroup)+import Test.Tasty.HUnit (assertBool, assertFailure, testCase)++tests :: TestTree+tests =+  testGroup+    "Baikai.GenModels"+    [ testCase "checkIdentifierCollisions rejects sanitized binding duplicates" $ do+        let entries = flattenEntries collisionCatalog+        case checkIdentifierCollisions entries of+          Right () -> assertFailure "expected duplicate generated identifier to be rejected"+          Left err -> do+            assertBool "mentions duplicate identifier" ("openai_a_b" `Text.isInfixOf` err)+            assertBool "mentions first origin" ("openai/a-b" `Text.isInfixOf` err)+            assertBool "mentions second origin" ("openai/a_b" `Text.isInfixOf` err)+    ]++collisionCatalog :: CatalogFile+collisionCatalog =+  CatalogFile+    { provider = "openai",+      baseUrl = "https://api.openai.com",+      api = OpenAIChatCompletions,+      compat = CatalogCompatAuto,+      models =+        [ model "a-b",+          model "a_b"+        ]+    }++model :: Text -> ModelEntry+model mid =+  ModelEntry+    { entryId = mid,+      entryName = mid,+      entryReasoning = False,+      entryInput = [InputText],+      entryCost =+        CostEntry+          { costInput = 0,+            costOutput = 0,+            costCacheRead = 0,+            costCacheWrite = 0+          },+      entryContextWindow = 1,+      entryMaxOutputTokens = 1,+      entryEnabled = True,+      entryCompatOverride = Nothing+    }

@@ -0,0 +1,339 @@+module HelpersSpec (tests) where++import Baikai+import Baikai.Prelude+import Control.Exception qualified as Exception+import Data.Aeson qualified as Aeson+import Data.IORef (IORef, atomicModifyIORef', newIORef, readIORef)+import Data.Text qualified as Text+import Data.Time (UTCTime)+import Data.Vector qualified as Vector+import Streamly.Data.Stream qualified as Stream+import System.Environment qualified as Environment+import Test.Tasty (TestTree, testGroup)+import Test.Tasty.HUnit (assertBool, assertFailure, testCase, (@?=))++helpersApi :: Api+helpersApi = Custom "baikai-helpers-test"++helpersModel :: Model+helpersModel =+  emptyModel+    & #modelId+    .~ "helpers-model"+    & #api+    .~ helpersApi+    & #provider+    .~ "helpers"++epoch :: UTCTime+epoch = read "2026-06-05 00:00:00 UTC"++tests :: TestTree+tests =+  testGroup+    "Baikai helpers"+    [ testCase "runToolLoop resolves repeated tool turns and leaves final response separate" $ do+        scripted <- newScripted [toolUseResponse "call_1" "get_time", toolUseResponse "call_2" "get_time", textResponse "done"] []+        let ctx0 = addUser "start" emptyContext+            dispatcher _ = pure (toolResultText "2026-06-05T00:00:00Z")+        (ctx1, resp) <- runToolLoopWith (scriptRegistry scripted) 5 dispatcher helpersModel ctx0 emptyOptions+        calls <- scriptCalls scripted+        calls @?= 3+        responseStop resp @?= Stop+        Vector.length (ctx1 ^. #messages) @?= 5+        assertResolvedExchange "call_1" "2026-06-05T00:00:00Z" (Vector.toList (ctx1 ^. #messages) !! 1) (Vector.toList (ctx1 ^. #messages) !! 2)+        assertResolvedExchange "call_2" "2026-06-05T00:00:00Z" (Vector.toList (ctx1 ^. #messages) !! 3) (Vector.toList (ctx1 ^. #messages) !! 4),+      testCase "runToolLoop returns a replay-valid context on budget exhaustion" $ do+        scripted <- newScripted [toolUseResponse "call_1" "get_time", toolUseResponse "call_2" "get_time", textResponse "done"] []+        (ctx1, resp) <- runToolLoopWith (scriptRegistry scripted) 2 (const (pure (toolResultText "ok"))) helpersModel (addUser "start" emptyContext) emptyOptions+        calls <- scriptCalls scripted+        calls @?= 2+        responseStop resp @?= ToolUse+        Vector.length (ctx1 ^. #messages) @?= 3+        assertResolvedExchange "call_1" "ok" (Vector.toList (ctx1 ^. #messages) !! 1) (Vector.toList (ctx1 ^. #messages) !! 2),+      testCase "runToolLoop returns an error response without appending it" $ do+        scripted <- newScripted [errorResponse helpersModel epoch 0 (providerError "broken")] []+        let ctx0 = addUser "start" emptyContext+        (ctx1, resp) <- runToolLoopWith (scriptRegistry scripted) 3 (const (pure (toolResultText "unused"))) helpersModel ctx0 emptyOptions+        calls <- scriptCalls scripted+        calls @?= 1+        ctx1 @?= ctx0+        case responseError resp of+          Just err -> err ^. #message @?= "broken"+          Nothing -> assertFailure "expected error response",+      testCase "runToolLoop converts synchronous dispatcher exceptions into error tool results" $ do+        scripted <- newScripted [toolUseResponse "call_1" "explode", textResponse "recovered"] []+        (ctx1, resp) <-+          runToolLoopWith+            (scriptRegistry scripted)+            3+            (\_ -> Exception.throwIO (userError "boom"))+            helpersModel+            (addUser "start" emptyContext)+            emptyOptions+        responseStop resp @?= Stop+        case Vector.toList (ctx1 ^. #messages) of+          [_, _, ToolResultMessage ToolResultPayload {content = blocks, isError = err}] -> do+            err @?= True+            assertBool "tool error should include exception text" ("boom" `Text.isInfixOf` toolText blocks)+          msgs -> assertFailure ("unexpected messages: " <> show msgs),+      testCase "runToolLoop terminates a ToolUse response with no tool calls" $ do+        scripted <- newScripted [toolUseNoCallsResponse] []+        let ctx0 = addUser "start" emptyContext+        (ctx1, resp) <- runToolLoopWith (scriptRegistry scripted) 3 (const (pure (toolResultText "unused"))) helpersModel ctx0 emptyOptions+        calls <- scriptCalls scripted+        calls @?= 1+        responseStop resp @?= ToolUse+        ctx1 @?= ctx0,+      testCase "completeText returns text and throws BaikaiError on failures" $ do+        registerOneShot (Custom "baikai-helpers-text-ok") (textResponse "plain text")+        ok <-+          completeText+            (helpersModel & #api .~ Custom "baikai-helpers-text-ok")+            "prompt"+        ok @?= "plain text"+        registerApiProvider+          (errorProvider (Custom "baikai-helpers-text-error") (providerError "text failed"))+        thrown <-+          Exception.try+            ( completeText+                (helpersModel & #api .~ Custom "baikai-helpers-text-error")+                "prompt"+            ) ::+            IO (Either BaikaiError Text)+        case thrown of+          Left err -> err ^. #message @?= "text failed"+          Right txt -> assertFailure ("expected BaikaiError, got text: " <> Text.unpack txt),+      testCase "streamRequestEachWith and streamRequestListWith expose streamRequest without streamly imports" $ do+        let events = textEvents "stream-id" "streamed"+        scripted <- newScripted [] events+        seenRef <- newIORef []+        resp <- streamRequestEachWith (scriptRegistry scripted) (\event -> atomicModifyIORef' seenRef (\xs -> (xs <> [event], ()))) helpersModel emptyContext emptyOptions+        seen <- readIORef seenRef+        expected <- streamingComplete (\_ _ _ -> Stream.fromList events) helpersModel emptyContext emptyOptions+        listed <- streamRequestListWith (scriptRegistry scripted) helpersModel emptyContext emptyOptions+        seen @?= events+        listed @?= events+        resp @?= expected,+      testCase "ApiKeyEnvChain resolves the first set environment variable" $ do+        let first = "BAIKAI_HELPERS_CHAIN_FIRST"+            second = "BAIKAI_HELPERS_CHAIN_SECOND"+        withUnsetEnv first $+          withUnsetEnv second $ do+            Environment.setEnv second "second-key"+            resolved <- resolveApiKey (ApiKeyEnvChain [first, second])+            resolved @?= "second-key"+            Environment.setEnv first "first-key"+            resolvedFirst <- resolveApiKey (ApiKeyEnvChain [first, second])+            resolvedFirst @?= "first-key",+      testCase "ApiKeyEnvChain reports all probed names when unset" $ do+        let first = "BAIKAI_HELPERS_CHAIN_MISSING_A"+            second = "BAIKAI_HELPERS_CHAIN_MISSING_B"+        withUnsetEnv first $+          withUnsetEnv second $ do+            thrown <- Exception.try (resolveApiKey (ApiKeyEnvChain [first, second])) :: IO (Either BaikaiError Text)+            case thrown of+              Left err -> do+                err ^. #category @?= AuthError+                assertBool "message should include first name" (Text.pack first `Text.isInfixOf` (err ^. #message))+                assertBool "message should include second name" (Text.pack second `Text.isInfixOf` (err ^. #message))+              Right key -> assertFailure ("expected auth error, got key: " <> Text.unpack key),+      testCase "mkModel fills dispatch discriminators and defaults" $ do+        let model = mkModel OpenAIChatCompletions "gpt-test" "https://example.test"+        model ^. #api @?= OpenAIChatCompletions+        model ^. #modelId @?= "gpt-test"+        model ^. #baseUrl @?= "https://example.test"+        model ^. #name @?= "gpt-test"+        model ^. #provider @?= renderApi OpenAIChatCompletions,+      testCase "newProviderRegistryFrom uses last provider for duplicate tags" $ do+        reg <-+          newProviderRegistryFrom+            [oneShotProvider helpersApi "first", oneShotProvider helpersApi "second"]+        resp <- completeRequestWith reg helpersModel emptyContext emptyOptions+        flattenAssistantText (flattenAssistantBlocks resp) @?= "second",+      testCase "assertRegistered passes when all tags exist and throws for missing tags" $ do+        reg <- newProviderRegistryFrom [oneShotProvider helpersApi "ok"]+        assertRegistered reg [helpersApi]+        thrown <-+          Exception.try (assertRegistered reg [helpersApi, Custom "missing-one", Custom "missing-two"]) ::+            IO (Either BaikaiError ())+        case thrown of+          Left err -> do+            err ^. #category @?= ProviderUnavailable+            assertBool "message should include first missing tag" ("missing-one" `Text.isInfixOf` (err ^. #message))+            assertBool "message should include second missing tag" ("missing-two" `Text.isInfixOf` (err ^. #message))+          Right () -> assertFailure "expected ProviderUnavailable"+    ]++data Scripted = Scripted+  { scriptRegistry :: !ProviderRegistry,+    scriptCallRef :: !(IORef Int)+  }++newScripted :: [Response] -> [AssistantMessageEvent] -> IO Scripted+newScripted responses events = do+  reg <- newProviderRegistry+  responsesRef <- newIORef responses+  callsRef <- newIORef 0+  registerApiProviderWith reg $+    ApiProvider+      { apiTag = helpersApi,+        complete = scriptedComplete responsesRef callsRef,+        stream = \_ _ _ -> Stream.fromList events+      }+  pure Scripted {scriptRegistry = reg, scriptCallRef = callsRef}++scriptedComplete :: IORef [Response] -> IORef Int -> Model -> Context -> Options -> IO Response+scriptedComplete responsesRef callsRef model _ctx _opts = do+  atomicModifyIORef' callsRef (\n -> (n + 1, ()))+  mResp <-+    atomicModifyIORef' responsesRef $ \case+      [] -> ([], Nothing)+      r : rs -> (rs, Just r)+  pure $+    maybe+      (errorResponse model epoch 0 (providerError "script exhausted"))+      (stampModel model)+      mResp++scriptCalls :: Scripted -> IO Int+scriptCalls scripted = readIORef (scriptCallRef scripted)++registerOneShot :: Api -> Response -> IO ()+registerOneShot apiTag resp =+  registerApiProvider+    ApiProvider+      { apiTag,+        complete = \model _ctx _opts -> pure (stampModel model resp),+        stream = \_ _ _ -> Stream.fromList []+      }++oneShotProvider :: Api -> Text -> ApiProvider+oneShotProvider apiTag body =+  ApiProvider+    { apiTag,+      complete = \model _ctx _opts -> pure (stampModel model (textResponse body)),+      stream = \_ _ _ -> Stream.fromList []+    }++errorProvider :: Api -> BaikaiError -> ApiProvider+errorProvider apiTag err =+  ApiProvider+    { apiTag,+      complete = \model _ctx _opts -> pure (errorResponse model epoch 0 err),+      stream = \_ _ _ -> Stream.fromList []+    }++stampModel :: Model -> Response -> Response+stampModel model resp =+  resp+    & #model+    .~ model+    & #api+    .~ (model ^. #api)+    & #provider+    .~ (model ^. #provider)++toolUseResponse :: Text -> Text -> Response+toolUseResponse callId toolName =+  responseWith+    ToolUse+    (Vector.singleton (AssistantToolCall (emptyToolCall {id_ = callId, name = toolName, arguments = Aeson.object []})))+    Nothing++toolUseNoCallsResponse :: Response+toolUseNoCallsResponse =+  responseWith ToolUse (Vector.singleton (AssistantText (TextContent "no calls"))) Nothing++textResponse :: Text -> Response+textResponse body =+  responseWith Stop (Vector.singleton (AssistantText (TextContent body))) Nothing++responseWith :: StopReason -> Vector AssistantContent -> Maybe Text -> Response+responseWith sr blocks err =+  emptyResponse+    & #message+    .~ AssistantPayload+      { content = blocks,+        usage = zeroUsage,+        stopReason = sr,+        errorMessage = err,+        timestamp = Just epoch+      }+    & #model+    .~ helpersModel+    & #api+    .~ helpersApi+    & #provider+    .~ "helpers"++responseStop :: Response -> StopReason+responseStop Response {message = AssistantPayload {stopReason = sr}} = sr++assertResolvedExchange :: Text -> Text -> Message -> Message -> IO ()+assertResolvedExchange callId expectedText assistantMsg resultMsg = do+  case assistantMsg of+    AssistantMessage AssistantPayload {content = blocks, stopReason = sr} -> do+      sr @?= ToolUse+      case [tc | AssistantToolCall tc <- Vector.toList blocks] of+        [tc] -> tc ^. #id_ @?= callId+        calls -> assertFailure ("expected one tool call, got: " <> show calls)+    _ -> assertFailure ("expected assistant tool-use message, got: " <> show assistantMsg)+  case resultMsg of+    ToolResultMessage ToolResultPayload {toolCallId = actual, content = blocks, isError = err} -> do+      actual @?= callId+      err @?= False+      toolText blocks @?= expectedText+    _ -> assertFailure ("expected tool result message, got: " <> show resultMsg)++toolText :: Vector ToolResultContent -> Text+toolText =+  Text.concat+    . Vector.toList+    . Vector.mapMaybe+      ( \case+          ToolResultText (TextContent t) -> Just t+          _ -> Nothing+      )++textEvents :: Text -> Text -> [AssistantMessageEvent]+textEvents rid body =+  let msg =+        AssistantMessage+          AssistantPayload+            { content = Vector.singleton (AssistantText (TextContent body)),+              usage = zeroUsage,+              stopReason = Stop,+              errorMessage = Nothing,+              timestamp = Just epoch+            }+      start =+        AssistantMessage+          AssistantPayload+            { content = Vector.empty,+              usage = zeroUsage,+              stopReason = Stop,+              errorMessage = Nothing,+              timestamp = Just epoch+            }+   in [ EventStart StartPayload {partial = start, responseId = Just rid},+        TextStart IndexPayload {contentIndex = 0},+        TextDelta DeltaPayload {contentIndex = 0, delta = body},+        TextEnd BlockEndPayload {contentIndex = 0, content = body},+        EventDone (doneTerminal (Just rid) Stop msg)+      ]++withUnsetEnv :: String -> IO a -> IO a+withUnsetEnv name action =+  Exception.bracket+    ( do+        old <- Environment.lookupEnv name+        Environment.unsetEnv name+        pure old+    )+    restore+    (const action)+  where+    restore Nothing = Environment.unsetEnv name+    restore (Just value) = Environment.setEnv name value

@@ -18,11 +18,11 @@  requestDefaultTest :: TestTree requestDefaultTest =-  testCase "_InteractiveLaunchRequest keeps optional launch settings empty" $ do-    let req = _InteractiveLaunchRequest "start here"+  testCase "interactiveLaunchRequest keeps optional launch settings empty" $ do+    let req = interactiveLaunchRequest "start here"     req ^. #systemPrompt @?= Nothing     req ^. #userPrompt @?= "start here"-    req ^. #model @?= Nothing+    req ^. #modelId @?= Nothing     req ^. #workingDir @?= Nothing     req ^. #extraDirs @?= []     req ^. #safety @?= DefaultSafety@@ -49,7 +49,7 @@  resultConstructorTest :: TestTree resultConstructorTest =-  testCase "_InteractiveLaunchResult records provider identity and process status" $ do-    let result = _InteractiveLaunchResult InteractiveCodex ExitSuccess+  testCase "interactiveLaunchResult records provider identity and process status" $ do+    let result = interactiveLaunchResult InteractiveCodex ExitSuccess     result ^. #provider @?= InteractiveCodex     result ^. #exitCode @?= ExitSuccess

@@ -2,8 +2,11 @@  import AgentAssetsSpec qualified import Baikai+import Baikai.Models.Generated import Baikai.Prelude import CatalogSpec qualified+import CliInternalSpec qualified+import ContextSpec qualified import CostSpec qualified import Data.Aeson qualified as Aeson import Data.ByteString.Char8 qualified as BS8@@ -14,10 +17,16 @@ import ErrorInfoSpec qualified import ErrorSpec qualified import FetchModelsSpec qualified+import GenModelsSpec qualified+import HelpersSpec qualified import InteractiveSpec qualified+import StreamSpec qualified import Streamly.Data.Stream qualified as Stream+import SurfaceSpec qualified import Test.Tasty (TestTree, defaultMain, testGroup) import Test.Tasty.HUnit (assertBool, testCase, (@?=))+import Test.Tasty.QuickCheck (Gen)+import Test.Tasty.QuickCheck qualified as QC import TraceSpec qualified import UsageSpec qualified @@ -29,7 +38,7 @@  testModel :: Model testModel =-  _Model+  emptyModel     & #modelId     .~ "test-model"     & #name@@ -50,14 +59,14 @@ testProvider providerName canned =   let handler m _ctx _opts =         pure $-          _Response+          emptyResponse             & #message             .~ AssistantPayload               { content = V.singleton (AssistantText (TextContent canned)),-                usage = _Usage,+                usage = zeroUsage,                 stopReason = Stop,                 errorMessage = Nothing,-                timestamp = read "2026-06-05 00:00:00 UTC"+                timestamp = Just (read "2026-06-05 00:00:00 UTC")               }             & #model             .~ m@@ -80,12 +89,18 @@       [ tests,         AgentAssetsSpec.tests,         CatalogSpec.tests,+        CliInternalSpec.tests,+        ContextSpec.tests,         CostSpec.tests,         EmbeddingSpec.tests,         ErrorInfoSpec.tests,         ErrorSpec.tests,         FetchModelsSpec.tests,+        GenModelsSpec.tests,+        HelpersSpec.tests,         InteractiveSpec.tests,+        StreamSpec.tests,+        SurfaceSpec.tests,         TraceSpec.tests,         UsageSpec.tests       ]@@ -94,39 +109,39 @@ tests =   testGroup     "baikai EP-2"-    [ testCase "_Context defaults are zero-y" $ do-        _Context ^. #systemPrompt @?= Nothing-        V.length (_Context ^. #messages) @?= 0,-      testCase "_Options defaults are zero-y" $ do-        _Options ^. #maxTokens @?= Nothing-        _Options ^. #temperature @?= Nothing-        _Options ^. #apiKey @?= Nothing-        _Options ^. #responseFormat @?= Nothing,+    [ testCase "emptyContext defaults are zero-y" $ do+        emptyContext ^. #systemPrompt @?= Nothing+        V.length (emptyContext ^. #messages) @?= 0,+      testCase "emptyOptions defaults are zero-y" $ do+        emptyOptions ^. #maxTokens @?= Nothing+        emptyOptions ^. #temperature @?= Nothing+        emptyOptions ^. #apiKey @?= Nothing+        emptyOptions ^. #responseFormat @?= Nothing,       testCase "responseFormat round-trips through Options" $ do-        responseFormat (_Options & #responseFormat .~ Just JsonObject)+        responseFormat (emptyOptions & #responseFormat .~ Just JsonObject)           @?= Just JsonObject         let person =               Aeson.object                 [ "type" Aeson..= ("object" :: Text)                 ]             schemaFmt = JsonSchema {name = "person", schema = person, strict = True}-        responseFormat (_Options & #responseFormat .~ Just schemaFmt)+        responseFormat (emptyOptions & #responseFormat .~ Just schemaFmt)           @?= Just schemaFmt,       testCase "Options Show redacts literal API keys" $ do         let secret = "sk-baikai-secret-never-print"-            opts = _Options & #apiKey .~ Just (ApiKeyLiteral secret)+            opts = emptyOptions & #apiKey .~ Just (ApiKeyLiteral secret)         assertBool           "show opts must not contain the raw API key"           (not (secret `Text.isInfixOf` Text.pack (show opts))),       testCase "Options JSON redacts literal API keys" $ do         let secret = "sk-baikai-secret-never-print"-            opts = _Options & #apiKey .~ Just (ApiKeyLiteral secret)+            opts = emptyOptions & #apiKey .~ Just (ApiKeyLiteral secret)         assertBool           "Aeson.encode opts must not contain the raw API key"           (not (secret `Text.isInfixOf` Text.pack (LBS8.unpack (Aeson.encode opts)))),       testCase "completeRequest dispatches through the registered handler" $ do-        let ctx = _Context & #messages .~ V.fromList [user "ping"]-        resp <- completeRequest testModel ctx _Options+        let ctx = emptyContext & #messages .~ V.fromList [user "ping"]+        resp <- completeRequest testModel ctx emptyOptions         flattenAssistantBlocks resp           @?= V.singleton (AssistantText (TextContent "hello from the test provider"))         (resp ^. #model) ^. #modelId @?= "test-model"@@ -136,9 +151,9 @@         regB <- newProviderRegistry         registerApiProviderWith regA (testProvider "provider-a" "hello from A")         registerApiProviderWith regB (testProvider "provider-b" "hello from B")-        let ctx = _Context & #messages .~ V.fromList [user "ping"]-        respA <- completeRequestWith regA testModel ctx _Options-        respB <- completeRequestWith regB testModel ctx _Options+        let ctx = emptyContext & #messages .~ V.fromList [user "ping"]+        respA <- completeRequestWith regA testModel ctx emptyOptions+        respB <- completeRequestWith regB testModel ctx emptyOptions         flattenAssistantBlocks respA           @?= V.singleton (AssistantText (TextContent "hello from A"))         flattenAssistantBlocks respB@@ -148,14 +163,14 @@       testCase "streamRequestWith dispatches through an explicit registry" $ do         reg <- newProviderRegistry         registerApiProviderWith reg (testProvider "stream-provider" "hello from stream")-        let ctx = _Context & #messages .~ V.fromList [user "ping"]-        events <- Stream.toList (streamRequestWith reg testModel ctx _Options)+        let ctx = emptyContext & #messages .~ V.fromList [user "ping"]+        events <- Stream.toList (streamRequestWith reg testModel ctx emptyOptions)         resp <- Stream.fold (reassembleResponse testModel) (Stream.fromList events)         flattenAssistantBlocks resp           @?= V.singleton (AssistantText (TextContent "hello from stream")),       testCase "OpenAI compat auto-detection drives provider request policy" $ do         let deepseek =-              _Model+              emptyModel                 & #api                 .~ OpenAIChatCompletions                 & #baseUrl@@ -163,8 +178,40 @@             compat = openaiCompletionsCompatFor deepseek         compat ^. #thinkingFormat @?= ThinkingFormatDeepseek         compat ^. #maxTokensField @?= MaxTokensField-        compat ^. #supportsStrictMode @?= False-        compat ^. #supportsDeveloperRole @?= False,+        compat ^. #supportsStrictMode @?= False,+      testCase "host auto-detection is suffix-bounded" $ do+        urlHost "http://user@openrouter.ai:8443/api" @?= Just "openrouter.ai"+        autoDetectOpenAICompletions "https://api.xyz.ai"+          @?= defaultOpenAICompletionsCompat+        autoDetectOpenAICompletions "https://evil-z.ai.example.com"+          @?= defaultOpenAICompletionsCompat+        autoDetectOpenAICompletions "https://api.z.ai/v1"+          ^. #thinkingFormat+          @?= ThinkingFormatZai+        autoDetectOpenAICompletions "https://API.DEEPSEEK.COM"+          ^. #thinkingFormat+          @?= ThinkingFormatDeepseek+        autoDetectOpenAICompletions "http://user@openrouter.ai:8443/api"+          ^. #thinkingFormat+          @?= ThinkingFormatOpenRouter+        autoDetectOpenAICompletions ""+          @?= defaultOpenAICompletionsCompat,+      QC.testProperty "unknown OpenAI host suffixes use defaults" $+        QC.forAll unknownHostGen $ \host ->+          QC.property $+            autoDetectOpenAICompletions ("https://" <> Text.pack host)+              == defaultOpenAICompletionsCompat,+      testCase "default API-key env table matches known hosts" $ do+        defaultApiKeyEnvForBaseUrl "https://api.deepseek.com/v1"+          @?= Just "DEEPSEEK_API_KEY"+        defaultApiKeyEnvForBaseUrl "http://user@openrouter.ai:8443/api"+          @?= Just "OPENROUTER_API_KEY"+        defaultApiKeyEnvForBaseUrl "https://dashscope-intl.aliyuncs.com/compatible-mode/v1"+          @?= Just "DASHSCOPE_API_KEY"+        defaultApiKeyEnvForBaseUrl "https://api.xyz.ai"+          @?= Nothing+        defaultApiKeyEnvForBaseUrl ""+          @?= Nothing,       testCase "explicit OpenAI compat overrides baseUrl auto-detection" $ do         let explicit =               defaultOpenAICompletionsCompat@@ -172,7 +219,7 @@                   thinkingFormat = ThinkingFormatNone                 }             model =-              _Model+              emptyModel                 & #api                 .~ OpenAIChatCompletions                 & #baseUrl@@ -184,7 +231,7 @@         compat ^. #thinkingFormat @?= ThinkingFormatNone,       testCase "Anthropic compat auto-detection drives cache request policy" $ do         let fireworks =-              _Model+              emptyModel                 & #api                 .~ AnthropicMessages                 & #baseUrl@@ -192,13 +239,39 @@             compat = anthropicMessagesCompatFor fireworks         compat ^. #supportsCacheControlOnTools @?= False         compat ^. #sendSessionAffinityHeaders @?= True-        compat ^. #supportsLongCacheRetention @?= False,+        compat ^. #supportsLongCacheRetention @?= False+        compat ^. #thinkingStyle @?= AnthropicThinkingBudget,+      testCase "Anthropic compat defaults thinking style by model generation" $ do+        anthropicMessagesCompatFor anthropic_claude_opus_4_6+          ^. #thinkingStyle+          @?= AnthropicThinkingAdaptive+        anthropicMessagesCompatFor anthropic_claude_opus_4_7+          ^. #thinkingStyle+          @?= AnthropicThinkingAdaptive+        anthropicMessagesCompatFor anthropic_claude_opus_4_8+          ^. #thinkingStyle+          @?= AnthropicThinkingAdaptive+        anthropicMessagesCompatFor anthropic_claude_fable_5+          ^. #thinkingStyle+          @?= AnthropicThinkingAdaptive+        anthropicMessagesCompatFor anthropic_claude_haiku_4_5+          ^. #thinkingStyle+          @?= AnthropicThinkingBudget+        anthropicMessagesCompatFor anthropic_claude_opus_4_5+          ^. #thinkingStyle+          @?= AnthropicThinkingBudget+        anthropicMessagesCompatFor anthropic_claude_sonnet_4_5+          ^. #thinkingStyle+          @?= AnthropicThinkingBudget+        anthropicMessagesCompatFor anthropic_claude_sonnet_4_6+          ^. #thinkingStyle+          @?= AnthropicThinkingBudget,       testCase "user smart constructor produces a UserMessage" $ do         let ts = read "2026-06-05 01:02:03 UTC"         case userAt ts "hello" of           UserMessage UserPayload {content = uc, timestamp = actualTs} -> do             uc @?= V.singleton (UserText (TextContent "hello"))-            actualTs @?= ts+            actualTs @?= Just ts           _ -> error "expected UserMessage",       testCase "assistant smart constructor produces an AssistantMessage" $ do         let ts = read "2026-06-05 01:02:03 UTC"@@ -206,7 +279,7 @@           AssistantMessage AssistantPayload {content = ac, stopReason = sr, timestamp = actualTs} -> do             ac @?= V.singleton (AssistantText (TextContent "world"))             sr @?= Stop-            actualTs @?= ts+            actualTs @?= Just ts           _ -> error "expected AssistantMessage",       testCase "effectful user constructor produces a UserMessage in IO" $ do         msg <- userNow "hello now"@@ -216,19 +289,19 @@           _ -> error "expected UserMessage",       testCase "appendToolResult carries text, image, and error payloads" $ do         let textCall =-              _ToolCall+              emptyToolCall                 { id_ = "call_text",                   name = "text_tool",                   arguments = Aeson.object []                 }             imageCall =-              _ToolCall+              emptyToolCall                 { id_ = "call_image",                   name = "image_tool",                   arguments = Aeson.object []                 }             errorCall =-              _ToolCall+              emptyToolCall                 { id_ = "call_error",                   name = "error_tool",                   arguments = Aeson.object []@@ -242,16 +315,16 @@                           AssistantToolCall imageCall,                           AssistantToolCall errorCall                         ],-                    usage = _Usage,+                    usage = zeroUsage,                     stopReason = ToolUse,                     errorMessage = Nothing,-                    timestamp = read "2026-06-05 00:00:00 UTC"+                    timestamp = Just (read "2026-06-05 00:00:00 UTC")                   }-            resp = _Response & #message .~ assistantPayload+            resp = emptyResponse & #message .~ assistantPayload             assistantPayload = case assistantTurn of               AssistantMessage p -> p               _ -> error "expected assistant fixture"-            ctx0 = _Context & #messages .~ V.singleton (user "use tools")+            ctx0 = emptyContext & #messages .~ V.singleton (user "use tools")             image = ImageContent {imageData = BS8.pack "png-bytes", mimeType = "image/png"}             dispatcher tc = case tc ^. #name of               "text_tool" -> pure (toolResultText "text result")@@ -279,3 +352,8 @@                 err @?= True           msgs -> error ("unexpected context messages: " <> show msgs)     ]++unknownHostGen :: Gen String+unknownHostGen = do+  label <- QC.listOf1 (QC.elements (['a' .. 'z'] <> ['0' .. '9']))+  pure (label <> ".example.invalid")