relay-pagination (empty) → 0.1.0.0

raw patch · 8 files changed

+686/−0 lines, 8 filesdep +aesondep +basedep +base64-bytestring

Dependencies added: aeson, base, base64-bytestring, bytestring, http-api-data, quickcheck-instances, relay-pagination, tasty, tasty-hunit, tasty-quickcheck, text, uuid-types

Files

CHANGELOG.md +16/−0
LICENSE +30/−0
relay-pagination.cabal +71/−0
src/Relay/Pagination.hs +13/−0
src/Relay/Pagination/Connection.hs +82/−0
src/Relay/Pagination/Cursor.hs +184/−0
src/Relay/Pagination/Request.hs +85/−0
test/Main.hs +205/−0

+ CHANGELOG.md view

@@ -0,0 +1,16 @@+# Changelog for relay-pagination++Versioning follows the [Haskell Package Versioning Policy](https://pvp.haskell.org/).++## 0.1.0.0 — 2026-07-16++Initial contents:++- Relay connection wire types: `Connection`, `Edge`, `PageInfo`, with+  hand-written, field-order-stable JSON instances.+- Versioned, fingerprinted opaque cursor codec (`Cursor`, `CursorPayload`,+  `KeyValue`, `encodeCursor`, `decodeCursor`): unpadded base64url over compact+  JSON, timestamps as exact integer microseconds, deliberately no float key+  type. `FromHttpApiData`/`ToHttpApiData` instances for `Cursor`.+- Request validation (`PageConfig`, `PageRequest`, `mkPageRequest`): strict+  `first`+`after` / `last`+`before` argument families, size bounds.

+ LICENSE view

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

+ relay-pagination.cabal view

@@ -0,0 +1,71 @@+cabal-version:   3.0+name:            relay-pagination+version:         0.1.0.0+synopsis:+  Relay-style cursor pagination wire types and opaque cursor codec++description:+  Core wire types for Relay Cursor Connections-style pagination over REST:+  the Connection/Edge/PageInfo response envelope with Relay-conventional JSON,+  first/after/last/before request validation, and a versioned, fingerprinted,+  base64url-encoded opaque cursor with an exact, golden-tested wire format.++license:         BSD-3-Clause+license-file:    LICENSE+author:          Nadeem Bitar+maintainer:      Nadeem Bitar+category:        Web, Database+build-type:      Simple+extra-doc-files: CHANGELOG.md++source-repository head+  type:     git+  location: https://github.com/shinzui/relay-pagination++common warnings+  ghc-options:+    -Wall -Wcompat -Widentities -Wincomplete-record-updates+    -Wincomplete-uni-patterns -Wredundant-constraints -Wunused-packages++common lang+  import:             warnings+  default-language:   GHC2024+  default-extensions:+    DeriveAnyClass+    DuplicateRecordFields+    OverloadedLabels+    OverloadedStrings++library+  import:          lang+  hs-source-dirs:  src+  exposed-modules:+    Relay.Pagination+    Relay.Pagination.Connection+    Relay.Pagination.Cursor+    Relay.Pagination.Request++  build-depends:+    , aeson              >=2.2  && <2.3+    , base               >=4.21 && <5+    , base64-bytestring  >=1.2  && <1.3+    , bytestring         >=0.11 && <0.13+    , http-api-data      >=0.6  && <0.7+    , text               >=2.0  && <2.2+    , uuid-types         >=1.0  && <1.1++test-suite relay-pagination-test+  import:         lang+  type:           exitcode-stdio-1.0+  hs-source-dirs: test+  main-is:        Main.hs+  build-depends:+    , aeson+    , base+    , http-api-data+    , quickcheck-instances  >=0.3  && <0.4+    , relay-pagination+    , tasty                 >=1.4  && <1.6+    , tasty-hunit           >=0.10 && <0.11+    , tasty-quickcheck      >=0.10 && <0.12+    , uuid-types

@@ -0,0 +1,13 @@+-- | Relay-style cursor pagination: wire types and the opaque cursor codec.+-- This facade re-exports the whole public API; the submodules exist for+-- focused imports.+module Relay.Pagination+  ( module Relay.Pagination.Connection,+    module Relay.Pagination.Cursor,+    module Relay.Pagination.Request,+  )+where++import Relay.Pagination.Connection+import Relay.Pagination.Cursor+import Relay.Pagination.Request

@@ -0,0 +1,82 @@+{-# LANGUAGE BlockArguments #-}++-- | The Relay connection response envelope. JSON encoding follows the Relay+-- convention exactly: {"edges":[{"node":...,"cursor":"..."}],"pageInfo":+-- {"hasNextPage":...,"hasPreviousPage":...,"startCursor":...,"endCursor":...}}+-- with null cursors on empty pages. Encodings are hand-written with fixed+-- field order so tests can pin exact bytes.+module Relay.Pagination.Connection+  ( Connection (..),+    Edge (..),+    PageInfo (..),+  )+where++import Data.Aeson ((.:), (.:?), (.=))+import Data.Aeson qualified as Aeson+import GHC.Generics (Generic)+import Relay.Pagination.Cursor (Cursor)++-- | One returned row ('node') plus the cursor that addresses its position.+data Edge a = Edge+  { node :: !a,+    cursor :: !Cursor+  }+  deriving stock (Eq, Show, Functor, Foldable, Traversable, Generic)++instance (Aeson.ToJSON a) => Aeson.ToJSON (Edge a) where+  toJSON e = Aeson.object ["node" .= node e, "cursor" .= cursor e]+  toEncoding e = Aeson.pairs ("node" .= node e <> "cursor" .= cursor e)++instance (Aeson.FromJSON a) => Aeson.FromJSON (Edge a) where+  parseJSON = Aeson.withObject "Edge" \o -> Edge <$> o .: "node" <*> o .: "cursor"++-- | Relay pageInfo. 'startCursor' / 'endCursor' are the first/last edge's+-- cursors, or Nothing (JSON null) when the page is empty.+data PageInfo = PageInfo+  { hasNextPage :: !Bool,+    hasPreviousPage :: !Bool,+    startCursor :: !(Maybe Cursor),+    endCursor :: !(Maybe Cursor)+  }+  deriving stock (Eq, Show, Generic)++instance Aeson.ToJSON PageInfo where+  toJSON p =+    Aeson.object+      [ "hasNextPage" .= hasNextPage p,+        "hasPreviousPage" .= hasPreviousPage p,+        "startCursor" .= startCursor p,+        "endCursor" .= endCursor p+      ]+  toEncoding p =+    Aeson.pairs+      ( "hasNextPage" .= hasNextPage p+          <> "hasPreviousPage" .= hasPreviousPage p+          <> "startCursor" .= startCursor p+          <> "endCursor" .= endCursor p+      )++instance Aeson.FromJSON PageInfo where+  parseJSON = Aeson.withObject "PageInfo" \o ->+    PageInfo+      <$> o .: "hasNextPage"+      <*> o .: "hasPreviousPage"+      <*> o .:? "startCursor"+      <*> o .:? "endCursor"++-- | A page of results in Relay connection shape. Edges are always in the+-- endpoint's canonical sort order regardless of paging direction.+data Connection a = Connection+  { edges :: ![Edge a],+    pageInfo :: !PageInfo+  }+  deriving stock (Eq, Show, Functor, Foldable, Traversable, Generic)++instance (Aeson.ToJSON a) => Aeson.ToJSON (Connection a) where+  toJSON c = Aeson.object ["edges" .= edges c, "pageInfo" .= pageInfo c]+  toEncoding c = Aeson.pairs ("edges" .= edges c <> "pageInfo" .= pageInfo c)++instance (Aeson.FromJSON a) => Aeson.FromJSON (Connection a) where+  parseJSON = Aeson.withObject "Connection" \o ->+    Connection <$> o .: "edges" <*> o .: "pageInfo"

@@ -0,0 +1,184 @@+{-# LANGUAGE BlockArguments #-}++-- | The opaque pagination cursor: wire representation, payload, and (M4) codec.+--+-- Wire format (version 1): a cursor is unpadded base64url over compact JSON+-- @{"v":1,"f":<word32>,"k":[...]}@. Field order is fixed by 'Aeson.pairs' so+-- encoded bytes are stable; decoding accepts any key order. See the ExecPlan+-- (docs/plans/1-scaffold-the-repository-and-the-relay-pagination-core-package.md)+-- and, once distilled, docs/adr/2-cursor-wire-format.md.+module Relay.Pagination.Cursor+  ( Cursor (..),+    KeyValue (..),+    CursorPayload (..),+    CursorError (..),+    cursorVersion,+    encodeCursor,+    decodeCursor,+    cursorToText,+    cursorFromText,+  )+where++import Data.Aeson ((.:), (.=))+import Data.Aeson qualified as Aeson+import Data.Bifunctor (first)+import Data.ByteString (ByteString)+import Data.ByteString.Base64.URL qualified as Base64Url+import Data.ByteString.Lazy qualified as LBS+import Data.Int (Int64)+import Data.Text (Text)+import Data.Text qualified as Text+import Data.Text.Encoding qualified as Text+import Data.UUID.Types (UUID)+import Data.Word (Word32, Word8)+import Web.HttpApiData (FromHttpApiData (..), ToHttpApiData (..))++-- | An opaque cursor, stored exactly as it travels on the wire: unpadded+-- base64url ASCII bytes. Construction from a payload happens only via+-- 'encodeCursor'; inspection only via 'decodeCursor'. The JSON instances are+-- pass-throughs (a cursor is a JSON string) and never validate — validation+-- is the job of the endpoint that knows its expected fingerprint.+newtype Cursor = Cursor ByteString+  deriving stock (Show)+  deriving newtype (Eq, Ord)++instance Aeson.ToJSON Cursor where+  toJSON (Cursor wire) = Aeson.String (Text.decodeUtf8Lenient wire)+  toEncoding (Cursor wire) = Aeson.toEncoding (Text.decodeUtf8Lenient wire)++instance Aeson.FromJSON Cursor where+  parseJSON = Aeson.withText "Cursor" (pure . Cursor . Text.encodeUtf8)++-- | Renders the wire bytes ('cursorToText'); infallible, like the JSON+-- encoding.+instance ToHttpApiData Cursor where+  toUrlPiece = cursorToText++-- | Unlike the JSON instance, parsing a query parameter rejects text that is+-- not well-formed unpadded base64url ('cursorFromText'), so an HTTP layer can+-- answer 400 without knowing anything about the payload.+instance FromHttpApiData Cursor where+  parseUrlPiece = cursorFromText++-- | One sort-key value inside a cursor. Exact scalar payloads only:+-- deliberately no Double constructor, so float precision loss at page+-- boundaries is unrepresentable. Timestamps are integer microseconds since+-- the Unix epoch (UTC).+data KeyValue+  = KvInt !Int64+  | KvText !Text+  | KvUuid !UUID+  | KvTimestampMicros !Int64+  | KvBool !Bool+  | KvNull+  deriving stock (Eq, Ord, Show)++instance Aeson.ToJSON KeyValue where+  toJSON = \case+    KvInt n -> Aeson.object ["t" .= ("i" :: Text), "v" .= n]+    KvText t -> Aeson.object ["t" .= ("s" :: Text), "v" .= t]+    KvUuid u -> Aeson.object ["t" .= ("u" :: Text), "v" .= u]+    KvTimestampMicros n -> Aeson.object ["t" .= ("ts" :: Text), "v" .= n]+    KvBool b -> Aeson.object ["t" .= ("b" :: Text), "v" .= b]+    KvNull -> Aeson.object ["t" .= ("n" :: Text)]+  toEncoding = \case+    KvInt n -> Aeson.pairs ("t" .= ("i" :: Text) <> "v" .= n)+    KvText t -> Aeson.pairs ("t" .= ("s" :: Text) <> "v" .= t)+    KvUuid u -> Aeson.pairs ("t" .= ("u" :: Text) <> "v" .= u)+    KvTimestampMicros n -> Aeson.pairs ("t" .= ("ts" :: Text) <> "v" .= n)+    KvBool b -> Aeson.pairs ("t" .= ("b" :: Text) <> "v" .= b)+    KvNull -> Aeson.pairs ("t" .= ("n" :: Text))++instance Aeson.FromJSON KeyValue where+  parseJSON = Aeson.withObject "KeyValue" \o -> do+    tag :: Text <- o .: "t"+    case tag of+      "i" -> KvInt <$> o .: "v"+      "s" -> KvText <$> o .: "v"+      "u" -> KvUuid <$> o .: "v"+      "ts" -> KvTimestampMicros <$> o .: "v"+      "b" -> KvBool <$> o .: "v"+      "n" -> pure KvNull+      other -> fail ("unknown KeyValue tag: " <> Text.unpack other)++-- | The decoded content of a cursor: format version, the fingerprint of the+-- sort specification that minted it, and one 'KeyValue' per sort column (in+-- sort-specification order, tie-breaker last).+data CursorPayload = CursorPayload+  { version :: !Word8,+    fingerprint :: !Word32,+    keys :: ![KeyValue]+  }+  deriving stock (Eq, Show)++instance Aeson.ToJSON CursorPayload where+  toJSON p = Aeson.object ["v" .= version p, "f" .= fingerprint p, "k" .= keys p]+  toEncoding p = Aeson.pairs ("v" .= version p <> "f" .= fingerprint p <> "k" .= keys p)++instance Aeson.FromJSON CursorPayload where+  parseJSON = Aeson.withObject "CursorPayload" \o ->+    CursorPayload <$> o .: "v" <*> o .: "f" <*> o .: "k"++-- | The current cursor format version. Bumping it is a breaking wire change+-- requiring a Decision Log + ADR entry.+cursorVersion :: Word8+cursorVersion = 1++-- | Everything that can go wrong turning wire bytes back into a payload.+-- KeyTypeMismatch / KeyCountMismatch are raised by relay-pagination-hasql's+-- key codecs (EP-3), not by 'decodeCursor' itself; they live here so the+-- whole cursor pipeline shares one error type.+data CursorError+  = BadBase64+  | BadJson !Text+  | WrongVersion !Word8+  | FingerprintMismatch+      { expected :: !Word32,+        actual :: !Word32+      }+  | KeyTypeMismatch+      { expectedTag :: !Text,+        actualValue :: !KeyValue+      }+  | KeyCountMismatch+      { expectedCount :: !Int,+        actualCount :: !Int+      }+  deriving stock (Eq, Show)++-- | Mint the wire form of a payload: compact JSON, then unpadded base64url.+encodeCursor :: CursorPayload -> Cursor+encodeCursor = Cursor . Base64Url.encodeUnpadded . LBS.toStrict . Aeson.encode++-- | Render a cursor as text, e.g. for a query parameter. The wire bytes are+-- already unpadded base64url ASCII, so this never fails and never needs+-- percent-encoding.+cursorToText :: Cursor -> Text+cursorToText (Cursor wire) = Text.decodeUtf8Lenient wire++-- | Parse cursor text received over HTTP, accepting exactly the strings+-- 'cursorToText' produces: well-formed unpadded base64url. The payload stays+-- opaque here — version, fingerprint, and key validation happen later, in+-- 'decodeCursor', at the endpoint that knows its expected fingerprint.+cursorFromText :: Text -> Either Text Cursor+cursorFromText t =+  let wire = Text.encodeUtf8 t+   in case Base64Url.decodeUnpadded wire of+        Left err -> Left ("not unpadded base64url: " <> Text.pack err)+        Right _ -> Right (Cursor wire)++-- | Decode and validate a cursor received from a client. The caller supplies+-- the fingerprint its own sort specification expects; a cursor minted under+-- any other specification is rejected with 'FingerprintMismatch'.+decodeCursor :: Word32 -> Cursor -> Either CursorError CursorPayload+decodeCursor expectedFingerprint (Cursor wire) = do+  raw <- first (const BadBase64) (Base64Url.decodeUnpadded wire)+  payload :: CursorPayload <-+    first (BadJson . Text.pack) (Aeson.eitherDecodeStrict raw)+  if version payload /= cursorVersion+    then Left (WrongVersion (version payload))+    else+      if fingerprint payload /= expectedFingerprint+        then Left FingerprintMismatch {expected = expectedFingerprint, actual = fingerprint payload}+        else Right payload

@@ -0,0 +1,85 @@+-- | Validation of the four Relay request arguments (first/after/last/before)+-- into a 'PageRequest'. Strict subset of the Relay spec: first+last together+-- is rejected rather than tolerated, and page sizes above the endpoint's+-- maximum are rejected rather than clamped.+module Relay.Pagination.Request+  ( Direction (..),+    PageConfig (..),+    PageRequest (..),+    PageRequestError (..),+    mkPageRequest,+  )+where++import Relay.Pagination.Cursor (Cursor)++-- | Which way a page walks the canonical sort order. Forward serves+-- first/after; Backward serves last/before. Edges are returned in canonical+-- order either way (the SQL layer reverses backward pages in memory).+data Direction = Forward | Backward+  deriving stock (Eq, Show)++-- | Per-endpoint pagination policy, written once by the service author.+-- Precondition (unchecked): 0 < defaultPageSize <= maxPageSize.+data PageConfig = PageConfig+  { defaultPageSize :: !Int,+    maxPageSize :: !Int+  }+  deriving stock (Eq, Show)++-- | A validated page request: how many rows, which direction, from where.+-- 'cursor' is Nothing for the first page in the given direction.+data PageRequest = PageRequest+  { pageSize :: !Int,+    direction :: !Direction,+    cursor :: !(Maybe Cursor)+  }+  deriving stock (Eq, Show)++-- | Why a combination of first/after/last/before was rejected. Checked in+-- declaration order; the first applicable error wins.+data PageRequestError+  = FirstAndLastBothGiven+  | AfterAndBeforeBothGiven+  | FirstWithBefore+  | LastWithAfter+  | NegativePageSize !Int+  | PageSizeTooLarge+      { requested :: !Int,+        allowedMax :: !Int+      }+  deriving stock (Eq, Show)++-- | Validate the four Relay arguments, in the order they appear in a query+-- string: @first@, @after@, @last@, @before@.+mkPageRequest ::+  PageConfig ->+  -- | @first@+  Maybe Int ->+  -- | @after@+  Maybe Cursor ->+  -- | @last@+  Maybe Int ->+  -- | @before@+  Maybe Cursor ->+  Either PageRequestError PageRequest+mkPageRequest config mFirst mAfter mLast mBefore+  | Just _ <- mFirst, Just _ <- mLast = Left FirstAndLastBothGiven+  | Just _ <- mAfter, Just _ <- mBefore = Left AfterAndBeforeBothGiven+  | Just _ <- mFirst, Just _ <- mBefore = Left FirstWithBefore+  | Just _ <- mLast, Just _ <- mAfter = Left LastWithAfter+  | Just n <- mFirst = do+      size <- checkedSize n+      Right PageRequest {pageSize = size, direction = Forward, cursor = mAfter}+  | Just n <- mLast = do+      size <- checkedSize n+      Right PageRequest {pageSize = size, direction = Backward, cursor = mBefore}+  | Just _ <- mBefore =+      Right PageRequest {pageSize = defaultPageSize config, direction = Backward, cursor = mBefore}+  | otherwise =+      Right PageRequest {pageSize = defaultPageSize config, direction = Forward, cursor = mAfter}+  where+    checkedSize n+      | n < 0 = Left (NegativePageSize n)+      | n > maxPageSize config = Left PageSizeTooLarge {requested = n, allowedMax = maxPageSize config}+      | otherwise = Right n

+ test/Main.hs view

@@ -0,0 +1,205 @@+{-# LANGUAGE BlockArguments #-}++module Main (main) where++import Data.Aeson qualified as Aeson+import Data.Maybe (fromJust)+import Data.UUID.Types qualified as UUID+import Relay.Pagination+import Test.QuickCheck.Instances ()+import Test.Tasty+import Test.Tasty.HUnit+import Test.Tasty.QuickCheck+import Web.HttpApiData (parseUrlPiece, toUrlPiece)++main :: IO ()+main =+  defaultMain $+    testGroup+      "relay-pagination"+      [keyValueJsonTests, connectionJsonTests, cursorCodecTests, httpApiDataTests, pageRequestTests]++-- * KeyValue JSON shape (M3)++keyValueJsonTests :: TestTree+keyValueJsonTests =+  testGroup+    "KeyValue JSON"+    [ testCase "KvInt" $ Aeson.encode (KvInt 42) @?= "{\"t\":\"i\",\"v\":42}",+      testCase "KvText" $ Aeson.encode (KvText "abc") @?= "{\"t\":\"s\",\"v\":\"abc\"}",+      testCase "KvUuid" $+        Aeson.encode (KvUuid exampleUuid)+          @?= "{\"t\":\"u\",\"v\":\"0dc4ca2f-6f6a-4f28-9f7f-3f2a1b2c3d4e\"}",+      testCase "KvTimestampMicros" $+        Aeson.encode (KvTimestampMicros 1720000000123456)+          @?= "{\"t\":\"ts\",\"v\":1720000000123456}",+      testCase "KvBool" $ Aeson.encode (KvBool True) @?= "{\"t\":\"b\",\"v\":true}",+      testCase "KvNull" $ Aeson.encode KvNull @?= "{\"t\":\"n\"}",+      testCase "decoding accepts reordered keys" $+        Aeson.decode "{\"v\":7,\"t\":\"i\"}" @?= Just (KvInt 7),+      testCase "unknown tag is rejected" $+        Aeson.decode @KeyValue "{\"t\":\"x\"}" @?= Nothing,+      testCase "fractional numbers are rejected" $+        Aeson.decode @KeyValue "{\"t\":\"i\",\"v\":1.5}" @?= Nothing,+      testProperty "KeyValue JSON round-trips" $+        forAll arbitraryKeyValue \kv -> Aeson.decode (Aeson.encode kv) === Just kv+    ]++-- * Connection JSON shape (M3)++connectionJsonTests :: TestTree+connectionJsonTests =+  testGroup+    "Connection JSON"+    [ testCase "Relay-conventional shape, exact bytes" $+        Aeson.encode exampleConnection+          @?= "{\"edges\":[\+              \{\"node\":\"first\",\"cursor\":\"eyJ2IjoxLCJmIjo3LCJrIjpbeyJ0IjoiaSIsInYiOjF9XX0\"},\+              \{\"node\":\"second\",\"cursor\":\"eyJ2IjoxLCJmIjo3LCJrIjpbeyJ0IjoiaSIsInYiOjJ9XX0\"}],\+              \\"pageInfo\":{\"hasNextPage\":true,\"hasPreviousPage\":false,\+              \\"startCursor\":\"eyJ2IjoxLCJmIjo3LCJrIjpbeyJ0IjoiaSIsInYiOjF9XX0\",\+              \\"endCursor\":\"eyJ2IjoxLCJmIjo3LCJrIjpbeyJ0IjoiaSIsInYiOjJ9XX0\"}}",+      testCase "empty page has null cursors" $+        Aeson.encode (Connection {edges = [], pageInfo = PageInfo False False Nothing Nothing} :: Connection Bool)+          @?= "{\"edges\":[],\"pageInfo\":{\"hasNextPage\":false,\"hasPreviousPage\":false,\+              \\"startCursor\":null,\"endCursor\":null}}",+      testCase "Connection JSON round-trips" $+        Aeson.decode (Aeson.encode exampleConnection) @?= Just exampleConnection+    ]+  where+    c1 = encodeCursor (CursorPayload 1 7 [KvInt 1])+    c2 = encodeCursor (CursorPayload 1 7 [KvInt 2])+    exampleConnection :: Connection String+    exampleConnection =+      Connection+        { edges = [Edge "first" c1, Edge "second" c2],+          pageInfo = PageInfo True False (Just c1) (Just c2)+        }++-- * Cursor codec (M4)++cursorCodecTests :: TestTree+cursorCodecTests =+  testGroup+    "cursor codec"+    [ testProperty "round-trips any version-1 payload" $+        forAll arbitraryPayload \p ->+          decodeCursor (fingerprint p) (encodeCursor p) === Right p,+      testProperty "any other fingerprint is rejected" $+        forAll arbitraryPayload \p -> \other ->+          other /= fingerprint p ==>+            decodeCursor other (encodeCursor p)+              === Left FingerprintMismatch {expected = other, actual = fingerprint p},+      testCase "golden encode: kitchen sink" $+        encodeCursor kitchenSink @?= Cursor kitchenSinkWire,+      testCase "golden decode: kitchen sink" $+        decodeCursor 305419896 (Cursor kitchenSinkWire) @?= Right kitchenSink,+      testCase "golden encode: small" $+        encodeCursor (CursorPayload 1 1 [KvInt 7])+          @?= Cursor "eyJ2IjoxLCJmIjoxLCJrIjpbeyJ0IjoiaSIsInYiOjd9XX0",+      testCase "golden decode: small" $+        decodeCursor 1 (Cursor "eyJ2IjoxLCJmIjoxLCJrIjpbeyJ0IjoiaSIsInYiOjd9XX0")+          @?= Right (CursorPayload 1 1 [KvInt 7]),+      testCase "BadBase64 on non-alphabet bytes" $+        decodeCursor 1 (Cursor "%%%") @?= Left BadBase64,+      testCase "BadJson on well-formed base64 of non-payload" $+        case decodeCursor 1 (Cursor "aGVsbG8") of -- base64url("hello")+          Left (BadJson _) -> pure ()+          other -> assertFailure ("expected BadJson, got " <> show other),+      testCase "WrongVersion on a version-2 payload" $+        decodeCursor 1 (encodeCursor (CursorPayload 2 1 [])) @?= Left (WrongVersion 2)+    ]+  where+    kitchenSink =+      CursorPayload+        1+        305419896+        [ KvTimestampMicros 1720000000123456,+          KvInt 42,+          KvText "abc",+          KvUuid exampleUuid,+          KvBool True,+          KvNull+        ]+    kitchenSinkWire =+      "eyJ2IjoxLCJmIjozMDU0MTk4OTYsImsiOlt7InQiOiJ0cyIsInYiOjE3MjAwMDAwMDAxMjM0NTZ9\+      \LHsidCI6ImkiLCJ2Ijo0Mn0seyJ0IjoicyIsInYiOiJhYmMifSx7InQiOiJ1IiwidiI6IjBkYzRj\+      \YTJmLTZmNmEtNGYyOC05ZjdmLTNmMmExYjJjM2Q0ZSJ9LHsidCI6ImIiLCJ2Ijp0cnVlfSx7InQi\+      \OiJuIn1dfQ"++-- * Cursor http-api-data instances (EP-2 M1)++httpApiDataTests :: TestTree+httpApiDataTests =+  testGroup+    "Cursor http-api-data"+    [ testCase "toUrlPiece is the wire text verbatim" $+        toUrlPiece (Cursor "-_8A") @?= "-_8A",+      testCase "round-trips URL-safe alphabet bytes" $+        -- "-_8A" is base64url of [0xfb, 0xff, 0x00]; plain base64 would be "+/8A"+        parseUrlPiece (toUrlPiece (Cursor "-_8A")) @?= Right (Cursor "-_8A"),+      testProperty "round-trips any minted cursor" $+        forAll arbitraryPayload \p ->+          let c = encodeCursor p+           in parseUrlPiece (toUrlPiece c) === Right c,+      testCase "rejects non-base64url input" $+        case parseUrlPiece @Cursor "%%%not-base64url!" of+          Left _ -> pure ()+          Right c -> assertFailure ("expected Left, got " <> show c),+      testCase "rejects padded base64" $+        case parseUrlPiece @Cursor "YWI=" of+          Left _ -> pure ()+          Right c -> assertFailure ("expected Left, got " <> show c)+    ]++-- * mkPageRequest validation matrix (M5)++pageRequestTests :: TestTree+pageRequestTests =+  testGroup+    "mkPageRequest"+    [ ok "no arguments: forward, default size" Nothing Nothing Nothing Nothing (PageRequest 25 Forward Nothing),+      ok "first" (Just 10) Nothing Nothing Nothing (PageRequest 10 Forward Nothing),+      ok "first+after" (Just 10) (Just c) Nothing Nothing (PageRequest 10 Forward (Just c)),+      ok "after alone: forward, default size" Nothing (Just c) Nothing Nothing (PageRequest 25 Forward (Just c)),+      ok "last" Nothing Nothing (Just 10) Nothing (PageRequest 10 Backward Nothing),+      ok "last+before" Nothing Nothing (Just 10) (Just c) (PageRequest 10 Backward (Just c)),+      ok "before alone: backward, default size" Nothing Nothing Nothing (Just c) (PageRequest 25 Backward (Just c)),+      ok "zero size is allowed" (Just 0) Nothing Nothing Nothing (PageRequest 0 Forward Nothing),+      ok "size equal to max is allowed" (Just 100) Nothing Nothing Nothing (PageRequest 100 Forward Nothing),+      bad "first+last" (Just 1) Nothing (Just 1) Nothing FirstAndLastBothGiven,+      bad "everything at once: first+last wins" (Just 1) (Just c) (Just 1) (Just c) FirstAndLastBothGiven,+      bad "after+before" Nothing (Just c) Nothing (Just c) AfterAndBeforeBothGiven,+      bad "first+before" (Just 1) Nothing Nothing (Just c) FirstWithBefore,+      bad "last+after" Nothing (Just c) (Just 1) Nothing LastWithAfter,+      bad "negative first" (Just (-1)) Nothing Nothing Nothing (NegativePageSize (-1)),+      bad "negative last" Nothing Nothing (Just (-5)) (Just c) (NegativePageSize (-5)),+      bad "first over max" (Just 101) Nothing Nothing Nothing PageSizeTooLarge {requested = 101, allowedMax = 100},+      bad "last over max" Nothing Nothing (Just 1000) Nothing PageSizeTooLarge {requested = 1000, allowedMax = 100}+    ]+  where+    cfg = PageConfig {defaultPageSize = 25, maxPageSize = 100}+    c = encodeCursor (CursorPayload 1 1 [KvInt 7])+    ok name f a l b expected =+      testCase name (mkPageRequest cfg f a l b @?= Right expected)+    bad name f a l b expected =+      testCase name (mkPageRequest cfg f a l b @?= Left expected)++-- * Generators++exampleUuid :: UUID.UUID+exampleUuid = fromJust (UUID.fromString "0dc4ca2f-6f6a-4f28-9f7f-3f2a1b2c3d4e")++arbitraryKeyValue :: Gen KeyValue+arbitraryKeyValue =+  oneof+    [ KvInt <$> arbitrary,+      KvText <$> arbitrary,+      KvUuid <$> arbitrary,+      KvTimestampMicros <$> arbitrary,+      KvBool <$> arbitrary,+      pure KvNull+    ]++arbitraryPayload :: Gen CursorPayload+arbitraryPayload = CursorPayload 1 <$> arbitrary <*> listOf arbitraryKeyValue