notion-client 0.9.0.0 → 0.10.0.0

raw patch · 24 files changed

+2257/−156 lines, 24 filesdep +directorydep +entropydep +memorydep ~aesondep ~basedep ~bytestringnew-component:exe:notion-client-oauth-example

Dependencies added: directory, entropy, memory, unix, wai, warp

Dependency ranges changed: aeson, base, bytestring, filepath, http-client-tls, http-types, servant-client, text, time, vector

Files

• CHANGELOG.md +26/−0
• README.md +259/−47
• notion-client-oauth-example/FileTokenStore.hs +103/−0
• notion-client-oauth-example/Login.hs +136/−0
• notion-client-oauth-example/Main.hs +161/−0
• notion-client.cabal +73/−4
• scripts/OAuthLiveCheck.hs +87/−0
• src/Notion/V1.hs +20/−5
• src/Notion/V1/Client.hs +47/−18
• src/Notion/V1/OAuth.hs +116/−2
• src/Notion/V1/OAuth/Authorization.hs +122/−0
• src/Notion/V1/OAuth/Refresh.hs +187/−0
• src/Notion/V1/Pagination.hs +2/−6
• src/Notion/V1/TokenSource.hs +30/−0
• tasty/AuthorizationTests.hs +73/−0
• tasty/FakeNotion.hs +14/−12
• tasty/Main.hs +10/−0
• tasty/OAuthExamplePlatform.hs +18/−0
• tasty/OAuthExampleTests.hs +210/−0
• tasty/OAuthTests.hs +136/−61
• tasty/RuntimeTests.hs +1/−1
• tasty/TokenHTTPTests.hs +133/−0
• tasty/TokenRefreshTests.hs +219/−0
• tasty/TokenSourceTests.hs +74/−0

@@ -1,5 +1,31 @@ # Changelog for notion-client +## 0.10.0.0 (2026-10-19)++### Breaking Changes++* Use `notion-client-effectful >=0.4 && <0.5`; the companion requires `notion-client >=0.10 && <0.11`.++* `RequestContext.contextAuthorization` is replaced by `contextTokenSource`; `standardHeaders` now returns `IO [Header]`. Use `withStandardHeaders` around non-Servant response acquisition for one reactive renewal, and keep body readers and user callbacks outside it.++* OAuth endpoint failures with OAuth error bodies now throw `OAuthError` instead of `UnknownHTTPResponseError`. Known OAuth codes in the alternate Notion error envelope also become `OAuthError`; ordinary Notion API codes remain `NotionError`.++### New Features++* POSIX `notion-client-oauth-example` demonstrates localhost login, durable private file persistence, explicit refresh and confirmed local logout. Offline callback, listener and file-store tests cover single use and recovery. Live public-integration acceptance passed login, user-owner decoding, explicit and automatic token rotation, persisted restart, consent cancellation and revoke/local logout on 2026-10-19.++* Per-request `TokenSource`, `makeMethodsWithTokenSource` and `Notion.V1.OAuth.Refresh` support automatic renewal once on typed `Unauthorized`, serialized token rotation and persistence-before-use. Failed saves retain the pair for `retryTokenPersistence`; uncertain exchanges block grant replay.++* `Notion.V1.OAuth.Authorization` provides secure state generation, consent URLs, strict state-first callback verification and code exchange.++* Typed `OAuthErrorCode` and route-local normalization of OAuth failures; OAuth requests never automatically replay grants. Default error rendering and OAuth debug logging omit server descriptions, headers and bodies.++### Migration++* Existing `makeMethods`, `makeMethodsWith` and `makeMethodsWithEnv` callers keep their fixed-token behavior. Opt into refresh with `makeMethodsWithTokenSource` and `tokenManagerSource`; neither `Methods` fields nor effectful operations change in this release.+* Construct custom request contexts with `requestContextFor` for a fixed token or `requestContextWithTokenSource` for a dynamic source. Call `standardHeaders` in IO for headers without renewal, or use `withStandardHeaders` for a replayable acquisition that can renew once. Close rejected responses and classify them before throwing; consume an opened response outside the retry wrappers.+* Handle `OAuthError` for OAuth endpoint failures. For a managed installation, handle `ReauthorizationRequired`, `TokenPersistenceError` and `RefreshOutcomeUnknown` at the IO boundary, including when using `runNotion`. Persistence recovery calls `retryTokenPersistence` on the same manager; reauthorization and uncertain refresh outcomes require a new login and manager.+ ## 0.9.0.0 (2026-10-12)  ### Breaking Changes

@@ -6,23 +6,47 @@  - Type-safe API bindings using Servant - Comprehensive coverage of Notion API endpoints-- Support for all Notion object types: Pages, Databases, Data Sources, Blocks, Users, etc.+- Typed pages, databases, data sources, blocks, users, and other published API objects - Simple client interface with sensible defaults - Automatic retries of rate-limited and overloaded requests, honoring `retry-after` - Typed error codes with request IDs for support-- OAuth token exchange and URL-to-ID helpers+- OAuth login, automatic token refresh and URL-to-ID helpers  ## Installation -Add to your `package.yaml` or `.cabal` file:+For this release, use `notion-client` 0.10.x with `notion-client-effectful` 0.4.x+if you need the effectful adapter. Add to your `.cabal` file: +```cabal+build-depends: notion-client >=0.10 && <0.11+```++Or add to `package.yaml`:+ ```yaml dependencies:-  - notion-client+  - notion-client >=0.10 && <0.11 ``` +### Upgrading from 0.9++Fixed-token constructors (`makeMethods`, `makeMethodsWith`, `makeMethodsWithEnv`)+keep their signatures. Automatic refresh is opt-in through+`makeMethodsWithTokenSource`; `Methods` fields are unchanged.++Custom HTTP clients must replace `RequestContext.contextAuthorization` with+`contextTokenSource`. Prefer `requestContextFor` for a fixed token or+`requestContextWithTokenSource` for an installation's source. `standardHeaders`+now runs in IO and does not renew; use `withStandardHeaders` around replayable+response acquisition for renewal, keeping response bodies outside retry scopes.+OAuth endpoint failures now use `OAuthError`. See [OAuth](#oauth) for lifecycle+exceptions and the [changelog](CHANGELOG.md#01000-2026-10-19) for the full migration.+ ## Usage +Examples assume `GHC2024` with `OverloadedStrings` and `DuplicateRecordFields`.+Replace placeholder IDs with real IDs from pages shared with your connection.+ Here's a simple example of retrieving a Notion page:  ```haskell@@ -48,19 +72,23 @@  ### Creating a page with typed properties +The target data source must have properties with matching names and types;+this example uses a status property named `Status` and a select named `Priority`.+ ```haskell import Notion.V1 import Notion.V1.Common (Parent(..)) import Notion.V1.Pages import Notion.V1.PropertyValue qualified as PV+import Notion.V1.RichText (RichText) import Data.Map qualified as Map import Data.Vector qualified as Vector -createNewPage :: Methods -> IO PageObject-createNewPage Methods{createPage} = do+createNewPage :: Methods -> RichText -> IO PageObject+createNewPage Methods{createPage} titleRichText = do     let pageProperties = Map.fromList             [ ("title", PV.titleValue (Vector.singleton titleRichText))-            , ("Status", PV.selectValue "In Progress")+            , ("Status", PV.statusValue "In Progress")             , ("Priority", PV.selectValue "High")             , ("Due", PV.dateValue "2024-06-01" Nothing)             , ("Score", PV.numberValue 42)@@ -68,7 +96,7 @@             ]          newPage = mkCreatePage-            (DataSourceParent { dataSourceId = "data-source-id-here" })+            (DataSourceParent { dataSourceId = "data-source-id-here", parentDatabaseId = Nothing })             pageProperties      createPage newPage@@ -77,12 +105,15 @@ ### Reading typed properties  ```haskell-import Notion.V1.PropertyValue+import Data.Map qualified as Map+import Data.Text (Text)+import Notion.V1.Pages (PageObject(..))+import Notion.V1.PropertyValue (PropertyValue(StatusValue), SelectOptionValue(..))  readPageStatus :: PageObject -> Maybe Text readPageStatus page =     case Map.lookup "Status" (properties page) of-        Just (SelectValue _ (Just opt)) -> Just (name opt)+        Just (StatusValue _ (Just SelectOptionValue{name = optionName})) -> Just optionName         _ -> Nothing ``` @@ -120,12 +151,12 @@ ```haskell import Notion.V1 import Notion.V1.Common (Parent(..))-import Notion.V1.Pages+import Notion.V1.Pages (CreatePage(..), PageObject, mkCreatePage)  createMarkdownPage :: Methods -> IO PageObject createMarkdownPage Methods{createPage} = do     let newPage = (mkCreatePage-            (DataSourceParent { dataSourceId = "data-source-id" })+            (DataSourceParent { dataSourceId = "data-source-id", parentDatabaseId = Nothing })             mempty)             { markdown = Just "# Hello\n\nThis page was created with **markdown**." } @@ -135,6 +166,7 @@ ### Editing page content with markdown  ```haskell+import Data.Vector qualified as Vector import Notion.V1 import Notion.V1.Pages @@ -142,7 +174,7 @@ editPage Methods{updatePageMarkdown} pageId =     updatePageMarkdown pageId $         UpdateContent UpdateContentRequest-            { contentUpdates = fromList+            { contentUpdates = Vector.fromList                 [ ContentUpdate                     { oldStr = "old text"                     , newStr = "new text"@@ -161,9 +193,12 @@ ```haskell import Network.HTTP.Client.TLS (newTlsManager) import Notion.V1+import Data.Text qualified as Text+import System.Environment (getEnv)  main :: IO () main = do+    token <- Text.pack <$> getEnv "NOTION_TOKEN"     manager <- newTlsManager     let config = defaultClientConfig {logger = Just stderrLogger, logLevel = LogInfo}         methods = makeMethodsWith config manager token@@ -182,7 +217,9 @@ ```haskell import Control.Exception (catch) import Data.Text qualified as Text+import Notion.V1 (Methods(..)) import Notion.V1.Error+import Notion.V1.Pages (PageID)  safeRetrieve :: Methods -> PageID -> IO () safeRetrieve Methods{retrievePage} pageId =@@ -202,33 +239,106 @@  ### OAuth +Public integrations (public connections in Notion's portal) use a browser consent+flow. Create one in the [developer portal](https://www.notion.so/profile/integrations),+register an exact redirect URI, and keep its OAuth client ID and secret in your+trusted server environment. The client secret and exchange belong on a trusted+backend for distributed desktop or browser apps.++The protocol helpers build the URL, verify the callback, and exchange its code:+ ```haskell-import Notion.V1 (defaultBaseUrl, defaultClientConfig)+import Control.Exception (throwIO)+import Data.Text (Text)+import Network.HTTP.Types.URI (Query) import Notion.V1.OAuth-import Servant.Client (mkClientEnv)+import Notion.V1.OAuth.Authorization -exchangeCode :: Manager -> Text -> IO OAuthTokenResponse-exchangeCode manager authCode = do-    let oauth = makeOAuthMethodsWith defaultClientConfig-            (mkClientEnv manager defaultBaseUrl)-            OAuthCredentials {clientId = "...", clientSecret = "..."}-    createOAuthToken oauth $ AuthorizationCode AuthorizationCodeGrant-        { code = authCode-        , redirectUri = Just "https://example.com/callback"-        , externalAccount = Nothing-        }+beginLogin :: Text -> Text -> IO AuthorizationRequest+beginLogin client redirect = do+    freshState <- newOAuthState+    pure (AuthorizationRequest client redirect freshState)++-- Run this only after claiming the initiating session's pending request once.+exchangeVerifiedCode :: OAuthMethods -> AuthorizationRequest -> OAuthCode+                     -> IO OAuthTokenResponse+exchangeVerifiedCode = exchangeAuthorizationCode++verifyCallback :: AuthorizationRequest -> Query -> IO OAuthCode+verifyCallback request query =+    either throwIO pure (verifyAuthorizationCallback (state request) query) ``` -`revokeOAuthToken` and `introspectOAuthToken` take a token.+Send the browser to `authorizationUrl request`. Bind the complete request (state,+client ID and exact redirect URI) to the initiating session and expire it after a+short interval. Give the verifier an already-decoded WAI query or `parseQuery`+output; do not decode twice. After verification, atomically consume the pending+request before exchange. A state-validated `AuthorizationDenied` also consumes it;+malformed or forged callbacks leave it pending. The pure verifier supplies neither+session storage nor expiry/replay protection. Descriptions are untrusted text. +After a successful exchange, convert with `oauthTokensFromResponse now response`+and durably save the pair. If that first save fails, retain the received pair and+retry only its save; never exchange the code again. The runnable example below+implements this recovery. Then construct stable methods from your store:++```haskell+import Notion.V1 (ClientConfig, Methods, makeMethodsWithTokenSource)+import Notion.V1.OAuth (OAuthMethods)+import Notion.V1.OAuth.Refresh+import Servant.Client (ClientEnv)++connectInstallation :: ClientConfig -> ClientEnv -> OAuthMethods -> TokenStore+                    -> IO (OAuthTokenManager, Methods)+connectInstallation config env oauth store = do+    manager <- newOAuthTokenManager oauth store+    pure (manager, makeMethodsWithTokenSource config env (tokenManagerSource manager))+```++`TokenStore` supplies `loadTokens` and an idempotent `saveTokens`; the library also+provides `inMemoryTokenStore` for volatile use. The manager loads once, renews once+after typed `Unauthorized`, and persists the replacement before using it.+`refreshTokensNow` performs explicit refresh. Handle these IO exceptions:++- `OAuthError`: inspect `oauthErrorCode`; `OAuthInvalidClient` means client+  configuration failed, and `OAuthInvalidGrant` means a grant was rejected.+  OAuth endpoint calls never retry automatically. Default rendering/logging omits+  descriptions, raw bodies and headers; explicit metadata is available.+- `ReauthorizationRequired`: start a new login; the refresh token is absent or+  rejected. A null replacement refresh token remains absent.+- `TokenPersistenceError`: the manager retains the unsaved replacement and blocks+  requests/refresh. Call `retryTokenPersistence` to save that identical pair.+- `RefreshOutcomeUnknown`: a refresh may have succeeded remotely. Start a new login+  and construct a new manager; do not reload the old store and replay its token.++Use one manager per installation. Multiple managers/processes must coordinate the+entire load/refresh/save sequence externally; save-time compare-and-swap is too+late. Store hooks must not re-enter the manager. A crash between remote rotation+and durable save may require another login. `currentTokens` is for explicit+inspection/recovery and can return unsaved or unusable credentials. There is no+timer refresh because token responses supply no expiry.++`RequestContext` now carries `contextTokenSource`; `standardHeaders` reads current+headers in IO. Non-Servant clients use `withStandardHeaders` around replayable+response acquisition, with `withRetries` inside it. Close rejected responses before+throwing their classified error. Keep body consumption and user callbacks outside+both retry layers. Byte and file-backed multipart bodies can be replayed; arbitrary+one-shot streams cannot. OAuth methods retain Basic authentication.++The effectful adapter accepts these same `Methods`. Final `NotionError` values use+`Error NotionError`; OAuth lifecycle and persistence exceptions remain IO exceptions.+ ### URL helpers  ```haskell+import Notion.V1.Common (UUID) import Notion.V1.Helpers (extractBlockId, extractNotionId) -extractNotionId "https://www.notion.so/team/Tasks-abc123def456789012345678901234ab?v=..."+notionId :: Maybe UUID+notionId = extractNotionId "https://www.notion.so/team/Tasks-abc123def456789012345678901234ab?v=..." -- Just (UUID "abc123de-f456-7890-1234-5678901234ab")-extractBlockId "https://www.notion.so/Page-0123456789abcdef0123456789abcdef#block-fedcba9876543210fedcba9876543210"+blockId :: Maybe UUID+blockId = extractBlockId "https://www.notion.so/Page-0123456789abcdef0123456789abcdef#block-fedcba9876543210fedcba9876543210" -- Just (UUID "fedcba98-7654-3210-fedc-ba9876543210") ``` @@ -236,14 +346,15 @@  ```haskell import Notion.V1.Pagination (paginateAll)-import Notion.V1.DataSources (QueryDataSource(..))+import Data.Vector (Vector)+import Notion.V1 (Methods(..))+import Notion.V1.DataSources (DataSourceID, QueryDataSource(..), _QueryDataSource)+import Notion.V1.Search (PageOrDataSource) -allPages <- paginateAll $ \cursor ->-    queryDataSource methods dsId QueryDataSource-        { filter = Nothing, sorts = Nothing-        , startCursor = cursor, pageSize = Just 100-        , inTrash = Nothing, filterProperties = Nothing-        }+allPages :: Methods -> DataSourceID -> IO (Vector PageOrDataSource)+allPages methods dsId = paginateAll $ \cursor ->+    queryDataSource methods dsId+        _QueryDataSource {startCursor = cursor, pageSize = Just 100} ```  `paginateFoldM` and `paginateForM_` process every item while holding only one@@ -254,7 +365,7 @@ Callers that use the [`effectful`](https://hackage.haskell.org/package/effectful) effect system can opt into an `Eff`-typed surface via the companion package-[`notion-client-effectful`](./notion-client-effectful/). Every+[`notion-client-effectful`](https://hackage.haskell.org/package/notion-client-effectful). Every `Notion.V1.Methods` field is re-exposed as a smart constructor of a `Notion` effect, and a `runNotion` interpreter dispatches through a concrete `Methods` value. `NotionError` responses surface via the@@ -289,7 +400,7 @@   print result ``` -See [`notion-client-effectful/README.md`](./notion-client-effectful/README.md)+See the [companion README](https://github.com/shinzui/notion-client/tree/master/notion-client-effectful#readme) for the full import pattern (qualifying one of the two `Notion.V1` modules is required — every smart constructor shares its name with the matching `Methods` record selector).@@ -298,15 +409,18 @@  - **Databases**: Create, retrieve, update, and query databases - **Data Sources**: Create, retrieve, update, query data sources; list templates-- **Pages**: Create (with blocks or markdown), retrieve, update, move pages; retrieve and update page markdown+- **Pages**: Create (with blocks or markdown), retrieve, update, move pages; retrieve and update page markdown, including background operations - **Blocks**: Retrieve, update, append children (with position control), and delete blocks - **Users**: List, retrieve users and bot users - **Views**: Create, retrieve, update, delete, list, and query database views (all 10 view types) - **Search**: Search for pages and data sources-- **Comments**: Create and list comments+- **Comments**: Create, retrieve, update, delete and list comments+- **File Uploads**: Create, upload content, complete, retrieve and list uploads+- **Meeting Notes**: Create from recordings and query meeting notes+- **Async Tasks**: Retrieve status and wait for background operations - **Custom Emojis**: List workspace custom emojis - **Webhooks**: Event types (including view events) and signature verification-- **OAuth**: Exchange authorization codes and refresh tokens, revoke and introspect tokens+- **OAuth**: Browser login helpers, verified callbacks, automatic token refresh with persistence, revoke and introspect tokens  ## Running the Example @@ -326,17 +440,115 @@ cabal run notion-client-example ``` -### Obtaining API Credentials+### OAuth example -1. Create a Notion integration at [https://www.notion.so/my-integrations](https://www.notion.so/my-integrations)-2. Get your integration token from the integration settings-3. Share any Notion pages or databases you want to access with your integration-   - Open the page/database in Notion-   - Click "Share" in the top right-   - Enter your integration name and click "Invite"+The POSIX-only `notion-client-oauth-example` runs a trusted local confidential+client. In the [developer portal](https://www.notion.so/profile/integrations),+choose **Build → Public connections**, create a test connection, and enable the+capabilities your application needs. Register `http://localhost:8765/callback`+under its OAuth configuration, then copy its OAuth client ID and secret from the+**Configuration** tab. See Notion's [public-connection setup guide](https://developers.notion.com/guides/get-started/public-connections).+Set the credentials in your shell (never commit them):++```bash+export NOTION_OAUTH_CLIENT_ID=...+export NOTION_OAUTH_CLIENT_SECRET=...+cabal run notion-client-oauth-example -- login+cabal run notion-client-oauth-example -- whoami+cabal run notion-client-oauth-example -- refresh+cabal run notion-client-oauth-example -- whoami+cabal run notion-client-oauth-example -- revoke+```++For a local checkout using direnv, the same exports can live in gitignored+`.envrc.local`, which `.envrc` loads after the development shell. The executable+reads environment variables; it does not load dotenv files itself.++If port 8765 is occupied, register another exact callback URI and set both+`NOTION_OAUTH_REDIRECT_URI=http://localhost:8767/callback` and+`NOTION_OAUTH_LISTEN_PORT=8767`. A real public integration accepted this localhost+HTTP callback during live validation on 2026-10-19. Always open the authorization+URL printed by `login`; visiting `/callback` directly returns “Invalid callback”.++`login` prints a consent URL after the listener is ready on `127.0.0.1`, validates+state, consumes the callback once, exchanges the code and saves credentials before+reporting success. It expires after ten minutes. Invalid callbacks leave it pending;+a matching-state cancellation reports cancellation without exchanging. `whoami`+prints the bot name and up to five shared results; an empty search is valid.+`refresh` prints full-value rotation comparisons as booleans and offers persistence+retry without sending a second grant. `revoke` removes local credentials only after+confirmed remote success. Subsequent commands require login; no remote token-family+invalidation is assumed.++`NOTION_OAUTH_TOKEN_FILE` defaults to `.notion-oauth-tokens.json`. The example requires+an owner-only regular token file in a directory owned by you and not writable by+group or others. It rejects token symlinks, creates private temporary files before+writing, synchronizes and atomically replaces them, and synchronizes the parent+directory. Every command holds `<token-file>.lock` across load/refresh/save. After+a crash, remove a stale lock directory manually only after checking no example+process is active. Keep the process alive to retry an unsaved pair; stopping it can+require another login. This file store is an example, not a production secret store.++If the portal refuses HTTP localhost redirects, register an HTTPS tunnel's exact+callback URL and set `NOTION_OAUTH_REDIRECT_URI` to it. Set+`NOTION_OAUTH_LISTEN_PORT` to its local target port (default `8765`). Redirect URIs+must have an absolute path and no query or fragment. The listener still binds+loopback. No framework adapter, PKCE, timer refresh, distributed store or Notion+MCP OAuth is provided. The executable and its POSIX file tests are disabled on+Windows; the core library and ordinary HTTP tests remain portable.++### Internal connection credentials++These credentials are for `notion-client-example`; the OAuth example above uses+a public connection's client ID and secret instead.++1. Create an internal connection in the [developer portal](https://www.notion.so/profile/integrations).+2. Copy its API token from **Configuration** and set `NOTION_TOKEN`.+3. Share the pages or databases you want to access: open the page's **•••** menu,+   choose **Add connections**, and select your connection. See the+   [authorization guide](https://developers.notion.com/guides/get-started/authorization). 4. Get the page/database IDs from their URLs:    - Page URL: `https://www.notion.so/Your-Page-Title-83715d7c1111424aaa11d7fc1111bd2a`    - Page ID: `83715d7c1111424aaa11d7fc1111bd2a` (the last part of the URL)++## Release preparation++The release pair is `notion-client-0.10.0.0` and+`notion-client-effectful-0.4.0.0`, targeting Notion API `2026-03-11` and validated+with GHC 9.12.4. Keep both Cabal versions, the companion's core bound and both+changelogs aligned. Run from the repository root:++```bash+cabal build all+env -u NOTION_TOKEN cabal test all --test-show-details=direct+cabal haddock all+cabal check+(cd notion-client-effectful && cabal check)+cabal sdist all+```++The offline suites currently contain 462 core tests and four companion runtime+tests. The separate live OAuth gate passed login, user-owner decoding, explicit+and reactive rotation, persisted restart, cancellation and revoke/local logout;+its evidence is in [plan 19](https://github.com/shinzui/notion-client/blob/master/docs/plans/19-demonstrate-and-document-the-public-integration-oauth-login-end-to-end.md).+After OAuth runtime changes, repeat that sequence with a disposable test+installation. The explicit automatic-refresh harness is:++```bash+cabal exec -- runghc -package=notion-client -XGHC2024 -XOverloadedStrings -XDuplicateRecordFields -XRecordWildCards -inotion-client-oauth-example scripts/OAuthLiveCheck.hs+```++Run it after login/explicit refresh and before revoke. It changes only the+in-memory access token, uses the current saved refresh token, and durably saves+the replacement. It is excluded from offline tests.++Inspect both archives under `dist-newstyle/sdist/` before upload. Each must contain+its README, changelog, license and all sources required by its tests and examples;+local environment and token files must be absent. Build and test both extracted+archives together in a fresh Cabal project to catch dependencies on the checkout.+Publish the core package before its companion so the companion's bound resolves.+These preparation commands generate local artifacts; uploading, tagging and+publishing are separate maintainer actions.  ## License 

@@ -0,0 +1,103 @@+-- | Example-only POSIX persistence. The complete command must hold the lock.+-- Atomic replacement protects complete JSON; it cannot transact with Notion.+module FileTokenStore+  ( fileTokenStore,+    tokenFileExists,+    withTokenFileLock,+    removeTokenFile,+  )+where++import Control.Exception+import Control.Monad (unless, when)+import Data.Aeson qualified as A+import Data.Bits ((.&.))+import Data.ByteString.Lazy qualified as L+import Notion.V1.OAuth.Refresh+import System.Directory qualified as D+import System.FilePath+import System.IO+import System.IO.Error (isAlreadyExistsError, isDoesNotExistError)+import System.Posix.Directory qualified as PD+import System.Posix.Files qualified as F+import System.Posix.IO qualified as P+import System.Posix.Temp (mkstemp)+import System.Posix.Unistd (fileSynchronise)+import System.Posix.User (getEffectiveUserID)++fileTokenStore :: FilePath -> TokenStore+fileTokenStore path =+  TokenStore+    { loadTokens = do+        exists <- tokenFileExists path+        unless exists (ioError (userError "No saved credentials. Run login again"))+        bytes <- L.readFile path+        either (const (ioError (userError "Invalid token file. Run login again"))) pure (A.eitherDecode bytes),+      saveTokens = save path+    }++-- Check using lstat, including dangling symlinks. Do not follow token symlinks.+tokenFileExists :: FilePath -> IO Bool+tokenFileExists path = do+  checkDirectory (takeDirectory path)+  status <- optionalStatus path+  case status of+    Nothing -> pure False+    Just s -> do+      uid <- getEffectiveUserID+      unless+        (F.isRegularFile s && F.fileOwner s == uid && F.fileMode s .&. 0o077 == 0)+        (ioError (userError "Token path must be an owner-only regular file"))+      pure True++optionalStatus :: FilePath -> IO (Maybe F.FileStatus)+optionalStatus path =+  (Just <$> F.getSymbolicLinkStatus path) `catch` \(e :: IOException) ->+    if isDoesNotExistError e then pure Nothing else throwIO e++checkDirectory :: FilePath -> IO ()+checkDirectory path = do+  s <- F.getSymbolicLinkStatus path+  uid <- getEffectiveUserID+  unless+    (F.isDirectory s && F.fileOwner s == uid && F.fileMode s .&. 0o022 == 0)+    (ioError (userError "Token directory must be owned by you and not writable by group or others"))++save :: FilePath -> OAuthTokens -> IO ()+save path tokens = mask $ \restore -> do+  _ <- tokenFileExists path+  let directory = takeDirectory path+      cleanup (temporary, tempHandle) = do+        ignoreIO (hClose tempHandle)+        ignoreIO (D.removeFile temporary)+  -- mkstemp creates exclusively with mode 0600 before any secret bytes exist.+  bracketOnError (mkstemp (directory </> takeFileName path <> ".tmp-")) cleanup $ \(temporary, tempHandle) -> do+    restore (L.hPut tempHandle (A.encode tokens) >> hFlush tempHandle)+    fd <- P.handleToFd tempHandle+    bracket (pure fd) P.closeFd (restore . fileSynchronise)+    -- Recheck destination before replacement; the directory is not attacker-writable.+    _ <- tokenFileExists path+    D.renameFile temporary path+    synchronizeDirectory directory++synchronizeDirectory :: FilePath -> IO ()+synchronizeDirectory directory = bracket (P.openFd directory P.ReadOnly P.defaultFileFlags) P.closeFd fileSynchronise++-- | The lock covers load, remote exchange and durable save. A crash may leave+-- the lock directory behind; remove it only after checking no command is active.+withTokenFileLock :: FilePath -> IO a -> IO a+withTokenFileLock path = bracket acquire (const (D.removeDirectory lock)) . const+  where+    lock = path <> ".lock"+    acquire = do+      checkDirectory (takeDirectory path)+      PD.createDirectory lock 0o700 `catch` \(e :: IOException) ->+        if isAlreadyExistsError e then ioError (userError "OAuth command already locked; check for an active process before removing the lock directory") else throwIO e++removeTokenFile :: FilePath -> IO ()+removeTokenFile path = do+  exists <- tokenFileExists path+  when exists (D.removeFile path >> synchronizeDirectory (takeDirectory path))++ignoreIO :: IO () -> IO ()+ignoreIO action = action `catch` \(_ :: IOException) -> pure ()

@@ -0,0 +1,136 @@+-- | A single local login session, with ten-minute expiry and atomic single use.+module Login+  ( LoginResult (..),+    newLoginApplication,+    runLogin,+    callbackPath,+  )+where++import Control.Concurrent+import Control.Exception+import Control.Monad (void)+import Data.ByteString (ByteString)+import Data.ByteString.Char8 qualified as B8+import Data.ByteString.Lazy qualified as L+import Data.Text (Text)+import Data.Text qualified as T+import Data.Text.Encoding qualified as T+import Data.Time.Clock+import Network.HTTP.Types+import Network.Wai qualified as W+import Network.Wai.Handler.Warp qualified as Warp+import Notion.V1.OAuth (OAuthErrorCode (OAuthAccessDenied), OAuthMethods)+import Notion.V1.OAuth.Authorization+import Notion.V1.OAuth.Refresh+import System.Timeout qualified as Timeout++-- Secrets are retained only for explicit save recovery; Show is redacted.+data LoginResult = Connected OAuthTokens | SavePending OAuthTokens | Cancelled | LoginFailed | LoginExpired++instance Show LoginResult where+  show (Connected _) = "Connected"+  show (SavePending _) = "SavePending"+  show Cancelled = "Cancelled"+  show LoginFailed = "LoginFailed"+  show LoginExpired = "LoginExpired"++-- | Validate an absolute HTTP(S) redirect and use its exact encoded path.+-- No query, fragment or user-info is accepted. The exact URI still goes to Notion.+callbackPath :: Text -> Either Text ByteString+callbackPath uri = do+  rest <-+    maybe+      (Left "Redirect URI must be absolute HTTP(S)")+      Right+      (T.stripPrefix "http://" uri `orElse` T.stripPrefix "https://" uri)+  let (authority, path) = T.breakOn "/" rest+  if T.null authority+    || T.null path+    || T.any (`elem` ("?#@\\" :: String)) authority+    || T.any (`elem` ("?#\\" :: String)) path+    || T.any (<= ' ') uri+    then Left "Redirect URI needs an absolute path and no query or fragment"+    else Right (T.encodeUtf8 path)+  where+    orElse (Just a) _ = Just a+    orElse Nothing b = b++-- | Inject methods/store for network-free callback tests. Invalid requests leave+-- the login pending. A valid success or denial claims it once before exchange.+-- The caller keeps the application lifetime within the expiry interval.+newLoginApplication ::+  OAuthMethods ->+  TokenStore ->+  AuthorizationRequest ->+  ByteString ->+  IO (W.Application, IO LoginResult)+newLoginApplication oauth store request path = do+  claim <- newMVar False+  completed <- newEmptyMVar+  let complete result = void (tryPutMVar completed result)+      application req respond+        | W.requestMethod req /= methodGet || W.rawPathInfo req /= path = respond (page status404 "Not found")+        | otherwise = case verifyAuthorizationCallback (state request) (W.queryString req) of+            Left StateMismatch -> respond (page status400 "Invalid callback")+            Left MissingCode -> respond (page status400 "Invalid callback")+            Left MalformedCallback -> respond (page status400 "Invalid callback")+            verified -> mask $ \restore -> do+              already <- modifyMVar claim (\used -> pure (True, used))+              if already+                then respond (page status409 "Callback already used")+                else case verified of+                  Left (AuthorizationDenied OAuthAccessDenied _) -> do+                    response <- respond (page status200 "Consent was cancelled") `finally` complete Cancelled+                    pure response+                  Left (AuthorizationDenied _ _) -> do+                    response <- respond (page status400 "Authorization failed") `finally` complete LoginFailed+                    pure response+                  Right code -> do+                    exchange <- try @SomeException (restore (exchangeAuthorizationCode oauth request code))+                    case exchange of+                      Left _ -> do+                        response <- respond (page status500 "Connection failed; start login again") `finally` complete LoginFailed+                        pure response+                      Right tokenResponse -> do+                        now <- getCurrentTime+                        let tokens = oauthTokensFromResponse now tokenResponse+                        saved <- try @SomeException (restore (saveTokens store tokens))+                        case saved of+                          Left _ -> do+                            response <- respond (page status500 "Credentials received but storage failed; return to the console") `finally` complete (SavePending tokens)+                            pure response+                          Right () -> do+                            response <- respond (page status200 "Connected") `finally` complete (Connected tokens)+                            pure response+  pure (application, takeMVar completed)++page :: Status -> B8.ByteString -> W.Response+page status message =+  W.responseLBS+    status+    [(hContentType, "text/plain; charset=utf-8"), (hCacheControl, "no-store"), ("Referrer-Policy", "no-referrer")]+    (L.fromStrict message)++-- | Bind explicitly to loopback, propagate startup errors, announce only after+-- readiness, and bracket listener lifetime. Timeout also covers exchange/save.+-- A pending initial save can be retried by the caller using the retained pair.+runLogin :: Int -> Int -> OAuthMethods -> TokenStore -> AuthorizationRequest -> IO () -> IO LoginResult+runLogin port timeoutMicros oauth store request announce = do+  path <- either (ioError . userError . T.unpack) pure (callbackPath (redirectUri request))+  (application, awaitResult) <- newLoginApplication oauth store request path+  ready <- newEmptyMVar+  stopped <- newEmptyMVar+  let settings =+        Warp.setHost "127.0.0.1" $+          Warp.setPort port $+            Warp.setBeforeMainLoop (void (tryPutMVar ready (Right ()))) $+              Warp.setOnException (\_ _ -> pure ()) Warp.defaultSettings+      start = forkFinally (Warp.runSettings settings application) $ \outcome -> do+        void (tryPutMVar ready outcome)+        putMVar stopped outcome+      stop tid = killThread tid >> takeMVar stopped >> pure ()+  bracket start stop $ \_ -> do+    takeMVar ready >>= either throwIO pure+    announce+    Timeout.timeout timeoutMicros awaitResult >>= maybe (pure LoginExpired) pure

@@ -0,0 +1,161 @@+-- | Public integration login example (POSIX only).+-- Create a public connection in https://www.notion.so/profile/integrations and+-- register http://localhost:8765/callback. Export NOTION_OAUTH_CLIENT_ID and+-- NOTION_OAUTH_CLIENT_SECRET, then run with login, whoami, refresh or revoke.+-- If localhost HTTP is refused, register an HTTPS tunnel URL and set+-- NOTION_OAUTH_REDIRECT_URI; keep its target listener port configured separately.+-- This confidential-client example runs in a trusted process. Distributed apps+-- must keep the client secret and exchange on a trusted backend.+module Main (main) where++import Control.Exception+import Control.Monad (unless, when)+import Data.Maybe (fromMaybe)+import Data.Text qualified as T+import Data.Text.IO qualified as T+import Data.Vector qualified as V+import FileTokenStore+import Login+import Network.HTTP.Client.TLS (newTlsManager)+import Notion.V1+import Notion.V1.Common (UUID (..))+import Notion.V1.DataSources qualified as D+import Notion.V1.Error qualified as E+import Notion.V1.ListOf (ListOf (..))+import Notion.V1.OAuth qualified as O+import Notion.V1.OAuth.Authorization qualified as A+import Notion.V1.OAuth.Refresh qualified as R+import Notion.V1.Pages qualified as P+import Notion.V1.Search+import Notion.V1.Users qualified as U+import Servant.Client (mkClientEnv)+import System.Environment+import System.Exit+import System.IO+import Text.Read (readMaybe)++main :: IO ()+main =+  program `catch` \(e :: SomeException) -> case fromException e of+    Just (exit :: ExitCode) -> throwIO exit+    Nothing | Just (_ :: AsyncException) <- fromException e -> throwIO e+    Nothing -> hPutStrLn stderr (diagnostic e) >> exitFailure++program :: IO ()+program = do+  args <- getArgs+  command <- case args of+    [c] | c `elem` ["login", "whoami", "refresh", "revoke"] -> pure c+    _ -> usage+  cid <- required "NOTION_OAUTH_CLIENT_ID"+  secret <- required "NOTION_OAUTH_CLIENT_SECRET"+  redirect <- T.pack . fromMaybe "http://localhost:8765/callback" <$> lookupEnv "NOTION_OAUTH_REDIRECT_URI"+  portText <- fromMaybe "8765" <$> lookupEnv "NOTION_OAUTH_LISTEN_PORT"+  port <- case readMaybe portText of+    Just p | p > 0 && p <= 65535 -> pure p+    _ -> usage+  path <- fromMaybe ".notion-oauth-tokens.json" <$> lookupEnv "NOTION_OAUTH_TOKEN_FILE"+  withTokenFileLock path $ do+    http <- newTlsManager+    let env = mkClientEnv http defaultBaseUrl+        oauth = O.makeOAuthMethodsWith defaultClientConfig env (O.OAuthCredentials cid secret)+        store = fileTokenStore path+    case command of+      "login" -> do+        state <- A.newOAuthState+        let request = A.AuthorizationRequest cid redirect state+        result <- runLogin port (10 * 60 * 1000000) oauth store request $ do+          putStrLn "Open this URL in your browser:"+          T.putStrLn (A.authorizationUrl request)+          T.putStrLn ("Waiting for the redirect on " <> redirect)+        case result of+          Connected tokens -> connected path tokens+          SavePending tokens -> do+            putStrLn "Credentials received but storage failed. Keep this process open to retain them."+            retrySave (R.saveTokens store tokens)+            connected path tokens+          Cancelled -> putStrLn "Consent was cancelled"+          LoginExpired -> hPutStrLn stderr "Login timed out. Start login again" >> exitFailure+          LoginFailed -> hPutStrLn stderr "Connection failed. Check client credentials and start login again" >> exitFailure+      _ -> do+        exists <- tokenFileExists path+        unless exists (hPutStrLn stderr "Run login again" >> exitFailure)+        manager <- R.newOAuthTokenManager oauth store+        case command of+          "whoami" -> do+            let api = makeMethodsWithTokenSource defaultClientConfig env (R.tokenManagerSource manager)+                who = do+                  U.UserObject {name} <- retrieveMyUser api+                  T.putStrLn ("Bot: " <> fromMaybe "(unnamed)" name)+                  List {results} <- search api _SearchRequest {pageSize = Just 5}+                  if V.null results then putStrLn "No shared search results" else mapM_ (T.putStrLn . resultLabel) (V.toList (V.take 5 results))+            who `catch` \(_ :: R.TokenPersistenceError) -> do+              putStrLn "Refresh succeeded but its credentials were not saved."+              _ <- retrySave (R.retryTokenPersistence manager)+              who+          "refresh" -> do+            old <- R.currentTokens manager+            result <- try @R.TokenPersistenceError (R.refreshTokensNow manager)+            new <- either (const (retrySave (R.retryTokenPersistence manager))) pure result+            putStrLn ("access token changed: " <> show (R.accessToken old /= R.accessToken new))+            putStrLn ("refresh token changed: " <> maybe "not returned" (\_ -> show (R.refreshToken old /= R.refreshToken new)) (R.refreshToken new))+          "revoke" -> do+            tokens <- R.currentTokens manager+            _ <- O.revokeOAuthToken oauth (R.accessToken tokens)+            removeTokenFile path+            putStrLn "Local credentials removed. Run login again"+          _ -> usage++required :: String -> IO T.Text+required key =+  lookupEnv key >>= \case+    Just value | not (null value) -> pure (T.pack value)+    _ -> usage++usage :: IO a+usage = do+  hPutStrLn stderr "usage: notion-client-oauth-example (login | whoami | refresh | revoke)"+  hPutStrLn stderr "  requires NOTION_OAUTH_CLIENT_ID and NOTION_OAUTH_CLIENT_SECRET"+  exitWith (ExitFailure 2)++-- This action may save the same pair repeatedly, but must never exchange a grant.+retrySave :: IO a -> IO a+retrySave action = do+  putStrLn "Press Enter to retry persistence, or q to stop (unsaved credentials may require a new login)."+  hFlush stdout+  eof <- hIsEOF stdin+  when eof exitFailure+  answer <- getLine+  when (answer == "q") exitFailure+  attempt <- try @SomeException action+  case attempt of+    Right a -> pure a+    Left e | Just (_ :: AsyncException) <- fromException e -> throwIO e+    Left _ -> putStrLn "Persistence still failed; credentials are retained in this process." >> retrySave action++connected :: FilePath -> R.OAuthTokens -> IO ()+connected path R.OAuthTokens {workspaceName, workspaceId, botId} = do+  T.putStrLn ("Connected to workspace " <> fromMaybe "(unnamed)" workspaceName <> " (workspace " <> workspaceId <> ", bot " <> botId <> ")")+  putStrLn ("Tokens saved to " <> path)++resultLabel :: PageOrDataSource -> T.Text+resultLabel = \case+  PageResult P.PageObject {id = UUID value} -> "page " <> value+  PartialPageResult P.PartialPageObject {id = UUID value} -> "page " <> value+  DataSourceResult D.DataSourceObject {id = UUID value} -> "data source " <> value+  PartialDataSourceResult D.PartialDataSourceObject {id = UUID value} -> "data source " <> value+  UnknownResult _ -> "Unknown search result type"++diagnostic :: SomeException -> String+diagnostic e+  | Just (_ :: R.TokenPersistenceError) <- fromException e = "Token persistence failed; retain this process and retry the save"+  | Just (_ :: R.RefreshOutcomeUnknown) <- fromException e = "Refresh outcome unknown. Run login again; do not reuse the old refresh token"+  | Just (_ :: R.ReauthorizationRequired) <- fromException e = "Authorization required. Run login again"+  | Just oe@O.OAuthError {oauthErrorCode = O.OAuthInvalidClient} <- fromException e = "Check OAuth client credentials: " <> displayException oe+  | Just (oe :: O.OAuthError) <- fromException e = displayException oe+  | Just E.NotionError {code} <- fromException e = "Notion API request failed (" <> safeCode code <> ")"+  | Just (_ :: IOException) <- fromException e = "Local storage or listener failed; check the token directory, permissions, lock and port"+  | otherwise = "OAuth operation failed; start login again"+  where+    safeCode (E.UnknownErrorCode _) = "unknown_error"+    safeCode c = T.unpack (E.apiErrorCodeText c)

@@ -1,12 +1,16 @@ cabal-version: 3.4 name: notion-client-version: 0.9.0.0+version: 0.10.0.0 synopsis: Type-safe Haskell client for the Notion API description:   This package provides comprehensive and type-safe bindings   to the Notion API, providing both a Servant interface and   non-Servant interface for convenience.   .+  Includes browser OAuth authorization helpers, typed OAuth errors,+  per-request token sources and automatic refresh with caller-supplied+  persistence. A POSIX example demonstrates the complete login flow.+  .   Read the @README@ below for a fully worked usage example.   .   Otherwise, browse the "Notion.V1" module, which is the@@ -20,12 +24,14 @@ homepage: https://github.com/shinzui/notion-client bug-reports: https://github.com/shinzui/notion-client/issues build-type: Simple-tested-with: ghc ==9.12.2+tested-with: ghc ==9.12.4 extra-doc-files:   CHANGELOG.md   README.md -extra-source-files: LICENSE+extra-source-files:+  LICENSE+  scripts/OAuthLiveCheck.hs  source-repository head   type: git@@ -42,11 +48,13 @@     bytestring >=0.11 && <0.13,     containers >=0.6 && <0.8,     cryptohash-sha256 >=0.11 && <0.12,+    entropy >=0.4.1.11 && <0.5,     filepath >=1.4 && <1.6,     http-api-data >=0.6 && <0.7,     http-client >=0.7.16 && <0.8,     http-client-tls >=0.3 && <0.4,     http-types >=0.12 && <0.13,+    memory >=0.18 && <0.19,     mtl >=2.2 && <2.4,     random >=1.2 && <1.4,     scientific >=0.3 && <0.4,@@ -81,6 +89,8 @@     Notion.V1.ListOf     Notion.V1.MeetingNotes     Notion.V1.OAuth+    Notion.V1.OAuth.Authorization+    Notion.V1.OAuth.Refresh     Notion.V1.Pages     Notion.V1.Pagination     Notion.V1.Properties@@ -88,6 +98,7 @@     Notion.V1.Retry     Notion.V1.RichText     Notion.V1.Search+    Notion.V1.TokenSource     Notion.V1.Users     Notion.V1.ViewConfig     Notion.V1.ViewQueries@@ -114,15 +125,20 @@   main-is: Main.hs   other-modules:     AsyncTaskTests+    AuthorizationTests     CommentTests     DataSourceSearchTests     FakeNotion     HelpersTests     MeetingNotesTests+    OAuthExamplePlatform     OAuthTests     ObjectFieldTests     ResponseJSONTests     RuntimeTests+    TokenHTTPTests+    TokenRefreshTests+    TokenSourceTests     ViewTests     WireFormatTests @@ -137,6 +153,7 @@     base,     bytestring,     containers,+    directory,     http-api-data,     http-client,     http-client-tls,@@ -151,9 +168,24 @@     text,     time,     vector,+    wai >=3.2.4 && <3.3,+    warp >=3.4.13 && <3.5, -  ghc-options: -Wall+  ghc-options:+    -Wall+    -threaded +  if !os(windows)+    hs-source-dirs: notion-client-oauth-example+    other-modules:+      FileTokenStore+      Login+      OAuthExampleTests++    build-depends:+      filepath,+      unix >=2.8 && <2.9,+ executable notion-client-example   default-language: GHC2024   hs-source-dirs: notion-client-example@@ -188,3 +220,40 @@     vector,    ghc-options: -Wall++executable notion-client-oauth-example+  default-language: GHC2024+  hs-source-dirs: notion-client-oauth-example+  main-is: Main.hs+  other-modules:+    FileTokenStore+    Login++  default-extensions:+    DuplicateRecordFields+    OverloadedStrings+    RecordWildCards++  ghc-options:+    -Wall+    -threaded++  if os(windows)+    buildable: False+  else+    build-depends:+      aeson,+      base,+      bytestring,+      directory >=1.3 && <1.4,+      filepath,+      http-client-tls,+      http-types,+      notion-client,+      servant-client,+      text,+      time,+      unix >=2.8 && <2.9,+      vector,+      wai >=3.2.4 && <3.3,+      warp >=3.4.13 && <3.5,

@@ -0,0 +1,87 @@+{-# LANGUAGE GHC2024 #-}+{-# LANGUAGE DuplicateRecordFields #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-}++-- | Explicit live acceptance harness, never invoked by the offline suite.+-- Run after login/refresh with a current refresh-capable installation. It replaces+-- only the in-memory access token, keeps the current refresh token, and durably+-- saves the one replacement pair. It never probes a superseded refresh token.+module Main (main) where++import Control.Exception+import Control.Monad (unless)+import Data.IORef+import Data.Maybe (fromMaybe)+import Data.Text qualified as T+import FileTokenStore+import Network.HTTP.Client.TLS (newTlsManager)+import Notion.V1+import Notion.V1.OAuth qualified as O+import Notion.V1.OAuth.Refresh qualified as R+import Servant.Client (mkClientEnv)+import System.Environment+import System.Exit++main :: IO ()+main =+  run `catch` \(e :: SomeException) -> case fromException e of+    Just (exit :: ExitCode) -> throwIO exit+    Nothing | Just (_ :: AsyncException) <- fromException e -> throwIO e+    Nothing -> putStrLn "Live check failed; reauthorize after an uncertain exchange. No credentials printed." >> exitFailure++run :: IO ()+run = do+  client <- T.pack <$> getEnv "NOTION_OAUTH_CLIENT_ID"+  secret <- T.pack <$> getEnv "NOTION_OAUTH_CLIENT_SECRET"+  path <- fromMaybe ".notion-oauth-tokens.json" <$> lookupEnv "NOTION_OAUTH_TOKEN_FILE"+  withTokenFileLock path $ do+    let fileStore = fileTokenStore path+    old <- R.loadTokens fileStore+    unless (R.refreshToken old /= Nothing) (putStrLn "Live check requires a current refresh token" >> exitFailure)+    http <- newTlsManager+    let env = mkClientEnv http defaultBaseUrl+        baseOAuth = O.makeOAuthMethodsWith defaultClientConfig env (O.OAuthCredentials client secret)+    calls <- newIORef (0 :: Int)+    let oauth =+          baseOAuth+            { O.createOAuthToken = \grant -> do+                modifyIORef' calls (+ 1)+                response <- O.createOAuthToken baseOAuth grant+                putStrLn $+                  "OAuth owner decoded: " <> case O.owner response of+                    O.OAuthUserOwner _ -> "user"+                    O.OAuthWorkspaceOwner -> "workspace"+                    O.UnknownOAuthOwner _ -> "unknown"+                pure response+            }+        -- Do not write the intentionally invalid access token to disk.+        injectedStore = fileStore {R.loadTokens = pure old {R.accessToken = "intentionally-invalid-live-acceptance-token"}}+    manager <- R.newOAuthTokenManager oauth injectedStore+    let api = makeMethodsWithTokenSource defaultClientConfig env (R.tokenManagerSource manager)+    result <- try @R.TokenPersistenceError (retrieveMyUser api)+    case result of+      Right _ -> pure ()+      Left _ -> do+        retryPersistence manager+        _ <- retrieveMyUser api+        pure ()+    count <- readIORef calls+    saved <- R.loadTokens fileStore+    current <- R.currentTokens manager+    unless+      (count == 1 && saved == current && R.accessToken saved /= "intentionally-invalid-live-acceptance-token")+      (putStrLn "Live reactive-refresh assertions failed" >> exitFailure)+    unless (R.refreshToken saved /= Nothing) (putStrLn "No replacement refresh token; refreshing-installation gate remains pending" >> exitFailure)+    putStrLn "live unauthorized -> refresh -> retry succeeded: True"+    putStrLn "refresh requests: 1"+    putStrLn "persisted replacement: True"+    putStrLn ("access token changed: " <> show (R.accessToken old /= R.accessToken saved))+    putStrLn ("refresh token changed: " <> maybe "not returned" (\_ -> show (R.refreshToken old /= R.refreshToken saved)) (R.refreshToken saved))++retryPersistence :: R.OAuthTokenManager -> IO ()+retryPersistence manager = do+  putStrLn "Replacement retained in memory. Fix storage, then press Enter to retry saving; stopping may require login again."+  _ <- getLine+  result <- try @R.TokenPersistenceError (R.retryTokenPersistence manager)+  either (const (retryPersistence manager)) (const (pure ())) result

@@ -7,6 +7,7 @@ -- -- import Notion.V1 -- import Notion.V1.Pages+-- import Network.HTTP.Client.TLS (newTlsManager) -- import Data.Text qualified as Text -- import System.Environment qualified as Environment --@@ -28,6 +29,9 @@     makeMethods,     makeMethodsWith,     makeMethodsWithEnv,+    makeMethodsWithTokenSource,+    TokenSource (..),+    staticTokenSource,     Methods (..),      -- * Configuration@@ -46,6 +50,8 @@     -- * Runtime building blocks     RequestContext (..),     requestContextFor,+    requestContextWithTokenSource,+    withStandardHeaders,     standardHeaders,     responseTimeoutFor,     withRetries,@@ -79,11 +85,14 @@     legacyClientConfig,     noRetries,     requestContextFor,+    requestContextWithTokenSource,     responseTimeoutFor,     runClientWith,     standardHeaders,     stderrLogger,+    withAuthorizationHeader,     withRetries,+    withStandardHeaders,   ) import Notion.V1.Comments (CommentContent, CommentObject, CommentResponse) import Notion.V1.Comments qualified as Comments@@ -102,6 +111,7 @@ import Notion.V1.Pages qualified as Pages import Notion.V1.Search (SearchRequest) import Notion.V1.Search qualified as Search+import Notion.V1.TokenSource import Notion.V1.Users (UserID, UserObject) import Notion.V1.Users qualified as Users import Notion.V1.Views (ViewObject)@@ -146,10 +156,14 @@   -- | API token   Text ->   Methods-makeMethodsWithEnv config clientEnv token = Methods {..}+makeMethodsWithEnv config clientEnv token = makeMethodsWithTokenSource config clientEnv (staticTokenSource token)++-- | Keep Methods stable while reading a bearer token for each call. One typed+-- Unauthorized response can renew and replay the request once. Byte and+-- file-backed multipart bodies are replayable; arbitrary one-shot streams are not.+makeMethodsWithTokenSource :: ClientConfig -> ClientEnv -> TokenSource -> Methods+makeMethodsWithTokenSource config clientEnv source = Methods {..}   where-    context = requestContextFor config clientEnv token-    configuredEnv = configureClientEnv config clientEnv     ( ( createDatabase           :<|> retrieveDatabase           :<|> updateDatabase@@ -214,11 +228,12 @@           Proxy           run           (Client.client @API Proxy)-          (contextAuthorization context)+          "Bearer placeholder"           (notionVersion config)      run :: Client.ClientM a -> IO a-    run = runClientWith configuredEnv+    run clientM = withAuthorization source $ \auth ->+      runClientWith (configureClientEnv config (withAuthorizationHeader auth clientEnv)) clientM      -- Wrap retrievePageFiltered to provide backward-compatible retrievePage     retrievePage pid = retrievePageFiltered pid []

@@ -1,9 +1,11 @@ -- | Client runtime: configuration, timeout, retries and logging. -- -- 'Notion.V1.makeMethodsWith' builds 'Notion.V1.Methods' from a 'ClientConfig'.--- The building blocks below ('RequestContext', 'standardHeaders',--- 'responseTimeoutFor', 'withRetries') are exported so requests made outside--- Servant, such as streaming responses, behave exactly like 'Notion.V1.Methods'.+-- The building blocks below ('RequestContext', 'withStandardHeaders',+-- 'responseTimeoutFor', 'withRetries') let non-Servant requests share the runtime.+-- 'standardHeaders' reads current authorization in IO without renewal.+-- 'withStandardHeaders' can renew once around replayable response acquisition;+-- keep body consumption and user callbacks outside both retry wrappers. module Notion.V1.Client   ( -- * Configuration     ClientConfig (..),@@ -25,6 +27,9 @@     -- * Runtime building blocks     RequestContext (..),     requestContextFor,+    requestContextWithTokenSource,+    withStandardHeaders,+    withAuthorizationHeader,     standardHeaders,     configureClientEnv,     notionMiddleware,@@ -66,6 +71,7 @@     unknownResponseMessage,   ) import Notion.V1.Retry (RetryOptions (..), canRetry, defaultRetryOptions, noRetries, parseRetryAfter, retryDelay, validateRequestPath)+import Notion.V1.TokenSource import Paths_notion_client qualified import Servant.Client (BaseUrl (..), ClientEnv (..), ClientM, Scheme (..)) import Servant.Client qualified as Client@@ -155,28 +161,51 @@     contextManager :: HTTP.Manager,     -- | The effective base URL, for example @https://api.notion.com/v1@.     contextBaseUrl :: BaseUrl,-    -- | Full @Authorization@ header value, for example @Bearer secret_...@.-    contextAuthorization :: Text+    -- | Read afresh for every request; one source per installation.+    contextTokenSource :: TokenSource   }  -- | Build the context from the same inputs as 'Notion.V1.makeMethodsWithEnv': -- manager and base URL from the 'ClientEnv', and a bearer token. requestContextFor :: ClientConfig -> ClientEnv -> Text -> RequestContext-requestContextFor config ClientEnv {manager = m, baseUrl = b} token =-  RequestContext-    { contextConfig = config,-      contextManager = m,-      contextBaseUrl = b,-      contextAuthorization = "Bearer " <> token-    }+requestContextFor config env token = requestContextWithTokenSource config env (staticTokenSource token) --- | The @Authorization@, @Notion-Version@ and (when configured) @User-Agent@ headers.-standardHeaders :: RequestContext -> [Header]-standardHeaders RequestContext {contextConfig = ClientConfig {notionVersion, userAgent}, contextAuthorization} =-  [ ("Authorization", Text.encodeUtf8 contextAuthorization),-    ("Notion-Version", Text.encodeUtf8 notionVersion)-  ]+requestContextWithTokenSource :: ClientConfig -> ClientEnv -> TokenSource -> RequestContext+requestContextWithTokenSource config ClientEnv {manager = m, baseUrl = b} source =+  RequestContext config m b source++-- | Read the current token and attach standard headers, without renewal.+standardHeaders :: RequestContext -> IO [Header]+standardHeaders context@RequestContext {contextTokenSource} =+  headersWith context . ("Bearer " <>) <$> currentToken contextTokenSource++-- | Renew once on typed Unauthorized. Put normal retries inside the action.+-- Scope this to replayable request/response acquisition only. Never wrap stream+-- body consumption or a user callback, which must not be replayed.+withStandardHeaders :: RequestContext -> ([Header] -> IO a) -> IO a+withStandardHeaders context@RequestContext {contextTokenSource} action =+  withAuthorization contextTokenSource (action . headersWith context)++headersWith :: RequestContext -> Text -> [Header]+headersWith RequestContext {contextConfig = ClientConfig {notionVersion, userAgent}} auth =+  [("Authorization", Text.encodeUtf8 auth), ("Notion-Version", Text.encodeUtf8 notionVersion)]     <> userAgentHeader userAgent++-- | Replace authorization inside the runtime and outside caller middleware, so+-- each ordinary retry sees exactly one fresh header. OAuth Basic auth bypasses it.+withAuthorizationHeader :: Text -> ClientEnv -> ClientEnv+withAuthorizationHeader auth env =+  env+    { middleware = \app req ->+        middleware+          env+          app+          req+            { requestHeaders =+                Seq.singleton ("Authorization", Text.encodeUtf8 auth)+                  <> Seq.filter ((/= "Authorization") . fst) (requestHeaders req)+            }+    }  userAgentHeader :: Maybe Text -> [Header] userAgentHeader = maybe [] (\ua -> [("User-Agent", Text.encodeUtf8 ua)])

@@ -2,7 +2,8 @@ -- -- These endpoints authenticate with HTTP Basic auth using the integration's -- client ID and secret instead of a bearer token, so they have their own API--- type and methods record.+-- type and methods record. OAuth failures throw 'OAuthError'; requests are+-- never automatically retried, because grants may be consumed. -- -- @ -- manager <- newTlsManager@@ -30,6 +31,13 @@     OAuthRevokeResponse (..),     OAuthIntrospectResponse (..), +    -- * Errors+    OAuthErrorCode (..),+    oauthErrorCodeText,+    parseOAuthErrorCode,+    OAuthError (..),+    oauthErrorFromResponse,+     -- * Methods     OAuthMethods (..),     makeOAuthMethods,@@ -40,15 +48,21 @@   ) where +import Control.Applicative ((<|>))+import Control.Exception (Exception (..), catch, throwIO) import Data.Aeson ((.:), (.:?), (.=)) import Data.Aeson qualified as Aeson import Data.ByteString.Base64 qualified as Base64+import Data.List (find) import Data.Maybe (catMaybes) import Data.Proxy (Proxy (..))+import Data.Text qualified as T import Data.Text.Encoding qualified as Text import Notion.Prelude import Notion.V1.Client (ClientConfig (..), configureClientEnv, legacyClientConfig, runClientWith) import Notion.V1.Common (UUID)+import Notion.V1.Error qualified as Error+import Notion.V1.Retry (noRetries) import Servant.Client (ClientEnv) import Servant.Client qualified as Client import Prelude hiding (id)@@ -228,7 +242,107 @@       Client.hoistClient         @API         Proxy-        (runClientWith (configureClientEnv config env))+        (reinterpret . runClientWith (configureClientEnv safeConfig env))         (Client.client @API Proxy)         (basicAuthorization creds)         (notionVersion config)++    -- Only allow structured operational fields through the shared runtime logger.+    -- In particular, its debug response body and server-supplied message are secret-bearing.+    safeConfig = config {retryOptions = noRetries, logger = sanitize <$> logger config}+    sanitize write level _ fields =+      write level "OAuth request" (filter ((`elem` ["method", "path", "attempt", "delayMs", "code", "requestId"]) . fst) fields)++reinterpret :: IO a -> IO a+reinterpret action =+  action+    `catch` (\e@(Error.UnknownHTTPResponseError r) -> maybe (throwIO e) throwIO (oauthErrorFromResponse r))+    `catch` (\e@Error.NotionError {response} -> maybe (throwIO e) throwIO (response >>= oauthErrorFromResponse))++-- | OAuth token and authorization-redirect error codes (RFC 6749).+data OAuthErrorCode+  = OAuthInvalidRequest+  | OAuthInvalidClient+  | OAuthInvalidGrant+  | OAuthUnauthorizedClient+  | OAuthUnsupportedGrantType+  | OAuthInvalidScope+  | OAuthAccessDenied+  | OAuthUnsupportedResponseType+  | OAuthServerError+  | OAuthTemporarilyUnavailable+  | UnknownOAuthErrorCode Text+  deriving stock (Eq, Show)++knownOAuthCodes :: [(OAuthErrorCode, Text)]+knownOAuthCodes =+  [ (OAuthInvalidRequest, "invalid_request"),+    (OAuthInvalidClient, "invalid_client"),+    (OAuthInvalidGrant, "invalid_grant"),+    (OAuthUnauthorizedClient, "unauthorized_client"),+    (OAuthUnsupportedGrantType, "unsupported_grant_type"),+    (OAuthInvalidScope, "invalid_scope"),+    (OAuthAccessDenied, "access_denied"),+    (OAuthUnsupportedResponseType, "unsupported_response_type"),+    (OAuthServerError, "server_error"),+    (OAuthTemporarilyUnavailable, "temporarily_unavailable")+  ]++oauthErrorCodeText :: OAuthErrorCode -> Text+oauthErrorCodeText (UnknownOAuthErrorCode t) = t+oauthErrorCodeText c = maybe "" snd (find ((== c) . fst) knownOAuthCodes)++parseOAuthErrorCode :: Text -> OAuthErrorCode+parseOAuthErrorCode t = maybe (UnknownOAuthErrorCode t) fst (find ((== t) . snd) knownOAuthCodes)++instance FromJSON OAuthErrorCode where+  parseJSON = Aeson.withText "OAuthErrorCode" (pure . parseOAuthErrorCode)++instance ToJSON OAuthErrorCode where+  toJSON = String . oauthErrorCodeText++-- | Explicit metadata may contain secrets or untrusted server text. Default+-- rendering deliberately omits descriptions, bodies and headers.+data OAuthError = OAuthError+  { oauthErrorCode :: OAuthErrorCode,+    errorDescription :: Maybe Text,+    errorUri :: Maybe Text,+    requestId :: Maybe Text,+    response :: Maybe Error.HttpErrorResponse+  }+  deriving stock (Eq)++instance Show OAuthError where+  show OAuthError {oauthErrorCode, requestId, response} =+    "Notion OAuth request failed: "+      <> T.unpack (safeCode oauthErrorCode)+      <> maybe "" (\r -> " (HTTP " <> show (Error.httpStatus r) <> ")") response+      <> maybe "" (\r -> " [request " <> T.unpack r <> "]") requestId+    where+      safeCode (UnknownOAuthErrorCode _) = "unknown_oauth_error"+      safeCode c = oauthErrorCodeText c++instance Exception OAuthError where+  displayException = show++instance FromJSON OAuthError where+  parseJSON = Aeson.withObject "OAuthError" $ \o -> do+    c <- o .: "error"+    if T.null c+      then fail "Empty OAuth error"+      else+        OAuthError (parseOAuthErrorCode c) <$> o .:? "error_description" <*> o .:? "error_uri" <*> o .:? "request_id" <*> pure Nothing++-- | Recognize either OAuth's envelope or a known OAuth code in Notion's+-- documented envelope, only on OAuth routes.+oauthErrorFromResponse :: Error.HttpErrorResponse -> Maybe OAuthError+oauthErrorFromResponse r = do+  e@OAuthError {requestId} <- Aeson.decode (Error.errorBody r) <|> alternate+  pure e {response = Just r, requestId = requestId <|> Error.notionRequestId r}+  where+    alternate = do+      Error.NotionError {code, message, requestId} <- Aeson.decode (Error.errorBody r)+      let c = parseOAuthErrorCode (Error.apiErrorCodeText code)+      case c of+        UnknownOAuthErrorCode _ -> Nothing+        _ -> Just (OAuthError c (Just message) Nothing requestId Nothing)

@@ -0,0 +1,122 @@+-- | Protocol helpers for confidential-client OAuth login. The application must+-- bind each request to its initiating session, expire it, and atomically consume+-- it once on verified success or denial, before exchanging the code. This pure+-- verifier does not provide session storage, expiry or replay protection.+module Notion.V1.OAuth.Authorization+  ( OAuthState (..),+    newOAuthState,+    sameOAuthState,+    AuthorizationRequest (..),+    authorizationUrl,+    authorizationUrlWith,+    OAuthCode (..),+    AuthorizationCallbackError (..),+    verifyAuthorizationCallback,+    authorizationCodeGrant,+    exchangeAuthorizationCode,+  )+where++import Control.Exception (Exception)+import Control.Monad (forM, when)+import Data.ByteArray (constEq)+import Data.ByteString.Base64.URL qualified as Base64+import Data.Text (Text)+import Data.Text qualified as T+import Data.Text.Encoding qualified as T+import Network.HTTP.Types.URI (Query, renderQuery)+import Notion.V1.Client (defaultBaseUrl)+import Notion.V1.OAuth (AuthorizationCodeGrant (..), OAuthErrorCode (..), OAuthMethods (..), OAuthTokenRequest (..), OAuthTokenResponse, parseOAuthErrorCode)+import Servant.Client (BaseUrl, showBaseUrl)+import System.Entropy (getEntropy)++-- | Serialize explicitly with 'oauthStateText'; default rendering is redacted.+newtype OAuthState = OAuthState {oauthStateText :: Text}++instance Show OAuthState where show _ = "OAuthState <redacted>"++-- | 32 bytes of operating-system entropy, encoded as 43 URL-safe characters.+newOAuthState :: IO OAuthState+newOAuthState = OAuthState . T.decodeUtf8 . Base64.encodeUnpadded <$> getEntropy 32++-- | Constant-time byte comparison for equal-length values.+sameOAuthState :: OAuthState -> OAuthState -> Bool+sameOAuthState (OAuthState a) (OAuthState b) = constEq (T.encodeUtf8 a) (T.encodeUtf8 b)++data AuthorizationRequest = AuthorizationRequest+  {clientId :: Text, redirectUri :: Text, state :: OAuthState}++-- | Build the consent URL. The redirect URI must exactly match registration.+authorizationUrl :: AuthorizationRequest -> Text+authorizationUrl = authorizationUrlWith defaultBaseUrl++authorizationUrlWith :: BaseUrl -> AuthorizationRequest -> Text+authorizationUrlWith base AuthorizationRequest {clientId, redirectUri, state} =+  T.pack (showBaseUrl base)+    <> "/oauth/authorize"+    <> T.decodeUtf8+      ( renderQuery+          True+          [ ("client_id", Just (T.encodeUtf8 clientId)),+            ("response_type", Just "code"),+            ("owner", Just "user"),+            ("redirect_uri", Just (T.encodeUtf8 redirectUri)),+            ("state", Just (T.encodeUtf8 (oauthStateText state)))+          ]+      )++-- | A convenience wrapper, not proof that a caller verified the callback.+newtype OAuthCode = OAuthCode {oauthCodeText :: Text} deriving stock (Eq)++instance Show OAuthCode where show _ = "OAuthCode <redacted>"++data AuthorizationCallbackError+  = AuthorizationDenied OAuthErrorCode (Maybe Text)+  | StateMismatch+  | MissingCode+  | MalformedCallback+  deriving stock (Eq)++instance Show AuthorizationCallbackError where+  show (AuthorizationDenied code _) =+    "AuthorizationDenied " <> case code of+      UnknownOAuthErrorCode _ -> "<unknown code>"+      _ -> show code+  show StateMismatch = "StateMismatch"+  show MissingCode = "MissingCode"+  show MalformedCallback = "MalformedCallback"++instance Exception AuthorizationCallbackError++-- | Input values are already percent-decoded by WAI or parseQuery. Unknown+-- fields are ignored. Descriptions are untrusted display data.+verifyAuthorizationCallback :: OAuthState -> Query -> Either AuthorizationCallbackError OAuthCode+verifyAuthorizationCallback expected query = do+  fields <- forM ["state", "code", "error", "error_description", "error_uri"] $ \key -> do+    value <- case [v | (k, v) <- query, k == key] of+      [] -> Right Nothing+      [Just bytes] -> either (const (Left MalformedCallback)) (Right . Just) (T.decodeUtf8' bytes)+      _ -> Left MalformedCallback+    pure (key, value)+  let get key = lookup key fields >>= id+      returnedState = get "state"+      code = get "code"+      err = get "error"+  when (code /= Nothing && err /= Nothing) (Left MalformedCallback)+  case returnedState of+    Just s | not (T.null s), not (T.null (oauthStateText expected)), sameOAuthState expected (OAuthState s) -> pure ()+    _ -> Left StateMismatch+  case err of+    Just "" -> Left MalformedCallback+    Just e -> Left (AuthorizationDenied (parseOAuthErrorCode e) (get "error_description"))+    Nothing -> case code of+      Just c | not (T.null c) -> Right (OAuthCode c)+      _ -> Left MissingCode++-- | Sends the exact redirect URI from the initiating request.+authorizationCodeGrant :: AuthorizationRequest -> OAuthCode -> OAuthTokenRequest+authorizationCodeGrant AuthorizationRequest {redirectUri} (OAuthCode code) =+  AuthorizationCode AuthorizationCodeGrant {code, redirectUri = Just redirectUri, externalAccount = Nothing}++exchangeAuthorizationCode :: OAuthMethods -> AuthorizationRequest -> OAuthCode -> IO OAuthTokenResponse+exchangeAuthorizationCode oauth req = createOAuthToken oauth . authorizationCodeGrant req

@@ -0,0 +1,187 @@+-- | Rotation-safe token management for one installation in one process.+-- Use exactly one manager per installation. Separate managers/processes must+-- coordinate the whole load/refresh/save transaction externally. A save-time+-- compare-and-swap cannot prevent competing remote refreshes. Process crashes+-- between remote rotation and durable save may require fresh authorization.+module Notion.V1.OAuth.Refresh+  ( OAuthTokens (..),+    oauthTokensFromResponse,+    TokenStore (..),+    inMemoryTokenStore,+    ReauthorizationRequired (..),+    TokenPersistenceError,+    RefreshOutcomeUnknown,+    OAuthTokenManager,+    newOAuthTokenManager,+    tokenManagerSource,+    currentTokens,+    refreshTokensNow,+    retryTokenPersistence,+  )+where++import Control.Concurrent.MVar+import Control.Exception+import Data.IORef+import Data.Text qualified as T+import Data.Time.Clock+import Notion.Prelude+import Notion.V1.OAuth qualified as O+import Notion.V1.TokenSource++-- | Persisted credentials. Explicit JSON contains secrets; Show never does.+data OAuthTokens = OAuthTokens+  { accessToken :: Text,+    refreshToken :: Maybe Text,+    botId :: Text,+    workspaceId :: Text,+    workspaceName :: Maybe Text,+    obtainedAt :: UTCTime+  }+  deriving stock (Eq, Generic)++instance Show OAuthTokens where show _ = "OAuthTokens <redacted>"++instance ToJSON OAuthTokens where toJSON = genericToJSON aesonOptions++instance FromJSON OAuthTokens where parseJSON = genericParseJSON aesonOptions++oauthTokensFromResponse :: UTCTime -> O.OAuthTokenResponse -> OAuthTokens+oauthTokensFromResponse obtainedAt O.OAuthTokenResponse {accessToken, refreshToken, botId, workspaceId, workspaceName} = OAuthTokens {..}++-- | Save must be idempotent for the same pair, meet the application's durability+-- contract before returning, and never call back into its manager.+data TokenStore = TokenStore {loadTokens :: IO OAuthTokens, saveTokens :: OAuthTokens -> IO ()}++inMemoryTokenStore :: OAuthTokens -> IO TokenStore+inMemoryTokenStore tokens = do+  ref <- newIORef tokens+  pure (TokenStore (readIORef ref) (atomicWriteIORef ref))++newtype ReauthorizationRequired = ReauthorizationRequired {reauthorizationCause :: Maybe O.OAuthError}+  deriving stock (Show)++instance Exception ReauthorizationRequired++data TokenPersistenceError = TokenPersistenceError deriving stock (Eq, Show)++instance Exception TokenPersistenceError where+  displayException _ = "OAuth token persistence failed; retry saving the retained pair"++data RefreshOutcomeUnknown = RefreshOutcomeUnknown deriving stock (Eq, Show)++instance Exception RefreshOutcomeUnknown where+  displayException _ = "OAuth refresh outcome unknown; authorize again without replaying the refresh token"++-- Every state retains the last known pair for explicit recovery.+data Lifecycle+  = Ready OAuthTokens+  | PendingPersistence OAuthTokens+  | NeedsReauthorization OAuthTokens (Maybe O.OAuthError)+  | UncertainOutcome OAuthTokens++data OAuthTokenManager = OAuthTokenManager (MVar Lifecycle) O.OAuthMethods TokenStore++newOAuthTokenManager :: O.OAuthMethods -> TokenStore -> IO OAuthTokenManager+newOAuthTokenManager oauth store = do+  tokens <- loadTokens store+  OAuthTokenManager <$> newMVar (Ready tokens) <*> pure oauth <*> pure store++knownTokens :: Lifecycle -> OAuthTokens+knownTokens = \case+  Ready t -> t+  PendingPersistence t -> t+  NeedsReauthorization t _ -> t+  UncertainOutcome t -> t++-- | Inspection/recovery only. This may return an unusable or unsaved pair.+-- Authorize requests through 'tokenManagerSource', which enforces lifecycle.+currentTokens :: OAuthTokenManager -> IO OAuthTokens+currentTokens (OAuthTokenManager lock _ _) = knownTokens <$> readMVar lock++usable :: Lifecycle -> Either SomeException OAuthTokens+usable = \case+  Ready t -> Right t+  PendingPersistence _ -> Left (toException TokenPersistenceError)+  NeedsReauthorization _ cause -> Left (toException (ReauthorizationRequired cause))+  UncertainOutcome _ -> Left (toException RefreshOutcomeUnknown)++tokenManagerSource :: OAuthTokenManager -> TokenSource+tokenManagerSource manager@(OAuthTokenManager lock _ _) =+  TokenSource+    { currentToken = do+        state <- readMVar lock+        accessToken <$> either throwIO pure (usable state),+      renewToken = \rejected ->+        Just . accessToken+          <$> transition+            manager+            ( \restore state ->+                case usable state of+                  Left e -> pure (state, Left e)+                  Right tokens | accessToken tokens /= rejected -> pure (state, Right tokens)+                  Right tokens -> rotate manager restore tokens+            )+    }++-- The result is rethrown only after the new lifecycle has been published.+-- A surprise exception must never restore Ready with a possibly consumed grant.+transition ::+  OAuthTokenManager ->+  ((forall a. IO a -> IO a) -> Lifecycle -> IO (Lifecycle, Either SomeException b)) ->+  IO b+transition (OAuthTokenManager lock _ _) action = do+  result <- mask $ \restore -> do+    old <- takeMVar lock+    (new, outcome) <-+      action restore old `catch` \(e :: SomeException) ->+        pure (UncertainOutcome (knownTokens old), Left e)+    putMVar lock new+    pure outcome+  either throwIO pure result++rotate ::+  OAuthTokenManager ->+  (forall a. IO a -> IO a) ->+  OAuthTokens ->+  IO (Lifecycle, Either SomeException OAuthTokens)+rotate manager@(OAuthTokenManager _ oauth _) restore old = case refreshToken old of+  Nothing -> pure (NeedsReauthorization old Nothing, Left (toException (ReauthorizationRequired Nothing)))+  Just rt -> do+    response <- try @SomeException (restore (O.createOAuthToken oauth (O.RefreshToken rt)))+    case response of+      Left e+        | Just oe@O.OAuthError {oauthErrorCode = O.OAuthInvalidGrant} <- fromException e ->+            pure (NeedsReauthorization old (Just oe), Left (toException (ReauthorizationRequired (Just oe))))+      Left e | Just (_ :: O.OAuthError) <- fromException e -> pure (Ready old, Left e)+      Left e -> pure (UncertainOutcome old, Left e)+      Right r@O.OAuthTokenResponse {accessToken = access, tokenType, botId = bot, workspaceId = workspace}+        | T.null access || T.toLower tokenType /= "bearer" || bot /= botId old || workspace /= workspaceId old ->+            pure (UncertainOutcome old, Left (toException RefreshOutcomeUnknown))+        | otherwise -> do+            now <- getCurrentTime+            persist manager restore (oauthTokensFromResponse now r)++persist ::+  OAuthTokenManager ->+  (forall a. IO a -> IO a) ->+  OAuthTokens ->+  IO (Lifecycle, Either SomeException OAuthTokens)+persist (OAuthTokenManager _ _ store) restore tokens = do+  saved <- try @SomeException (restore (saveTokens store tokens))+  pure $ case saved of+    Right () -> (Ready tokens, Right tokens)+    Left _ -> (PendingPersistence tokens, Left (toException TokenPersistenceError))++-- | Explicit calls serialize, but each may rotate. Automatic rejections share+-- a completed rotation by comparing the rejected access token under the lock.+refreshTokensNow :: OAuthTokenManager -> IO OAuthTokens+refreshTokensNow manager = transition manager $ \restore state -> case usable state of+  Left e -> pure (state, Left e)+  Right t -> rotate manager restore t++-- | Save the identical retained pair without making another OAuth request.+retryTokenPersistence :: OAuthTokenManager -> IO OAuthTokens+retryTokenPersistence manager = transition manager $ \restore state -> case state of+  PendingPersistence t -> persist manager restore t+  _ -> pure (state, usable state)

@@ -54,13 +54,9 @@ -- -- @ -- allPages <- paginateAll $ \\cursor ->---   queryDataSource methods dsId QueryDataSource---     { filter = Nothing---     , sorts = Nothing---     , startCursor = cursor+--   queryDataSource methods dsId _QueryDataSource+--     { startCursor = cursor --     , pageSize = Just 100---     , inTrash = Nothing---     , filterProperties = Nothing --     } -- @ paginateAll :: (Maybe Text -> IO (ListOf a)) -> IO (Vector a)

@@ -0,0 +1,30 @@+-- | Per-request bearer authorization and a single reactive renewal.+module Notion.V1.TokenSource (TokenSource (..), staticTokenSource, withAuthorization) where++import Control.Exception (throwIO, try)+import Data.Text (Text)+import Notion.V1.Error (APIErrorCode (Unauthorized), NotionError (..))++-- | One source per installation. Tokens exclude the @Bearer @ prefix.+data TokenSource = TokenSource+  { currentToken :: IO Text,+    -- | Renew after rejection, or return a token another request obtained.+    -- Nothing means no renewal is available. Exceptions propagate in IO.+    renewToken :: Text -> IO (Maybe Text)+  }++staticTokenSource :: Text -> TokenSource+staticTokenSource token = TokenSource (pure token) (const (pure Nothing))++-- | Replay once only on typed Unauthorized. The action must be replayable.+-- Scope this to request acquisition, never a stream body or user callback.+withAuthorization :: TokenSource -> (Text -> IO a) -> IO a+withAuthorization TokenSource {currentToken, renewToken} action = do+  token <- currentToken+  result <- try (action ("Bearer " <> token))+  case result of+    Right a -> pure a+    Left e@NotionError {code = Unauthorized} -> do+      replacement <- renewToken token+      maybe (throwIO e) (action . ("Bearer " <>)) replacement+    Left e -> throwIO e

@@ -0,0 +1,73 @@+module AuthorizationTests (tests) where++import Data.Aeson qualified as A+import Data.ByteString qualified as BS+import Data.IORef (readIORef)+import Data.Text qualified as T+import FakeNotion+import Network.HTTP.Types.URI (parseQuery)+import Notion.V1 (defaultClientConfig)+import Notion.V1.OAuth+import Notion.V1.OAuth.Authorization+import OAuthTests (credentials, personOwner, tokenJson)+import Test.Tasty+import Test.Tasty.HUnit++tests :: TestTree+tests =+  testGroup+    "Authorization"+    [ testCase "authorization URL is exact" $+        authorizationUrl req @?= "https://api.notion.com/v1/oauth/authorize?client_id=client&response_type=code&owner=user&redirect_uri=http%3A%2F%2Flocalhost%3A8765%2Fcallback&state=s-123",+      testCase "secure state is 43 URL-safe characters and rendering redacts" $ do+        a <- newOAuthState+        b <- newOAuthState+        T.length (oauthStateText a) @?= 43+        assertBool "URL safe" (T.all (`elem` (['A' .. 'Z'] <> ['a' .. 'z'] <> ['0' .. '9'] <> "-_")) (oauthStateText a))+        assertBool "fresh" (not (sameOAuthState a b))+        show a @?= "OAuthState <redacted>"+        show (OAuthCode "secret") @?= "OAuthCode <redacted>"+        show (AuthorizationDenied (UnknownOAuthErrorCode "SECRET") (Just "SECRET")) @?= "AuthorizationDenied <unknown code>",+      testCase "constant-time primitive rejects differing bytes and lengths" $ do+        assertBool "equal" (sameOAuthState (OAuthState "aa") (OAuthState "aa"))+        mapM_ (\s -> assertBool "different" (not (sameOAuthState (OAuthState "aa") (OAuthState s)))) ["ab", "a", "bb"],+      testCase "callback success and one decoding pass" $ do+        verify "?code=c-1&state=s-123" @?= Right (OAuthCode "c-1")+        verify "?code=a%2Bb&state=s-123&unknown=x" @?= Right (OAuthCode "a+b"),+      testCase "denial requires state and preserves unknown codes" $ do+        verify "?error=access_denied&state=s-123" @?= Left (AuthorizationDenied OAuthAccessDenied Nothing)+        verify "?error=access_denied&state=s-123&error_description=User%20cancelled" @?= Left (AuthorizationDenied OAuthAccessDenied (Just "User cancelled"))+        verify "?error=slow_down&state=s-123" @?= Left (AuthorizationDenied (UnknownOAuthErrorCode "slow_down") Nothing)+        mapM_ (\q -> verify q @?= Left StateMismatch) ["?error=access_denied", "?error=access_denied&state=other", "?code=c-1", "?code=c-1&state=other"]+        verifyAuthorizationCallback (OAuthState "") (parseQuery "?code=c&state=") @?= Left StateMismatch,+      testCase "missing and empty code" $+        mapM_ (\q -> verify q @?= Left MissingCode) ["?state=s-123", "?code=&state=s-123"],+      testCase "malformed ambiguous callbacks rejected" $+        mapM_+          (\q -> verify q @?= Left MalformedCallback)+          [ "?code=a&code=a&state=s-123",+            "?state=s-123&state=s-123",+            "?error=x&error=x&state=s-123",+            "?code=c&error=x&state=s-123",+            "?code&state=s-123",+            "?state=s-123&error=",+            "?state=s-123&error_uri",+            "?state=s-123&code=%FF",+            "?state=s-123&error_description=%FF",+            "?state=s-123&error_uri=x&error_uri=x"+          ],+      testCase "code exchange includes redirect URI and Basic authentication" $ do+        A.toJSON (authorizationCodeGrant req (OAuthCode "c-1"))+          @?= A.object+            ["grant_type" A..= ("authorization_code" :: T.Text), "code" A..= ("c-1" :: T.Text), "redirect_uri" A..= ("http://localhost:8765/callback" :: T.Text)]+        (env, recorded) <- fakeClientEnv [jsonReply 200 (tokenJson personOwner)]+        _ <- exchangeAuthorizationCode (makeOAuthMethodsWith defaultClientConfig env credentials) req (OAuthCode "c-1")+        rs <- readIORef recorded+        map method rs @?= ["POST"]+        map path rs @?= ["/oauth/token"]+        map (lookupRecordedHeader "Authorization") rs @?= [Just "Basic Y2xpZW50OnNlY3JldA=="]+    ]+  where+    verify :: BS.ByteString -> Either AuthorizationCallbackError OAuthCode+    verify = verifyAuthorizationCallback (OAuthState "s-123") . parseQuery+    req = AuthorizationRequest "client" "http://localhost:8765/callback" (OAuthState "s-123")

@@ -6,6 +6,7 @@   ( Recorded (..),     FakeReply (..),     fakeClientEnv,+    fakeClientEnvWith,     fakeBaseUrl,     jsonReply,     lookupRecordedHeader,@@ -19,7 +20,7 @@ import Data.ByteString.Builder (toLazyByteString) import Data.ByteString.Lazy qualified as LBS import Data.Foldable (toList)-import Data.IORef (IORef, atomicModifyIORef', modifyIORef', newIORef)+import Data.IORef (IORef, atomicModifyIORef', newIORef) import Network.HTTP.Client (defaultManagerSettings, newManager) import Network.HTTP.Types (Header, HeaderName, Method, http11, mkStatus) import Servant.Client (BaseUrl (..), ClientEnv (..), ClientError (..), Scheme (..), mkClientEnv)@@ -54,21 +55,22 @@ -- | A 'ClientEnv' answering from the script, and the requests it records. fakeClientEnv :: [FakeReply] -> IO (ClientEnv, IORef [Recorded]) fakeClientEnv script = do-  manager <- newManager defaultManagerSettings   remaining <- newIORef script+  fakeClientEnvWith $ \_ -> do+    next <- atomicModifyIORef' remaining (\case [] -> ([], Nothing); r : rs -> (rs, Just r))+    maybe (ioError (userError "FakeNotion: script exhausted")) pure next++-- | Header-dependent replies, with an atomic request recorder.+fakeClientEnvWith :: (Recorded -> IO FakeReply) -> IO (ClientEnv, IORef [Recorded])+fakeClientEnvWith reply = do+  manager <- newManager defaultManagerSettings   recorded <- newIORef []   let mw _realApp req = do-        liftIO $-          modifyIORef'-            recorded-            (<> [Recorded (requestMethod req) (toLazyByteString (requestPath req)) (toList (requestHeaders req))])-        next <- liftIO $ atomicModifyIORef' remaining (\case [] -> ([], Nothing); r : rs -> (rs, Just r))-        FakeReply {status, replyHeaders, body} <--          maybe (liftIO (ioError (userError "FakeNotion: script exhausted"))) pure next+        let request = Recorded (requestMethod req) (toLazyByteString (requestPath req)) (toList (requestHeaders req))+        liftIO $ atomicModifyIORef' recorded (\rs -> (rs <> [request], ()))+        FakeReply {status, replyHeaders, body} <- liftIO (reply request)         let resp = Response (mkStatus status "") (foldMap pure replyHeaders) http11 body         if status >= 200 && status < 300           then pure resp-          else-            throwError-              (FailureResponse (bimap (const ()) (\p -> (fakeBaseUrl, LBS.toStrict (toLazyByteString p))) req) resp)+          else throwError (FailureResponse (bimap (const ()) (\p -> (fakeBaseUrl, LBS.toStrict (toLazyByteString p))) req) resp)   pure ((mkClientEnv manager fakeBaseUrl) {middleware = mw}, recorded)

@@ -1,6 +1,7 @@ module Main where  import AsyncTaskTests qualified+import AuthorizationTests qualified import CommentTests qualified import Data.Aeson qualified as Aeson import Data.Aeson.Key qualified as Key@@ -56,6 +57,7 @@ import Notion.V1.Users (BotUser (..), UserObject (..), WorkspaceLimits (..)) import Notion.V1.Views (Clearable (..), CreateView (..), UpdateView (..), ViewObject (..), ViewType (..)) import Notion.V1.Views qualified as Views+import OAuthExamplePlatform qualified import OAuthTests qualified import ObjectFieldTests qualified import ResponseJSONTests qualified@@ -63,6 +65,9 @@ import System.Environment qualified as Environment import Test.Tasty import Test.Tasty.HUnit+import TokenHTTPTests qualified+import TokenRefreshTests qualified+import TokenSourceTests qualified import ViewTests qualified import Web.HttpApiData (toQueryParam) import WireFormatTests qualified@@ -184,6 +189,11 @@         ResponseJSONTests.tests,         RuntimeTests.tests,         OAuthTests.tests,+        AuthorizationTests.tests,+        TokenSourceTests.tests,+        TokenRefreshTests.tests,+        TokenHTTPTests.tests,+        OAuthExamplePlatform.tests,         HelpersTests.tests,         ViewTests.tests,         DataSourceSearchTests.tests,

@@ -0,0 +1,18 @@+{-# LANGUAGE GHC2024 #-}+{-# LANGUAGE CPP #-}++module OAuthExamplePlatform (tests) where++#ifndef mingw32_HOST_OS+import OAuthExampleTests qualified+import Test.Tasty (TestTree)+#else+import Test.Tasty (TestTree, testGroup)+#endif++tests :: TestTree+#ifndef mingw32_HOST_OS+tests = OAuthExampleTests.tests+#else+tests = testGroup "OAuthExample (POSIX only)" []+#endif

@@ -0,0 +1,210 @@+{-# LANGUAGE GHC2024 #-}++module OAuthExampleTests (tests) where++import Control.Concurrent+import Control.Exception+import Data.Aeson qualified as A+import Data.Bits ((.&.))+import Data.ByteString qualified as BS+import Data.ByteString.Lazy qualified as L+import Data.IORef+import Data.Time.Clock+import FileTokenStore+import Login+import Network.HTTP.Client qualified as H+import Network.HTTP.Types qualified as T+import Network.Wai qualified as W+import Network.Wai.Handler.Warp qualified as Warp+import Notion.V1.OAuth qualified as O+import Notion.V1.OAuth.Authorization qualified as Auth+import Notion.V1.OAuth.Refresh qualified as R+import OAuthTests (personOwner, tokenJson)+import System.Directory qualified as D+import System.FilePath+import System.Posix.Files qualified as F+import System.Posix.Temp (mkdtemp)+import Test.Tasty+import Test.Tasty.HUnit+import TokenSourceTests (bounded)++request :: Auth.AuthorizationRequest+request = Auth.AuthorizationRequest "client" "http://localhost:8765/callback" (Auth.OAuthState "fixed-state")++fixture :: IO (R.OAuthTokens, O.OAuthTokenResponse)+fixture = do+  response <- either assertFailure pure (A.eitherDecode (tokenJson personOwner))+  now <- getCurrentTime+  pure (R.oauthTokensFromResponse now response, response)++oauth :: IO O.OAuthTokenResponse -> O.OAuthMethods+oauth action = O.OAuthMethods (const action) (const (pure (O.OAuthRevokeResponse Nothing))) (const (pure (O.OAuthIntrospectResponse False Nothing Nothing Nothing)))++get :: H.Manager -> Int -> String -> IO (H.Response L.ByteString)+get manager port query = H.parseRequest ("http://127.0.0.1:" <> show port <> query) >>= \r -> H.httpLbs r manager++withDirectory :: (FilePath -> IO a) -> IO a+withDirectory = bracket (mkdtemp "/tmp/notion-oauth-tests-") D.removePathForcibly++tests :: TestTree+tests =+  testGroup+    "OAuthExample"+    [ testCase "invalid callback leaves login pending; valid callback saves before success" $ bounded $ do+        (tokens, response) <- fixture+        store <- R.inMemoryTokenStore tokens+        calls <- newIORef (0 :: Int)+        let exchange = modifyIORef' calls (+ 1) >> pure response+        (app, result) <- newLoginApplication (oauth exchange) store request "/callback"+        Warp.testWithApplication (pure app) $ \port -> do+          manager <- H.newManager H.defaultManagerSettings+          bad <- get manager port "/callback?code=secret-code&state=forged"+          H.responseStatus bad @?= T.status400+          readIORef calls >>= (@?= 0)+          success <- get manager port "/callback?code=secret-code&state=fixed-state"+          H.responseStatus success @?= T.status200+          H.responseBody success @?= "Connected"+          lookup "Cache-Control" (H.responseHeaders success) @?= Just "no-store"+          lookup "Referrer-Policy" (H.responseHeaders success) @?= Just "no-referrer"+          result >>= \case Connected _ -> pure (); other -> assertFailure (show other)+          readIORef calls >>= (@?= 1)+          duplicate <- get manager port "/callback?code=secret-code&state=fixed-state"+          H.responseStatus duplicate @?= T.status409+          readIORef calls >>= (@?= 1),+      testCase "denial requires state, consumes once, and never exchanges" $ bounded $ do+        (tokens, _) <- fixture+        store <- R.inMemoryTokenStore tokens+        (app, result) <- newLoginApplication (oauth (assertFailure "must not exchange")) store request "/callback"+        Warp.testWithApplication (pure app) $ \port -> do+          manager <- H.newManager H.defaultManagerSettings+          bad <- get manager port "/callback?error=access_denied"+          H.responseStatus bad @?= T.status400+          cancelled <- get manager port "/callback?error=access_denied&state=fixed-state&error_description=%3Cscript%3Esecret%3C%2Fscript%3E"+          H.responseBody cancelled @?= "Consent was cancelled"+          result >>= \case Cancelled -> pure (); other -> assertFailure (show other)+          duplicate <- get manager port "/callback?error=access_denied&state=fixed-state"+          H.responseStatus duplicate @?= T.status409,+      testCase "concurrent duplicates exchange once; no success before save returns" $ bounded $ do+        (tokens, response) <- fixture+        calls <- newIORef (0 :: Int)+        saving <- newEmptyMVar+        release <- newEmptyMVar+        first <- newEmptyMVar+        let store = R.TokenStore (pure tokens) (\_ -> putMVar saving () >> takeMVar release)+        (app, _) <- newLoginApplication (oauth (modifyIORef' calls (+ 1) >> pure response)) store request "/callback"+        Warp.testWithApplication (pure app) $ \port -> do+          manager <- H.newManager H.defaultManagerSettings+          _ <- forkFinally (get manager port "/callback?code=one&state=fixed-state") (putMVar first)+          takeMVar saving+          isEmptyMVar first >>= assertBool "no response before persistence"+          duplicate <- get manager port "/callback?code=two&state=fixed-state"+          H.responseStatus duplicate @?= T.status409+          readIORef calls >>= (@?= 1)+          putMVar release ()+          takeMVar first >>= either (assertFailure . displayException) (\r -> H.responseBody r @?= "Connected"),+      testCase "initial save failure retains credentials for retry without another exchange" $ bounded $ do+        (tokens, response) <- fixture+        broken <- newIORef True+        saved <- newIORef []+        calls <- newIORef (0 :: Int)+        let store =+              R.TokenStore+                (pure tokens)+                ( \pair -> do+                    modifyIORef' saved (<> [pair])+                    readIORef broken >>= \b -> if b then ioError (userError "SECRET") else pure ()+                )+        (app, result) <- newLoginApplication (oauth (modifyIORef' calls (+ 1) >> pure response)) store request "/callback"+        Warp.testWithApplication (pure app) $ \port -> do+          manager <- H.newManager H.defaultManagerSettings+          failed <- get manager port "/callback?code=SECRET&state=fixed-state"+          H.responseStatus failed @?= T.status500+          assertBool "no reflected secret" (not ("SECRET" `BS.isInfixOf` L.toStrict (H.responseBody failed)))+          result >>= \case+            SavePending pair -> do+              show (SavePending pair) @?= "SavePending"+              writeIORef broken False+              R.saveTokens store pair+              readIORef saved >>= (@?= [pair, pair])+            other -> assertFailure (show other)+          readIORef calls >>= (@?= 1),+      testCase "exchange failures and unrelated paths produce generic pages" $ bounded $ do+        (tokens, _) <- fixture+        store <- R.inMemoryTokenStore tokens+        (app, result) <- newLoginApplication (oauth (ioError (userError "SECRET <script>"))) store request "/callback"+        Warp.testWithApplication (pure app) $ \port -> do+          manager <- H.newManager H.defaultManagerSettings+          notFound <- get manager port "/other?code=SECRET&state=fixed-state"+          H.responseStatus notFound @?= T.status404+          failed <- get manager port "/callback?code=SECRET&state=fixed-state"+          H.responseBody failed @?= "Connection failed; start login again"+          result >>= \case LoginFailed -> pure (); other -> assertFailure (show other),+      testCase "startup failure propagates before announcement; timeout closes listener" $ bounded $ do+        (tokens, response) <- fixture+        store <- R.inMemoryTokenStore tokens+        announced <- newIORef False+        let emptyApp _ respond = respond (W.responseLBS T.status200 [] "")+        Warp.testWithApplication (pure emptyApp) $ \busy -> do+          failure <- try @IOException (runLogin busy 20000 (oauth (pure response)) store request (writeIORef announced True))+          assertBool "bind failure" (either (const True) (const False) failure)+          readIORef announced >>= (@?= False)+        free <- Warp.testWithApplication (pure emptyApp) pure+        runLogin free 20000 (oauth (pure response)) store request (writeIORef announced True) >>= \case+          LoginExpired -> pure ()+          other -> assertFailure (show other)+        readIORef announced >>= (@?= True)+        -- Rebinding the same port after timeout proves the listener was released.+        runLogin free 1000 (oauth (pure response)) store request (pure ()) >>= \case+          LoginExpired -> pure ()+          other -> assertFailure (show other),+      testCase "redirect configuration requires a path without query or fragment" $ do+        Auth.oauthStateText (Auth.state request) @?= "fixed-state"+        callbackPath "http://localhost:8765/callback" @?= Right "/callback"+        callbackPath "https://tunnel.example/cb/path" @?= Right "/cb/path"+        mapM_ (\uri -> assertBool "rejected" (either (const True) (const False) (callbackPath uri))) ["/relative", "http://localhost", "http://localhost/cb?x=y", "http://localhost/cb#f", "http://user@localhost/cb"],+      testCase "file replacement is private complete and loads on restart" $ withDirectory $ \directory -> do+        (tokens, _) <- fixture+        let path = directory </> "tokens.json"+            store = fileTokenStore path+            replacement = tokens {R.accessToken = "new-access", R.refreshToken = Just "new-refresh"}+        tokenFileExists path >>= (@?= False)+        R.saveTokens store tokens+        mode <- F.fileMode <$> F.getFileStatus path+        mode .&. 0o077 @?= 0+        R.saveTokens store replacement+        R.loadTokens (fileTokenStore path) >>= (@?= replacement)+        L.readFile path >>= \bytes -> A.decode bytes @?= Just replacement+        D.listDirectory directory >>= (@?= ["tokens.json"]),+      testCase "pre-rename failure preserves old destination and cleans owned temporary" $ withDirectory $ \directory -> do+        (tokens, _) <- fixture+        let path = directory </> "tokens.json"+            store = fileTokenStore path+        R.saveTokens store tokens+        failed <- try @SomeException (R.saveTokens store tokens {R.workspaceName = Just (error "injected encoding failure")})+        assertBool "failed" (either (const True) (const False) failed)+        R.loadTokens store >>= (@?= tokens)+        D.listDirectory directory >>= (@?= ["tokens.json"]),+      testCase "reject symlink token paths and unsafe destination directories" $ withDirectory $ \directory -> do+        (tokens, _) <- fixture+        let target = directory </> "target.json"+            link = directory </> "tokens.json"+        R.saveTokens (fileTokenStore target) tokens+        F.createSymbolicLink target link+        failure <- try @IOException (R.saveTokens (fileTokenStore link) tokens)+        assertBool "symlink rejected" (either (const True) (const False) failure)+        R.loadTokens (fileTokenStore target) >>= (@?= tokens)+        F.setFileMode directory 0o777+        unsafe <- try @IOException (R.saveTokens (fileTokenStore target) tokens)+        F.setFileMode directory 0o700+        assertBool "unsafe directory rejected" (either (const True) (const False) unsafe),+      testCase "command lock excludes a second command and confirmed logout clears file" $ withDirectory $ \directory -> do+        (tokens, _) <- fixture+        let path = directory </> "tokens.json"+        withTokenFileLock path $ do+          R.saveTokens (fileTokenStore path) tokens+          second <- try @IOException (withTokenFileLock path (assertFailure "must not acquire"))+          assertBool "second command refused" (either (const True) (const False) second)+          R.loadTokens (fileTokenStore path) >>= (@?= tokens)+        withTokenFileLock path (removeTokenFile path)+        tokenFileExists path >>= (@?= False)+    ]

@@ -1,12 +1,19 @@ -- | Tests for the OAuth endpoints.-module OAuthTests (tests) where+module OAuthTests (tests, tokenJson, personOwner, credentials) where +import Control.Exception (SomeException, displayException, fromException, throwIO, try)+import Control.Monad (forM_)+import Control.Monad.IO.Class (liftIO) import Data.Aeson qualified as Aeson import Data.ByteString.Lazy.Char8 qualified as L8-import Data.IORef (readIORef)+import Data.IORef (modifyIORef', newIORef, readIORef)+import Data.List (isInfixOf) import FakeNotion import Notion.V1 (defaultClientConfig)+import Notion.V1.Client (ClientConfig (..), LogLevel (..))+import Notion.V1.Error qualified as E import Notion.V1.OAuth+import Servant.Client (ClientEnv (..)) import Test.Tasty import Test.Tasty.HUnit @@ -14,65 +21,67 @@ tests =   testGroup     "OAuth"-    [ testCase "basicAuthorization encodes client_id:client_secret" $-        basicAuthorization credentials @?= "Basic Y2xpZW50OnNlY3JldA==",-      testCase "authorization_code request encodes" $ do-        let grant = AuthorizationCodeGrant "code-123" (Just "https://example.com/callback") Nothing-        Aeson.toJSON (AuthorizationCode grant)-          @?= Aeson.object-            [ "grant_type" Aeson..= ("authorization_code" :: String),-              "code" Aeson..= ("code-123" :: String),-              "redirect_uri" Aeson..= ("https://example.com/callback" :: String)-            ]-        Aeson.toJSON (AuthorizationCode grant {externalAccount = Just (ExternalAccount "acct-1" "Tanaka Hanako")})-          @?= Aeson.object-            [ "grant_type" Aeson..= ("authorization_code" :: String),-              "code" Aeson..= ("code-123" :: String),-              "redirect_uri" Aeson..= ("https://example.com/callback" :: String),-              "external_account" Aeson..= Aeson.object ["key" Aeson..= ("acct-1" :: String), "name" Aeson..= ("Tanaka Hanako" :: String)]-            ],-      testCase "refresh_token request encodes" $-        Aeson.toJSON (RefreshToken "nrt_abc")-          @?= Aeson.object ["grant_type" Aeson..= ("refresh_token" :: String), "refresh_token" Aeson..= ("nrt_abc" :: String)],-      testCase "token response with person owner decodes" $ do-        OAuthTokenResponse {owner, refreshToken} <- decodeOrFail (tokenJson personOwner)-        refreshToken @?= Just "nrt_tanaka_refresh"-        case owner of-          OAuthUserOwner OAuthOwnerUser {email, name} -> do-            email @?= Just "hanako@example.com"-            name @?= Just "Tanaka Hanako"-          other -> assertFailure ("expected a user owner, got " <> show other),-      testCase "partial user owner and workspace owner decode" $ do-        OAuthTokenResponse {owner = partial} <--          decodeOrFail (tokenJson "{\"type\":\"user\",\"user\":{\"id\":\"0e1d2c3b-4a59-4687-b7a6-958473625140\",\"object\":\"user\"}}")-        case partial of-          OAuthUserOwner OAuthOwnerUser {email, type_} -> do-            email @?= Nothing-            type_ @?= Nothing-          other -> assertFailure ("expected a user owner, got " <> show other)-        OAuthTokenResponse {owner = workspace} <- decodeOrFail (tokenJson "{\"type\":\"workspace\",\"workspace\":true}")-        workspace @?= OAuthWorkspaceOwner-        OAuthTokenResponse {owner = team} <- decodeOrFail (tokenJson "{\"type\":\"team\"}")-        case team of-          UnknownOAuthOwner _ -> pure ()-          other -> assertFailure ("expected UnknownOAuthOwner, got " <> show other),-      testCase "introspect response decodes" $ do-        r1 <- decodeOrFail "{\"active\":true,\"scope\":\"read_content\",\"iat\":1757890000,\"request_id\":\"r-1\"}"-        r1 @?= OAuthIntrospectResponse True (Just "read_content") (Just 1757890000) (Just "r-1")-        r2 <- decodeOrFail "{\"active\":false}"-        r2 @?= OAuthIntrospectResponse False Nothing Nothing Nothing,-      testCase "createOAuthToken sends Basic auth to POST /oauth/token" $ do-        (env, recorded) <- fakeClientEnv [jsonReply 200 (tokenJson personOwner)]-        let oauth = makeOAuthMethodsWith defaultClientConfig env credentials-        _ <- createOAuthToken oauth (RefreshToken "nrt_tanaka_refresh")-        readIORef recorded >>= \case-          [r@Recorded {method, path}] -> do-            method @?= "POST"-            path @?= "/oauth/token"-            lookupRecordedHeader "Authorization" r @?= Just "Basic Y2xpZW50OnNlY3JldA=="-            length [() | ("Authorization", _) <- headers r] @?= 1-          rs -> assertFailure ("expected one request, got " <> show (length rs))-    ]+    ( errorTests+        <> [ testCase "basicAuthorization encodes client_id:client_secret" $+               basicAuthorization credentials @?= "Basic Y2xpZW50OnNlY3JldA==",+             testCase "authorization_code request encodes" $ do+               let grant = AuthorizationCodeGrant "code-123" (Just "https://example.com/callback") Nothing+               Aeson.toJSON (AuthorizationCode grant)+                 @?= Aeson.object+                   [ "grant_type" Aeson..= ("authorization_code" :: String),+                     "code" Aeson..= ("code-123" :: String),+                     "redirect_uri" Aeson..= ("https://example.com/callback" :: String)+                   ]+               Aeson.toJSON (AuthorizationCode grant {externalAccount = Just (ExternalAccount "acct-1" "Tanaka Hanako")})+                 @?= Aeson.object+                   [ "grant_type" Aeson..= ("authorization_code" :: String),+                     "code" Aeson..= ("code-123" :: String),+                     "redirect_uri" Aeson..= ("https://example.com/callback" :: String),+                     "external_account" Aeson..= Aeson.object ["key" Aeson..= ("acct-1" :: String), "name" Aeson..= ("Tanaka Hanako" :: String)]+                   ],+             testCase "refresh_token request encodes" $+               Aeson.toJSON (RefreshToken "nrt_abc")+                 @?= Aeson.object ["grant_type" Aeson..= ("refresh_token" :: String), "refresh_token" Aeson..= ("nrt_abc" :: String)],+             testCase "token response with person owner decodes" $ do+               OAuthTokenResponse {owner, refreshToken} <- decodeOrFail (tokenJson personOwner)+               refreshToken @?= Just "nrt_tanaka_refresh"+               case owner of+                 OAuthUserOwner OAuthOwnerUser {email, name} -> do+                   email @?= Just "hanako@example.com"+                   name @?= Just "Tanaka Hanako"+                 other -> assertFailure ("expected a user owner, got " <> show other),+             testCase "partial user owner and workspace owner decode" $ do+               OAuthTokenResponse {owner = partial} <-+                 decodeOrFail (tokenJson "{\"type\":\"user\",\"user\":{\"id\":\"0e1d2c3b-4a59-4687-b7a6-958473625140\",\"object\":\"user\"}}")+               case partial of+                 OAuthUserOwner OAuthOwnerUser {email, type_} -> do+                   email @?= Nothing+                   type_ @?= Nothing+                 other -> assertFailure ("expected a user owner, got " <> show other)+               OAuthTokenResponse {owner = workspace} <- decodeOrFail (tokenJson "{\"type\":\"workspace\",\"workspace\":true}")+               workspace @?= OAuthWorkspaceOwner+               OAuthTokenResponse {owner = team} <- decodeOrFail (tokenJson "{\"type\":\"team\"}")+               case team of+                 UnknownOAuthOwner _ -> pure ()+                 other -> assertFailure ("expected UnknownOAuthOwner, got " <> show other),+             testCase "introspect response decodes" $ do+               r1 <- decodeOrFail "{\"active\":true,\"scope\":\"read_content\",\"iat\":1757890000,\"request_id\":\"r-1\"}"+               r1 @?= OAuthIntrospectResponse True (Just "read_content") (Just 1757890000) (Just "r-1")+               r2 <- decodeOrFail "{\"active\":false}"+               r2 @?= OAuthIntrospectResponse False Nothing Nothing Nothing,+             testCase "createOAuthToken sends Basic auth to POST /oauth/token" $ do+               (env, recorded) <- fakeClientEnv [jsonReply 200 (tokenJson personOwner)]+               let oauth = makeOAuthMethodsWith defaultClientConfig env credentials+               _ <- createOAuthToken oauth (RefreshToken "nrt_tanaka_refresh")+               readIORef recorded >>= \case+                 [r@Recorded {method, path}] -> do+                   method @?= "POST"+                   path @?= "/oauth/token"+                   lookupRecordedHeader "Authorization" r @?= Just "Basic Y2xpZW50OnNlY3JldA=="+                   length [() | ("Authorization", _) <- headers r] @?= 1+                 rs -> assertFailure ("expected one request, got " <> show (length rs))+           ]+    )  credentials :: OAuthCredentials credentials = OAuthCredentials {clientId = "client", clientSecret = "secret"}@@ -89,3 +98,69 @@   "{\"access_token\":\"secret_tanaka_access\",\"token_type\":\"bearer\",\"refresh_token\":\"nrt_tanaka_refresh\",\"bot_id\":\"2f8e6d4c-1b3a-4c5d-8e7f-9a0b1c2d3e4f\",\"workspace_icon\":null,\"workspace_name\":\"Tanaka Hanako's Workspace\",\"workspace_id\":\"7a6b5c4d-3e2f-4a1b-9c8d-7e6f5a4b3c2d\",\"owner\":"     <> owner     <> ",\"duplicated_template_id\":null,\"request_id\":\"5d4c3b2a-1f0e-4d9c-8b7a-6f5e4d3c2b1a\"}"++errorTests :: [TestTree]+errorTests =+  [ testCase "OAuth timeout propagates with one attempt" $ do+      (env, _) <- fakeClientEnv []+      calls <- newIORef (0 :: Int)+      let failing = env {middleware = \_ _ -> liftIO (modifyIORef' calls (+ 1) >> throwIO E.RequestTimeoutError)}+      result <- try @E.RequestTimeoutError (createOAuthToken (makeOAuthMethodsWith defaultClientConfig failing credentials) (RefreshToken "secret"))+      assertBool "timeout" (either (const True) (const False) result)+      readIORef calls >>= (@?= 1),+    testCase "OAuth errors retain metadata and redact secrets" $ do+      (env, recorded) <- fakeClientEnv [FakeReply 400 [("Content-Type", "application/json"), ("x-notion-request-id", "r-oauth-2"), ("Secret", "SENTINEL")] "{\"error\":\"invalid_grant\",\"error_description\":\"SENTINEL\"}"]+      logs <- newIORef []+      let config = defaultClientConfig {logger = Just (\_ msg fields -> modifyIORef' logs (<> [show (msg, fields)])), logLevel = LogDebug}+      r <- try @OAuthError (createOAuthToken (makeOAuthMethodsWith config env credentials) (RefreshToken "SENTINEL"))+      case r of+        Left e@OAuthError {oauthErrorCode, errorDescription, requestId, response} -> do+          oauthErrorCode @?= OAuthInvalidGrant+          errorDescription @?= Just "SENTINEL"+          requestId @?= Just "r-oauth-2"+          fmap E.httpStatus response @?= Just 400+          assertBool "show redacted" (not ("SENTINEL" `isInfixOf` (show e <> displayException e)))+        Right _ -> assertFailure "expected OAuthError"+      readIORef logs >>= assertBool "debug logs redacted" . all (not . isInfixOf "SENTINEL")+      length <$> readIORef recorded >>= (@?= 1),+    testCase "OAuth and documented Notion envelopes normalize locally" $ do+      forM_+        [ ("{\"error\":\"invalid_client\",\"request_id\":\"body-id\"}", OAuthInvalidClient),+          ("{\"object\":\"error\",\"code\":\"invalid_grant\",\"message\":\"bad\"}", OAuthInvalidGrant),+          ("{\"error\":\"slow_down\"}", UnknownOAuthErrorCode "slow_down")+        ]+        $ \(body, expected) -> do+          (env, _) <- fakeClientEnv [jsonReply 401 body]+          result <- try @OAuthError (revokeOAuthToken (makeOAuthMethodsWith defaultClientConfig env credentials) "token")+          case result of+            Left OAuthError {oauthErrorCode, response} -> do+              oauthErrorCode @?= expected+              fmap E.httpStatus response @?= Just 401+            Right _ -> assertFailure "expected OAuthError",+    testCase "ordinary and malformed errors retain original exception" $ do+      forM_ ["validation_error", "brand_new_code"] $ \c -> do+        (env, _) <- fakeClientEnv [jsonReply 400 ("{\"object\":\"error\",\"code\":\"" <> c <> "\",\"message\":\"bad\"}")]+        result <- try @E.NotionError (revokeOAuthToken (makeOAuthMethodsWith defaultClientConfig env credentials) "token")+        assertBool "NotionError" (either (const True) (const False) result)+      forM_ ["oops", "{\"error\":\"\"}", "{\"error\":17}", "{}"] $ \body -> do+        (env, _) <- fakeClientEnv [jsonReply 502 body]+        r <- try @E.UnknownHTTPResponseError (introspectOAuthToken (makeOAuthMethodsWith defaultClientConfig env credentials) "token")+        assertBool "UnknownHTTPResponseError" (either (const True) (const False) r),+    testCase "OAuth never retries grants revoke or introspect" $ do+      forM_ ["rate_limited", "service_overload"] $ \code ->+        forM_+          [ \o -> () <$ createOAuthToken o (AuthorizationCode (AuthorizationCodeGrant "c" Nothing Nothing)),+            \o -> () <$ createOAuthToken o (RefreshToken "r"),+            \o -> () <$ revokeOAuthToken o "t",+            \o -> () <$ introspectOAuthToken o "t"+          ]+          $ \call -> do+            (env, recorded) <- fakeClientEnv [jsonReply 429 ("{\"object\":\"error\",\"code\":\"" <> code <> "\",\"message\":\"bad\"}")]+            r <- try @SomeException (call (makeOAuthMethodsWith defaultClientConfig env credentials))+            assertBool "original NotionError" (either (maybe False (const True) . fromException @E.NotionError) (const False) r)+            length <$> readIORef recorded >>= (@?= 1),+    testCase "all known codes and JSON roundtrip" $+      forM_ [OAuthInvalidRequest, OAuthInvalidClient, OAuthInvalidGrant, OAuthUnauthorizedClient, OAuthUnsupportedGrantType, OAuthInvalidScope, OAuthAccessDenied, OAuthUnsupportedResponseType, OAuthServerError, OAuthTemporarilyUnavailable, UnknownOAuthErrorCode "future"] $ \c -> do+        parseOAuthErrorCode (oauthErrorCodeText c) @?= c+        Aeson.decode (Aeson.encode c) @?= Just c+  ]

@@ -72,7 +72,7 @@       (env, _) <- fakeClientEnv []       let context = requestContextFor legacyClientConfig env "secret_tanaka"           sent = [(n, v) | (n, v) <- headers r, n `elem` ["Authorization", "Notion-Version", "User-Agent"]]-      standardHeaders context @?= sent+      standardHeaders context >>= (@?= sent)       contextBaseUrl context @?= fakeBaseUrl   ]   where

@@ -0,0 +1,133 @@+module TokenHTTPTests (tests) where++import Control.Exception+import Control.Monad (void)+import Control.Monad.IO.Class qualified+import Data.ByteString qualified as BS+import Data.ByteString.Lazy qualified as L+import Data.Foldable qualified+import Data.IORef+import Network.HTTP.Client qualified as H+import Network.HTTP.Types qualified as T+import Network.Wai qualified as W+import Network.Wai.Handler.Warp qualified as Warp+import Notion.V1+import Notion.V1.Client (applyTimeout)+import Notion.V1.Error+import Notion.V1.FileUploads (mkSendFileUpload)+import Notion.V1.Search qualified+import Servant.Client qualified as S+import Servant.Client.Core qualified+import System.Directory (getTemporaryDirectory, removeFile)+import System.IO+import Test.Tasty+import Test.Tasty.HUnit+import TokenSourceTests (bounded)++rejection :: L.ByteString+rejection = "{\"object\":\"error\",\"code\":\"unauthorized\",\"message\":\"invalid token\"}"++tests :: TestTree+tests =+  testGroup+    "TokenSource HTTP"+    [ testCase "real acquisition closes rejection before renewal; opened callbacks never replay" $ bounded $ do+        requests <- newIORef []+        closed <- newIORef False+        renewals <- newIORef (0 :: Int)+        let app req respond = do+              atomicModifyIORef' requests (\rs -> (rs <> [W.requestHeaders req], ()))+              respond $+                if lookup "Authorization" (W.requestHeaders req) == Just "Bearer old"+                  then W.responseLBS T.status401 [("Content-Type", "application/json")] rejection+                  else W.responseLBS T.status200 [("Content-Type", "text/event-stream")] "data: ok\n\n"+        Warp.testWithApplication (pure app) $ \port -> do+          manager <- H.newManager H.defaultManagerSettings+          let base = S.BaseUrl S.Http "127.0.0.1" port "/v1"+              source =+                TokenSource+                  (pure "old")+                  ( \_ -> do+                      readIORef closed >>= assertBool "rejected response already closed"+                      modifyIORef' renewals (+ 1)+                      pure (Just "new")+                  )+              context = requestContextWithTokenSource defaultClientConfig (S.mkClientEnv manager base) source+          request <- H.parseRequest (S.showBaseUrl base <> "/sessions")+          let acquire = withStandardHeaders context $ \headers -> withRetries defaultClientConfig "POST" "sessions.stream" $ mask $ \restore -> do+                response <- restore (H.responseOpen (applyTimeout defaultClientConfig request {H.requestHeaders = headers, H.method = "POST"}) manager)+                if T.statusIsSuccessful (H.responseStatus response)+                  then pure response+                  else do+                    chunks <- restore (H.brConsume (H.responseBody response)) `finally` (H.responseClose response >> writeIORef closed True)+                    throwIO (notionErrorFromResponse (H.responseStatus response) (H.responseHeaders response) (L.fromChunks chunks))+          outcome <- try @NotionError $ bracket acquire H.responseClose $ \res -> do+            chunk <- H.brRead (H.responseBody res)+            assertBool "stream opened" (not (BS.null chunk))+            throwIO (NotionError "error" 401 Unauthorized "callback failed" Nothing Nothing Nothing Nothing)+          either (\e -> code e @?= Unauthorized) (const (assertFailure "callback should throw")) outcome+          readIORef renewals >>= (@?= 1)+          hs <- readIORef requests+          map (lookup "Authorization") hs @?= [Just "Bearer old", Just "Bearer new"]+          map (lookup "Notion-Version") hs @?= replicate 2 (Just "2026-03-11")+          assertBool "user agent on every open" (all ((/= Nothing) . lookup "User-Agent") hs),+      testCase "caller middleware and request builder retained; bytes replay identically" $ bounded $ do+        received <- newIORef []+        middle <- newIORef []+        built <- newIORef (0 :: Int)+        renewals <- newIORef (0 :: Int)+        let app req respond = do+              body <- W.strictRequestBody req+              atomicModifyIORef' received (\rs -> (rs <> [(W.requestHeaders req, body)], ()))+              respond $+                W.responseLBS+                  (if lookup "Authorization" (W.requestHeaders req) == Just "Bearer old" then T.status401 else T.status200)+                  [("Content-Type", "application/json")]+                  (if lookup "Authorization" (W.requestHeaders req) == Just "Bearer old" then rejection else "{\"object\":\"list\",\"results\":[],\"has_more\":false,\"next_cursor\":null}")+        Warp.testWithApplication (pure app) $ \port -> do+          manager <- H.newManager H.defaultManagerSettings+          let env = S.mkClientEnv manager (S.BaseUrl S.Http "127.0.0.1" port "/v1")+              custom =+                env+                  { S.makeClientRequest = \base req -> modifyIORef' built (+ 1) >> S.makeClientRequest env base req,+                    S.middleware = \next req -> do+                      Control.Monad.IO.Class.liftIO $ modifyIORef' middle (<> [Data.Foldable.toList (Servant.Client.Core.requestHeaders req)])+                      next req+                  }+              source = TokenSource (pure "old") (\_ -> modifyIORef' renewals (+ 1) >> pure (Just "new"))+          void (search (makeMethodsWithTokenSource defaultClientConfig custom source) (Notion.V1.Search.SearchRequest Nothing Nothing Nothing Nothing Nothing))+          rs <- readIORef received+          case rs of+            [(_, a), (_, b)] -> a @?= b+            _ -> assertFailure "expected two byte requests"+          length <$> readIORef middle >>= (@?= 2)+          readIORef middle >>= mapM_ (\hs -> length (filter ((== "Authorization") . fst) hs) @?= 1)+          readIORef built >>= (@?= 2)+          readIORef renewals >>= (@?= 1),+      testCase "file-backed multipart body can be replayed after rejection" $+        bounded $+          bracket (getTemporaryDirectory >>= \directory -> openBinaryTempFile directory "notion-upload") (\(path, h) -> hClose h `finally` removeFile path) $ \(path, h) -> do+            BS.hPut h "fixture bytes: Tanaka Hanako"+            hFlush h+            hClose h+            received <- newIORef []+            let app req respond = do+                  body <- W.strictRequestBody req+                  atomicModifyIORef' received (\rs -> (rs <> [body], ()))+                  respond $+                    W.responseLBS+                      (if lookup "Authorization" (W.requestHeaders req) == Just "Bearer old" then T.status401 else T.status200)+                      [("Content-Type", "application/json")]+                      (if lookup "Authorization" (W.requestHeaders req) == Just "Bearer old" then rejection else "{}")+            Warp.testWithApplication (pure app) $ \port -> do+              manager <- H.newManager H.defaultManagerSettings+              let env = S.mkClientEnv manager (S.BaseUrl S.Http "127.0.0.1" port "/v1")+                  source = TokenSource (pure "old") (const (pure (Just "new")))+              -- The deliberately partial success fixture fails decoding after acquisition.+              void (try @S.ClientError (sendFileUploadContent (makeMethodsWithTokenSource defaultClientConfig env source) "upload-id" (mkSendFileUpload path "hanako.txt" "text/plain")))+              readIORef received >>= \case+                [a, b] -> do+                  a @?= b+                  assertBool "file bytes present" ("fixture bytes: Tanaka Hanako" `BS.isInfixOf` L.toStrict b)+                _ -> assertFailure "expected multipart replay"+    ]

@@ -0,0 +1,219 @@+{-# LANGUAGE GHC2024 #-}+{-# LANGUAGE AllowAmbiguousTypes #-}++module TokenRefreshTests (tests) where++import Control.Concurrent+import Control.Exception+import Control.Monad (forM_, void)+import Data.Aeson qualified as A+import Data.IORef+import Data.List (isInfixOf)+import Data.Time.Clock+import FakeNotion+import Notion.V1+import Notion.V1.Error (NotionError)+import Notion.V1.OAuth qualified as O+import Notion.V1.OAuth.Refresh qualified as R+import OAuthTests (credentials, personOwner, tokenJson)+import Test.Tasty+import Test.Tasty.HUnit+import TokenSourceTests (bounded, unauthorized, userJson)++fixture :: IO (R.OAuthTokens, O.OAuthTokenResponse)+fixture = do+  response <- either assertFailure pure (A.eitherDecode (tokenJson personOwner))+  now <- getCurrentTime+  let old = (R.oauthTokensFromResponse now response) {R.accessToken = "old", R.refreshToken = Just "old-refresh"}+  pure (old, response)++methods :: (O.OAuthTokenRequest -> IO O.OAuthTokenResponse) -> O.OAuthMethods+methods f = O.OAuthMethods f (const (pure (O.OAuthRevokeResponse Nothing))) (const (pure (O.OAuthIntrospectResponse False Nothing Nothing Nothing)))++forkResult :: IO a -> IO (ThreadId, MVar (Either SomeException a))+forkResult action = do+  result <- newEmptyMVar+  tid <- forkFinally action (putMVar result)+  pure (tid, result)++succeeds :: MVar (Either SomeException a) -> IO a+succeeds result = bounded (takeMVar result) >>= either (assertFailure . displayException) pure++expect :: forall e a. (Exception e) => IO a -> IO ()+expect action = try @e action >>= either (const (pure ())) (const (assertFailure "expected exception"))++counting :: O.OAuthTokenResponse -> IO (O.OAuthMethods, IO Int)+counting response = do+  ref <- newIORef (0 :: Int)+  pure (methods (\_ -> atomicModifyIORef' ref (\n -> (n + 1, ())) >> pure response), readIORef ref)++tests :: TestTree+tests =+  testGroup+    "TokenRefresh"+    [ testCase "reject refresh persist retry and timestamp" $ do+        (old, response) <- fixture+        (oauthEnv, grants) <- fakeClientEnv [jsonReply 200 (tokenJson personOwner)]+        store <- R.inMemoryTokenStore old+        manager <- R.newOAuthTokenManager (O.makeOAuthMethodsWith defaultClientConfig oauthEnv credentials) store+        (env, recorded) <- fakeClientEnvWith $ \request ->+          pure $+            if lookupRecordedHeader "Authorization" request == Just "Bearer old" then unauthorized else jsonReply 200 userJson+        before <- getCurrentTime+        void (retrieveMyUser (makeMethodsWithTokenSource defaultClientConfig env (R.tokenManagerSource manager)))+        after <- getCurrentTime+        tokens <- R.currentTokens manager+        R.accessToken tokens @?= O.accessToken response+        R.botId tokens @?= R.botId old+        R.workspaceId tokens @?= R.workspaceId old+        assertBool "obtained at response" (R.obtainedAt tokens >= before && R.obtainedAt tokens <= after)+        R.loadTokens store >>= (@?= tokens)+        length <$> readIORef grants >>= (@?= 1)+        map (lookupRecordedHeader "Authorization") <$> readIORef recorded >>= (@?= [Just "Bearer old", Just "Bearer secret_tanaka_access"]),+      testCase "concurrent old rejections share rotation and wait for durable save" $ bounded $ do+        (old, response) <- fixture+        (oauth, count) <- counting response+        bothOld <- newEmptyMVar+        reject <- newEmptyMVar+        saving <- newEmptyMVar+        durable <- newEmptyMVar+        seenOld <- newIORef (0 :: Int)+        let store = R.TokenStore (pure old) (\_ -> putMVar saving () >> readMVar durable)+        manager <- R.newOAuthTokenManager oauth store+        (env, recorded) <- fakeClientEnvWith $ \request ->+          if lookupRecordedHeader "Authorization" request == Just "Bearer old"+            then do+              n <- atomicModifyIORef' seenOld (\n -> (n + 1, n + 1))+              if n == 2 then putMVar bothOld () else pure ()+              readMVar reject+              pure unauthorized+            else pure (jsonReply 200 userJson)+        let call = retrieveMyUser (makeMethodsWithTokenSource defaultClientConfig env (R.tokenManagerSource manager))+        (_, a) <- forkResult call+        (_, b) <- forkResult call+        takeMVar bothOld+        putMVar reject ()+        takeMVar saving+        rs <- readIORef recorded+        length rs @?= 2+        map (lookupRecordedHeader "Authorization") rs @?= replicate 2 (Just "Bearer old")+        count >>= (@?= 1)+        putMVar durable ()+        void (succeeds a)+        void (succeeds b)+        renewToken (R.tokenManagerSource manager) "old" >>= (@?= Just "secret_tanaka_access")+        count >>= (@?= 1),+      testCase "invalid grant and missing refresh become remembered terminal states" $ do+        (old, _) <- fixture+        forM_ [False, True] $ \missing -> do+          attempts <- newIORef (0 :: Int)+          let failure = O.OAuthError O.OAuthInvalidGrant Nothing Nothing Nothing Nothing+              oauth = methods (\_ -> modifyIORef' attempts (+ 1) >> throwIO failure)+          store <- R.inMemoryTokenStore (if missing then old {R.refreshToken = Nothing} else old)+          manager <- R.newOAuthTokenManager oauth store+          expect @R.ReauthorizationRequired (R.refreshTokensNow manager)+          expect @R.ReauthorizationRequired (currentToken (R.tokenManagerSource manager))+          expect @R.ReauthorizationRequired (R.refreshTokensNow manager)+          expect @R.ReauthorizationRequired (renewToken (R.tokenManagerSource manager) "old")+          readIORef attempts >>= (@?= if missing then 0 else 1),+      testCase "save failure retains exact pair and persistence retry never rotates" $ do+        (old, response) <- fixture+        (oauth, count) <- counting response+        broken <- newIORef True+        saved <- newIORef []+        manager <-+          R.newOAuthTokenManager+            oauth+            ( R.TokenStore+                (pure old)+                ( \t -> do+                    modifyIORef' saved (<> [t])+                    readIORef broken >>= \b -> if b then ioError (userError "SENTINEL") else pure ()+                )+            )+        expect @R.TokenPersistenceError (R.refreshTokensNow manager)+        pending <- R.currentTokens manager+        R.accessToken pending @?= O.accessToken response+        expect @R.TokenPersistenceError (currentToken (R.tokenManagerSource manager))+        expect @R.TokenPersistenceError (R.refreshTokensNow manager)+        count >>= (@?= 1)+        writeIORef broken False+        R.retryTokenPersistence manager >>= (@?= pending)+        R.retryTokenPersistence manager >>= (@?= pending)+        readIORef saved >>= (@?= [pending, pending])+        currentToken (R.tokenManagerSource manager) >>= (@?= O.accessToken response)+        count >>= (@?= 1),+      testCase "lost response blocks reuse and preserves last known credentials" $ do+        (old, _) <- fixture+        calls <- newIORef (0 :: Int)+        store <- R.inMemoryTokenStore old+        manager <- R.newOAuthTokenManager (methods (\_ -> modifyIORef' calls (+ 1) >> ioError (userError "lost response"))) store+        expect @IOException (R.refreshTokensNow manager)+        expect @R.RefreshOutcomeUnknown (currentToken (R.tokenManagerSource manager))+        expect @R.RefreshOutcomeUnknown (R.refreshTokensNow manager)+        expect @R.RefreshOutcomeUnknown (R.retryTokenPersistence manager)+        R.currentTokens manager >>= (@?= old)+        readIORef calls >>= (@?= 1),+      testCase "cancellation during exchange publishes uncertainty and releases lock" $ bounded $ do+        (old, _) <- fixture+        started <- newEmptyMVar+        blocked <- newEmptyMVar+        store <- R.inMemoryTokenStore old+        manager <- R.newOAuthTokenManager (methods (\_ -> putMVar started () >> takeMVar blocked)) store+        (tid, result) <- forkResult (R.refreshTokensNow manager)+        takeMVar started+        killThread tid+        bounded (takeMVar result) >>= \r -> assertBool "cancelled" (either (const True) (const False) r)+        expect @R.RefreshOutcomeUnknown (R.refreshTokensNow manager)+        R.currentTokens manager >>= (@?= old),+      testCase "cancellation after response during save retains pending pair" $ bounded $ do+        (old, response) <- fixture+        (oauth, count) <- counting response+        started <- newEmptyMVar+        blocked <- newEmptyMVar+        broken <- newIORef True+        let save _ = readIORef broken >>= \b -> if b then putMVar started () >> takeMVar blocked else pure ()+        manager <- R.newOAuthTokenManager oauth (R.TokenStore (pure old) save)+        (tid, result) <- forkResult (R.refreshTokensNow manager)+        takeMVar started+        killThread tid+        takeMVar result >>= \r -> assertBool "persistence error" (either (maybe False (const True) . fromException @R.TokenPersistenceError) (const False) r)+        pending <- R.currentTokens manager+        R.accessToken pending @?= O.accessToken response+        expect @R.TokenPersistenceError (currentToken (R.tokenManagerSource manager))+        writeIORef broken False+        R.retryTokenPersistence manager >>= (@?= pending)+        count >>= (@?= 1),+      testCase "null refresh stays absent; invalid identity or type cannot authorize" $ do+        (old, response) <- fixture+        (oauth, count) <- counting response {O.refreshToken = Nothing}+        store <- R.inMemoryTokenStore old+        manager <- R.newOAuthTokenManager oauth store+        replacement <- R.refreshTokensNow manager+        R.refreshToken replacement @?= Nothing+        expect @R.ReauthorizationRequired (R.refreshTokensNow manager)+        count >>= (@?= 1)+        forM_ [response {O.tokenType = "mac"}, response {O.botId = "other"}, response {O.workspaceId = "other"}, response {O.accessToken = ""}] $ \invalid -> do+          (badOAuth, _) <- counting invalid+          freshStore <- R.inMemoryTokenStore old+          bad <- R.newOAuthTokenManager badOAuth freshStore+          expect @R.RefreshOutcomeUnknown (R.refreshTokensNow bad)+          expect @R.RefreshOutcomeUnknown (currentToken (R.tokenManagerSource bad)),+      testCase "explicit OAuth rejection remains distinguishable without invalidating pair" $ do+        (old, _) <- fixture+        store <- R.inMemoryTokenStore old+        let failure = O.OAuthError O.OAuthInvalidClient Nothing Nothing Nothing Nothing+        manager <- R.newOAuthTokenManager (methods (\_ -> throwIO failure)) store+        expect @O.OAuthError (R.refreshTokensNow manager)+        currentToken (R.tokenManagerSource manager) >>= (@?= "old"),+      testCase "JSON roundtrip, load once, and redacted rendering" $ do+        (old, response) <- fixture+        A.decode (A.encode old) @?= Just old+        assertBool "tokens redacted" (not ("old-refresh" `isInfixOf` show old))+        loaded <- newIORef (0 :: Int)+        (oauth, _) <- counting response+        manager <- R.newOAuthTokenManager oauth (R.TokenStore (modifyIORef' loaded (+ 1) >> pure old) (const (pure ())))+        void (currentToken (R.tokenManagerSource manager))+        void (R.refreshTokensNow manager)+        readIORef loaded >>= (@?= 1)+    ]

@@ -0,0 +1,74 @@+module TokenSourceTests (tests, unauthorized, userJson, bounded) where++import Control.Exception+import Control.Monad (forM_, void)+import Data.ByteString.Lazy qualified as L+import Data.IORef+import FakeNotion+import Notion.V1+import Notion.V1.Error+import Notion.V1.OAuth qualified as O+import Notion.V1.TokenSource (withAuthorization)+import OAuthTests (credentials)+import System.Timeout qualified as Timeout+import Test.Tasty+import Test.Tasty.HUnit++unauthorized :: FakeReply+unauthorized = jsonReply 401 "{\"object\":\"error\",\"code\":\"unauthorized\",\"message\":\"invalid token\"}"++userJson :: L.ByteString+userJson = "{\"object\":\"user\",\"id\":\"6f1c2b9e-4d3a-4e8f-9b7c-2a1d0e5f3c4b\",\"name\":\"Sato Kenji\",\"type\":\"bot\",\"bot\":{\"owner\":{\"type\":\"workspace\",\"workspace\":true}}}"++bounded :: IO a -> IO a+bounded action = Timeout.timeout 5000000 action >>= maybe (assertFailure "timed out") pure++tests :: TestTree+tests =+  testGroup+    "TokenSource"+    [ testCase "source follows changes on every call with one Authorization header" $ do+        ref <- newIORef "t1"+        (env, recorded) <- fakeClientEnv (replicate 2 (jsonReply 200 userJson))+        let api = makeMethodsWithTokenSource defaultClientConfig env (TokenSource (readIORef ref) (const (pure Nothing)))+        void (retrieveMyUser api)+        writeIORef ref "t2"+        void (retrieveMyUser api)+        rs <- readIORef recorded+        map (lookupRecordedHeader "Authorization") rs @?= [Just "Bearer t1", Just "Bearer t2"]+        map (length . filter ((== "Authorization") . fst) . headers) rs @?= [1, 1],+      testCase "renewal once, static rejection, and second rejection do not loop" $ do+        forM_ [False, True] $ \secondFails -> do+          (env, recorded) <- fakeClientEnv [unauthorized, if secondFails then unauthorized else jsonReply 200 userJson]+          calls <- newIORef []+          let source = TokenSource (pure "old") (\old -> modifyIORef' calls (<> [old]) >> pure (Just "new"))+          result <- try @NotionError (retrieveMyUser (makeMethodsWithTokenSource defaultClientConfig env source))+          either (\e -> code e @?= Unauthorized) (const (assertBool "successful" (not secondFails))) result+          readIORef calls >>= (@?= ["old"])+          map (lookupRecordedHeader "Authorization") <$> readIORef recorded >>= (@?= [Just "Bearer old", Just "Bearer new"])+        (env, rs) <- fakeClientEnv [unauthorized]+        result <- try @NotionError (retrieveMyUser (makeMethodsWithEnv defaultClientConfig env "old"))+        either (\e -> code e @?= Unauthorized) (const (assertFailure "expected rejection")) result+        length <$> readIORef rs >>= (@?= 1),+      testCase "ordinary retry budget runs independently before and after renewal" $ do+        let rateLimited = jsonReply 429 "{\"object\":\"error\",\"code\":\"rate_limited\",\"message\":\"slow down\"}"+            config = defaultClientConfig {retryOptions = RetryOptions 1 0.000001 0.000001}+        (env, recorded) <- fakeClientEnv [rateLimited, unauthorized, rateLimited, jsonReply 200 userJson]+        renewals <- newIORef (0 :: Int)+        let source = TokenSource (pure "old") (\_ -> modifyIORef' renewals (+ 1) >> pure (Just "new"))+        void (retrieveMyUser (makeMethodsWithTokenSource config env source))+        length <$> readIORef recorded >>= (@?= 4)+        readIORef renewals >>= (@?= 1),+      testCase "decode timeout untyped 401 and failed POST never renew" $ do+        renewals <- newIORef (0 :: Int)+        let source = TokenSource (pure "old") (\_ -> modifyIORef' renewals (+ 1) >> pure (Just "new"))+        forM_ [jsonReply 401 "{}", jsonReply 200 "{}", jsonReply 500 "{\"object\":\"error\",\"code\":\"internal_server_error\",\"message\":\"bad\"}"] $ \reply -> do+          (env, _) <- fakeClientEnv [reply]+          void (try @SomeException (retrieveMyUser (makeMethodsWithTokenSource defaultClientConfig {retryOptions = noRetries} env source)))+        void (try @RequestTimeoutError (withAuthorization source (\_ -> throwIO RequestTimeoutError)))+        readIORef renewals >>= (@?= 0),+      testCase "Basic OAuth authentication bypasses bearer source" $ do+        (env, recorded) <- fakeClientEnv [jsonReply 200 "{\"active\":false}"]+        void (O.introspectOAuthToken (O.makeOAuthMethodsWith defaultClientConfig env credentials) "token")+        map (lookupRecordedHeader "Authorization") <$> readIORef recorded >>= (@?= [Just "Basic Y2xpZW50OnNlY3JldA=="])+    ]