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 +78/−0
- baikai.cabal +33/−2
- fetch/FetchModels.hs +193/−0
- fetch/FetchModelsCore.hs +377/−0
- src/Baikai/Auth.hs +4/−4
- src/Baikai/Cost.hs +22/−0
- src/Baikai/Error.hs +205/−8
- src/Baikai/Models/Generated.hs +430/−34
- src/Baikai/Provider/Cli/Internal.hs +2/−2
- src/Baikai/Provider/Registry.hs +6/−5
- src/Baikai/Response.hs +11/−2
- src/Baikai/Stream.hs +33/−17
- src/Baikai/Stream/Event.hs +20/−1
- src/Baikai/Usage.hs +29/−1
- test/CostSpec.hs +4/−2
- test/ErrorInfoSpec.hs +65/−0
- test/ErrorSpec.hs +92/−0
- test/FetchModelsSpec.hs +114/−0
- test/Main.hs +9/−1
- test/TraceSpec.hs +5/−4
- test/UsageSpec.hs +120/−0
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)+ ]