packages feed

shikumi-cache-0.1.2.0: src/Shikumi/Cache/ResponseJSON.hs

{-# OPTIONS_GHC -Wno-orphans #-}

-- | A faithful JSON round-trip for baikai's 'Response' graph (EP-6).
--
-- The persistent cache backends (SQLite/Redis/Postgres) store each cached
-- 'Baikai.Response.Response' as JSON and read it back. baikai's 'Response' graph
-- round-trips only /partially/ out of the box: 'Baikai.Model.Model',
-- 'Baikai.Api.Api', 'Baikai.Content.AssistantContent', and
-- 'Baikai.StopReason.StopReason' have both 'ToJSON' and 'FromJSON'; but
-- 'Baikai.Usage.Usage', 'Baikai.Cost.Cost', and 'Baikai.Cost.CostBreakdown' are
-- 'ToJSON'-only, and 'Baikai.Message.AssistantPayload' and 'Response' have no
-- aeson instances at all.
--
-- This module supplies the missing pieces as __orphan instances__ so a 'Response'
-- can be encoded and decoded losslessly enough for caching. The instances mirror
-- baikai's own encoders exactly:
--
--   * 'Usage' uses @camelTo2 '_'@ field labels (baikai's @usageOptions@), so the
--     'FromJSON' reads the same snake_case keys baikai's 'ToJSON' writes.
--   * 'Cost' / 'CostBreakdown' read the @usd@ / @*_usd@ 'Scientific' fields baikai
--     writes (via @fromRationalRepetendUnlimited@) and lift them back to
--     'Rational' with 'toRational'. This is lossy only for non-terminating
--     repetends; it never affects the typed-output guarantee, which is decoded
--     from the assistant __text__ ('AssistantContent', which round-trips
--     exactly) — cost is metadata.
--   * 'AssistantPayload' / 'Response' use @defaultOptions@ (matching baikai's
--     @deriving anyclass ToJSON@).
--
-- This module is the __single home__ for these orphans across the whole
-- framework. EP-7's @Shikumi.Trace.ResponseJSON@ re-exports them from here rather
-- than defining its own copy, so no module that imports both the cache and the
-- trace package ever sees duplicate instances.
module Shikumi.Cache.ResponseJSON () where

import Baikai.Cost (Cost (..), CostBreakdown (..))
import Baikai.Message (AssistantPayload (..))
import Baikai.Response (Response (..))
import Baikai.Usage (Usage (..))
import Data.Aeson
  ( FromJSON (parseJSON),
    Key,
    Object,
    Options (fieldLabelModifier),
    ToJSON (toJSON),
    camelTo2,
    defaultOptions,
    genericParseJSON,
    genericToJSON,
    withObject,
    (.:),
  )
import Data.Aeson.Types (Parser)
import Data.Scientific (Scientific)

-- | baikai's 'Usage' field-label scheme: @camelTo2 '_'@ (snake_case).
usageOptions :: Options
usageOptions = defaultOptions {fieldLabelModifier = camelTo2 '_'}

-- | Parse a required object field as 'Scientific' and lift it to 'Rational',
-- inverting baikai's @Rational -> Scientific@ cost encoding. A synthetic cost
-- with a non-terminating decimal expansion, such as @1 % 3@, does not satisfy
-- 'Eq' after an encode/decode round-trip because baikai's encoder drops the
-- repetend index. Real USD pricing rates are decimal, so real provider costs
-- terminate; do not rely on round-tripped 'CachedResponse' equality for
-- synthetic non-decimal costs.
ratField :: Object -> Key -> Parser Rational
ratField o k = toRational <$> (o .: k :: Parser Scientific)

instance FromJSON Usage where
  parseJSON = genericParseJSON usageOptions

instance FromJSON CostBreakdown where
  parseJSON = withObject "CostBreakdown" $ \o ->
    CostBreakdown
      <$> ratField o "input_usd"
      <*> ratField o "output_usd"
      <*> ratField o "cached_input_usd"
      <*> ratField o "cached_write_usd"

instance FromJSON Cost where
  parseJSON = withObject "Cost" $ \o ->
    Cost <$> ratField o "usd" <*> o .: "breakdown"

instance FromJSON AssistantPayload where
  parseJSON = genericParseJSON defaultOptions

instance ToJSON Response where
  toJSON = genericToJSON defaultOptions

instance FromJSON Response where
  parseJSON = genericParseJSON defaultOptions