typesafe-ai (empty) → 0.1.0.0

raw patch · 8 files changed

+1393/−0 lines, 8 filesdep +aesondep +basedep +bytestring

Dependencies added: aeson, base, bytestring, http-client, http-client-tls, http-types, random, tasty, tasty-hunit, text, time, typesafe-ai, typesafe-ai-core, wai, warp

Files

• CHANGELOG.md +18/−0
• LICENSE +28/−0
• README.md +44/−0
• src/TypeSafe.hs +59/−0
• src/TypeSafe/Client.hs +446/−0
• src/TypeSafe/Tutorial.hs +385/−0
• test/Main.hs +313/−0
• typesafe-ai.cabal +100/−0

@@ -0,0 +1,18 @@+# Changelog for typesafe-ai++This package follows the [PVP](https://pvp.haskell.org) and is released+together with `typesafe-ai-core`, with the same version number.++## 0.1.0.0++First release. Checked against version 0.2.0 of the TypeSafe OpenAPI+specification.++- `TypeSafe.Client`: an `http-client` transport with a shared TLS connection+  pool, per-attempt timeouts, retries with exponential backoff and jitter that+  honour `Retry-After` and `retry-after-ms`, and a logging hook.+- Configuration from `TYPESAFE_API_KEY`, `TYPESAFE_BASE_URL` and+  `TYPESAFE_DEFAULT_MODEL`, like the official Python and JavaScript SDKs.+- `TypeSafe` re-exports the whole API, and the package re-exports the modules+  of `typesafe-ai-core`.+- `TypeSafe.Tutorial`: a guided tour of the SDK.

@@ -0,0 +1,28 @@+BSD 3-Clause License++Copyright (c) 2026, byteally++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++1. Redistributions of source code must retain the above copyright notice, this+   list of conditions and the following disclaimer.++2. Redistributions in binary form must reproduce the above copyright notice,+   this list of conditions and the following disclaimer in the documentation+   and/or other materials provided with the distribution.++3. Neither the name of the copyright holder nor the names of its+   contributors may be used to endorse or promote products derived from+   this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"+AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE+IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE+DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE+FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL+DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR+SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER+CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,+OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

@@ -0,0 +1,44 @@+# typesafe-ai++A Haskell client for [TypeSafe AI](https://typesafe.ai)'s System One API.+Send text or JSON state with typed questions, and get back answers that decode+to your own Haskell types.++```haskell+{-# LANGUAGE DeriveAnyClass, DeriveGeneric, DerivingStrategies, OverloadedStrings #-}++import GHC.Generics (Generic)+import TypeSafe++data Department = Billing | Technical | Sales+  deriving stock (Show, Eq, Generic)+  deriving anyclass (ChoiceOption)++main :: IO ()+main = do+  client <- newClientFromEnv -- reads TYPESAFE_API_KEY+  result <-+    send client $+      systemOne "Help! My payouts have been failing for 3 days." $+        (,) <$> ask "department" (choice "Which team should handle this?")+            <*> ask "is_urgent" (noul "Does this convey urgency?")+  let (department, urgent) = evaluationAnswers result+  print (choiceSelected department :: Department, choiceConfidence department)+  print (noulProbability urgent)+```++- Choice options and Score levels are your own types; the answer can only be+  one of them.+- Questions combine with `Applicative`, and many questions fit in one+  request.+- Built on `http-client`, with a shared TLS connection pool, per-attempt+  timeouts, and retries with exponential backoff that honour `Retry-After`.+- Errors are values that separate local validation, error responses,+  connection failures and unexpected responses.++Read `TypeSafe.Tutorial` for a guided tour. The types, codecs and calls live+in [`typesafe-ai-core`](https://hackage.haskell.org/package/typesafe-ai-core),+which has no HTTP dependency. The+[repository](https://github.com/byteally/typesafe-sdk) has runnable examples.++This is a community SDK, not affiliated with or endorsed by TypeSafe AI.

@@ -0,0 +1,59 @@+-- |+-- Module      : TypeSafe+-- Description : Typed questions for the TypeSafe System One API+-- Copyright   : (c) 2026 byteally+-- License     : BSD-3-Clause+--+-- A client for TypeSafe's System One API (<https://docs.typesafe.ai>).+-- Send a /state/ (text or JSON) with typed questions, and get back answers+-- your code can use directly: a probability for a yes\/no 'noul', one of your+-- own options for a 'choice', a level of your own rubric for a 'score'.+--+-- @+-- {-# LANGUAGE DeriveAnyClass, DeriveGeneric, DerivingStrategies, OverloadedStrings #-}+--+-- import GHC.Generics (Generic)+-- import TypeSafe+--+-- data Department = Billing | Technical | Sales+--   deriving stock (Show, Generic)+--   deriving anyclass ('ChoiceOption')+--+-- main :: IO ()+-- main = do+--   client <- 'newClientFromEnv'+--   result <-+--     'send' client $+--       'systemOne' \"Help! My payouts have been failing for 3 days.\" $+--         (,)+--           \<$\> 'ask' \"department\" ('choice' \"Which team should handle this?\")+--           \<*\> 'ask' \"is_urgent\" ('noul' \"Does this convey urgency?\")+--   let (department, urgent) = 'evaluationAnswers' result+--   print ('choiceSelected' department :: Department, 'choiceConfidence' department)+--   print ('noulProbability' urgent)+-- @+--+-- "TypeSafe.Tutorial" walks through the library step by step. The other+-- modules are:+--+-- ["TypeSafe.Question"] questions and answers ('noul', 'choice', 'score',+-- 'ask').+--+-- ["TypeSafe.Call"] the API calls ('systemOne', 'listModels') and per-call+-- options ('withModel', 'withTimeout', …).+--+-- ["TypeSafe.Client"] the HTTP client ('newClientFromEnv', 'send').+--+-- ["TypeSafe.Error"], ["TypeSafe.Retry"] errors and the retry policy.+--+-- ["TypeSafe.Wire"] the raw OpenAPI schemas. Not re-exported.+--+-- The types, codecs and calls live in the @typesafe-ai-core@ package, which+-- has no HTTP dependency; this package adds the @http-client@ transport.+module TypeSafe+  ( module TypeSafe.Core+  , module TypeSafe.Client+  ) where++import TypeSafe.Client+import TypeSafe.Core

@@ -0,0 +1,446 @@+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE DerivingStrategies #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ScopedTypeVariables #-}++-- |+-- Module      : TypeSafe.Client+-- Description : A TypeSafe API client built on http-client+-- Copyright   : (c) 2026 byteally+-- License     : BSD-3-Clause+--+-- Sends 'Call's (see "TypeSafe.Call") to the TypeSafe API over+-- @http-client@, with TLS, connection reuse, timeouts and retries.+--+-- @+-- import TypeSafe+--+-- main :: IO ()+-- main = do+--   client <- 'newClientFromEnv'                -- reads TYPESAFE_API_KEY+--   result <- 'send' client $+--     'systemOne' \"Help! My payouts have been failing for 3 days.\"+--       ('ask' \"is_urgent\" ('noul' \"Does this convey urgency?\"))+--   print ('noulProbability' ('evaluationAnswers' result))+-- @+--+-- A 'Client' is immutable and thread-safe. Create one per application and+-- share it: its connection pool is what makes repeated calls fast.+--+-- = Timeouts and retries+--+-- Each attempt must complete within 'configTimeout' (10 seconds by default,+-- see 'withTimeout' to change it per call). Failed attempts are retried+-- according to 'configRetryPolicy', or the policy set with 'withRetryPolicy';+-- see "TypeSafe.Retry" for the defaults.+module TypeSafe.Client+  ( -- * Clients+    Client+  , newClient+  , newClientWith+  , newClientFromEnv+  , clientConfig++    -- * Sending calls+  , send+  , sendEither++    -- * Configuration+  , ClientConfig (..)+  , defaultClientConfig+  , clientConfigFromEnv+  , ApiKey+  , mkApiKey+  , ConfigError (..)++    -- ** Environment variables+  , apiKeyEnv+  , baseUrlEnv+  , defaultModelEnv++    -- * Logging+  , LogEvent (..)+  , LogStage (..)+  , renderLogEvent+  , stderrLogger++    -- * Identification+  , userAgent++    -- * Re-exports+  , Manager+  ) where++import Control.Concurrent (threadDelay)+import Control.Exception (Exception (..), throwIO, toException, try)+import qualified Data.ByteString as BS+import qualified Data.ByteString.Lazy as LBS+import qualified Data.ByteString.Char8 as BS8+import Data.Maybe (fromMaybe)+import Data.Text (Text)+import qualified Data.Text as Text+import qualified Data.Text.Encoding as Text+import qualified Data.Text.Encoding.Error as Text+import qualified Data.Text.IO as Text+import Data.Time.Clock (NominalDiffTime, getCurrentTime)+import Data.Version (showVersion)+import GHC.Clock (getMonotonicTime)+import GHC.Generics (Generic)+import Numeric (showFFloat)+import Network.HTTP.Client (HttpException (..), HttpExceptionContent (..), Manager)+import qualified Network.HTTP.Client as HTTP+import Network.HTTP.Client.TLS (newTlsManager)+import Network.HTTP.Types (RequestHeaders, Status, statusCode, urlEncode)+import qualified Paths_typesafe_ai as Paths+import System.Environment (lookupEnv)+import System.IO (stderr)+import qualified System.Info as Info+import System.Random (randomRIO)+import System.Timeout (timeout)+import TypeSafe.Core++-- $setup+-- >>> :set -XOverloadedStrings++------------------------------------------------------------------------------+-- Configuration++-- | A validated API key. Its 'Show' instance never reveals the key.+newtype ApiKey = ApiKey BS.ByteString++instance Show ApiKey where+  show _ = "<api key>"++-- | Validate an API key. Surrounding whitespace, such as the newline at the+-- end of a key file, is removed; an empty key or one containing whitespace,+-- control or non-ASCII characters is rejected.+--+-- >>> mkApiKey "  ts_live_abc123\n"+-- Right <api key>+--+-- >>> mkApiKey "ts live"+-- Left (InvalidApiKey "the API key contains whitespace, control or non-ASCII characters")+mkApiKey :: Text -> Either ConfigError ApiKey+mkApiKey raw+  | Text.null key = Left (InvalidApiKey "the API key is empty")+  | Text.any (\c -> c < '!' || c > '~') key =+      Left (InvalidApiKey "the API key contains whitespace, control or non-ASCII characters")+  | otherwise = Right (ApiKey (Text.encodeUtf8 key))+  where+    key = Text.strip raw++-- | Why a client could not be configured.+data ConfigError+  = -- | No API key was given, and 'apiKeyEnv' is unset or blank.+    MissingApiKey+  | -- | The API key is malformed.+    InvalidApiKey !Text+  | -- | The base URL cannot be parsed: the URL and the reason.+    InvalidBaseUrl !Text !Text+  | -- | The timeout is not positive.+    InvalidTimeout !NominalDiffTime+  deriving stock (Eq, Show, Generic)++instance Exception ConfigError where+  displayException = \case+    MissingApiKey -> "no TypeSafe API key: set " <> Text.unpack apiKeyEnv <> " or pass one to mkApiKey"+    InvalidApiKey reason -> "invalid TypeSafe API key: " <> Text.unpack reason+    InvalidBaseUrl url reason -> "invalid TypeSafe base URL " <> show url <> ": " <> Text.unpack reason+    InvalidTimeout t -> "invalid timeout " <> show t <> ": it must be positive"++-- | Client settings. Start from 'defaultClientConfig' or+-- 'clientConfigFromEnv' and override fields with record update syntax:+--+-- @+-- (defaultClientConfig key) {'configTimeout' = Just 30, 'configLogger' = 'stderrLogger'}+-- @+data ClientConfig = ClientConfig+  { configApiKey :: !ApiKey+  -- ^ Sent as @Authorization: Bearer …@.+  , configBaseUrl :: !Text+  -- ^ The API root, 'defaultBaseUrl' by default. It may include a path+  -- prefix, for example to go through an AI gateway.+  , configDefaultModel :: !ModelName+  -- ^ The model for calls that do not set one with 'withModel'.+  , configRetryPolicy :: !RetryPolicy+  -- ^ How failed attempts are retried.+  , configTimeout :: !(Maybe NominalDiffTime)+  -- ^ How long each attempt may take, in seconds. 'Nothing' waits forever.+  , configHeaders :: !RequestHeaders+  -- ^ Extra headers for every request. The 'protectedHeaders' cannot be+  -- overridden.+  , configLogger :: !(LogEvent -> IO ())+  -- ^ Called for every attempt, retry and result. Plug in your logging+  -- library here; the default discards everything. Events never contain the+  -- API key or request bodies.+  }++-- | The defaults: 'defaultBaseUrl', 'jevLatest', 'defaultRetryPolicy', a+-- 10 second timeout, no extra headers and no logging.+defaultClientConfig :: ApiKey -> ClientConfig+defaultClientConfig key =+  ClientConfig+    { configApiKey = key+    , configBaseUrl = defaultBaseUrl+    , configDefaultModel = jevLatest+    , configRetryPolicy = defaultRetryPolicy+    , configTimeout = Just 10+    , configHeaders = []+    , configLogger = \_ -> pure ()+    }++-- | @TYPESAFE_API_KEY@: the API key. Required by 'clientConfigFromEnv'.+apiKeyEnv :: Text+apiKeyEnv = "TYPESAFE_API_KEY"++-- | @TYPESAFE_BASE_URL@: overrides 'configBaseUrl'.+baseUrlEnv :: Text+baseUrlEnv = "TYPESAFE_BASE_URL"++-- | @TYPESAFE_DEFAULT_MODEL@: overrides 'configDefaultModel'.+defaultModelEnv :: Text+defaultModelEnv = "TYPESAFE_DEFAULT_MODEL"++-- | 'defaultClientConfig' with the API key, base URL and default model read+-- from 'apiKeyEnv', 'baseUrlEnv' and 'defaultModelEnv'. Blank variables count+-- as unset. These are the same variables the official Python and JavaScript+-- SDKs read.+clientConfigFromEnv :: IO (Either ConfigError ClientConfig)+clientConfigFromEnv = do+  key <- env apiKeyEnv+  baseUrl <- env baseUrlEnv+  model <- env defaultModelEnv+  pure $ do+    apiKey <- maybe (Left MissingApiKey) mkApiKey key+    let config = defaultClientConfig apiKey+    pure+      config+        { configBaseUrl = fromMaybe (configBaseUrl config) baseUrl+        , configDefaultModel = maybe (configDefaultModel config) ModelName model+        }+  where+    env name = do+      value <- lookupEnv (Text.unpack name)+      pure $ case Text.strip . Text.pack <$> value of+        Just v | not (Text.null v) -> Just v+        _ -> Nothing++------------------------------------------------------------------------------+-- Clients++-- | A configured connection to the TypeSafe API.+data Client = Client+  { clientConfig_ :: !ClientConfig+  , clientManager :: !Manager+  , clientBaseRequest :: !HTTP.Request+  }++-- | The configuration a client was created with.+clientConfig :: Client -> ClientConfig+clientConfig = clientConfig_++-- | Create a client with its own TLS connection pool. Throws 'ConfigError'+-- if the configuration is invalid.+newClient :: ClientConfig -> IO Client+newClient config = do+  manager <- newTlsManager+  either throwIO pure (newClientWith manager config)++-- | Create a client that shares an existing @http-client@ 'Manager', for+-- example with servant-client or your own HTTP code. The manager must+-- support TLS for @https@ URLs (see "Network.HTTP.Client.TLS").+newClientWith :: Manager -> ClientConfig -> Either ConfigError Client+newClientWith manager config = do+  case configTimeout config of+    Just t | t <= 0 -> Left (InvalidTimeout t)+    _ -> Right ()+  base <- parseBaseUrl (configBaseUrl config)+  pure Client {clientConfig_ = config, clientManager = manager, clientBaseRequest = base}++-- | 'newClient' with 'clientConfigFromEnv'. Throws 'ConfigError' if+-- @TYPESAFE_API_KEY@ is not set or a variable is invalid.+newClientFromEnv :: IO Client+newClientFromEnv = clientConfigFromEnv >>= either throwIO newClient++parseBaseUrl :: Text -> Either ConfigError HTTP.Request+parseBaseUrl url = case HTTP.parseRequest (Text.unpack url) of+  Left e -> Left (InvalidBaseUrl url (Text.pack (reason e)))+  Right r+    | not (BS.null (HTTP.queryString r)) || BS8.elem '#' (HTTP.path r) ->+        Left (InvalidBaseUrl url "the base URL must not have a query string or fragment")+    | otherwise -> Right r+  where+    reason e = case fromException e of+      Just (InvalidUrlException _ why) -> why+      _ -> displayException e++------------------------------------------------------------------------------+-- Sending++-- | Send a call and return its result. Throws 'TypeSafeError' once retries+-- are exhausted.+send :: Client -> Call a -> IO a+send client call = sendEither client call >>= either throwIO pure++-- | Send a call and return its result or the error, after any retries.+-- Exceptions that are not about the request, such as asynchronous+-- exceptions, propagate as usual.+sendEither :: Client -> Call a -> IO (Either TypeSafeError a)+sendEither client call = case renderCall defaults call of+  Left err -> do+    logEvent 0 (Failed err)+    pure (Left err)+  Right request -> do+    start <- getMonotonicTime+    attempt start (toHttpRequest client request) 1+  where+    config = clientConfig_ client+    defaults = CallDefaults (configDefaultModel config) (configHeaders config)+    policy = fromMaybe (configRetryPolicy config) (callRetryPolicy call)+    limit = maybe (configTimeout config) Just (callTimeout call)+    endpoint = callEndpoint call+    logEvent n stage = configLogger config (LogEvent endpoint n stage)++    attempt start request n = do+      logEvent n Sending+      began <- getMonotonicTime+      outcome <- exchange request+      finished <- getMonotonicTime+      let latency = realToFrac (finished - began)+      result <- case outcome of+        Left err -> pure (Left err)+        Right response -> do+          logEvent n (Received (HTTP.responseStatus response) latency (requestIdOf response))+          pure (parseResponse call (fromHttpResponse response))+      case result of+        Right a -> pure (Right a)+        Left err+          | n <= retryMaxRetries policy && isRetryable policy err -> do+              now <- getCurrentTime+              random <- randomRIO (0, 1)+              let delay = retryDelay policy now random n err+              elapsed <- subtract start <$> getMonotonicTime+              if maybe False (\budget -> realToFrac elapsed + delay >= budget) (retryBudget policy)+                then giveUp n err+                else do+                  logEvent n (Retrying delay err)+                  threadDelay (microseconds delay)+                  attempt start request (n + 1)+          | otherwise -> giveUp n err++    giveUp n err = do+      logEvent n (Failed err)+      pure (Left err)++    exchange request = do+      let run = try (HTTP.httpLbs request (clientManager client))+      outcome <- case limit of+        Nothing -> Just <$> run+        Just t -> timeout (microseconds t) run+      pure $ case outcome of+        Nothing -> Left (ConnectionError (ConnectionTimedOut endpoint))+        Just (Left e) -> Left (classify e)+        Just (Right response) -> Right response++    classify :: HttpException -> TypeSafeError+    classify = \case+      HttpExceptionRequest _ ResponseTimeout -> ConnectionError (ConnectionTimedOut endpoint)+      HttpExceptionRequest _ ConnectionTimeout -> ConnectionError (ConnectionTimedOut endpoint)+      HttpExceptionRequest r content ->+        ConnectionError (ConnectionFailed endpoint (toException (HttpExceptionRequest (redact r) content)))+      e -> ConnectionError (ConnectionFailed endpoint (toException e))++    redact r =+      r+        { HTTP.requestHeaders =+            [(name, if name == "Authorization" then "<redacted>" else value) | (name, value) <- HTTP.requestHeaders r]+        }++    requestIdOf response = RequestId . Text.decodeUtf8With Text.lenientDecode <$> lookup requestIdHeader (HTTP.responseHeaders response)++toHttpRequest :: Client -> HttpRequest -> HTTP.Request+toHttpRequest client r =+  base+    { HTTP.method = httpRequestMethod r+    , HTTP.path = basePath <> "/" <> BS.intercalate "/" (map (urlEncode False . Text.encodeUtf8) (httpRequestPath r))+    , HTTP.requestHeaders =+        ("Authorization", "Bearer " <> key)+          : ("User-Agent", userAgent)+          : httpRequestHeaders r+    , HTTP.requestBody = maybe mempty HTTP.RequestBodyLBS (httpRequestBody r)+    , HTTP.responseTimeout = HTTP.responseTimeoutNone+    }+  where+    base = clientBaseRequest client+    basePath = BS8.dropWhileEnd (== '/') (HTTP.path base)+    ApiKey key = configApiKey (clientConfig_ client)++fromHttpResponse :: HTTP.Response LBS.ByteString -> HttpResponse+fromHttpResponse response =+  HttpResponse (HTTP.responseStatus response) (HTTP.responseHeaders response) (HTTP.responseBody response)++microseconds :: NominalDiffTime -> Int+microseconds t = max 1 (ceiling (t * 1000000))++-- | The @User-Agent@ sent with every request, such as+-- @typesafe-ai-haskell\/0.1.0.0 (ghc-9.12)@.+userAgent :: BS.ByteString+userAgent =+  BS8.pack $+    "typesafe-ai-haskell/"+      <> showVersion Paths.version+      <> " ("+      <> Info.compilerName+      <> "-"+      <> showVersion Info.compilerVersion+      <> ")"++------------------------------------------------------------------------------+-- Logging++-- | Something that happened while sending a call.+data LogEvent = LogEvent+  { logEndpoint :: !Text+  -- ^ The method and path, such as @POST \/v1\/systemone@.+  , logAttempt :: !Int+  -- ^ The attempt number, from 1; 0 for calls rejected before sending.+  , logStage :: !LogStage+  }+  deriving stock (Show, Generic)++-- | The stages of an attempt.+data LogStage+  = -- | The request is about to be sent.+    Sending+  | -- | A response arrived: its status, how long it took, and its request id.+    Received !Status !NominalDiffTime !(Maybe RequestId)+  | -- | The attempt failed and will be retried after the delay.+    Retrying !NominalDiffTime !TypeSafeError+  | -- | The call failed for good.+    Failed !TypeSafeError+  deriving stock (Show, Generic)++-- | A one-line description of an event.+renderLogEvent :: LogEvent -> Text+renderLogEvent (LogEvent endpoint n stage) =+  "[typesafe] " <> endpoint <> " (attempt " <> tshow n <> "): " <> case stage of+    Sending -> "sending"+    Received status latency rid ->+      "HTTP "+        <> tshow (statusCode status)+        <> " in "+        <> seconds latency+        <> maybe "" (\(RequestId r) -> " [" <> r <> "]") rid+    Retrying delay err -> "retrying in " <> seconds delay <> " after: " <> renderTypeSafeError err+    Failed err -> "failed: " <> renderTypeSafeError err++  where+    seconds t = Text.pack (showFFloat (Just 3) (realToFrac t :: Double) "s")++-- | A logger that prints every event to standard error, for debugging.+stderrLogger :: LogEvent -> IO ()+stderrLogger = Text.hPutStrLn stderr . renderLogEvent++tshow :: (Show a) => a -> Text+tshow = Text.pack . show

@@ -0,0 +1,385 @@+{-# OPTIONS_GHC -Wno-unused-imports #-}++-- |+-- Module      : TypeSafe.Tutorial+-- Description : A guided tour of the TypeSafe SDK+-- Copyright   : (c) 2026 byteally+-- License     : BSD-3-Clause+--+-- This module contains no code; it is a tutorial. The examples assume+--+-- @+-- {-# LANGUAGE DeriveAnyClass, DeriveGeneric, DerivingStrategies, LambdaCase, OverloadedStrings #-}+--+-- import Data.Aeson ((.=))+-- import Data.Text (Text)+-- import GHC.Generics (Generic)+-- import TypeSafe+-- @+--+-- Complete, runnable programs are in the @examples@ directory of the+-- repository.+module TypeSafe.Tutorial+  ( -- * 1. What TypeSafe does+    -- $what++    -- * 2. A client+    -- $client++    -- * 3. The first question+    -- $first++    -- * 4. Choosing a question type+    -- $types++    -- * 5. Options and levels are types+    -- $options++    -- * 6. Many questions, one request+    -- $many++    -- * 7. Structured state+    -- $state++    -- * 8. Acting on confidence+    -- $confidence++    -- * 9. Combining scores in code+    -- $composite++    -- * 10. When a question depends on an answer+    -- $dependent++    -- * 11. Errors and retries+    -- $errors++    -- * 12. Models+    -- $models++    -- * 13. Testing code that uses the SDK+    -- $testing++    -- * 14. When the API grows+    -- $evolution+  ) where++import TypeSafe++-- $what+--+-- TypeSafe's System One models make fast, structured judgments. You send a+-- /state/ (the content to judge: text, a record, a conversation) and a set of+-- named /questions/. Each question comes back as a typed answer, never as+-- prose, so the calling code stays in control:+--+-- * a 'noul' asks /is this true?/ and returns a 'Probability';+-- * a 'choice' asks /which of these options?/ and returns one of the options+--   you offered, with a probability for each and a 'Confidence';+-- * a 'score' asks /which level of this rubric?/ and returns an expected+--   level, a probability for each level and a 'Confidence'.+--+-- Ask for judgments a knowledgeable person makes in a second, and compose the+-- answers in Haskell. See <https://docs.typesafe.ai/concepts/system-one>.++-- $client+--+-- Create an API key in the TypeSafe console and export it:+--+-- > export TYPESAFE_API_KEY=...+--+-- Then create one 'Client' for the whole program. It is thread-safe and keeps+-- a pool of connections, so share it rather than creating one per call.+--+-- @+-- client <- 'newClientFromEnv'+-- @+--+-- 'newClientFromEnv' also reads @TYPESAFE_BASE_URL@ and+-- @TYPESAFE_DEFAULT_MODEL@. To configure the client in code instead:+--+-- @+-- key <- either throwIO pure ('mkApiKey' keyFromVault)+-- client <-+--   'newClient'+--     ('defaultClientConfig' key)+--       { 'configTimeout' = Just 5+--       , 'configRetryPolicy' = 'defaultRetryPolicy' {'retryMaxRetries' = 4}+--       , 'configLogger' = 'stderrLogger'+--       }+-- @+--+-- If your application already has an @http-client@ 'Manager' (for example+-- one shared with servant-client), pass it to 'newClientWith'.++-- $first+--+-- A call is a value describing a request. 'send' runs it:+--+-- @+-- result <-+--   'send' client $+--     'systemOne' \"Help! My payouts have been failing for 3 days.\" $+--       'ask' \"is_urgent\" ('noul' \"Does this convey urgency?\")+--+-- print ('noulProbability' ('evaluationAnswers' result))   -- 0.95+-- print ('evaluationModel' result)                       -- \"jev-1.13.0\"+-- print ('usageInputTokens' ('evaluationUsage' result))    -- 296+-- @+--+-- The id passed to 'ask' (@\"is_urgent\"@) only matches the answer to its+-- question. It is not shown to the model, so put the whole question in the+-- instructions.++-- $types+--+-- Pick the type whose answer your code can act on directly+-- (<https://docs.typesafe.ai/primitives>):+--+-- * __Noul__ for a clean yes\/no condition, where the probability itself is+--   useful: \"Does the customer request a refund?\". 'noulWith' also says+--   what a yes and a no mean.+--+-- * __Choice__ for one of a known set of unordered options: routing to a+--   department, classifying a document. Add an @other@ option when the list+--   might not cover every input.+--+-- * __Score__ for a position on a spectrum that you can describe level by+--   level: severity, frustration, skill.+--+-- A Noul of 0.5 means the model is unsure, not that something is \"half+-- true\". To measure how much, use a Score.++-- $options+--+-- Choice options and Score levels are ordinary Haskell types. Derive the+-- classes for an enumeration:+--+-- @+-- data Department = Billing | Technical | Sales+--   deriving stock (Show, Eq, Generic)+--   deriving anyclass ('ChoiceOption')+--+-- data Frustration = Calm | Frustrated | VeryAngry+--   deriving stock (Show, Eq, Generic)+--   deriving anyclass ('ScoreLevel')+-- @+--+-- The answer to @'choice' \"Which team should handle this?\"@ is then a+-- @'Choice' Department@, and 'choiceSelected' can only be one of the three+-- constructors: an option the model was not offered is reported as an error+-- ('UnknownOption'), never passed to your code.+--+-- Constructors are sent in snake case (@billing@) for options and as words+-- (@very angry@) for levels. Descriptions make the model far more accurate,+-- so write them for anything that is not obvious from the name:+--+-- @+-- instance 'ChoiceOption' Department where+--   'optionDescription' = Just . \\case+--     Billing -> \"Payments, invoicing, refunds\"+--     Technical -> \"Bugs, outages, integrations\"+--     Sales -> \"Pricing, upgrades, new accounts\"+--+-- instance 'ScoreLevel' Frustration where+--   'levelDescription' = \\case+--     Calm -> \"Calm, just stating facts\"+--     Frustrated -> \"Frustrated but civil\"+--     VeryAngry -> \"Very angry, strong language\"+-- @+--+-- When the options are only known at run time, such as a catalogue from a+-- database, use 'choiceBy' and 'scoreBy', or 'scoreRubric' for a rubric of+-- plain descriptions:+--+-- @+-- skill :: NonEmpty Skill -> 'Question' ('Choice' Skill)+-- skill = 'choiceBy' skillName (Just . 'contentText' . skillSummary) \"Which skill fits the request?\"+-- @++-- $many+--+-- Every question in a request sees the same state and is evaluated in+-- parallel, so extra questions barely change latency and cost only their own+-- tokens. Ask everything you might need in one request+-- (<https://docs.typesafe.ai/patterns/fan-out>) and let the code ignore what+-- it does not use.+--+-- 'Questions' is an 'Applicative'. Describe the record you want and the+-- questions that fill it:+--+-- @+-- data Triage = Triage+--   { department :: 'Choice' Department+--   , urgent :: 'Noul'+--   , frustration :: 'Score' Frustration+--   }+--+-- triage :: 'Questions' Triage+-- triage =+--   Triage+--     \<$\> 'ask' \"department\" ('choice' \"Which team should handle this?\")+--     \<*\> 'ask' \"is_urgent\" ('noul' \"Does this convey urgency?\")+--     \<*\> 'ask' \"frustration\" ('score' \"How frustrated is the customer?\")+--+-- result <- 'send' client ('systemOne' ticketText triage)+-- @+--+-- Questions generated from data are one 'traverse' away. This scores every+-- passage of a search result in a single request:+--+-- @+-- relevance :: Text -> [Text] -> 'Questions' [(Text, 'Noul')]+-- relevance query passages =+--   for (zip [0 :: Int ..] passages) $ \\(i, passage) ->+--     (,) passage+--       \<$\> 'ask'+--         ('QuestionId' (\"passage_\" <> Text.pack (show i)))+--         ('noul' ('contentObject' [\"query\" .= query, \"passage\" .= passage, \"question\" .= (\"Does \`passage\` answer \`query\`?\" :: Text)]))+-- @+--+-- Ids must be distinct within a request; a clash is reported as+-- 'DuplicateQuestionId' before anything is sent.++-- $state+--+-- The state can be a string or structured JSON. Structure helps: questions+-- can point at a field by its path, in backticks+-- (<https://docs.typesafe.ai/concepts/state>).+--+-- @+-- state :: 'Content'+-- state =+--   'contentObject'+--     [ \"ticket\" .= ticket               -- any ToJSON value+--     , \"refund_policy\" .= policyText+--     ]+--+-- refundRequested :: 'Question' 'Noul'+-- refundRequested = 'noul' \"Does \`ticket.messages[0].text\` request a refund?\"+-- @+--+-- Instructions and descriptions accept structure too, which keeps long+-- context out of the question sentence+-- (<https://docs.typesafe.ai/primitives/advanced>).++-- $confidence+--+-- Choice and Score answers carry a 'Confidence' besides their probabilities.+-- The answer says /what/; the confidence says /whether to act on it/+-- (<https://docs.typesafe.ai/patterns/confidence-routing>):+--+-- @+-- route :: 'Choice' Department -> Action+-- route answer+--   | 'confidence' answer >= 0.8 = Assign ('choiceSelected' answer)+--   | otherwise = SendToHuman ('rankedChoices' answer)+-- @+--+-- Tune thresholds on your own data, and pin the model version you tuned+-- them against (see "12. Models").++-- $composite+--+-- Split a complex judgment into atomic scores and combine them with weights+-- that live in code (<https://docs.typesafe.ai/patterns/composite-scoring>).+-- 'normalizedScore' puts rubrics of any length on a 0–1 scale:+--+-- @+-- priority :: 'Questions' Double+-- priority =+--   (\\sev fru inf -> 0.5 * 'normalizedScore' sev + 0.3 * 'normalizedScore' fru + 0.2 * 'normalizedScore' inf)+--     \<$\> 'ask' \"severity\" ('score' \@Severity \"How severe is the bug?\")+--     \<*\> 'ask' \"frustration\" ('score' \@Frustration \"How frustrated is the customer?\")+--     \<*\> 'ask' \"info\" ('score' \@Detail \"How much does the report give an engineer to work with?\")+-- @+--+-- When priorities change, change the weights, not the prompts.++-- $dependent+--+-- Questions in a request are independent: one answer is not context for+-- another. That is why 'Questions' is an 'Applicative' and not a 'Monad';+-- the types cannot express a question that depends on an answer of the same+-- request.+--+-- When the next question really depends on an answer, because you need it+-- to fetch more data or to decide which options to offer, make a second+-- request:+--+-- @+-- category <- 'evaluationAnswers' \<$\> 'send' client ('systemOne' doc ('ask' \"category\" ('choice' \"Which category?\")))+-- let subcategories = subcategoriesOf ('choiceSelected' category)+-- detail <- 'send' client ('systemOne' doc ('ask' \"sub\" ('choiceBy' name (const Nothing) \"Which subcategory?\" subcategories)))+-- @+--+-- If the second request's questions could have been asked against the+-- original state, ask them in the first request instead.++-- $errors+--+-- 'send' throws a 'TypeSafeError'; 'sendEither' returns it. The constructors+-- separate what callers usually handle differently:+--+-- @+-- 'sendEither' client call >>= \\case+--   Right result -> use result+--   Left ('InvalidRequest' problem) -> bug problem           -- nothing was sent+--   Left ('ServiceError' e) -> case 'apiErrorKind' e of+--     'Unauthorized' -> checkTheKey+--     'RateLimited' -> backOff                                -- already retried+--     _ -> report ('apiErrorMessage' e) ('apiErrorRequestId' e)+--   Left ('ConnectionError' _) -> networkTrouble+--   Left ('ResponseError' e) -> report ('responseErrorProblem' e) ('responseErrorRequestId' e)+-- @+--+-- Rate limiting (429), overload (529), other 5xx statuses, timeouts and+-- connection failures are retried with exponential backoff before an error+-- is reported, honouring the server's @Retry-After@. Adjust the policy per+-- client ('configRetryPolicy') or per call ('withRetryPolicy'); see+-- "TypeSafe.Retry".+--+-- Include 'apiErrorRequestId' when you contact TypeSafe support.++-- $models+--+-- Calls use 'jevLatest' unless the client or the call says otherwise. An+-- alias moves when a new model ships, so if you have tuned thresholds, pin a+-- version:+--+-- @+-- 'send' client ('withModel' \"jev-1.13.0\" ('systemOne' state triage))+-- @+--+-- 'evaluationModel' always reports the versioned model that answered.+-- 'listModels' returns the names available to your account.++-- $testing+--+-- Calls are values, so the code that builds them can be tested without a+-- network. 'renderCall' shows exactly what would be sent, and+-- 'parseResponse' decodes a recorded response:+--+-- @+-- let call = 'systemOne' ticket triage+-- 'renderCall' ('CallDefaults' 'jevLatest' []) call    -- the HTTP request+-- 'parseResponse' call ('HttpResponse' status200 [] recordedBody)+-- @+--+-- For higher-level tests, abstract over sending in your own code, for+-- example with a record of functions or an effect, and interpret calls with+-- 'parseResponse' over canned responses.++-- $evolution+--+-- The SDK keeps working as the API gains features:+--+-- * unknown fields in responses are ignored;+-- * answers of an unknown type are kept (see 'TypeSafe.Wire.AnswerOther' and+--   'evaluationResponse');+-- * 'withExtraBody' sends request fields the SDK does not know yet;+-- * 'otherQuestion' sends a new question type and decodes its answer with+--   your own 'Data.Aeson.FromJSON' instance.+--+-- Prefer upgrading the SDK once it supports the feature properly.+-- 'apiSpecVersion' is the version of the API specification the installed+-- SDK was checked against.

@@ -0,0 +1,313 @@+{-# LANGUAGE OverloadedStrings #-}++-- | Tests the http-client transport against a local mock of the API.+--+-- Set @TYPESAFE_LIVE_TESTS=1@ and @TYPESAFE_API_KEY@ to also run a few+-- requests against the real API.+module Main (main) where++import Control.Concurrent (threadDelay)+import Control.Exception (SomeException, evaluate, try)+import Control.Monad (unless)+import qualified Data.Aeson as Aeson+import qualified Data.ByteString.Lazy as LBS+import Data.IORef+import Data.List (isInfixOf)+import Data.Maybe (isJust)+import qualified Data.Text as Text+import Data.Time.Calendar (fromGregorian)+import Network.HTTP.Client (defaultManagerSettings, newManager)+import Network.HTTP.Types+import qualified Network.Wai as Wai+import Network.Wai.Handler.Warp (testWithApplication)+import System.Environment (lookupEnv, setEnv, unsetEnv)+import Test.Tasty (TestTree, defaultMain, testGroup)+import Test.Tasty.HUnit (assertBool, assertFailure, testCase, (@?=))+import TypeSafe++-- | A request as the mock server saw it.+data Seen = Seen+  { seenMethod :: Method+  , seenPath :: [Text.Text]+  , seenHeaders :: RequestHeaders+  , seenBody :: LBS.ByteString+  }++-- | Run a mock API that answers requests with the given responses in order,+-- repeating the last one.+withMockApi :: [IO Wai.Response] -> (Int -> IORef [Seen] -> IO a) -> IO a+withMockApi responses action = do+  seen <- newIORef []+  script <- newIORef responses+  let app request respond = do+        body <- Wai.strictRequestBody request+        modifyIORef' seen (<> [Seen (Wai.requestMethod request) (Wai.pathInfo request) (Wai.requestHeaders request) body])+        next <- atomicModifyIORef' script $ \pending -> case pending of+          [r] -> ([r], r)+          r : rs -> (rs, r)+          [] -> ([], pure (Wai.responseLBS status500 [] "no scripted response"))+        next >>= respond+  testWithApplication (pure app) (\port -> action port seen)++json :: Status -> ResponseHeaders -> LBS.ByteString -> IO Wai.Response+json status headers body = pure (Wai.responseLBS status (("Content-Type", "application/json") : headers) body)++okNoul :: IO Wai.Response+okNoul =+  json+    status200+    [("x-typesafe-request-id", "req_mock")]+    "{\"model\":\"jev-1.13.0\",\"answers\":{\"billing\":{\"type\":\"noul\",\"noul\":0.98}},\"usage\":{\"input_tokens\":120,\"output_tokens\":12}}"++billing :: Call (Evaluation Noul)+billing = systemOne "I was charged twice." (ask "billing" (noul "Is this about billing?"))++testKey :: ApiKey+testKey = either (error . show) id (mkApiKey "ts_test_secret_value")++-- | A client for the mock API, with fast retries, recording log events.+mockClient :: Int -> (ClientConfig -> ClientConfig) -> IO (Client, IORef [LogEvent])+mockClient port adjust = do+  events <- newIORef []+  manager <- newManager defaultManagerSettings+  let config =+        adjust+          (defaultClientConfig testKey)+            { configBaseUrl = "http://127.0.0.1:" <> Text.pack (show port)+            , configRetryPolicy =+                defaultRetryPolicy {retryInitialBackoff = 0.01, retryMaxBackoff = 0.02}+            , configLogger = \e -> modifyIORef' events (<> [e])+            }+  client <- either (fail . show) pure (newClientWith manager config)+  pure (client, events)++attempts :: IORef [Seen] -> IO Int+attempts seen = length <$> readIORef seen++main :: IO ()+main = do+  live <- liveTests+  defaultMain (testGroup "typesafe-ai" (transportTests : configTests : live))++transportTests :: TestTree+transportTests =+  testGroup+    "http-client transport"+    [ testCase "sends a typed call and decodes the answer" $+        withMockApi [okNoul] $ \port seen -> do+          (client, _) <- mockClient port id+          result <- send client billing+          evaluationAnswers result @?= Noul 0.98+          evaluationRequestId result @?= Just "req_mock"+          [request] <- readIORef seen+          seenMethod request @?= "POST"+          seenPath request @?= ["v1", "systemone"]+          Aeson.decode (seenBody request)+            @?= Just+              ( Aeson.object+                  [ "state" Aeson..= ("I was charged twice." :: Text.Text)+                  , "model" Aeson..= ("jev-latest" :: Text.Text)+                  , "questions" Aeson..= Aeson.object ["billing" Aeson..= Aeson.object ["type" Aeson..= ("noul" :: Text.Text), "instructions" Aeson..= ("Is this about billing?" :: Text.Text)]]+                  ]+              )+    , testCase "authenticates, identifies itself and negotiates JSON" $+        withMockApi [okNoul] $ \port seen -> do+          (client, _) <- mockClient port id+          _ <- send client billing+          [request] <- readIORef seen+          let header name = lookup name (seenHeaders request)+          header "Authorization" @?= Just "Bearer ts_test_secret_value"+          header "Content-Type" @?= Just "application/json"+          header "Accept" @?= Just "application/json"+          assertBool "user agent" (maybe False ("typesafe-ai-haskell/" `LBS.isPrefixOf`) (LBS.fromStrict <$> header "User-Agent"))+    , testCase "extra headers cannot replace the protected ones" $+        withMockApi [okNoul] $ \port seen -> do+          (client, _) <- mockClient port (\c -> c {configHeaders = [("X-Team", "search"), ("Authorization", "Bearer other")]})+          _ <- send client (withHeaders [("User-Agent", "spoof"), ("X-Call", "1")] billing)+          [request] <- readIORef seen+          let values name = [v | (n, v) <- seenHeaders request, n == name]+          values "Authorization" @?= ["Bearer ts_test_secret_value"]+          values "User-Agent" @?= [userAgent]+          values "X-Team" @?= ["search"]+          values "X-Call" @?= ["1"]+    , testCase "a base URL with a path prefix is kept" $+        withMockApi [okNoul] $ \port seen -> do+          (client, _) <- mockClient port (\c -> c {configBaseUrl = configBaseUrl c <> "/gateway/typesafe/"})+          _ <- send client billing+          map seenPath <$> readIORef seen >>= (@?= [["gateway", "typesafe", "v1", "systemone"]])+    , testCase "lists models" $+        withMockApi [json status200 [] "{\"models\":[{\"name\":\"jev-latest\",\"description\":\"General-purpose system one model.\",\"release_date\":\"2026-09-15\"}]}"] $+          \port seen -> do+            (client, _) <- mockClient port id+            models <- send client listModels+            map modelMetadataName models @?= ["jev-latest"]+            map modelMetadataReleaseDay models @?= [Just (fromGregorian 2026 9 15)]+            [request] <- readIORef seen+            (seenMethod request, seenBody request) @?= ("GET", "")+    , testCase "retries a rate limit, honouring retry-after-ms" $+        withMockApi [json status429 [("retry-after-ms", "30")] "{}", okNoul] $ \port seen -> do+          (client, events) <- mockClient port id+          result <- sendEither client billing+          fmap evaluationAnswers result `rightIs` Noul 0.98+          attempts seen >>= (@?= 2)+          delays <- mapRetries <$> readIORef events+          delays @?= [0.03]+    , testCase "retries an overloaded API until the retries run out" $+        withMockApi [json (mkStatus 529 "Overloaded") [] "{\"detail\":{\"message\":\"busy\"}}"] $ \port seen -> do+          (client, events) <- mockClient port id+          result <- sendEither client billing+          case result of+            Left (ServiceError e) -> (apiErrorKind e, apiErrorMessage e) @?= (Overloaded, Just "busy")+            other -> assertFailure (show (fmap evaluationAnswers other))+          attempts seen >>= (@?= 3)+          stages <- map logStage <$> readIORef events+          length [() | Retrying _ _ <- stages] @?= 2+          length [() | Failed _ <- stages] @?= 1+    , testCase "does not retry a validation error" $+        withMockApi [json status422 [] "{\"detail\":[{\"loc\":[\"body\",\"state\"],\"msg\":\"Field required\",\"type\":\"missing\"}]}"] $+          \port seen -> do+            (client, _) <- mockClient port id+            result <- sendEither client billing+            case result of+              Left (ServiceError e) -> apiErrorKind e @?= UnprocessableEntity+              other -> assertFailure (show (fmap evaluationAnswers other))+            attempts seen >>= (@?= 1)+    , testCase "a per-call retry policy wins" $+        withMockApi [json status503 [] ""] $ \port seen -> do+          (client, _) <- mockClient port id+          _ <- sendEither client (withRetryPolicy noRetries billing)+          attempts seen >>= (@?= 1)+    , testCase "stops when the retry budget would be exceeded" $+        withMockApi [json status503 [] ""] $ \port seen -> do+          (client, _) <-+            mockClient port $ \c ->+              c {configRetryPolicy = (configRetryPolicy c) {retryInitialBackoff = 1, retryMaxBackoff = 1, retryBudget = Just 0.5}}+          _ <- sendEither client billing+          attempts seen >>= (@?= 1)+    , testCase "times out a slow attempt" $+        withMockApi [threadDelay 2000000 >> okNoul] $ \port _ -> do+          (client, _) <- mockClient port (\c -> c {configRetryPolicy = noRetries})+          result <- sendEither client (withTimeout 0.2 billing)+          case result of+            Left (ConnectionError (ConnectionTimedOut endpoint)) -> endpoint @?= "POST /v1/systemone"+            other -> assertFailure (show (fmap evaluationAnswers other))+    , testCase "reports a refused connection without leaking the key" $ do+        port <- withMockApi [okNoul] (\port _ -> pure port) -- the port is closed afterwards+        (client, events) <- mockClient port id+        result <- sendEither client billing+        case result of+          Left err@(ConnectionError (ConnectionFailed _ _)) -> do+            let shown = show err <> Text.unpack (renderTypeSafeError err)+            assertBool "the key must not appear in the error" (not ("ts_test_secret_value" `isInfixOf` shown))+          other -> assertFailure (show (fmap evaluationAnswers other))+        stages <- map logStage <$> readIORef events+        length [() | Sending <- stages] @?= 3+    , testCase "rejects invalid questions without sending anything" $+        withMockApi [okNoul] $ \port seen -> do+          (client, _) <- mockClient port id+          result <- sendEither client (systemOne "state" (pure ()))+          case result of+            Left (InvalidRequest NoQuestions) -> pure ()+            other -> assertFailure (show (fmap evaluationAnswers other))+          attempts seen >>= (@?= 0)+    , testCase "send throws what sendEither returns" $+        withMockApi [json status401 [] "{\"detail\":{\"error_type\":\"authentication_error\",\"message\":\"Cannot authenticate\"}}"] $+          \port _ -> do+            (client, _) <- mockClient port id+            thrown <- try (send client billing >>= evaluate)+            case thrown of+              Left (ServiceError e) -> apiErrorKind e @?= Unauthorized+              Left other -> assertFailure (show other)+              Right _ -> assertFailure "expected an exception"+    ]+  where+    mapRetries events = [delay | LogEvent _ _ (Retrying delay _) <- events]+    rightIs result expected = case result of+      Right a -> a @?= expected+      Left e -> assertFailure (show e)++configTests :: TestTree+configTests =+  testGroup+    "configuration"+    [ testCase "API keys are trimmed and validated" $ do+        fmap show (mkApiKey " ts_abc\n") @?= Right "<api key>"+        mkApiKey "" `isLeftWith` "empty"+        mkApiKey "ts abc" `isLeftWith` "whitespace"+        mkApiKey "ts_\233" `isLeftWith` "non-ASCII"+    , -- The environment is global to the process and tasty runs tests in+      -- parallel, so every scenario that changes it lives in this one test.+      testCase "configuration comes from the environment" $ do+        withEnv [("TYPESAFE_API_KEY", Just " ts_env \n"), ("TYPESAFE_BASE_URL", Just "https://gateway.example/typesafe"), ("TYPESAFE_DEFAULT_MODEL", Just "jev-1.13.0")] $ do+          config <- clientConfigFromEnv >>= either (fail . show) pure+          configBaseUrl config @?= "https://gateway.example/typesafe"+          configDefaultModel config @?= "jev-1.13.0"+        withEnv [("TYPESAFE_API_KEY", Just "ts_env"), ("TYPESAFE_BASE_URL", Just "  "), ("TYPESAFE_DEFAULT_MODEL", Nothing)] $ do+          config <- clientConfigFromEnv >>= either (fail . show) pure+          configBaseUrl config @?= defaultBaseUrl+          configDefaultModel config @?= jevLatest+        withEnv [("TYPESAFE_API_KEY", Nothing)] $+          fmap (either Just (const Nothing)) clientConfigFromEnv >>= (@?= Just MissingApiKey)+        withEnv [("TYPESAFE_API_KEY", Just "   ")] $+          fmap (either Just (const Nothing)) clientConfigFromEnv >>= (@?= Just MissingApiKey)+    , testCase "invalid base URLs and timeouts are rejected" $ do+        manager <- newManager defaultManagerSettings+        let rejected config = either Just (const Nothing) (newClientWith manager config)+        fmap isInvalidUrl (rejected (defaultClientConfig testKey) {configBaseUrl = "not a url"}) @?= Just True+        fmap isInvalidUrl (rejected (defaultClientConfig testKey) {configBaseUrl = "https://api.typesafe.ai?x=1"}) @?= Just True+        rejected (defaultClientConfig testKey) {configTimeout = Just 0} @?= Just (InvalidTimeout 0)+    , testCase "newClient throws a ConfigError" $ do+        thrown <- try (newClient (defaultClientConfig testKey) {configBaseUrl = "ftp:/nope"})+        case thrown of+          Left (InvalidBaseUrl url _) -> url @?= "ftp:/nope"+          Left other -> assertFailure (show other)+          Right _ -> assertFailure "expected an exception"+    ]+  where+    isInvalidUrl (InvalidBaseUrl _ _) = True+    isInvalidUrl _ = False+    isLeftWith result fragment = case result of+      Left (InvalidApiKey reason) -> assertBool (Text.unpack reason) (fragment `Text.isInfixOf` reason)+      Left other -> assertFailure (show other)+      Right _ -> assertFailure "expected the key to be rejected"++withEnv :: [(String, Maybe String)] -> IO a -> IO a+withEnv vars action = do+  saved <- traverse (\(k, _) -> (,) k <$> lookupEnv k) vars+  mapM_ set vars+  result <- try action+  mapM_ set saved+  either (\e -> fail (show (e :: SomeException))) pure result+  where+    set (k, v) = maybe (unsetEnv k) (setEnv k) v++-- | Requests against the real API, when enabled. The configuration is read+-- before any test runs, because other tests change the environment.+liveTests :: IO [TestTree]+liveTests = do+  enabled <- lookupEnv "TYPESAFE_LIVE_TESTS"+  configured <- clientConfigFromEnv+  pure $ case configured of+    Right config+      | enabled == Just "1" ->+          [ testGroup+              "live API"+              [ testCase "lists models" $ do+                  client <- newClient config+                  models <- send client listModels+                  assertBool "at least one model" (not (null models))+              , testCase "answers a typed question" $ do+                  client <- newClient config+                  result <- send client billing+                  let p = noulProbability (evaluationAnswers result)+                  assertBool "a probability" (p >= 0 && p <= 1)+                  assertBool "a request id" (isJust (evaluationRequestId result))+              , testCase "rejects a bad key" $ do+                  client <- newClient config {configApiKey = testKey, configRetryPolicy = noRetries}+                  result <- sendEither client listModels+                  case result of+                    Left (ServiceError e) -> unless (apiErrorKind e `elem` [Unauthorized, PermissionDenied]) (assertFailure (show e))+                    other -> assertFailure (show other)+              ]+          ]+    _ -> []

@@ -0,0 +1,100 @@+cabal-version:      3.0+name:               typesafe-ai+version:            0.1.0.0+synopsis:           Client for the TypeSafe AI System One API+description:+  A client for TypeSafe's System One API (<https://docs.typesafe.ai>): send+  text or JSON state with typed Noul (yes/no), Choice and Score questions, and+  get back answers that decode to your own Haskell types.+  .+  Built on @http-client@ with TLS, connection reuse, per-attempt timeouts and+  retries with exponential backoff that honour @Retry-After@.+  .+  The types, JSON codecs and calls are in @typesafe-ai-core@, which has no+  HTTP dependency, so they can also be used with servant or any other HTTP+  stack.+  .+  Start with "TypeSafe" and "TypeSafe.Tutorial".+  .+  This is a community SDK, not affiliated with or endorsed by TypeSafe AI.++homepage:           https://github.com/byteally/typesafe-sdk+bug-reports:        https://github.com/byteally/typesafe-sdk/issues+license:            BSD-3-Clause+license-file:       LICENSE+author:             Magesh B+maintainer:         magesh85@gmail.com+copyright:          2026 byteally+category:           AI, Web, API+build-type:         Simple+tested-with:+  GHC ==9.6.7 || ==9.8.4 || ==9.10.3 || ==9.12.2 || ==9.14.1++extra-doc-files:+  CHANGELOG.md+  README.md++source-repository head+  type:     git+  location: https://github.com/byteally/typesafe-sdk.git+  subdir:   typesafe-ai++common warnings+  ghc-options:+    -Wall -Wcompat -Widentities -Wincomplete-record-updates+    -Wincomplete-uni-patterns -Wmissing-deriving-strategies+    -Wpartial-fields -Wredundant-constraints -Wunused-packages++library+  import:           warnings+  hs-source-dirs:   src+  default-language: Haskell2010+  exposed-modules:+    TypeSafe+    TypeSafe.Client+    TypeSafe.Tutorial++  other-modules:    Paths_typesafe_ai+  autogen-modules:  Paths_typesafe_ai++  -- Depending on typesafe-ai alone gives access to the whole API.+  reexported-modules:+    , TypeSafe.Call+    , TypeSafe.Content+    , TypeSafe.Core+    , TypeSafe.Error+    , TypeSafe.Question+    , TypeSafe.Retry+    , TypeSafe.Wire++  build-depends:+    , base              >=4.18   && <4.23+    , bytestring        >=0.11.3 && <0.13+    , http-client       >=0.7.13 && <0.8+    , http-client-tls   >=0.3.6.2 && <0.5+    , http-types        >=0.12.3 && <0.13+    , random            >=1.2    && <1.4+    , text              >=2.0    && <2.2+    , time              >=1.12   && <1.17+    , typesafe-ai-core  >=0.1.0.0 && <0.1.1++test-suite spec+  import:           warnings+  type:             exitcode-stdio-1.0+  hs-source-dirs:   test+  default-language: Haskell2010+  main-is:          Main.hs+  ghc-options:      -threaded -rtsopts -with-rtsopts=-N+  build-depends:+    , aeson+    , base+    , bytestring+    , http-client+    , http-types+    , tasty         >=1.4 && <1.6+    , tasty-hunit   >=0.10 && <0.11+    , text+    , time+    , typesafe-ai+    , wai           >=3.2 && <3.3+    , warp          >=3.3 && <3.5