packages feed

baikai 0.1.1.0 → 0.2.0.0

raw patch · 21 files changed

+1852/−83 lines, 21 filesdep +http-clientdep +http-client-tlsnew-component:exe:baikai-fetch-modelsPVP ok

version bump matches the API change (PVP)

Dependencies added: http-client, http-client-tls

API changes (from Hackage documentation)

- Baikai.Error: DecodeError :: !Text -> BaikaiError
- Baikai.Error: ProcessError :: !Int -> !Text -> BaikaiError
- Baikai.Error: ProviderError :: !Text -> BaikaiError
- Baikai.Error: RequestInvalid :: !Text -> BaikaiError
- Baikai.Models.Generated: anthropic_claude_haiku_4_5_20251001 :: Model
- Baikai.Models.Generated: openai_o1_mini :: Model
+ Baikai.Cost: instance GHC.Internal.Base.Monoid Baikai.Cost.Cost
+ Baikai.Cost: instance GHC.Internal.Base.Monoid Baikai.Cost.CostBreakdown
+ Baikai.Cost: instance GHC.Internal.Base.Semigroup Baikai.Cost.Cost
+ Baikai.Cost: instance GHC.Internal.Base.Semigroup Baikai.Cost.CostBreakdown
+ Baikai.Error: AuthError :: ErrorCategory
+ Baikai.Error: BaikaiError :: !ErrorCategory -> !Text -> !Maybe Int -> !Maybe Int -> !Maybe Int -> BaikaiError
+ Baikai.Error: ContextOverflow :: ErrorCategory
+ Baikai.Error: DecodeFailure :: ErrorCategory
+ Baikai.Error: InvalidRequest :: ErrorCategory
+ Baikai.Error: OtherError :: ErrorCategory
+ Baikai.Error: ProcessFailure :: ErrorCategory
+ Baikai.Error: ProviderUnavailable :: ErrorCategory
+ Baikai.Error: RateLimited :: ErrorCategory
+ Baikai.Error: TransientError :: ErrorCategory
+ Baikai.Error: [category] :: BaikaiError -> !ErrorCategory
+ Baikai.Error: [exitCode] :: BaikaiError -> !Maybe Int
+ Baikai.Error: [httpStatus] :: BaikaiError -> !Maybe Int
+ Baikai.Error: [message] :: BaikaiError -> !Text
+ Baikai.Error: [retryAfterSeconds] :: BaikaiError -> !Maybe Int
+ Baikai.Error: authError :: Text -> BaikaiError
+ Baikai.Error: bodyIndicatesOverflow :: Text -> Bool
+ Baikai.Error: classifyHttpStatus :: Int -> Maybe Int -> ErrorCategory
+ Baikai.Error: classifyHttpStatusWithBody :: Int -> Maybe Int -> Text -> ErrorCategory
+ Baikai.Error: data ErrorCategory
+ Baikai.Error: decodeError :: Text -> BaikaiError
+ Baikai.Error: instance Data.Aeson.Types.FromJSON.FromJSON Baikai.Error.BaikaiError
+ Baikai.Error: instance Data.Aeson.Types.FromJSON.FromJSON Baikai.Error.ErrorCategory
+ Baikai.Error: instance Data.Aeson.Types.ToJSON.ToJSON Baikai.Error.BaikaiError
+ Baikai.Error: instance Data.Aeson.Types.ToJSON.ToJSON Baikai.Error.ErrorCategory
+ Baikai.Error: instance GHC.Classes.Eq Baikai.Error.ErrorCategory
+ Baikai.Error: instance GHC.Internal.Generics.Generic Baikai.Error.ErrorCategory
+ Baikai.Error: instance GHC.Internal.Show.Show Baikai.Error.ErrorCategory
+ Baikai.Error: invalidRequest :: Text -> BaikaiError
+ Baikai.Error: isRetryable :: BaikaiError -> Bool
+ Baikai.Error: processError :: Int -> Text -> BaikaiError
+ Baikai.Error: providerError :: Text -> BaikaiError
+ Baikai.Error: providerUnavailable :: Text -> BaikaiError
+ Baikai.Error: rateLimited :: Maybe Int -> Text -> BaikaiError
+ Baikai.Models.Generated: anthropic_claude_fable_5 :: Model
+ Baikai.Models.Generated: anthropic_claude_opus_4_5 :: Model
+ Baikai.Models.Generated: anthropic_claude_opus_4_6 :: Model
+ Baikai.Models.Generated: anthropic_claude_opus_4_8 :: Model
+ Baikai.Models.Generated: anthropic_claude_sonnet_4_5 :: Model
+ Baikai.Models.Generated: openai_gpt_4_1 :: Model
+ Baikai.Models.Generated: openai_gpt_4_1_mini :: Model
+ Baikai.Models.Generated: openai_gpt_4_1_nano :: Model
+ Baikai.Models.Generated: openai_gpt_5 :: Model
+ Baikai.Models.Generated: openai_gpt_5_1 :: Model
+ Baikai.Models.Generated: openai_gpt_5_2 :: Model
+ Baikai.Models.Generated: openai_gpt_5_4 :: Model
+ Baikai.Models.Generated: openai_gpt_5_4_mini :: Model
+ Baikai.Models.Generated: openai_gpt_5_4_nano :: Model
+ Baikai.Models.Generated: openai_gpt_5_5 :: Model
+ Baikai.Models.Generated: openai_gpt_5_mini :: Model
+ Baikai.Models.Generated: openai_gpt_5_nano :: Model
+ Baikai.Models.Generated: openai_o3 :: Model
+ Baikai.Models.Generated: openai_o3_mini :: Model
+ Baikai.Models.Generated: openai_o4_mini :: Model
+ Baikai.Response: [errorInfo] :: Response -> !Maybe BaikaiError
+ Baikai.Stream.Event: [errorInfo] :: TerminalPayload -> !Maybe BaikaiError
+ Baikai.Stream.Event: doneTerminal :: StopReason -> Message -> TerminalPayload
+ Baikai.Stream.Event: errorTerminal :: StopReason -> Message -> Maybe BaikaiError -> TerminalPayload
+ Baikai.Usage: instance GHC.Internal.Base.Monoid Baikai.Usage.Usage
+ Baikai.Usage: instance GHC.Internal.Base.Semigroup Baikai.Usage.Usage
+ Baikai.Usage: sumUsage :: Foldable f => f Usage -> Usage
- Baikai.Response: Response :: !AssistantPayload -> !Model -> !Api -> !Text -> !Maybe Text -> !Integer -> Response
+ Baikai.Response: Response :: !AssistantPayload -> !Model -> !Api -> !Text -> !Maybe Text -> !Integer -> !Maybe BaikaiError -> Response
- Baikai.Stream.Event: TerminalPayload :: !StopReason -> !Message -> TerminalPayload
+ Baikai.Stream.Event: TerminalPayload :: !StopReason -> !Message -> !Maybe BaikaiError -> TerminalPayload

Files

CHANGELOG.md view
@@ -7,6 +7,84 @@  ## [Unreleased] +## [baikai 0.2.0.0] - 2026-06-21++### Added++- `Usage`, `Cost`, and `CostBreakdown` now have `Semigroup`/`Monoid`+  instances that add field-by-field, plus `sumUsage :: Foldable f => f+  Usage -> Usage`, so callers can total per-call usage and cost.+  `reasoningTokens` combines as presence-wins (`Nothing` only when both+  operands are `Nothing`).+- A categorised error model: `BaikaiError` is now a record carrying an+  `ErrorCategory` (`AuthError`, `RateLimited`, `ContextOverflow`,+  `InvalidRequest`, `TransientError`, `DecodeFailure`, `ProcessFailure`,+  `ProviderUnavailable`, `OtherError`), an optional HTTP `httpStatus`, a+  `retryAfterSeconds` hint, and a subprocess `exitCode`. New smart+  constructors (`providerError`, `invalidRequest`, `decodeError`,+  `processError`, `rateLimited`, `authError`, `providerUnavailable`),+  the `isRetryable` predicate, and the pure `classifyHttpStatus` /+  `classifyHttpStatusWithBody` helpers let callers implement retry+  policy without parsing error text. `ErrorCategory` and `BaikaiError`+  serialize to JSON.+- `Response` and the streaming `EventError`'s `TerminalPayload` now+  carry `errorInfo :: Maybe BaikaiError`, so a failed `completeRequest`+  (or a drained stream) exposes the structured category/retry hint+  in-band. `Baikai.Stream.Event` gains `doneTerminal` / `errorTerminal`+  constructors.++### Changed++- **Breaking:** `BaikaiError`'s four flat constructors+  (`ProviderError`, `RequestInvalid`, `DecodeError`, `ProcessError`)+  were replaced by the record above. Migrate by lowercasing to the+  smart constructors — `ProviderError "x"` becomes `providerError "x"`,+  `ProcessError n "x"` becomes `processError n "x"`, etc.+- **Breaking:** `Baikai.Stream.Event.TerminalPayload` and+  `Baikai.Response.Response` gained an `errorInfo` field; build+  `TerminalPayload` via `doneTerminal` / `errorTerminal`.++### Fixed++- Restored JSON decoding for `BaikaiError` values with omitted optional+  metadata fields.++## [baikai-claude 0.2.0.0] - 2026-06-21++### Added++- The Anthropic API and `claude -p` CLI providers now classify failures+  into the typed `BaikaiError` categories: HTTP errors (via the caught+  `servant-client` `ClientError`) map status/`Retry-After`/body onto+  `AuthError` / `RateLimited` / `ContextOverflow` / `InvalidRequest` /+  `TransientError`, and mid-stream Anthropic `error` events are+  classified by their error type. The result is surfaced on+  `Response.errorInfo`.++## [baikai-openai 0.2.0.0] - 2026-06-21++### Added++- The OpenAI/OpenAI-compatible API and `codex exec` CLI providers now+  classify failures into the typed `BaikaiError` categories the same way+  as `baikai-claude` (HTTP `ClientError` for status-based errors,+  streamed error text for mid-stream errors), surfaced on+  `Response.errorInfo`.++## [baikai-trace-otel 0.2.0.0] - 2026-06-21++### Changed++- Updated the `baikai` dependency bound to `^>=0.2.0` for compatibility with+  the `baikai 0.2.0.0` breaking API release.++## [baikai-effectful 0.2.0.0] - 2026-06-21++### Changed++- Updated the `baikai` dependency bound to `^>=0.2.0` for compatibility with+  the `baikai 0.2.0.0` breaking API release.+ ## [baikai 0.1.1.0] - 2026-06-12  ### Added
baikai.cabal view
@@ -1,6 +1,6 @@ cabal-version:   3.4 name:            baikai-version:         0.1.1.0+version:         0.2.0.0 synopsis:        Unified Haskell interface for multiple AI providers description:   baikai provides a unified, provider-agnostic Haskell interface for working@@ -102,18 +102,47 @@     , scientific     , text        ^>=2.1 +executable baikai-fetch-models+  import:         common-options+  hs-source-dirs: fetch+  main-is:        FetchModels.hs+  other-modules:  FetchModelsCore++  -- The main module is named @FetchModels@ (not @Main@) so the pure+  -- core can be compiled into the test suite alongside its own+  -- @Main.hs@ without a module-name clash.+  ghc-options:    -main-is FetchModels+  build-depends:+    , aeson+    , baikai+    , base             >=4.20 && <5+    , bytestring+    , containers+    , directory+    , filepath+    , http-client+    , http-client-tls+    , scientific+    , text             ^>=2.1+    , vector+ test-suite baikai-test   import:             common-options   type:               exitcode-stdio-1.0-  hs-source-dirs:     test+  hs-source-dirs:     test fetch   main-is:            Main.hs   other-modules:     AgentAssetsSpec     CatalogSpec     CostSpec     EmbeddingSpec+    ErrorInfoSpec+    ErrorSpec+    FetchModelsCore+    FetchModelsSpec     InteractiveSpec     TraceSpec+    UsageSpec    build-tool-depends: baikai:baikai-gen-models   build-depends:@@ -121,10 +150,12 @@     , baikai     , base     , bytestring+    , containers     , directory     , filepath     , openai     , process+    , scientific     , stm     , streamly-core  >=0.3 && <0.5     , tasty
+ fetch/FetchModels.hs view
@@ -0,0 +1,193 @@+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE OverloadedStrings #-}++-- | Executable @baikai-fetch-models@: refresh baikai's catalog JSON+-- from upstream sources (primarily @https:\/\/models.dev\/api.json@).+--+-- Pipeline role: this tool does @network -> catalog JSON@. The+-- existing @baikai-gen-models@ does @catalog JSON -> Generated.hs@.+-- The two stay separate so the network never runs at build time and+-- the catalog JSON stays a human-reviewable @git diff@ artifact.+--+-- Typical use, from the repo root:+--+-- > cabal run baikai-fetch-models           -- fetch live, rewrite data/models/{anthropic,openai}.json+-- > cabal run baikai-gen-models             -- regenerate Generated.hs+-- > git --no-pager diff baikai/data/models  -- review before committing+--+-- Flags:+--+-- * @--from-url URL@   — upstream document (default+--   @https:\/\/models.dev\/api.json@).+-- * @--from-file PATH@ — read a local document instead of the network+--   (used by tests and for offline work).+-- * @--out-dir DIR@    — directory to write @\<provider\>.json@ into+--   (default @\<baikai-pkg-dir\>\/data\/models@).+-- * @--provider {openai|anthropic|all}@ — which catalogs to emit+--   (default @all@).+-- * @--stdout@         — print to stdout instead of writing files.+--+-- All normalization, curation, and rendering logic lives in the pure+-- 'FetchModelsCore' module so it can be unit-tested without IO; this+-- module is only the impure shell (arg parsing, network fetch, file+-- writing).+module FetchModels (main, fetchUpstream) where++import Control.Exception (catch)+import Data.ByteString qualified as BS+import Data.ByteString.Lazy qualified as BSL+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)+import Network.HTTP.Client.TLS (newTlsManager)+import System.Directory (doesFileExist, getCurrentDirectory)+import System.Environment (getArgs)+import System.Exit (die)+import System.FilePath (takeDirectory, (</>))++-- | Which provider(s) to emit.+data ProviderSel = SelOpenAI | SelAnthropic | SelAll+  deriving stock (Eq, Show)++-- | Parsed command-line options.+data Options = Options+  { optFromUrl :: !String,+    optFromFile :: !(Maybe FilePath),+    optOutDir :: !(Maybe FilePath),+    optProvider :: !ProviderSel,+    optStdout :: !Bool+  }++defaultOptions :: Options+defaultOptions =+  Options+    { optFromUrl = "https://models.dev/api.json",+      optFromFile = Nothing,+      optOutDir = Nothing,+      optProvider = SelAll,+      optStdout = False+    }++main :: IO ()+main = do+  args <- getArgs+  opts <- parseArgs args+  raw <- loadUpstreamBytes opts+  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+    then mapM_ (BS.putStr . renderCatalog) catalogs+    else do+      outDir <- resolveOutDir (optOutDir opts)+      mapM_ (writeCatalog outDir) 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+  Just path -> BSL.readFile path+  Nothing ->+    fetchUpstream (optFromUrl opts)+      `catch` \e ->+        die $+          "baikai-fetch-models: failed to fetch "+            <> optFromUrl opts+            <> ": "+            <> show (e :: HttpException)++-- | GET a URL over TLS and return the body. 'parseUrlThrow' makes any+-- non-2xx status raise an 'HttpException' (handled by the caller), so+-- a 404 or server error never reaches the parser or the filesystem.+fetchUpstream :: String -> IO BSL.ByteString+fetchUpstream url = do+  manager <- newTlsManager+  req <- parseUrlThrow url+  responseBody <$> httpLbs req manager++-- | 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)++-- | 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")+  BS.writeFile path (renderCatalog cat)+  putStrLn $+    "Wrote " <> path <> " (" <> show (length (cModels cat)) <> " models)"++-- | The provider specs selected by @--provider@.+selectedSpecs :: ProviderSel -> [ProviderSpec]+selectedSpecs = \case+  SelOpenAI -> [openaiSpec]+  SelAnthropic -> [anthropicSpec]+  SelAll -> [anthropicSpec, openaiSpec]++-- | Resolve the output directory, anchoring the default against the+-- @baikai@ package directory the same way @baikai-gen-models@ does.+resolveOutDir :: Maybe FilePath -> IO FilePath+resolveOutDir (Just d) = pure d+resolveOutDir Nothing = do+  mPkg <- locatePackageDir+  case mPkg of+    Nothing ->+      die+        "baikai-fetch-models: could not locate baikai.cabal in any \+        \ancestor directory; pass --out-dir explicitly"+    Just pkg -> pure (pkg </> "data/models")++-- | Locate the directory containing @baikai.cabal@ by walking up from+-- the current working directory, also checking a @baikai@ subdir at+-- each level so invocation from the repo root works. Mirrors+-- @baikai-gen-models@.+locatePackageDir :: IO (Maybe FilePath)+locatePackageDir = getCurrentDirectory >>= walk+  where+    walk dir = do+      here <- doesFileExist (dir </> "baikai.cabal")+      if here+        then pure (Just dir)+        else do+          sub <- doesFileExist (dir </> "baikai" </> "baikai.cabal")+          if sub+            then pure (Just (dir </> "baikai"))+            else+              let parent = takeDirectory dir+               in if parent == dir then pure Nothing else walk parent++-- | Parse the flags; anything else is a hard error, mirroring+-- @baikai-gen-models@'s strict arg handling.+parseArgs :: [String] -> IO Options+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 ("--provider" : v : rest) = do+      sel <- parseProvider v+      go o {optProvider = sel} rest+    go o ("--stdout" : rest) = go o {optStdout = True} rest+    go _ (a : _) = die $ "baikai-fetch-models: unknown argument " <> show a++parseProvider :: String -> IO ProviderSel+parseProvider = \case+  "openai" -> pure SelOpenAI+  "anthropic" -> pure SelAnthropic+  "all" -> pure SelAll+  other ->+    die $+      "baikai-fetch-models: unknown --provider "+        <> show other+        <> " (expected openai, anthropic, or all)"
+ fetch/FetchModelsCore.hs view
@@ -0,0 +1,377 @@+{-# 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+-- hand-maintained files under @baikai\/data\/models\/@.+--+-- This module is deliberately free of @IO@ and of any network+-- dependency so it can be unit-tested directly (see+-- @baikai\/test\/FetchModelsSpec.hs@) and so the network fetch lives+-- only in the thin executable wrapper @baikai\/fetch\/FetchModels.hs@.+--+-- == Curation policy+--+-- baikai's catalog is an intentionally curated short list, not an+-- exhaustive mirror of models.dev. Only models whose ids appear in the+-- per-provider include set ('openaiInclude', 'anthropicInclude') are+-- emitted, and only if upstream marks them @tool_call: true@. For+-- @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.+module FetchModelsCore+  ( -- * Upstream shape (subset of models.dev fields we consume)+    UpstreamModel (..),+    parseUpstream,++    -- * Output catalog shape+    CatalogModel (..),+    CatalogCost (..),+    Catalog (..),++    -- * Provider specs and normalization+    ProviderSpec (..),+    openaiSpec,+    anthropicSpec,+    openaiInclude,+    anthropicInclude,+    normalizeProvider,++    -- * Rendering+    renderCatalog,+  )+where++import Baikai.Model (InputModality (..))+import Data.Aeson (FromJSON (..), (.!=), (.:), (.:?))+import Data.Aeson qualified as Aeson+import Data.ByteString (ByteString)+import Data.ByteString.Lazy qualified as BSL+import Data.List (sortOn)+import Data.Map.Strict (Map)+import Data.Map.Strict qualified as Map+import Data.Maybe (fromMaybe)+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)++-- * Upstream shape ----------------------------------------------------++-- | The subset of a models.dev model object that we consume. Every+-- 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]+  }+  deriving stock (Eq, Show)++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"+    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+        }++-- | @limit@ sub-object.+data Limit = Limit+  { limitContext :: !(Maybe Integer),+    limitOutput :: !(Maybe Integer)+  }++instance FromJSON Limit where+  parseJSON = Aeson.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)+  }++instance FromJSON Cost where+  parseJSON = Aeson.withObject "cost" $ \o ->+    Cost+      <$> o .:? "input"+      <*> o .:? "output"+      <*> o .:? "cache_read"+      <*> o .:? "cache_write"++-- | @modalities@ sub-object; we only read @input@.+newtype Modalities = Modalities {modalitiesInput :: [Text]}++instance FromJSON Modalities where+  parseJSON = Aeson.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}++instance FromJSON UpstreamProvider where+  parseJSON = Aeson.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++-- * Output catalog shape ---------------------------------------------++-- | Per-million-token cost rates, in the catalog's field names.+data CatalogCost = CatalogCost+  { ccInput :: !Scientific,+    ccOutput :: !Scientific,+    ccCacheRead :: !Scientific,+    ccCacheWrite :: !Scientific+  }+  deriving stock (Eq, Show)++-- | 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+  }+  deriving stock (Eq, Show)++-- | A whole catalog file: one provider and its curated models.+data Catalog = Catalog+  { cProvider :: !Text,+    cBaseUrl :: !Text,+    cApi :: !Text,+    cModels :: ![CatalogModel]+  }+  deriving stock (Eq, Show)++-- * Provider specs and normalization ---------------------------------++-- | What a provider needs to be normalized: its identity in the+-- catalog and the curation predicate selecting which upstream model+-- ids to keep.+data ProviderSpec = ProviderSpec+  { psProvider :: !Text,+    psBaseUrl :: !Text,+    psApi :: !Text,+    psInclude :: !(Text -> Bool)+  }++-- | Curation include set for OpenAI: the chat-completions-compatible+-- current line. Responses-API-only ids (@*-pro@, @*-codex@,+-- @*-deep-research@) are deliberately absent.+openaiInclude :: Set Text+openaiInclude =+  Set.fromList+    [ "gpt-5.5",+      "gpt-5.4",+      "gpt-5.4-mini",+      "gpt-5.4-nano",+      "gpt-5.2",+      "gpt-5.1",+      "gpt-5",+      "gpt-5-mini",+      "gpt-5-nano",+      "gpt-4.1",+      "gpt-4.1-mini",+      "gpt-4.1-nano",+      "gpt-4o",+      "gpt-4o-mini",+      "o3",+      "o3-mini",+      "o4-mini",+      "o1"+    ]++-- | Curation include set for Anthropic: the current generations.+anthropicInclude :: Set Text+anthropicInclude =+  Set.fromList+    [ "claude-opus-4-8",+      "claude-opus-4-7",+      "claude-opus-4-6",+      "claude-opus-4-5",+      "claude-sonnet-4-6",+      "claude-sonnet-4-5",+      "claude-haiku-4-5",+      "claude-fable-5"+    ]++-- | Provider spec for OpenAI's first-party chat-completions endpoint.+openaiSpec :: ProviderSpec+openaiSpec =+  ProviderSpec+    { psProvider = "openai",+      psBaseUrl = "https://api.openai.com",+      psApi = "openai-chat-completions",+      psInclude = (`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)+    }++-- | Normalize one provider's upstream models into a 'Catalog'. Keeps+-- only @tool_call == True@ models that pass the curation predicate,+-- maps each upstream model to a 'CatalogModel' (dropping @pdf@ and any+-- non-text/image modality; missing costs and limits default to 0 so a+-- human notices), and sorts by model id for deterministic output.+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)+    }+  where+    kept =+      [ m+      | m <- Map.elems upstream,+        uToolCall m,+        psInclude spec (uId m)+      ]+    toCatalogModel m =+      CatalogModel+        { cmId = uId m,+          cmName = fromMaybe (uId m) (uName m),+          cmReasoning = uReasoning m,+          cmInput =+            if "image" `elem` uInputMods m+              then [InputText, InputImage]+              else [InputText],+          cmCost =+            CatalogCost+              { ccInput = fromMaybe 0 (uCostIn m),+                ccOutput = fromMaybe 0 (uCostOut m),+                ccCacheRead = fromMaybe 0 (uCacheRead m),+                ccCacheWrite = fromMaybe 0 (uCacheWrite m)+              },+          cmContextWindow = fromMaybe 0 (uCtx m),+          cmMaxOutputTokens = fromMaybe 0 (uMaxOut m)+        }++-- * Rendering ---------------------------------------------------------++-- | Render a 'Catalog' as catalog JSON, byte-for-byte in the style of+-- the hand-maintained files: 2-space indent, an inline @input@ array,+-- costs as decimal numbers with a trailing @.0@ on whole values, and a+-- trailing newline.+renderCatalog :: Catalog -> ByteString+renderCatalog cat = encodeUtf8 (Text.unlines (renderLines cat))++renderLines :: Catalog -> [Text]+renderLines cat =+  ["{"]+    ++ [ "  \"provider\": " <> jsonString (cProvider cat) <> ",",+         "  \"baseUrl\": " <> jsonString (cBaseUrl cat) <> ",",+         "  \"api\": " <> jsonString (cApi cat) <> ",",+         "  \"compat\": \"auto\","+       ]+    ++ modelsSection (cModels cat)+    ++ ["}"]++modelsSection :: [CatalogModel] -> [Text]+modelsSection [] = ["  \"models\": []"]+modelsSection ms =+  ["  \"models\": ["]+    ++ concat (addBlockCommas (map renderModel ms))+    ++ ["  ]"]++-- | Append a trailing comma to the last line of each block except the+-- final one, so emitted model objects are comma-separated.+addBlockCommas :: [[Text]] -> [[Text]]+addBlockCommas [] = []+addBlockCommas [b] = [b]+addBlockCommas (b : rest) = appendCommaToLast b : addBlockCommas rest+  where+    appendCommaToLast xs = case reverse xs of+      [] -> xs+      (lastLine : front) -> reverse ((lastLine <> ",") : front)++renderModel :: CatalogModel -> [Text]+renderModel m =+  [ "    {",+    "      \"id\": " <> jsonString (cmId m) <> ",",+    "      \"name\": " <> jsonString (cmName m) <> ",",+    "      \"reasoning\": " <> jsonBool (cmReasoning m) <> ",",+    "      \"input\": " <> renderInput (cmInput m) <> ",",+    "      \"cost\": {",+    "        \"input\": " <> renderNum (ccInput c) <> ",",+    "        \"output\": " <> renderNum (ccOutput c) <> ",",+    "        \"cacheRead\": " <> renderNum (ccCacheRead c) <> ",",+    "        \"cacheWrite\": " <> renderNum (ccCacheWrite c),+    "      },",+    "      \"contextWindow\": " <> Text.pack (show (cmContextWindow m)) <> ",",+    "      \"maxOutputTokens\": " <> Text.pack (show (cmMaxOutputTokens m)) <> ",",+    "      \"enabled\": true",+    "    }"+  ]+  where+    c = cmCost m++renderInput :: [InputModality] -> Text+renderInput ms = "[" <> Text.intercalate ", " (map one ms) <> "]"+  where+    one InputText = "\"text\""+    one InputImage = "\"image\""++jsonBool :: Bool -> Text+jsonBool True = "true"+jsonBool False = "false"++-- | Render a cost as a fixed-point decimal. Whole values gain a+-- trailing @.0@ (e.g. @15@ → @15.0@) to match the existing files;+-- fractional values keep their natural decimal form (e.g. @0.075@).+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).+jsonString :: Text -> Text+jsonString t =+  "\"" <> Text.replace "\"" "\\\"" (Text.replace "\\" "\\\\" t) <> "\""
src/Baikai/Auth.hs view
@@ -13,7 +13,7 @@   ) where -import Baikai.Error (BaikaiError (..))+import Baikai.Error (authError) import Control.Exception (throwIO) import Control.Monad.IO.Class (MonadIO, liftIO) import Data.Aeson (ToJSON (toJSON), object, (.=))@@ -47,8 +47,8 @@ renderApiKeySourceForDebug (ApiKeyEnv name) =   "ApiKeyEnv " <> Text.pack (show name) --- | Resolve a key source to a plain 'Text'. Throws 'ProviderError' (a--- constructor of 'BaikaiError') if 'ApiKeyEnv' is used and the named variable+-- | 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 -- is unset. resolveApiKey :: (MonadIO m) => ApiKeySource -> m Text resolveApiKey (ApiKeyLiteral t) = pure t@@ -56,4 +56,4 @@   liftIO $     Environment.lookupEnv name >>= \case       Just v -> pure (Text.pack v)-      Nothing -> throwIO (ProviderError ("env var " <> Text.pack name <> " is not set"))+      Nothing -> throwIO (authError ("env var " <> Text.pack name <> " is not set"))
src/Baikai/Cost.hs view
@@ -37,6 +37,28 @@ _Cost :: Cost _Cost = Cost {usd = 0, breakdown = _CostBreakdown} +-- Field-wise combination so callers can total per-call costs with+-- '(<>)'/'mconcat'. 'mempty' reuses the existing zero value, so the+-- identity laws hold by construction (adding zero rationals).++instance Semigroup CostBreakdown where+  a <> b =+    CostBreakdown+      { inputUsd = inputUsd a + inputUsd b,+        outputUsd = outputUsd a + outputUsd b,+        cachedInputUsd = cachedInputUsd a + cachedInputUsd b,+        cachedWriteUsd = cachedWriteUsd a + cachedWriteUsd b+      }++instance Monoid CostBreakdown where+  mempty = _CostBreakdown++instance Semigroup Cost where+  a <> b = Cost {usd = usd a + usd b, breakdown = breakdown a <> breakdown b}++instance Monoid Cost where+  mempty = _Cost+ instance ToJSON CostBreakdown where   toJSON cb =     object
src/Baikai/Error.hs view
@@ -1,13 +1,210 @@-module Baikai.Error (BaikaiError (..)) where+module Baikai.Error+  ( BaikaiError (..),+    ErrorCategory (..), -import Control.Exception (Exception)+    -- * Smart constructors+    providerError,+    invalidRequest,+    decodeError,+    processError,+    rateLimited,+    authError,+    providerUnavailable,++    -- * Accessors+    isRetryable,++    -- * Pure classification helpers for provider packages+    classifyHttpStatus,+    classifyHttpStatusWithBody,+    bodyIndicatesOverflow,+  )+where++import Control.Exception (Exception (displayException))+import Data.Aeson+  ( FromJSON (parseJSON),+    Options (constructorTagModifier, fieldLabelModifier),+    ToJSON (toJSON),+    camelTo2,+    defaultOptions,+    genericParseJSON,+    genericToJSON,+  ) import Data.Text (Text)+import Data.Text qualified as Text import GHC.Generics (Generic) -data BaikaiError-  = ProviderError !Text-  | RequestInvalid !Text-  | DecodeError !Text-  | ProcessError !Int !Text+-- | A provider-neutral category for a failed call. Callers switch on+-- this to decide policy (retry, surface to user, abort). The set is+-- closed and stable; new HTTP nuances map onto an existing member+-- rather than growing this type.+data ErrorCategory+  = -- | Authentication/authorization failure: missing or rejected+    -- credentials (HTTP 401/403, or a missing API-key env var).+    AuthError+  | -- | The provider rate-limited the request (HTTP 429). Usually+    -- retryable after a delay; see 'retryAfterSeconds'.+    RateLimited+  | -- | The request exceeded the model's context window or a related+    -- size limit. Not retryable as-is; the caller must shrink input.+    ContextOverflow+  | -- | The request was malformed or otherwise rejected as invalid+    -- (HTTP 400/404/422). Not retryable without changes.+    InvalidRequest+  | -- | A transient server-side or network failure (HTTP 408/5xx, or a+    -- connection error). Safe to retry, ideally with backoff.+    TransientError+  | -- | The response could not be decoded/parsed into the expected+    -- shape.+    DecodeFailure+  | -- | A subprocess (the @claude -p@ or @codex exec@ CLI provider)+    -- exited non-zero. The exit code is in 'exitCode'.+    ProcessFailure+  | -- | No provider handler was registered for the model's API tag.+    ProviderUnavailable+  | -- | Anything not covered above.+    OtherError   deriving stock (Eq, Show, Generic)-  deriving anyclass (Exception)++-- | Categories serialize as snake_case strings (e.g. @"rate_limited"@).+instance ToJSON ErrorCategory where+  toJSON =+    genericToJSON+      defaultOptions {constructorTagModifier = camelTo2 '_'}++instance FromJSON ErrorCategory where+  parseJSON =+    genericParseJSON+      defaultOptions {constructorTagModifier = camelTo2 '_'}++-- | A failed baikai call. The 'category' drives caller policy; the+-- remaining fields carry optional structured hints. No record-field+-- prefixes (project convention): fields are plain names.+data BaikaiError = BaikaiError+  { category :: !ErrorCategory,+    -- | Human-readable detail, safe to log.+    message :: !Text,+    -- | The HTTP status code, when the failure came from an HTTP call.+    httpStatus :: !(Maybe Int),+    -- | Seconds to wait before retrying, parsed from a @Retry-After@+    -- header when present and integer-valued.+    retryAfterSeconds :: !(Maybe Int),+    -- | The subprocess exit code, for 'ProcessFailure'.+    exitCode :: !(Maybe Int)+  }+  deriving stock (Eq, Show, Generic)++-- | Fields serialize as snake_case (e.g. @http_status@, @retry_after_seconds@).+instance ToJSON BaikaiError where+  toJSON =+    genericToJSON+      defaultOptions {fieldLabelModifier = camelTo2 '_'}++instance FromJSON BaikaiError where+  parseJSON =+    genericParseJSON+      defaultOptions {fieldLabelModifier = camelTo2 '_'}++instance Exception BaikaiError where+  displayException e =+    "BaikaiError(" <> show (category e) <> "): " <> Text.unpack (message e)++-- | Base value with everything absent; used by smart constructors.+baseError :: ErrorCategory -> Text -> BaikaiError+baseError c m =+  BaikaiError+    { category = c,+      message = m,+      httpStatus = Nothing,+      retryAfterSeconds = Nothing,+      exitCode = Nothing+    }++-- Smart constructors. These keep call sites close to the old API: an+-- old @ProviderError "x"@ becomes @providerError "x"@, etc.++-- | A generic provider failure with no further classification.+providerError :: Text -> BaikaiError+providerError = baseError OtherError++-- | A request rejected as invalid.+invalidRequest :: Text -> BaikaiError+invalidRequest = baseError InvalidRequest++-- | A response that failed to decode.+decodeError :: Text -> BaikaiError+decodeError = baseError DecodeFailure++-- | A subprocess that exited non-zero. First argument is the exit code.+processError :: Int -> Text -> BaikaiError+processError code m = (baseError ProcessFailure m) {exitCode = Just code}++-- | A rate-limit failure with an optional retry-after hint (seconds).+rateLimited :: Maybe Int -> Text -> BaikaiError+rateLimited secs m =+  (baseError RateLimited m) {retryAfterSeconds = secs, httpStatus = Just 429}++-- | An authentication/authorization or credential-configuration failure.+authError :: Text -> BaikaiError+authError = baseError AuthError++-- | No provider handler registered for a model's API tag.+providerUnavailable :: Text -> BaikaiError+providerUnavailable = baseError ProviderUnavailable++-- | Whether the application may sensibly retry this error. True for+-- rate limits and transient server/network failures; False otherwise.+-- (Note: 'retryAfterSeconds' may still be 'Nothing' even when this is+-- True, meaning "retryable but no server-suggested delay".)+isRetryable :: BaikaiError -> Bool+isRetryable e = case category e of+  RateLimited -> True+  TransientError -> True+  _ -> False++-- | Map an HTTP status code (and an optional already-parsed+-- retry-after-seconds value) to a category. Pure and network-free so it+-- can be unit-tested in the core package; provider packages call it+-- after extracting the status from their SDK's exception type.+--+-- The body of a 400 may indicate a context-window overflow, but this+-- helper only sees the status code; callers that can inspect the body+-- should special-case overflow before falling back here.+classifyHttpStatus :: Int -> Maybe Int -> ErrorCategory+classifyHttpStatus status _retryAfter+  | status == 401 || status == 403 = AuthError+  | status == 429 = RateLimited+  | status == 408 = TransientError+  | status == 400 || status == 404 || status == 422 = InvalidRequest+  | status >= 500 = TransientError+  | otherwise = OtherError++-- | Like 'classifyHttpStatus', but also inspects the response body so a+-- 400/422 whose body signals a context-window overflow is categorised+-- as 'ContextOverflow' rather than the plain 'InvalidRequest' the status+-- alone would give. All other statuses defer to 'classifyHttpStatus'.+classifyHttpStatusWithBody :: Int -> Maybe Int -> Text -> ErrorCategory+classifyHttpStatusWithBody status retryAfter body+  | (status == 400 || status == 422) && bodyIndicatesOverflow body =+      ContextOverflow+  | otherwise = classifyHttpStatus status retryAfter++-- | Whether an error body's text contains a known context-window+-- overflow marker (case-insensitive). Covers the phrasings used by the+-- Anthropic and OpenAI APIs.+bodyIndicatesOverflow :: Text -> Bool+bodyIndicatesOverflow body =+  any (`Text.isInfixOf` lower) markers+  where+    lower = Text.toLower body+    markers =+      [ "context length",+        "context_length_exceeded",+        "maximum context",+        "context window",+        "prompt is too long",+        "too many tokens",+        "request_too_large",+        "too many total text bytes"+      ]
src/Baikai/Models/Generated.hs view
@@ -23,6 +23,28 @@ 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@@ -31,42 +53,64 @@     , api = AnthropicMessages     , provider = "anthropic"     , baseUrl = "https://api.anthropic.com"-    , reasoning = False+    , reasoning = True     , input = [InputText, InputImage]     , cost = ModelCost-        { inputCost = 4 % 5-        , outputCost = 4 % 1-        , cacheReadCost = 2 % 25-        , cacheWriteCost = 1 % 1+        { inputCost = 1 % 1+        , outputCost = 5 % 1+        , cacheReadCost = 1 % 10+        , cacheWriteCost = 5 % 4         }     , contextWindow = 200000-    , maxOutputTokens = 8192+    , maxOutputTokens = 64000     , headers = Map.empty     , compat = CompatNone     } -anthropic_claude_haiku_4_5_20251001 :: Model-anthropic_claude_haiku_4_5_20251001 =+anthropic_claude_opus_4_5 :: Model+anthropic_claude_opus_4_5 =   Model-    { modelId = "claude-haiku-4-5-20251001"-    , name = "Claude Haiku 4.5 (2025-10-01)"+    { modelId = "claude-opus-4-5"+    , name = "Claude Opus 4.5"     , api = AnthropicMessages     , provider = "anthropic"     , baseUrl = "https://api.anthropic.com"-    , reasoning = False+    , reasoning = True     , input = [InputText, InputImage]     , cost = ModelCost-        { inputCost = 4 % 5-        , outputCost = 4 % 1-        , cacheReadCost = 2 % 25-        , cacheWriteCost = 1 % 1+        { inputCost = 5 % 1+        , outputCost = 25 % 1+        , cacheReadCost = 1 % 2+        , cacheWriteCost = 25 % 4         }     , contextWindow = 200000-    , maxOutputTokens = 8192+    , 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@@ -78,13 +122,57 @@     , reasoning = True     , input = [InputText, InputImage]     , cost = ModelCost-        { inputCost = 15 % 1-        , outputCost = 75 % 1-        , cacheReadCost = 3 % 2-        , cacheWriteCost = 75 % 4+        { 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 = 8192+    , maxOutputTokens = 64000     , headers = Map.empty     , compat = CompatNone     }@@ -97,7 +185,7 @@     , api = AnthropicMessages     , provider = "anthropic"     , baseUrl = "https://api.anthropic.com"-    , reasoning = False+    , reasoning = True     , input = [InputText, InputImage]     , cost = ModelCost         { inputCost = 3 % 1@@ -105,8 +193,8 @@         , cacheReadCost = 3 % 10         , cacheWriteCost = 15 % 4         }-    , contextWindow = 200000-    , maxOutputTokens = 8192+    , contextWindow = 1000000+    , maxOutputTokens = 64000     , headers = Map.empty     , compat = CompatNone     }@@ -155,6 +243,72 @@     , 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@@ -199,11 +353,209 @@     , 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 = "OpenAI o1"+    , name = "o1"     , api = OpenAIChatCompletions     , provider = "openai"     , baseUrl = "https://api.openai.com"@@ -221,24 +573,68 @@     , compat = CompatNone     } -openai_o1_mini :: Model-openai_o1_mini =+openai_o3 :: Model+openai_o3 =   Model-    { modelId = "o1-mini"-    , name = "OpenAI o1-mini"+    { 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 = 3 % 1-        , outputCost = 12 % 1-        , cacheReadCost = 3 % 2+        { inputCost = 11 % 10+        , outputCost = 22 % 5+        , cacheReadCost = 11 % 20         , cacheWriteCost = 0 % 1         }-    , contextWindow = 128000-    , maxOutputTokens = 65536+    , 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     }
src/Baikai/Provider/Cli/Internal.hs view
@@ -101,8 +101,8 @@ maybeApply (Just a) f b = f a b  -- | Decode UTF-8 bytes leniently, replacing invalid sequences with--- U+FFFD. Used for surfacing CLI stderr in--- 'Baikai.Error.ProcessError'.+-- U+FFFD. Used for surfacing CLI stderr in a+-- 'Baikai.Error.ProcessFailure' error. decodeUtf8Lenient :: ByteString -> Text decodeUtf8Lenient = Text.decodeUtf8With Text.lenientDecode 
src/Baikai/Provider/Registry.hs view
@@ -9,8 +9,9 @@ -- 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 'Baikai.Error.ProviderError' when--- no handler is registered for that tag.+-- tag and dispatches; it throws a 'Baikai.Error.BaikaiError' in the+-- 'Baikai.Error.ProviderUnavailable' category when no handler is+-- registered for that tag. module Baikai.Provider.Registry   ( ApiProvider (..),     ProviderRegistry,@@ -27,7 +28,7 @@  import Baikai.Api (Api, renderApi) import Baikai.Context (Context)-import Baikai.Error (BaikaiError (..))+import Baikai.Error (providerUnavailable) import Baikai.Model (Model (..)) import Baikai.Options (Options) import Baikai.Response (Response)@@ -87,7 +88,7 @@ lookupApiProvider = lookupApiProviderWith globalProviderRegistry  -- | Dispatch a synchronous request through the registered handler--- for the model's 'Api' tag. Throws 'ProviderError' when no handler+-- for the model's 'Api' tag. Throws a 'ProviderUnavailable' error when no handler -- is registered for that tag. completeRequestWith :: ProviderRegistry -> Model -> Context -> Options -> IO Response completeRequestWith reg m ctx opts = do@@ -96,7 +97,7 @@     Just p -> complete p m ctx opts     Nothing ->       throwIO $-        ProviderError ("No provider registered for API: " <> renderApi (api m))+        providerUnavailable ("No provider registered for API: " <> renderApi (api m))  -- | Dispatch a synchronous request through the process-global registry. completeRequest :: Model -> Context -> Options -> IO Response
src/Baikai/Response.hs view
@@ -19,6 +19,7 @@  import Baikai.Api (Api (..)) import Baikai.Content (AssistantContent)+import Baikai.Error (BaikaiError) import Baikai.Message (AssistantPayload (..), Message (..)) import Baikai.Model (Model, _Model) import Baikai.StopReason (StopReason (..))@@ -36,7 +37,14 @@     api :: !Api,     provider :: !Text,     responseId :: !(Maybe Text),-    latencyMs :: !Integer+    latencyMs :: !Integer,+    -- | 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.+    errorInfo :: !(Maybe BaikaiError)   }   deriving stock (Eq, Show, Generic) @@ -58,7 +66,8 @@       api = Custom "",       provider = "",       responseId = Nothing,-      latencyMs = 0+      latencyMs = 0,+      errorInfo = Nothing     }  -- | Wrap the response payload as a conversation 'AssistantMessage'.
src/Baikai/Stream.hs view
@@ -31,6 +31,7 @@   ) import Baikai.Content qualified as Content import Baikai.Context (Context)+import Baikai.Error (BaikaiError, providerUnavailable) import Baikai.Message (AssistantPayload (..), Message (AssistantMessage)) import Baikai.Message qualified as Msg import Baikai.Model (Model)@@ -51,8 +52,11 @@     StartPayload (..),     TerminalPayload (..),     ToolCallEndPayload (..),+    doneTerminal,+    errorTerminal,   ) import Baikai.Usage (_Usage)+import Control.Exception (fromException) import Control.Exception qualified import Control.Lens ((%~), (&), (.~), (^.)) import Data.Aeson qualified as Aeson@@ -126,8 +130,10 @@     textBuf :: !(IntMap Text),     thinkBuf :: !(IntMap Text),     toolArgsBuf :: !(IntMap Text),-    -- | 'Just (reason, msg)' once 'EventDone' or 'EventError' fires.-    terminal :: !(Maybe (StopReason, Message))+    -- | '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))   }   deriving stock (Show, Generic) @@ -181,18 +187,18 @@       & #blocks %~ IntMap.insert i (AssistantToolCall tc)       & #toolArgsBuf %~ IntMap.delete i   EventDone TerminalPayload {reason = r, message = msg} ->-    s & #terminal .~ Just (r, msg)-  EventError TerminalPayload {reason = r, message = msg} ->-    s & #terminal .~ Just (r, msg)+    s & #terminal .~ Just (r, msg, Nothing)+  EventError TerminalPayload {reason = r, message = msg, errorInfo = ei} ->+    s & #terminal .~ Just (r, msg, ei)  finalizeState :: ReassemblyState -> IO Response finalizeState s = do   now <- getCurrentTime   let m = s ^. #model       assembled = assembleBlocks s-      (terminalMsg, terminalReason) = case s ^. #terminal of-        Just (r, msg) -> (msg, r)-        Nothing -> (synthesizeTerminal now assembled, Stop)+      (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@@ -206,7 +212,8 @@         api = m ^. #api,         provider = m ^. #provider,         responseId = Nothing,-        latencyMs = latency+        latencyMs = latency,+        errorInfo = terminalError       }  -- | Project the closed content blocks in 'contentIndex' order, plus@@ -325,7 +332,7 @@       reason = payload ^. #stopReason    in [EventStart StartPayload {partial = skeleton}]         <> blockEvents-        <> [EventDone TerminalPayload {reason = reason, message = msg}]+        <> [EventDone (doneTerminal reason msg)]  blockEvent :: Int -> AssistantContent -> [AssistantMessageEvent] blockEvent i = \case@@ -350,30 +357,39 @@ errorEvent :: Control.Exception.SomeException -> IO AssistantMessageEvent errorEvent e = do   now <- getCurrentTime-  let msg =+  -- When a @complete@ handler threw a typed 'BaikaiError' (the CLI,+  -- 'Baikai.Auth', and registry paths do), preserve it structurally so a+  -- caller draining this lifted stream still gets the category and any+  -- retry hint. Otherwise fall back to the displayed exception text.+  let mErr = fromException e :: Maybe BaikaiError+      errText = case mErr of+        Just be -> be ^. #message+        Nothing -> Text.pack (Control.Exception.displayException e)+      msg =         AssistantMessage           AssistantPayload             { Msg.content = Vector.empty,               Msg.usage = _Usage,               Msg.stopReason = ErrorReason,-              Msg.errorMessage = Just (Text.pack (Control.Exception.displayException e)),+              Msg.errorMessage = Just errText,               Msg.timestamp = now             }-  pure (EventError TerminalPayload {reason = ErrorReason, message = msg})+  pure (EventError (errorTerminal ErrorReason msg mErr))  -- | The single 'EventError' value used when no provider is -- registered for the model's API tag. noProviderEvent :: Model -> IO AssistantMessageEvent noProviderEvent m = do   now <- getCurrentTime-  let msg =+  let detail = "No provider registered for API: " <> renderApi (m ^. #api)+      be = providerUnavailable detail+      msg =         AssistantMessage           AssistantPayload             { Msg.content = Vector.empty,               Msg.usage = _Usage,               Msg.stopReason = ErrorReason,-              Msg.errorMessage =-                Just ("No provider registered for API: " <> renderApi (m ^. #api)),+              Msg.errorMessage = Just detail,               Msg.timestamp = now             }-  pure (EventError TerminalPayload {reason = ErrorReason, message = msg})+  pure (EventError (errorTerminal ErrorReason msg (Just be)))
src/Baikai/Stream/Event.hs view
@@ -31,11 +31,14 @@     BlockEndPayload (..),     ToolCallEndPayload (..),     TerminalPayload (..),+    doneTerminal,+    errorTerminal,     isTerminal,   ) where  import Baikai.Content (ToolCall)+import Baikai.Error (BaikaiError) import Baikai.Message (Message) import Baikai.StopReason (StopReason) import Data.Aeson (ToJSON)@@ -148,10 +151,26 @@ -- resolved 'StopReason' and the assembled 'message'. data TerminalPayload = TerminalPayload   { reason :: !StopReason,-    message :: !Message+    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.+    errorInfo :: !(Maybe BaikaiError)   }   deriving stock (Eq, Show, Generic)   deriving anyclass (ToJSON)++-- | 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}++-- | 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}  -- | 'True' when the event terminates the stream — exactly one -- 'EventDone' or 'EventError' is emitted per call.
src/Baikai/Usage.hs view
@@ -6,7 +6,7 @@ -- 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) where+module Baikai.Usage (Usage (..), _Usage, sumUsage) where  import Baikai.Cost (Cost, _Cost) import Data.Aeson@@ -16,6 +16,7 @@     defaultOptions,     genericToJSON,   )+import Data.Maybe (fromMaybe) import GHC.Generics (Generic) import Numeric.Natural (Natural) @@ -46,3 +47,30 @@       totalTokens = 0,       cost = _Cost     }++-- | Combine two optional reasoning-token counts. Presence wins: an+-- absent side counts as zero, but the result is only 'Nothing' when+-- both sides are 'Nothing', so a non-reasoning call summed with a+-- reasoning call keeps the reasoning total.+combineReasoning :: Maybe Natural -> Maybe Natural -> Maybe Natural+combineReasoning Nothing Nothing = Nothing+combineReasoning a b = Just (fromMaybe 0 a + fromMaybe 0 b)++instance Semigroup Usage where+  a <> b =+    Usage+      { inputTokens = inputTokens a + inputTokens b,+        outputTokens = outputTokens a + outputTokens b,+        cacheReadTokens = cacheReadTokens a + cacheReadTokens b,+        cacheWriteTokens = cacheWriteTokens a + cacheWriteTokens b,+        reasoningTokens = combineReasoning (reasoningTokens a) (reasoningTokens b),+        totalTokens = totalTokens a + totalTokens b,+        cost = cost a <> cost b+      }++instance Monoid Usage where+  mempty = _Usage++-- | Total a collection of per-call usages into one.+sumUsage :: (Foldable f) => f Usage -> Usage+sumUsage = foldl' (<>) mempty
test/CostSpec.hs view
@@ -138,7 +138,8 @@           api = Custom "test",           provider = "claude-api",           responseId = Nothing,-          latencyMs = 100+          latencyMs = 100,+          errorInfo = Nothing         }  -- Register a handler under a private API tag that returns a canned@@ -162,7 +163,8 @@           api = cannedApi,           provider = "canned",           responseId = Nothing,-          latencyMs = 7+          latencyMs = 7,+          errorInfo = Nothing         }  registerCanned :: Response -> IO ()
+ test/ErrorInfoSpec.hs view
@@ -0,0 +1,65 @@+-- | End-to-end check that a structured error set on an 'EventError'+-- terminal is threaded through reassembly onto the 'Response' a caller+-- gets back from 'completeRequest'. This is the user-visible payoff of+-- the in-band error-classification work: branch on category/retry+-- without parsing error text.+module ErrorInfoSpec (tests) where++import Baikai+import Baikai.Prelude+import Streamly.Data.Stream qualified as Stream+import Test.Tasty (TestTree, testGroup)+import Test.Tasty.HUnit (assertFailure, testCase, (@?=))++errApi :: Api+errApi = Custom "baikai-errinfo"++errModel :: Model+errModel =+  _Model+    & #modelId+    .~ "err-model"+    & #api+    .~ errApi+    & #provider+    .~ "test"++-- | A stream that emits a single 'EventError' carrying a structured+-- 'RateLimited' error with a retry-after hint.+errStream :: Model -> Context -> Options -> Stream.Stream IO AssistantMessageEvent+errStream _ _ _ =+  let payload =+        (_Response ^. #message)+          & #stopReason+          .~ ErrorReason+          & #errorMessage+          .~ Just "rate limited, slow down"+      term =+        errorTerminal+          ErrorReason+          (AssistantMessage payload)+          (Just (rateLimited (Just 5) "rate limited, slow down"))+   in Stream.fromList [EventError term]++registerErr :: IO ()+registerErr =+  registerApiProvider+    ApiProvider+      { apiTag = errApi,+        stream = errStream,+        complete = streamingComplete errStream+      }++tests :: TestTree+tests =+  testGroup+    "Response.errorInfo threading"+    [ testCase "completeRequest surfaces structured errorInfo" $ do+        registerErr+        resp <- completeRequest errModel _Context _Options+        case resp ^. #errorInfo of+          Just be -> do+            be ^. #category @?= RateLimited+            be ^. #retryAfterSeconds @?= Just 5+          Nothing -> assertFailure "expected Response.errorInfo to be populated"+    ]
+ test/ErrorSpec.hs view
@@ -0,0 +1,92 @@+module ErrorSpec (tests) where++import Baikai.Error+  ( BaikaiError (..),+    ErrorCategory (..),+    classifyHttpStatus,+    classifyHttpStatusWithBody,+    decodeError,+    invalidRequest,+    isRetryable,+    processError,+    rateLimited,+  )+import Test.Tasty (TestTree, testGroup)+import Test.Tasty.HUnit (testCase, (@?=))++tests :: TestTree+tests =+  testGroup+    "Baikai.Error"+    [ classifyTests,+      bodyClassifyTests,+      retryTests,+      constructorTests+    ]++bodyClassifyTests :: TestTree+bodyClassifyTests =+  testGroup+    "classifyHttpStatusWithBody"+    [ testCase "400 + overflow body -> ContextOverflow" $+        classifyHttpStatusWithBody 400 Nothing "This model's maximum context length is 8192 tokens"+          @?= ContextOverflow,+      testCase "400 + prompt-too-long body -> ContextOverflow" $+        classifyHttpStatusWithBody 400 Nothing "prompt is too long: 9000 tokens > 8000"+          @?= ContextOverflow,+      testCase "400 + ordinary body -> InvalidRequest" $+        classifyHttpStatusWithBody 400 Nothing "missing required field 'model'"+          @?= InvalidRequest,+      testCase "429 + overflow-looking body still RateLimited (status wins)" $+        classifyHttpStatusWithBody 429 Nothing "context length whatever"+          @?= RateLimited,+      testCase "500 defers to status -> TransientError" $+        classifyHttpStatusWithBody 500 Nothing "context length" @?= TransientError+    ]++classifyTests :: TestTree+classifyTests =+  testGroup+    "classifyHttpStatus"+    [ testCase "401 -> AuthError" $ classifyHttpStatus 401 Nothing @?= AuthError,+      testCase "403 -> AuthError" $ classifyHttpStatus 403 Nothing @?= AuthError,+      testCase "429 -> RateLimited" $ classifyHttpStatus 429 Nothing @?= RateLimited,+      testCase "408 -> TransientError" $ classifyHttpStatus 408 Nothing @?= TransientError,+      testCase "400 -> InvalidRequest" $ classifyHttpStatus 400 Nothing @?= InvalidRequest,+      testCase "404 -> InvalidRequest" $ classifyHttpStatus 404 Nothing @?= InvalidRequest,+      testCase "422 -> InvalidRequest" $ classifyHttpStatus 422 Nothing @?= InvalidRequest,+      testCase "500 -> TransientError" $ classifyHttpStatus 500 Nothing @?= TransientError,+      testCase "502 -> TransientError" $ classifyHttpStatus 502 Nothing @?= TransientError,+      testCase "503 -> TransientError" $ classifyHttpStatus 503 Nothing @?= TransientError,+      testCase "418 -> OtherError" $ classifyHttpStatus 418 Nothing @?= OtherError+    ]++retryTests :: TestTree+retryTests =+  testGroup+    "isRetryable / retryAfterSeconds"+    [ testCase "rate limited is retryable" $+        isRetryable (rateLimited (Just 30) "slow down") @?= True,+      testCase "rate limited carries retry-after" $+        retryAfterSeconds (rateLimited (Just 30) "slow down") @?= Just 30,+      testCase "rate limited sets httpStatus 429" $+        httpStatus (rateLimited Nothing "slow down") @?= Just 429,+      testCase "invalid request is not retryable" $+        isRetryable (invalidRequest "bad shape") @?= False,+      testCase "decode failure is not retryable" $+        isRetryable (decodeError "garbled") @?= False+    ]++constructorTests :: TestTree+constructorTests =+  testGroup+    "smart constructors"+    [ testCase "processError carries exit code" $+        exitCode (processError 2 "boom") @?= Just 2,+      testCase "processError category is ProcessFailure" $+        category (processError 2 "boom") @?= ProcessFailure,+      testCase "invalidRequest category" $+        category (invalidRequest "x") @?= InvalidRequest,+      testCase "decodeError category" $+        category (decodeError "x") @?= DecodeFailure+    ]
+ test/FetchModelsSpec.hs view
@@ -0,0 +1,114 @@+{-# 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+-- models.dev-shaped fixture. No network is involved.+module FetchModelsSpec (tests) where++import Baikai.Model (InputModality (..))+import Data.ByteString.Lazy qualified as BSL+import Data.Map.Strict (Map)+import Data.Map.Strict qualified as Map+import Data.Text (Text)+import Data.Text qualified as Text+import Data.Text.Encoding (decodeUtf8)+import FetchModelsCore+import Test.Tasty (TestTree, testGroup)+import Test.Tasty.HUnit (assertBool, testCase, (@?=))++-- | Path to the fixture, relative to the @baikai@ package directory+-- (tests run with that as the working directory, as 'CatalogSpec'+-- relies on for its @src/...@ path).+fixturePath :: FilePath+fixturePath = "test/fixtures/models-dev-sample.json"++loadUpstream :: IO (Map Text (Map Text UpstreamModel))+loadUpstream = do+  raw <- BSL.readFile fixturePath+  case parseUpstream raw of+    Left err -> error ("fixture parse failed: " <> err)+    Right u -> pure u++-- | 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)++-- | Expected OpenAI catalog after normalization. @gpt-5-pro@ is+-- excluded by curation (Responses-API-only) and @gpt-legacy-nontool@+-- by the @tool_call@ filter; models sort by id, so @gpt-5-nano@+-- precedes @gpt-5.4@.+expectedOpenAI :: Catalog+expectedOpenAI =+  Catalog+    { cProvider = "openai",+      cBaseUrl = "https://api.openai.com",+      cApi = "openai-chat-completions",+      cModels =+        [ 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+            },+          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+            }+        ]+    }++tests :: TestTree+tests =+  testGroup+    "Baikai.FetchModels"+    [ testCase "OpenAI normalization filters, curates, and maps fields" $ do+        upstream <- loadUpstream+        catalogFor upstream openaiSpec @?= expectedOpenAI,+      testCase "tool_call: false model is excluded" $ do+        upstream <- loadUpstream+        let ids = map cmId (cModels (catalogFor upstream openaiSpec))+        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))+        assertBool "gpt-5-pro must be excluded" ("gpt-5-pro" `notElem` ids),+      testCase "pdf modality is dropped" $ do+        upstream <- loadUpstream+        let rendered = renderText (catalogFor upstream openaiSpec)+        assertBool+          "input renders as [\"text\", \"image\"] with no pdf"+          ("\"input\": [\"text\", \"image\"]" `Text.isInfixOf` rendered)+        assertBool "no pdf in rendered output" (not ("pdf" `Text.isInfixOf` rendered)),+      testCase "missing cache costs default to 0.0 in rendered output" $ do+        upstream <- loadUpstream+        let rendered = renderText (catalogFor upstream openaiSpec)+        assertBool+          "cacheRead 0.0 present (gpt-5-nano default)"+          ("\"cacheRead\": 0.0" `Text.isInfixOf` rendered)+        assertBool+          "cacheWrite 0.0 present"+          ("\"cacheWrite\": 0.0" `Text.isInfixOf` rendered),+      testCase "whole-number costs render with a trailing .0" $ do+        upstream <- loadUpstream+        let rendered = renderText (catalogFor upstream openaiSpec)+        assertBool+          "output 15 renders as 15.0"+          ("\"output\": 15.0" `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"]+    ]++renderText :: Catalog -> Text+renderText = decodeUtf8 . renderCatalog
test/Main.hs view
@@ -11,11 +11,15 @@ import Data.Text qualified as Text import Data.Vector qualified as V import EmbeddingSpec qualified+import ErrorInfoSpec qualified+import ErrorSpec qualified+import FetchModelsSpec qualified import InteractiveSpec qualified import Streamly.Data.Stream qualified as Stream import Test.Tasty (TestTree, defaultMain, testGroup) import Test.Tasty.HUnit (assertBool, testCase, (@?=)) import TraceSpec qualified+import UsageSpec qualified  -- | Ground the test provider on a 'Custom' API tag so it does not -- clash with the real Anthropic/OpenAI handlers if a future test@@ -78,8 +82,12 @@         CatalogSpec.tests,         CostSpec.tests,         EmbeddingSpec.tests,+        ErrorInfoSpec.tests,+        ErrorSpec.tests,+        FetchModelsSpec.tests,         InteractiveSpec.tests,-        TraceSpec.tests+        TraceSpec.tests,+        UsageSpec.tests       ]  tests :: TestTree
test/TraceSpec.hs view
@@ -3,7 +3,7 @@ import Baikai.Api (Api (..)) import Baikai.Content (AssistantContent (..), TextContent (..)) import Baikai.Context (Context (..), _Context)-import Baikai.Error (BaikaiError (..))+import Baikai.Error (BaikaiError, providerError) import Baikai.Message (AssistantPayload (..), user) import Baikai.Model (Model (..), _Model) import Baikai.Options (Options, _Options)@@ -69,7 +69,8 @@       api = a,       provider = "stub.trace",       responseId = Nothing,-      latencyMs = 0+      latencyMs = 0,+      errorInfo = Nothing     }  registerOk :: Api -> IO ()@@ -110,7 +111,7 @@         pure (),       testCase "encodes failure as ErrorReason in the response" $ do         let a = Custom "baikai-trace-silent-fail"-        registerFail a (ProviderError "boom")+        registerFail a (providerError "boom")         resp <- withTrace silent (stubModel a) stubContext stubOptions         let AssistantPayload {stopReason = sr, errorMessage = em} = resp ^. #message         sr @?= ErrorReason@@ -142,7 +143,7 @@ memoryFailTest =   testCase "memory sink records CallStarted then CallFailed on stream error" $ do     let a = Custom "baikai-trace-memory-fail"-    registerFail a (ProviderError "stub-failure")+    registerFail a (providerError "stub-failure")     (ref, sink) <- memorySink     resp <- withTrace sink (stubModel a) stubContext stubOptions     -- The producer-side failure surfaces as an ErrorReason on the
+ test/UsageSpec.hs view
@@ -0,0 +1,120 @@+module UsageSpec (tests) where++import Baikai.Cost (Cost (..), CostBreakdown (..), _Cost, _CostBreakdown)+import Baikai.Usage (Usage (..), sumUsage, _Usage)+import Test.Tasty (TestTree, testGroup)+import Test.Tasty.HUnit (testCase, (@?=))++tests :: TestTree+tests =+  testGroup+    "Baikai.Usage"+    [ identityTests,+      additionTests,+      reasoningTests,+      costTests,+      sumUsageTests+    ]++-- | A non-trivial usage value for identity checks.+u0 :: Usage+u0 =+  _Usage+    { inputTokens = 10,+      outputTokens = 5,+      cacheReadTokens = 2,+      cacheWriteTokens = 1,+      reasoningTokens = Just 3,+      totalTokens = 18,+      cost = costOf 1 2 3 4+    }++-- | Build a 'Cost' whose breakdown carries the four given USD/100 rates+-- and whose 'usd' is their sum (so the totals stay self-consistent).+costOf :: Rational -> Rational -> Rational -> Rational -> Cost+costOf i o ci cw =+  Cost+    { usd = (i + o + ci + cw) / 100,+      breakdown =+        CostBreakdown+          { inputUsd = i / 100,+            outputUsd = o / 100,+            cachedInputUsd = ci / 100,+            cachedWriteUsd = cw / 100+          }+    }++identityTests :: TestTree+identityTests =+  testGroup+    "monoid identity"+    [ testCase "mempty <> u == u" $ (mempty <> u0) @?= u0,+      testCase "u <> mempty == u" $ (u0 <> mempty) @?= u0,+      testCase "mempty == _Usage" $ (mempty :: Usage) @?= _Usage+    ]++additionTests :: TestTree+additionTests =+  testGroup+    "field-wise addition"+    [ testCase "numeric fields add" $ do+        let a = _Usage {inputTokens = 10, outputTokens = 5, cacheReadTokens = 2, cacheWriteTokens = 1, totalTokens = 15}+            b = _Usage {inputTokens = 3, outputTokens = 1, cacheReadTokens = 4, cacheWriteTokens = 5, totalTokens = 4}+            s = a <> b+        inputTokens s @?= 13+        outputTokens s @?= 6+        cacheReadTokens s @?= 6+        cacheWriteTokens s @?= 6+        totalTokens s @?= 19+    ]++reasoningTests :: TestTree+reasoningTests =+  testGroup+    "reasoningTokens presence rule"+    [ testCase "Just <> Nothing == Just" $+        reasoningTokens (rJust 5 <> rNothing) @?= Just 5,+      testCase "Nothing <> Just == Just" $+        reasoningTokens (rNothing <> rJust 5) @?= Just 5,+      testCase "Nothing <> Nothing == Nothing" $+        reasoningTokens (rNothing <> rNothing) @?= Nothing,+      testCase "Just <> Just sums" $+        reasoningTokens (rJust 2 <> rJust 3) @?= Just 5+    ]+  where+    rJust n = _Usage {reasoningTokens = Just n}+    rNothing = _Usage {reasoningTokens = Nothing}++costTests :: TestTree+costTests =+  testGroup+    "cost totals add"+    [ testCase "usd and breakdown add" $ do+        let a = _Usage {cost = costOf 1 0 0 0}+            b = _Usage {cost = costOf 2 0 0 0}+            c = cost (a <> b)+        usd c @?= 3 / 100+        inputUsd (breakdown c) @?= 3 / 100,+      testCase "breakdown is a monoid" $ do+        let s = breakdown (costOf 1 2 3 4) <> breakdown (costOf 5 6 7 8)+        inputUsd s @?= 6 / 100+        outputUsd s @?= 8 / 100+        cachedInputUsd s @?= 10 / 100+        cachedWriteUsd s @?= 12 / 100,+      testCase "mempty cost is zero" $ do+        (mempty :: Cost) @?= _Cost+        (mempty :: CostBreakdown) @?= _CostBreakdown+    ]++sumUsageTests :: TestTree+sumUsageTests =+  testGroup+    "sumUsage"+    [ testCase "sumUsage equals chained <>" $ do+        let u1 = _Usage {inputTokens = 1, totalTokens = 1}+            u2 = _Usage {inputTokens = 2, totalTokens = 2}+            u3 = _Usage {inputTokens = 3, totalTokens = 3}+        sumUsage [u1, u2, u3] @?= (u1 <> u2 <> u3),+      testCase "sumUsage [] == mempty" $+        sumUsage [] @?= (mempty :: Usage)+    ]