huggingface (empty) → 0.1.0.0

raw patch · 27 files changed

+2938/−0 lines, 27 filesdep +aesondep +basedep +bytestringsetup-changed

Dependencies added: aeson, base, bytestring, http-client, http-client-tls, http-types, huggingface, mtl, network-uri, optparse-applicative, parsec, tasty, tasty-hunit, tasty-quickcheck, text, wai, warp

Files

• CHANGELOG.md +21/−0
• CONTRIBUTING.md +15/−0
• LICENSE +30/−0
• README.md +327/−0
• Setup.hs +4/−0
• default.nix +8/−0
• examples/Main.hs +75/−0
• huggingface.cabal +96/−0
• scripts/validate.sh +8/−0
• src/HuggingFace.hs +26/−0
• src/HuggingFace/Client.hs +138/−0
• src/HuggingFace/Error.hs +43/−0
• src/HuggingFace/Hub.hs +110/−0
• src/HuggingFace/Inference.hs +94/−0
• src/HuggingFace/Internal/HTTP.hs +151/−0
• src/HuggingFace/Monad.hs +45/−0
• src/HuggingFace/Types.hs +34/−0
• src/HuggingFace/Types/Auth.hs +35/−0
• src/HuggingFace/Types/Chat.hs +226/−0
• src/HuggingFace/Types/Hub.hs +154/−0
• src/HuggingFace/Types/Pagination.hs +90/−0
• src/HuggingFace/Types/Parameters.hs +90/−0
• src/HuggingFace/Types/Repository.hs +180/−0
• src/HuggingFace/Types/Routing.hs +103/−0
• src/HuggingFace/Types/Tasks.hs +57/−0
• src/HuggingFace/Utils.hs +122/−0
• test/Main.hs +656/−0

@@ -0,0 +1,21 @@+# Changelog++## 0.1.0.0++- Initial Hub client: paginated model, dataset, and Space discovery;+  revision metadata, identity, buffered and streaming file downloads.+- Hosted chat completions, feature extraction, text classification,+  text generation, and generic JSON inference requests.+- Parsed identifiers, opaque tokens, explicit errors, bounded redirects,+  and origin-restricted pagination and authentication.+- Offline integration tests and source-distribution CI across GHC 9.6–9.14.+- Opaque domain types for repository metadata, endpoints, and chat identifiers;+  parsers refine input once and JSON decoding preserves the same guarantees.+- Structural repository identities and routed models, with total constructors+  for composing parsed components and reusing response identifiers in requests.+- Nonempty conversations and embedding batches, and smart constructors for+  positive limits/timeouts and bounded sampling settings. Client construction+  consumes parsed configuration and no longer returns an input-error branch.+- Parsec grammars over Text for domain values and endpoint origins, and over+  ByteString for Link headers, with complete input consumption and redacted+  errors. Quoted Link parameters preserve escaped delimiters.

@@ -0,0 +1,15 @@+# Contributing++Bug reports, documentation improvements, and pull requests are welcome. Include+a small reproducer and your GHC/Cabal versions in a report. Remove tokens,+private repository data, and sensitive error bodies before sharing logs.++Run `scripts/validate.sh` before submitting a change. Tests use a local HTTP+server and must not require tokens, public network access, or paid inference.+Add focused regression tests for changed request shapes, error handling, and+credential boundaries. Match the explicit exports and Haddock module headers.++Keep dependency bounds, the CI matrix, and `tested-with` aligned. Include new+fixture files in `extra-source-files`, update the changelog for public API+changes, and verify the unpacked source distribution. Do not claim a compiler+has been tested locally unless it has actually been run.

@@ -0,0 +1,30 @@+Copyright (c) 2026, Emily Pillmore++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.++    * 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.++    * Neither the name of Emily Pillmore nor the names of other+      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+OWNER 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,327 @@+# huggingface++Haskell bindings to the [Hugging Face Hub](https://huggingface.co/docs/hub/api)+and [Inference Providers](https://huggingface.co/docs/inference-providers).++`huggingface` provides a reusable HTTP client, typed request and response+records, explicit errors, pagination, and streaming downloads. It does not+require Python or execute downloaded model code.++## Scope++| Area | Operations |+| --- | --- |+| Hub discovery | Search and filter models, datasets, and Spaces, one page at a time |+| Hub metadata | Repository metadata and file listings at a branch, tag, or commit |+| Identity | Look up the configured token's owner |+| Files | Buffer small files or stream large files through a callback |+| Router inference | Non-streaming chat completions, multimodal message content, tool calls |+| HF Inference | Sentence embeddings, text classification, text generation, generic JSON tasks |++This initial release covers the operations above. It does not implement Hub+uploads or commits, snapshot caching, local inference, binary inference tasks,+or SSE streaming. `infer` targets the `hf-inference` provider; chat completion+uses the router and supports provider suffixes. Each model must be served for+the requested task. The existence of a Hub repository alone does not imply+hosted inference availability.++## Build++```console+cabal build all+cabal test all --test-show-details=direct+cabal haddock all+cabal sdist+```++The package uses Haskell2010 and targets GHC 9.6–9.14. CI builds and tests the+unpacked source distribution on Linux across that range and on macOS with+GHC 9.14. The local initial implementation was validated with GHC 9.14.1;+the CI matrix is not a claim that every compiler was run locally.++To use this checkout from another project, add `huggingface` to its+`build-depends` and include this directory in that project's `cabal.project`:++```cabal+packages: . /path/to/huggingface+```++A `default.nix` expression is supplied for Nix users. Choose a nixpkgs set+whose Haskell packages satisfy the Cabal bounds; the expression is not pinned.++## Modules++Import `HuggingFace` for the domain API, or use focused imports:++| Module | Responsibility |+| --- | --- |+| `HuggingFace.Client` | Client construction, parsed endpoints, and configuration |+| `HuggingFace.Error` | Error constructors and redacted diagnostics |+| `HuggingFace.Monad` | Opaque client computations, runner, and error/IO utilities |+| `HuggingFace.Hub` | Hub operations and downloads |+| `HuggingFace.Inference` | Hosted inference operations |+| `HuggingFace.Types.Auth` | Opaque tokens and their parser |+| `HuggingFace.Types.Repository` | Repository IDs, owners, names, paths, revisions, and commit SHAs |+| `HuggingFace.Types.Hub` | Listing options, metadata tags, and Hub response records |+| `HuggingFace.Types.Routing` | Model targets, provider selection, and resolved model names |+| `HuggingFace.Types.Chat` | Chat identifiers, messages, requests, responses, and defaults |+| `HuggingFace.Types.Tasks` | Text-generation parameters and task results |+| `HuggingFace.Types.Parameters` | Constrained numeric types and smart constructors |+| `HuggingFace.Types.Pagination` | Pages and opaque continuation handles |+| `HuggingFace.Utils` | Shared parsing, JSON, and HTTP utilities |+| `HuggingFace.Internal.HTTP` | Transport implementation for building additional operations |++`HuggingFace.Types` re-exports the domain modules and errors for convenience.+Existing imports from `HuggingFace`, `HuggingFace.Types`, `HuggingFace.Hub`,+and `HuggingFace.Inference` remain supported. Domain implementations, parsers,+and JSON instances live together. Shared helpers live in `HuggingFace.Utils`.+Every library module is exposed by Cabal, including `HuggingFace.Internal.HTTP`.+`Internal` identifies transport implementation details, not package visibility;+import it and `Utils` explicitly when extending the client.++Module visibility does not expose raw constructors. Direct newtype accessors+are declared as record fields. `RepoId`, `InferenceModel`, and `Client` use+records for their independently meaningful components. Exported selectors+support normal Haskell record updates.+`tokenBytes` explicitly reveals the credential for custom transports;+`nextPageURL` may contain private query parameters. `Token` and `NextPage` retain+redacted `Show` instances. `nextPageFromHeaders` parses a continuation, and the+transport checks its origin when it is consumed. `repoIdParser` supports composing larger Parsec+grammars; `parseRepoId` remains the entry point for a complete external value.++For example, building a chat request needs no transport imports:++```haskell+import Data.List.NonEmpty (NonEmpty (..))+import Data.Text (Text)+import HuggingFace.Error (HuggingFaceError)+import HuggingFace.Types.Chat (ChatRequest, defaultChatRequest, userMessage)+import HuggingFace.Types.Routing (parseInferenceModel)++prepareChat :: Text -> Text -> Either HuggingFaceError ChatRequest+prepareChat target prompt = do+    model <- parseInferenceModel target+    pure (defaultChatRequest model (userMessage prompt :| []))+```++## Public Hub reads++```haskell+{-# LANGUAGE OverloadedStrings #-}++import HuggingFace++main :: IO ()+main = do+    result <- runHuggingFaceM $ do+        limit <- liftEither (mkPositiveInt 10)+        client <- liftIO (newClient defaultClientConfig)+        page <- listModels client defaultListOptions+            { listSearch = Just "bert", listLimit = Just limit }+        liftIO $ mapM_ (print . repoIdText . repoId) (pageItems page)+    either print pure result+```++`listModels`, `listDatasets`, and `listSpaces` return a single `Page RepoInfo`.+`pageNext` contains an opaque continuation when another page is available.+Call `nextPage client continuation` to fetch it; the result type can be fixed+with `HuggingFaceM (Page RepoInfo)`. Pagination remains+explicit so callers control how many requests they make. `listLimit` is the+requested page size, and the server may cap it.++`parseRepoId`, `parseRevision`, and `parseRepoPath` turn external `Text` into+opaque domain values without throwing.+For example, `modelInfo client repository (Just revision)` retrieves a+specific revision, while `Nothing` uses the default branch. Revision slashes+are encoded as part of a single URL segment. `RepoInfo` retains unknown+metadata in `repoRaw`, and optional fields remain `Nothing` when omitted.++## Authentication and chat++The library never reads credentials implicitly. Pass a parsed token in+`accessToken`. The example executable reads `HF_TOKEN` when it is present.++```haskell+{-# LANGUAGE OverloadedStrings #-}++import Data.List.NonEmpty (NonEmpty (..))+import qualified Data.Text as T+import HuggingFace+import System.Environment (getEnv)++main :: IO ()+main = do+    result <- runHuggingFaceM $ do+        rawToken <- liftIO (T.pack <$> getEnv "HF_TOKEN")+        rawModel <- liftIO (T.pack <$> getEnv "HF_MODEL")+        token <- liftEither (parseToken rawToken)+        model <- liftEither (parseInferenceModel rawModel)+        limit <- liftEither (mkPositiveInt 64)+        client <- liftIO $ newClient defaultClientConfig { accessToken = Just token }+        let request = (defaultChatRequest model (userMessage "Hello!" :| []))+                { chatMaxTokens = Just limit }+        chatCompletion client request+    either print print result+```++Set `HF_MODEL` to a currently served model, optionally with a provider suffix.+The token needs permission to call Inference Providers. Hosted calls can incur+charges. `chatExtra` accepts provider options such as `tools`, `seed`, and+`response_format`; it cannot override reserved typed fields or enable streaming.+`ChatMessage` also accepts JSON content arrays for multimodal requests and+preserves tool calls in responses.++The compiled example uses `optparse-applicative` and offers these commands:++```console+cabal run huggingface-example -- models bert+cabal run huggingface-example -- model google-bert/bert-base-uncased+cabal run huggingface-example -- chat "$HF_MODEL" "Explain a Haskell functor briefly."+```++Only the last command invokes hosted inference.++Use `cabal run huggingface-example -- --help` for the command overview, or+`cabal run huggingface-example -- chat --help` for command-specific help.+Missing or invalid arguments produce usage errors before reading `HF_TOKEN`+or creating a client. Repository and routed model arguments use the library's+existing domain parsers. Use `--` before a positional argument beginning with+a dash, for example `chat "$HF_MODEL" -- "--explain this flag"`.++## Parse once, use typed values++Text received from configuration or JSON is parsed into domain types with+hidden constructors. Request functions consume those types without reparsing.+Direct accessors such as `accountNameText` are record selectors; computed+renderers such as `repoIdText` and `revisionText` remain ordinary functions.+Record updates can replace field values, so use the parsers and smart+constructors for external input. JSON decoding uses those same parsers.+There are no partial `IsString` or `Read` instances.++Domain and endpoint grammars use Parsec directly over strict `Text`; pagination+headers use Parsec over `ByteString`. Parsers require complete input consumption+and construct the domain values as they parse. Parser diagnostics are replaced+with redacted errors, since raw unexpected tokens may contain credentials.+Numeric smart constructors still consume numbers, and Aeson handles JSON.++| Domain | Types and entry points |+| --- | --- |+| Repository identity | `parseRepoId`, or `qualifiedRepo` with an `AccountName` and `RepoName` |+| Repository content | `parseRepoPath`, `parseRevision`, `mainRevision`, `commitRevision` |+| Commit identity | `parseCommitSha` parses forty hex digits and normalizes case |+| Chat target | `parseInferenceModel`, or `modelFromRepo` / `routeModel` with an existing `RepoId` |+| Routing | `Fastest`, `Cheapest`, `Preferred`, or `Via` a parsed `Provider` |+| Trusted origins | `parseEndpoint` retains a parsed request; default origins need no parsing |+| Metadata | Separate `HubTag`, `PipelineTag`, `LibraryName`, `SpaceSdk`, and `SortKey` types |+| Chat identity | Separate `ChatRole`, `ToolCallId`, `ParticipantName`, `CompletionId`, `ModelName`, and `FinishReason` types |+| Constrained numbers | `mkPositiveInt`, `mkChatTemperature`, `mkTopP`, `mkGenerationTemperature` |++Returned `repoId`, `repoSha`, `fileName`, and `userName` fields are typed too.+For example, pass `repoId info` straight to `modelInfo`, `fileName file` to+`downloadFile`, or `commitRevision sha` as a revision. `routeModel (repoId info)+Fastest` selects a chat target without rendering and reparsing its ID.++`ChatRequest` conversations and `featureExtraction` batches use `NonEmpty`:+construct one with `first :| rest`. For a dynamic list, use+`Data.List.NonEmpty.nonEmpty` at the input boundary and handle its `Nothing`+case there. Counts, page sizes, and response timeouts use `PositiveInt`;+sampling settings have their own bounds and reject NaN and infinity.++Free-form prompts, generated text, display names, and classifier labels remain+`Text`. Extension payloads remain JSON. Open server-defined namespaces retain+future nonblank values rather than enumerating today's tags, roles, or stop+reasons. A provider's resolved `ModelName` is distinct from a router+`InferenceModel`, since provider aliases need not be Hub repository names.+`CompletionId` preserves empty IDs returned by Hugging Face / TGI.+`String` conversions are confined to dependencies that require them; HTTP+headers and file contents remain bytes.++This is an API change from the initial unpublished scaffold: `mkToken`,+`mkRepoId`, `mkRevision`, and `mkRepoPath` are now `parseToken`, `parseRepoId`,+`parseRevision`, and `parseRepoPath`. `newClient` returns `IO Client`, and+`newClientWithManager` returns `Client`; configuration failures are handled+while constructing the typed configuration.++## Downloads++`downloadFile client kind repository revision path` buffers a file in memory.+Use `withDownload` for model weights. It supplies an `http-client` `BodyReader`+to a `HuggingFaceM` callback and releases the connection on success, typed error,+or IO exception:++```haskell+import qualified Data.ByteString as BS+import HuggingFace.Monad (HuggingFaceM, liftIO)+import Network.HTTP.Client (BodyReader, brRead)+import System.IO (Handle)++copyBody :: Handle -> BodyReader -> HuggingFaceM ()+copyBody handle reader = do+    chunk <- liftIO (brRead reader)+    if BS.null chunk+        then pure ()+        else liftIO (BS.hPut handle chunk) >> copyBody handle reader+```++Pass `copyBody handle` as the last argument to `withDownload`. The caller owns+the output handle, path selection, overwrite policy, and cleanup of partially+written files. Do not retain the reader after the callback returns. The+library follows at most five GET redirects and removes authentication when+crossing origins, including ports. HTTPS cannot redirect to HTTP.++## Errors and configuration++Client operations return `HuggingFaceM a`, an opaque newtype over+`ExceptT HuggingFaceError IO` with `Functor`, `Applicative`, `Monad`, `MonadIO`,+and `MonadError HuggingFaceError` instances. Compose operations in a `do` block;+an error stops subsequent actions. Run the whole computation once with+`runHuggingFaceM :: HuggingFaceM a -> IO (Either HuggingFaceError a)` at the+application boundary. The transformer constructor is not exposed.++`HuggingFace.Monad` and the convenience import `HuggingFace` provide `liftEither`+for pure smart-constructor results, `liftIO` for ordinary IO, and `throwError`+and `catchError` for explicit error handling. These are the standard+[`mtl` operations](https://hackage.haskell.org/package/mtl-2.3.1/docs/Control-Monad-Except.html).+`liftHuggingFaceM` adapts existing `IO (Either HuggingFaceError a)` actions.+Pure parsers remain pure, and `newClient` still returns `IO Client`.++For example, recover from a missing repository while preserving other errors:++```haskell+import HuggingFace++findModel :: Client -> RepoId -> HuggingFaceM (Maybe RepoInfo)+findModel client repository =+    (Just <$> modelInfo client repository Nothing) `catchError` \err ->+        case err of+            HttpError {errorStatus = 404} -> pure Nothing+            _ -> throwError err+```++HTTP errors retain status,+request ID, `Retry-After`, and at most 64 KiB of response content. `Show`+omits response bodies and headers; treat those fields as sensitive when+inspecting them yourself. Invalid JSON and schema mismatches return+`DecodeError`. Transport failures are classified without retaining or printing+the request. Asynchronous exceptions and non-HTTP callback exceptions propagate;+neither `catchError` nor `runHuggingFaceM` catches them. A typed error leaving a+download callback closes its response before an outer `catchError` handler runs.++`newClient` creates a reusable TLS connection pool with transport retries+disabled. POSTs are never followed across redirects or automatically retried.+This avoids silently replaying a potentially billable request. Callers can+implement their own explicit retry policy using the returned status and headers.++`newClientWithManager` accepts a caller-owned manager. When constructing that+manager, set `managerRetryableException = const False` to retain the no-replay+guarantee. The caller is also responsible for its TLS, proxy, and request hooks.+Only configure trusted Hub/inference origins, because the configured token+is sent to both. HTTPS is required except for loopback HTTP development servers.+Parse a custom origin with `parseEndpoint` before putting it in the configuration.+The default response timeout is 30 seconds; set `timeoutMicroseconds` to a+`PositiveInt` built with `mkPositiveInt` to change it.++Successful JSON responses and `downloadFile` are buffered without a size cap.+Use bounded page sizes and `withDownload` for large content. Public requests+are subject to Hugging Face rate limits; no automatic background requests occur.+

@@ -0,0 +1,4 @@+import Distribution.Simple (defaultMain)++main :: IO ()+main = defaultMain

@@ -0,0 +1,8 @@+{ nixpkgs ? import <nixpkgs> {}, compiler ? "default" }:+let+  haskellPackages = if compiler == "default"+    then nixpkgs.haskellPackages+    else nixpkgs.haskell.packages.${compiler};+  package = haskellPackages.callCabal2nix "huggingface" ./. {};+in+  if nixpkgs.lib.inNixShell then package.env else package

@@ -0,0 +1,75 @@+{-# LANGUAGE OverloadedStrings #-}++-- |+-- Module      : Main+-- Description : Small command-line examples of the Hugging Face client+-- Copyright   : (c) 2026 Emily Pillmore+-- License     : BSD-3-Clause+-- Maintainer  : emilypi@cohomolo.gy+-- Stability   : experimental+-- Portability : GHC+module Main (main) where++import Data.Bifunctor (first)+import Data.List.NonEmpty (NonEmpty (..))+import Data.Text (Text)+import qualified Data.Text as T+import qualified Data.Text.IO as T+import HuggingFace+import qualified Options.Applicative as Options+import System.Environment (lookupEnv)+import System.Exit (die)++data Command+    = SearchModels Text+    | ShowModel RepoId+    | RunChat InferenceModel Text++commandInfo :: Options.ParserInfo Command+commandInfo = Options.info (Options.helper <*> commandParser)+    ( Options.fullDesc+    <> Options.progDesc "Query the Hugging Face Hub or run a hosted chat completion"+    <> Options.footer "Authentication: set HF_TOKEN for authenticated requests. The chat command may incur provider charges."+    )++commandParser :: Options.Parser Command+commandParser = Options.hsubparser+    ( Options.command "models" (Options.info searchModels (Options.progDesc "Search models (up to ten results)"))+    <> Options.command "model" (Options.info showModel (Options.progDesc "Show repository metadata"))+    <> Options.command "chat" (Options.info runChat (Options.progDesc "Run a hosted chat completion"))+    )+  where+    searchModels = SearchModels <$> Options.strArgument+        (Options.metavar "SEARCH" <> Options.help "Model search text")+    showModel = ShowModel <$> Options.argument (domainReader parseRepoId)+        (Options.metavar "OWNER/NAME" <> Options.help "Hub repository ID (a bare name is also accepted)")+    runChat = RunChat+        <$> Options.argument (domainReader parseInferenceModel)+            (Options.metavar "MODEL" <> Options.help "Model repository with an optional provider or routing suffix")+        <*> Options.strArgument (Options.metavar "PROMPT" <> Options.help "Prompt text; quote multiword prompts")++domainReader :: (Text -> Either HuggingFaceError a) -> Options.ReadM a+domainReader parse = Options.eitherReader (first show . parse . T.pack)++-- | Run a Hub query or an explicitly requested hosted chat completion.+main :: IO ()+main = do+    command <- Options.customExecParser (Options.prefs Options.showHelpOnEmpty) commandInfo+    result <- runHuggingFaceM $ do+        tokenText <- liftIO (lookupEnv "HF_TOKEN")+        token <- liftEither (traverse (parseToken . T.pack) tokenText)+        client <- liftIO $ newClient defaultClientConfig+          { accessToken = token+          }+        case command of+            SearchModels query -> do+                limit <- liftEither (mkPositiveInt 10)+                page <- listModels client defaultListOptions {listSearch = Just query, listLimit = Just limit}+                liftIO $ mapM_ (T.putStrLn . repoIdText . repoId) (pageItems page)+            ShowModel repository -> do+                info <- modelInfo client repository Nothing+                liftIO (print info)+            RunChat target prompt -> do+                completion <- chatCompletion client (defaultChatRequest target (userMessage prompt :| []))+                liftIO $ mapM_ (print . choiceMessage) (completionChoices completion)+    either (die . show) pure result

@@ -0,0 +1,96 @@+cabal-version:      3.0+name:               huggingface+version:            0.1.0.0+synopsis:           Haskell bindings to the Hugging Face Hub and Inference APIs+description:+  A typed HTTP client for discovering models, datasets, and Spaces on the+  Hugging Face Hub, retrieving repository metadata and files, and running+  hosted inference. Includes chat completions, feature extraction, text+  generation, and classification, with explicit errors and pagination.+homepage:           https://github.com/emilypi/huggingface+bug-reports:        https://github.com/emilypi/huggingface/issues+license:            BSD-3-Clause+license-file:       LICENSE+author:             Emily Pillmore+maintainer:         Emily Pillmore <emilypi@cohomolo.gy>+copyright:          (c) 2026 Emily Pillmore+category:           Network, Machine Learning+build-type:         Simple+tested-with:        GHC ==9.6.7 || ==9.8.4 || ==9.10.3 || ==9.12.4 || ==9.14.1+extra-doc-files:+  README.md+  CHANGELOG.md+  CONTRIBUTING.md+extra-source-files:+  scripts/validate.sh+  default.nix++source-repository head+  type:     git+  location: https://github.com/emilypi/huggingface.git++common settings+  default-language: Haskell2010+  ghc-options:      -Wall -Wcompat -Wincomplete-uni-patterns -Wincomplete-record-updates+  build-depends:    base >=4.18 && <4.23++library+  import: settings+  hs-source-dirs: src+  exposed-modules:+    HuggingFace+    HuggingFace.Client+    HuggingFace.Error+    HuggingFace.Hub+    HuggingFace.Inference+    HuggingFace.Monad+    HuggingFace.Types+    HuggingFace.Types.Auth+    HuggingFace.Types.Chat+    HuggingFace.Types.Hub+    HuggingFace.Types.Pagination+    HuggingFace.Types.Parameters+    HuggingFace.Types.Repository+    HuggingFace.Types.Routing+    HuggingFace.Types.Tasks+    HuggingFace.Utils+    HuggingFace.Internal.HTTP+  build-depends:+      aeson           >=2.1   && <2.4+    , bytestring      >=0.11  && <0.13+    , http-client     >=0.7.13 && <0.8+    , http-client-tls >=0.3.6 && <0.5+    , http-types      >=0.12  && <0.13+    , mtl             >=2.3.1 && <2.4+    , network-uri     >=2.6   && <2.7+    , parsec          >=3.1.16 && <3.2+    , text            >=2.0   && <2.3++test-suite huggingface-tests+  import: settings+  type: exitcode-stdio-1.0+  hs-source-dirs: test+  main-is: Main.hs+  ghc-options: -threaded -rtsopts+  build-depends:+      huggingface+    , aeson+    , bytestring+    , http-client+    , http-types+    , tasty            >=1.4 && <1.6+    , tasty-hunit      >=0.10 && <0.11+    , tasty-quickcheck >=0.10 && <0.12+    , text+    , wai              >=3.2 && <3.3+    , warp             >=3.3 && <3.5++executable huggingface-example+  import: settings+  hs-source-dirs: examples+  main-is: Main.hs+  ghc-options: -threaded+  build-depends:+      huggingface+    , optparse-applicative >=0.18 && <0.20+    , text

@@ -0,0 +1,8 @@+#!/usr/bin/env bash+set -euo pipefail+cd "$(dirname "$0")/.."+cabal check+cabal build all --enable-tests --ghc-options=-Werror+cabal test all --test-show-details=direct --ghc-options=-Werror+cabal haddock all+cabal sdist

@@ -0,0 +1,26 @@+-- |+-- Module      : HuggingFace+-- Description : Haskell client for the Hugging Face Hub and hosted inference+-- Copyright   : (c) 2026 Emily Pillmore+-- License     : BSD-3-Clause+-- Maintainer  : emilypi@cohomolo.gy+-- Stability   : experimental+-- Portability : GHC+--+-- Create a reusable 'Client' with 'newClient' and 'defaultClientConfig'.+-- Parse repository names with 'parseRepoId', then call 'modelInfo',+-- 'listModels', or 'chatCompletion'. See the README for complete examples.+-- Compose operations in 'HuggingFaceM' and run them with 'runHuggingFaceM'.+module HuggingFace+    ( module HuggingFace.Client+    , module HuggingFace.Hub+    , module HuggingFace.Inference+    , module HuggingFace.Monad+    , module HuggingFace.Types+    ) where++import HuggingFace.Client+import HuggingFace.Hub+import HuggingFace.Inference+import HuggingFace.Monad+import HuggingFace.Types

@@ -0,0 +1,138 @@+{-# LANGUAGE OverloadedStrings #-}++-- |+-- Module      : HuggingFace.Client+-- Description : Connection pooling, authentication, and endpoint configuration+-- Copyright   : (c) 2026 Emily Pillmore+-- License     : BSD-3-Clause+-- Maintainer  : emilypi@cohomolo.gy+-- Stability   : experimental+-- Portability : GHC+module HuggingFace.Client+    ( Client, ClientConfig (..), defaultClientConfig, newClient, newClientWithManager+    , clientManager, clientHub, clientInference, clientToken, clientTimeout+    , Endpoint, parseEndpoint, endpointText, defaultHubEndpoint, defaultInferenceEndpoint+    ) where++import Control.Monad (when)+import Data.Char (isDigit, ord)+import Data.Text (Text)+import qualified Data.Text as T+import Network.HTTP.Client+    ( Manager, Request, defaultRequest, getUri, host, managerRetryableException+    , newManager, parseRequest, port, secure )+import Network.HTTP.Client.TLS (tlsManagerSettings)+import Network.URI (parseURI)+import qualified Text.Parsec as P+import HuggingFace.Error (HuggingFaceError (..))+import HuggingFace.Utils (TextParser, parseText, matched)+import HuggingFace.Types.Auth (Token)+import HuggingFace.Types.Parameters (PositiveInt, positiveIntValue, defaultTimeout)++-- | Reusable connection pool, parsed endpoints, and credentials. Construct a+-- client with 'newClient' or 'newClientWithManager'.+data Client = Client+    { clientManager :: Manager -- ^ Connection manager used by this client.+    , clientHub :: Request -- ^ Parsed Hub origin, without request credentials or endpoint-specific paths.+    , clientInference :: Request -- ^ Parsed inference origin, without request credentials or task-specific paths.+    , clientToken :: Maybe Token -- ^ Optional credential for this client's configured origins.+    , clientTimeout :: Int -- ^ Response timeout in microseconds.+    }++-- | Parsed HTTP(S) origin. The request representation is retained so client+-- construction never reparses URLs. Plain HTTP is restricted to loopback.+newtype Endpoint = Endpoint Request++instance Show Endpoint where+    show = show . endpointText++instance Eq Endpoint where+    a == b = endpointText a == endpointText b++-- | Parse an HTTPS origin (or loopback HTTP origin), with no credentials,+-- non-root path, query, or fragment. Parse errors never echo the input.+parseEndpoint :: Text -> Either HuggingFaceError Endpoint+parseEndpoint input = do+    (tls, parsedPort) <- parseText malformed origin input+    -- Delegate complete RFC URI / IPv6 syntax to network-uri (itself backed by+    -- Parsec), then adapt to http-client's required String API. The origin+    -- grammar has already consumed the entire input and bounded the port.+    _ <- maybe (Left malformed) Right (parseURI (T.unpack input))+    request <- maybe (Left malformed) Right (parseRequest (T.unpack input) :: Maybe Request)+    pure (Endpoint request {secure = tls, port = parsedPort})+  where+    malformed = InvalidInput "Endpoint requires an HTTPS origin, or loopback HTTP origin, with a port in 1–65535 and no credentials, path, query, or fragment"++origin :: TextParser (Bool, Int)+origin = do+    _ <- P.string "http"+    tls <- P.option False (True <$ P.char 's')+    _ <- P.string "://"+    hostname <- matched $+        P.between (P.char '[') (P.char ']') (P.skipMany1 (P.noneOf "]"))+            P.<|> P.skipMany1 (P.satisfy (\c -> c /= ':' && c /= '/' && c /= '?' && c /= '#' && c /= '@' && c /= '[' && c /= ']'))+    parsedPort <- P.option (if tls then 443 else 80) (P.char ':' *> portNumber)+    P.optional (P.char '/')+    if tls || hostname `elem` ["localhost", "127.0.0.1", "[::1]"]+        then pure (tls, parsedPort)+        else P.parserFail "Plain HTTP requires loopback"++-- | Render the parsed origin. A missing root slash is normalized to @/@.+endpointText :: Endpoint -> Text+endpointText (Endpoint request) = T.pack (show (getUri request))++-- | Public Hub origin.+defaultHubEndpoint :: Endpoint+defaultHubEndpoint = Endpoint defaultRequest {secure = True, host = "huggingface.co", port = 443}++-- | Public Inference Providers router origin.+defaultInferenceEndpoint :: Endpoint+defaultInferenceEndpoint = Endpoint defaultRequest {secure = True, host = "router.huggingface.co", port = 443}++-- | Trusted client configuration built from parsed endpoints and a positive+-- timeout. The same token is sent to both origins: only configure endpoints+-- that you trust with it.+data ClientConfig = ClientConfig+    { hubEndpoint :: Endpoint -- ^ Default: 'defaultHubEndpoint'.+    , inferenceEndpoint :: Endpoint -- ^ Default: 'defaultInferenceEndpoint'.+    , accessToken :: Maybe Token -- ^ Optional for public Hub reads.+    , timeoutMicroseconds :: PositiveInt -- ^ Positive timeout, default thirty seconds.+    } deriving (Show)++-- | Public Hugging Face endpoints with no token and a thirty-second timeout.+defaultClientConfig :: ClientConfig+defaultClientConfig = ClientConfig defaultHubEndpoint defaultInferenceEndpoint Nothing defaultTimeout++-- | Create a reusable TLS connection pool. Configuration is already parsed;+-- constructing the client does not perform any network requests.+newClient :: ClientConfig -> IO Client+newClient config = do+    manager <- newManager tlsManagerSettings {managerRetryableException = const False}+    pure (newClientWithManager manager config)++-- | Use a caller-owned manager. The caller controls its TLS, proxy, and lifetime+-- settings; request-altering manager hooks must not reintroduce credentials.+-- Set @managerRetryableException = const False@ when creating it: http-client's+-- default retry policy can replay a POST if a reused connection loses a response.+-- The no-automatic-retry guarantee requires this setting for custom managers.+newClientWithManager :: Manager -> ClientConfig -> Client+newClientWithManager manager config =+    let Endpoint hub = hubEndpoint config+        Endpoint inference = inferenceEndpoint config+    in Client manager hub inference (accessToken config) (positiveIntValue (timeoutMicroseconds config))++-- Accumulate with a bounded Int; fail before a later digit could overflow.+-- Leading zeroes are allowed, but a zero port is not a usable endpoint.+portNumber :: TextParser Int+portNumber = do+    first <- digit+    number <- rest first+    when (number == 0) (P.parserFail "Zero port")+    pure number+  where+    digit = (\c -> ord c - ord '0') <$> P.satisfy isDigit+    rest n = P.option n $ do+        d <- digit+        let next = 10 * n + d+        when (next > 65535) (P.parserFail "Port out of range")+        rest next

@@ -0,0 +1,43 @@+-- |+-- Module      : HuggingFace.Error+-- Description : Client errors and redacted diagnostics+-- Copyright   : (c) 2026 Emily Pillmore+-- License     : BSD-3-Clause+-- Maintainer  : emilypi@cohomolo.gy+-- Stability   : experimental+-- Portability : GHC+module HuggingFace.Error+    ( HuggingFaceError (..)+    ) where++import Data.ByteString (ByteString)+import Data.Text (Text)++-- | Client failures. HTTP response bodies and headers are retained for callers+-- but omitted from 'Show', since servers can echo credentials or private data.+-- Transport exceptions are classified without retaining their credential-bearing+-- request. Asynchronous and non-HTTP callback exceptions propagate; HTTP+-- exceptions raised while reading a download become 'TransportError'.+data HuggingFaceError+    = InvalidInput Text+    | TransportError Text+    | HttpError+        { errorStatus :: Int+        , errorBody :: ByteString -- ^ At most 64 KiB of response content; treat as sensitive.+        , errorRequestId :: Maybe ByteString+        , errorRetryAfter :: Maybe ByteString+        }+    | DecodeError -- ^ A successful response did not match its expected JSON schema.+    | UnsafeRedirect -- ^ Cross-origin API redirect, invalid location, or HTTPS downgrade.+    | TooManyRedirects -- ^ More than five redirects.+    | InvalidPagination -- ^ A continuation does not point at the configured Hub origin.+    deriving (Eq)++instance Show HuggingFaceError where+    show (InvalidInput message) = "InvalidInput " ++ show message+    show (TransportError message) = "TransportError " ++ show message+    show HttpError {errorStatus = code} = "HttpError " ++ show code+    show DecodeError = "DecodeError"+    show UnsafeRedirect = "UnsafeRedirect"+    show TooManyRedirects = "TooManyRedirects"+    show InvalidPagination = "InvalidPagination"

@@ -0,0 +1,110 @@+{-# LANGUAGE OverloadedStrings #-}++-- |+-- Module      : HuggingFace.Hub+-- Description : Repository discovery, metadata, and streamed file downloads+-- Copyright   : (c) 2026 Emily Pillmore+-- License     : BSD-3-Clause+-- Maintainer  : emilypi@cohomolo.gy+-- Stability   : experimental+-- Portability : GHC+module HuggingFace.Hub+    ( ListOptions (..), defaultListOptions+    , listModels, listDatasets, listSpaces, nextPage+    , repositoryInfo, modelInfo, datasetInfo, spaceInfo, whoAmI+    , downloadFile, withDownload+    ) where++import Data.Aeson (FromJSON)+import qualified Data.ByteString.Char8 as B8+import qualified Data.ByteString.Lazy as BL+import Data.Maybe (catMaybes)+import qualified Data.Text as T+import Data.Text.Encoding (encodeUtf8)+import Network.HTTP.Client (BodyReader, brConsume, requestHeaders, responseBody)+import Network.HTTP.Types (Query, hAccept)+import HuggingFace.Internal.HTTP+import HuggingFace.Client (Client, clientHub)+import HuggingFace.Monad (HuggingFaceM, liftIO)+import HuggingFace.Types.Hub+import HuggingFace.Types.Parameters (positiveIntValue)+import HuggingFace.Types.Pagination (Page, NextPage)+import HuggingFace.Types.Repository++-- | Fetch one page of models.+listModels :: Client -> ListOptions -> HuggingFaceM (Page RepoInfo)+listModels = listRepositories Model++-- | Fetch one page of datasets.+listDatasets :: Client -> ListOptions -> HuggingFaceM (Page RepoInfo)+listDatasets = listRepositories Dataset++-- | Fetch one page of Spaces.+listSpaces :: Client -> ListOptions -> HuggingFaceM (Page RepoInfo)+listSpaces = listRepositories Space++listRepositories :: RepoType -> Client -> ListOptions -> HuggingFaceM (Page RepoInfo)+listRepositories kind client options = getPage client (requestFor client (clientHub client) ["api", repoPlural kind] (listQuery options))++listQuery :: ListOptions -> Query+listQuery options = catMaybes+    [ field "search" (listSearch options)+    , field "author" (accountNameText <$> listAuthor options)+    , field "sort" (sortKeyText <$> listSort options)+    , (\n -> ("limit", Just (B8.pack (show (positiveIntValue n))))) <$> listLimit options+    ] ++ [("filter", Just (encodeUtf8 (hubTagText f))) | f <- listFilter options]+      ++ [("full", Just "true") | listFull options]+  where+    field key = fmap (\value -> (key, Just (encodeUtf8 value)))++-- | Fetch a continuation obtained from a page. Only the configured Hub origin+-- is accepted, even when the continuation came from another client's page.+nextPage :: FromJSON a => Client -> NextPage -> HuggingFaceM (Page a)+nextPage = continuePage++-- | Repository metadata at the default branch or an explicit revision.+-- Requests file sizes through @blobs=true@.+repositoryInfo :: Client -> RepoType -> RepoId -> Maybe Revision -> HuggingFaceM RepoInfo+repositoryInfo client kind repository revision = getJSON client $+    requestFor client (clientHub client)+        (["api", repoPlural kind] ++ T.splitOn "/" (repoIdText repository)+            ++ maybe [] (\r -> ["revision", revisionText r]) revision)+        [("blobs", Just "true")]++-- | Model metadata, optionally pinned to a revision.+modelInfo :: Client -> RepoId -> Maybe Revision -> HuggingFaceM RepoInfo+modelInfo client = repositoryInfo client Model++-- | Dataset metadata, optionally pinned to a revision.+datasetInfo :: Client -> RepoId -> Maybe Revision -> HuggingFaceM RepoInfo+datasetInfo client = repositoryInfo client Dataset++-- | Space metadata, optionally pinned to a revision.+spaceInfo :: Client -> RepoId -> Maybe Revision -> HuggingFaceM RepoInfo+spaceInfo client = repositoryInfo client Space++-- | Identify the token's owner. Requires an access token.+whoAmI :: Client -> HuggingFaceM UserInfo+whoAmI client = getJSON client (requestFor client (clientHub client) ["api", "whoami-v2"] [])++-- | Buffer a file in memory. Use 'withDownload' for large model weights.+downloadFile :: Client -> RepoType -> RepoId -> Revision -> RepoPath -> HuggingFaceM BL.ByteString+downloadFile client kind repository revision file =+    withDownload client kind repository revision file (liftIO . fmap BL.fromChunks . brConsume)++-- | Stream a repository file to a callback. The body reader is valid only while+-- the callback runs. Connections close on success, typed error, or exception.+-- HTTP failures use the monad's error channel; other IO exceptions propagate.+-- No filesystem paths are chosen or written by the library. Credentials are removed on CDN redirects;+-- an HTTPS request can never redirect to HTTP. At most five redirects are followed.+withDownload :: Client -> RepoType -> RepoId -> Revision -> RepoPath -> (BodyReader -> HuggingFaceM a) -> HuggingFaceM a+withDownload client kind repository revision file consume =+    withBody True client request (consume . responseBody)+  where+    prefix = case kind of Model -> []; _ -> [repoPlural kind]+    baseRequest = requestFor client (clientHub client)+        (prefix ++ T.splitOn "/" (repoIdText repository) ++ ["resolve", revisionText revision]+            ++ T.splitOn "/" (repoPathText file)) []+    request = baseRequest+        { requestHeaders = (hAccept, "*/*") : filter ((/= hAccept) . fst) (requestHeaders baseRequest)+        }

@@ -0,0 +1,94 @@+{-# LANGUAGE OverloadedStrings #-}++-- |+-- Module      : HuggingFace.Inference+-- Description : Hosted chat completions and HF Inference tasks+-- Copyright   : (c) 2026 Emily Pillmore+-- License     : BSD-3-Clause+-- Maintainer  : emilypi@cohomolo.gy+-- Stability   : experimental+-- Portability : GHC+module HuggingFace.Inference+    ( ChatMessage (..), userMessage, systemMessage, assistantMessage+    , ChatRequest (..), defaultChatRequest, ChatCompletion (..), ChatChoice (..), Usage (..)+    , chatCompletion+    , GenerationParameters (..), defaultGenerationParameters, GeneratedText (..), textGeneration+    , Classification (..), classifyText, featureExtraction+    , infer+    ) where++import Control.Applicative ((<|>))+import Data.Aeson+import Data.Aeson.Types (Parser, parseEither)+import Data.List.NonEmpty (NonEmpty)+import Data.Text (Text)+import qualified Data.Text as T+import HuggingFace.Internal.HTTP+import HuggingFace.Client (Client, clientInference)+import HuggingFace.Error (HuggingFaceError (..))+import HuggingFace.Monad (HuggingFaceM, throwError)+import HuggingFace.Types.Chat+import HuggingFace.Types.Repository (RepoId, repoIdText)+import HuggingFace.Types.Tasks++-- | Submit a non-streaming chat completion. Calls may incur provider charges.+-- This operation is never automatically retried or replayed on a redirect.+chatCompletion+    :: Client+    -> ChatRequest+    -> HuggingFaceM ChatCompletion+chatCompletion client =+    postJSON client+      (requestFor+        client (clientInference client)+        ["v1", "chat", "completions"]+        []+        )++newtype Generations = Generations { _getGenerations :: [GeneratedText] }++instance FromJSON Generations where+    parseJSON value = Generations <$> (parseJSON value <|> ((: []) <$> parseJSON value))++-- | Generate text using a model served by @hf-inference@. Task availability+-- depends on the model/provider; use 'chatCompletion' for router-hosted LLMs.+textGeneration+    :: Client+    -> RepoId+    -> Text+    -> GenerationParameters+    -> HuggingFaceM [GeneratedText]+textGeneration client model prompt parameters =+    _getGenerations <$>+        infer client model (object ["inputs" .= prompt, "parameters" .= parameters, "stream" .= False])++-- | Classify one input. Accepts the flat and single-batch response shapes used+-- by HF Inference. Multiple batches for a single input are rejected.+classifyText :: Client -> RepoId -> Text -> HuggingFaceM [Classification]+classifyText client model input = do+    result <- infer client model (object ["inputs" .= input])+    either (const (throwError DecodeError)) pure (parseEither parseLabels result)+  where+    parseLabels value = parseJSON value <|> do+        batches <- parseJSON value :: Parser [[Classification]]+        case batches of+            [labels] -> pure labels+            _ -> fail "Expected one classification batch"++-- | Compute sentence embeddings for a nonempty batch. Uses the explicit+-- @/pipeline/feature-extraction@ route. Models returning token-level tensors+-- instead of one vector per input are outside this convenience function's schema.+featureExtraction :: Client -> RepoId -> NonEmpty Text -> HuggingFaceM [[Double]]+featureExtraction client model inputs =+    postJSON client+        (requestFor client (clientInference client)+            (["hf-inference", "models"] ++ T.splitOn "/" (repoIdText model) ++ ["pipeline", "feature-extraction"]) [])+        (object ["inputs" .= inputs])++-- | Send a caller-defined JSON request to a model's default HF Inference task.+-- Use this for task-specific request/response schemas beyond the typed helpers.+-- This does not route to arbitrary providers. Binary and SSE responses are not+-- decoded here. No model code executes locally, and requests are not retried.+infer :: (ToJSON request, FromJSON response) => Client -> RepoId -> request -> HuggingFaceM response+infer client model = postJSON client+    (requestFor client (clientInference client) (["hf-inference", "models"] ++ T.splitOn "/" (repoIdText model)) [])

@@ -0,0 +1,151 @@+{-# LANGUAGE OverloadedStrings #-}++-- |+-- Module      : HuggingFace.Internal.HTTP+-- Description : HTTP transport and credential-safe redirects+-- Copyright   : (c) 2026 Emily Pillmore+-- License     : BSD-3-Clause+-- Maintainer  : emilypi@cohomolo.gy+-- Stability   : experimental+-- Portability : GHC+--+-- Transport implementation shared by the Hub and inference APIs. This module+-- is exposed for callers building additional operations; 'requestFor' prepares+-- requests using the client's configuration. Import it explicitly rather than+-- through the "HuggingFace" convenience facade.+module HuggingFace.Internal.HTTP+    ( requestFor, getJSON, postJSON, getPage, continuePage, withBody+    ) where++import Control.Exception (catch)+import Data.Aeson (FromJSON, ToJSON, encode)+import Data.ByteString (ByteString)+import qualified Data.ByteString.Char8 as B8+import qualified Data.ByteString.Lazy as BL+import Data.Text (Text)+import Network.HTTP.Client hiding (TooManyRedirects)+import Network.HTTP.Types+import Network.URI (URI (..), URIAuth (..), parseURIReference, relativeTo)+import HuggingFace.Error (HuggingFaceError (..))+import HuggingFace.Monad+import HuggingFace.Types.Auth (tokenBytes)+import HuggingFace.Client (Client, clientManager, clientHub, clientToken, clientTimeout)+import HuggingFace.Utils (encodeSegments, readAtMost, sameOrigin, decodeJSON)+import HuggingFace.Types.Pagination (Page (..), NextPage, nextPageFromHeaders, nextPageURL)++-- | Prepare a request for a trusted origin. Encodes path segments, sets the+-- timeout and bearer token, and disables automatic redirects and status throws.+-- The supplied origin must be trusted with the client's credential.+requestFor :: Client -> Request -> [Text] -> Query -> Request+requestFor client base segments query = base+    { path = encodeSegments segments+    , queryString = renderQuery True query+    , redirectCount = 0+    , checkResponse = \_ _ -> pure ()+    , responseTimeout = responseTimeoutMicro (clientTimeout client)+    , cookieJar = Nothing+    , requestHeaders = [(hAccept, "application/json"), (hUserAgent, "huggingface-haskell/0.1.0.0")]+        ++ case clientToken client of+            Nothing -> []+            Just token -> [(hAuthorization, "Bearer " <> tokenBytes token)]+    }++-- | Execute a prepared request and decode JSON. GET redirects stay on-origin;+-- response and decoding failures use the library's redacted error types.+getJSON :: FromJSON a => Client -> Request -> HuggingFaceM a+getJSON client request = do+    (_, _, body) <- getBytes client request+    liftEither (decodeJSON body)++-- | Submit JSON with a prepared request and decode its response. POST redirects+-- are not followed; use a manager with transport retries disabled.+postJSON :: (ToJSON a, FromJSON b) => Client -> Request -> a -> HuggingFaceM b+postJSON client request payload = getJSON client request+    { method = methodPost+    , requestBody = RequestBodyLBS (encode payload)+    , requestHeaders = (hContentType, "application/json") : requestHeaders request+    }++getBytes :: Client -> Request -> HuggingFaceM (Request, ResponseHeaders, BL.ByteString)+getBytes client request = withBody False client request $ \response -> do+    chunks <- liftIO (brConsume (responseBody response))+    pure (getOriginalRequest response, responseHeaders response, BL.fromChunks chunks)++-- | Decode a JSON array and its Link continuation from a prepared request.+getPage :: FromJSON a => Client -> Request -> HuggingFaceM (Page a)+getPage client request = do+    (finalRequest, headers, body) <- getBytes client request+    items <- liftEither (decodeJSON body)+    pure (Page items (nextPageFromHeaders finalRequest headers))++-- | Fetch a continuation only if it resolves to the configured Hub origin.+continuePage :: FromJSON a => Client -> NextPage -> HuggingFaceM (Page a)+continuePage client next = case redirectTarget False (clientHub client) (nextPageURL next) of+    Right target | sameOrigin target (clientHub client) ->+        let request = requestFor client target [] []+        in getPage client request {path = path target, queryString = queryString target}+    _ -> throwError InvalidPagination++-- | Consume a successful response while its body reader is in scope. Setting+-- the first argument to 'True' allows external GET redirects and strips+-- credentials when crossing origins. HTTPS downgrades are always rejected.+-- The response and its socket are closed before following another redirect.+-- Only GET redirects are followed; replaying a billable POST is never implicit.+-- Typed callback errors close the response before propagating to the caller.+withBody :: Bool -> Client -> Request -> (Response BodyReader -> HuggingFaceM a) -> HuggingFaceM a+withBody allowExternal client initial consume = go (5 :: Int) initial+  where+    go remaining request = do+        outcome <- liftHuggingFaceM $ catchHTTP $+            withResponse request (clientManager client) $ \response -> runHuggingFaceM $ do+                let code = statusCode (responseStatus response)+                if code >= 200 && code < 300+                    then Right <$> consume response+                    else if method request == methodGet && code `elem` [301, 302, 303, 307, 308]+                        then if remaining <= 0 then throwError TooManyRedirects else+                            case lookup hLocation (responseHeaders response) of+                                Nothing -> throwError UnsafeRedirect+                                Just location -> Left <$> liftEither (redirectTarget allowExternal request location)+                        else liftIO (responseError response) >>= throwError+        case outcome of+            Right value -> pure value+            Left target -> go (remaining - 1) target++catchHTTP :: IO (Either HuggingFaceError a) -> IO (Either HuggingFaceError a)+catchHTTP action = action `catch` handler+  where+    handler :: HttpException -> IO (Either HuggingFaceError a)+    handler (HttpExceptionRequest _ ResponseTimeout) = pure (Left (TransportError "Response timeout"))+    handler (HttpExceptionRequest _ ConnectionTimeout) = pure (Left (TransportError "Connection timeout"))+    handler _ = pure (Left (TransportError "HTTP transport failure"))++responseError :: Response BodyReader -> IO HuggingFaceError+responseError response = do+    body <- readAtMost 65536 (responseBody response)+    let headers = responseHeaders response+    pure HttpError+        { errorStatus = statusCode (responseStatus response)+        , errorBody = body+        , errorRequestId = lookup "x-request-id" headers+        , errorRetryAfter = lookup "retry-after" headers+        }++redirectTarget :: Bool -> Request -> ByteString -> Either HuggingFaceError Request+redirectTarget allowExternal current location = do+    reference <- maybe (Left UnsafeRedirect) Right (parseURIReference (B8.unpack location))+    let uri = reference `relativeTo` getUri current+    case uriAuthority uri of+        Just auth | null (uriUserInfo auth) && uriScheme uri `elem` ["http:", "https:"] -> pure ()+        _ -> Left UnsafeRedirect+    target <- maybe (Left UnsafeRedirect) Right (parseRequest (show uri) :: Maybe Request)+    if (secure current && not (secure target)) || (not allowExternal && not (sameOrigin current target))+        then Left UnsafeRedirect+        else Right target+            { method = methodGet+            , redirectCount = 0+            , checkResponse = \_ _ -> pure ()+            , responseTimeout = responseTimeout current+            , cookieJar = Nothing+            , requestHeaders = if sameOrigin current target then requestHeaders current+                else filter (\(key, _) -> key /= hAuthorization && key /= hCookie) (requestHeaders current)+            }

@@ -0,0 +1,45 @@+{-# LANGUAGE DerivingVia #-}+{-# LANGUAGE MultiParamTypeClasses #-}++-- |+-- Module      : HuggingFace.Monad+-- Description : Concrete client computations with typed errors+-- Copyright   : (c) 2026 Emily Pillmore+-- License     : BSD-3-Clause+-- Maintainer  : emilypi@cohomolo.gy+-- Stability   : experimental+-- Portability : GHC+--+-- Compose client operations in t'HuggingFaceM' and call 'runHuggingFaceM' at+-- the application's IO boundary. The constructor and transformer representation+-- are opaque; the standard 'MonadIO' and 'MonadError' operations are available.+module HuggingFace.Monad+    ( HuggingFaceM, runHuggingFaceM, liftHuggingFaceM+    , liftEither, liftIO, throwError, catchError+    ) where++import Control.Monad.Except+    ( ExceptT (..), MonadError, catchError, liftEither, runExceptT, throwError )+import Control.Monad.IO.Class (MonadIO, liftIO)+import HuggingFace.Error (HuggingFaceError)++-- | A concrete computation over @ExceptT HuggingFaceError IO@.+-- Typed errors stop subsequent actions unless handled with 'catchError'.+-- Ordinary IO exceptions and asynchronous cancellation remain IO exceptions;+-- 'catchError' does not intercept them. HTTP operations translate transport+-- exceptions into the library's redacted errors at the transport boundary.+newtype HuggingFaceM a = HuggingFaceM (ExceptT HuggingFaceError IO a)+    deriving (Functor, Applicative, Monad, MonadIO, MonadError HuggingFaceError)+        via (ExceptT HuggingFaceError IO)++-- | Run a computation, returning its typed error or result. This does not+-- catch IO exceptions or asynchronous cancellation.+runHuggingFaceM :: HuggingFaceM a -> IO (Either HuggingFaceError a)+runHuggingFaceM (HuggingFaceM action) = runExceptT action++-- | Embed an IO action that already returns a typed result. Useful when+-- adapting callback-based IO APIs or existing clients. Use 'liftEither' for+-- pure parser results and 'liftIO' for IO actions without typed errors.+-- The action runs once; its IO exceptions propagate unchanged.+liftHuggingFaceM :: IO (Either HuggingFaceError a) -> HuggingFaceM a+liftHuggingFaceM = HuggingFaceM . ExceptT

@@ -0,0 +1,34 @@+-- |+-- Module      : HuggingFace.Types+-- Description : Convenience re-exports of focused domain types+-- Copyright   : (c) 2026 Emily Pillmore+-- License     : BSD-3-Clause+-- Maintainer  : emilypi@cohomolo.gy+-- Stability   : experimental+-- Portability : GHC+--+-- Import the @HuggingFace.Types.*@ modules for individual domains. This module+-- re-exports their public types and "HuggingFace.Error" for convenience.+-- Constructors remain opaque; shared helpers are available separately from+-- "HuggingFace.Utils".+module HuggingFace.Types+    ( module HuggingFace.Error+    , module HuggingFace.Types.Auth+    , module HuggingFace.Types.Repository+    , module HuggingFace.Types.Hub+    , module HuggingFace.Types.Routing+    , module HuggingFace.Types.Chat+    , module HuggingFace.Types.Tasks+    , module HuggingFace.Types.Parameters+    , module HuggingFace.Types.Pagination+    ) where++import HuggingFace.Error+import HuggingFace.Types.Auth+import HuggingFace.Types.Repository+import HuggingFace.Types.Hub+import HuggingFace.Types.Routing+import HuggingFace.Types.Chat+import HuggingFace.Types.Tasks+import HuggingFace.Types.Parameters+import HuggingFace.Types.Pagination

@@ -0,0 +1,35 @@+{-# LANGUAGE OverloadedStrings #-}++-- |+-- Module      : HuggingFace.Types.Auth+-- Description : Opaque bearer tokens and explicit credential access+-- Copyright   : (c) 2026 Emily Pillmore+-- License     : BSD-3-Clause+-- Maintainer  : emilypi@cohomolo.gy+-- Stability   : experimental+-- Portability : GHC+module HuggingFace.Types.Auth+    ( Token, parseToken, tokenBytes+    ) where++import Data.ByteString (ByteString)+import Data.Text (Text)+import Data.Text.Encoding (encodeUtf8)+import HuggingFace.Error (HuggingFaceError)+import HuggingFace.Utils (parseValue, takeWhile1P, asciiAlphaNum)++-- | Opaque bearer token with a redacted 'Show' instance.+newtype Token = Token+    { tokenBytes :: ByteString+    -- ^ Recover the bearer credential for a custom transport. This value is secret;+    -- unlike the token's 'Show' instance, rendering these bytes exposes it.+    }++instance Show Token where+    show _ = "<Token>"++-- | Parse a bearer token without retaining malformed input in errors.+-- Its 'Show' instance never reveals the value.+parseToken :: Text -> Either HuggingFaceError Token+parseToken = parseValue "Token requires ASCII letters, digits, underscores, or hyphens" $+    Token . encodeUtf8 <$> takeWhile1P (\c -> asciiAlphaNum c || c == '_' || c == '-')

@@ -0,0 +1,226 @@+{-# LANGUAGE DerivingVia #-}+{-# LANGUAGE OverloadedStrings #-}++-- |+-- Module      : HuggingFace.Types.Chat+-- Description : Chat identities, messages, requests, and completion responses+-- Copyright   : (c) 2026 Emily Pillmore+-- License     : BSD-3-Clause+-- Maintainer  : emilypi@cohomolo.gy+-- Stability   : experimental+-- Portability : GHC+module HuggingFace.Types.Chat+    ( ChatRole, parseChatRole, chatRoleText+    , ToolCallId, parseToolCallId, toolCallIdText+    , ParticipantName, parseParticipantName, participantNameText+    , CompletionId, parseCompletionId, completionIdText+    , FinishReason, parseFinishReason, finishReasonText+    , systemRole, userRole, assistantRole, toolRole, developerRole+    , ChatMessage (..), userMessage, systemMessage, assistantMessage+    , ChatRequest (..), defaultChatRequest+    , ChatCompletion (..), ChatChoice (..), Usage (..)+    ) where++import Data.Aeson+import qualified Data.Aeson.KeyMap as KM+import Data.List.NonEmpty (NonEmpty)+import Data.Maybe (catMaybes)+import Data.Text (Text)+import qualified Text.Parsec as P+import HuggingFace.Error (HuggingFaceError)+import HuggingFace.Utils (parseTextJSON, parseLabel, parseValue, label)+import HuggingFace.Types.Parameters (PositiveInt, ChatTemperature, TopP)+import HuggingFace.Types.Routing (InferenceModel, ModelName)++-- | Open chat role; common roles have named constants.+newtype ChatRole = ChatRole+    { chatRoleText :: Text+    -- ^ Render a ChatRole.+    }+    deriving stock (Show)+    deriving (Eq, Ord, ToJSON) via Text++-- | Parse a ChatRole from external text.+parseChatRole :: Text -> Either HuggingFaceError ChatRole+parseChatRole = fmap ChatRole . parseLabel "ChatRole"++instance FromJSON ChatRole where parseJSON = parseTextJSON "ChatRole" parseChatRole++-- | Opaque provider-assigned tool call identifier.+newtype ToolCallId = ToolCallId+    { toolCallIdText :: Text+    -- ^ Render a ToolCallId.+    }+    deriving stock (Show)+    deriving (Eq, Ord, ToJSON) via Text++-- | Parse a ToolCallId from external text.+parseToolCallId :: Text -> Either HuggingFaceError ToolCallId+parseToolCallId = fmap ToolCallId . parseLabel "ToolCallId"++instance FromJSON ToolCallId where parseJSON = parseTextJSON "ToolCallId" parseToolCallId++-- | Open chat participant name; provider-specific naming rules remain server-side.+newtype ParticipantName = ParticipantName+    { participantNameText :: Text+    -- ^ Render a ParticipantName.+    }+    deriving stock (Show)+    deriving (Eq, Ord, ToJSON) via Text++-- | Parse a ParticipantName from external text.+parseParticipantName :: Text -> Either HuggingFaceError ParticipantName+parseParticipantName = fmap ParticipantName . parseLabel "ParticipantName"++instance FromJSON ParticipantName where parseJSON = parseTextJSON "ParticipantName" parseParticipantName++-- | Opaque provider-assigned completion identifier. An empty identifier is+-- preserved because Hugging Face / TGI can return it on successful responses.+newtype CompletionId = CompletionId+    { completionIdText :: Text+    -- ^ Render a CompletionId.+    }+    deriving stock (Show)+    deriving (Eq, Ord, ToJSON) via Text++-- | Parse a CompletionId from external text.+parseCompletionId :: Text -> Either HuggingFaceError CompletionId+parseCompletionId = parseValue "Expected a completion identifier without controls" $+    CompletionId <$> (label P.<|> ("" <$ P.eof))++instance FromJSON CompletionId where parseJSON = parseTextJSON "CompletionId" parseCompletionId++-- | Open provider stop reason; unknown reasons are preserved.+newtype FinishReason = FinishReason+    { finishReasonText :: Text+    -- ^ Render a FinishReason.+    }+    deriving stock (Show)+    deriving (Eq, Ord, ToJSON) via Text++-- | Parse a FinishReason from external text.+parseFinishReason :: Text -> Either HuggingFaceError FinishReason+parseFinishReason = fmap FinishReason . parseLabel "FinishReason"++instance FromJSON FinishReason where parseJSON = parseTextJSON "FinishReason" parseFinishReason++-- | System instruction role.+systemRole :: ChatRole+systemRole = ChatRole "system"++-- | User message role.+userRole :: ChatRole+userRole = ChatRole "user"++-- | Assistant response role.+assistantRole :: ChatRole+assistantRole = ChatRole "assistant"++-- | Tool response role.+toolRole :: ChatRole+toolRole = ChatRole "tool"++-- | Developer instruction role.+developerRole :: ChatRole+developerRole = ChatRole "developer"++-- | A chat message. JSON content supports text, multimodal arrays, and null+-- content for tool calls. Provider-specific tool payloads are preserved as JSON.+data ChatMessage = ChatMessage+    { messageRole :: ChatRole -- ^ For example @system@, @user@, @assistant@, or @tool@.+    , messageContent :: Maybe Value -- ^ Text or multimodal content; absent for some tool calls.+    , messageToolCalls :: Maybe Value -- ^ Tool call array, when present.+    , messageToolCallId :: Maybe ToolCallId -- ^ Identifier for a tool response.+    , messageName :: Maybe ParticipantName -- ^ Optional participant name.+    } deriving stock (Eq, Show)++instance ToJSON ChatMessage where+    toJSON message = object $ ("role" .= messageRole message)+        : catMaybes+            [ ("content" .=) <$> messageContent message+            , ("tool_calls" .=) <$> messageToolCalls message+            , ("tool_call_id" .=) <$> messageToolCallId message+            , ("name" .=) <$> messageName message+            ]++instance FromJSON ChatMessage where+    parseJSON = withObject "ChatMessage" $ \o -> ChatMessage+        <$> o .: "role" <*> o .:? "content" <*> o .:? "tool_calls"+        <*> o .:? "tool_call_id" <*> o .:? "name"++-- | Construct a plain-text user message.+userMessage :: Text -> ChatMessage+userMessage = textMessage userRole++-- | Construct a plain-text system message.+systemMessage :: Text -> ChatMessage+systemMessage = textMessage systemRole++-- | Construct a plain-text assistant message.+assistantMessage :: Text -> ChatMessage+assistantMessage = textMessage assistantRole++textMessage :: ChatRole -> Text -> ChatMessage+textMessage role content = ChatMessage role (Just (String content)) Nothing Nothing Nothing++-- | Non-streaming chat request for the router's OpenAI-compatible endpoint.+-- Model names can include a provider suffix such as @:fastest@ or @:together@.+data ChatRequest = ChatRequest+    { chatModel :: InferenceModel -- ^ Hub model identifier and optional routing suffix.+    , chatMessages :: NonEmpty ChatMessage -- ^ A nonempty conversation.+    , chatMaxTokens :: Maybe PositiveInt -- ^ Positive output token limit.+    , chatTemperature :: Maybe ChatTemperature -- ^ Finite sampling temperature in @[0,2]@.+    , chatTopP :: Maybe TopP -- ^ Finite probability in @(0,1]@.+    , chatExtra :: Object -- ^ Additional fields, e.g. @tools@ or @response_format@.+    } deriving stock (Eq, Show)++-- | Construct a request with server-default sampling settings.+defaultChatRequest :: InferenceModel -> NonEmpty ChatMessage -> ChatRequest+defaultChatRequest model messages = ChatRequest model messages Nothing Nothing Nothing KM.empty++instance ToJSON ChatRequest where+    toJSON request = Object $ KM.union fields extras+      where+        fields = KM.fromList $ ["model" .= chatModel request, "messages" .= chatMessages request, "stream" .= False]+            ++ catMaybes+                [ ("max_tokens" .=) <$> chatMaxTokens request+                , ("temperature" .=) <$> chatTemperature request+                , ("top_p" .=) <$> chatTopP request+                ]+        -- Reserved fields cannot replace parsed fields or enable streaming.+        extras = foldr KM.delete (chatExtra request) ["model", "messages", "stream", "max_tokens", "temperature", "top_p"]++-- | Token accounting when reported by the provider.+data Usage = Usage+    { promptTokens :: Integer -- ^ Tokens in the prompt.+    , completionTokens :: Integer -- ^ Tokens generated.+    , totalTokens :: Integer -- ^ Total billed/reported tokens.+    } deriving stock (Eq, Show)++instance FromJSON Usage where+    parseJSON = withObject "Usage" $ \o -> Usage+        <$> o .: "prompt_tokens" <*> o .: "completion_tokens" <*> o .: "total_tokens"++-- | One completion candidate.+data ChatChoice = ChatChoice+    { choiceIndex :: Int -- ^ Candidate index.+    , choiceMessage :: ChatMessage -- ^ Assistant message, including tool calls.+    , choiceFinishReason :: Maybe FinishReason -- ^ Provider stop reason.+    } deriving stock (Eq, Show)++instance FromJSON ChatChoice where+    parseJSON = withObject "ChatChoice" $ \o -> ChatChoice+        <$> o .: "index" <*> o .: "message" <*> o .:? "finish_reason"++-- | Completed non-streaming response. Additional fields remain in 'completionRaw'.+data ChatCompletion = ChatCompletion+    { completionId :: CompletionId -- ^ Request identifier assigned by the provider.+    , completionModel :: ModelName -- ^ Resolved model.+    , completionChoices :: [ChatChoice] -- ^ Completion candidates.+    , completionUsage :: Maybe Usage -- ^ Optional token accounting.+    , completionRaw :: Object -- ^ Full response, including provider extensions.+    } deriving stock (Eq, Show)++instance FromJSON ChatCompletion where+    parseJSON = withObject "ChatCompletion" $ \o -> ChatCompletion+        <$> o .: "id" <*> o .: "model" <*> o .: "choices" <*> o .:? "usage" <*> pure o

@@ -0,0 +1,154 @@+{-# LANGUAGE DerivingVia #-}+{-# LANGUAGE OverloadedStrings #-}++-- |+-- Module      : HuggingFace.Types.Hub+-- Description : Hub discovery options and repository metadata+-- Copyright   : (c) 2026 Emily Pillmore+-- License     : BSD-3-Clause+-- Maintainer  : emilypi@cohomolo.gy+-- Stability   : experimental+-- Portability : GHC+module HuggingFace.Types.Hub+    ( HubTag, parseHubTag, hubTagText+    , PipelineTag, parsePipelineTag, pipelineTagText+    , LibraryName, parseLibraryName, libraryNameText+    , SpaceSdk, parseSpaceSdk, spaceSdkText+    , SortKey, parseSortKey, sortKeyText+    , RepoInfo (..), RepoFile (..), UserInfo (..)+    , ListOptions (..), defaultListOptions+    ) where++import Data.Aeson+import Data.Text (Text)+import HuggingFace.Error (HuggingFaceError)+import HuggingFace.Utils (parseTextJSON, parseLabel)+import HuggingFace.Types.Parameters (PositiveInt)+import HuggingFace.Types.Repository (AccountName, RepoId, CommitSha, RepoPath)++-- | Open Hub metadata tag, including namespaced tags.+newtype HubTag = HubTag+    { hubTagText :: Text+    -- ^ Render a HubTag.+    }+    deriving stock (Show)+    deriving (Eq, Ord, ToJSON) via Text++-- | Parse a HubTag from external text.+parseHubTag :: Text -> Either HuggingFaceError HubTag+parseHubTag = fmap HubTag . parseLabel "HubTag"++instance FromJSON HubTag where parseJSON = parseTextJSON "HubTag" parseHubTag++-- | Open model task identifier.+newtype PipelineTag = PipelineTag+    { pipelineTagText :: Text+    -- ^ Render a PipelineTag.+    }+    deriving stock (Show)+    deriving (Eq, Ord, ToJSON) via Text++-- | Parse a PipelineTag from external text.+parsePipelineTag :: Text -> Either HuggingFaceError PipelineTag+parsePipelineTag = fmap PipelineTag . parseLabel "PipelineTag"++instance FromJSON PipelineTag where parseJSON = parseTextJSON "PipelineTag" parsePipelineTag++-- | Open model library identifier.+newtype LibraryName = LibraryName+    { libraryNameText :: Text+    -- ^ Render a LibraryName.+    }+    deriving stock (Show)+    deriving (Eq, Ord, ToJSON) via Text++-- | Parse a LibraryName from external text.+parseLibraryName :: Text -> Either HuggingFaceError LibraryName+parseLibraryName = fmap LibraryName . parseLabel "LibraryName"++instance FromJSON LibraryName where parseJSON = parseTextJSON "LibraryName" parseLibraryName++-- | Open Space SDK identifier.+newtype SpaceSdk = SpaceSdk+    { spaceSdkText :: Text+    -- ^ Render a SpaceSdk.+    }+    deriving stock (Show)+    deriving (Eq, Ord, ToJSON) via Text++-- | Parse a SpaceSdk from external text.+parseSpaceSdk :: Text -> Either HuggingFaceError SpaceSdk+parseSpaceSdk = fmap SpaceSdk . parseLabel "SpaceSdk"++instance FromJSON SpaceSdk where parseJSON = parseTextJSON "SpaceSdk" parseSpaceSdk++-- | Open Hub sort field.+newtype SortKey = SortKey+    { sortKeyText :: Text+    -- ^ Render a SortKey.+    }+    deriving stock (Show)+    deriving (Eq, Ord, ToJSON) via Text++-- | Parse a SortKey from external text.+parseSortKey :: Text -> Either HuggingFaceError SortKey+parseSortKey = fmap SortKey . parseLabel "SortKey"++instance FromJSON SortKey where parseJSON = parseTextJSON "SortKey" parseSortKey++-- | Shared Hub metadata. Optional fields may be absent from list responses.+-- Unknown fields remain available in 'repoRaw' for forward compatibility.+data RepoInfo = RepoInfo+    { repoId :: RepoId -- ^ Fully qualified repository name.+    , repoSha :: Maybe CommitSha -- ^ Revision commit SHA when supplied.+    , repoPrivate :: Maybe Bool -- ^ Visibility, when included by the server.+    , repoDownloads :: Maybe Integer -- ^ Download count, when available.+    , repoLikes :: Maybe Integer -- ^ Like count, when available.+    , repoTags :: [HubTag] -- ^ Hub metadata tags.+    , repoPipelineTag :: Maybe PipelineTag -- ^ Model task, when available.+    , repoLibraryName :: Maybe LibraryName -- ^ Associated model library.+    , repoSdk :: Maybe SpaceSdk -- ^ Space SDK, when available.+    , repoSiblings :: [RepoFile] -- ^ Files included in the metadata response.+    , repoRaw :: Object -- ^ Complete JSON object, including provider extensions.+    } deriving stock (Eq, Show)++instance FromJSON RepoInfo where+    parseJSON = withObject "RepoInfo" $ \o -> RepoInfo+        <$> o .: "id" <*> o .:? "sha" <*> o .:? "private"+        <*> o .:? "downloads" <*> o .:? "likes" <*> o .:? "tags" .!= []+        <*> o .:? "pipeline_tag" <*> o .:? "library_name" <*> o .:? "sdk"+        <*> o .:? "siblings" .!= [] <*> pure o++-- | A file returned in repository metadata. Size requires @blobs=true@.+data RepoFile = RepoFile+    { fileName :: RepoPath -- ^ Relative path within the repository.+    , fileSize :: Maybe Integer -- ^ Byte count, when supplied.+    } deriving stock (Eq, Show)++instance FromJSON RepoFile where+    parseJSON = withObject "RepoFile" $ \o -> RepoFile <$> o .: "rfilename" <*> o .:? "size"++-- | Identity returned by @/api/whoami-v2@.+data UserInfo = UserInfo+    { userName :: AccountName -- ^ Account name.+    , userFullName :: Maybe Text -- ^ Display name.+    , userRaw :: Object -- ^ Full identity response; may contain private account data.+    } deriving stock (Eq, Show)++instance FromJSON UserInfo where+    parseJSON = withObject "UserInfo" $ \o -> UserInfo <$> o .: "name" <*> o .:? "fullname" <*> pure o++-- | Options common to the Hub's repository listing endpoints. 'listLimit' is+-- the requested page size, not a total across pages. The server may cap it.+data ListOptions = ListOptions+    { listSearch :: Maybe Text -- ^ Search repository names.+    , listAuthor :: Maybe AccountName -- ^ Restrict to an account or organization.+    , listFilter :: [HubTag] -- ^ Repeated @filter@ query parameters.+    , listSort :: Maybe SortKey -- ^ Server sort key, such as @downloads@ or @lastModified@.+    , listLimit :: Maybe PositiveInt -- ^ Positive page size.+    , listFull :: Bool -- ^ Ask for expanded metadata.+    } deriving stock (Eq, Show)++-- | Unfiltered first page, with the server's default size and ordering.+defaultListOptions :: ListOptions+defaultListOptions = ListOptions Nothing Nothing [] Nothing Nothing False

@@ -0,0 +1,90 @@+{-# LANGUAGE DerivingVia #-}+{-# LANGUAGE OverloadedStrings #-}++-- |+-- Module      : HuggingFace.Types.Pagination+-- Description : Pages and parsed Link header continuations+-- Copyright   : (c) 2026 Emily Pillmore+-- License     : BSD-3-Clause+-- Maintainer  : emilypi@cohomolo.gy+-- Stability   : experimental+-- Portability : GHC+module HuggingFace.Types.Pagination+    ( Page (..), NextPage, nextPageFromHeaders, nextPageURL+    ) where++import Data.ByteString (ByteString)+import qualified Data.ByteString as BS+import qualified Data.ByteString.Char8 as B8+import Data.Char (isAscii, isAlphaNum, ord, toLower)+import Data.Either (fromRight)+import Data.Maybe (catMaybes, listToMaybe)+import Network.HTTP.Client (Request, getUri)+import Network.HTTP.Types (ResponseHeaders)+import Network.URI (parseURIReference, relativeTo)+import qualified Text.Parsec as P+import qualified Text.Parsec.ByteString as P+import HuggingFace.Utils (matchedBytes)++-- | One server page. The caller explicitly decides whether to fetch another.+data Page a = Page+    { pageItems :: [a] -- ^ Items in this response.+    , pageNext :: Maybe NextPage -- ^ Opaque continuation supplied by the Hub.+    } deriving stock (Eq, Show)++-- | Opaque server-provided pagination continuation.+newtype NextPage = NextPage+    { nextPageURL :: ByteString+    -- ^ Recover the continuation URL as bytes. Query parameters may contain private+    -- state; the 'Show' instance redacts them. Consuming a continuation still requires+    -- checking its origin against the client's configured Hub endpoint.+    }+    deriving (Eq) via ByteString++instance Show NextPage where+    show _ = "<NextPage>"++-- A Link header is a comma-separated list of targets and parameters. Parsing+-- quoted strings as a unit prevents embedded commas, semicolons, and escaped+-- quotes from being mistaken for delimiters or relation parameters.+links :: ByteString -> [ByteString]+links = fromRight [] . P.parse (linkHeader <* P.eof) ""++linkHeader :: P.Parser [ByteString]+linkHeader = do+    ows+    -- HTTP list recipients ignore empty members (RFC 9110, section 5.6.1.2).+    entries <- P.optionMaybe link `P.sepBy1` (P.char ',' *> ows)+    pure [target | (target, parameters) <- catMaybes entries, maybe False (elem "next" . B8.words) (lookup "rel" parameters)]+  where+    link = do+        target <- P.between (P.char '<') (P.char '>') $+            matchedBytes (P.skipMany (P.satisfy (\c -> c > ' ' && c < '\DEL' && c /= '<' && c /= '>')))+        ows+        parameters <- P.many (P.char ';' *> ows *> parameter <* ows)+        pure (target, parameters)+    parameter = do+        name <- token <* ows+        value <- P.option "" (P.char '=' *> ows *> (quoted P.<|> token))+        pure (B8.map toLower name, value)+    token = matchedBytes (P.skipMany1 (P.satisfy tokenChar))+    tokenChar c = (isAscii c && isAlphaNum c) || B8.elem c "!#$%&'*+-.^_`|~"+    quoted = P.between (P.char '"') (P.char '"') (BS.concat <$> P.many chunk)+    chunk = (P.char '\\' *> (B8.singleton <$> P.satisfy quotedPair))+        P.<|> matchedBytes (P.skipMany1 (P.satisfy quotedText))+    quotedPair c = c == '\t' || (ord c >= 32 && c /= '\DEL')+    quotedText c = quotedPair c && c /= '"' && c /= '\\'++ows :: P.Parser ()+ows = P.skipMany (P.satisfy (\c -> c == ' ' || c == '\t'))++-- | Parse the first @rel=next@ target from response Link headers and resolve it+-- against the final request URL. Malformed Link headers contribute no target.+-- The resulting handle is untrusted until the transport checks its origin.+nextPageFromHeaders :: Request -> ResponseHeaders -> Maybe NextPage+nextPageFromHeaders request headers = do+    link <- listToMaybe (concatMap (links . snd) (filter ((== "link") . fst) headers))+    let resolved = case parseURIReference (B8.unpack link) of+            Just uri -> B8.pack (show (uri `relativeTo` getUri request))+            Nothing -> link+    pure (NextPage resolved)

@@ -0,0 +1,90 @@+{-# LANGUAGE DerivingVia #-}+{-# LANGUAGE OverloadedStrings #-}++-- |+-- Module      : HuggingFace.Types.Parameters+-- Description : Constrained counts, timeouts, and sampling parameters+-- Copyright   : (c) 2026 Emily Pillmore+-- License     : BSD-3-Clause+-- Maintainer  : emilypi@cohomolo.gy+-- Stability   : experimental+-- Portability : GHC+module HuggingFace.Types.Parameters+    ( PositiveInt, mkPositiveInt, positiveIntValue, defaultTimeout+    , ChatTemperature, mkChatTemperature, chatTemperatureValue+    , TopP, mkTopP, topPValue+    , GenerationTemperature, mkGenerationTemperature, generationTemperatureValue+    ) where++import Data.Aeson+import HuggingFace.Error (HuggingFaceError (..))+import HuggingFace.Utils (fromEither, inRange)++-- | Strictly positive machine integer for counts, limits, and microseconds.+-- No 'Num' instance is supplied, so arithmetic cannot bypass construction.+newtype PositiveInt = PositiveInt+    { positiveIntValue :: Int+    -- ^ Recover a positive integer.+    }+    deriving stock (Show)+    deriving (Eq, Ord, ToJSON) via Int++-- | Refine an external integer into a positive count.+mkPositiveInt :: Int -> Either HuggingFaceError PositiveInt+mkPositiveInt n+    | n > 0 = Right (PositiveInt n)+    | otherwise = Left (InvalidInput "Expected a positive integer")++-- | Thirty seconds in microseconds.+defaultTimeout :: PositiveInt+defaultTimeout = PositiveInt 30000000++instance FromJSON PositiveInt where parseJSON v = parseJSON v >>= fromEither . mkPositiveInt++-- | A finite value in [0,2].+newtype ChatTemperature = ChatTemperature+    { chatTemperatureValue :: Double+    -- ^ Recover the numeric value.+    }+    deriving stock (Show)+    deriving (Eq, Ord, ToJSON) via Double++-- | Refine a number into a finite value in [0,2].+mkChatTemperature :: Double -> Either HuggingFaceError ChatTemperature+mkChatTemperature t+    | inRange 0 2 t = Right (ChatTemperature t)+    | otherwise = Left (InvalidInput "ChatTemperature requires a finite value in [0,2]")++instance FromJSON ChatTemperature where parseJSON v = parseJSON v >>= fromEither . mkChatTemperature++-- | A finite value in (0,1].+newtype TopP = TopP+    { topPValue :: Double+    -- ^ Recover the numeric value.+    }+    deriving stock (Show)+    deriving (Eq, Ord, ToJSON) via Double++-- | Refine a number into a finite value in (0,1].+mkTopP :: Double -> Either HuggingFaceError TopP+mkTopP t+    | inRange 0 1 t && t > 0 = Right (TopP t)+    | otherwise = Left (InvalidInput "TopP requires a finite value in (0,1]")++instance FromJSON TopP where parseJSON v = parseJSON v >>= fromEither . mkTopP++-- | A positive finite value.+newtype GenerationTemperature = GenerationTemperature+    { generationTemperatureValue :: Double+    -- ^ Recover the numeric value.+    }+    deriving stock (Show)+    deriving (Eq, Ord, ToJSON) via Double++-- | Refine a number into a positive finite value.+mkGenerationTemperature :: Double -> Either HuggingFaceError GenerationTemperature+mkGenerationTemperature t+    | not (isNaN t || isInfinite t) && t > 0 = Right (GenerationTemperature t)+    | otherwise = Left (InvalidInput "GenerationTemperature requires a positive finite value")++instance FromJSON GenerationTemperature where parseJSON v = parseJSON v >>= fromEither . mkGenerationTemperature

@@ -0,0 +1,180 @@+{-# LANGUAGE DerivingVia #-}+{-# LANGUAGE OverloadedStrings #-}++-- |+-- Module      : HuggingFace.Types.Repository+-- Description : Repository names, revisions, paths, and commit identities+-- Copyright   : (c) 2026 Emily Pillmore+-- License     : BSD-3-Clause+-- Maintainer  : emilypi@cohomolo.gy+-- Stability   : experimental+-- Portability : GHC+module HuggingFace.Types.Repository+    ( RepoId, parseRepoId, repoIdText, repoOwner, repoName, qualifiedRepo+    , RepoName, parseRepoName, repoNameText+    , AccountName, parseAccountName, accountNameText+    , Revision, parseRevision, revisionText, mainRevision, commitRevision+    , RepoPath, parseRepoPath, repoPathText+    , CommitSha, parseCommitSha, commitShaText+    , RepoType (..)+    , repoIdParser, repoPlural+    ) where++import Control.Monad (replicateM_, void)+import Data.Aeson+import Data.Char (isAscii, isHexDigit, isControl)+import Data.List.NonEmpty (NonEmpty (..))+import qualified Data.List.NonEmpty as NE+import Data.Text (Text)+import qualified Data.Text as T+import qualified Text.Parsec as P+import HuggingFace.Error (HuggingFaceError)+import HuggingFace.Utils (TextParser, parseValue, parseTextJSON, matched, asciiAlphaNum, takeWhile1P)++-- | Repository basename, distinct from its optional owner.+newtype RepoName = RepoName+    { repoNameText :: Text+    -- ^ Render a repository basename.+    }+    deriving stock (Show)+    deriving (Eq, Ord, ToJSON) via Text++-- | Parse a Hub repository basename.+parseRepoName :: Text -> Either HuggingFaceError RepoName+parseRepoName = parseValue "Expected a Hub repository basename" (RepoName <$> nameParser)++instance FromJSON RepoName where parseJSON = parseTextJSON "RepoName" parseRepoName++-- | Repository identity with an optional owner and a basename. Parsers and+-- smart constructors assemble it from parsed names.+data RepoId = RepoId+    { repoOwner :: Maybe AccountName -- ^ Optional owner of a repository.+    , repoName :: RepoName -- ^ Repository basename.+    }+    deriving stock (Eq, Ord, Show)++-- | Parse either a bare repository name or @owner/name@.+parseRepoId :: Text -> Either HuggingFaceError RepoId+parseRepoId = parseValue "Expected a repository name or owner/name" repoIdParser++-- | Compose a repository parser with a larger grammar, such as a routing suffix.+-- Use 'parseRepoId' when parsing a complete external value.+repoIdParser :: TextParser RepoId+repoIdParser = do+    first <- nameParser+    P.option (RepoId Nothing (RepoName first)) $+        qualifiedRepo (AccountName first) . RepoName <$> (P.char '/' *> nameParser)++-- | Assemble a qualified repository from parsed components without reparsing.+qualifiedRepo :: AccountName -> RepoName -> RepoId+qualifiedRepo owner = RepoId (Just owner)++-- | Render a repository identity for display or persistence.+repoIdText :: RepoId -> Text+repoIdText (RepoId owner name) = maybe "" ((<> "/") . accountNameText) owner <> repoNameText name++instance ToJSON RepoId where toJSON = toJSON . repoIdText+instance FromJSON RepoId where parseJSON = parseTextJSON "RepoId" parseRepoId++-- | Branch, tag, or commit reference; slash-separated components are retained.+newtype Revision = Revision (NonEmpty Text)+    deriving stock (Show)+    deriving (Eq, Ord) via (NonEmpty Text)++-- | Parse a revision. Slashes are encoded together as one URL segment.+parseRevision :: Text -> Either HuggingFaceError Revision+parseRevision = parseValue "Expected nonempty revision segments without traversal, controls, or backslashes" (Revision <$> components)++-- | Render a revision.+revisionText :: Revision -> Text+revisionText (Revision parts) = T.intercalate "/" (NE.toList parts)++-- | The default Hub branch.+mainRevision :: Revision+mainRevision = Revision ("main" :| [])++-- | Pin a revision to an already parsed full commit SHA.+commitRevision :: CommitSha -> Revision+commitRevision sha = Revision (commitShaText sha :| [])++instance ToJSON Revision where toJSON = toJSON . revisionText+instance FromJSON Revision where parseJSON = parseTextJSON "Revision" parseRevision++-- | Nonempty relative file path with no empty, dot, or parent segments.+newtype RepoPath = RepoPath (NonEmpty Text)+    deriving stock (Show)+    deriving (Eq, Ord) via (NonEmpty Text)++-- | Parse a repository-relative path, preserving Unicode and spaces.+parseRepoPath :: Text -> Either HuggingFaceError RepoPath+parseRepoPath = parseValue "Expected a relative repository file path without traversal, controls, or backslashes" (RepoPath <$> components)++-- | Render a repository-relative path.+repoPathText :: RepoPath -> Text+repoPathText (RepoPath parts) = T.intercalate "/" (NE.toList parts)++instance ToJSON RepoPath where toJSON = toJSON . repoPathText+instance FromJSON RepoPath where parseJSON = parseTextJSON "RepoPath" parseRepoPath++-- | Full SHA-1 commit identifier, stored in canonical lowercase form.+newtype CommitSha = CommitSha+    { commitShaText :: Text -- ^ Render a full commit identifier.+    }+    deriving stock (Show)+    deriving (Eq, Ord, ToJSON) via Text++-- | Parse exactly forty ASCII hexadecimal digits. Use 'parseRevision' for+-- abbreviated commit references, branches, or tags.+parseCommitSha :: Text -> Either HuggingFaceError CommitSha+parseCommitSha = parseValue "CommitSha requires forty hexadecimal digits" $+    CommitSha . T.toLower <$> matched (replicateM_ 40 (P.satisfy (\c -> isAscii c && isHexDigit c)))++instance FromJSON CommitSha where parseJSON = parseTextJSON "CommitSha" parseCommitSha++-- | Account or organization namespace.+newtype AccountName = AccountName+    { accountNameText :: Text -- ^ Render an account or organization name.+    }+    deriving stock (Show)+    deriving (Eq, Ord, ToJSON) via Text++-- | Parse a AccountName from external text.+parseAccountName :: Text -> Either HuggingFaceError AccountName+parseAccountName = parseValue "Expected a Hub account or organization name" (AccountName <$> nameParser)++instance FromJSON AccountName where parseJSON = parseTextJSON "AccountName" parseAccountName++-- | Hub repository kinds.+data RepoType = Model | Dataset | Space+    deriving stock (Eq, Ord, Show, Enum, Bounded)++-- | Hub collection path component for a repository kind.+repoPlural :: RepoType -> Text+repoPlural Model = "models"+repoPlural Dataset = "datasets"+repoPlural Space = "spaces"++-- Hub name components start/end with a word character, cannot repeat '.' or+-- '-', and cannot end in '.git'. Length is bounded while consuming input.+nameParser :: TextParser Text+nameParser = matched $ word *> rest (95 :: Int)+  where+    word = P.satisfy (\c -> asciiAlphaNum c || c == '_')+    nameChar = P.satisfy (\c -> asciiAlphaNum c || c == '_' || c == '-' || c == '.')+    next = void word P.<|> do+        P.notFollowedBy (P.try (P.string ".git" <* P.notFollowedBy nameChar))+        punctuation <- P.char '-' P.<|> P.char '.'+        P.notFollowedBy (P.char punctuation)+        void (P.lookAhead nameChar)+    rest 0 = P.notFollowedBy nameChar+    rest n = P.optional (next *> rest (n - 1))++components :: TextParser (NonEmpty Text)+components = (:|) <$> component <*> P.many (P.char '/' *> component)+  where+    component = do+        part <- takeWhile1P (\c -> c /= '/' && c /= '\\' && not (isControl c))+        case part of+            "." -> P.parserFail "Dot segment"+            ".." -> P.parserFail "Parent segment"+            _ -> pure part

@@ -0,0 +1,103 @@+{-# LANGUAGE DerivingVia #-}+{-# LANGUAGE OverloadedStrings #-}++-- |+-- Module      : HuggingFace.Types.Routing+-- Description : Inference model identities and provider selection+-- Copyright   : (c) 2026 Emily Pillmore+-- License     : BSD-3-Clause+-- Maintainer  : emilypi@cohomolo.gy+-- Stability   : experimental+-- Portability : GHC+module HuggingFace.Types.Routing+    ( Provider, parseProvider, providerText+    , Routing (..), InferenceModel, parseInferenceModel, inferenceModelText+    , modelRepository, modelRouting, modelFromRepo, routeModel+    , ModelName, parseModelName, modelNameText+    ) where++import Data.Aeson+import Data.Text (Text)+import qualified Text.Parsec as P+import HuggingFace.Error (HuggingFaceError)+import HuggingFace.Utils (TextParser, parseValue, parseTextJSON, parseLabel, takeWhile1P, asciiAlphaNum)+import HuggingFace.Types.Repository (RepoId, repoIdText, repoIdParser)++-- | Provider-resolved model name; it need not be a Hub repository ID.+newtype ModelName = ModelName+    { modelNameText :: Text+    -- ^ Render a ModelName.+    }+    deriving stock (Show)+    deriving (Eq, Ord, ToJSON) via Text++-- | Parse a ModelName from external text.+parseModelName :: Text -> Either HuggingFaceError ModelName+parseModelName = fmap ModelName . parseLabel "ModelName"++instance FromJSON ModelName where parseJSON = parseTextJSON "ModelName" parseModelName++-- | Provider routing slug; policy names are reserved for Routing constructors.+newtype Provider = Provider+    { providerText :: Text+    -- ^ Render a Provider.+    }+    deriving stock (Show)+    deriving (Eq, Ord, ToJSON) via Text++-- | Parse a Provider from external text.+parseProvider :: Text -> Either HuggingFaceError Provider+parseProvider = parseValue "Expected a provider slug, not a routing policy" providerParser++instance FromJSON Provider where parseJSON = parseTextJSON "Provider" parseProvider++-- | Router selection policy or a named provider. An absent routing choice uses+-- the server default; it is distinct from explicitly selecting 'Fastest'.+data Routing = Fastest | Cheapest | Preferred | Via Provider deriving stock (Eq, Ord, Show)++-- | A Hub model repository paired with an optional parsed routing choice.+data InferenceModel = InferenceModel+    { modelRepository :: RepoId -- ^ The repository referenced by a routed model.+    , modelRouting :: Maybe Routing -- ^ Optional explicit routing choice.+    } deriving stock (Eq, Ord, Show)++-- | Parse @owner/model@ or @owner/model:provider-or-policy@.+parseInferenceModel :: Text -> Either HuggingFaceError InferenceModel+parseInferenceModel = parseValue "Expected a model repository with at most one routing suffix" $+    InferenceModel <$> repoIdParser <*> P.optionMaybe (P.char ':' *> routingParser)++routingParser :: TextParser Routing+routingParser = do+    slug <- takeWhile1P (\c -> asciiAlphaNum c || c == '-')+    pure $ case slug of+        "fastest" -> Fastest+        "cheapest" -> Cheapest+        "preferred" -> Preferred+        _ -> Via (Provider slug)++providerParser :: TextParser Provider+providerParser = do+    routing <- routingParser+    case routing of+        Via provider -> pure provider+        _ -> P.parserFail "Reserved routing policy"++-- | Choose the router's default policy for an existing repository identifier.+modelFromRepo :: RepoId -> InferenceModel+modelFromRepo repository = InferenceModel repository Nothing++-- | Select a routing policy without converting an identifier back to text.+routeModel :: RepoId -> Routing -> InferenceModel+routeModel repository routing = InferenceModel repository (Just routing)++-- | Render a model together with its optional routing suffix.+inferenceModelText :: InferenceModel -> Text+inferenceModelText (InferenceModel repository routing) = repoIdText repository <> maybe "" ((":" <>) . render) routing+  where+    render Fastest = "fastest"+    render Cheapest = "cheapest"+    render Preferred = "preferred"+    render (Via provider) = providerText provider++instance ToJSON InferenceModel where toJSON = toJSON . inferenceModelText+instance FromJSON InferenceModel where parseJSON = parseTextJSON "InferenceModel" parseInferenceModel

@@ -0,0 +1,57 @@+{-# LANGUAGE OverloadedStrings #-}++-- |+-- Module      : HuggingFace.Types.Tasks+-- Description : HF Inference task parameters and results+-- Copyright   : (c) 2026 Emily Pillmore+-- License     : BSD-3-Clause+-- Maintainer  : emilypi@cohomolo.gy+-- Stability   : experimental+-- Portability : GHC+module HuggingFace.Types.Tasks+    ( GenerationParameters (..), defaultGenerationParameters+    , GeneratedText (..), Classification (..)+    ) where++import Data.Aeson+import Data.Maybe (catMaybes)+import Data.Text (Text)+import HuggingFace.Types.Parameters (PositiveInt, GenerationTemperature)++-- | Parameters for the HF Inference text-generation task.+data GenerationParameters = GenerationParameters+    { generationMaxNewTokens :: Maybe PositiveInt -- ^ Positive output token limit.+    , generationTemperature :: Maybe GenerationTemperature -- ^ Positive finite sampling temperature.+    , generationDoSample :: Maybe Bool -- ^ Enable sampling.+    , generationReturnFullText :: Maybe Bool -- ^ Include the prompt in output.+    } deriving (Eq, Show)++-- | Use the server's generation defaults.+defaultGenerationParameters :: GenerationParameters+defaultGenerationParameters = GenerationParameters Nothing Nothing Nothing Nothing++instance ToJSON GenerationParameters where+    toJSON parameters = object $ catMaybes+        [ ("max_new_tokens" .=) <$> generationMaxNewTokens parameters+        , ("temperature" .=) <$> generationTemperature parameters+        , ("do_sample" .=) <$> generationDoSample parameters+        , ("return_full_text" .=) <$> generationReturnFullText parameters+        ]++-- | Generated text and optional token-level details.+data GeneratedText = GeneratedText+    { generatedText :: Text -- ^ Generated output.+    , generationDetails :: Maybe Value -- ^ Provider-specific token and sampling details.+    } deriving (Eq, Show)++instance FromJSON GeneratedText where+    parseJSON = withObject "GeneratedText" $ \o -> GeneratedText <$> o .: "generated_text" <*> o .:? "details"++-- | A predicted label and score.+data Classification = Classification+    { classificationLabel :: Text -- ^ Predicted label.+    , classificationScore :: Double -- ^ Model confidence score.+    } deriving (Eq, Show)++instance FromJSON Classification where+    parseJSON = withObject "Classification" $ \o -> Classification <$> o .: "label" <*> o .: "score"

@@ -0,0 +1,122 @@+{-# LANGUAGE OverloadedStrings #-}++-- |+-- Module      : HuggingFace.Utils+-- Description : Shared parsing, JSON, and HTTP utilities+-- Copyright   : (c) 2026 Emily Pillmore+-- License     : BSD-3-Clause+-- Maintainer  : emilypi@cohomolo.gy+-- Stability   : experimental+-- Portability : GHC+module HuggingFace.Utils+    ( TextParser, parseText, parseValue, parseTextJSON, parseLabel, fromEither, decodeJSON+    , matched, matchedBytes, takeWhile1P, label, asciiAlphaNum, inRange+    , encodeSegments, readAtMost, sameOrigin+    ) where++import Data.Aeson (FromJSON, Value, eitherDecode, withText)+import qualified Data.Aeson.Types as JSON+import Data.ByteString (ByteString)+import qualified Data.ByteString as BS+import qualified Data.ByteString.Char8 as B8+import qualified Data.ByteString.Lazy as BL+import Data.Char (isAlphaNum, isAscii, isControl, isSpace, toLower)+import Data.Text (Text)+import qualified Data.Text as T+import qualified Data.Text.Foreign as TF+import Data.Text.Encoding (encodeUtf8)+import Network.HTTP.Client (BodyReader, Request, brRead, secure, port, host)+import Network.HTTP.Types (urlEncode)+import qualified Text.Parsec as P+import qualified Text.Parsec.ByteString as PB+import HuggingFace.Error (HuggingFaceError (..))++-- | Parsec parser over strict 'Text', without user state.+type TextParser = P.Parsec Text ()++-- | Require complete input consumption and replace parser errors with the+-- caller's diagnostic. Parsec errors may contain input+-- tokens, so they must never escape a parser that can receive credentials.+parseText :: e -> TextParser a -> Text -> Either e a+parseText err parser = either (const (Left err)) Right . P.parse (parser <* P.eof) ""++-- | Capture consumed Text without an intermediate String or rescanning the+-- remaining input. Parsec consumes complete characters, so the byte-length+-- difference always falls on a UTF-8 boundary; takeWord8 is the safe slicer.+matched :: TextParser a -> TextParser Text+matched parser = do+    before <- P.getInput+    _ <- parser+    after <- P.getInput+    pure (TF.takeWord8 (fromIntegral (TF.lengthWord8 before - TF.lengthWord8 after)) before)++-- | Consume one or more matching characters and return the consumed text.+takeWhile1P :: (Char -> Bool) -> TextParser Text+takeWhile1P predicate = matched (P.skipMany1 (P.satisfy predicate))++-- | Whether a character is an ASCII letter or decimal digit.+asciiAlphaNum :: Char -> Bool+asciiAlphaNum c = isAscii c && isAlphaNum c++-- | Parse an open label, preserving spaces, Unicode, and punctuation, with+-- at least one non-space character and no control characters.+label :: TextParser Text+label = do+    _ <- P.lookAhead (P.skipMany (P.satisfy isSpace) *> P.satisfy (not . isSpace))+    takeWhile1P (not . isControl)++-- | Decode a JSON string using a domain parser. The first argument names the+-- expected type in Aeson diagnostics.+parseTextJSON :: Text -> (Text -> Either HuggingFaceError a) -> Value -> JSON.Parser a+parseTextJSON name parse = withText (T.unpack name) (fromEither . parse)++-- | Lift a domain result into Aeson's parser.+fromEither :: Either HuggingFaceError a -> JSON.Parser a+fromEither = either (fail . show) pure++-- | Parse a complete value, reporting 'InvalidInput' with the supplied message.+parseValue :: Text -> TextParser a -> Text -> Either HuggingFaceError a+parseValue message = parseText (InvalidInput message)++-- | Parse a complete 'label'; the first argument identifies the domain type.+parseLabel :: Text -> Text -> Either HuggingFaceError Text+parseLabel name = parseValue (name <> " requires nonblank text without control characters") label++-- | Test a finite number against inclusive lower and upper bounds.+inRange :: Double -> Double -> Double -> Bool+inRange low high t = not (isNaN t || isInfinite t) && t >= low && t <= high++-- | Decode JSON without retaining potentially sensitive parser diagnostics.+decodeJSON :: FromJSON a => BL.ByteString -> Either HuggingFaceError a+decodeJSON = either (const (Left DecodeError)) Right . eitherDecode++-- | Capture the bytes consumed by a ByteString parser.+matchedBytes :: PB.Parser a -> PB.Parser ByteString+matchedBytes parser = do+    before <- P.getInput+    _ <- parser+    after <- P.getInput+    pure (BS.take (BS.length before - BS.length after) before)++-- | Encode each path segment as UTF-8 and percent-escape it, then join the+-- segments under a leading slash. Slashes inside a segment are escaped too.+encodeSegments :: [Text] -> ByteString+encodeSegments parts = "/" <> BS.intercalate "/" (map (urlEncode True . encodeUtf8) parts)++-- | Read at most the requested number of bytes, or none for a nonpositive limit.+-- The last chunk may exceed the limit; its excess bytes are consumed and+-- discarded. Use this for a bounded preview before closing the response.+readAtMost :: Int -> BodyReader -> IO ByteString+readAtMost limit reader = BS.concat . reverse <$> go limit []+  where+    go n chunks+        | n <= 0 = pure chunks+        | otherwise = do+            chunk <- brRead reader+            if BS.null chunk then pure chunks+                else go (n - BS.length chunk) (BS.take n chunk : chunks)++-- | Compare TLS, port, and case-insensitive hostname; paths are ignored.+sameOrigin :: Request -> Request -> Bool+sameOrigin a b = secure a == secure b && port a == port b+    && B8.map toLower (host a) == B8.map toLower (host b)

@@ -0,0 +1,656 @@+{-# LANGUAGE OverloadedStrings #-}++module Main (main) where++import Control.Exception (AsyncException (UserInterrupt), IOException, throwIO, try)+import Data.Aeson+import qualified Data.Aeson.KeyMap as KM+import Data.ByteString (ByteString)+import qualified Data.ByteString as BS+import qualified Data.ByteString.Char8 as B8+import qualified Data.ByteString.Lazy as BL+import Data.Either (isLeft)+import Data.IORef+import Data.List (isInfixOf, sort)+import Data.List.NonEmpty (NonEmpty (..))+import Data.Text.Encoding (encodeUtf8)+import Data.Text (Text)+import qualified Data.Text as T+import HuggingFace.Monad+import HuggingFace.Client+import HuggingFace.Error+import HuggingFace.Hub+    ( listModels, listDatasets, listSpaces, nextPage+    , modelInfo, datasetInfo, spaceInfo, whoAmI, downloadFile, withDownload+    )+import HuggingFace.Inference (chatCompletion, textGeneration, classifyText, featureExtraction, infer)+import qualified HuggingFace.Internal.HTTP as Transport+import HuggingFace.Types.Auth+import HuggingFace.Types.Chat+import HuggingFace.Types.Hub+import HuggingFace.Types.Pagination+import HuggingFace.Types.Parameters+import HuggingFace.Types.Repository+import HuggingFace.Types.Routing+import HuggingFace.Types.Tasks+import qualified HuggingFace.Utils as Utils+import Network.HTTP.Client (brRead, defaultManagerSettings, managerRetryableException, managerModifyResponse, newManager)+import qualified Network.HTTP.Client.Internal as HTTP+import Network.HTTP.Types+import qualified Network.Wai as Wai+import Network.Wai.Handler.Warp (testWithApplication)+import Test.Tasty+import Test.Tasty.HUnit+import Test.Tasty.QuickCheck++data Observed = Observed+    { observedMethod :: Method+    , observedPath :: ByteString+    , observedQuery :: Query+    , observedHeaders :: RequestHeaders+    , observedBody :: BL.ByteString+    } deriving (Show)++type Reply = (Status, ResponseHeaders, BL.ByteString)++withServer :: (Observed -> IO Reply) -> (Int -> IO [Observed] -> IO a) -> IO a+withServer handler action = do+    seen <- newIORef []+    let app request respond = do+            body <- Wai.strictRequestBody request+            let observed = Observed (Wai.requestMethod request) (Wai.rawPathInfo request)+                    (Wai.queryString request) (Wai.requestHeaders request) body+            atomicModifyIORef' seen (\values -> (observed : values, ()))+            (status, headers, payload) <- handler observed+            respond (Wai.responseLBS status headers payload)+    testWithApplication (pure app) $ \port -> action port (reverse <$> readIORef seen)++withFixture :: Reply -> (Client -> IO [Observed] -> IO a) -> IO a+withFixture reply action = withServer (const (pure reply)) $ \port seen -> do+    client <- clientAt port (Just token)+    action client seen++clientAt :: Int -> Maybe Token -> IO Client+clientAt port tokenValue = do+    manager <- newManager defaultManagerSettings {managerRetryableException = const False}+    pure $ newClientWithManager manager defaultClientConfig+        { hubEndpoint = endpointAt port, inferenceEndpoint = endpointAt port, accessToken = tokenValue }++origin :: Int -> Text+origin port = "http://127.0.0.1:" <> T.pack (show port)++endpointAt :: Int -> Endpoint+endpointAt = valid . parseEndpoint . origin++expectRight :: Show e => Either e a -> IO a+expectRight = either (\err -> assertFailure (show err) >> fail "unreachable") pure++valid :: Show e => Either e a -> a+valid = either (error . show) id++token :: Token+token = valid (parseToken "hf_test_token")++repository :: RepoId+repository = valid (parseRepoId "owner/model")++repoJSON :: BL.ByteString+repoJSON = "{\"id\":\"owner/model\",\"sha\":\"0123456789abcdef0123456789abcdef01234567\",\"private\":false,\"downloads\":42,\"likes\":2,\"siblings\":[{\"rfilename\":\"config.json\",\"size\":17}],\"futureField\":true}"++chatJSON :: BL.ByteString+chatJSON = "{\"id\":\"chat-1\",\"model\":\"owner/model\",\"choices\":[{\"index\":0,\"message\":{\"role\":\"assistant\",\"content\":\"Hello!\"},\"finish_reason\":\"stop\"}],\"usage\":{\"prompt_tokens\":2,\"completion_tokens\":3,\"total_tokens\":5}}"++jsonReply :: BL.ByteString -> Reply+jsonReply = (,,) status200 [(hContentType, "application/json")]++main :: IO ()+main = defaultMain $ testGroup "huggingface"+    [ identifierTests, domainTests, grammarTests, moduleTests, monadTests, hubTests, transportTests, inferenceTests ]++monadTests :: TestTree+monadTests = testGroup "Concrete client computations"+    [ testCase "parser errors prevent any request" $ withFixture (jsonReply repoJSON) $ \client seen -> do+        result <- runHuggingFaceM $ do+            parsed <- liftEither (parseRepoId "owner/../model")+            modelInfo client parsed Nothing+        case result of+            Left InvalidInput{} -> pure ()+            _ -> assertFailure (show result)+        length <$> seen >>= (@?= 0)+    , testCase "metadata and downloads compose without intermediate Either handling" $+        withServer (\request -> pure $ if "/api/" `BS.isPrefixOf` observedPath request+            then jsonReply repoJSON else (status200, [], "content")) $ \port seen -> do+                client <- clientAt port Nothing+                result <- runHuggingFaceM $ do+                    info <- modelInfo client repository Nothing+                    file <- liftEither (parseRepoPath "config.json")+                    downloadFile client Model (repoId info) mainRevision file+                result @?= Right "content"+                map observedPath <$> seen >>= (@?=+                    ["/api/models/owner/model", "/owner/model/resolve/main/config.json"])+    , testCase "catchError can recover from an HTTP error with another operation" $+        withServer (\request -> pure $ if observedPath request == "/api/models"+            then jsonReply "[]" else (status404, [], "missing")) $ \port seen -> do+                client <- clientAt port Nothing+                result <- runHuggingFaceM $+                    (modelInfo client repository Nothing >> pure [repository]) `catchError` \err ->+                        case err of+                            HttpError {errorStatus = 404} -> map repoId . pageItems <$> listModels client defaultListOptions+                            _ -> throwError err+                result @?= Right []+                map observedPath <$> seen >>= (@?= ["/api/models/owner/model", "/api/models"])+    , testCase "decode errors stop a subsequent inference request" $ withFixture (jsonReply "invalid") $ \client seen -> do+        result <- runHuggingFaceM $ do+            info <- modelInfo client repository Nothing+            infer client (repoId info) (object []) :: HuggingFaceM Value+        result @?= Left DecodeError+        map observedPath <$> seen >>= (@?= ["/api/models/owner/model"])+    , testCase "IO adapters run once and participate in typed recovery" $ do+        calls <- newIORef (0 :: Int)+        let action = liftHuggingFaceM $ do+                modifyIORef' calls (+ 1)+                pure (Left DecodeError :: Either HuggingFaceError ())+        readIORef calls >>= (@?= 0)+        result <- runHuggingFaceM $ (action >> liftIO (modifyIORef' calls (+ 100)))+            `catchError` \err -> liftIO (err @?= DecodeError)+        result @?= Right ()+        readIORef calls >>= (@?= 1)+    , testCase "typed callback errors release the response before outer recovery" $+        withServer (const (pure (jsonReply "payload"))) $ \port seen -> do+            closed <- newIORef False+            manager <- newManager defaultManagerSettings+                { managerRetryableException = const False+                , managerModifyResponse = \response -> do+                    let HTTP.ResponseClose close = HTTP.responseClose' response+                    pure response {HTTP.responseClose' = HTTP.ResponseClose (close >> writeIORef closed True)}+                }+            let client = newClientWithManager manager defaultClientConfig {hubEndpoint = endpointAt port}+                aborted = InvalidInput "Stopped download"+            result <- runHuggingFaceM $+                withDownload client Model repository mainRevision (valid (parseRepoPath "file"))+                    (\_ -> do+                        liftIO (readIORef closed >>= (@?= False))+                        throwError aborted)+                `catchError` \err -> do+                    liftIO (err @?= aborted)+                    liftIO (readIORef closed >>= (@?= True))+                    pure ("recovered" :: Text)+            result @?= Right "recovered"+            length <$> seen >>= (@?= 1)+    ]++moduleTests :: TestTree+moduleTests = testGroup "Exposed extension modules"+    [ testCase "transport supports custom operations with parsed client configuration" $+        withFixture (jsonReply repoJSON) $ \client seen -> do+            let request = Transport.requestFor client (clientHub client) ["api", "models", "owner", "model"] []+            response <- runHuggingFaceM (Transport.getJSON client request) >>= expectRight+            repoId response @?= repository+            requests <- seen+            map observedPath requests @?= ["/api/models/owner/model"]+            map (lookup hAuthorization . observedHeaders) requests @?= [Just "Bearer hf_test_token"]+    , testCase "header-created continuations still require the configured origin" $+        withFixture (jsonReply "[]") $ \client seen -> do+            let request = Transport.requestFor client (clientHub client) ["api", "models"] []+                headers = [("link", "<https://other.example/api/models?cursor=PRIVATE>; rel=next")]+            case nextPageFromHeaders request headers of+                Nothing -> assertFailure "missing parsed continuation"+                Just next -> do+                    nextPageURL next @?= "https://other.example/api/models?cursor=PRIVATE"+                    show next @?= "<NextPage>"+                    (runHuggingFaceM (Transport.continuePage client next) :: IO (Either HuggingFaceError (Page RepoInfo)))+                        >>= (@?= Left InvalidPagination)+            requests <- seen+            length requests @?= 0+    , testCase "shared parser runners consume complete values and redact failures" $ do+        Utils.parseValue "Malformed repository" repoIdParser "owner/model" @?= Right repository+        Utils.parseValue "Malformed repository" repoIdParser "owner/model?secret=PRIVATE"+            @?= Left (InvalidInput "Malformed repository")+        (Utils.decodeJSON "{\"id\":\"PRIVATE/invalid/id\"}" :: Either HuggingFaceError RepoInfo)+            @?= Left DecodeError+    ]++identifierTests :: TestTree+identifierTests = testGroup "Parsed domain values"+    [ testCase "token is redacted in configuration" $ do+        show token @?= "<Token>"+        assertBool "config leaked token" (not ("hf_test_token" `isInfixOf` show defaultClientConfig {accessToken = Just token}))+    , testCase "invalid tokens never echo their input" $ mapM_ (\value -> do+        let result = parseToken value+        assertBool "accepted malformed token" (isLeft result)+        assertBool "echoed secret" (not ("SECRET" `isInfixOf` show result)))+        ["", "hf_SECRET\r\nInjected: true", "hf_SECRET token", "hf_SECRET\955"]+    , testGroup "invalid repositories"+        [ testCase (show bad) $ assertBool "accepted invalid repo" (isLeft (parseRepoId bad))+        | bad <- ["", "/name", "name/", "a/b/c", "a/../b", "a?x=1", "https://example.com", "-name", "a..b", "a--b", "name.git", T.replicate 97 "x"] ]+    , testProperty "repository identity round-trips" $ forAll (listOf1 (elements ['a' .. 'z'])) $ \name ->+        let input = "owner/" <> T.pack (take 40 name)+        in fmap repoIdText (parseRepoId input) === Right input+    , testCase "branches may include slashes" $+        fmap revisionText (parseRevision "refs/pr/42") @?= Right "refs/pr/42"+    , testCase "revisions reject empty and dot-only segments" $+        mapM_ (\input -> assertBool "unsafe revision" (isLeft (parseRevision input))) ["../main", "refs/../main", "/main", "main/"]+    , testGroup "unsafe file paths"+        [ testCase (show bad) $ assertBool "accepted unsafe path" (isLeft (parseRepoPath bad))+        | bad <- ["", "/config.json", "../config.json", "a/../b", "a/./b", "a//b", "a/", "a\\b", "a\NULb"] ]+    , testCase "Unicode file names remain intact" $+        fmap repoPathText (parseRepoPath "sub/λ weights.json") @?= Right "sub/λ weights.json"+    , testCase "unsafe endpoints fail to parse" $+        mapM_ (\endpoint -> assertBool "accepted unsafe endpoint" (isLeft (parseEndpoint endpoint)))+            ["http://example.com", "https://user:secret@example.com", "https://example.com/api", "https://example.com?token=x", "https://example.com#fragment", "file:///tmp/data"]+    , testCase "endpoint ports cannot overflow or wrap to another destination" $+        mapM_ (\portText -> assertBool "invalid port parsed" (isLeft (parseEndpoint ("https://example.com:" <> portText))))+            ["", "0", "-1", "65536", "65979", "18446744073709552059", "not-a-port"]++    ]++domainTests :: TestTree+domainTests = testGroup "Domain boundaries"+    [ testCase "repository components compose without reparsing" $ do+        owner <- expectRight (parseAccountName "owner")+        name <- expectRight (parseRepoName "model")+        qualifiedRepo owner name @?= repository+        repoOwner repository @?= Just owner+        repoName repository @?= name+        repoOwner <$> parseRepoId "bert" @?= Right Nothing+    , testProperty "parsed repositories survive JSON encoding" $+        forAll (listOf1 (elements ['a' .. 'z'])) $ \name ->+            let value = valid (parseRepoId ("owner/" <> T.pack (take 40 name)))+            in eitherDecode (encode value) === Right value+    , testCase "qualified fields parse during JSON decoding" $ do+        mapM_ (\value -> assertBool "invalid response identity accepted" $+            isLeft (eitherDecode (encode value) :: Either String RepoInfo))+            [ object ["id" .= ("a/b/c" :: Text)]+            , object ["id" .= repository, "sha" .= ("abc" :: Text)]+            , object ["id" .= repository, "siblings" .= [object ["rfilename" .= ("../weights" :: Text)]]]+            , object ["id" .= repository, "pipeline_tag" .= ("" :: Text)]+            ]+        assertBool "invalid account accepted" $+            isLeft (eitherDecode "{\"name\":\"owner/name\"}" :: Either String UserInfo)+    , testCase "commit SHAs normalize and become revisions without reparsing" $ do+        sha <- expectRight (parseCommitSha "0123456789ABCDEF0123456789ABCDEF01234567")+        commitShaText sha @?= "0123456789abcdef0123456789abcdef01234567"+        revisionText (commitRevision sha) @?= commitShaText sha+        eitherDecode (encode sha) @?= Right sha+        mapM_ (\raw -> assertBool "malformed SHA parsed" (isLeft (parseCommitSha raw)))+            ["", "abc", T.replicate 40 "g", T.replicate 39 "a", T.replicate 41 "a"]+    , testCase "all router policies and named providers retain their structure" $ do+        provider <- expectRight (parseProvider "together")+        let targets = modelFromRepo repository : map (routeModel repository) [Fastest, Cheapest, Preferred, Via provider]+        mapM_ (\target -> do+            modelRepository target @?= repository+            parseInferenceModel (inferenceModelText target) @?= Right target+            eitherDecode (encode target) @?= Right target) targets+        map modelRouting targets @?= [Nothing, Just Fastest, Just Cheapest, Just Preferred, Just (Via provider)]+        assertBool "policy accepted as provider" (isLeft (parseProvider "fastest"))+        mapM_ (\raw -> assertBool "malformed model parsed" (isLeft (parseInferenceModel raw)))+            ["", " ", "owner/model:", ":fastest", "owner/model:fastest:cheapest", "owner/model:bad provider", "owner/model:provider/path"]+    , testCase "parsed paths and revisions retain escaped and Unicode content" $ do+        let path = valid (parseRepoPath "λ/a %20.json")+            revision = valid (parseRevision "refs/pr/42")+        eitherDecode (encode path) @?= Right path+        eitherDecode (encode revision) @?= Right revision+    , testCase "open namespaces retain future server values" $ do+        info <- expectRight (eitherDecode "{\"id\":\"owner/model\",\"tags\":[\"license:future-1.0\"],\"pipeline_tag\":\"future-task\",\"library_name\":\"future-library\",\"sdk\":\"future-sdk\"}" :: Either String RepoInfo)+        map hubTagText (repoTags info) @?= ["license:future-1.0"]+        fmap pipelineTagText (repoPipelineTag info) @?= Just "future-task"+        fmap libraryNameText (repoLibraryName info) @?= Just "future-library"+        fmap spaceSdkText (repoSdk info) @?= Just "future-sdk"+        response <- expectRight (eitherDecode "{\"id\":\"provider:completion:1\",\"model\":\"provider/deployment/model-v2\",\"choices\":[{\"index\":0,\"message\":{\"role\":\"future_role\"},\"finish_reason\":\"future_reason\"}]}" :: Either String ChatCompletion)+        completionIdText (completionId response) @?= "provider:completion:1"+        modelNameText (completionModel response) @?= "provider/deployment/model-v2"+        map (chatRoleText . messageRole . choiceMessage) (completionChoices response) @?= ["future_role"]+        map (fmap finishReasonText . choiceFinishReason) (completionChoices response) @?= [Just "future_reason"]+    , testCase "message identifiers parse on input and retain their JSON shape" $ do+        call <- expectRight (parseToolCallId "call-1")+        name <- expectRight (parseParticipantName "search_tool")+        let message = ChatMessage toolRole (Just (String "result")) Nothing (Just call) (Just name)+        toJSON message @?= object ["role" .= ("tool" :: Text), "content" .= ("result" :: Text), "tool_call_id" .= ("call-1" :: Text), "name" .= ("search_tool" :: Text)]+        eitherDecode (encode message) @?= Right message+        mapM_ (\raw -> do+            participant <- expectRight (parseParticipantName raw)+            eitherDecode (encode participant) @?= Right participant)+            ["Zoë Reviewer", T.replicate 128 "x"]+        mapM_ (\payload -> assertBool "invalid message identifier accepted" $+            isLeft (eitherDecode payload :: Either String ChatMessage))+            ["{\"role\":\"\"}", "{\"role\":\"tool\",\"tool_call_id\":\"\"}", "{\"role\":\"user\",\"name\":\"\"}"]+    , testCase "numeric constraints produce usable types at construction" $ do+        positiveIntValue <$> mkPositiveInt 1 @?= Right 1+        mapM_ (\n -> assertBool "nonpositive count parsed" (isLeft (mkPositiveInt n))) [minBound, -1, 0]+        mapM_ (\n -> assertBool "invalid temperature parsed" (isLeft (mkChatTemperature n))) [-0.1, 2.1, 0/0, 1/0, -1/0]+        mapM_ (\n -> assertBool "invalid top_p parsed" (isLeft (mkTopP n))) [0, -1, 1.1, 0/0, 1/0]+        mapM_ (\n -> assertBool "invalid generation temperature parsed" (isLeft (mkGenerationTemperature n))) [0, -1, 0/0, 1/0]+        mapM_ (\n -> chatTemperatureValue <$> mkChatTemperature n @?= Right n) [0, 2]+        topPValue <$> mkTopP 1 @?= Right 1+        generationTemperatureValue <$> mkGenerationTemperature 3 @?= Right 3+        assertBool "numeric JSON bypassed smart constructor" (isLeft (eitherDecode "0" :: Either String PositiveInt))+        eitherDecode (encode (valid (mkTopP 0.7))) @?= Right (valid (mkTopP 0.7))+    , testCase "endpoint parser retains a renderable origin and hides bad credentials" $ do+        mapM_ (\raw -> do+            endpoint <- expectRight (parseEndpoint raw)+            parseEndpoint (endpointText endpoint) @?= Right endpoint)+            ["https://huggingface.co", "https://router.huggingface.co/", "https://example.com:1", "https://example.com:65535", "http://localhost:8080", "http://127.0.0.1:8000", "http://[::1]:8000"]+        parseEndpoint (endpointText defaultHubEndpoint) @?= Right defaultHubEndpoint+        parseEndpoint (endpointText defaultInferenceEndpoint) @?= Right defaultInferenceEndpoint+        assertBool "parser echoed credentials" (not ("SECRET" `isInfixOf` show (parseEndpoint "https://user:SECRET@example.com")))+    ]++grammarTests :: TestTree+grammarTests = testGroup "Parsec grammars"+    [ testCase "Hub names handle punctuation and the exact length boundary" $ do+        mapM_ (\raw -> fmap repoNameText (parseRepoName raw) @?= Right raw)+            ["a", "_", "a_b", "a-b.c", "a-.b", "model.gitx", "model.git-more", T.replicate 96 "x"]+        mapM_ (\raw -> assertBool "malformed name parsed" (isLeft (parseRepoName raw)))+            [".a", "a.", "a-", "a..b", "a--b", "model.git", T.replicate 97 "x", "owner/name", "model:fastest"]+        assertBool "invalid owner suffix parsed" (isLeft (parseRepoId "owner.git/model"))+        assertBool "oversized owner parsed" (isLeft (parseRepoId (T.replicate 97 "x" <> "/model")))+    , testCase "routing policy prefixes do not consume provider slugs" $ do+        mapM_ (\raw -> do+            target <- expectRight (parseInferenceModel ("owner/model:" <> raw))+            case modelRouting target of+                Just (Via provider) -> providerText provider @?= raw+                other -> assertFailure (show other))+            ["fastest-provider", "cheapest-provider", "preferred-provider"]+        mapM_ (\raw -> assertBool "trailing input parsed" (isLeft (parseInferenceModel raw)))+            ["owner/model:fastest/extra", "owner/model:fastest:extra", "owner/model.git:fastest", "owner/model/extra:fastest", "owner/model:fastest\n"]+    , testCase "tokens and complete identifiers reject trailing input" $ do+        assertBool "token prefix accepted" (isLeft (parseToken "hf_secret!"))+        assertBool "SHA prefix accepted" (isLeft (parseCommitSha (T.replicate 40 "a" <> "extra")))+        mapM_ (\raw -> assertBool "repository prefix accepted" (isLeft (parseRepoId raw)))+            ["owner/model?key=value", "owner/model\n", "owner/model trailing"]+    , testCase "component parsing preserves non-BMP text and excludes traversal" $ do+        let raw = "🦄/λ weights/文件.json"+        fmap repoPathText (parseRepoPath raw) @?= Right raw+        fmap revisionText (parseRevision raw) @?= Right raw+        mapM_ (\bad -> assertBool "bad segment accepted" (isLeft (parseRepoPath bad)))+            ["🦄/../file", "🦄/./file", "🦄//file", "🦄/file\r\n"]+    , testCase "open label grammars preserve spaces without accepting blank input" $ do+        fmap participantNameText (parseParticipantName "  Zoë Reviewer 🦄  ") @?= Right "  Zoë Reviewer 🦄  "+        mapM_ (\raw -> assertBool "blank label parsed" (isLeft (parseHubTag raw))) ["", " ", "\x2003", "abc\NUL"]+        fmap completionIdText (parseCompletionId "") @?= Right ""+        assertBool "blank nonempty completion ID parsed" (isLeft (parseCompletionId " "))+    , testCase "origin grammar consumes only a complete origin" $ do+        fmap endpointText (parseEndpoint "https://example.com:000443/") @?= Right "https://example.com/"+        mapM_ (\raw -> assertBool "non-origin parsed" (isLeft (parseEndpoint raw)))+            [ "https://example.com//", "https://example.com/?secret=1", "https://example.com/#fragment"+            , "https://example.com:443garbage", "https://example.com:443:80"+            , "https://[::1", "https://[not-an-ip]", "http://localhost.evil.example"+            , "https://example.com\n", "https://example.com@other.example"+            ]+    , testProperty "routed repository components render and reparse" $+        forAll (listOf1 (elements ['a' .. 'z'])) $ \suffix ->+            let raw = "owner/model-" <> T.pack (take 40 suffix) <> ":fastest-provider"+            in fmap inferenceModelText (parseInferenceModel raw) === Right raw+    ]++hubTests :: TestTree+hubTests = testGroup "Hub API"+    [ testCase "lists models with encoded query parameters and authentication" $+        withFixture (jsonReply ("[" <> repoJSON <> "]")) $ \client seen -> do+            page <- runHuggingFaceM (listModels client defaultListOptions+                { listSearch = Just "hello & λ", listAuthor = Just (valid (parseAccountName "owner")), listFilter = map (valid . parseHubTag) ["text-generation", "pytorch"], listLimit = Just (valid (mkPositiveInt 2)), listFull = True })+                >>= expectRight+            map repoId (pageItems page) @?= [repository]+            requests <- seen+            case requests of+                [request] -> do+                    observedPath request @?= "/api/models"+                    observedMethod request @?= methodGet+                    lookup hAuthorization (observedHeaders request) @?= Just "Bearer hf_test_token"+                    sort (observedQuery request) @?= sort+                        [("search", Just "hello & \206\187"), ("author", Just "owner"), ("filter", Just "text-generation"), ("filter", Just "pytorch"), ("limit", Just "2"), ("full", Just "true")]+                _ -> assertFailure (show requests)+    , testCase "lists datasets and Spaces" $ withFixture (jsonReply "[]") $ \client seen -> do+        _ <- runHuggingFaceM (listDatasets client defaultListOptions) >>= expectRight+        _ <- runHuggingFaceM (listSpaces client defaultListOptions) >>= expectRight+        map observedPath <$> seen >>= (@?= ["/api/datasets", "/api/spaces"])+    , testCase "metadata routes preserve slash-containing revisions" $ withFixture (jsonReply repoJSON) $ \client seen -> do+        let revision = Just (valid (parseRevision "refs/pr/42"))+        model <- runHuggingFaceM (modelInfo client repository revision) >>= expectRight+        repoSha model @?= Just (valid (parseCommitSha "0123456789abcdef0123456789abcdef01234567"))+        repoDownloads model @?= Just 42+        repoSiblings model @?= [RepoFile (valid (parseRepoPath "config.json")) (Just 17)]+        KM.lookup "futureField" (repoRaw model) @?= Just (Bool True)+        _ <- runHuggingFaceM (datasetInfo client repository Nothing) >>= expectRight+        _ <- runHuggingFaceM (spaceInfo client repository Nothing) >>= expectRight+        map observedPath <$> seen >>= (@?= ["/api/models/owner/model/revision/refs%2Fpr%2F42", "/api/datasets/owner/model", "/api/spaces/owner/model"])+    , testCase "metadata tolerates absent and null optional fields" $ do+        info <- expectRight (eitherDecode "{\"id\":\"owner/model\",\"tags\":null,\"siblings\":null}" :: Either String RepoInfo)+        repoTags info @?= []+        repoSiblings info @?= []+        repoPrivate info @?= Nothing+    , testCase "metadata identifiers feed subsequent requests without parsing" $+        withServer (\request -> pure $ if "/api/" `BS.isPrefixOf` observedPath request+            then jsonReply repoJSON else (status200, [], "content")) $ \port seen -> do+                client <- clientAt port Nothing+                info <- runHuggingFaceM (modelInfo client repository Nothing) >>= expectRight+                case (repoSha info, repoSiblings info) of+                    (Just sha, file : _) -> do+                        runHuggingFaceM (downloadFile client Model (repoId info) (commitRevision sha) (fileName file)) >>= (@?= Right "content")+                        let target = routeModel (repoId info) Fastest+                        modelRepository target @?= repoId info+                    _ -> assertFailure "fixture must include a commit and file"+                map observedPath <$> seen >>= (@?=+                    ["/api/models/owner/model", "/owner/model/resolve/0123456789abcdef0123456789abcdef01234567/config.json"])+    , testCase "whoami uses authenticated identity endpoint" $ withFixture (jsonReply "{\"name\":\"emilypi\",\"fullname\":\"Emily\"}") $ \client seen -> do+        user <- runHuggingFaceM (whoAmI client) >>= expectRight+        userName user @?= valid (parseAccountName "emilypi")+        map observedPath <$> seen >>= (@?= ["/api/whoami-v2"])+    , testCase "public requests omit Authorization" $ withServer (const (pure (jsonReply "[]"))) $ \port seen -> do+        client <- clientAt port Nothing+        _ <- runHuggingFaceM (listModels client defaultListOptions) >>= expectRight+        map (lookup hAuthorization . observedHeaders) <$> seen >>= (@?= [Nothing])+    , testCase "Link pagination handles commas, quoted parameters and relative URLs" $+        withServer (\request -> pure $ if null (observedQuery request)+            then (status200, [("link", "</api/models?cursor=a,b>; title=\"one,two\"; rel=\"next last\", </api/models?cursor=old>; rel=\"prev\"")], "[]")+            else jsonReply ("[" <> repoJSON <> "]")) $ \port seen -> do+                client <- clientAt port (Just token)+                first <- runHuggingFaceM (listModels client defaultListOptions) >>= expectRight+                case pageNext first of+                    Nothing -> assertFailure "missing continuation"+                    Just next -> do+                        second <- runHuggingFaceM (nextPage client next) >>= expectRight+                        map repoId (pageItems second) @?= [repository]+                        pageNext second @?= Nothing+                map observedQuery <$> seen >>= (@?= [[], [("cursor", Just "a,b")]])+    , testCase "cross-origin continuations are rejected" $+        withFixture (status200, [("link", "<https://example.invalid/api/models?cursor=x>; rel=next")], "[]") $ \client seen -> do+            first <- runHuggingFaceM (listModels client defaultListOptions) >>= expectRight+            case pageNext first of+                Just next -> (runHuggingFaceM (nextPage client next) :: IO (Either HuggingFaceError (Page RepoInfo))) >>= (@?= Left InvalidPagination)+                Nothing -> assertFailure "missing continuation"+            length <$> seen >>= (@?= 1)+    , testCase "Link parameters accept HTTP whitespace around names and values" $+        withFixture (status200, [("link", "</api/models?cursor=x>;\trel\t=\t\"next\"\t")], "[]") $ \client seen -> do+            first <- runHuggingFaceM (listModels client defaultListOptions) >>= expectRight+            case pageNext first of+                Nothing -> assertFailure "missing tab-separated continuation"+                Just next -> do+                    second <- runHuggingFaceM (nextPage client next) :: IO (Either HuggingFaceError (Page RepoInfo))+                    _ <- expectRight second+                    map observedQuery <$> seen >>= (@?= [[], [("cursor", Just "x")]])+    , testCase "quoted Link extensions keep escaped quotes and delimiters inside values" $+        withFixture (status200, [("link", "</api/models?cursor=a,b>; title=\"one\\\",two;three\"; rel=\"next last\"")], "[]") $ \client seen -> do+            first <- runHuggingFaceM (listModels client defaultListOptions) >>= expectRight+            case pageNext first of+                Nothing -> assertFailure "missing quoted continuation"+                Just next -> do+                    second <- runHuggingFaceM (nextPage client next) :: IO (Either HuggingFaceError (Page RepoInfo))+                    _ <- expectRight second+                    map observedQuery <$> seen >>= (@?= [[], [("cursor", Just "a,b")]])+    , testCase "HTTP list grammar ignores empty Link members" $+        withFixture (status200, [("link", " , , </api/models?cursor=x>; rel=next, , ")], "[]") $ \client seen -> do+            first <- runHuggingFaceM (listModels client defaultListOptions) >>= expectRight+            case pageNext first of+                Nothing -> assertFailure "missing continuation between empty members"+                Just next -> do+                    second <- runHuggingFaceM (nextPage client next) :: IO (Either HuggingFaceError (Page RepoInfo))+                    _ <- expectRight second+                    map observedQuery <$> seen >>= (@?= [[], [("cursor", Just "x")]])+    , testGroup "Link grammar cannot mistake extensions or malformed input for next"+        [ testCase (show header) $ withFixture (status200, [("link", header)], "[]") $ \client _ -> do+            page <- runHuggingFaceM (listModels client defaultListOptions) >>= expectRight+            pageNext page @?= Nothing+        | header <- [ "</api/models?cursor=x>; title=\"ignore; rel=next\"; rel=prev"+                    , "</api/models?cursor=x>; rel=prev; rel=next"+                    , "</api/models?cursor=x>; rel=\"next\" garbage"+                    , "</api/models?cursor=x>; rel=\"next"+                    , "</api/models?cursor=x; rel=next"+                    ] ]+    , testCase "relative pagination uses the final redirected URL" $+        withServer (\request -> pure $ case observedPath request of+            "/api/models" -> (status302, [(hLocation, "/relocated/models")], "")+            "/relocated/models" | null (observedQuery request) -> (status200, [("link", "<?cursor=next>; rel=next")], "[]")+            "/relocated/models" -> jsonReply ("[" <> repoJSON <> "]")+            _ -> (status404, [], "")) $ \port seen -> do+                client <- clientAt port Nothing+                page <- runHuggingFaceM (listModels client defaultListOptions) >>= expectRight+                case pageNext page of+                    Nothing -> assertFailure "missing continuation"+                    Just next -> do+                        result <- runHuggingFaceM (nextPage client next) >>= expectRight+                        map repoId (pageItems result) @?= [repository]+                map observedPath <$> seen >>= (@?= ["/api/models", "/relocated/models", "/relocated/models"])+    , testCase "downloads encode file names and repository prefixes" $ withFixture (jsonReply "bytes") $ \client seen -> do+        let revision = valid (parseRevision "branch/name")+            file = valid (parseRepoPath "sub/λ weights?.json")+        mapM_ (\kind -> runHuggingFaceM (downloadFile client kind repository revision file) >>= (@?= Right "bytes")) [Model, Dataset, Space]+        map (lookup hAccept . observedHeaders) <$> seen >>= (@?= replicate 3 (Just "*/*"))+        map observedPath <$> seen >>= (@?=+            [ "/owner/model/resolve/branch%2Fname/sub/%CE%BB%20weights%3F.json"+            , "/datasets/owner/model/resolve/branch%2Fname/sub/%CE%BB%20weights%3F.json"+            , "/spaces/owner/model/resolve/branch%2Fname/sub/%CE%BB%20weights%3F.json" ])+    ]++transportTests :: TestTree+transportTests = testGroup "Transport"+    [ testGroup "HTTP errors"+        [ testCase (show code) $ withFixture (mkStatus code "error", [("x-request-id", "request-42"), ("retry-after", "7")], "{\"error\":\"hf_test_token\"}") $ \client seen -> do+            result <- runHuggingFaceM (modelInfo client repository Nothing)+            case result of+                Left err@HttpError{} -> do+                    errorStatus err @?= code+                    errorRequestId err @?= Just "request-42"+                    errorRetryAfter err @?= Just "7"+                    assertBool "error body lost" ("hf_test_token" `BS.isInfixOf` errorBody err)+                    assertBool "error display leaked token" (not ("hf_test_token" `isInfixOf` show err))+                _ -> assertFailure (show result)+            length <$> seen >>= (@?= 1)+        | code <- [401, 403, 404, 429, 500, 503] ]+    , testCase "error bodies are bounded" $ withFixture (status500, [], BL.replicate 100000 120) $ \client _ -> do+        result <- runHuggingFaceM (modelInfo client repository Nothing)+        case result of+            Left err@HttpError{} -> BS.length (errorBody err) @?= 65536+            _ -> assertFailure (show result)+    , testGroup "JSON errors"+        [ testCase (B8.unpack (BL.toStrict payload)) $ withFixture (jsonReply payload) $ \client _ ->+            runHuggingFaceM (modelInfo client repository Nothing) >>= (@?= Left DecodeError)+        | payload <- ["<html>error</html>", "{\"not_id\":true}", "{\"id\":3}"] ]+    , testCase "same-origin GET redirects retain token" $+        withServer (\request -> pure $ if observedPath request == "/api/models/owner/model"+            then (status302, [(hLocation, "/canonical")], "") else jsonReply repoJSON) $ \port seen -> do+                client <- clientAt port (Just token)+                _ <- runHuggingFaceM (modelInfo client repository Nothing) >>= expectRight+                map (lookup hAuthorization . observedHeaders) <$> seen >>= (@?= replicate 2 (Just "Bearer hf_test_token"))+    , testCase "API redirects cannot cross origins" $ withFixture (status302, [(hLocation, "https://example.invalid/data")], "") $ \client _ ->+        runHuggingFaceM (modelInfo client repository Nothing) >>= (@?= Left UnsafeRedirect)+    , testCase "redirect loops terminate" $ withFixture (status302, [(hLocation, "/loop")], "") $ \client seen -> do+        runHuggingFaceM (modelInfo client repository Nothing) >>= (@?= Left TooManyRedirects)+        length <$> seen >>= (@?= 6)+    , testCase "download redirects remove credentials across ports" $+        withServer (const (pure (jsonReply "download"))) $ \cdnPort cdnSeen ->+            withFixture (status302, [(hLocation, encodeUtf8 (origin cdnPort <> "/blob"))], "") $ \client _ -> do+                runHuggingFaceM (downloadFile client Model repository mainRevision (valid (parseRepoPath "weights.bin"))) >>= (@?= Right "download")+                map (lookup hAuthorization . observedHeaders) <$> cdnSeen >>= (@?= [Nothing])+    , testCase "download callbacks can stop early and subsequent requests work" $ withFixture (jsonReply "payload") $ \client _ -> do+        result <- runHuggingFaceM (withDownload client Model repository mainRevision (valid (parseRepoPath "file")) (liftIO . brRead))+        result @?= Right "payload"+        result2 <- runHuggingFaceM (withDownload client Model repository mainRevision (valid (parseRepoPath "file")) (const (pure ())))+        result2 @?= Right ()+    , testCase "callback exceptions and asynchronous cancellation propagate" $ withFixture (jsonReply "payload") $ \client _ -> do+        ioResult <- try (runHuggingFaceM (withDownload client Model repository mainRevision (valid (parseRepoPath "file")) (const (liftIO (ioError (userError "callback")))))) :: IO (Either IOException (Either HuggingFaceError ()))+        assertBool "swallowed callback exception" (isLeft ioResult)+        asyncResult <- try (runHuggingFaceM (withDownload client Model repository mainRevision (valid (parseRepoPath "file")) (const (liftIO (throwIO UserInterrupt))))) :: IO (Either AsyncException (Either HuggingFaceError ()))+        asyncResult @?= Left UserInterrupt+    ]++inferenceTests :: TestTree+inferenceTests = testGroup "Hosted inference"+    [ testCase "chat request, extensions, and typed response" $ withFixture (jsonReply chatJSON) $ \client seen -> do+        let request = (defaultChatRequest (routeModel repository Fastest) (systemMessage "Be concise" :| [userMessage "Hi"]))+                { chatMaxTokens = Just (valid (mkPositiveInt 20)), chatTemperature = Just (valid (mkChatTemperature 0.2))+                , chatExtra = KM.fromList [("stream", Bool True), ("model", String "wrong"), ("seed", Number 42)] }+        response <- runHuggingFaceM (chatCompletion client request) >>= expectRight+        completionUsage response @?= Just (Usage 2 3 5)+        map (messageContent . choiceMessage) (completionChoices response) @?= [Just (String "Hello!")]+        requests <- seen+        case requests of+            [sent] -> do+                observedPath sent @?= "/v1/chat/completions"+                observedMethod sent @?= methodPost+                lookup hContentType (observedHeaders sent) @?= Just "application/json"+                payload <- expectRight (eitherDecode (observedBody sent) :: Either String Object)+                KM.lookup "model" payload @?= Just (String "owner/model:fastest")+                KM.lookup "stream" payload @?= Just (Bool False)+                KM.lookup "seed" payload @?= Just (Number 42)+                KM.lookup "max_tokens" payload @?= Just (Number 20)+                KM.member "top_p" payload @?= False+            _ -> assertFailure (show requests)+    , testCase "tool-call messages allow absent content" $ do+        let payload = "{\"role\":\"assistant\",\"content\":null,\"tool_calls\":[{\"id\":\"call-1\"}]}"+        message <- expectRight (eitherDecode payload :: Either String ChatMessage)+        messageContent message @?= Nothing+        assertBool "lost tool calls" (messageToolCalls message /= Nothing)+        eitherDecode (encode message) @?= Right message+    , testCase "successful TGI chat responses can have an empty completion ID" $+        withFixture (jsonReply "{\"id\":\"\",\"model\":\"tgi\",\"choices\":[]}") $ \client _ -> do+            response <- runHuggingFaceM (chatCompletion client (defaultChatRequest (modelFromRepo repository) (userMessage "Hi" :| []))) >>= expectRight+            completionIdText (completionId response) @?= ""+    , testCase "chat redirects are returned without replaying POST" $ withFixture (status307, [(hLocation, "/other")], "") $ \client seen -> do+        response <- runHuggingFaceM (chatCompletion client (defaultChatRequest (modelFromRepo repository) (userMessage "Hi" :| [])))+        case response of Left err@HttpError{} -> errorStatus err @?= 307; _ -> assertFailure (show response)+        length <$> seen >>= (@?= 1)+    , testCase "lost response on a reused connection does not replay a billed POST" $ do+        calls <- newIORef (0 :: Int)+        let app request respond+                | Wai.requestMethod request == methodGet = respond (Wai.responseLBS status200 [] "[]")+                | otherwise = do+                    _ <- Wai.strictRequestBody request+                    atomicModifyIORef' calls (\n -> (n + 1, ()))+                    -- Drop the connection after receiving the POST, before any+                    -- response headers. A default http-client manager retries it.+                    respond (Wai.responseRaw (\_ _ -> pure ()) (Wai.responseLBS status500 [] ""))+        testWithApplication (pure app) $ \port -> do+            client <- newClient defaultClientConfig {hubEndpoint = endpointAt port, inferenceEndpoint = endpointAt port}+            _ <- runHuggingFaceM (listModels client defaultListOptions) >>= expectRight+            result <- runHuggingFaceM (chatCompletion client (defaultChatRequest (modelFromRepo repository) (userMessage "Hi" :| [])))+            case result of+                Left (TransportError _) -> pure ()+                _ -> assertFailure (show result)+            readIORef calls >>= (@?= 1)+    , testCase "feature extraction uses explicit task route and batch" $ withFixture (jsonReply "[[0.1,0.2],[0.3,0.4]]") $ \client seen -> do+        runHuggingFaceM (featureExtraction client repository ("one" :| ["two"])) >>= (@?= Right [[0.1,0.2],[0.3,0.4]])+        requests <- seen+        case requests of+            [request] -> do+                observedPath request @?= "/hf-inference/models/owner/model/pipeline/feature-extraction"+                eitherDecode (observedBody request) @?= Right (object ["inputs" .= (["one", "two"] :: [Text])])+            _ -> assertFailure (show requests)+    , testGroup "generation response shapes"+        [ testCase (show index) $ withFixture (jsonReply payload) $ \client seen -> do+            runHuggingFaceM (textGeneration client repository "Hello" defaultGenerationParameters {generationMaxNewTokens = Just (valid (mkPositiveInt 4))}) >>= (@?= Right [GeneratedText "world" Nothing])+            requests <- seen+            case requests of+                [request] -> do+                    observedPath request @?= "/hf-inference/models/owner/model"+                    eitherDecode (observedBody request) @?= Right (object ["inputs" .= ("Hello" :: Text), "parameters" .= object ["max_new_tokens" .= (4 :: Int)], "stream" .= False])+                _ -> assertFailure (show requests)+        | (index, payload) <- zip [1 :: Int ..] ["[{\"generated_text\":\"world\"}]", "{\"generated_text\":\"world\"}"] ]+    , testGroup "classification response shapes"+        [ testCase (show index) $ withFixture (jsonReply payload) $ \client _ ->+            runHuggingFaceM (classifyText client repository "great") >>= (@?= Right [Classification "POSITIVE" 0.9])+        | (index, payload) <- zip [1 :: Int ..] ["[{\"label\":\"POSITIVE\",\"score\":0.9}]", "[[{\"label\":\"POSITIVE\",\"score\":0.9}]]"] ]+    , testCase "generic inference preserves custom JSON" $ withFixture (jsonReply "{\"answer\":42}") $ \client _ -> do+        result <- runHuggingFaceM (infer client repository (object ["inputs" .= ("custom task" :: Text)])) :: IO (Either HuggingFaceError Value)+        result @?= Right (object ["answer" .= (42 :: Int)])+    ]