kioku-core 0.9.0.2 → 0.10.0.0

raw patch · 13 files changed

+934/−55 lines, 13 filesdep +hasql-dynamic-statementsdep +relay-paginationdep +relay-pagination-hasqldep ~kioku-apidep ~kioku-coredep ~kioku-migrationsPVP ok

version bump matches the API change (PVP)

Dependencies added: hasql-dynamic-statements, relay-pagination, relay-pagination-hasql

Dependency ranges changed: kioku-api, kioku-core, kioku-migrations

API changes (from Hackage documentation)

Files

• CHANGELOG.md +23/−0
• kioku-core.cabal +11/−5
• src/Kioku/Memory.hs +57/−8
• src/Kioku/Memory/ReadModel.hs +103/−4
• src/Kioku/Pagination.hs +81/−0
• src/Kioku/ProjectionCatalog.hs +19/−4
• src/Kioku/Session.hs +40/−20
• src/Kioku/Session/ReadModel.hs +228/−3
• test/Kioku/BoundedReadSpec.hs +328/−0
• test/Kioku/ProjectionCatalogSpec.hs +35/−4
• test/Kioku/ReadModelReconcileSpec.hs +2/−2
• test/Kioku/SpaceIsolationSpec.hs +4/−4
• test/Main.hs +3/−1

@@ -2,6 +2,29 @@  ## [Unreleased] +## 0.10.0.0 — 2026-10-19++### Breaking Changes++- The bounded reads (`Kioku.Session.getPageWithContext`, `getCountsWithContext`,+  `getTurnsPageWithContext`, `getRelationsWithContext`; `Kioku.Memory.getPageWithContext`,+  `getCountsWithContext`) now refuse a context that does not grant `MemoryRead` before any+  SQL runs, and return one flat `Kioku.Pagination.BoundedReadError` instead of+  `Either ReadModelError (Either BoundedPageError a)`.+- `SessionFilter.status` is a typed `SessionStatus` (now exported, with+  `parseSessionStatus` and `sessionStatusToText`) instead of `Text`.++### Changed++- The session and memory collections share one namespace/scope predicate and one space+  parameter from `Kioku.Pagination`; the page limit is exported as `maxBoundedPageSize`.+- Document that migration 0014 blocks writes to the three tables while its indexes build.+  The catalog fingerprint and read-model identities are unchanged.++## 0.9.1.0 — 2026-10-19++- Add context-first Session/Memory Relay pages, scalar status and relation counts, turns and cycle-safe lineage traversal. Preserve native Memory ordering and expose authoritative archive changed receipts. Register six read-only query models and test explicit public catalog adoption from the exact previous release. Existing facades remain compatible.+ ## 0.9.0.2 — 2026-10-16  ### Changed

@@ -1,6 +1,6 @@ cabal-version: 3.0 name: kioku-core-version: 0.9.0.2+version: 0.10.0.0 synopsis: Reusable agent memory runtime description:   Core runtime for kioku. M1 establishes the application effect stack; later@@ -76,6 +76,7 @@     Kioku.Memory.Embedding.Worker     Kioku.Memory.EventStream     Kioku.Memory.ReadModel+    Kioku.Pagination     Kioku.Partition     Kioku.ProjectionCatalog     Kioku.ReadModel@@ -128,16 +129,19 @@     filepath >=1.4 && <1.6,     generic-lens >=2.2 && <2.4,     hasql >=1.6 && <1.11,+    hasql-dynamic-statements ^>=0.5.1.2,     hasql-pool >=1.2 && <1.5,     hasql-transaction >=1.0 && <1.3,     hs-opentelemetry-api >=1.0 && <1.1,     keiki ^>=0.9.1.0,     keiro ^>=0.21.0.0,     keiro-core ^>=0.21.0.0,-    kioku-api ^>=0.9.0.2,+    kioku-api ^>=0.10.0.0,     kiroku-store ^>=0.11.0.0,     lens >=5.2 && <5.4,     mmzk-typeid >=0.7 && <0.8,+    relay-pagination ^>=0.1.1.2,+    relay-pagination-hasql ^>=0.1.1.2,     shibuya-core ^>=0.10.0.1,     shibuya-kiroku-adapter ^>=0.6.0.1,     shikumi ^>=0.4.0.0,@@ -156,6 +160,7 @@   other-modules:     Kioku.AIRuntimeSpec     Kioku.AwaitingSpec+    Kioku.BoundedReadSpec     Kioku.CodecCompatSpec     Kioku.DistillSpec     Kioku.EmbeddingWorkerSpec@@ -201,11 +206,12 @@     hasql-transaction >=1.0,     keiro ^>=0.21.0.0,     keiro-core ^>=0.21.0.0,-    kioku-api ^>=0.9.0.2,-    kioku-core ^>=0.9.0.2,-    kioku-migrations:test-support ^>=0.9.0.2,+    kioku-api ^>=0.10.0.0,+    kioku-core ^>=0.10.0.0,+    kioku-migrations:test-support ^>=0.10.0.0,     kiroku-store ^>=0.11.0.0,     lens >=5.2,+    relay-pagination ^>=0.1.1.2,     shibuya-core ^>=0.10.0.1,     shikumi ^>=0.4.0.0,     shikumi-trace ^>=0.3.0.0,

@@ -28,6 +28,11 @@ -- takes the space rather than the whole context because these functions return -- @Either ReadModelError@, and a permission denial has already been decided — a context exists -- only for permissions 'Kioku.Api.Access.authorizeMemoryAccess' actually checked.+--+-- The bounded reads ('getPageWithContext', 'getCountsWithContext') are the exception: they take+-- the whole context, refuse one that does not grant 'MemoryRead' with+-- 'BoundedReadNotPermitted', and only then read the context's space. A context minted only to+-- record or forget cannot be spent on listing the space. module Kioku.Memory   ( MemoryWriteError (..), @@ -35,6 +40,7 @@     recordWithContext,     supersedeWithContext,     archiveWithContext,+    archiveWithContextChanged,     updateTagsWithContext,     updateConfidenceWithContext,     mergeWithContext,@@ -54,13 +60,20 @@     getRowsBySession,     getActiveRowsByType,     getSupersessionChain,+    MemoryFilter (..),+    MemorySelection (..),+    MemoryCounts (..),+    MemoryRow (..),+    BoundedReadError (..),+    getPageWithContext,+    getCountsWithContext,   ) where  import Data.List (find) import Effectful (Eff, IOE, (:>)) import Effectful.Error.Static (Error)-import Keiro.Command (CommandError (..), defaultRunCommandOptions)+import Keiro.Command (CommandError (..), CommandResult (..), defaultRunCommandOptions) import Keiro.Projection (runCommandWithProjections) import Keiro.Projection.Catalog (typedInlineProjections) import Keiro.ReadModel (QueryFreshness (Immediate), ReadModelError, runQueryWithFreshness)@@ -86,16 +99,24 @@     MemoriesByScopeQuery (..),     MemoriesBySessionQuery (..),     MemoriesByTypeQuery (..),+    MemoriesCountQuery (..),+    MemoriesPageQuery (..),     MemoryByIdQuery (..),+    MemoryCounts (..),+    MemoryFilter (..),     MemoryRow (..),+    MemorySelection (..),     MemorySupersessionChainQuery (..),     memoriesByNamespaceRowsReadModel,     memoriesByScopeRowsReadModel,     memoriesBySessionRowsReadModel,     memoriesByTypeRowsReadModel,+    memoriesCountReadModel,+    memoriesPageReadModel,     memoryByIdReadModel,     memorySupersessionChainReadModel,   )+import Kioku.Pagination (BoundedReadError (..), Connection, PageRequest, gatedPage, gatedRead) import Kioku.Prelude import Kioku.ProjectionCatalog (kiokuProjectionCatalog, memoryProjectionSet) import Kiroku.Store.Effect (Store)@@ -249,16 +270,32 @@   (IOE :> es, KirokuStoreResource :> es, Store :> es, Error StoreError :> es) =>   ArchiveMemoryData ->   Eff es (Either MemoryWriteError MemoryId)-archiveIn cmdData = do+archiveIn cmdData = fmap (fmap fst) (archiveInChanged cmdData)++-- | The flag records whether this command appended an archive event, including+-- concurrent retries. A matching archive by another command returns False.+archiveWithContextChanged ::+  (IOE :> es, KirokuStoreResource :> es, Store :> es, Error StoreError :> es) =>+  MemoryAccessContext -> ArchiveMemoryData -> Eff es (Either MemoryWriteError (MemoryId, Bool))+archiveWithContextChanged context cmdData =+  underContext context MemoryForget cmdData.memorySpaceId cmdData.actorPrincipal (archiveInChanged cmdData)++archiveInChanged ::+  (IOE :> es, KirokuStoreResource :> es, Store :> es, Error StoreError :> es) =>+  ArchiveMemoryData -> Eff es (Either MemoryWriteError (MemoryId, Bool))+archiveInChanged cmdData = do   existing <- lookupMemory cmdData.memorySpaceId cmdData.memoryId   case existing of     Left err -> pure (Left (MemoryReadFailed err))     Right Nothing -> pure (Left MemoryNotFound)     Right (Just row)-      | row.status /= "active" -> pure (idempotentOr "archive" archiveMismatch row cmdData.memoryId)-      | otherwise ->-          runMemoryCommand cmdData.memoryId (ArchiveMemory cmdData)-            >>= acceptRejectedIfMatches cmdData.memorySpaceId cmdData.memoryId (isNothing . archiveMismatch)+      | row.status /= "active" -> pure (fmap (,False) (idempotentOr "archive" archiveMismatch row cmdData.memoryId))+      | otherwise -> do+          outcome <- runMemoryCommandChanged cmdData.memoryId (ArchiveMemory cmdData)+          case outcome of+            Left err@(MemoryCommandRejected CommandRejected) ->+              fmap (fmap (,False)) (acceptRejectedIfMatches cmdData.memorySpaceId cmdData.memoryId (isNothing . archiveMismatch) (Left err))+            result -> pure result   where     archiveMismatch = mismatchOf memoryArchiveFields cmdData @@ -608,7 +645,12 @@   MemoryId ->   MemoryCommand ->   Eff es (Either MemoryWriteError MemoryId)-runMemoryCommand mid cmd = do+runMemoryCommand mid cmd = fmap (fmap fst) (runMemoryCommandChanged mid cmd)++runMemoryCommandChanged ::+  (IOE :> es, KirokuStoreResource :> es, Store :> es, Error StoreError :> es) =>+  MemoryId -> MemoryCommand -> Eff es (Either MemoryWriteError (MemoryId, Bool))+runMemoryCommandChanged mid cmd = do   -- Keiro's catalog cannot declare the shared framework-owned timer table as   -- a Kioku target. Derive Kioku's handler from the catalog, keep the timer   -- callback explicit, and run both in the append transaction; see@@ -623,4 +665,11 @@   pure $     case result of       Left err -> Left (MemoryCommandRejected err)-      Right _ -> Right mid+      Right receipt -> Right (mid, receipt.eventsAppended > 0)++-- | Bounded reads refuse a context that does not grant 'MemoryRead' before any SQL runs.+getPageWithContext :: (IOE :> es, Store :> es) => MemoryAccessContext -> MemorySelection -> PageRequest -> Eff es (Either BoundedReadError (Connection MemoryRow))+getPageWithContext context selection page = gatedPage context (runQueryWithFreshness Nothing Immediate memoriesPageReadModel MemoriesPageQuery {context, selection, page})++getCountsWithContext :: (IOE :> es, Store :> es) => MemoryAccessContext -> MemorySelection -> Eff es (Either BoundedReadError MemoryCounts)+getCountsWithContext context selection = gatedRead context (runQueryWithFreshness Nothing Immediate memoriesCountReadModel MemoriesCountQuery {context, selection})

@@ -6,7 +6,14 @@ -- from writing, outside the space it was authorized for, and it makes the partition visible in -- every query a reviewer reads. module Kioku.Memory.ReadModel-  ( memoryInlineProjection,+  ( MemoryFilter (..),+    MemorySelection (..),+    MemoriesPageQuery (..),+    MemoriesCountQuery (..),+    MemoryCounts (..),+    memoriesPageReadModel,+    memoriesCountReadModel,+    memoryInlineProjection,     MemoryRow (..),     MemoryByIdQuery (..),     MemoriesByNamespaceQuery (..),@@ -41,11 +48,12 @@ import Data.ByteString.Lazy qualified as BL import Data.Functor.Contravariant ((>$<)) import Data.Generics.Labels ()-import Data.Int (Int32)+import Data.Int (Int32, Int64) import Data.Set (Set) import Data.Set qualified as Set import Data.Text.Encoding qualified as TE import Hasql.Decoders qualified as D+import Hasql.DynamicStatements.Snippet qualified as S import Hasql.Encoders qualified as E import Hasql.Statement (Statement, preparable) import Hasql.Transaction qualified as Tx@@ -56,15 +64,18 @@     ReadModelBlueprint (..),     immediateReadModel,   )-import Kioku.Api.Access (MemorySpaceId)+import Kioku.Api.Access (MemoryAccessContext, MemorySpaceId)+import Kioku.Api.Recall (RecallTarget) import Kioku.Api.Scope (scopeFromColumns, scopeKindText, scopeNamespaceText, scopeRefText)-import Kioku.Api.Types (MemoryRecord (..), confidenceToText, memoryTypeToText)+import Kioku.Api.Types (MemoryRecord (..), MemoryStatus, MemoryType, confidenceToText, memoryStatusToText, memoryTypeToText) import Kioku.Database.Schema (kiokuSchema, memoriesRelation, memoriesTable) import Kioku.Id (idText) import Kioku.Memory.Domain+import Kioku.Pagination (BoundedPageError, Connection, PageRequest, boundedPage, contextSpaceSnippet, recallTargetSnippet) import Kioku.Partition (memorySpaceColumn, memorySpaceParam) import Kioku.Prelude import Kiroku.Store.Types (RecordedEvent)+import Relay.Pagination.Hasql qualified as R  data MemoryRow = MemoryRow   { memorySpaceId :: !MemorySpaceId,@@ -728,3 +739,91 @@         <> ((\c -> c.updatedAt) >$< E.param (E.nonNullable E.timestamptz))     )     D.noResult++data MemoryFilter = MemoryFilter+  {target :: !RecallTarget, status :: !(Maybe MemoryStatus), memoryType :: !(Maybe MemoryType), sessionId :: !(Maybe Text)}+  deriving stock (Eq, Show)++data MemorySelection = FilteredMemories !MemoryFilter | SupersessionChain !Text+  deriving stock (Eq, Show)++data MemoriesPageQuery = MemoriesPageQuery {context :: !MemoryAccessContext, selection :: !MemorySelection, page :: !PageRequest}++data MemoriesCountQuery = MemoriesCountQuery {context :: !MemoryAccessContext, selection :: !MemorySelection}++data MemoryCounts = MemoryCounts {total :: !Int64, active :: !Int64, superseded :: !Int64, merged :: !Int64, archived :: !Int64}+  deriving stock (Generic, Eq, Show)++memoriesPageReadModel :: ReadModel MemoriesPageQuery (Either BoundedPageError (Connection MemoryRow))+memoriesPageReadModel =+  immediateReadModel+    ReadModelBlueprint+      { name = "kioku-memories-page",+        schema = kiokuSchema,+        tableName = memoriesRelation,+        version = memoryReadModelVersion,+        shapeHash = memoryReadModelShapeHash,+        cursorAuthority = NoQueryCursor,+        query = \q -> boundedPage (memoryPageOrder q.selection) memoryRowDecoder (memorySelectionBase q.context q.selection) q.page+      }++memoriesCountReadModel :: ReadModel MemoriesCountQuery MemoryCounts+memoriesCountReadModel =+  immediateReadModel+    ReadModelBlueprint+      { name = "kioku-memories-count",+        schema = kiokuSchema,+        tableName = memoriesRelation,+        version = memoryReadModelVersion,+        shapeHash = memoryReadModelShapeHash,+        cursorAuthority = NoQueryCursor,+        query = \q ->+          Tx.statement+            ()+            ( S.toPreparableStatement+                ("SELECT count(*),count(*) FILTER(WHERE status='active'),count(*) FILTER(WHERE status='superseded'),count(*) FILTER(WHERE status='merged'),count(*) FILTER(WHERE status='archived') FROM (" <> memorySelectionBase q.context q.selection <> ") selected")+                (D.singleRow (MemoryCounts <$> int8 <*> int8 <*> int8 <*> int8 <*> int8))+            )+      }+  where+    int8 = D.column (D.nonNullable D.int8)++memoryPageOrder :: MemorySelection -> R.SortSpec MemoryRow+memoryPageOrder selection = R.SortSpec $ case selection of+  SupersessionChain _ -> R.KeyColumn "created_at" R.Asc (.createdAt) R.timestamptzKey :| [identity]+  FilteredMemories filters -> case filters.sessionId of+    Just _ -> recent :| [identity]+    Nothing -> R.KeyColumn "priority" R.Asc (fromIntegral . (.priority)) R.int8Key :| [recent, identity]+  where+    recent = R.KeyColumn "created_at" R.Desc (.createdAt) R.timestamptzKey+    identity = R.KeyColumn "memory_id" R.Asc (.memoryId) R.textKey++memorySelectionBase :: MemoryAccessContext -> MemorySelection -> S.Snippet+memorySelectionBase context = \case+  FilteredMemories filters ->+    "SELECT "+      <> S.sql memoryRowColumns+      <> " FROM "+      <> S.sql memoriesTable+      <> " WHERE memory_space_id="+      <> contextSpaceSnippet context+      <> recallTargetSnippet filters.target+      <> maybe "" (\value -> " AND status=" <> S.param (memoryStatusToText value)) filters.status+      <> maybe "" (\value -> " AND memory_type=" <> S.param (memoryTypeToText value)) filters.memoryType+      <> maybe "" (\value -> " AND session_id=" <> S.param value) filters.sessionId+  SupersessionChain identity ->+    "WITH RECURSIVE chain AS (SELECT "+      <> S.sql memoryRowColumns+      <> " FROM "+      <> S.sql memoriesTable+      <> " WHERE memory_space_id="+      <> contextSpaceSnippet context+      <> " AND memory_id="+      <> S.param identity+      <> " UNION SELECT "+      <> S.sql (qualifiedMemoryRowColumns "m")+      <> " FROM "+      <> S.sql memoriesTable+      <> " m JOIN chain c ON m.memory_space_id=c.memory_space_id AND (m.memory_id=c.supersedes OR m.supersedes=c.memory_id OR m.memory_id=c.superseded_by OR m.superseded_by=c.memory_id)) SELECT "+      <> S.sql memoryRowColumns+      <> " FROM chain"

@@ -0,0 +1,81 @@+-- | SQL-bounded core reads using the shared Relay keyset implementation.+-- Hosts exposing these cursors over an API bind their collection/filter context+-- around the public Relay cursor; this module never forks that codec.+--+-- Unlike the older space-first reads, every bounded read checks that its context grants+-- 'MemoryRead' before any SQL runs. A context minted only to record or forget cannot be spent+-- on listing or counting the space.+module Kioku.Pagination+  ( BoundedPageError (..),+    BoundedReadError (..),+    boundedPage,+    maxBoundedPageSize,+    gatedRead,+    gatedPage,+    contextSpaceSnippet,+    recallTargetSnippet,+    Connection,+    PageRequest (..),+  )+where++import Data.Bifunctor (first)+import Data.Text (Text)+import Hasql.Decoders qualified as D+import Hasql.DynamicStatements.Snippet qualified as S+import Hasql.Transaction qualified as Tx+import Keiro.ReadModel (ReadModelError)+import Kioku.Api.Access (MemoryAccessContext, MemoryPermission (MemoryRead), memoryContextAllows, memoryContextSpace, memorySpaceIdText)+import Kioku.Api.Recall (RecallTarget (..))+import Kioku.Api.Scope (MemoryScope (..), Namespace (..), ScopeKind (..))+import Relay.Pagination (Connection, CursorError, PageRequest (..), PageRequestError (..))+import Relay.Pagination.Hasql qualified as R++data BoundedPageError = InvalidPageSize !PageRequestError | InvalidPageCursor !CursorError+  deriving stock (Eq, Show)++-- | Every way a bounded read can fail, flattened so callers match one type.+data BoundedReadError+  = -- | the context authorized other actions, but not reading+    BoundedReadNotPermitted !MemoryPermission+  | BoundedReadFailed !ReadModelError+  | BoundedReadInvalidPage !BoundedPageError+  deriving stock (Eq, Show)++-- | The largest page any bounded read returns. A zero-size page is valid Relay and returns+-- only page info.+maxBoundedPageSize :: Int+maxBoundedPageSize = 100++boundedPage :: R.SortSpec row -> D.Row row -> S.Snippet -> PageRequest -> Tx.Transaction (Either BoundedPageError (Connection row))+boundedPage order decoder base request+  | request.pageSize < 0 = pure (Left (InvalidPageSize (NegativePageSize request.pageSize)))+  | request.pageSize > maxBoundedPageSize = pure (Left (InvalidPageSize (PageSizeTooLarge request.pageSize maxBoundedPageSize)))+  | otherwise = case R.paginate order request base decoder of+      Left failure -> pure (Left (InvalidPageCursor failure))+      Right statement -> Right <$> Tx.statement () statement++-- | Run a scalar read only if the context grants 'MemoryRead'.+gatedRead :: (Applicative f) => MemoryAccessContext -> f (Either ReadModelError a) -> f (Either BoundedReadError a)+gatedRead context run+  | not (memoryContextAllows MemoryRead context) = pure (Left (BoundedReadNotPermitted MemoryRead))+  | otherwise = first BoundedReadFailed <$> run++-- | Run a page read only if the context grants 'MemoryRead'.+gatedPage :: (Applicative f) => MemoryAccessContext -> f (Either ReadModelError (Either BoundedPageError a)) -> f (Either BoundedReadError a)+gatedPage context run = (>>= first BoundedReadInvalidPage) <$> gatedRead context run++-- | The context's memory space as a typed parameter.+contextSpaceSnippet :: MemoryAccessContext -> S.Snippet+contextSpaceSnippet = S.param . memorySpaceIdText . memoryContextSpace++-- | The namespace/scope predicate shared by the session and memory collections. The global+-- bucket is matched with @IS NULL@; an entity scope always names both its kind and ref.+recallTargetSnippet :: RecallTarget -> S.Snippet+recallTargetSnippet = \case+  NamespaceWide (Namespace ns) -> namespace ns+  ExactScope (ScopeGlobal (Namespace ns)) -> namespace ns <> " AND scope_kind IS NULL AND scope_ref IS NULL"+  ExactScope (ScopeEntity (Namespace ns) (ScopeKind kind) ref) -> namespace ns <> " AND scope_kind=" <> S.param kind <> " AND scope_ref=" <> S.param ref+  where+    namespace :: Text -> S.Snippet+    namespace ns = " AND namespace=" <> S.param ns

@@ -69,6 +69,8 @@     memoriesBySessionRowsReadModel,     memoriesByTypeReadModel,     memoriesByTypeRowsReadModel,+    memoriesCountReadModel,+    memoriesPageReadModel,     memoryByIdReadModel,     memoryInlineProjection,     memorySupersessionChainReadModel,@@ -82,11 +84,15 @@     sessionChainReadModel,     sessionDelegationChildrenReadModel,     sessionInlineProjection,+    sessionRelationsReadModel,     sessionsByFocusReadModel,     sessionsByNamespaceReadModel,     sessionsByScopeReadModel,     sessionsByStartedRangeReadModel,+    sessionsCountReadModel,+    sessionsPageReadModel,     turnsBySessionReadModel,+    turnsPageReadModel,   ) import Kiroku.Store.Types (CategoryName (..)) @@ -166,7 +172,9 @@  memoryQueryBindings :: [SomeQueryModelBinding] memoryQueryBindings =-  [ binding memoryByIdReadModel memoryGroupId memoriesTargetId,+  [ binding memoriesPageReadModel memoryGroupId memoriesTargetId,+    binding memoriesCountReadModel memoryGroupId memoriesTargetId,+    binding memoryByIdReadModel memoryGroupId memoriesTargetId,     binding memoriesByNamespaceReadModel memoryGroupId memoriesTargetId,     binding memoriesByNamespaceRowsReadModel memoryGroupId memoriesTargetId,     binding memoriesByScopeReadModel memoryGroupId memoriesTargetId,@@ -180,7 +188,11 @@  sessionQueryBindings :: [SomeQueryModelBinding] sessionQueryBindings =-  [ binding sessionByIdReadModel sessionGroupId sessionsTargetId,+  [ binding sessionsPageReadModel sessionGroupId sessionsTargetId,+    binding sessionsCountReadModel sessionGroupId sessionsTargetId,+    binding turnsPageReadModel sessionGroupId turnsTargetId,+    bindingMany sessionRelationsReadModel sessionGroupId [sessionsTargetId, turnsTargetId],+    binding sessionByIdReadModel sessionGroupId sessionsTargetId,     binding sessionsByNamespaceReadModel sessionGroupId sessionsTargetId,     binding sessionsByScopeReadModel sessionGroupId sessionsTargetId,     binding sessionsByFocusReadModel sessionGroupId sessionsTargetId,@@ -192,13 +204,16 @@   ]  binding :: ReadModel q r -> RebuildGroupId -> TargetId -> SomeQueryModelBinding-binding readModel rebuildGroup observedTarget =+binding readModel rebuildGroup observedTarget = bindingMany readModel rebuildGroup [observedTarget]++bindingMany :: ReadModel q r -> RebuildGroupId -> [TargetId] -> SomeQueryModelBinding+bindingMany readModel rebuildGroup observedTargets =   SomeQueryModelBinding     QueryModelBinding       { queryModelId = must (mkQueryModelId readModel.name),         readModel,         rebuildGroup,-        observedTargets = [observedTarget],+        observedTargets,         claimSite = site ("query model " <> readModel.name)       } 

@@ -47,6 +47,17 @@     getDelegationChildren,     getAwaitingByCorrelationKey,     getTurns,+    SessionStatus (..),+    SessionFilter (..),+    SessionSelection (..),+    SessionCounts (..),+    SessionRelations (..),+    TurnRow (..),+    BoundedReadError (..),+    getPageWithContext,+    getCountsWithContext,+    getTurnsPageWithContext,+    getRelationsWithContext,   ) where @@ -72,6 +83,7 @@ import Kioku.Api.Scope (MemoryScope, Namespace (..), scopeKindText, scopeNamespaceText, scopeRefText) import Kioku.Distill.Timer (l1TimerScheduleProjection) import Kioku.Id (SessionId, idText)+import Kioku.Pagination (BoundedReadError (..), Connection, PageRequest, gatedPage, gatedRead) import Kioku.Prelude import Kioku.ProjectionCatalog (kiokuProjectionCatalog, sessionProjectionSet) import Kioku.Session.Domain@@ -80,23 +92,37 @@   ( AwaitingSessionsByCorrelationKeyQuery (..),     SessionByIdQuery (..),     SessionChainQuery (..),+    SessionCounts (..),     SessionDelegationChildrenQuery (..),+    SessionFilter (..),+    SessionRelations (..),+    SessionRelationsQuery (..),     SessionRow (..),+    SessionSelection (..),+    SessionStatus (..),     SessionsByFocusQuery (..),     SessionsByNamespaceQuery (..),     SessionsByScopeQuery (..),     SessionsByStartedRangeQuery (..),+    SessionsCountQuery (..),+    SessionsPageQuery (..),     TurnRow (..),     TurnsBySessionQuery (..),+    TurnsPageQuery (..),     awaitingSessionsByCorrelationKeyReadModel,+    parseSessionStatus,     sessionByIdReadModel,     sessionChainReadModel,     sessionDelegationChildrenReadModel,+    sessionRelationsReadModel,     sessionsByFocusReadModel,     sessionsByNamespaceReadModel,     sessionsByScopeReadModel,     sessionsByStartedRangeReadModel,+    sessionsCountReadModel,+    sessionsPageReadModel,     turnsBySessionReadModel,+    turnsPageReadModel,   ) import Kiroku.Store.Effect (Store) import Kiroku.Store.Effect.Resource (KirokuStoreResource)@@ -214,26 +240,6 @@  -- * Idempotent accepts --- | The five statuses the projection writes. Parsing at the point of decision keeps--- 'SessionRow.status' a 'Text' (it is part of the read-model shape hosts consume) while--- removing stringly-typed comparisons from the decision logic.-data SessionStatus-  = StatusRunning-  | StatusAwaiting-  | StatusCompleted-  | StatusFailed-  | StatusInteractive-  deriving stock (Eq, Show)--parseSessionStatus :: Text -> Maybe SessionStatus-parseSessionStatus = \case-  "running" -> Just StatusRunning-  "awaiting" -> Just StatusAwaiting-  "completed" -> Just StatusCompleted-  "failed" -> Just StatusFailed-  "interactive" -> Just StatusInteractive-  _ -> Nothing- -- | Look up the session and hand its row plus parsed status to the caller. withExistingSession ::   (IOE :> es, Store :> es) =>@@ -821,3 +827,17 @@     case result of       Left err -> Left (SessionCommandRejected err)       Right _ -> Right sid++-- | Filters and lineage selection are applied in SQL before the bounded page. Like every+-- bounded read, this refuses a context that does not grant 'MemoryRead' before any SQL runs.+getPageWithContext :: (IOE :> es, Store :> es) => MemoryAccessContext -> SessionSelection -> PageRequest -> Eff es (Either BoundedReadError (Connection SessionRow))+getPageWithContext context selection page = gatedPage context (runQueryWithFreshness Nothing Immediate sessionsPageReadModel SessionsPageQuery {context, selection, page})++getCountsWithContext :: (IOE :> es, Store :> es) => MemoryAccessContext -> SessionSelection -> Eff es (Either BoundedReadError SessionCounts)+getCountsWithContext context selection = gatedRead context (runQueryWithFreshness Nothing Immediate sessionsCountReadModel SessionsCountQuery {context, selection})++getTurnsPageWithContext :: (IOE :> es, Store :> es) => MemoryAccessContext -> SessionId -> PageRequest -> Eff es (Either BoundedReadError (Connection TurnRow))+getTurnsPageWithContext context sid page = gatedPage context (runQueryWithFreshness Nothing Immediate turnsPageReadModel TurnsPageQuery {context, sessionId = idText sid, page})++getRelationsWithContext :: (IOE :> es, Store :> es) => MemoryAccessContext -> SessionId -> Eff es (Either BoundedReadError SessionRelations)+getRelationsWithContext context sid = gatedRead context (runQueryWithFreshness Nothing Immediate sessionRelationsReadModel SessionRelationsQuery {context, sessionId = idText sid})

@@ -4,7 +4,22 @@ -- space. Both columns are written by the projection from the event payload rather than looked -- up, and every query below filters on the space as well as on whatever it is keyed by. module Kioku.Session.ReadModel-  ( sessionInlineProjection,+  ( SessionStatus (..),+    parseSessionStatus,+    sessionStatusToText,+    SessionFilter (..),+    SessionSelection (..),+    SessionsPageQuery (..),+    SessionsCountQuery (..),+    SessionCounts (..),+    TurnsPageQuery (..),+    SessionRelationsQuery (..),+    SessionRelations (..),+    sessionsPageReadModel,+    sessionsCountReadModel,+    turnsPageReadModel,+    sessionRelationsReadModel,+    sessionInlineProjection,     SessionRow (..),     TurnRow (..),     SessionByIdQuery (..),@@ -38,9 +53,11 @@ where  import Data.Functor.Contravariant ((>$<))-import Data.Int (Int32)+import Data.Generics.Labels ()+import Data.Int (Int32, Int64) import Data.Text qualified as Text import Hasql.Decoders qualified as D+import Hasql.DynamicStatements.Snippet qualified as S import Hasql.Encoders qualified as E import Hasql.Statement (Statement, preparable) import Hasql.Transaction qualified as Tx@@ -51,7 +68,8 @@     ReadModelBlueprint (..),     immediateReadModel,   )-import Kioku.Api.Access (MemorySpaceId)+import Kioku.Api.Access (MemoryAccessContext, MemorySpaceId)+import Kioku.Api.Recall (RecallTarget) import Kioku.Api.Scope (scopeKindText, scopeNamespaceText, scopeRefText) import Kioku.Database.Schema   ( kiokuSchema,@@ -61,10 +79,12 @@     turnsTable,   ) import Kioku.Id (idText)+import Kioku.Pagination (BoundedPageError, Connection, PageRequest, boundedPage, contextSpaceSnippet, recallTargetSnippet) import Kioku.Partition (memorySpaceColumn, memorySpaceParam) import Kioku.Prelude import Kioku.Session.Domain import Kiroku.Store.Types (RecordedEvent)+import Relay.Pagination.Hasql qualified as R  data SessionRow = SessionRow   { memorySpaceId :: !MemorySpaceId,@@ -466,6 +486,16 @@ turnReadModelShapeHash :: Text turnReadModelShapeHash = "kioku-turn-v3" +-- | The relations count has its own identity rather than the session row's: its result is one+-- existence flag and three counts over keys that have not changed since the base schema, so a+-- session or turn row reshape does not change what it returns. Changing either value changes+-- the persisted catalog fingerprint and requires a catalog adoption.+sessionRelationsReadModelVersion :: Int+sessionRelationsReadModelVersion = 1++sessionRelationsReadModelShapeHash :: Text+sessionRelationsReadModelShapeHash = "kioku-session-relations-count-v1"+ sessionRowDecoder :: D.Row SessionRow sessionRowDecoder =   SessionRow@@ -872,3 +902,198 @@     <> ((\row -> fmap (fromIntegral @Int @Int32) row.promptTokens) >$< E.param (E.nullable E.int4))     <> ((\row -> fmap (fromIntegral @Int @Int32) row.outputTokens) >$< E.param (E.nullable E.int4))     <> ((\row -> row.recordedAt) >$< E.param (E.nonNullable E.timestamptz))++-- | The five statuses the projection writes. Parsing at the point of decision keeps+-- 'SessionRow.status' a 'Text' (it is part of the read-model shape hosts consume) while+-- removing stringly-typed comparisons from the decision logic and from filters.+data SessionStatus+  = StatusRunning+  | StatusAwaiting+  | StatusCompleted+  | StatusFailed+  | StatusInteractive+  deriving stock (Eq, Show, Enum, Bounded)++parseSessionStatus :: Text -> Maybe SessionStatus+parseSessionStatus = \case+  "running" -> Just StatusRunning+  "awaiting" -> Just StatusAwaiting+  "completed" -> Just StatusCompleted+  "failed" -> Just StatusFailed+  "interactive" -> Just StatusInteractive+  _ -> Nothing++sessionStatusToText :: SessionStatus -> Text+sessionStatusToText = \case+  StatusRunning -> "running"+  StatusAwaiting -> "awaiting"+  StatusCompleted -> "completed"+  StatusFailed -> "failed"+  StatusInteractive -> "interactive"++-- All optional predicates apply inside the trusted SQL relation before paging.+data SessionFilter = SessionFilter+  { target :: !RecallTarget,+    focus :: !(Maybe Text),+    status :: !(Maybe SessionStatus),+    subjectRef :: !(Maybe Text),+    startedSince :: !(Maybe UTCTime),+    startedUntil :: !(Maybe UTCTime)+  }+  deriving stock (Eq, Show)++data SessionSelection = FilteredSessions !SessionFilter | ContinuationChain !Text | DelegationChildren !Text+  deriving stock (Eq, Show)++data SessionsPageQuery = SessionsPageQuery {context :: !MemoryAccessContext, selection :: !SessionSelection, page :: !PageRequest}++data SessionsCountQuery = SessionsCountQuery {context :: !MemoryAccessContext, selection :: !SessionSelection}++data TurnsPageQuery = TurnsPageQuery {context :: !MemoryAccessContext, sessionId :: !Text, page :: !PageRequest}++data SessionRelationsQuery = SessionRelationsQuery {context :: !MemoryAccessContext, sessionId :: !Text}++data SessionCounts = SessionCounts+  {total :: !Int64, running :: !Int64, interactive :: !Int64, awaiting :: !Int64, completed :: !Int64, failed :: !Int64}+  deriving stock (Generic, Eq, Show)++data SessionRelations = SessionRelations {found :: !Bool, turns :: !Int64, chainMembers :: !Int64, delegationChildren :: !Int64}+  deriving stock (Generic, Eq, Show)++sessionsPageReadModel :: ReadModel SessionsPageQuery (Either BoundedPageError (Connection SessionRow))+sessionsPageReadModel =+  immediateReadModel+    ReadModelBlueprint+      { name = "kioku-sessions-page",+        schema = kiokuSchema,+        tableName = sessionsRelation,+        version = sessionReadModelVersion,+        shapeHash = sessionReadModelShapeHash,+        cursorAuthority = NoQueryCursor,+        query = \q -> boundedPage (sessionPageOrder q.selection) sessionRowDecoder (sessionSelectionBase q.context q.selection) q.page+      }++sessionsCountReadModel :: ReadModel SessionsCountQuery SessionCounts+sessionsCountReadModel =+  immediateReadModel+    ReadModelBlueprint+      { name = "kioku-sessions-count",+        schema = kiokuSchema,+        tableName = sessionsRelation,+        version = sessionReadModelVersion,+        shapeHash = sessionReadModelShapeHash,+        cursorAuthority = NoQueryCursor,+        query = \q ->+          Tx.statement+            ()+            ( S.toPreparableStatement+                ("SELECT count(*),count(*) FILTER(WHERE status='running'),count(*) FILTER(WHERE status='interactive'),count(*) FILTER(WHERE status='awaiting'),count(*) FILTER(WHERE status='completed'),count(*) FILTER(WHERE status='failed') FROM (" <> sessionSelectionBase q.context q.selection <> ") selected")+                (D.singleRow (SessionCounts <$> int8 <*> int8 <*> int8 <*> int8 <*> int8 <*> int8))+            )+      }+  where+    int8 = D.column (D.nonNullable D.int8)++turnsPageReadModel :: ReadModel TurnsPageQuery (Either BoundedPageError (Connection TurnRow))+turnsPageReadModel =+  immediateReadModel+    ReadModelBlueprint+      { name = "kioku-turns-page",+        schema = kiokuSchema,+        tableName = turnsRelation,+        version = turnReadModelVersion,+        shapeHash = turnReadModelShapeHash,+        cursorAuthority = NoQueryCursor,+        query = \q ->+          boundedPage+            order+            turnRowDecoder+            ("SELECT memory_space_id,turn_id,session_id,turn_index,role,content,tool_summary,prompt_tokens,output_tokens,recorded_at FROM " <> S.sql turnsTable <> " WHERE memory_space_id=" <> contextSpaceSnippet q.context <> " AND session_id=" <> S.param q.sessionId)+            q.page+      }+  where+    order = R.SortSpec (R.KeyColumn "turn_index" R.Asc (fromIntegral . (.turnIndex)) R.int8Key :| [R.KeyColumn "turn_id" R.Asc (.turnId) R.textKey])++sessionRelationsReadModel :: ReadModel SessionRelationsQuery SessionRelations+sessionRelationsReadModel =+  immediateReadModel+    ReadModelBlueprint+      { name = "kioku-session-relations-count",+        schema = kiokuSchema,+        tableName = sessionsRelation,+        version = sessionRelationsReadModelVersion,+        shapeHash = sessionRelationsReadModelShapeHash,+        cursorAuthority = NoQueryCursor,+        query = \q ->+          Tx.statement+            ()+            ( S.toPreparableStatement+                ( "SELECT EXISTS(SELECT 1 FROM "+                    <> S.sql sessionsTable+                    <> " WHERE memory_space_id="+                    <> contextSpaceSnippet q.context+                    <> " AND session_id="+                    <> S.param q.sessionId+                    <> "),"+                    <> "(SELECT count(*) FROM "+                    <> S.sql turnsTable+                    <> " WHERE memory_space_id="+                    <> contextSpaceSnippet q.context+                    <> " AND session_id="+                    <> S.param q.sessionId+                    <> "),"+                    <> "(SELECT count(*) FROM ("+                    <> sessionSelectionBase q.context (ContinuationChain q.sessionId)+                    <> ") chain),"+                    <> "(SELECT count(*) FROM "+                    <> S.sql sessionsTable+                    <> " WHERE memory_space_id="+                    <> contextSpaceSnippet q.context+                    <> " AND parent_session_id="+                    <> S.param q.sessionId+                    <> ")"+                )+                (D.singleRow (SessionRelations <$> D.column (D.nonNullable D.bool) <*> int8 <*> int8 <*> int8))+            )+      }+  where+    int8 = D.column (D.nonNullable D.int8)++sessionPageOrder :: SessionSelection -> R.SortSpec SessionRow+sessionPageOrder selection = R.SortSpec (R.KeyColumn "started_at" direction (.startedAt) R.timestamptzKey :| [R.KeyColumn "session_id" R.Asc (.sessionId) R.textKey])+  where+    direction = case selection of FilteredSessions _ -> R.Desc; _ -> R.Asc++sessionSelectionBase :: MemoryAccessContext -> SessionSelection -> S.Snippet+sessionSelectionBase context = \case+  FilteredSessions filters ->+    "SELECT "+      <> S.sql sessionRowColumns+      <> " FROM "+      <> S.sql sessionsTable+      <> " WHERE memory_space_id="+      <> contextSpaceSnippet context+      <> recallTargetSnippet filters.target+      <> maybe "" (\value -> " AND focus=" <> S.param value) filters.focus+      <> maybe "" (\value -> " AND status=" <> S.param (sessionStatusToText value)) filters.status+      <> maybe "" (\value -> " AND subject_ref=" <> S.param value) filters.subjectRef+      <> maybe "" (\value -> " AND started_at >= " <> S.param value) filters.startedSince+      <> maybe "" (\value -> " AND started_at < " <> S.param value) filters.startedUntil+  DelegationChildren parent -> "SELECT " <> S.sql sessionRowColumns <> " FROM " <> S.sql sessionsTable <> " WHERE memory_space_id=" <> contextSpaceSnippet context <> " AND parent_session_id=" <> S.param parent+  ContinuationChain identity ->+    "WITH RECURSIVE chain(session_id,previous_session_id) AS (SELECT session_id,previous_session_id FROM "+      <> S.sql sessionsTable+      <> " WHERE memory_space_id="+      <> contextSpaceSnippet context+      <> " AND session_id="+      <> S.param identity+      <> " UNION SELECT s.session_id,s.previous_session_id FROM "+      <> S.sql sessionsTable+      <> " s JOIN chain c ON s.session_id=c.previous_session_id WHERE s.memory_space_id="+      <> contextSpaceSnippet context+      <> ") SELECT "+      <> S.sql (qualifiedSessionRowColumns "s")+      <> " FROM "+      <> S.sql sessionsTable+      <> " s JOIN chain c ON s.session_id=c.session_id WHERE s.memory_space_id="+      <> contextSpaceSnippet context

@@ -0,0 +1,328 @@+module Kioku.BoundedReadSpec (tests) where++import Control.Concurrent.Async (concurrently)+import Control.Monad (replicateM)+import Data.List (sort)+import Data.Set qualified as Set+import Data.Text qualified as Text+import Data.Time (addUTCTime)+import Effectful (Eff)+import Kioku.Api.Access (MemoryAccessContext, MemoryPermission (..), memoryContextRecordedActor, memoryContextSpace)+import Kioku.Api.Access.Internal qualified as Internal+import Kioku.Api.Recall (RecallTarget (..))+import Kioku.Api.Scope (MemoryScope (..), Namespace (..), ScopeKind (..))+import Kioku.Api.Types (Confidence (..), MemoryStatus (..), MemoryType (..))+import Kioku.App (AppEffects, runAppIO, withNoopAppEnv)+import Kioku.Id (MemoryId, SessionId, genMemoryId, genSessionId, idText)+import Kioku.Memory qualified as M+import Kioku.Memory.Domain (ArchiveMemoryData (..), RecordMemoryData (..), SupersedeMemoryData (..))+import Kioku.Migrations.TestSupport (withKiokuMigratedDatabase)+import Kioku.Pagination (BoundedPageError (..), BoundedReadError (..))+import Kioku.Prelude+import Kioku.Session qualified as S+import Kioku.Session.Domain (RecordTurnData (..), StartSessionData (..))+import Kioku.SpaceFixtures (otherContext, testActor, testContext, testSpace)+import Kiroku.Store.Connection (defaultConnectionSettings)+import Relay.Pagination (Connection (..), Direction (..), Edge (..), PageInfo (..), PageRequest (..), PageRequestError (..))+import Test.Tasty (TestTree, testGroup)+import Test.Tasty.HUnit (assertEqual, assertFailure, testCase)++tests :: TestTree+tests =+  testGroup+    "Bounded facade"+    [ testCase "session pages, scalar counts and subject filters respect space and explicit scope" (withApp sessionPages),+      testCase "memory pages filter before bounds and archive reports its own append" (withApp memoryPages),+      testCase "turn and continuation pages retain complete relation counts" (withApp relationPages),+      testCase "concurrent archives report exactly one appending command" archiveRace,+      testCase "supersession pages traverse both directions and stay in their space" (withApp supersessionPages),+      testCase "delegation children and started ranges select before bounds" (withApp delegationAndRange),+      testCase "memory type and session filters page in native session order" (withApp memoryFilters),+      testCase "every bounded read refuses a context without MemoryRead before SQL" (withApp readPermission)+    ]++ns :: Namespace+ns = Namespace "bounded"++entity :: MemoryScope+entity = ScopeEntity ns (ScopeKind "intention") "one"++right :: (Show e) => Either e a -> Eff AppEffects a+right = either (liftIO . assertFailure . show) pure++check :: (Eq a, Show a) => String -> a -> a -> Eff AppEffects ()+check label expected actual = liftIO (assertEqual label expected actual)++withApp :: Eff AppEffects a -> IO a+withApp action = withKiokuMigratedDatabase \conn -> withNoopAppEnv (defaultConnectionSettings conn) \env -> do+  result <- runAppIO env action+  either (assertFailure . show) pure result++start :: MemoryAccessContext -> MemoryScope -> UTCTime -> Maybe SessionId -> Eff AppEffects SessionId+start context scope now previous = startSession context scope now previous Nothing++startSession :: MemoryAccessContext -> MemoryScope -> UTCTime -> Maybe SessionId -> Maybe SessionId -> Eff AppEffects SessionId+startSession context scope now previous parent = do+  sid <- liftIO genSessionId+  right+    =<< S.startWithContext+      context+      StartSessionData+        { sessionId = sid,+          memorySpaceId = memoryContextSpace context,+          actorPrincipal = memoryContextRecordedActor context,+          ownerPrincipal = Nothing,+          agentId = "bounded",+          focus = "review",+          scope,+          subjectRef = Just "same-subject",+          previousSessionId = previous,+          parentSessionId = parent,+          delegationDepth = maybe 0 (const 1) parent,+          startedAt = now+        }++record :: MemoryAccessContext -> MemoryScope -> UTCTime -> Eff AppEffects MemoryId+record context scope now = recordWithPriority context scope now 100++recordWithPriority :: MemoryAccessContext -> MemoryScope -> UTCTime -> Int -> Eff AppEffects MemoryId+recordWithPriority context scope now priority = recordMemory context scope now priority Nothing MemoryFact++recordMemory :: MemoryAccessContext -> MemoryScope -> UTCTime -> Int -> Maybe SessionId -> MemoryType -> Eff AppEffects MemoryId+recordMemory context scope now priority session memoryType = do+  mid <- liftIO genMemoryId+  right+    =<< M.recordWithContext+      context+      RecordMemoryData+        { memoryId = mid,+          memorySpaceId = memoryContextSpace context,+          actorPrincipal = memoryContextRecordedActor context,+          ownerPrincipal = Nothing,+          agentId = "bounded",+          sessionId = session,+          scope,+          memoryType,+          content = "content",+          priority,+          confidence = HighConfidence,+          tags = Set.empty,+          supersedes = Nothing,+          recordedAt = now+        }++page :: Int -> PageRequest+page n = PageRequest n Forward Nothing++nodes :: Connection a -> [a]+nodes connection = map (.node) connection.edges++pageError :: Either BoundedReadError a -> Maybe BoundedPageError+pageError = \case+  Left (BoundedReadInvalidPage err) -> Just err+  _ -> Nothing++sessionPages :: Eff AppEffects ()+sessionPages = do+  now <- liftIO getCurrentTime+  ids <- replicateM 7 (start testContext entity now Nothing)+  global <- start testContext (ScopeGlobal ns) now Nothing+  _ <- start otherContext entity now Nothing+  let filters = S.SessionFilter (NamespaceWide ns) Nothing Nothing Nothing Nothing Nothing+      selection = S.FilteredSessions filters+      get req = right =<< S.getPageWithContext testContext selection req+  first <- get (page 3)+  second <- get (PageRequest 3 Forward first.pageInfo.endCursor)+  third <- get (PageRequest 3 Forward second.pageInfo.endCursor)+  check "all tied rows" (sort (map idText (global : ids))) (sort (map (.sessionId) (nodes first <> nodes second <> nodes third)))+  back <- get (PageRequest 3 Backward second.pageInfo.startCursor)+  check "backward order" (map (.sessionId) (nodes first)) (map (.sessionId) (nodes back))+  counts <- right =<< S.getCountsWithContext testContext selection+  check "complete count" 8 counts.total+  exact <- right =<< S.getPageWithContext testContext (S.FilteredSessions (filters {S.target = ExactScope (ScopeGlobal ns)})) (page 3)+  check "exact global is narrow" [idText global] (map (.sessionId) (nodes exact))+  subject <- right =<< S.getCountsWithContext testContext (S.FilteredSessions (S.SessionFilter (NamespaceWide ns) Nothing Nothing (Just "absent") Nothing Nothing))+  check "subject filter" 0 subject.total+  tooLarge <- S.getPageWithContext testContext selection (page 101)+  check "maximum enforced" (Just (InvalidPageSize (PageSizeTooLarge 101 100))) (pageError tooLarge)+  negative <- S.getPageWithContext testContext selection (page (-1))+  check "negative refused" (Just (InvalidPageSize (NegativePageSize (-1)))) (pageError negative)+  running <- right =<< S.getCountsWithContext testContext (S.FilteredSessions (S.SessionFilter (NamespaceWide ns) Nothing (Just S.StatusRunning) Nothing Nothing Nothing))+  check "typed status filter" 8 running.total+  completed <- right =<< S.getCountsWithContext testContext (S.FilteredSessions (S.SessionFilter (NamespaceWide ns) Nothing (Just S.StatusCompleted) Nothing Nothing Nothing))+  check "absent status" 0 completed.total++memoryPages :: Eff AppEffects ()+memoryPages = do+  now <- liftIO getCurrentTime+  ids <- replicateM 7 (record testContext entity now)+  global <- recordWithPriority testContext (ScopeGlobal ns) now 1+  _ <- record otherContext entity now+  let filters = M.MemoryFilter (ExactScope entity) (Just MemoryActive) Nothing Nothing+      selection = M.FilteredMemories filters+      get req = right =<< M.getPageWithContext testContext selection req+  first <- get (page 3)+  second <- get (PageRequest 3 Forward first.pageInfo.endCursor)+  third <- get (PageRequest 3 Forward second.pageInfo.endCursor)+  check "all tied rows" (sort (map idText ids)) (sort (map (.memoryId) (nodes first <> nodes second <> nodes third)))+  back <- get (PageRequest 3 Backward second.pageInfo.startCursor)+  check "backward order" (map (.memoryId) (nodes first)) (map (.memoryId) (nodes back))+  prioritized <- right =<< M.getPageWithContext testContext (M.FilteredMemories (filters {M.target = NamespaceWide ns})) (page 1)+  check "native priority order" [idText global] (map (.memoryId) (nodes prioritized))+  let archive = ArchiveMemoryData {memoryId = global, memorySpaceId = memoryContextSpace testContext, actorPrincipal = memoryContextRecordedActor testContext, archivedAt = now}+  initial <- right =<< M.archiveWithContextChanged testContext archive+  duplicate <- right =<< M.archiveWithContextChanged testContext archive+  check "archive changed" (global, True) initial+  check "archive repeated" (global, False) duplicate+  counts <- right =<< M.getCountsWithContext testContext (M.FilteredMemories (filters {M.target = NamespaceWide ns, M.status = Nothing}))+  check "all statuses count" (8, 7, 1) (counts.total, counts.active, counts.archived)+  archived <- right =<< M.getPageWithContext testContext (M.FilteredMemories (filters {M.target = NamespaceWide ns, M.status = Just MemoryArchived})) (page 1)+  check "status before bounds" [idText global] (map (.memoryId) (nodes archived))++relationPages :: Eff AppEffects ()+relationPages = do+  now <- liftIO getCurrentTime+  root <- start testContext entity now Nothing+  next <- start testContext entity now (Just root)+  latest <- start testContext entity now (Just next)+  forM_ [1 .. 7] \i -> do+    _ <-+      right+        =<< S.recordTurnWithContext+          testContext+          RecordTurnData+            { sessionId = latest,+              memorySpaceId = memoryContextSpace testContext,+              actorPrincipal = memoryContextRecordedActor testContext,+              turnId = "bounded-" <> Text.pack (show i),+              turnIndex = i,+              role = "user",+              content = "content",+              toolSummary = Nothing,+              promptTokens = Nothing,+              outputTokens = Nothing,+              recordedAt = now+            }+    pure ()+  relations <- right =<< S.getRelationsWithContext testContext latest+  check "complete counts" (True, 7, 3, 0) (relations.found, relations.turns, relations.chainMembers, relations.delegationChildren)+  turns <- right =<< S.getTurnsPageWithContext testContext latest (page 2)+  rest <- right =<< S.getTurnsPageWithContext testContext latest (PageRequest 100 Forward turns.pageInfo.endCursor)+  check "all turns" [1 .. 7] (map (.turnIndex) (nodes turns <> nodes rest))+  chain <- right =<< S.getPageWithContext testContext (S.ContinuationChain (idText latest)) (page 100)+  check "all ancestors" (sort (map idText [root, next, latest])) (sort (map (.sessionId) (nodes chain)))+  hidden <- right =<< S.getRelationsWithContext otherContext latest+  check "foreign relation invisible" (False, 0, 0, 0) (hidden.found, hidden.turns, hidden.chainMembers, hidden.delegationChildren)++archiveRace :: IO ()+archiveRace = withKiokuMigratedDatabase \conn -> withNoopAppEnv (defaultConnectionSettings conn) \env -> do+  let run :: Eff AppEffects a -> IO a+      run action = runAppIO env action >>= either (assertFailure . show) pure+  now <- getCurrentTime+  mid <- run (record testContext entity now)+  let command =+        M.archiveWithContextChanged+          testContext+          ArchiveMemoryData+            { memoryId = mid,+              memorySpaceId = memoryContextSpace testContext,+              actorPrincipal = memoryContextRecordedActor testContext,+              archivedAt = now+            }+  (a, b) <- concurrently (run (right =<< command)) (run (right =<< command))+  assertEqual "one authoritative append" [False, True] (sort [snd a, snd b])++supersessionPages :: Eff AppEffects ()+supersessionPages = do+  now <- liftIO getCurrentTime+  a <- record testContext entity now+  b <- record testContext entity now+  c <- record testContext entity now+  _ <-+    right+      =<< M.supersedeWithContext+        testContext+        SupersedeMemoryData+          { memoryId = a,+            memorySpaceId = memoryContextSpace testContext,+            actorPrincipal = memoryContextRecordedActor testContext,+            supersededBy = b,+            supersededAt = now+          }+  _ <-+    right+      =<< M.supersedeWithContext+        testContext+        SupersedeMemoryData+          { memoryId = b,+            memorySpaceId = memoryContextSpace testContext,+            actorPrincipal = memoryContextRecordedActor testContext,+            supersededBy = c,+            supersededAt = now+          }+  let selection = M.SupersessionChain (idText b)+      get req = right =<< M.getPageWithContext testContext selection req+  first <- get (page 1)+  rest <- get (PageRequest 100 Forward first.pageInfo.endCursor)+  check "both directions" (sort (map idText [a, b, c])) (sort (map (.memoryId) (nodes first <> nodes rest)))+  counts <- right =<< M.getCountsWithContext testContext selection+  check "complete chain counts" (3, 1, 2) (counts.total, counts.active, counts.superseded)+  foreignPage <- right =<< M.getPageWithContext otherContext selection (page 100)+  check "foreign chain invisible" [] (map (.memoryId) (nodes foreignPage))++delegationAndRange :: Eff AppEffects ()+delegationAndRange = do+  now <- liftIO getCurrentTime+  parent <- start testContext entity now Nothing+  delegated <- forM [1 .. 4] \i -> startSession testContext entity (addUTCTime (fromInteger i) now) Nothing (Just parent)+  _ <- startSession otherContext entity now Nothing Nothing+  let get req = right =<< S.getPageWithContext testContext (S.DelegationChildren (idText parent)) req+  first <- get (page 3)+  rest <- get (PageRequest 3 Forward first.pageInfo.endCursor)+  check "children ascend by start" (map idText delegated) (map (.sessionId) (nodes first <> nodes rest))+  relations <- right =<< S.getRelationsWithContext testContext parent+  check "child count" 4 relations.delegationChildren+  let filters = S.SessionFilter (ExactScope entity) Nothing Nothing Nothing (Just (addUTCTime 2 now)) (Just (addUTCTime 4 now))+  ranged <- right =<< S.getPageWithContext testContext (S.FilteredSessions filters) (page 100)+  check "half-open started range" (map idText (reverse (take 2 (drop 1 delegated)))) (map (.sessionId) (nodes ranged))+  rangedCount <- right =<< S.getCountsWithContext testContext (S.FilteredSessions filters)+  check "range count" 2 rangedCount.total++memoryFilters :: Eff AppEffects ()+memoryFilters = do+  now <- liftIO getCurrentTime+  sid <- start testContext entity now Nothing+  inSession <- forM [1 .. 5] \i -> recordMemory testContext entity (addUTCTime (fromInteger i) now) (fromInteger i) (Just sid) MemoryFact+  preference <- recordMemory testContext entity now 100 Nothing MemoryPreference+  _ <- recordMemory testContext entity now 100 Nothing MemoryFact+  let filters = M.MemoryFilter (NamespaceWide ns) Nothing Nothing (Just (idText sid))+      get req = right =<< M.getPageWithContext testContext (M.FilteredMemories filters) req+  first <- get (page 2)+  second <- get (PageRequest 2 Forward first.pageInfo.endCursor)+  third <- get (PageRequest 2 Forward second.pageInfo.endCursor)+  check "session order ignores priority" (map idText (reverse inSession)) (map (.memoryId) (nodes first <> nodes second <> nodes third))+  back <- get (PageRequest 2 Backward second.pageInfo.startCursor)+  check "session backward order" (map (.memoryId) (nodes first)) (map (.memoryId) (nodes back))+  typed <- right =<< M.getPageWithContext testContext (M.FilteredMemories (M.MemoryFilter (NamespaceWide ns) Nothing (Just MemoryPreference) Nothing)) (page 100)+  check "memory type filter" [idText preference] (map (.memoryId) (nodes typed))++readPermission :: Eff AppEffects ()+readPermission = do+  now <- liftIO getCurrentTime+  let writer = Internal.MemoryAccessContext {Internal.memorySpaceId = testSpace, Internal.actor = testActor, Internal.grantedPermissions = Set.fromList [MemoryRecord, MemoryForget], Internal.decisionToken = Nothing}+      denied :: Either BoundedReadError a -> Bool+      denied = \case+        Left (BoundedReadNotPermitted MemoryRead) -> True+        _ -> False+  sid <- start writer entity now Nothing+  _ <- record writer entity now+  sessionPage <- S.getPageWithContext writer (S.FilteredSessions (S.SessionFilter (NamespaceWide ns) Nothing Nothing Nothing Nothing Nothing)) (page 1)+  sessionCounts <- S.getCountsWithContext writer (S.ContinuationChain (idText sid))+  turnsPage <- S.getTurnsPageWithContext writer sid (page 1)+  relations <- S.getRelationsWithContext writer sid+  memoryPage <- M.getPageWithContext writer (M.FilteredMemories (M.MemoryFilter (NamespaceWide ns) Nothing Nothing Nothing)) (page 1)+  memoryCounts <- M.getCountsWithContext writer (M.SupersessionChain "absent")+  check "all six reads refused" [True, True, True, True, True, True] [denied sessionPage, denied sessionCounts, denied turnsPage, denied relations, denied memoryPage, denied memoryCounts]+  -- The gate runs before page validation, so an invalid page cannot probe a refused space.+  invalid <- S.getPageWithContext writer (S.DelegationChildren (idText sid)) (page 101)+  check "permission before page size" True (denied invalid)

@@ -18,15 +18,19 @@   ( CatalogDiagnostic (..),     CatalogDiagnosticCode (..),     CatalogInventory (..),+    InventoryGroup (..),     InventoryQueryCursor,     InventoryQueryFreshness (..),     InventoryQueryModel (..),     ProjectionCatalog (..),     ProjectionDefinition (..),     ProjectionSet (..),+    QueryModelBinding (..),     SomeProjectionSet (..),+    SomeQueryModelBinding (..),     SourceDeclaration (..),     Validation (..),+    catalogFingerprint,     catalogFingerprintText,     catalogRegistrations,     mkClaimSite,@@ -37,10 +41,11 @@ import Keiro.ReadModel   ( HeadScope (EntireVisibleLog),     QueryFreshness (WaitForHead),+    ReadModel (..),     ReadModelDefinitionError (ReadModelDefinitionMissingCursor),     headWaitingReadModel,   )-import Keiro.ReadModel.Rebuild (registerProjectionCatalog)+import Keiro.ReadModel.Rebuild (CatalogAdoptionPlan (..), GroupAdoptionClass (..), adoptCatalogGroups, previewCatalogAdoption, registerProjectionCatalog) import Keiro.Stream qualified as Stream import Keiro.Timer (lookupTimer) import Kioku.Api.Scope (MemoryScope (..), Namespace (..))@@ -77,6 +82,7 @@   testGroup     "ProjectionCatalog"     [ testCase "the Kioku catalog has one stable complete inventory" testInventory,+      testCase "bounded queries adopt from the exact released catalog through public lifecycle APIs" testCompatibleAdoption,       testCase "typed projection sets select only application-owned handlers" testTypedHandlers,       testCase "both hand-written event streams validate explicitly" testEventStreams,       testCase "duplicate target ownership is rejected with a stable diagnostic" testDuplicateOwnership,@@ -97,8 +103,8 @@   assertEqual "targets" 3 (length kiokuCatalogInventory.inventoryTargets)   assertEqual "groups" 2 (length kiokuCatalogInventory.inventoryGroups)   assertEqual "projection owners" 2 (length kiokuCatalogInventory.inventoryProjections)-  assertEqual "query models" 19 (length kiokuCatalogInventory.inventoryQueryModels)-  assertEqual "registrations" 19 (length (catalogRegistrations kiokuProjectionCatalog))+  assertEqual "query models" 25 (length kiokuCatalogInventory.inventoryQueryModels)+  assertEqual "registrations" 25 (length (catalogRegistrations kiokuProjectionCatalog))   assertBool     "every query is immediate and cursorless"     ( all@@ -107,7 +113,7 @@     )   assertEqual     "canonical fingerprint"-    "catalog-v7:54f9ac55d73f40160d87b0ae49c2477a0de860c2e6e1e38df0591a2036d002e4"+    "catalog-v7:8cce393084799278ee21a4aba3356e1f88d34c630e8c1b97aa8743e543616956"     (catalogFingerprintText kiokuCatalogFingerprint)   where     noCursor :: Maybe InventoryQueryCursor -> Bool@@ -351,3 +357,28 @@  must :: (Show error) => Either error value -> value must = either (error . show) id++testCompatibleAdoption :: Assertion+testCompatibleAdoption = withKiokuMigratedDatabase \conn ->+  withNoopAppEnv (defaultConnectionSettings conn) \env -> do+    let added = ["kioku-memories-page", "kioku-memories-count", "kioku-sessions-page", "kioku-sessions-count", "kioku-turns-page", "kioku-session-relations-count"]+        historical definition = definition {queryModels = filter (\(SomeQueryModelBinding binding) -> binding.readModel.name `notElem` added) definition.queryModels}+    prior <- case validateKiokuProjectionCatalogWith historical of+      Failure errors -> assertFailure (show errors)+      Success catalog -> pure catalog+    assertEqual "exact previous release catalog" "catalog-v7:54f9ac55d73f40160d87b0ae49c2477a0de860c2e6e1e38df0591a2036d002e4" (catalogFingerprintText (catalogFingerprint prior))+    let groups = NonEmpty.fromList (map (.rebuildGroupId) kiokuCatalogInventory.inventoryGroups)+    result <- runAppIO env do+      reverted <- adoptCatalogGroups prior groups+      liftIO (either (assertFailure . show) (const (pure ())) reverted)+      oldRegistered <- registerProjectionCatalog prior+      liftIO (either (assertFailure . show) (const (pure ())) oldRegistered)+      drift <- registerProjectionCatalog kiokuProjectionCatalog+      liftIO $ assertBool "ordinary startup refuses drift" (case drift of Left _ -> True; Right _ -> False)+      preview <- previewCatalogAdoption kiokuProjectionCatalog+      liftIO $ assertEqual "both live groups change" 2 (length [() | (_, AdoptionSliceChanged _ _) <- preview.groupStates])+      adopted <- adoptCatalogGroups kiokuProjectionCatalog groups+      liftIO (either (assertFailure . show) (const (pure ())) adopted)+      registered <- registerProjectionCatalog kiokuProjectionCatalog+      liftIO (either (assertFailure . show) (const (pure ())) registered)+    either (assertFailure . show) pure result

@@ -119,8 +119,8 @@       -- Every Kioku read model reads one of the three relocated projections, so the relocation       -- leaves none of them current and reconciliation has to advance all of them.       assertEqual-        "every model was advanced"-        []+        "all historical models advanced; the new relation-count identity stays current"+        ["kioku-session-relations-count"]         [schema.readModelName | (schema, outcome) <- outcomes, outcome /= Reconciled]      repaired <- Session.getById testSpace sid

@@ -448,10 +448,10 @@     liftIO $       mapM_         assertPartitionLeading-        [ ("memories by scope", "kioku_memories_space_", memoriesByScope, scopeRows),-          ("memories by type", "kioku_memories_space_", memoriesByType, typeRows),-          ("sessions by namespace", "kioku_sessions_space_", sessionsByNamespace, namespaceSessions),-          ("sessions awaiting", "kioku_sessions_space_", sessionsAwaiting, awaitingSessions)+        [ ("memories by scope", "memories_space_", memoriesByScope, scopeRows),+          ("memories by type", "memories_space_", memoriesByType, typeRows),+          ("sessions by namespace", "sessions_space_", sessionsByNamespace, namespaceSessions),+          ("sessions awaiting", "sessions_space_", sessionsAwaiting, awaitingSessions)         ]   where     rowCount = either (const (-1)) length

@@ -2,6 +2,7 @@  import Kioku.AIRuntimeSpec qualified as AIRuntimeSpec import Kioku.AwaitingSpec qualified as AwaitingSpec+import Kioku.BoundedReadSpec qualified as BoundedReadSpec import Kioku.CodecCompatSpec qualified as CodecCompatSpec import Kioku.DistillSpec qualified as DistillSpec import Kioku.EmbeddingWorkerSpec qualified as EmbeddingWorkerSpec@@ -28,7 +29,8 @@   defaultMain $     testGroup       "kioku"-      [ AIRuntimeSpec.tests,+      [ BoundedReadSpec.tests,+        AIRuntimeSpec.tests,         AwaitingSpec.tests,         CodecCompatSpec.tests,         IdempotencySpec.tests,