packages feed

shomei-client (empty) → 0.3.0.0

raw patch · 5 files changed

+713/−0 lines, 5 filesdep +basedep +base64dep +bytestring

Dependencies added: base, base64, bytestring, http-api-data, http-client, http-client-tls, http-types, servant, servant-client, servant-client-core, servant-health, shomei-client, shomei-core, shomei-jwt, shomei-migrations, shomei-postgres, shomei-servant, shomei-server, tasty, tasty-hunit, text, warp

Files

+ CHANGELOG.md view
@@ -0,0 +1,28 @@+# Changelog for shomei-client++All notable changes to `shomei-client` are documented here. This package adheres to the+[PVP](https://pvp.haskell.org/) and is versioned independently of the other+Shōmei packages.++## 0.3.0.0 — 2026-11-05++- **Breaking:** internal dependency bounds follow the 0.3 API series; migration dependencies require `shomei-migrations ^>=0.2.0.1`.+- First Hackage publication; earlier version sections describe repository development milestones.++- **Breaking:** `adminListSessions` takes optional limit/cursor parameters and returns the bounded session page.++## 0.2.0.0 — 2026-08-27++Not yet published to Hackage: the library itself resolves cleanly, but its+test-suite depends on `shomei-server`, which is blocked on a Hackage release+of `webauthn` compatible with GHC 9.12.4 and `jose 0.13`. This package ships+alongside `shomei-server`.++Initial release contents:++- Bearer `Token` values render as `Token <redacted>` so assertion failures and diagnostic output+  cannot disclose the credential.+- A typed Haskell client derived from the same `ShomeiAPI` definition that+  `shomei-servant` serves, so client and server cannot drift apart.+- Connection management and token handling for calling a standalone+  `shomei-server` from another service.
+ LICENSE view
@@ -0,0 +1,21 @@+MIT License++Copyright (c) 2026 Nadeem Bitar++Permission is hereby granted, free of charge, to any person obtaining a copy+of this software and associated documentation files (the "Software"), to deal+in the Software without restriction, including without limitation the rights+to use, copy, modify, merge, publish, distribute, sublicense, and/or sell+copies of the Software, and to permit persons to whom the Software is+furnished to do so, subject to the following conditions:++The above copyright notice and this permission notice shall be included in all+copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,+FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE+AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER+LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,+OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE+SOFTWARE.
+ shomei-client.cabal view
@@ -0,0 +1,98 @@+cabal-version: 3.0+name: shomei-client+version: 0.3.0.0+synopsis: Haskell client for the standalone Shōmei auth service+description:+  A typed Haskell client derived from the same ShomeiAPI definition that+  shomei-servant serves, so the client and the server cannot drift apart.+  Wraps the generated servant-client functions in a small record with+  connection management and token handling for calling a standalone+  shomei-server from another service.++homepage: https://github.com/shinzui/shomei+bug-reports: https://github.com/shinzui/shomei/issues+license: MIT+license-file: LICENSE+author: Nadeem Bitar+maintainer: nadeem@gmail.com+copyright: 2026 Nadeem Bitar+category: Web, Security+tested-with: ghc ==9.12.4+extra-doc-files: CHANGELOG.md++source-repository head+  type: git+  location: https://github.com/shinzui/shomei.git++common warnings+  ghc-options:+    -Wall+    -Wcompat+    -Widentities+    -Wincomplete-record-updates+    -Wincomplete-uni-patterns+    -Wpartial-fields+    -Wredundant-constraints++common shared+  default-language: GHC2024+  default-extensions:+    BlockArguments+    DataKinds+    DeriveAnyClass+    DuplicateRecordFields+    MultilineStrings+    OverloadedLabels+    OverloadedRecordDot+    OverloadedStrings+    QualifiedDo+    TemplateHaskell+    TypeFamilies++library+  import: warnings, shared+  hs-source-dirs: src+  exposed-modules: Shomei.Client+  build-depends:+    base >=4.18 && <5,+    base64 >=1.0 && <1.1,+    bytestring >=0.11 && <0.13,+    http-api-data >=0.6 && <0.8,+    http-client >=0.7 && <0.8,+    http-client-tls >=0.3 && <0.5,+    servant >=0.20.3 && <0.21,+    servant-client >=0.20.3 && <0.21,+    servant-client-core >=0.20.3 && <0.21,+    servant-health >=0.1 && <0.2,+    shomei-core ^>=0.3.0.0,+    shomei-servant ^>=0.3.0.0,+    text >=2.0 && <2.2,++test-suite shomei-client-test+  import: warnings, shared+  type: exitcode-stdio-1.0+  hs-source-dirs: test+  main-is: Main.hs+  ghc-options:+    -threaded+    -rtsopts+    -with-rtsopts=-N++  build-depends:+    base >=4.18 && <5,+    bytestring >=0.11 && <0.13,+    http-client >=0.7 && <0.8,+    http-types >=0.12 && <0.13,+    servant-client >=0.20.3 && <0.21,+    servant-health >=0.1 && <0.2,+    shomei-client ^>=0.3.0.0,+    shomei-core ^>=0.3.0.0,+    shomei-jwt ^>=0.3.0.0,+    shomei-migrations:test-support ^>=0.2.0.1,+    shomei-postgres ^>=0.3.0.0,+    shomei-servant ^>=0.3.0.0,+    shomei-server ^>=0.3.0.0,+    tasty >=1.4 && <1.6,+    tasty-hunit >=0.10 && <0.11,+    text >=2.0 && <2.2,+    warp >=3.3 && <3.5,
+ src/Shomei/Client.hs view
@@ -0,0 +1,428 @@+-- The 'HasClient' instances for 'RequireRole'/'RequireScope' delegate their associated+-- @Client@ type to the @AuthProtect "shomei-jwt"@ instance, which GHC cannot see is+-- terminating (the right-hand side is another application of the same family).+{-# LANGUAGE UndecidableInstances #-}+-- The @AuthClientData@ instance below is an unavoidable orphan (both the type family and+-- @AuthProtect "shomei-jwt"@ belong to servant; 'Token' belongs here) — the standard+-- servant generalized-auth client pattern. The two 'HasClient' instances are orphans for the+-- same reason. Silence the orphan warning for this module.+{-# OPTIONS_GHC -Wno-orphans #-}++-- | A typed Haskell client for the standalone Shōmei auth service.+--+-- The client functions are not hand-written: they are /derived/ from the exact same+-- 'Shomei.Servant.Api.ShomeiAPI' Servant type the server serves, via @servant-client@'s+-- 'genericClient'. So the client and server can never disagree about the wire format.+-- The 'Authenticated' (@AuthProtect "shomei-jwt"@) routes take a 'Token' (the Bearer JWT),+-- attached through @servant-client@'s generalized-authentication support+-- ('AuthClientData' + 'mkAuthenticatedRequest').+module Shomei.Client+  ( Token (..),+    ShomeiClient,+    shomeiClient,+    ShomeiRoutesClient,+    shomeiRoutesClient,+    shomeiClientEnv,+    runClient,+    ClientEnv,+    ClientError,+    ApplicationResult (..),+    CookieResponse (..),+    ProblemDetails (..),+    OAuthResult (..),+    TokenSuccess (..),+    signup,+    login,+    refresh,+    logout,+    me,+    session,+    -- passkey enrollment / management (Bearer):+    passkeyRegisterBegin,+    passkeyRegisterComplete,+    listPasskeys,+    deletePasskey,+    -- passkey login / MFA (unauthenticated):+    mfaComplete,+    passkeyLoginBegin,+    passkeyLoginComplete,+    -- machine tokens (OAuth2 client_credentials):+    oauthToken,+    TokenResponse (..),+    -- administration (Bearer; the caller needs the @admin@ role or the @shomei:admin@ scope):+    adminListUsers,+    AdminStatusFilter,+    UserPageCursor,+    adminGetUser,+    adminSuspendUser,+    adminReinstateUser,+    adminDeleteUser,+    adminListSessions,+    SessionPageCursor,+    adminRevokeSessions,+    adminRevokeSession,+    adminPasswordReset,+    adminGrantRole,+    adminRevokeRole,+  )+where++import Data.Base64.Types (extractBase64)+import Data.ByteString.Base64 qualified as B64+import Data.Text qualified as Text+import Data.Text.Encoding qualified as TE+import Network.HTTP.Client qualified as HTTP+import Network.HTTP.Client.TLS qualified as TLS++-- Explicitly, as a /type/: 'Shomei.Prelude' re-exports lens, whose @(:>)@ snoc pattern synonym+-- would otherwise win.+import Servant.API (type (:>))+import Servant.API.Experimental.Auth (AuthProtect)+import Servant.Client+  ( BaseUrl (..),+    ClientEnv,+    ClientError,+    ClientM,+    Scheme (..),+    mkClientEnv,+    parseBaseUrl,+    runClientM,+  )+import Servant.Client.Core+  ( AuthClientData,+    AuthenticatedRequest,+    addHeader,+    mkAuthenticatedRequest,+  )+import Servant.Client.Core.HasClient (AsClientT, HasClient (..))+import Servant.Client.Generic (genericClient)+import Shomei.Account.Admin.Api qualified as AdminAccount+import Shomei.Account.Api qualified as Account+import Shomei.Account.Dto (SignupRequest)+import Shomei.Account.Result+import Shomei.Account.User.Dto (AdminStatusFilter, UserPageCursor)+import Shomei.Authorization.Api qualified as Authorization+import Shomei.Authorization.Result+import Shomei.Id (PasskeyId, SessionId, UserId)+import Shomei.Mfa.Api qualified as Mfa+import Shomei.Mfa.Dto (MfaCompleteRequest)+import Shomei.Mfa.Result+import Shomei.OAuth.Api qualified as OAuthApi+import Shomei.OAuth.Result (OAuthResult (..), TokenResult, TokenSuccess (..))+import Shomei.Passkey.Api qualified as Passkey+import Shomei.Passkey.Dto+  ( PasskeyLoginCompleteRequest,+    PasskeyRegisterCompleteRequest,+  )+import Shomei.Passkey.Result+import Shomei.Prelude+import Shomei.Servant.Api (ApplicationApi, ShomeiRoutes)+import Shomei.Servant.Api qualified as Api+import Shomei.Servant.Auth (Authenticated, OAuthAuthenticated)+import Shomei.Servant.Authz (RequireAdmin, RequirePermission, RequireRole, RequireScope)+import Shomei.Servant.Error (ProblemDetails (..))+import Shomei.Servant.OAuth (TokenResponse (..))+import Shomei.Servant.PreHandler (CsrfProtected, PreHandlerResponses, RateLimited)+import Shomei.Servant.Result (ApplicationResult (..), CookieResponse (..))+import Shomei.Session.Admin.Api qualified as AdminSession+import Shomei.Session.Api qualified as Session+import Shomei.Session.Dto (LoginRequest, RefreshRequest, SessionPageCursor)+import Shomei.Session.Result+import Web.FormUrlEncoded (toForm)++-- | A Bearer access token (the signed JWT the server returned from @\/v1\/auth\/login@).+newtype Token = Token {unToken :: Text}+  deriving stock (Eq)++instance Show Token where+  show _ = "Token <redacted>"++-- | Tell @servant-client@ what credential the @shomei-jwt@ scheme needs client-side.+type instance AuthClientData (AuthProtect "shomei-jwt") = Token++-- | Client-side, Shōmei's authorization combinators are indistinguishable from plain+-- authentication: the caller still presents one Bearer token, and whether the server then finds+-- the required role or scope in it is the server's business (a 403 if not). So both delegate to+-- the @AuthProtect "shomei-jwt"@ instance, and a @RequireRole \"admin\" :> …@ route's client+-- function takes exactly the same @'bearer' tok@ argument an 'Authenticated' one does.+--+-- Without these, 'genericClient' cannot derive 'ShomeiClient' at all — @ShomeiAPI@ now carries a+-- 'RequireRole' on its audit route. They are orphans for the same reason the 'AuthClientData'+-- instance above is: the class belongs to servant, the combinator to @shomei-servant@.+instance (HasClient m api) => HasClient m (RequireRole r :> api) where+  type Client m (RequireRole r :> api) = Client m (AuthProtect "shomei-jwt" :> api)+  clientWithRoute pm _ = clientWithRoute pm (Proxy :: Proxy (AuthProtect "shomei-jwt" :> api))+  hoistClientMonad pm _ = hoistClientMonad pm (Proxy :: Proxy (AuthProtect "shomei-jwt" :> api))++instance (HasClient m api) => HasClient m (RequireScope s :> api) where+  type Client m (RequireScope s :> api) = Client m (AuthProtect "shomei-jwt" :> api)+  clientWithRoute pm _ = clientWithRoute pm (Proxy :: Proxy (AuthProtect "shomei-jwt" :> api))+  hoistClientMonad pm _ = hoistClientMonad pm (Proxy :: Proxy (AuthProtect "shomei-jwt" :> api))++instance (HasClient m api) => HasClient m (RequirePermission p :> api) where+  type Client m (RequirePermission p :> api) = Client m (AuthProtect "shomei-jwt" :> api)+  clientWithRoute pm _ = clientWithRoute pm (Proxy :: Proxy (AuthProtect "shomei-jwt" :> api))+  hoistClientMonad pm _ = hoistClientMonad pm (Proxy :: Proxy (AuthProtect "shomei-jwt" :> api))++instance (HasClient m api) => HasClient m (Authenticated :> api) where+  type Client m (Authenticated :> api) = Client m (AuthProtect "shomei-jwt" :> api)+  clientWithRoute pm _ = clientWithRoute pm (Proxy :: Proxy (AuthProtect "shomei-jwt" :> api))+  hoistClientMonad pm _ = hoistClientMonad pm (Proxy :: Proxy (AuthProtect "shomei-jwt" :> api))++instance (HasClient m api) => HasClient m (OAuthAuthenticated :> api) where+  type Client m (OAuthAuthenticated :> api) = Client m (AuthProtect "shomei-jwt" :> api)+  clientWithRoute pm _ = clientWithRoute pm (Proxy :: Proxy (AuthProtect "shomei-jwt" :> api))+  hoistClientMonad pm _ = hoistClientMonad pm (Proxy :: Proxy (AuthProtect "shomei-jwt" :> api))++instance (HasClient m api) => HasClient m (RequireAdmin :> api) where+  type Client m (RequireAdmin :> api) = Client m (AuthProtect "shomei-jwt" :> api)+  clientWithRoute pm _ = clientWithRoute pm (Proxy :: Proxy (AuthProtect "shomei-jwt" :> api))+  hoistClientMonad pm _ = hoistClientMonad pm (Proxy :: Proxy (AuthProtect "shomei-jwt" :> api))++instance (HasClient m api) => HasClient m (PreHandlerResponses responses :> api) where+  type Client m (PreHandlerResponses responses :> api) = Client m api+  clientWithRoute pm _ = clientWithRoute pm (Proxy :: Proxy api)+  hoistClientMonad pm _ = hoistClientMonad pm (Proxy :: Proxy api)++instance (HasClient m api) => HasClient m (CsrfProtected :> api) where+  type Client m (CsrfProtected :> api) = Client m api+  clientWithRoute pm _ = clientWithRoute pm (Proxy :: Proxy api)+  hoistClientMonad pm _ = hoistClientMonad pm (Proxy :: Proxy api)++instance (HasClient m api) => HasClient m (RateLimited :> api) where+  type Client m (RateLimited :> api) = Client m api+  clientWithRoute pm _ = clientWithRoute pm (Proxy :: Proxy api)+  hoistClientMonad pm _ = hoistClientMonad pm (Proxy :: Proxy api)++-- | Build an 'AuthenticatedRequest' that adds @Authorization: Bearer <jwt>@.+bearer :: Token -> AuthenticatedRequest (AuthProtect "shomei-jwt")+bearer tok =+  mkAuthenticatedRequest tok \(Token jwt) req ->+    addHeader "Authorization" ("Bearer " <> jwt) req++-- | The client for the whole served tree: the @v1@ field carries the application client, and+-- @jwks@\/@health@\/@ready@ reach the unversioned root endpoints.+type ShomeiRoutesClient = ShomeiRoutes (AsClientT ClientM)++shomeiRoutesClient :: ShomeiRoutesClient+shomeiRoutesClient = genericClient++-- | The record of client functions, derived from 'ShomeiAPI' (fields match the API).+type ShomeiClient = ApplicationApi (AsClientT ClientM)++-- | The application client, reached through the @v1@ field of the root client. Each function+-- it contains already carries the @\/v1@ segment, because the segment lives in the route type+-- — so callers keep passing a bare base URL to 'shomeiClientEnv'.+shomeiClient :: ShomeiClient+shomeiClient = Api.application shomeiRoutesClient++accountClient :: Account.AccountApi (AsClientT ClientM)+accountClient = Api.account shomeiClient++sessionClient :: Session.SessionApi (AsClientT ClientM)+sessionClient = Api.session shomeiClient++passkeyClient :: Passkey.PasskeyApi (AsClientT ClientM)+passkeyClient = Api.passkey shomeiClient++mfaClient :: Mfa.MfaApi (AsClientT ClientM)+mfaClient = Api.mfa shomeiClient++adminAccountClient :: AdminAccount.AdminAccountApi (AsClientT ClientM)+adminAccountClient = Api.adminAccount shomeiClient++adminSessionClient :: AdminSession.AdminSessionApi (AsClientT ClientM)+adminSessionClient = Api.adminSession shomeiClient++authorizationClient :: Authorization.AuthorizationApi (AsClientT ClientM)+authorizationClient = Api.authorization shomeiClient++-- | Build a 'ClientEnv' from a base URL string, e.g. @"http:\/\/localhost:8080"@.+shomeiClientEnv :: String -> IO ClientEnv+shomeiClientEnv url = do+  base <- parseBaseUrl url+  mgr <- case baseUrlScheme base of+    Https -> HTTP.newManager TLS.tlsManagerSettings+    Http -> HTTP.newManager HTTP.defaultManagerSettings+  pure (mkClientEnv mgr base)++-- | Run a 'ClientM' action against a 'ClientEnv'.+runClient :: ClientEnv -> ClientM a -> IO (Either ClientError a)+runClient env act = runClientM act env++-- Field functions are reached via qualified selectors (@API.signup shomeiClient@) rather+-- than @OverloadedRecordDot@: a NamedRoutes field type is the @(:-)@ type-family+-- application, which record-dot's @HasField@ cannot see through, but selector application+-- reduces it to the concrete client function.++signup :: ClientEnv -> SignupRequest -> IO (Either ClientError SignupResult)+signup env body = runClient env (Account.signup accountClient body)++-- | Log in with email + password.+--+-- IMPORTANT: the returned 'LoginResponse' is a tagged sum (EP-4). On @status:"complete"@ it+-- carries @user@ + @token@ ('LoginCompleteResponse'). On @status:"mfa_required"@ it carries a+-- @ceremonyId@ and WebAuthn @options@ ('LoginMfaRequiredResponse'): the account has a passkey,+-- so the caller must run @navigator.credentials.get()@ in the browser and call 'mfaComplete'+-- with the @ceremonyId@ and the browser's @assertion@ JSON to obtain tokens. The Haskell+-- signature is unchanged; only the meaning of 'LoginResponse' widened.+login :: ClientEnv -> LoginRequest -> IO (Either ClientError LoginResult)+login env body = runClient env (Session.login sessionClient body)++-- | Rotate a refresh token. This is a bearer-mode client, so the token travels in the body and+-- the cookie/origin headers the route also accepts are left unset.+refresh :: ClientEnv -> RefreshRequest -> IO (Either ClientError RefreshResult)+refresh env body = runClient env (Session.refresh sessionClient Nothing Nothing Nothing body)++-- | Authenticated routes take the 'AuthenticatedRequest' built from the Bearer token.+logout :: ClientEnv -> Token -> IO (Either ClientError LogoutResult)+logout env tok = runClient env (Session.logout sessionClient (bearer tok))++me :: ClientEnv -> Token -> IO (Either ClientError MeResult)+me env tok = runClient env (Account.me accountClient (bearer tok))++session :: ClientEnv -> Token -> IO (Either ClientError CurrentSessionResult)+session env tok = runClient env (Session.currentSession sessionClient (bearer tok))++-- Passkey enrollment / management. These are 'Authenticated' (Bearer) routes, so each takes a+-- 'Token' and attaches it with 'bearer', exactly like 'me'/'session'/'logout'.++-- | Begin enrolling a passkey (authenticated). Returns the ceremony id and the WebAuthn+-- creation @options@ the browser feeds to @navigator.credentials.create()@.+passkeyRegisterBegin ::+  ClientEnv -> Token -> IO (Either ClientError RegisterBeginResult)+passkeyRegisterBegin env tok =+  runClient env (Passkey.registerBegin passkeyClient (bearer tok))++-- | Complete passkey enrollment (authenticated): submit the browser's credential JSON and an+-- optional label. Returns the stored passkey.+passkeyRegisterComplete ::+  ClientEnv -> Token -> PasskeyRegisterCompleteRequest -> IO (Either ClientError RegisterCompleteResult)+passkeyRegisterComplete env tok body =+  runClient env (Passkey.registerComplete passkeyClient (bearer tok) body)++-- | List the caller's enrolled passkeys (authenticated). Never includes public-key bytes.+listPasskeys ::+  ClientEnv -> Token -> IO (Either ClientError ListPasskeysResult)+listPasskeys env tok =+  runClient env (Passkey.list passkeyClient (bearer tok))++-- | Remove one of the caller's passkeys by id (authenticated). 404 if it is not theirs. The+-- 'PasskeyId' can be parsed from a 'PasskeyResponse' \'s @passkeyId@ 'Text' with+-- 'Shomei.Id.parseId'.+deletePasskey ::+  ClientEnv -> Token -> PasskeyId -> IO (Either ClientError RemovePasskeyResult)+deletePasskey env tok pid =+  runClient env (Passkey.remove passkeyClient (bearer tok) pid)++-- Passkey login / MFA. These are unauthenticated (the caller does not yet hold a token), so+-- each takes only its request body and mirrors 'login'/'refresh'.++-- | Complete an MFA step-up: after 'login' returned @status:"mfa_required"@, the browser runs+-- @navigator.credentials.get()@ and this submits the @ceremonyId@ + the @assertion@ JSON.+-- Returns the access/refresh token pair.+mfaComplete ::+  ClientEnv -> MfaCompleteRequest -> IO (Either ClientError MfaCompleteResult)+mfaComplete env body = runClient env (Mfa.complete mfaClient body)++-- | Begin a passwordless passkey login. Returns the ceremony id and the WebAuthn @options@+-- the browser feeds to @navigator.credentials.get()@ (the discoverable-credential picker+-- chooses the account).+passkeyLoginBegin ::+  ClientEnv -> IO (Either ClientError PasskeyLoginBeginResult)+passkeyLoginBegin env = runClient env (Passkey.loginBegin passkeyClient)++-- | Complete a passwordless passkey login: submit the @ceremonyId@ + the browser's+-- @assertion@ JSON. The passkey IS the strong factor, so this returns a token pair directly+-- (never an MFA challenge).+passkeyLoginComplete ::+  ClientEnv -> PasskeyLoginCompleteRequest -> IO (Either ClientError PasskeyLoginCompleteResult)+passkeyLoginComplete env body = runClient env (Passkey.loginComplete passkeyClient body)++-- Administration (EP-2). Every one of these is an 'Authenticated' route whose handler demands+-- the @admin@ role or the @shomei:admin@ scope; a token without either gets a @403@.+--+-- The mutations answer @204@\/@202@ with no body, so their wrappers discard 'NoContent' and+-- return @()@ — exactly as 'logout' and 'deletePasskey' do.++-- | One keyset page of users. @status@ filters (@"active"@ | @"suspended"@ | @"deleted"@),+-- @limit@ defaults to 50 and is clamped to 1000, and @before@ takes the previous page's+-- @nextCursor@.+adminListUsers ::+  ClientEnv -> Token -> Maybe AdminStatusFilter -> Maybe Int -> Maybe UserPageCursor -> IO (Either ClientError ListUsersResult)+adminListUsers env tok status limit before =+  runClient env (AdminAccount.listUsers adminAccountClient (bearer tok) status limit before)++-- | One user plus the roles actually granted to them in the store.+adminGetUser :: ClientEnv -> Token -> UserId -> IO (Either ClientError GetUserResult)+adminGetUser env tok uid = runClient env (AdminAccount.getUser adminAccountClient (bearer tok) uid)++-- | Suspend an active user and revoke their sessions. @409@ if they are not active; @403@ if+-- the caller is the target.+adminSuspendUser :: ClientEnv -> Token -> UserId -> IO (Either ClientError SuspendUserResult)+adminSuspendUser env tok uid =+  runClient env (AdminAccount.suspendUser adminAccountClient (bearer tok) uid)++-- | Return a suspended user to service. @409@ if they are not suspended.+adminReinstateUser :: ClientEnv -> Token -> UserId -> IO (Either ClientError ReinstateUserResult)+adminReinstateUser env tok uid =+  runClient env (AdminAccount.reinstateUser adminAccountClient (bearer tok) uid)++-- | Soft-delete a user (status becomes @deleted@) and revoke their sessions. The row survives.+adminDeleteUser :: ClientEnv -> Token -> UserId -> IO (Either ClientError DeleteUserResult)+adminDeleteUser env tok uid =+  runClient env (AdminAccount.deleteUser adminAccountClient (bearer tok) uid)++-- | A bounded newest-first session page (default 50, maximum 200) in every status.+adminListSessions :: ClientEnv -> Token -> UserId -> Maybe Int -> Maybe SessionPageCursor -> IO (Either ClientError ListSessionsResult)+adminListSessions env tok uid limit before = runClient env (AdminSession.listSessions adminSessionClient (bearer tok) uid limit before)++adminRevokeSessions :: ClientEnv -> Token -> UserId -> IO (Either ClientError RevokeSessionsResult)+adminRevokeSessions env tok uid =+  runClient env (AdminSession.revokeSessions adminSessionClient (bearer tok) uid)++adminRevokeSession :: ClientEnv -> Token -> SessionId -> IO (Either ClientError RevokeSessionResult)+adminRevokeSession env tok sid =+  runClient env (AdminSession.revokeSession adminSessionClient (bearer tok) sid)++-- | Trigger the ordinary password-reset flow for a user named by id. @409@ if they have no email.+adminPasswordReset :: ClientEnv -> Token -> UserId -> IO (Either ClientError AdminPasswordResetResult)+adminPasswordReset env tok uid =+  runClient env (AdminAccount.passwordReset adminAccountClient (bearer tok) uid)++-- | Fetch a machine token from @POST \/oauth\/token@ with the OAuth2 @client_credentials@ grant+-- (EP-4), authenticating with @client_secret_basic@.+--+-- An empty @scopes@ list omits the @scope@ parameter entirely, which grants every scope the+-- service account is allowed. Passing scopes narrows the token to that subset; a scope outside+-- the account's allow-list is rejected with @invalid_scope@.+--+-- Declared protocol failures are constructors of 'OAuthResult' inside @Right@. 'ClientError' is+-- reserved for transport, decoding, or an undeclared response. The result body uses RFC 6749's+-- @{"error":…,"error_description":…}@ shape because @\/oauth\/*@ speaks the OAuth2 protocol.+--+-- Get a @client_id@ and secret with @shomei-admin service-accounts create@.+oauthToken :: ClientEnv -> Text -> Text -> [Text] -> IO (Either ClientError TokenResult)+oauthToken env clientId clientSecret scopes =+  runClient env (OAuthApi.token (Api.oauth shomeiRoutesClient) (Just basicHeader) form)+  where+    basicHeader =+      "Basic " <> extractBase64 (B64.encodeBase64 (TE.encodeUtf8 (clientId <> ":" <> clientSecret)))+    -- An absent `scope` is a server-defined default (RFC 6749 §3.3); an empty one is a malformed+    -- request. So a caller passing no scopes must send no parameter, not `scope=`.+    form =+      toForm+        ( ("grant_type" :: Text, "client_credentials" :: Text)+            : [("scope", Text.unwords scopes) | not (null scopes)]+        )++-- | Grant a role. Idempotent: re-granting a held role still succeeds. @422@ if the role is not+-- in the registry.+adminGrantRole :: ClientEnv -> Token -> UserId -> Text -> IO (Either ClientError GrantRoleResult)+adminGrantRole env tok uid role =+  runClient env (Authorization.grantRole authorizationClient (bearer tok) uid role)++-- | Revoke a role. @404@ if the user did not hold it.+adminRevokeRole :: ClientEnv -> Token -> UserId -> Text -> IO (Either ClientError RevokeRoleResult)+adminRevokeRole env tok uid role =+  runClient env (Authorization.revokeRole authorizationClient (bearer tok) uid role)
+ test/Main.hs view
@@ -0,0 +1,138 @@+-- | Round-trip test for the derived 'shomei-client' against a real server: an ephemeral+-- PostgreSQL (via @shomei-migrations:test-support@), the real @shomei-server@ assembly served+-- in-process with warp, driven through the typed client. Proves the derived client and the+-- server agree on the wire format end-to-end, including the Bearer-authenticated @me@ route.+module Main (main) where++import Data.ByteString qualified as BS+import Data.IORef (newIORef)+import Data.Text (Text)+import Network.HTTP.Client (defaultManagerSettings, newManager)+import Network.Wai.Handler.Warp (testWithApplication)+import Servant.Health (ProbeCheck, ProbeVerdict (Healthy))+import Shomei.Account.Dto (SignupRequest (..), SignupResponse (..))+import Shomei.Account.Password.Hash.Postgres (Argon2Params (..), newHashingLimiter)+import Shomei.Account.User.Dto (UserResponse (..))+import Shomei.Authorization.Claims.Domain (Audience (..), Issuer (..))+import Shomei.Client qualified as C+import Shomei.Config (defaultShomeiConfig)+import Shomei.Id (parseId)+import Shomei.Mfa.Totp.Postgres (TotpEncryptionKey, totpEncryptionKeyFromBytes)+import Shomei.Migrations.TestSupport (withShomeiMigratedDatabase)+import Shomei.Notify (noNotifierSecrets)+import Shomei.Notify.Queue (newNotifierQueue)+import Shomei.Persistence.Database.Postgres (defaultTransactionRetryPolicy)+import Shomei.Persistence.Pool.Postgres (acquirePool)+import Shomei.Server.App (Env (..))+import Shomei.Server.Boot (application)+import Shomei.Server.Keys (bootstrapKeys)+import Shomei.Session.Dto+  ( LoginRequest (..),+    LoginResponse (..),+    RefreshRequest (..),+    TokenPairResponse (..),+  )+import Shomei.SigningKey.Domain (SigningAlgorithm (ES256))+import Shomei.SigningKey.Protection.Jwt (KeyEncryptionKey, keyEncryptionKeyFromBase64)+import Test.Tasty (TestTree, defaultMain, testGroup)+import Test.Tasty.HUnit (assertFailure, testCase, (@?=))++-- | TOTP is not exercised by this suite; the store is unreachable, so a fixed dummy key keeps+-- the 'Env' shape satisfied (EP-7 added 'envTotpKey').+dummyTotpKey :: TotpEncryptionKey+dummyTotpKey = either (const (error "bad dummy totp key")) id (totpEncryptionKeyFromBytes (BS.replicate 32 0))++testKek :: KeyEncryptionKey+testKek = either (error . show) id (keyEncryptionKeyFromBase64 "AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA=")++main :: IO ()+main = defaultMain tests++tests :: TestTree+tests =+  testGroup+    "shomei-client round-trip against a live server"+    [ testCase "client bearer diagnostics redact the credential" (show (C.Token "sensitive-bearer") @?= "Token <redacted>"),+      testCase "signup → login → me → refresh; then every admin wrapper reaches its route" $+        withShomeiMigratedDatabase \connStr -> do+          pool <- acquirePool 4 10 30000 connStr+          keysRef <- newIORef =<< bootstrapKeys testKek ES256 pool+          envMgr <- newManager defaultManagerSettings+          limiter <- newHashingLimiter 2+          notifierQueue <- newNotifierQueue 64+          let cfg = defaultShomeiConfig (Issuer "shomei") (Audience "shomei-clients")+              env = Env {envPool = pool, envDbRetryPolicy = defaultTransactionRetryPolicy, envConfig = cfg, envKeys = keysRef, envKek = testKek, envHttpManager = envMgr, envNotifierSecrets = noNotifierSecrets, envNotifierQueue = notifierQueue, envArgon2Params = testArgon2Params, envHashingLimiter = limiter, envTotpKey = dummyTotpKey}+          testWithApplication (pure (application env healthyProbe healthyProbe)) \port -> do+            cenv <- C.shomeiClientEnv ("http://127.0.0.1:" <> show port)++            su <-+              fmap C.cookieBody . expectApplicationSuccess "signup"+                =<< C.signup cenv SignupRequest {loginId = email, email = Just email, password = password, displayName = "Ada Lovelace"}++            loginResponse <-+              fmap C.cookieBody . expectApplicationSuccess "login"+                =<< C.login cenv LoginRequest {loginId = email, password = password, remember = Nothing}+            lr <- case loginResponse of+              complete@LoginCompleteResponse {} -> pure complete+              LoginMfaRequiredResponse {} -> assertFailure "login unexpectedly required MFA"+            tok <- C.Token <$> requireBodyToken lr.token.accessToken++            ur <- expectApplicationSuccess "me" =<< C.me cenv tok+            ur.email @?= Just email++            tp <- fmap C.cookieBody . expectApplicationSuccess "refresh" =<< C.refresh cenv RefreshRequest {refreshToken = lr.token.refreshToken}+            (tp.refreshToken /= lr.token.refreshToken) @?= True++            -- EP-2. The admin wrappers are derived from the same route types the server serves,+            -- so what is really under test is that the /paths/ they build reach the handlers --+            -- including the capture segments and the PUT no other route in the API uses. This+            -- token carries no admin role, so every route must answer 403: a 404 would mean the+            -- client built a path the server does not serve, a 405 that it used the wrong verb.+            uid <- either (\e -> assertFailure ("bad user id: " <> show e)) pure (parseId su.user.userId)+            sid <- either (\e -> assertFailure ("bad session id: " <> show e)) pure (parseId straySessionId)++            expect403 "adminListUsers" =<< C.adminListUsers cenv tok Nothing Nothing Nothing+            expect403 "adminGetUser" =<< C.adminGetUser cenv tok uid+            expect403 "adminSuspendUser" =<< C.adminSuspendUser cenv tok uid+            expect403 "adminReinstateUser" =<< C.adminReinstateUser cenv tok uid+            expect403 "adminDeleteUser" =<< C.adminDeleteUser cenv tok uid+            expect403 "adminListSessions" =<< C.adminListSessions cenv tok uid Nothing Nothing+            expect403 "adminRevokeSessions" =<< C.adminRevokeSessions cenv tok uid+            expect403 "adminRevokeSession" =<< C.adminRevokeSession cenv tok sid+            expect403 "adminPasswordReset" =<< C.adminPasswordReset cenv tok uid+            expect403 "adminGrantRole" =<< C.adminGrantRole cenv tok uid "admin"+            expect403 "adminRevokeRole" =<< C.adminRevokeRole cenv tok uid "admin"+    ]+  where+    email = "ada@example.com" :: Text+    password = "correct horse battery staple" :: Text+    -- A well-formed session id that belongs to nobody: the 403 fires before any lookup.+    straySessionId = "session_01h455vb4pex5vsknk084sn02q" :: Text++healthyProbe :: ProbeCheck+healthyProbe = pure Healthy++-- | The route was reached and the admin gate refused it. A 404 would mean the client built a+-- path the server does not serve; a 405, that it used the wrong verb.+expect403 :: String -> Either C.ClientError (C.ApplicationResult a) -> IO ()+expect403 label = \case+  Right (C.ApplicationForbidden problem) | C.status problem == 403 -> pure ()+  Right _ -> assertFailure (label <> ": expected a typed 403, got a different typed outcome")+  Left e -> assertFailure (label <> ": expected a typed 403, got transport failure " <> show e)++expectApplicationSuccess :: String -> Either C.ClientError (C.ApplicationResult a) -> IO a+expectApplicationSuccess label = \case+  Right (C.ApplicationSuccess value) -> pure value+  Right _ -> assertFailure (label <> ": expected success, got an application failure")+  Left err -> assertFailure (label <> ": transport failure: " <> show err)++-- | Body tokens are optional on the wire (cookie transport omits them). This client runs in+-- the default bearer mode, where they are always present.+requireBodyToken :: Maybe Text -> IO Text+requireBodyToken = maybe (assertFailure "expected a body token in bearer mode") pure++-- | Cheap Argon2 parameters for tests. This suite hashes and verifies real passwords, and the+-- production cost (~100 ms per hash) would dominate its runtime. Hash strength is irrelevant+-- here; only that hashing round-trips.+testArgon2Params :: Argon2Params+testArgon2Params = Argon2Params {memoryKiB = 8192, iterations = 1, parallelism = 1}