Types.hs

-- | Configuration, typed answers, and credential-safe failures.
-- Fields support record-dot syntax and pattern matching; there are no ordinary
-- record selector functions. Public answer constructors do not enforce invariants.
module Jev.Types
  ( Provider (..),
    Config (..),
    defaultConfig,
    RequestOptions (..),
    defaultRequestOptions,
    Option (..),
    JsonOption (..),
    NoulCriteria (..),
    Choice (..),
    Score (..),
    Noul (..),
    Response (..),
    Usage (..),
    ResponseMetadata (..),
    TransportFailure (..),
    JevError (..),
    renderJevError,
  )
where

import Data.Aeson (Value)
import Data.ByteString.Lazy qualified as LBS
import Data.IntMap.Strict (IntMap)
import Data.Maybe (fromMaybe)
import Data.Text (Text)
import Data.Text qualified as T
import Data.Text.Encoding (decodeUtf8Lenient)
import Network.HTTP.Types.Header (ResponseHeaders)

-- | The gateway used for validation and the default endpoint.
data Provider = TypeSafe | OpenRouter deriving (Eq, Show)

-- | Reusable client settings. Deliberately has no 'Show' instance to protect keys.
data Config = Config
  { -- | Gateway; distinct from the provider reported in a response.
    provider :: Provider,
    -- | Explicit bearer token. No environment lookup is performed.
    apiKey :: Text,
    -- | Model name or alias; pin a version for reproducible thresholds.
    model :: Text,
    -- | Complete URL override, including path. 'Nothing' selects the gateway default.
    endpoint :: Maybe Text,
    -- | Positive deadline for the entire HTTP operation, including the body, in microseconds. Excludes validation and response decoding.
    timeoutMicros :: Int
  }

-- | Defaults to a 30-second HTTP deadline and the gateway's documented endpoint.
-- TypeSafe uses @jev-latest@; OpenRouter uses @typesafe/jev-1.13@.
defaultConfig :: Provider -> Text -> Config
defaultConfig provider apiKey = Config provider apiKey model Nothing 30000000
  where
    model = case provider of
      TypeSafe -> "jev-latest"
      OpenRouter -> "typesafe/jev-1.13"

-- | Optional OpenRouter request settings. Nonempty settings are rejected for
-- TypeSafe rather than silently ignored. Nested routing and trace schemas are
-- validated by OpenRouter. Avoid putting secrets in observability metadata.
data RequestOptions = RequestOptions
  { -- | OpenRouter @provider@ object.
    providerRouting :: Maybe Value,
    -- | Observability session identifier, at most 256 characters.
    sessionId :: Maybe Text,
    -- | OpenRouter trace metadata object.
    trace :: Maybe Value,
    -- | End-user identifier, at most 256 characters.
    user :: Maybe Text
  }
  deriving (Eq, Show)

-- | No routing or observability overrides; works with both gateways.
defaultRequestOptions :: RequestOptions
defaultRequestOptions = RequestOptions Nothing Nothing Nothing Nothing

type role Option representational

-- | @Option value label description@: domain value, unique wire label, and
-- optional description. Values need no typeclass instances; labels must be unique.
data Option a = Option a Text (Maybe Text) deriving (Eq, Show, Functor)

type role JsonOption representational

-- | Structured version of @Option@. Descriptions accept strings, objects, arrays,
-- or null. Both 'Nothing' and @Just Null@ encode an undescribed option.
data JsonOption a = JsonOption a Text (Maybe Value) deriving (Eq, Show, Functor)

type role NoulCriteria representational

-- | Descriptions of the yes and no outcomes, in that order.
data NoulCriteria a = NoulCriteria
  { -- | Meaning of a yes answer.
    true :: a,
    -- | Meaning of a no answer.
    false :: a
  }
  deriving (Eq, Show, Functor)

type role Choice representational

-- | A selected domain value and the distribution over all supplied options.
-- 'fmap' transforms the selected value and every distribution entry.
data Choice a = Choice
  { -- | An option with maximal probability, allowing rounding tolerance.
    choice :: a,
    -- | Provider confidence in [0,1]; not the selected probability.
    confidence :: Double,
    -- | Distribution in the original option order, summing approximately to one.
    probabilities :: [(a, Double)]
  }
  deriving (Eq, Show, Functor)

-- | An expected value on the zero-based rubric scale, not normalized to [0,1].
data Score = Score
  { -- | Probability-weighted rubric index, possibly fractional.
    score :: Double,
    -- | Provider confidence in [0,1].
    confidence :: Double,
    -- | Sparse distribution; missing levels are not inserted. Sum is approximately one.
    probabilities :: IntMap Double,
    -- | Returned descriptions; includes every supplied probability index. Sparse legends are preserved.
    legend :: IntMap Value
  }
  deriving (Eq, Show)

-- | Probability of yes, in [0,1]. Choose application-specific thresholds.
newtype Noul = Noul {probability :: Double} deriving (Eq, Show)

-- | Usage fields are absent when the gateway does not report them.
data Usage = Usage
  { -- | Input token count.
    inputTokens :: Maybe Int,
    -- | Output token count.
    outputTokens :: Maybe Int,
    -- | OpenRouter-reported cost in USD, when present.
    cost :: Maybe Double
  }
  deriving (Eq, Show)

type role Response representational

-- | Typed answers with provider metadata. 'fmap' changes only the answers.
data Response a = Response
  { -- | Result of the composed question.
    answers :: a,
    -- | Resolved model reported by the gateway.
    model :: Text,
    -- | Reported usage; individual fields are optional.
    usage :: Usage,
    -- | Body @id@, falling back to @x-typesafe-request-id@.
    requestId :: Maybe Text,
    -- | Provider name reported by the gateway, if supplied.
    provider :: Maybe Text
  }
  deriving (Eq, Show, Functor)

-- | HTTP context retained even when a response cannot be decoded.
-- Headers and error bodies are server-controlled and may contain sensitive data.
data ResponseMetadata = ResponseMetadata
  { -- | HTTP status code.
    statusCode :: Int,
    -- | Unmodified response headers, including any @Retry-After@.
    headers :: ResponseHeaders,
    -- | Body @id@, falling back to @x-typesafe-request-id@.
    requestId :: Maybe Text
  }
  deriving (Eq, Show)

-- | Stable categories without exception text, URLs, request bodies, or credentials.
-- DNS and TLS failures may be reported as connection or internal failures by
-- the underlying manager. These categories do not imply a request is safe to retry.
data TransportFailure
  = -- | Total HTTP deadline expired, including body consumption.
    DeadlineExceeded
  | -- | The manager's response timeout expired.
    ResponseTimedOut
  | -- | Connection establishment timed out.
    ConnectionTimedOut
  | -- | The endpoint could not be parsed.
    InvalidEndpoint
  | -- | A connection could not be established or used.
    ConnectionFailed
  | -- | The connection closed unexpectedly.
    ConnectionClosed
  | -- | Malformed, truncated, or otherwise invalid HTTP response.
    InvalidResponse
  | -- | The supplied manager cannot make TLS requests.
    TlsNotSupported
  | -- | An internal manager exception, potentially a TLS failure.
    InternalTransportFailure
  | -- | Another HTTP transport failure.
    OtherTransportFailure
  deriving (Eq, Show)

-- | Expected failures are returned in 'Either'; asynchronous cancellation propagates.
-- Custom manager hooks and user-supplied pure functions can still throw exceptions.
data JevError
  = -- | Invalid local input; no HTTP request was made.
    ValidationError Text
  | -- | Categorized, credential-safe transport failure.
    TransportError TransportFailure
  | -- | Non-2xx response with metadata and original body.
    HttpError ResponseMetadata LBS.ByteString
  | -- | Pure fixture decoding failed; no HTTP metadata is available.
    DecodeError Text
  | -- | A successful HTTP response contained an invalid answer.
    ResponseDecodeError ResponseMetadata Text
  deriving (Eq, Show)

-- | Log-friendly description with the constructor, status code, request ID, and
-- message or body (truncated to 500 bytes). Never includes response headers.
-- Error bodies are server-controlled and may still contain sensitive data.
renderJevError :: JevError -> Text
renderJevError err = case err of
  ValidationError message -> "ValidationError: " <> message
  TransportError failure -> "TransportError: " <> T.pack (show failure)
  HttpError metadata body -> "HttpError" <> context metadata <> ": " <> truncated body
  DecodeError message -> "DecodeError: " <> message
  ResponseDecodeError metadata message -> "ResponseDecodeError" <> context metadata <> ": " <> message
  where
    context metadata = " (status " <> T.pack (show metadata.statusCode) <> ", request ID " <> fromMaybe "unknown" metadata.requestId <> ")"
    truncated body
      | LBS.length body > 500 = decodeUtf8Lenient (LBS.toStrict (LBS.take 500 body)) <> "... (truncated)"
      | otherwise = decodeUtf8Lenient (LBS.toStrict body)