jev (empty) → 0.1.0.0
raw patch · 16 files changed
+1436/−0 lines, 16 filesdep +aesondep +basedep +bytestring
Dependencies added: aeson, base, bytestring, containers, hspec, http-client, http-client-tls, http-types, jev, text, wai, warp
Files
- CHANGELOG.md +22/−0
- LICENSE +21/−0
- README.md +238/−0
- examples/Choice.hs +27/−0
- examples/Triage.hs +43/−0
- jev.cabal +94/−0
- lib/Jev.hs +6/−0
- lib/Jev/Client.hs +123/−0
- lib/Jev/Internal/Protocol.hs +211/−0
- lib/Jev/Question.hs +56/−0
- lib/Jev/Types.hs +207/−0
- scripts/check-sdist.sh +20/−0
- scripts/format.sh +8/−0
- scripts/verify.sh +15/−0
- test/JevSpec.hs +338/−0
- test/Main.hs +7/−0
+ CHANGELOG.md view
@@ -0,0 +1,22 @@+# Changelog++## 0.1.0.0++- Enforce `timeoutMicros` across the complete HTTP operation, including reading+ the response body. Validation and JSON decoding remain outside the deadline.+- Add structured transport failures. `TransportError Text` becomes+ `TransportError TransportFailure`; total deadline expiry is `DeadlineExceeded`.+- Change `HttpError Int body` to `HttpError ResponseMetadata body`. Read the+ status from `metadata.statusCode`; headers and request IDs are retained.+- Add `ResponseDecodeError ResponseMetadata Text` for HTTP decoding failures.+ `DecodeError Text` is used by the pure fixture decoder.+- Reject contradictory distributions and scores using documented rounding+ tolerances, and require legends to cover returned probability indices.+- Add pure question validation, request inspection, and fixture decoding.+- Add optional OpenRouter routing and observability settings through+ `decideWith`, `decideJSONWith`, and `prepareRequestWith`.+- Add `Functor` instances for value-carrying public data types.+- Document public API contracts and consumer installation; add package bounds,+ license text, and isolated source-distribution verification.+- Move Nix tooling overrides to `cabal.project.nix`; ordinary Cabal builds now+ use a minimal project file.
+ LICENSE view
@@ -0,0 +1,21 @@+MIT License++Copyright (c) 2026 Johan Yngman++Permission is hereby granted, free of charge, to any person obtaining a copy+of this software and associated documentation files (the "Software"), to deal+in the Software without restriction, including without limitation the rights+to use, copy, modify, merge, publish, distribute, sublicense, and/or sell+copies of the Software, and to permit persons to whom the Software is+furnished to do so, subject to the following conditions:++The above copyright notice and this permission notice shall be included in all+copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,+FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE+AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER+LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,+OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE+SOFTWARE.
+ README.md view
@@ -0,0 +1,238 @@+# jev++A small Haskell client for [TypeSafe Jev](https://docs.typesafe.ai/introduction), with direct TypeSafe and OpenRouter support. Define typed questions, send a prompt, and pattern match on your own values. Choice, Score, and Noul can share one request using ordinary `Applicative` composition.++Textual inputs and metadata use strict `Text`. JSON encoding and response decoding stay inside the library. Responses retain probabilities, confidence where available, model information, and usage. `requestId` uses the JSON `id` when supplied by a gateway, otherwise the `x-typesafe-request-id` response header.++## Add Jev to an application++The supported and tested compiler is **GHC 9.10.1** (`base-4.20`). Dependency+bounds currently target that tested environment; other compiler versions have+not been verified. You can use Cabal directly; Nix is optional for consumers.++To consume a local checkout, place it beside your application and use this+`cabal.project` in the application directory:++```cabal+packages: . ../jev+```++For a Git dependency, instead add a `source-repository-package` stanza pointing+at `https://github.com/realbogart/jev.git` and pin `tag` to a full commit hash you+have reviewed. A local checkout includes your uncommitted changes; a Git pin does not.++A minimal application's `.cabal` file can be:++```cabal+cabal-version: 3.4+name: jev-demo+version: 0.1.0.0+build-type: Simple++executable jev-demo+ main-is: Main.hs+ build-depends: base >= 4.20 && < 4.21, text >= 2.1 && < 2.2, jev == 0.1.0.0+ default-language: GHC2021+ default-extensions: OverloadedStrings, OverloadedRecordDot+```++Copy [examples/Choice.hs](examples/Choice.hs) to `Main.hs`, set `JEV_API_KEY`, and+run `cabal run jev-demo`. Add `aeson` to your application's dependencies if you+use the structured JSON helpers. The postpositive `qualified` imports in the+examples are enabled by `GHC2021` (or explicitly by `ImportQualifiedPost`).++## A single Choice++Enable `OverloadedStrings` and `OverloadedRecordDot` in your application. Define an explicit mapping between your constructors and the labels and descriptions Jev sees:++```haskell+import Jev+import Data.Text qualified as Text+import Data.Text.IO qualified as Text++data Team = Billing | Technical++route :: Question (Choice Team)+route =+ choice "Which team should handle this?"+ [ Option Billing "billing" (Just "Payments and invoices"),+ Option Technical "technical" (Just "Bugs and outages")+ ]+```++Given a `Text` API key, reuse a client across requests:++```haskell+withClient (defaultConfig TypeSafe key) $ \client -> do+ result <- decide client "I was charged twice." route+ case result of+ Left err -> Text.putStrLn (Text.pack (show err))+ Right response -> case response.answers.choice of+ Billing -> Text.putStrLn "Send to billing"+ Technical -> Text.putStrLn "Send to technical support"+```++The complete [Choice example](examples/Choice.hs) loads `JEV_API_KEY` and handles both constructors:++```bash+cabal run jev-choice+```++## Choice, Score, and Noul in one call++Use a record constructor with `<$>` and `<*>` to describe the result:++```haskell+data Triage = Triage+ { team :: Choice Team,+ urgency :: Score,+ human :: Noul+ }++triage :: Question Triage+triage =+ Triage+ <$> route+ <*> score "How urgent is this?" ["Routine", "Handle today", "Handle immediately"]+ <*> noul "Does this need a human?"+```++Run `decide client prompt triage` to receive `Either JevError (Response Triage)` in one HTTPS request. `response.answers.team.choice` is a `Team`; `response.answers.urgency.score` is a fractional value on the rubric's zero-based scale; `response.answers.human.probability` is the probability of yes. Choose thresholds in application code. Noul is not a Boolean, and Score is not automatically normalized to 0–1.++The complete [Triage example](examples/Triage.hs) uses OpenRouter, retains routing confidence, reports the score, and escalates when the Noul probability is at least `0.8`:++```bash+cabal run jev-triage+```++Set `OPENROUTER_API_KEY` before running it. Both examples make real, billable requests when executed; building and testing do not.++## Configuration and lifecycle++`defaultConfig TypeSafe key` uses `https://api.typesafe.ai/v1/systemone` and `jev-latest`. `defaultConfig OpenRouter key` uses `https://openrouter.ai/api/alpha/decisions` and `typesafe/jev-1.13`. The [OpenRouter Decisions API](https://openrouter.ai/docs/api/api-reference/alphadecisions/submit-a-decisions-questions-and-answers-request) is an alpha endpoint.++Override `model`, `endpoint` (a complete URL), or `timeoutMicros` with record updates:++```haskell+config :: Text.Text -> Config+config key = (defaultConfig TypeSafe key) {timeoutMicros = 60 * 1000000}+```++The default deadline is 30 seconds for the entire HTTP operation, including+connection setup, request transmission, and reading the complete response body.+Expiration returns `TransportError DeadlineExceeded`. Pure input validation and+response decoding are outside this deadline. A custom manager may impose its+own shorter limits. Keys are explicit: the library does not read the environment,+and `Config` has no `Show` instance.++Records expose fields for record-dot syntax, record updates, and pattern matching.+They do not generate ordinary selector functions: use `response.answers` or+`Response {answers = value}`, rather than `answers response`.++`newClient` creates a reusable TLS connection manager; `withClient` scopes its use. `closeClient` releases the client's manager reference and prevents new requests through that client. In-flight requests can finish. The HTTP library reclaims connections automatically after the manager becomes unreachable. Closing is idempotent.++For an existing connection pool, use `clientWithManager config manager`. The caller retains ownership, and `closeClient` does nothing to a borrowed manager. Its manager settings also control any transport-level retries. Library-owned managers disable retries; application-level retries, caching, and logging are left to callers.++OpenRouter routing and observability settings are optional per request:++```haskell+-- Import Data.Aeson (object, (.=)) for this example.+routerOptions :: RequestOptions+routerOptions = defaultRequestOptions+ { sessionId = Just "support-session-42",+ providerRouting = Just (object ["allow_fallbacks" .= False])+ }+-- decideWith client routerOptions "I was charged twice." route+```++`decideWith` and `decideJSONWith` also accept `trace` objects and a `user`+identifier. Session and user identifiers are limited to 256 characters. Nonempty+options fail locally on TypeSafe; nested routing and trace fields are checked by+OpenRouter. Defaults send no extra fields.++## Structured inputs and composition++`decideJSON`, `choiceJSON`, `scoreJSON`, and `noulJSON` accept Aeson values for structured state, instructions, and criteria. State and instructions support strings, objects, and arrays. Use `JsonOption` for structured Choice descriptions; `Nothing` or `Just Null` encodes an undescribed option as JSON `null`. Use `noulWithCriteria` or `noulJSON` with `NoulCriteria` to describe both yes and no. With direct TypeSafe, the JSON helpers also accept `Null` instructions and Noul outcome descriptions. OpenRouter requires non-null instructions and descriptions for both supplied Noul outcomes; incompatible values fail locally. Score levels and state must be non-null on both providers.++`Question` supports `fmap`, applicative composition, and `traverse`. Internal question IDs are assigned automatically. For example, `traverse noul prompts` describes one request returning `[Noul]`. There is no `Monad` instance: questions in one request cannot depend on earlier answers. Make another `decide` call for dependent decisions.++Question construction is pure; validation happens before any HTTP request. An entirely `pure` question or empty traversal contains no questions and is rejected. Choice accepts 1–255 options with unique wire labels; Score accepts 2–10 levels. No typeclass instances are required for Choice domain values.++Results expose constructors for pattern matching. Choice distributions pair domain values with probabilities in the supplied option order. Score distributions and legends use `IntMap`; supplied sparse distributions are preserved. The decoder checks finite probabilities in [0,1], distribution sums within `0.001` of one, a maximal selected Choice probability within `0.001`, and a Score within `0.001 * numberOfLevels` of its probability-weighted value. Legends must cover every returned probability index. Values are never renormalized or filled in. Confidence is retained as a separate provider measure in [0,1], not recomputed from the distribution. Public constructors allow manually created values that bypass these checks.++`Response`, `Choice`, `Option`, `JsonOption`, and `NoulCriteria` have `Functor`+instances. Mapping a `Choice` transforms both the selection and the values in its+distribution; mapping a `Response` changes only its answers.++## Validation and testing without HTTP++`validateQuestion TypeSafe triage` checks question structure without a client or+API key. Failures identify the question's zero-based ID and primitive, for example+`q1 (score): Score requires 2 to 10 levels`.++`prepareRequest provider model state question` additionally checks the model and+state, and returns an abstract `PreparedRequest a`. `prepareRequestWith` also+accepts per-request options. Use `requestBody` to inspect the exact JSON bytes,+and `decodeResponse` to test stored response fixtures against the original typed+question. Neither operation makes a network request or requires credentials:++```haskell+-- Import Data.Aeson (Value (String)) and qualified Data.ByteString.Lazy as LBS.+decodeRouteFixture :: LBS.ByteString -> Either JevError (Response (Choice Team))+decodeRouteFixture fixture = do+ prepared <- prepareRequest TypeSafe "jev-latest" (String "Test state") route+ decodeResponse prepared fixture+```++The fixture decoder does not check HTTP status or attach header metadata. Request+bodies contain no bearer token, but can still contain sensitive application data.++## Handling failures++Failures distinguish validation, transport, HTTP status, and decoding:++- `ValidationError message`: no request was made.+- `TransportError reason`: a structured `TransportFailure`, such as+ `DeadlineExceeded`, `ConnectionFailed`, or `InvalidResponse`. Categories contain+ no request contents or credentials. A category does not guarantee retry safety;+ a timed-out request may already have been processed.+- `HttpError metadata body`: a non-2xx response. `metadata.statusCode`,+ `metadata.headers`, and `metadata.requestId` retain diagnostic context.+ `lookup "Retry-After" metadata.headers` retrieves server retry guidance when present.+- `ResponseDecodeError metadata message`: a 2xx response could not be decoded;+ the same metadata is retained, including the body ID when readable or header ID.+- `DecodeError message`: decoding a fixture through `decodeResponse` failed.++Asynchronous cancellation propagates normally. Exceptions from custom manager+hooks or user functions mapped over questions are not generally converted to+`JevError`. Server response headers and bodies can contain sensitive information;+choose what to retain when logging. See [CHANGELOG.md](CHANGELOG.md) for changes+to error constructor arguments.++## Development++Use the repository's Nix development shell, then run:++```bash+./scripts/format.sh+./scripts/verify.sh+```++Verification checks package metadata, compiles the library and both examples,+runs fixture and local HTTP server tests, and builds and tests an unpacked source+distribution using a fresh, minimal Cabal project. Tests require no API credentials.+`cabal haddock lib:jev` generates API documentation. The default Nix package builds+the library. Nix development-tool overrides live in `cabal.project.nix`; ordinary+Cabal consumers use the minimal `cabal.project` without those overrides.++`Jev` is the convenient public import. `Jev.Types`, `Jev.Question`, and `Jev.Client` separate data, question construction, and transport. The internal protocol module owns JSON encoding and decoding.++## API compatibility notes++Checked against the official [HTTP reference](https://docs.typesafe.ai/api), [question schemas](https://docs.typesafe.ai/sdk/python/api/types/questions), and [response schemas](https://docs.typesafe.ai/sdk/python/api/types/responses), with targeted live checks on both providers.++The [advanced structure guide](https://docs.typesafe.ai/primitives/advanced) lists null Score levels, but the HTTP reference, Python schema, and both live endpoints reject them. The library follows the confirmed endpoint behavior. Score legends can contain objects and arrays as well as text, so their values remain Aeson `Value`.++For Jev 1.13, the [model documentation](https://docs.typesafe.ai/models) specifies 64k tokens for the complete request and 32k for state plus the longest question. These limits are enforced by the provider, not estimated locally. Pin `config.model` to a version when your thresholds depend on that version's behavior; `jev-latest` can change.++TypeSafe documents HTTP 401 for authentication failures, 422 for validation failures, 429 for rate limits, and 529 for overload. The library preserves their status and response body. Callers should use exponential backoff for 429/529. Automatic retries and the model-listing endpoint are outside this library's decision API. The examples intentionally use `JEV_API_KEY`; TypeSafe's own SDK examples use `TYPESAFE_API_KEY`.
+ examples/Choice.hs view
@@ -0,0 +1,27 @@+module Main (main) where++import Data.Text qualified as Text+import Data.Text.IO qualified as Text+import Jev+import System.Environment (getEnv)++data Team = Billing | Technical deriving (Eq, Show)++route :: Question (Choice Team)+route =+ choice+ "Which team should handle this?"+ [ Option Billing "billing" (Just "Payments and invoices"),+ Option Technical "technical" (Just "Bugs and outages")+ ]++main :: IO ()+main = do+ key <- Text.pack <$> getEnv "JEV_API_KEY"+ withClient (defaultConfig TypeSafe key) $ \client -> do+ result <- decide client "I was charged twice." route+ case result of+ Left err -> Text.putStrLn (Text.pack (show err))+ Right response -> case response.answers.choice of+ Billing -> Text.putStrLn "Send to billing"+ Technical -> Text.putStrLn "Send to technical support"
+ examples/Triage.hs view
@@ -0,0 +1,43 @@+module Main (main) where++import Data.Text qualified as Text+import Data.Text.IO qualified as Text+import Jev+import System.Environment (getEnv)++data Team = Billing | Technical deriving (Eq, Show)++data Triage = Triage+ {team :: Choice Team, urgency :: Score, human :: Noul}+ deriving (Eq, Show)++triage :: Question Triage+triage =+ Triage+ <$> choice+ "Which team should handle this?"+ [ Option Billing "billing" (Just "Payments and invoices"),+ Option Technical "technical" (Just "Bugs and outages")+ ]+ <*> score "How urgent is this?" ["Routine", "Handle today", "Handle immediately"]+ <*> noulWithCriteria+ "Does this need a human?"+ (NoulCriteria "A person must investigate or act" "A standard help article will resolve it")++main :: IO ()+main = do+ key <- Text.pack <$> getEnv "OPENROUTER_API_KEY"+ withClient (defaultConfig OpenRouter key) $ \client -> do+ result <- decide client "Checkout has failed all morning. Please help now." triage+ case result of+ Left err -> Text.putStrLn (Text.pack (show err))+ Right response -> do+ let answer = response.answers+ case answer.team.choice of+ Billing -> Text.putStrLn "Billing ticket"+ Technical -> Text.putStrLn "Technical ticket"+ Text.putStrLn ("Routing confidence: " <> Text.pack (show answer.team.confidence))+ Text.putStrLn ("Urgency (0–2): " <> Text.pack (show answer.urgency.score))+ if answer.human.probability >= 0.8+ then Text.putStrLn "Escalate to a person"+ else Text.putStrLn "Continue automated handling"
+ jev.cabal view
@@ -0,0 +1,94 @@+cabal-version: 3.4+name: jev+version: 0.1.0.0+synopsis: Typed decisions with Jev through TypeSafe and OpenRouter+description: Typed, composable Jev questions with reusable HTTPS clients.+homepage: https://github.com/realbogart/jev+bug-reports: https://github.com/realbogart/jev/issues+license: MIT+license-file: LICENSE+tested-with: GHC == 9.10.1+author: Johan Yngman+maintainer: johan.yngman@gmail.com+-- copyright:+category: Web+build-type: Simple+extra-doc-files: README.md, CHANGELOG.md+extra-source-files: scripts/format.sh, scripts/verify.sh, scripts/check-sdist.sh++source-repository head+ type: git+ location: https://github.com/realbogart/jev.git++common dependencies+ build-depends: base >= 4.20 && < 4.21,+ text >= 2.1 && < 2.2++common warnings+ ghc-options: -Weverything -Wno-missing-signatures -Wno-missing-exported-signatures+ -Wno-implicit-prelude -Wno-missing-export-lists -Wno-missing-import-lists+ -Wno-monomorphism-restriction -Wno-type-defaults -Wno-missing-safe-haskell-mode+ -Wno-unsafe -Wno-missing-local-signatures -Wno-missing-kind-signatures+ -Wno-all-missed-specialisations -Wno-missed-specialisations -Wno-ambiguous-fields+ -Wno-missing-deriving-strategies -Wno-prepositive-qualified-module+ -Wno-unused-top-binds++common extensions+ default-extensions: RoleAnnotations,+ OverloadedStrings,+ DuplicateRecordFields,+ NoFieldSelectors,+ StrictData,+ OverloadedRecordDot,+ AllowAmbiguousTypes,+ DataKinds,+ TypeFamilies,+ RecordWildCards,+ DeriveDataTypeable++library+ import: warnings, extensions, dependencies+ hs-source-dirs: lib+ exposed-modules: Jev, Jev.Types, Jev.Question, Jev.Client+ other-modules: Jev.Internal.Protocol+ build-depends: bytestring >= 0.12 && < 0.13,+ containers >= 0.7 && < 0.8,+ aeson >= 2.2 && < 2.3,+ http-client >= 0.7.18 && < 0.8,+ http-client-tls >= 0.3.6 && < 0.4,+ http-types >= 0.12.4 && < 0.13+ default-language: GHC2021++executable jev-choice+ import: warnings, extensions, dependencies+ main-is: Choice.hs+ hs-source-dirs: examples+ build-depends: jev+ default-language: GHC2021+ ghc-options: -threaded++executable jev-triage+ import: warnings, extensions, dependencies+ main-is: Triage.hs+ hs-source-dirs: examples+ build-depends: jev+ default-language: GHC2021+ ghc-options: -threaded++test-suite jev-test+ import: warnings, extensions, dependencies+ type: exitcode-stdio-1.0+ main-is: Main.hs+ other-modules: JevSpec+ hs-source-dirs: test+ build-depends: bytestring >= 0.12 && < 0.13,+ containers >= 0.7 && < 0.8,+ aeson >= 2.2 && < 2.3,+ jev,+ hspec >= 2.11 && < 2.12,+ http-client >= 0.7.18 && < 0.8,+ http-types >= 0.12.4 && < 0.13,+ wai >= 3.2 && < 3.3,+ warp >= 3.4 && < 3.5+ default-language: GHC2021+ ghc-options: -threaded
+ lib/Jev.hs view
@@ -0,0 +1,6 @@+-- | Convenient import for the complete public Jev API.+module Jev (module Jev.Types, module Jev.Question, module Jev.Client) where++import Jev.Client+import Jev.Question+import Jev.Types
+ lib/Jev/Client.hs view
@@ -0,0 +1,123 @@+-- | Reusable HTTPS clients with explicit credentials, deadlines, and no automatic+-- application retries. A borrowed manager retains its own transport retry policy.+module Jev.Client (Client, newClient, clientWithManager, closeClient, withClient, decide, decideJSON, decideWith, decideJSONWith) where++import Control.Applicative ((<|>))+import Control.Exception (bracket, try)+import Data.Aeson (Value (String), decode, (.:?))+import Data.Aeson.Types (parseMaybe, withObject)+import Data.IORef (newIORef, readIORef, writeIORef)+import Data.Text (Text)+import Data.Text qualified as T+import Data.Text.Encoding qualified as TE+import Jev.Internal.Protocol (Question, decodeResponse, prepareRequestWith, requestBody)+import Jev.Types+import Network.HTTP.Client qualified as HTTP+import Network.HTTP.Client.TLS (tlsManagerSettings)+import Network.HTTP.Types.Status qualified as Status+import System.Timeout (timeout)++-- | A reusable connection pool and immutable configuration. Share across requests.+data Client = Client Config (IO (Maybe HTTP.Manager)) (IO ())++-- | Create a TLS client with transport retries disabled. Prefer 'withClient' for+-- scoped use, or call 'closeClient' when the client is no longer needed.+newClient :: Config -> IO Client+newClient config = do+ manager <- HTTP.newManager (tlsManagerSettings {HTTP.managerRetryableException = const False})+ reference <- newIORef (Just manager)+ pure (Client config (readIORef reference) (writeIORef reference Nothing))++-- | Borrow a manager without taking ownership of its lifecycle or settings.+-- Closing this client is a no-op, including subsequent requests through it.+clientWithManager :: Config -> HTTP.Manager -> Client+clientWithManager config manager = Client config (pure (Just manager)) (pure ())++-- | Release an owned manager reference and reject subsequent requests. Idempotent;+-- in-flight requests may finish. Connections are reclaimed by the HTTP library+-- when the manager becomes unreachable, not synchronously by this function.+closeClient :: Client -> IO ()+closeClient (Client _ _ release) = release++-- | Bracket an owned client's lifecycle, also releasing it on exceptions.+withClient :: Config -> (Client -> IO a) -> IO a+withClient config = bracket (newClient config) closeClient++-- | Evaluate all composed questions in one request against a shared text state.+decide :: Client -> Text -> Question a -> IO (Either JevError (Response a))+decide client = decideWith client defaultRequestOptions++-- | Evaluate against a string, object, or array state. Null is rejected.+decideJSON :: Client -> Value -> Question a -> IO (Either JevError (Response a))+decideJSON client = decideJSONWith client defaultRequestOptions++-- | Like 'decide', with per-request OpenRouter routing and observability settings.+decideWith :: Client -> RequestOptions -> Text -> Question a -> IO (Either JevError (Response a))+decideWith client options state = decideJSONWith client options (String state)++-- | Like 'decideJSON', with per-request settings. The HTTP deadline includes+-- connection setup, request transmission, and complete response body consumption.+-- Pure validation and decoding are outside the deadline. Cancellation propagates.+decideJSONWith :: Client -> RequestOptions -> Value -> Question a -> IO (Either JevError (Response a))+decideJSONWith (Client config getManager _) options state question+ | T.null config.apiKey = pure (Left (ValidationError "An API key is required"))+ | config.timeoutMicros <= 0 = pure (Left (ValidationError "Timeout must be positive"))+ | otherwise = case prepareRequestWith config.provider options config.model state question of+ Left err -> pure (Left err)+ Right prepared -> do+ available <- getManager+ case available of+ Nothing -> pure (Left (ValidationError "Client is closed"))+ Just manager -> send manager prepared+ where+ send manager prepared = do+ result <- timeout config.timeoutMicros $ try $ do+ initial <- HTTP.parseRequest (T.unpack endpoint)+ let request =+ initial+ { HTTP.method = "POST",+ HTTP.requestHeaders = [("Authorization", "Bearer " <> TE.encodeUtf8 config.apiKey), ("Content-Type", "application/json")],+ HTTP.requestBody = HTTP.RequestBodyLBS (requestBody prepared),+ HTTP.responseTimeout = HTTP.responseTimeoutNone,+ HTTP.redirectCount = 0,+ HTTP.checkResponse = \_ _ -> pure ()+ }+ HTTP.httpLbs request manager+ pure $ case result of+ Nothing -> Left (TransportError DeadlineExceeded)+ Just (Left (err :: HTTP.HttpException)) -> Left (TransportError (transportFailure err))+ Just (Right response) ->+ let status = Status.statusCode (HTTP.responseStatus response)+ body = HTTP.responseBody response+ headers = HTTP.responseHeaders response+ headerId = lookup "x-typesafe-request-id" headers >>= either (const Nothing) Just . TE.decodeUtf8'+ bodyId = decode body >>= parseMaybe (withObject "response" (.:? "id")) >>= id+ metadata = ResponseMetadata status headers (bodyId <|> headerId)+ in if status >= 200 && status < 300+ then case decodeResponse prepared body of+ Left (DecodeError message) -> Left (ResponseDecodeError metadata message)+ Left err -> Left err+ Right (Response answers model usage bodyRequestId provider) -> Right (Response answers model usage (bodyRequestId <|> headerId) provider)+ else Left (HttpError metadata body)+ endpoint = case config.endpoint of+ Just url -> url+ Nothing -> case config.provider of+ TypeSafe -> "https://api.typesafe.ai/v1/systemone"+ OpenRouter -> "https://openrouter.ai/api/alpha/decisions"++transportFailure :: HTTP.HttpException -> TransportFailure+transportFailure (HTTP.InvalidUrlException _ _) = InvalidEndpoint+transportFailure (HTTP.HttpExceptionRequest _ content) = case content of+ HTTP.ResponseTimeout -> ResponseTimedOut+ HTTP.ConnectionTimeout -> ConnectionTimedOut+ HTTP.ConnectionFailure _ -> ConnectionFailed+ HTTP.ConnectionClosed -> ConnectionClosed+ HTTP.NoResponseDataReceived -> ConnectionClosed+ HTTP.InvalidStatusLine _ -> InvalidResponse+ HTTP.InvalidHeader _ -> InvalidResponse+ HTTP.ResponseBodyTooShort _ _ -> InvalidResponse+ HTTP.InvalidChunkHeaders -> InvalidResponse+ HTTP.IncompleteHeaders -> InvalidResponse+ HTTP.TlsNotSupported -> TlsNotSupported+ HTTP.InternalException _ -> InternalTransportFailure+ _ -> OtherTransportFailure
+ lib/Jev/Internal/Protocol.hs view
@@ -0,0 +1,211 @@+module Jev.Internal.Protocol where++import Control.Monad (unless)+import Data.Aeson hiding (decode)+import Data.Aeson.Key qualified as Key+import Data.Aeson.KeyMap qualified as KM+import Data.Aeson.Types (JSONPathElement (Key), Pair, Parser, parseEither)+import Data.Bifunctor (first)+import Data.ByteString.Lazy qualified as LBS+import Data.IntMap.Strict qualified as IM+import Data.Map.Strict qualified as Map+import Data.Text (Text)+import Data.Text qualified as T+import Jev.Types++type role Question representational++-- | A pure description of independent questions. Applicative composition sends+-- all questions in one request; there is no Monad instance.+newtype Question a = Question+ {compile :: Provider -> Int -> Either JevError (Int, [(Key.Key, Value)], Object -> Parser a)}++instance Functor Question where+ fmap f (Question build) = Question $ \provider n -> do+ (next, fields, decode) <- build provider n+ pure (next, fields, fmap f . decode)++instance Applicative Question where+ pure a = Question $ \_ n -> Right (n, [], const (pure a))+ Question buildF <*> Question buildA = Question $ \provider n -> do+ (middle, fs, decodeF) <- buildF provider n+ (end, as, decodeA) <- buildA provider middle+ pure (end, fs <> as, \answers -> decodeF answers <*> decodeA answers)++validate :: Bool -> Text -> Either JevError ()+validate condition message = unless condition (Left (ValidationError message))++structured :: Value -> Bool+structured (String _) = True+structured (Object _) = True+structured (Array _) = True+structured _ = False++nullableContent :: Value -> Bool+nullableContent Null = True+nullableContent value = structured value++validDescription :: Provider -> Value -> Bool+validDescription TypeSafe = nullableContent+validDescription OpenRouter = structured++primitive :: Text -> Value -> Maybe Value -> (Provider -> Either JevError ()) -> (Object -> Parser a) -> Question a+primitive tag instructions criteria check decode = Question $ \provider n -> do+ let context = "q" <> T.pack (show n) <> " (" <> tag <> "): "+ contextualize (ValidationError message) = ValidationError (context <> message)+ contextualize err = err+ first contextualize $ do+ validate (validDescription provider instructions) "Instructions must be text, an object, or an array (null is supported by TypeSafe only)"+ check provider+ let key = Key.fromText ("q" <> T.pack (show n))+ body = object (["type" .= tag, "instructions" .= instructions] <> maybe [] (\c -> ["criteria" .= c]) criteria)+ parse answers = do+ value <- answers .: key+ (<?> Key key) $+ withObject+ "answer"+ ( \o -> do+ actual <- o .: "type"+ unless (actual == tag) (fail "Answer type does not match question")+ decode o+ )+ value+ pure (n + 1, [(key, body)], parse)++probabilityParser :: Double -> Parser Double+probabilityParser x+ | isNaN x || isInfinite x || x < 0 || x > 1 = fail "Probability must be finite and between zero and one"+ | otherwise = pure x++-- Allow small discrepancies from serialized floating-point distributions.+probabilityTolerance :: Double+probabilityTolerance = 1e-3++distribution :: [Double] -> Parser ()+distribution values = unless (abs (sum values - 1) <= probabilityTolerance) (fail "Probabilities must sum to approximately one")++choiceQuestion :: Value -> [JsonOption a] -> Question (Choice a)+choiceQuestion instructions options = primitive "choice" instructions (Just criteria) check $ \o -> do+ label <- o .: "choice"+ selected <- lookupOption label+ confidence <- o .: "confidence" >>= probabilityParser+ values <- o .: "probabilities" :: Parser (Map.Map Text Double)+ unless (Map.keysSet values == Map.keysSet mapping) (fail "Choice probabilities do not match options")+ probabilities <-+ traverse+ ( \(JsonOption a key _) -> do+ p <- maybe (fail "Missing option probability") probabilityParser (Map.lookup key values)+ pure (a, p)+ )+ options+ distribution (map snd probabilities)+ selectedProbability <- maybe (fail "Missing selected probability") pure (Map.lookup label values)+ unless (all (\p -> p <= selectedProbability + probabilityTolerance) (Map.elems values)) (fail "Selected choice is not a highest-probability option")+ pure (Choice selected confidence probabilities)+ where+ mapping = Map.fromList [(key, a) | JsonOption a key _ <- options]+ criteria = object [Key.fromText key .= description | JsonOption _ key description <- options]+ check _ = do+ validate (not (null options) && length options <= 255) "Choice requires 1 to 255 options"+ validate (Map.size mapping == length options) "Choice labels must be unique"+ validate (all (\(JsonOption _ _ d) -> maybe True nullableContent d) options) "Choice descriptions must be text, objects, arrays, null, or absent"+ lookupOption label = maybe (fail "Unknown choice label") pure (Map.lookup label mapping)++scoreQuestion :: Value -> [Value] -> Question Score+scoreQuestion instructions levels = primitive "score" instructions (Just (toJSON levels)) check $ \o -> do+ score <- o .: "score"+ unless (not (isNaN score || isInfinite score) && score >= 0 && score <= fromIntegral (length levels - 1)) (fail "Score outside rubric")+ confidence <- o .: "confidence" >>= probabilityParser+ probabilities <- o .: "probabilities" >>= indexed (\v -> parseJSON v >>= probabilityParser)+ unless (not (IM.null probabilities)) (fail "Score probabilities must not be empty")+ legend <- o .: "legend" >>= indexed (\value -> if structured value then pure value else fail "Invalid score legend description")+ distribution (IM.elems probabilities)+ unless (all (`IM.member` legend) (IM.keys probabilities)) (fail "Score legend is missing probability indices")+ let expected = sum [fromIntegral i * p | (i, p) <- IM.toList probabilities]+ unless (abs (score - expected) <= probabilityTolerance * fromIntegral (length levels)) (fail "Score does not match its probability-weighted rubric")+ pure (Score score confidence probabilities legend)+ where+ check _ = do+ validate (length levels >= 2 && length levels <= 10) "Score requires 2 to 10 levels"+ validate (all structured levels) "Score levels must be text, objects, or arrays"+ indexed :: (Value -> Parser b) -> Value -> Parser (IM.IntMap b)+ indexed parse = withObject "indexed rubric" $ \o ->+ IM.fromList+ <$> traverse+ ( \(key, value) -> do+ index <- maybe (fail "Unknown rubric index") pure (lookup (Key.toText key) [(T.pack (show i), i) | i <- [0 .. length levels - 1]])+ parsed <- parse value+ pure (index, parsed)+ )+ (KM.toList o)++noulQuestion :: Value -> Maybe (NoulCriteria Value) -> Question Noul+noulQuestion instructions criteria = primitive "noul" instructions encoded check $ \o -> Noul <$> (o .: "noul" >>= probabilityParser)+ where+ encoded = fmap (\(NoulCriteria yes no) -> object ["true" .= yes, "false" .= no]) criteria+ check provider = validate (maybe True (\(NoulCriteria yes no) -> validDescription provider yes && validDescription provider no) criteria) "Noul criteria must be text, objects, or arrays (null is supported by TypeSafe only)"++type role PreparedRequest representational++-- | Validated request bytes and the decoder tied to the original typed question.+-- Does not contain credentials. The body can contain sensitive application data.+data PreparedRequest a = PreparedRequest LBS.ByteString (LBS.ByteString -> Either JevError (Response a))++-- | Read the exact JSON body for inspection or a custom transport.+requestBody :: PreparedRequest a -> LBS.ByteString+requestBody (PreparedRequest body _) = body++-- | Decode a fixture or custom transport response using the original question mapping.+-- Does not check HTTP status or attach header metadata.+decodeResponse :: PreparedRequest a -> LBS.ByteString -> Either JevError (Response a)+decodeResponse (PreparedRequest _ decode) = decode++-- | Validate question structure without credentials or networking. Empty questions+-- are rejected; primitive errors identify the zero-based question ID.+validateQuestion :: Provider -> Question a -> Either JevError ()+validateQuestion provider (Question build) = do+ (_, fields, _) <- build provider 0+ validate (not (null fields)) "At least one question is required"++-- | Validate and encode a request without credentials or networking.+prepareRequest :: Provider -> Text -> Value -> Question a -> Either JevError (PreparedRequest a)+prepareRequest provider = prepareRequestWith provider defaultRequestOptions++-- | Like 'prepareRequest', with optional OpenRouter settings.+prepareRequestWith :: Provider -> RequestOptions -> Text -> Value -> Question a -> Either JevError (PreparedRequest a)+prepareRequestWith provider options model state (Question build) = do+ validate (not (T.null model)) "A model is required"+ extra <- requestOptions provider options+ validate (structured state) "State must be text, an object, or an array"+ (_, fields, parseAnswers) <- build provider 0+ validate (not (null fields)) "At least one question is required"+ let body = encode (object (["model" .= model, "state" .= state, "questions" .= Object (KM.fromList fields)] <> extra))+ decode bytes = do+ value <- either (Left . DecodeError . T.pack) Right (eitherDecode bytes)+ either+ (Left . DecodeError . T.pack)+ Right+ ( parseEither+ ( withObject "response" $ \o -> do+ answers <- o .: "answers" >>= parseAnswers+ resolved <- o .: "model"+ usage <- o .: "usage" >>= withObject "usage" (\u -> Usage <$> u .:? "input_tokens" <*> u .:? "output_tokens" <*> u .:? "cost")+ Response answers resolved usage <$> o .:? "id" <*> o .:? "provider"+ )+ value+ )+ pure (PreparedRequest body decode)++requestOptions :: Provider -> RequestOptions -> Either JevError [Pair]+requestOptions provider options = do+ validate (provider == OpenRouter || options == defaultRequestOptions) "Request options are supported by OpenRouter only"+ validate (maybe True isObject options.providerRouting) "Provider routing must be an object"+ validate (maybe True isObject options.trace) "Trace metadata must be an object"+ validate (maybe True ((<= 256) . T.length) options.sessionId) "Session ID must be at most 256 characters"+ validate (maybe True ((<= 256) . T.length) options.user) "User ID must be at most 256 characters"+ pure (field "provider" options.providerRouting <> field "session_id" options.sessionId <> field "trace" options.trace <> field "user" options.user)+ where+ isObject (Object _) = True+ isObject _ = False+ field :: (ToJSON a) => Key.Key -> Maybe a -> [Pair]+ field key = maybe [] (\value -> [key .= value])
+ lib/Jev/Question.hs view
@@ -0,0 +1,56 @@+-- | Pure question construction, validation, and fixture support.+module Jev.Question+ ( Question,+ choice,+ score,+ noul,+ noulWithCriteria,+ choiceJSON,+ scoreJSON,+ noulJSON,+ validateQuestion,+ PreparedRequest,+ prepareRequest,+ prepareRequestWith,+ requestBody,+ decodeResponse,+ )+where++import Data.Aeson (Value (String))+import Data.Text (Text)+import Jev.Internal.Protocol (PreparedRequest, Question, decodeResponse, prepareRequest, prepareRequestWith, requestBody, validateQuestion)+import Jev.Internal.Protocol qualified as Protocol+import Jev.Types++-- | Describe a choice with 1–255 options and unique wire labels.+-- Validation runs when prepared or sent; use 'validateQuestion' to check earlier.+choice :: Text -> [Option a] -> Question (Choice a)+choice instructions = choiceJSON (String instructions) . map (\(Option a label description) -> JsonOption a label (String <$> description))++-- | Rate on 2–10 ordered levels, starting at zero; returns a fractional expected score.+score :: Text -> [Text] -> Question Score+score instructions = scoreJSON (String instructions) . map String++-- | Ask a yes/no question; the answer is a probability, not a Boolean.+noul :: Text -> Question Noul+noul instructions = noulJSON (String instructions) Nothing++-- | Ask a yes/no question with explicit descriptions for both outcomes.+noulWithCriteria :: Text -> NoulCriteria Text -> Question Noul+noulWithCriteria instructions (NoulCriteria yes no) = noulJSON (String instructions) (Just (NoulCriteria (String yes) (String no)))++-- | Structured choice instructions and descriptions. Instructions accept strings,+-- objects, or arrays (also null for TypeSafe); descriptions may be null on either gateway.+choiceJSON :: Value -> [JsonOption a] -> Question (Choice a)+choiceJSON = Protocol.choiceQuestion++-- | Structured score instructions and 2–10 levels. Levels accept strings, objects,+-- or arrays, never null. Instructions may be null for TypeSafe only.+scoreJSON :: Value -> [Value] -> Question Score+scoreJSON = Protocol.scoreQuestion++-- | Structured yes/no instructions and optional outcome descriptions. Strings,+-- objects, and arrays are accepted; null is accepted for TypeSafe only.+noulJSON :: Value -> Maybe (NoulCriteria Value) -> Question Noul+noulJSON = Protocol.noulQuestion
+ lib/Jev/Types.hs view
@@ -0,0 +1,207 @@+-- | 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 (..),+ )+where++import Data.Aeson (Value)+import Data.ByteString.Lazy qualified as LBS+import Data.IntMap.Strict (IntMap)+import Data.Text (Text)+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)
+ scripts/check-sdist.sh view
@@ -0,0 +1,20 @@+#!/usr/bin/env bash+set -euo pipefail++# Run from the repository root. Build the actual published sources without the+# repository's project configuration or any Nix development-tool overrides.+review_sdist_dir=$(mktemp -d)+trap 'rm -rf "$review_sdist_dir"' EXIT+cabal sdist --output-directory="$review_sdist_dir"+review_archives=("$review_sdist_dir"/*.tar.gz)+if [[ ${#review_archives[@]} -ne 1 || ! -f ${review_archives[0]} ]]; then+ echo "Expected one source distribution" >&2+ exit 1+fi+tar -xzf "${review_archives[0]}" -C "$review_sdist_dir"+review_sources=("$review_sdist_dir"/jev-*/)+cd "${review_sources[0]}"+printf 'packages: .\n' > cabal.project+cabal check+cabal build all --enable-tests+cabal test all
+ scripts/format.sh view
@@ -0,0 +1,8 @@+#!/usr/bin/env bash+set -euo pipefail++echo "Formatting Haskell files..."+while IFS= read -r -d '' source; do+ ormolu --ghc-opt=-XGHC2021 --ghc-opt=-XOverloadedRecordDot --mode inplace "$source"+done < <(find lib/ test/ examples/ -name '*.hs' -print0)+echo "Formatting complete!"
+ scripts/verify.sh view
@@ -0,0 +1,15 @@+#!/usr/bin/env bash+set -euo pipefail++echo "Checking package metadata..."+cabal check++echo "Building project..."+cabal build all++echo "Running tests..."+cabal test all++echo "Checking source distribution..."+./scripts/check-sdist.sh+echo "Verification passed!"
+ test/JevSpec.hs view
@@ -0,0 +1,338 @@+module JevSpec (spec) where++import Control.Concurrent (threadDelay)+import Control.Exception (AsyncException (ThreadKilled), throwIO, toException, try)+import Data.Aeson+import Data.Aeson.KeyMap qualified as KM+import Data.ByteString.Lazy qualified as LBS+import Data.IORef+import Data.IntMap.Strict qualified as IM+import Data.Text (Text)+import Data.Text qualified as T+import Jev+import Network.HTTP.Client (defaultManagerSettings, newManager)+import Network.HTTP.Client qualified as HTTP+import Network.HTTP.Types+import Network.Wai hiding (Response, requestBody)+import Network.Wai.Handler.Warp (testWithApplication)+import System.Timeout qualified as Timeout+import Test.Hspec++data Team = Billing | Technical deriving (Eq, Show)++route :: Question (Choice Team)+route = choice "Route this" [Option Billing "billing" Nothing, Option Technical "technical" (Just "Bugs")]++choiceAnswer :: Value+choiceAnswer = object ["type" .= ("choice" :: Text), "choice" .= ("billing" :: Text), "confidence" .= (0.9 :: Double), "probabilities" .= object ["billing" .= (0.95 :: Double), "technical" .= (0.05 :: Double)]]++scoreAnswer :: Value+scoreAnswer = object ["type" .= ("score" :: Text), "score" .= (1.4 :: Double), "confidence" .= (0.6 :: Double), "probabilities" .= object ["1" .= (0.6 :: Double), "2" .= (0.4 :: Double)], "legend" .= object ["1" .= ("Today" :: Text), "2" .= ("Now" :: Text)]]++noulAnswer :: Double -> Value+noulAnswer p = object ["type" .= ("noul" :: Text), "noul" .= p]++envelope :: Value -> Value+envelope answers = object ["model" .= ("test-model" :: Text), "answers" .= answers, "usage" .= object ["input_tokens" .= (12 :: Int), "output_tokens" .= (3 :: Int)]]++serve :: Status -> LBS.ByteString -> Application+serve status body _ respond = respond (responseLBS status [(hContentType, "application/json")] body)++withServer :: Application -> (Client -> IO a) -> IO a+withServer application action = testWithApplication (pure application) $ \port ->+ withClient ((defaultConfig TypeSafe "test-key") {endpoint = Just ("http://127.0.0.1:" <> T.pack (show port) <> "/v1/systemone")}) action++answer :: Value -> Question a -> IO (Either JevError (Response a))+answer value question = withServer (serve status200 (encode (envelope value))) $ \client -> decide client "A prompt" question++isDecodeError :: Either JevError a -> Bool+isDecodeError (Left (DecodeError _)) = True+isDecodeError (Left (ResponseDecodeError _ _)) = True+isDecodeError _ = False++isValidationError :: Either JevError a -> Bool+isValidationError (Left (ValidationError _)) = True+isValidationError _ = False++spec :: Spec+spec = do+ describe "pure preparation and validation" $ do+ it "validates without credentials and identifies invalid composed questions" $ do+ validateQuestion TypeSafe route `shouldBe` Right ()+ validateQuestion TypeSafe ((,) <$> route <*> score "Bad rubric" ["Only"])+ `shouldBe` Left (ValidationError "q1 (score): Score requires 2 to 10 levels")+ validateQuestion TypeSafe (pure ()) `shouldSatisfy` isValidationError+ it "exposes the encoded request and decodes fixtures without a server" $ do+ case prepareRequest TypeSafe "test-model" (String "State") route of+ Left err -> expectationFailure (show err)+ Right prepared -> do+ case eitherDecode (requestBody prepared) of+ Right (Object body) -> do+ KM.lookup "state" body `shouldBe` Just (String "State")+ KM.lookup "model" body `shouldBe` Just (String "test-model")+ other -> expectationFailure (show (other :: Either String Value))+ fmap (\r -> r.answers.choice) (decodeResponse prepared (encode (envelope (object ["q0" .= choiceAnswer])))) `shouldBe` Right Billing+ decodeResponse prepared "not json" `shouldSatisfy` isDecodeError+ it "encodes OpenRouter settings and rejects incompatible settings locally" $ do+ let options = defaultRequestOptions {providerRouting = Just (object ["allow_fallbacks" .= False]), sessionId = Just "session", trace = Just (object ["trace_id" .= ("trace" :: Text)]), user = Just "user"}+ case prepareRequestWith OpenRouter options "model" (String "State") route of+ Left err -> expectationFailure (show err)+ Right prepared -> case eitherDecode (requestBody prepared) of+ Right (Object body) -> do+ KM.lookup "provider" body `shouldBe` options.providerRouting+ KM.lookup "session_id" body `shouldBe` Just (String "session")+ KM.lookup "trace" body `shouldBe` options.trace+ KM.lookup "user" body `shouldBe` Just (String "user")+ other -> expectationFailure (show (other :: Either String Value))+ let validateOptions provider settings = (() <$ prepareRequestWith provider settings "model" (String "State") route)+ validateOptions TypeSafe options `shouldSatisfy` isValidationError+ validateOptions OpenRouter (options {sessionId = Just (T.replicate 257 "x")}) `shouldSatisfy` isValidationError+ validateOptions OpenRouter (options {user = Just (T.replicate 257 "x")}) `shouldSatisfy` isValidationError+ validateOptions OpenRouter (options {providerRouting = Just Null}) `shouldSatisfy` isValidationError+ validateOptions OpenRouter (options {trace = Just (Bool True)}) `shouldSatisfy` isValidationError+ it "maps answer values without losing metadata or distribution entries" $ do+ let original = Response (Choice Billing 0.9 [(Billing, 0.95), (Technical, 0.05)]) "model" (Usage Nothing Nothing Nothing) (Just "id") Nothing+ mapped = fmap (fmap show) original+ mapped.answers `shouldBe` Choice "Billing" 0.9 [("Billing", 0.95), ("Technical", 0.05)]+ mapped.requestId `shouldBe` original.requestId+ mapped.usage `shouldBe` original.usage+ describe "typed results" $ do+ it "maps wire labels and probabilities to domain constructors" $ do+ result <- answer (object ["q0" .= choiceAnswer]) route+ fmap (\r -> r.answers) result `shouldBe` Right (Choice Billing 0.9 [(Billing, 0.95), (Technical, 0.05)])+ it "composes all primitives into one request independent of answer order" $ do+ result <- answer (object ["q2" .= noulAnswer 0.8, "q0" .= choiceAnswer, "q1" .= scoreAnswer]) ((,,) <$> route <*> score "Urgency" ["Routine", "Today", "Now"] <*> noul "Human?")+ fmap (\r -> let (c, s, n) = r.answers in (c.choice, s.score, s.probabilities, n.probability)) result+ `shouldBe` Right (Billing, 1.4, IM.fromList [(1, 0.6), (2, 0.4)], 0.8)+ it "supports nested composition and runtime collections" $ do+ result <- answer (object ["q0" .= noulAnswer 0.1, "q1" .= noulAnswer 0.9]) ((,) <$> pure "tag" <*> traverse noul ["One", "Two"])+ fmap (\r -> r.answers) result `shouldBe` Right ("tag" :: Text, [Noul 0.1, Noul 0.9])+ it "retains provider metadata and optional usage fields" $ do+ let body = object ["answers" .= object ["q0" .= noulAnswer 1], "model" .= ("typesafe/jev-1.13" :: Text), "id" .= ("request-1" :: Text), "provider" .= ("TypeSafe" :: Text), "usage" .= object ["cost" .= (0.001 :: Double)], "future" .= True]+ result <- withServer (serve status200 (encode body)) $ \client -> decide client "State" (noul "Yes?")+ fmap (\r -> (r.requestId, r.provider, r.usage)) result `shouldBe` Right (Just "request-1", Just "TypeSafe", Usage Nothing Nothing (Just 0.001))+ describe "documented structured content" $ do+ it "accepts TypeSafe null instructions and nullable Choice and Noul descriptions" $ do+ captured <- newIORef Nothing+ let levels = [object ["meaning" .= ("Routine" :: Text)], toJSON (["Urgent"] :: [Text])]+ scoreValue = object ["type" .= ("score" :: Text), "score" .= (1 :: Int), "confidence" .= (1 :: Int), "probabilities" .= object ["1" .= (1 :: Int)], "legend" .= object ["0" .= headLevel, "1" .= toJSON (["Urgent"] :: [Text])]]+ headLevel = object ["meaning" .= ("Routine" :: Text)]+ app request respond = do+ body <- strictRequestBody request+ writeIORef captured (decode body :: Maybe Value)+ serve status200 (encode (envelope (object ["q0" .= choiceAnswer, "q1" .= scoreValue, "q2" .= noulAnswer 0.9]))) request respond+ questions =+ (,,)+ <$> choiceJSON Null [JsonOption Billing "billing" (Just Null), JsonOption Technical "technical" Nothing]+ <*> scoreJSON Null levels+ <*> noulJSON Null (Just (NoulCriteria (String "Needs help") Null))+ result <- withServer app $ \client -> decideJSON client (toJSON (["Please help", "Duplicate payment"] :: [Text])) questions+ fmap (\r -> let (_, rating, _) = r.answers in rating.legend) result `shouldBe` Right (IM.fromList (zip [0 ..] levels))+ body <- readIORef captured+ case body of+ Just (Object o) -> case KM.lookup "questions" o of+ Just (Object qs) -> do+ KM.lookup "q0" qs `shouldBe` Just (object ["type" .= ("choice" :: Text), "instructions" .= Null, "criteria" .= object ["billing" .= Null, "technical" .= Null]])+ KM.lookup "q2" qs `shouldBe` Just (object ["type" .= ("noul" :: Text), "instructions" .= Null, "criteria" .= object ["true" .= ("Needs help" :: Text), "false" .= Null]])+ other -> expectationFailure (show other)+ other -> expectationFailure (show other)+ it "rejects null Score levels and invalid legend values" $ do+ withServer (serve status500 "must not be called") $ \client ->+ decide client "State" (scoreJSON (String "Urgency") [Null, String "High"]) >>= (`shouldSatisfy` isValidationError)+ let malformed = object ["type" .= ("score" :: Text), "score" .= (0 :: Int), "confidence" .= (1 :: Int), "probabilities" .= object ["0" .= (1 :: Int)], "legend" .= object ["0" .= True]]+ answer (object ["q0" .= malformed]) (score "Urgency" ["Low", "High"]) >>= (`shouldSatisfy` isDecodeError)+ it "rejects TypeSafe-only null fields before sending to OpenRouter" $ do+ calls <- newIORef (0 :: Int)+ let app request respond = modifyIORef' calls (+ 1) >> serve status500 "unexpected" request respond+ testWithApplication (pure app) $ \port ->+ withClient ((defaultConfig OpenRouter "key") {endpoint = Just ("http://127.0.0.1:" <> T.pack (show port))}) $ \client -> do+ decide client "State" (noulJSON Null Nothing) >>= (`shouldSatisfy` isValidationError)+ decide client "State" (noulJSON (String "Help?") (Just (NoulCriteria (String "Yes") Null))) >>= (`shouldSatisfy` isValidationError)+ readIORef calls `shouldReturn` 0+ it "accepts explicit null Choice descriptions through OpenRouter" $ do+ testWithApplication (pure (serve status200 (encode (envelope (object ["q0" .= choiceAnswer]))))) $ \port ->+ withClient ((defaultConfig OpenRouter "key") {endpoint = Just ("http://127.0.0.1:" <> T.pack (show port))}) $ \client -> do+ result <- decide client "State" (choiceJSON (String "Team?") [JsonOption Billing "billing" (Just Null), JsonOption Technical "technical" Nothing])+ fmap (\r -> r.answers.choice) result `shouldBe` Right Billing+ it "reads TypeSafe request IDs from headers and preserves gateway body IDs" $ do+ let bodyWithId = object ["model" .= ("test-model" :: Text), "usage" .= object [], "answers" .= object ["q0" .= noulAnswer 1], "id" .= ("gateway-id" :: Text)]+ app body _ respond = respond (responseLBS status200 [("x-typesafe-request-id", "direct-id")] (encode body))+ direct <- withServer (app (envelope (object ["q0" .= noulAnswer 1]))) $ \client -> decide client "State" (noul "Yes?")+ fmap (\r -> r.requestId) direct `shouldBe` Right (Just "direct-id")+ gateway <- withServer (app bodyWithId) $ \client -> decide client "State" (noul "Yes?")+ fmap (\r -> r.requestId) gateway `shouldBe` Right (Just "gateway-id")+ describe "validation" $ do+ it "rejects invalid questions before contacting the server" $ do+ calls <- newIORef (0 :: Int)+ let app request respond = modifyIORef' calls (+ 1) >> serve status500 "unexpected" request respond+ withServer app $ \client -> do+ decide client "State" (choice "Empty" ([] :: [Option Team])) >>= (`shouldSatisfy` isValidationError)+ decide client "State" (choice "Duplicate" [Option Billing "same" Nothing, Option Technical "same" Nothing]) >>= (`shouldSatisfy` isValidationError)+ decide client "State" (choice "Too many" [Option Billing (T.pack (show i)) Nothing | i <- [1 .. 256 :: Int]]) >>= (`shouldSatisfy` isValidationError)+ decide client "State" (score "Short" ["Only"]) >>= (`shouldSatisfy` isValidationError)+ decide client "State" (score "Long" (replicate 11 "Level")) >>= (`shouldSatisfy` isValidationError)+ decide client "State" (pure True) >>= (`shouldSatisfy` isValidationError)+ decideJSON client Null (noul "Yes?") >>= (`shouldSatisfy` isValidationError)+ decide client "State" (noulJSON (Bool True) Nothing) >>= (`shouldSatisfy` isValidationError)+ readIORef calls `shouldReturn` 0+ describe "response failures" $ do+ it "rejects missing answers and incorrect primitive tags" $ do+ answer (object []) route >>= (`shouldSatisfy` isDecodeError)+ answer (object ["q0" .= noulAnswer 0.5]) route >>= (`shouldSatisfy` isDecodeError)+ it "rejects unknown choices, missing probabilities, and invalid values" $ do+ let replace key value (Object o) = Object (KM.insert key value o)+ replace _ _ v = v+ answer (object ["q0" .= replace "choice" (String "unknown") choiceAnswer]) route >>= (`shouldSatisfy` isDecodeError)+ answer (object ["q0" .= replace "probabilities" (object []) choiceAnswer]) route >>= (`shouldSatisfy` isDecodeError)+ answer (object ["q0" .= noulAnswer 1.1]) (noul "Yes?") >>= (`shouldSatisfy` isDecodeError)+ answer (object ["q0" .= replace "score" (Number 3) scoreAnswer]) (score "Urgency" ["Low", "High"]) >>= (`shouldSatisfy` isDecodeError)+ answer (object ["q0" .= replace "probabilities" (object ["9" .= (1 :: Int)]) scoreAnswer]) (score "Urgency" ["Low", "Medium", "High"]) >>= (`shouldSatisfy` isDecodeError)+ it "reports malformed JSON and HTTP status bodies" $ do+ withServer (serve status200 "not json") (\client -> decide client "State" (noul "Yes?")) >>= (`shouldSatisfy` isDecodeError)+ mapM_+ ( \status -> do+ result <- withServer (serve status "provider error") (\client -> decide client "State" (noul "Yes?"))+ case result of+ Left (HttpError metadata body) -> do+ metadata.statusCode `shouldBe` statusCode status+ body `shouldBe` "provider error"+ other -> expectationFailure (show other)+ )+ [status401, status422, status429, mkStatus 529 "Overloaded"]+ it "rejects contradictory distributions while accepting rounding and sparse rubrics" $ do+ let replace key value (Object o) = Object (KM.insert key value o)+ replace _ _ v = v+ decodeFixture question value = do+ prepared <- prepareRequest TypeSafe "model" (String "State") question+ decodeResponse prepared (encode (envelope (object ["q0" .= value])))+ decodeFixture route (replace "probabilities" (object ["billing" .= (0 :: Int), "technical" .= (0 :: Int)]) choiceAnswer) `shouldSatisfy` isDecodeError+ decodeFixture route (replace "choice" (String "technical") choiceAnswer) `shouldSatisfy` isDecodeError+ fmap (\r -> r.answers.choice) (decodeFixture route (replace "probabilities" (object ["billing" .= (0.9501 :: Double), "technical" .= (0.05 :: Double)]) choiceAnswer)) `shouldBe` Right Billing+ let rubric = score "Urgency" ["Routine", "Today", "Now"]+ decodeFixture rubric (replace "score" (Number 0) scoreAnswer) `shouldSatisfy` isDecodeError+ decodeFixture rubric (replace "legend" (object []) scoreAnswer) `shouldSatisfy` isDecodeError+ fmap (\r -> r.answers.probabilities) (decodeFixture rubric scoreAnswer) `shouldBe` Right (IM.fromList [(1, 0.6), (2, 0.4)])+ it "retains retry headers and request IDs on HTTP and decoding failures" $ do+ let app status body _ respond = respond (responseLBS status [("Retry-After", "7"), ("x-typesafe-request-id", "header-id")] body)+ failed <- withServer (app status429 "limited") $ \client -> decide client "State" (noul "Yes?")+ case failed of+ Left (HttpError metadata body) -> do+ metadata.statusCode `shouldBe` 429+ metadata.requestId `shouldBe` Just "header-id"+ lookup "Retry-After" metadata.headers `shouldBe` Just "7"+ body `shouldBe` "limited"+ other -> expectationFailure (show other)+ malformed <- withServer (app status200 "not json") $ \client -> decide client "State" (noul "Yes?")+ case malformed of+ Left (ResponseDecodeError metadata _) -> metadata.requestId `shouldBe` Just "header-id"+ other -> expectationFailure (show other)+ gateway <- withServer (app status200 "{\"id\":\"body-id\"}") $ \client -> decide client "State" (noul "Yes?")+ case gateway of+ Left (ResponseDecodeError metadata _) -> metadata.requestId `shouldBe` Just "body-id"+ other -> expectationFailure (show other)+ describe "HTTP transport" $ do+ it "sends one authenticated request with structured inputs" $ do+ requests <- newIORef []+ let app request respond = do+ body <- strictRequestBody request+ modifyIORef' requests ((requestMethod request, rawPathInfo request, requestHeaders request, either (Left . T.pack) Right (eitherDecode body) :: Either Text Value) :)+ serve status200 (encode (envelope (object ["q0" .= choiceAnswer, "q1" .= noulAnswer 0.7]))) request respond+ instructions = object ["question" .= ("Route" :: Text)]+ question = (,) <$> choiceJSON instructions [JsonOption Billing "billing" (Just instructions), JsonOption Technical "technical" Nothing] <*> noulJSON (String "Human?") (Just (NoulCriteria instructions (String "No")))+ withServer app $ \client -> do+ result <- decideJSON client (object ["ticket" .= ("Broken" :: Text)]) question+ fmap (\r -> (fst r.answers).choice) result `shouldBe` Right Billing+ captured <- readIORef requests+ case captured of+ [(method, path, headers, Right (Object body))] -> do+ method `shouldBe` "POST"+ path `shouldBe` "/v1/systemone"+ lookup hAuthorization headers `shouldBe` Just "Bearer test-key"+ lookup hContentType headers `shouldBe` Just "application/json"+ KM.lookup "state" body `shouldBe` Just (object ["ticket" .= ("Broken" :: Text)])+ KM.lookup "model" body `shouldBe` Just (String "jev-latest")+ case KM.lookup "questions" body of+ Just (Object qs) -> do+ KM.size qs `shouldBe` 2+ KM.lookup "q0" qs `shouldBe` Just (object ["type" .= ("choice" :: Text), "instructions" .= instructions, "criteria" .= object ["billing" .= instructions, "technical" .= Null]])+ KM.lookup "q1" qs `shouldBe` Just (object ["type" .= ("noul" :: Text), "instructions" .= ("Human?" :: Text), "criteria" .= object ["true" .= instructions, "false" .= ("No" :: Text)]])+ other -> expectationFailure (show other)+ other -> expectationFailure (show other)+ it "supports OpenRouter configuration and a caller-owned manager" $ do+ let app request respond = do+ rawPathInfo request `shouldBe` "/api/alpha/decisions"+ body <- strictRequestBody request+ case either (Left . T.pack) Right (eitherDecode body) of+ Right (Object o) -> KM.lookup "model" o `shouldBe` Just (String "typesafe/jev-1.13")+ other -> expectationFailure (show (other :: Either Text Value))+ serve status200 (encode (envelope (object ["q0" .= noulAnswer 0.2]))) request respond+ testWithApplication (pure app) $ \port -> do+ manager <- newManager defaultManagerSettings+ let config = (defaultConfig OpenRouter "router-key") {endpoint = Just ("http://127.0.0.1:" <> T.pack (show port) <> "/api/alpha/decisions")}+ client = clientWithManager config manager+ closeClient client+ result <- decide client "State" (noul "Yes?")+ fmap (\r -> r.answers) result `shouldBe` Right (Noul 0.2)+ it "returns a timeout without exposing credentials" $ do+ let app request respond = threadDelay 200000 >> serve status200 "{}" request respond+ testWithApplication (pure app) $ \port ->+ withClient ((defaultConfig TypeSafe "secret") {endpoint = Just ("http://127.0.0.1:" <> T.pack (show port)), timeoutMicros = 10000}) $ \client -> do+ result <- decide client "State" (noul "Yes?")+ result `shouldBe` Left (TransportError DeadlineExceeded)++ it "enforces the deadline after response headers have arrived" $ do+ let app _ respond =+ respond+ ( responseStream+ status200+ []+ ( \write flush -> do+ write " "+ flush+ threadDelay 2000000+ write "{}"+ )+ )+ testWithApplication (pure app) $ \port ->+ withClient ((defaultConfig TypeSafe "secret") {endpoint = Just ("http://127.0.0.1:" <> T.pack (show port)), timeoutMicros = 50000}) $ \client -> do+ result <- Timeout.timeout 1000000 (decide client "State" (noul "Yes?"))+ result `shouldBe` Just (Left (TransportError DeadlineExceeded))++ it "categorizes manager failures without retaining request contents" $ do+ let cases = [(HTTP.ConnectionFailure (toException (userError "secret")), ConnectionFailed), (HTTP.InternalException (toException (userError "secret")), InternalTransportFailure), (HTTP.ResponseBodyTooShort 10 2, InvalidResponse)]+ mapM_+ ( \(failure, expected) -> do+ manager <- newManager (defaultManagerSettings {HTTP.managerModifyRequest = \request -> throwIO (HTTP.HttpExceptionRequest request failure)})+ decide (clientWithManager (defaultConfig TypeSafe "secret") manager) "private" (noul "Yes?") `shouldReturn` Left (TransportError expected)+ )+ cases++ it "selects the documented provider URLs without endpoint overrides" $ do+ let app = serve status200 (encode (envelope (object ["q0" .= noulAnswer 0.5])))+ testWithApplication (pure app) $ \port -> do+ forProviders port [(TypeSafe, "api.typesafe.ai", "/v1/systemone"), (OpenRouter, "openrouter.ai", "/api/alpha/decisions")]+ it "closes owned clients idempotently" $ do+ client <- newClient (defaultConfig TypeSafe "test-key")+ closeClient client+ closeClient client+ decide client "State" (noul "Yes?") `shouldReturn` Left (ValidationError "Client is closed")+ it "propagates asynchronous cancellation" $ do+ manager <- newManager (defaultManagerSettings {HTTP.managerModifyRequest = \_ -> throwIO ThreadKilled})+ let client = clientWithManager (defaultConfig TypeSafe "test-key") manager+ result <- try (decide client "State" (noul "Yes?")) :: IO (Either AsyncException (Either JevError (Response Noul)))+ result `shouldBe` Left ThreadKilled+ where+ forProviders port = mapM_ $ \(provider, host, path) -> do+ observed <- newIORef []+ manager <-+ newManager+ ( defaultManagerSettings+ { HTTP.managerModifyRequest = \request -> do+ modifyIORef' observed ((HTTP.host request, HTTP.path request, HTTP.secure request) :)+ pure request {HTTP.host = "127.0.0.1", HTTP.port = port, HTTP.secure = False, HTTP.proxy = Nothing}+ }+ )+ result <- decide (clientWithManager (defaultConfig provider "test-key") manager) "State" (noul "Yes?")+ fmap (\r -> r.answers) result `shouldBe` Right (Noul 0.5)+ requests <- readIORef observed+ take 1 (reverse requests) `shouldBe` [(host, path, True)]
+ test/Main.hs view
@@ -0,0 +1,7 @@+module Main where++import JevSpec qualified+import Test.Hspec++main :: IO ()+main = hspec JevSpec.spec