kioku-core 0.10.0.0 → 0.11.0.0

raw patch · 9 files changed

+965/−56 lines, 9 filesdep ~kioku-apidep ~kioku-coredep ~kioku-migrationsPVP ok

version bump matches the API change (PVP)

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

API changes (from Hackage documentation)

Files

• CHANGELOG.md +25/−0
• kioku-core.cabal +6/−5
• src/Kioku/Memory.hs +50/−1
• src/Kioku/Memory/ReadModel.hs +209/−28
• src/Kioku/ProjectionCatalog.hs +9/−1
• test/Kioku/ArchiveReceiptSpec.hs +250/−0
• test/Kioku/BoundedReadSpec.hs +337/−15
• test/Kioku/ProjectionCatalogSpec.hs +77/−6
• test/Main.hs +2/−0

@@ -2,6 +2,31 @@  ## [Unreleased] +## 0.11.0.0 — 2026-10-19++### Breaking Changes++- Add `scopeKind :: Maybe ScopeKind` as the fifth `MemoryFilter` field. Append `Nothing` to positional calls and set it explicitly in records to preserve prior selection; kind intersects the explicit target, status, type and session filters.++### Added++- Deprecated `Kioku.Memory.archiveLegacyChanged` returns the authoritative `(MemoryId, Bool)`+  append receipt for existing legacy-space archives, preserving all supplied attribution,+  including `UnattributedPrincipal`. First/repeat and mixed concurrent calls share the+  context-first worker; partition gates and typed failures remain unchanged.+- Migration guidance explains receipt adoption without inventing principals, the host's+  existing authorization boundary and removal with `archive` after an announced migration.+  No schema, catalog or dependency-cohort change is required.++- Permission-checked `getMetadataWithContext`, `getMetadataPageWithContext`, `getTagsPageWithContext` and `getNewestActiveMetadataWithContext`. Metadata selects complete scalar fields and a SQL tag count without decoding tag arrays; separate tag Connections retain full values with bounded ordinal cursors.+- Deterministic newest-active selection ignores priority and intersects non-active status to absence. Existing list orders and complete status counts are preserved.+- Four query registrations on the existing memories owner. Catalog adoption before normal startup is required; the exact 0.10.0.0 upgrade rehearsal proves retained data and idempotence. Projection shape identities are unchanged.++### Changed++- Document parent absence versus empty collections, archive visibility, restart after tag replacement, flat failures, outer Store failures, and the public pre-startup adoption recipe.+- Test more than 100 tied Memories, 205 tags with large Unicode values, zero-Store permission denial, failure distinctions, recency/kind intersections and measured partition-first access paths.+ ## 0.10.0.0 — 2026-10-19  ### Breaking Changes

@@ -1,6 +1,6 @@ cabal-version: 3.0 name: kioku-core-version: 0.10.0.0+version: 0.11.0.0 synopsis: Reusable agent memory runtime description:   Core runtime for kioku. M1 establishes the application effect stack; later@@ -136,7 +136,7 @@     keiki ^>=0.9.1.0,     keiro ^>=0.21.0.0,     keiro-core ^>=0.21.0.0,-    kioku-api ^>=0.10.0.0,+    kioku-api ^>=0.11.0.0,     kiroku-store ^>=0.11.0.0,     lens >=5.2 && <5.4,     mmzk-typeid >=0.7 && <0.8,@@ -159,6 +159,7 @@   main-is: Main.hs   other-modules:     Kioku.AIRuntimeSpec+    Kioku.ArchiveReceiptSpec     Kioku.AwaitingSpec     Kioku.BoundedReadSpec     Kioku.CodecCompatSpec@@ -206,9 +207,9 @@     hasql-transaction >=1.0,     keiro ^>=0.21.0.0,     keiro-core ^>=0.21.0.0,-    kioku-api ^>=0.10.0.0,-    kioku-core ^>=0.10.0.0,-    kioku-migrations:test-support ^>=0.10.0.0,+    kioku-api ^>=0.11.0.0,+    kioku-core ^>=0.11.0.0,+    kioku-migrations:test-support ^>=0.11.0.0,     kiroku-store ^>=0.11.0.0,     lens >=5.2,     relay-pagination ^>=0.1.1.2,

@@ -18,9 +18,10 @@ -- rejected rather than quietly rewritten. That keeps the stored event and the decision that -- allowed it the same fact. ----- The unsuffixed functions ('record', 'archive', …) remain for one release as deprecated+-- The unsuffixed functions ('record', 'archive', …) remain as deprecated -- compatibility wrappers. They take no context and refuse any payload naming a space other than -- 'legacyMemorySpaceId', so they cannot reach data belonging to anybody else.+-- 'archiveLegacyChanged' exposes the same temporary legacy contract with an append receipt. -- -- Every read takes a 'MemorySpaceId' first and returns nothing outside it. Pass -- 'Kioku.Api.Access.memoryContextSpace' of the context that authorized the read: the context is@@ -49,6 +50,7 @@     record,     supersede,     archive,+    archiveLegacyChanged,     updateTags,     updateConfidence,     merge,@@ -66,6 +68,12 @@     MemoryRow (..),     BoundedReadError (..),     getPageWithContext,+    getMetadataWithContext,+    getMetadataPageWithContext,+    getTagsPageWithContext,+    getNewestActiveMetadataWithContext,+    MemoryTag (..),+    MemoryMetadata (..),     getCountsWithContext,   ) where@@ -104,9 +112,13 @@     MemoryByIdQuery (..),     MemoryCounts (..),     MemoryFilter (..),+    MemoryMetadata (..),+    MemoryNewestActiveQuery (..),     MemoryRow (..),     MemorySelection (..),     MemorySupersessionChainQuery (..),+    MemoryTag (..),+    MemoryTagsPageQuery (..),     memoriesByNamespaceRowsReadModel,     memoriesByScopeRowsReadModel,     memoriesBySessionRowsReadModel,@@ -114,7 +126,11 @@     memoriesCountReadModel,     memoriesPageReadModel,     memoryByIdReadModel,+    memoryMetadataByIdReadModel,+    memoryMetadataPageReadModel,+    memoryNewestActiveReadModel,     memorySupersessionChainReadModel,+    memoryTagsPageReadModel,   ) import Kioku.Pagination (BoundedReadError (..), Connection, PageRequest, gatedPage, gatedRead) import Kioku.Prelude@@ -266,6 +282,24 @@   Eff es (Either MemoryWriteError MemoryId) archive cmdData = inLegacySpaceOnly cmdData.memorySpaceId (archiveIn cmdData) +{-# DEPRECATED archiveLegacyChanged "Use archiveWithContextChanged with a host-vouched-for actor. This legacy-only bridge will be removed with archive." #-}++-- | Deprecated legacy-only bridge returning whether this command appended an archive fact.+-- A first archive returns @True@; an accepted repeat (including a losing concurrent+-- archive) returns @False@. Refusals remain errors, never successful no-ops.+--+-- This performs no authentication or authorization. It accepts only 'legacyMemorySpaceId'+-- and preserves the supplied attribution, including 'UnattributedPrincipal'. Existing hosts+-- must retain their trusted boundary. New hosts and hosts with a real vouched-for actor use+-- 'archiveWithContextChanged'. This bridge is deprecated from introduction and will be removed+-- with 'archive' in a separately announced breaking change after affected consumers can migrate+-- to contexts; it is not a permanent unattributed-write API.+archiveLegacyChanged ::+  (IOE :> es, KirokuStoreResource :> es, Store :> es, Error StoreError :> es) =>+  ArchiveMemoryData ->+  Eff es (Either MemoryWriteError (MemoryId, Bool))+archiveLegacyChanged cmdData = inLegacySpaceOnly cmdData.memorySpaceId (archiveInChanged cmdData)+ archiveIn ::   (IOE :> es, KirokuStoreResource :> es, Store :> es, Error StoreError :> es) =>   ArchiveMemoryData ->@@ -673,3 +707,18 @@  getCountsWithContext :: (IOE :> es, Store :> es) => MemoryAccessContext -> MemorySelection -> Eff es (Either BoundedReadError MemoryCounts) getCountsWithContext context selection = gatedRead context (runQueryWithFreshness Nothing Immediate memoriesCountReadModel MemoriesCountQuery {context, selection})++getMetadataWithContext :: (IOE :> es, Store :> es) => MemoryAccessContext -> MemoryId -> Eff es (Either BoundedReadError (Maybe MemoryMetadata))+getMetadataWithContext context mid = gatedRead context (runQueryWithFreshness Nothing Immediate memoryMetadataByIdReadModel MemoryByIdQuery {memorySpaceId = memoryContextSpace context, memoryId = idText mid})++getMetadataPageWithContext :: (IOE :> es, Store :> es) => MemoryAccessContext -> MemorySelection -> PageRequest -> Eff es (Either BoundedReadError (Connection MemoryMetadata))+getMetadataPageWithContext context selection page = gatedPage context (runQueryWithFreshness Nothing Immediate memoryMetadataPageReadModel MemoriesPageQuery {context, selection, page})++-- | Missing and foreign parents are absent; an existing empty collection is Just.+-- Tag cursors refer to current array positions. Restart after a tag update.+getTagsPageWithContext :: (IOE :> es, Store :> es) => MemoryAccessContext -> MemoryId -> PageRequest -> Eff es (Either BoundedReadError (Maybe (Connection MemoryTag)))+getTagsPageWithContext context mid page = gatedPage context (runQueryWithFreshness Nothing Immediate memoryTagsPageReadModel MemoryTagsPageQuery {context, memoryId = idText mid, page})++-- | Newest active row, ignoring priority and intersecting every supplied filter.+getNewestActiveMetadataWithContext :: (IOE :> es, Store :> es) => MemoryAccessContext -> MemoryFilter -> Eff es (Either BoundedReadError (Maybe MemoryMetadata))+getNewestActiveMetadataWithContext context filters = gatedRead context (runQueryWithFreshness Nothing Immediate memoryNewestActiveReadModel MemoryNewestActiveQuery {context, filters})

@@ -8,6 +8,14 @@ module Kioku.Memory.ReadModel   ( MemoryFilter (..),     MemorySelection (..),+    MemoryMetadata (..),+    MemoryTag (..),+    MemoryTagsPageQuery (..),+    MemoryNewestActiveQuery (..),+    memoryTagsPageReadModel,+    memoryNewestActiveReadModel,+    memoryMetadataByIdReadModel,+    memoryMetadataPageReadModel,     MemoriesPageQuery (..),     MemoriesCountQuery (..),     MemoryCounts (..),@@ -64,9 +72,9 @@     ReadModelBlueprint (..),     immediateReadModel,   )-import Kioku.Api.Access (MemoryAccessContext, MemorySpaceId)+import Kioku.Api.Access (MemoryAccessContext, MemorySpaceId, memorySpaceIdText) import Kioku.Api.Recall (RecallTarget)-import Kioku.Api.Scope (scopeFromColumns, scopeKindText, scopeNamespaceText, scopeRefText)+import Kioku.Api.Scope (ScopeKind (..), scopeFromColumns, scopeKindText, scopeNamespaceText, scopeRefText) import Kioku.Api.Types (MemoryRecord (..), MemoryStatus, MemoryType, confidenceToText, memoryStatusToText, memoryTypeToText) import Kioku.Database.Schema (kiokuSchema, memoriesRelation, memoriesTable) import Kioku.Id (idText)@@ -98,6 +106,27 @@   }   deriving stock (Generic, Eq, Show) +data MemoryMetadata = MemoryMetadata+  { memorySpaceId :: !MemorySpaceId,+    memoryId :: !Text,+    agentId :: !Text,+    sessionId :: !(Maybe Text),+    namespace :: !Text,+    scopeKind :: !(Maybe Text),+    scopeRef :: !(Maybe Text),+    memoryType :: !Text,+    content :: !Text,+    priority :: !Int,+    confidence :: !Text,+    tagCount :: !Int64,+    status :: !Text,+    supersededBy :: !(Maybe Text),+    supersedes :: !(Maybe Text),+    createdAt :: !UTCTime,+    updatedAt :: !UTCTime+  }+  deriving stock (Generic, Eq, Show)+ -- | Every query names its memory space in a field rather than a tuple position, so a call site -- cannot transpose the partition with the namespace it happens to sit beside. data MemoryByIdQuery = MemoryByIdQuery@@ -404,6 +433,27 @@     <*> D.column (D.nonNullable D.timestamptz)     <*> D.column (D.nonNullable D.timestamptz) +memoryMetadataDecoder :: D.Row MemoryMetadata+memoryMetadataDecoder =+  MemoryMetadata+    <$> memorySpaceColumn+    <*> D.column (D.nonNullable D.text)+    <*> D.column (D.nonNullable D.text)+    <*> D.column (D.nullable D.text)+    <*> D.column (D.nonNullable D.text)+    <*> D.column (D.nullable D.text)+    <*> D.column (D.nullable D.text)+    <*> D.column (D.nonNullable D.text)+    <*> D.column (D.nonNullable D.text)+    <*> (fromIntegral @Int32 @Int <$> D.column (D.nonNullable D.int4))+    <*> D.column (D.nonNullable D.text)+    <*> D.column (D.nonNullable D.int8)+    <*> D.column (D.nonNullable D.text)+    <*> D.column (D.nullable D.text)+    <*> D.column (D.nullable D.text)+    <*> D.column (D.nonNullable D.timestamptz)+    <*> D.column (D.nonNullable D.timestamptz)+ memoryRecordDecoder :: D.Row MemoryRecord memoryRecordDecoder =   toRecord <$> memoryRowDecoder@@ -741,7 +791,7 @@     D.noResult  data MemoryFilter = MemoryFilter-  {target :: !RecallTarget, status :: !(Maybe MemoryStatus), memoryType :: !(Maybe MemoryType), sessionId :: !(Maybe Text)}+  {target :: !RecallTarget, status :: !(Maybe MemoryStatus), memoryType :: !(Maybe MemoryType), sessionId :: !(Maybe Text), scopeKind :: !(Maybe ScopeKind)}   deriving stock (Eq, Show)  data MemorySelection = FilteredMemories !MemoryFilter | SupersessionChain !Text@@ -764,7 +814,7 @@         version = memoryReadModelVersion,         shapeHash = memoryReadModelShapeHash,         cursorAuthority = NoQueryCursor,-        query = \q -> boundedPage (memoryPageOrder q.selection) memoryRowDecoder (memorySelectionBase q.context q.selection) q.page+        query = \q -> boundedPage (memoryPageOrder (.createdAt) (.memoryId) (.priority) q.selection) memoryRowDecoder (memorySelectionBase memoryRowColumns q.context q.selection) q.page       }  memoriesCountReadModel :: ReadModel MemoriesCountQuery MemoryCounts@@ -781,49 +831,180 @@           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")+                ("SELECT count(*),count(*) FILTER(WHERE status='active'),count(*) FILTER(WHERE status='superseded'),count(*) FILTER(WHERE status='merged'),count(*) FILTER(WHERE status='archived') FROM (" <> memorySelectionBase "status" 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]+memoryPageOrder :: (row -> UTCTime) -> (row -> Text) -> (row -> Int) -> MemorySelection -> R.SortSpec row+memoryPageOrder createdAt memoryId priority 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]+    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+    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+-- | Select fixed fields directly; the recursive walk carries only identity links.+-- UNION deduplicates cycles, and both the seed and joins retain the space boundary.+memorySelectionBase :: Text -> MemoryAccessContext -> MemorySelection -> S.Snippet+memorySelectionBase columns context = \case   FilteredMemories filters ->     "SELECT "-      <> S.sql memoryRowColumns+      <> S.sql columns       <> " 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+      <> memoryFilterWhere context filters   SupersessionChain identity ->-    "WITH RECURSIVE chain AS (SELECT "-      <> S.sql memoryRowColumns-      <> " FROM "+    "WITH RECURSIVE chain AS (SELECT memory_space_id,memory_id,supersedes,superseded_by FROM "       <> S.sql memoriesTable       <> " WHERE memory_space_id="       <> contextSpaceSnippet context       <> " AND memory_id="       <> S.param identity-      <> " UNION SELECT "-      <> S.sql (qualifiedMemoryRowColumns "m")-      <> " FROM "+      <> " UNION SELECT m.memory_space_id,m.memory_id,m.supersedes,m.superseded_by 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"+      <> S.sql columns+      <> " FROM "+      <> S.sql memoriesTable+      <> " WHERE memory_space_id="+      <> contextSpaceSnippet context+      <> " AND memory_id IN (SELECT memory_id FROM chain)"++memoryMetadataColumns :: Text+memoryMetadataColumns =+  "memory_space_id, memory_id, agent_id, session_id, namespace, scope_kind, scope_ref, memory_type, content, priority, confidence, jsonb_array_length(tags)::bigint AS tag_count, status, superseded_by, supersedes, created_at, updated_at"++memoryMetadataByIdReadModel :: ReadModel MemoryByIdQuery (Maybe MemoryMetadata)+memoryMetadataByIdReadModel =+  immediateReadModel+    ReadModelBlueprint+      { name = "kioku-memory-metadata-by-id",+        schema = kiokuSchema,+        tableName = memoriesRelation,+        version = memoryReadModelVersion,+        shapeHash = memoryReadModelShapeHash,+        cursorAuthority = NoQueryCursor,+        query = \q ->+          Tx.statement+            ()+            ( S.toPreparableStatement+                ( "SELECT "+                    <> S.sql memoryMetadataColumns+                    <> " FROM "+                    <> S.sql memoriesTable+                    <> " WHERE memory_space_id="+                    <> S.param (memorySpaceIdText q.memorySpaceId)+                    <> " AND memory_id="+                    <> S.param q.memoryId+                )+                (D.rowMaybe memoryMetadataDecoder)+            )+      }++memoryMetadataPageReadModel :: ReadModel MemoriesPageQuery (Either BoundedPageError (Connection MemoryMetadata))+memoryMetadataPageReadModel =+  immediateReadModel+    ReadModelBlueprint+      { name = "kioku-memory-metadata-page",+        schema = kiokuSchema,+        tableName = memoriesRelation,+        version = memoryReadModelVersion,+        shapeHash = memoryReadModelShapeHash,+        cursorAuthority = NoQueryCursor,+        query = \q ->+          boundedPage+            (memoryPageOrder (.createdAt) (.memoryId) (.priority) q.selection)+            memoryMetadataDecoder+            (memorySelectionBase memoryMetadataColumns q.context q.selection)+            q.page+      }++-- | All filters intersect; in particular a kind never widens an exact target.+memoryFilterWhere :: MemoryAccessContext -> MemoryFilter -> S.Snippet+memoryFilterWhere context filters =+  " 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+    <> maybe "" (\(ScopeKind value) -> " AND scope_kind=" <> S.param value) filters.scopeKind++-- | Position in the current stored tag array, with the complete tag value.+-- Restart traversal after replacing tags: ordinality is not a snapshot identity.+data MemoryTag = MemoryTag {ordinal :: !Int64, value :: !Text}+  deriving stock (Generic, Eq, Show)++data MemoryTagsPageQuery = MemoryTagsPageQuery {context :: !MemoryAccessContext, memoryId :: !Text, page :: !PageRequest}++data MemoryNewestActiveQuery = MemoryNewestActiveQuery {context :: !MemoryAccessContext, filters :: !MemoryFilter}++memoryTagsPageReadModel :: ReadModel MemoryTagsPageQuery (Either BoundedPageError (Maybe (Connection MemoryTag)))+memoryTagsPageReadModel =+  immediateReadModel+    ReadModelBlueprint+      { name = "kioku-memory-tags-page",+        schema = kiokuSchema,+        tableName = memoriesRelation,+        version = memoryReadModelVersion,+        shapeHash = memoryReadModelShapeHash,+        cursorAuthority = NoQueryCursor,+        query = \q -> do+          -- Validate even missing parents before reporting absence. No rich row decoder+          -- participates, and both page/existence statements share this transaction.+          result <-+            boundedPage+              tagOrder+              tagDecoder+              ( "SELECT tag.ordinal,tag.value FROM (SELECT tags FROM "+                  <> S.sql memoriesTable+                  <> parentWhere q+                  <> ") parent CROSS JOIN LATERAL jsonb_array_elements_text(parent.tags) WITH ORDINALITY AS tag(value,ordinal)"+              )+              q.page+          case result of+            Left failure -> pure (Left failure)+            Right connection -> do+              exists <-+                Tx.statement+                  ()+                  ( S.toPreparableStatement+                      ("SELECT EXISTS(SELECT 1 FROM " <> S.sql memoriesTable <> parentWhere q <> ")")+                      (D.singleRow (D.column (D.nonNullable D.bool)))+                  )+              pure (Right (if exists then Just connection else Nothing))+      }+  where+    tagOrder = R.SortSpec (R.KeyColumn "ordinal" R.Asc (.ordinal) R.int8Key :| [])+    tagDecoder = MemoryTag <$> D.column (D.nonNullable D.int8) <*> D.column (D.nonNullable D.text)+    parentWhere q = " WHERE memory_space_id=" <> contextSpaceSnippet q.context <> " AND memory_id=" <> S.param q.memoryId++memoryNewestActiveReadModel :: ReadModel MemoryNewestActiveQuery (Maybe MemoryMetadata)+memoryNewestActiveReadModel =+  immediateReadModel+    ReadModelBlueprint+      { name = "kioku-memory-newest-active-metadata",+        schema = kiokuSchema,+        tableName = memoriesRelation,+        version = memoryReadModelVersion,+        shapeHash = memoryReadModelShapeHash,+        cursorAuthority = NoQueryCursor,+        query = \q ->+          Tx.statement+            ()+            ( S.toPreparableStatement+                ( "SELECT "+                    <> S.sql memoryMetadataColumns+                    <> " FROM "+                    <> S.sql memoriesTable+                    <> memoryFilterWhere q.context q.filters+                    <> " AND status='active' ORDER BY created_at DESC,memory_id ASC LIMIT 1"+                )+                (D.rowMaybe memoryMetadataDecoder)+            )+      }

@@ -73,7 +73,11 @@     memoriesPageReadModel,     memoryByIdReadModel,     memoryInlineProjection,+    memoryMetadataByIdReadModel,+    memoryMetadataPageReadModel,+    memoryNewestActiveReadModel,     memorySupersessionChainReadModel,+    memoryTagsPageReadModel,   ) import Kioku.Prelude import Kioku.Session.Domain (SessionEvent)@@ -172,7 +176,11 @@  memoryQueryBindings :: [SomeQueryModelBinding] memoryQueryBindings =-  [ binding memoriesPageReadModel memoryGroupId memoriesTargetId,+  [ binding memoryMetadataByIdReadModel memoryGroupId memoriesTargetId,+    binding memoryMetadataPageReadModel memoryGroupId memoriesTargetId,+    binding memoryTagsPageReadModel memoryGroupId memoriesTargetId,+    binding memoryNewestActiveReadModel memoryGroupId memoriesTargetId,+    binding memoriesPageReadModel memoryGroupId memoriesTargetId,     binding memoriesCountReadModel memoryGroupId memoriesTargetId,     binding memoryByIdReadModel memoryGroupId memoriesTargetId,     binding memoriesByNamespaceReadModel memoryGroupId memoriesTargetId,

@@ -0,0 +1,250 @@+{-# OPTIONS_GHC -Wno-deprecations #-}++-- | Exercise deprecated legacy receipt compatibility through the public facade.+-- Stream inspection is independent evidence, never the source of a receipt.+module Kioku.ArchiveReceiptSpec (tests) where++import Control.Concurrent.Async (concurrently)+import Control.Concurrent.MVar (newEmptyMVar, putMVar, takeMVar)+import Data.Aeson (Value (..))+import Data.Aeson.KeyMap qualified as KeyMap+import Data.List (sort)+import Data.Set qualified as Set+import Data.Time (addUTCTime)+import Data.Vector qualified as Vector+import Effectful (Eff)+import Keiro.Stream qualified as Stream+import Kioku.Api.Access (MemoryAccessContext, RecordedPrincipal (..), legacyMemorySpaceId, legacyPrincipalRef, memoryContextRecordedActor, memoryContextSpace)+import Kioku.Api.Access.Internal qualified as Internal+import Kioku.Api.Scope (MemoryScope (..), Namespace (..))+import Kioku.Api.Types (Confidence (..), MemoryType (..))+import Kioku.App (AppEffects, runAppIO, withNoopAppEnv)+import Kioku.Id (MemoryId, genMemoryId)+import Kioku.Memory qualified as M+import Kioku.Memory.Domain (ArchiveMemoryData (..), MemoryArchivedData (..), MemoryEvent (..), RecordMemoryData (..), SupersedeMemoryData (..))+import Kioku.Memory.Domain qualified as Archive (ArchiveMemoryData (..))+import Kioku.Memory.EventStream (memoryStream, parseMemoryEvent)+import Kioku.Migrations.TestSupport (withKiokuMigratedDatabase)+import Kioku.Prelude+import Kioku.SpaceFixtures (legacyContext, otherActorPrincipal, testActor, testContext, testSpace)+import Kiroku.Store.Connection (defaultConnectionSettings)+import Kiroku.Store.Read (readStreamForward)+import Kiroku.Store.Types (RecordedEvent (..), StreamVersion (..))+import Test.Tasty (TestTree, testGroup)+import Test.Tasty.HUnit (assertEqual, assertFailure, testCase)++tests :: TestTree+tests =+  testGroup+    "Archive receipts"+    [ testCase "first and repeat preserve unattributed archive payload" (withApp firstAndRepeat),+      testCase "two legacy commands have one append owner" (archiveRace False),+      testCase "legacy and context commands share one append owner" (archiveRace True),+      testCase "foreign active and archived IDs stay absent" (withApp partitionRefusals),+      testCase "context gates precede work and idempotence" (withApp contextRefusals),+      testCase "missing and terminal errors match the ID-only wrapper" (withApp failureParity),+      testCase "known and legacy attribution and ID-only APIs retain parity" (withApp attributionParity)+    ]++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 ->+  runAppIO env action >>= either (assertFailure . show) pure++record :: MemoryAccessContext -> UTCTime -> Eff AppEffects MemoryId+record context recordedAt = do+  memoryId <- liftIO genMemoryId+  right+    =<< M.recordWithContext+      context+      RecordMemoryData+        { memoryId,+          memorySpaceId = memoryContextSpace context,+          actorPrincipal = memoryContextRecordedActor context,+          ownerPrincipal = Nothing,+          agentId = "archive-receipt-test",+          sessionId = Nothing,+          scope = ScopeGlobal (Namespace "archive_receipts"),+          memoryType = MemoryFact,+          content = "archive receipt fixture",+          priority = 100,+          confidence = HighConfidence,+          tags = Set.empty,+          supersedes = Nothing,+          recordedAt+        }++archiveData :: MemoryId -> RecordedPrincipal -> UTCTime -> ArchiveMemoryData+archiveData memoryId actorPrincipal archivedAt =+  ArchiveMemoryData {memoryId, memorySpaceId = legacyMemorySpaceId, actorPrincipal, archivedAt}++-- Read exact serialized values as well as decoded canonical events, so a codec+-- default cannot conceal an invented actor in the durable payload.+readEvents :: MemoryId -> Eff AppEffects [(Value, MemoryEvent)]+readEvents mid = do+  stored <- Vector.toList <$> readStreamForward (Stream.streamName (memoryStream mid)) (StreamVersion 0) 100+  forM stored \event -> do+    decoded <- right (parseMemoryEvent event.payload)+    pure (event.payload, decoded)++assertArchive :: MemoryId -> ArchiveMemoryData -> Eff AppEffects ()+assertArchive mid command = do+  events <- readEvents mid+  check "record plus exactly one archive" 2 (length events)+  check+    "one canonical archive, unchanged actor and timestamp"+    [MemoryArchivedData mid legacyMemorySpaceId command.actorPrincipal command.archivedAt]+    [d | (_, MemoryArchived d) <- events]++firstAndRepeat :: Eff AppEffects ()+firstAndRepeat = do+  now <- liftIO getCurrentTime+  mid <- record legacyContext now+  let command = archiveData mid UnattributedPrincipal now+  first <- right =<< M.archiveLegacyChanged command+  again <- right =<< M.archiveLegacyChanged command {Archive.archivedAt = addUTCTime 60 now}+  check "first appended" (mid, True) first+  check "repeat appended nothing" (mid, False) again+  assertArchive mid command+  events <- readEvents mid+  let actors = [KeyMap.lookup "actorPrincipal" dat | (Object payload, MemoryArchived _) <- events, Just (Object dat) <- [KeyMap.lookup "data" payload]]+  check "durable actor is the existing marker" [Just (String "kioku:unattributed")] actors++-- Both workers announce readiness before either may call the facade. Different+-- timestamps/actors let the durable event independently identify the winner.+archiveRace :: Bool -> IO ()+archiveRace mixed = 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 legacyContext now)+  readyA <- newEmptyMVar+  readyB <- newEmptyMVar+  startA <- newEmptyMVar+  startB <- newEmptyMVar+  let a = archiveData mid UnattributedPrincipal now+      b = archiveData mid (if mixed then memoryContextRecordedActor legacyContext else LegacyPrincipal (legacyPrincipalRef "old-host")) (addUTCTime 1 now)+      worker ready start action = putMVar ready () >> takeMVar start >> run (right =<< action)+      second = if mixed then M.archiveWithContextChanged legacyContext b else M.archiveLegacyChanged b+      release = takeMVar readyA >> takeMVar readyB >> putMVar startA () >> putMVar startB ()+  ((receiptA, receiptB), ()) <-+    concurrently+      (concurrently (worker readyA startA (M.archiveLegacyChanged a)) (worker readyB startB second))+      release+  assertEqual "both return the requested ID" [mid, mid] [fst receiptA, fst receiptB]+  assertEqual "exactly one authoritative append" [False, True] (sort [snd receiptA, snd receiptB])+  run (assertArchive mid (if snd receiptA then a else b))++-- Every refused call must preserve both stream and projected row, even if the+-- foreign row is already archived (where an unscoped lookup could leak a no-op).+partitionRefusals :: Eff AppEffects ()+partitionRefusals = do+  now <- liftIO getCurrentTime+  mid <- record testContext now+  let command = (archiveData mid (memoryContextRecordedActor testContext) now) {Archive.memorySpaceId = testSpace}+  before <- snapshot testContext mid+  expectFailure (M.MemorySpaceMismatch testSpace legacyMemorySpaceId) command+  check "wrong-space payload did not change row or stream" before =<< snapshot testContext mid+  missing <- liftIO genMemoryId+  forM_ [False, True] \archived -> do+    when archived $ void (right =<< M.archiveWithContext testContext command)+    stored <- snapshot testContext mid+    let hidden = archiveData mid UnattributedPrincipal now+    expectFailure M.MemoryNotFound hidden+    expectFailure M.MemoryNotFound (archiveData missing UnattributedPrincipal now)+    check "foreign ID is unchanged" stored =<< snapshot testContext mid+  check "missing ID has no stream" [] =<< readEvents missing++snapshot :: MemoryAccessContext -> MemoryId -> Eff AppEffects (String, [(Value, MemoryEvent)])+snapshot context mid = do+  row <- right =<< M.getMemoryRowById (memoryContextSpace context) mid+  events <- readEvents mid+  -- Show covers every projected column, including status and update timestamps.+  pure (show row, events)++expectFailure :: M.MemoryWriteError -> ArchiveMemoryData -> Eff AppEffects ()+expectFailure expected command = do+  result <- M.archiveLegacyChanged command+  old <- M.archive command+  checkFailure "receipt failure matches expected constructor" expected result+  checkFailure "ID-only wrapper returns exactly the same failure" expected old++checkFailure :: String -> M.MemoryWriteError -> Either M.MemoryWriteError a -> Eff AppEffects ()+checkFailure label expected actual =+  check label (show (Left expected :: Either M.MemoryWriteError ())) (show (void actual))++contextRefusals :: Eff AppEffects ()+contextRefusals = do+  now <- liftIO getCurrentTime+  mid <- record legacyContext now+  let command = archiveData mid (memoryContextRecordedActor legacyContext) now+      noForget =+        Internal.MemoryAccessContext+          { Internal.memorySpaceId = legacyMemorySpaceId,+            Internal.actor = testActor,+            Internal.grantedPermissions = Set.singleton Internal.MemoryRead,+            Internal.decisionToken = Nothing+          }+      refused context payload expected = do+        result <- M.archiveWithContextChanged context payload+        checkFailure "context refusal remains typed" expected result+  forM_ [False, True] \archived -> do+    when archived $ void (right =<< M.archiveLegacyChanged command)+    before <- snapshot legacyContext mid+    refused noForget command (M.MemoryNotPermitted Internal.MemoryForget)+    refused legacyContext command {Archive.memorySpaceId = testSpace} (M.MemorySpaceMismatch testSpace legacyMemorySpaceId)+    forM_ [otherActorPrincipal, UnattributedPrincipal] \actor ->+      refused legacyContext command {Archive.actorPrincipal = actor} (M.MemoryActorMismatch actor (memoryContextRecordedActor legacyContext))+    check "gates did not change row or stream" before =<< snapshot legacyContext mid++failureParity :: Eff AppEffects ()+failureParity = do+  now <- liftIO getCurrentTime+  missing <- liftIO genMemoryId+  expectFailure M.MemoryNotFound (archiveData missing UnattributedPrincipal now)+  check "missing has no facts" [] =<< readEvents missing+  winner <- record legacyContext now+  forM_ [False, True] \merged -> do+    mid <- record legacyContext now+    if merged+      then void (right =<< M.mergeWithContext legacyContext mid winner)+      else+        void+          ( right+              =<< M.supersedeWithContext+                legacyContext+                SupersedeMemoryData+                  { memoryId = mid,+                    memorySpaceId = legacyMemorySpaceId,+                    actorPrincipal = memoryContextRecordedActor legacyContext,+                    supersededBy = winner,+                    supersededAt = now+                  }+          )+    before <- snapshot legacyContext mid+    expectFailure (M.MemoryConflict "archive: status differs from the recorded memory") (archiveData mid UnattributedPrincipal now)+    check "terminal failure did not change row or stream" before =<< snapshot legacyContext mid++attributionParity :: Eff AppEffects ()+attributionParity = do+  now <- liftIO getCurrentTime+  forM_ [memoryContextRecordedActor legacyContext, LegacyPrincipal (legacyPrincipalRef "historic host label")] \actor -> do+    mid <- record legacyContext now+    let command = archiveData mid actor now+        retry = command {Archive.actorPrincipal = UnattributedPrincipal, Archive.archivedAt = addUTCTime 30 now}+    check "first receipt" (mid, True) =<< right =<< M.archiveLegacyChanged command+    check "accepted repeat retains ID" (mid, False) =<< right =<< M.archiveLegacyChanged retry+    check "old wrapper retains ID" mid =<< right =<< M.archive retry+    check "context ID-only wrapper retains ID" mid =<< right =<< M.archiveWithContext legacyContext command {Archive.actorPrincipal = memoryContextRecordedActor legacyContext}+    assertArchive mid command+  -- An ID-only first archive also owns the append; the bridge then reports a repeat.+  mid <- record legacyContext now+  let command = archiveData mid UnattributedPrincipal now+  check "old wrapper first ID" mid =<< right =<< M.archive command+  check "bridge observes accepted repeat" (mid, False) =<< right =<< M.archiveLegacyChanged command+  assertArchive mid command

@@ -6,7 +6,13 @@ import Data.Set qualified as Set import Data.Text qualified as Text import Data.Time (addUTCTime)-import Effectful (Eff)+import Effectful (Eff, IOE, runEff, (:>))+import Effectful.Dispatch.Dynamic (interpret_)+import Hasql.Decoders qualified as D+import Hasql.Encoders qualified as E+import Hasql.Statement (preparable)+import Hasql.Transaction qualified as Tx+import Keiro.ReadModel (ReadModelError (..)) import Kioku.Api.Access (MemoryAccessContext, MemoryPermission (..), memoryContextRecordedActor, memoryContextSpace) import Kioku.Api.Access.Internal qualified as Internal import Kioku.Api.Recall (RecallTarget (..))@@ -15,15 +21,19 @@ 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.Memory.Domain (ArchiveMemoryData (..), RecordMemoryData (..), SupersedeMemoryData (..), UpdateMemoryTagsData (..))+import Kioku.Memory.ReadModel qualified as Filter (MemoryFilter (..)) import Kioku.Migrations.TestSupport (withKiokuMigratedDatabase) import Kioku.Pagination (BoundedPageError (..), BoundedReadError (..)) import Kioku.Prelude+import Kioku.ReadModel (reconcileReadModelRegistry) 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 Kiroku.Store.Effect (Store)+import Kiroku.Store.Transaction (runTransaction)+import Relay.Pagination (Connection (..), Cursor (..), Direction (..), Edge (..), PageInfo (..), PageRequest (..), PageRequestError (..), cursorToText) import Test.Tasty (TestTree, testGroup) import Test.Tasty.HUnit (assertEqual, assertFailure, testCase) @@ -33,6 +43,13 @@     "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 "fixed metadata traverses tied populations without tag arrays" (withApp metadataPages),+      testCase "tags page complete Unicode values with bounded ordinal cursors" (withApp tagPages),+      testCase "kind filters and newest active reads intersect before page bounds" (withApp recencyAndKinds),+      testCase "denied Memory reads execute zero Store operations" deniedWithoutStore,+      testCase "missing, malformed, stale and unavailable Memory reads stay distinct" (withApp memoryFailures),+      testCase "Memory storage failures preserve the outer Store channel" storageFailures,+      testCase "recency and metadata access plans on a multi-space fixture" (withApp memoryAccessPlans),       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),@@ -89,7 +106,10 @@ 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+recordMemory context scope now priority session memoryType = recordTagged context scope now priority session memoryType Set.empty++recordTagged :: MemoryAccessContext -> MemoryScope -> UTCTime -> Int -> Maybe SessionId -> MemoryType -> Set.Set Text -> Eff AppEffects MemoryId+recordTagged context scope now priority session memoryType tags = do   mid <- liftIO genMemoryId   right     =<< M.recordWithContext@@ -103,10 +123,10 @@           sessionId = session,           scope,           memoryType,-          content = "content",+          content = if Set.null tags then "content" else Text.replicate 1000 "complete 記憶🌱",           priority,           confidence = HighConfidence,-          tags = Set.empty,+          tags,           supersedes = Nothing,           recordedAt = now         }@@ -158,7 +178,7 @@   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+  let filters = M.MemoryFilter (ExactScope entity) (Just MemoryActive) Nothing Nothing Nothing       selection = M.FilteredMemories filters       get req = right =<< M.getPageWithContext testContext selection req   first <- get (page 3)@@ -167,16 +187,16 @@   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)+  prioritized <- right =<< M.getPageWithContext testContext (M.FilteredMemories (filters {Filter.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}))+  counts <- right =<< M.getCountsWithContext testContext (M.FilteredMemories (filters {Filter.target = NamespaceWide ns, Filter.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)+  archived <- right =<< M.getPageWithContext testContext (M.FilteredMemories (filters {Filter.target = NamespaceWide ns, Filter.status = Just MemoryArchived})) (page 1)   check "status before bounds" [idText global] (map (.memoryId) (nodes archived))  relationPages :: Eff AppEffects ()@@ -260,13 +280,24 @@             supersededBy = c,             supersededAt = now           }+  merged <- record testContext entity now+  _ <- right =<< M.mergeWithContext testContext merged c+  -- A corrupt self-link cannot make the shared recursive walk loop forever.+  runTransaction (Tx.statement (idText c) (preparable "UPDATE kioku.memories SET superseded_by=memory_id WHERE memory_id=$1" (E.param (E.nonNullable E.text)) D.noResult))+  forM_ [(a, "superseded"), (b, "superseded"), (merged, "merged")] \(identity, expectedStatus) -> do+    retained <- right =<< M.getMetadataWithContext testContext identity+    check "retired metadata point remains inspectable" (Just expectedStatus) ((.status) <$> retained)+    tags <- right =<< M.getTagsPageWithContext testContext identity (page 1)+    check "retired tag parent remains visible" (Just 0) (length . (.edges) <$> tags)   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)))+  check "both directions" (sort (map idText [a, b, c, merged])) (sort (map (.memoryId) (nodes first <> nodes rest)))+  metadata <- walkForward (\req -> right =<< M.getMetadataPageWithContext testContext selection req)+  check "metadata shares cycle-safe chain semantics and order" (sort (map idText [a, b, c, merged])) (map (.memoryId) metadata)   counts <- right =<< M.getCountsWithContext testContext selection-  check "complete chain counts" (3, 1, 2) (counts.total, counts.active, counts.superseded)+  check "complete chain counts" (4, 1, 2, 1) (counts.total, counts.active, counts.superseded, counts.merged)   foreignPage <- right =<< M.getPageWithContext otherContext selection (page 100)   check "foreign chain invisible" [] (map (.memoryId) (nodes foreignPage)) @@ -295,15 +326,17 @@   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))+  let filters = M.MemoryFilter (NamespaceWide ns) Nothing Nothing (Just (idText sid)) Nothing       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)+  sessionMetadata <- walkForward (\req -> right =<< M.getMetadataPageWithContext testContext (M.FilteredMemories filters) req)+  check "metadata native session order" (map idText (reverse inSession)) (map (.memoryId) sessionMetadata)   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)+  typed <- right =<< M.getPageWithContext testContext (M.FilteredMemories (M.MemoryFilter (NamespaceWide ns) Nothing (Just MemoryPreference) Nothing Nothing)) (page 100)   check "memory type filter" [idText preference] (map (.memoryId) (nodes typed))  readPermission :: Eff AppEffects ()@@ -320,9 +353,298 @@   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)+  memoryPage <- M.getPageWithContext writer (M.FilteredMemories (M.MemoryFilter (NamespaceWide ns) Nothing 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)++metadataPages :: Eff AppEffects ()+metadataPages = do+  now <- liftIO getCurrentTime+  ids <- replicateM 105 (record testContext entity now)+  let tags = Set.fromList ["tag-" <> Text.pack (show i) | i <- [1 :: Int .. 205]]+  tagged <- recordTagged testContext entity now 100 Nothing MemoryFact tags+  foreignId <- record otherContext entity now+  missing <- liftIO genMemoryId+  let selection = M.FilteredMemories (M.MemoryFilter (NamespaceWide ns) Nothing Nothing Nothing Nothing)+      get req = right =<< M.getMetadataPageWithContext testContext selection req+  rows <- walkForward get+  check "all metadata in native tie order" (sort (map idText (tagged : ids))) (map (.memoryId) rows)+  reverseRows <- walkBackward get+  check "reverse traversal returns complete population" rows reverseRows+  detail <- right =<< M.getMetadataWithContext testContext tagged+  rich <- right =<< M.getMemoryRowById testSpace tagged+  case (detail, rich) of+    (Just meta, Just row) -> do+      check "fixed count" 205 meta.tagCount+      check+        "all scalar fields retained"+        ((row.memorySpaceId, row.memoryId, row.agentId, row.sessionId, row.namespace, row.scopeKind, row.scopeRef, row.memoryType), (row.content, row.priority, row.confidence, row.status, row.supersededBy, row.supersedes, row.createdAt, row.updatedAt))+        ((meta.memorySpaceId, meta.memoryId, meta.agentId, meta.sessionId, meta.namespace, meta.scopeKind, meta.scopeRef, meta.memoryType), (meta.content, meta.priority, meta.confidence, meta.status, meta.supersededBy, meta.supersedes, meta.createdAt, meta.updatedAt))+    other -> liftIO (assertFailure (show other))+  forM_ [missing, foreignId] \mid -> do+    absent <- right =<< M.getMetadataWithContext testContext mid+    check "missing/foreign point is absent" Nothing absent+  checkPageBounds (M.getMetadataPageWithContext testContext selection)++walkForward :: (PageRequest -> Eff AppEffects (Connection a)) -> Eff AppEffects [a]+walkForward get = go Nothing+  where+    go cursor = do+      connection <- get (PageRequest 37 Forward cursor)+      rest <- if connection.pageInfo.hasNextPage then go connection.pageInfo.endCursor else pure []+      pure (nodes connection <> rest)++walkBackward :: (PageRequest -> Eff AppEffects (Connection a)) -> Eff AppEffects [a]+walkBackward get = go Nothing+  where+    go cursor = do+      connection <- get (PageRequest 37 Backward cursor)+      rest <- if connection.pageInfo.hasPreviousPage then go connection.pageInfo.startCursor else pure []+      pure (rest <> nodes connection)++checkPageBounds :: (PageRequest -> Eff AppEffects (Either BoundedReadError (Connection a))) -> Eff AppEffects ()+checkPageBounds get = do+  negative <- get (page (-1))+  oversized <- get (page 101)+  zero <- right =<< get (page 0)+  check "negative page" (Just (InvalidPageSize (NegativePageSize (-1)))) (pageError negative)+  check "oversized page" (Just (InvalidPageSize (PageSizeTooLarge 101 100))) (pageError oversized)+  check "zero page returns no edges" 0 (length zero.edges)++tagPages :: Eff AppEffects ()+tagPages = do+  now <- liftIO getCurrentTime+  let longTag = "a" <> Text.replicate 20000 "記憶🌱"+      tags = Set.insert longTag (Set.fromList ["tag-" <> Text.pack (show i) | i <- [1 :: Int .. 204]])+  mid <- recordTagged testContext entity now 100 Nothing MemoryFact tags+  short <- recordTagged testContext entity now 100 Nothing MemoryFact (Set.singleton "a")+  empty <- record testContext entity now+  foreignId <- record otherContext entity now+  missing <- liftIO genMemoryId+  let get req = do+        result <- right =<< M.getTagsPageWithContext testContext mid req+        maybe (liftIO (assertFailure "existing parent absent")) pure result+  forward <- walkForward get+  reverseRows <- walkBackward get+  check "all full values" (Set.toAscList tags) (map (.value) forward)+  check "no omitted or duplicate ordinals" [1 .. 205] (map (.ordinal) forward)+  check "backward traversal" forward reverseRows+  first <- get (page 1)+  shortFirst <- right =<< M.getTagsPageWithContext testContext short (page 1)+  check+    "cursor size independent of value length"+    (fmap (Text.length . cursorToText) (shortFirst >>= (.pageInfo.endCursor)))+    (Text.length . cursorToText <$> first.pageInfo.endCursor)+  checkPageBounds (\req -> fmap (fmap (fromMaybe (error "existing parent absent"))) (M.getTagsPageWithContext testContext mid req))+  emptyResult <- right =<< M.getTagsPageWithContext testContext empty (page 10)+  check "existing empty parent" (Just 0) (length . (.edges) <$> emptyResult)+  forM_ [missing, foreignId] \identity -> do+    result <- right =<< M.getTagsPageWithContext testContext identity (page 10)+    check "absent parent" Nothing result+    zero <- right =<< M.getTagsPageWithContext testContext identity (page 0)+    check "absent zero-size parent" Nothing zero+    invalid <- M.getTagsPageWithContext testContext identity (PageRequest 10 Forward (Just (Cursor "!")))+    check "invalid cursor does not become absence" True (case pageError invalid of Just (InvalidPageCursor _) -> True; _ -> False)+    forM_ [-1, 101] \n -> do+      failure <- M.getTagsPageWithContext testContext identity (page n)+      check "missing parent still validates size" True (case pageError failure of Just (InvalidPageSize _) -> True; _ -> False)+  _ <-+    right+      =<< M.archiveWithContext+        testContext+        ArchiveMemoryData+          { memoryId = mid,+            memorySpaceId = testSpace,+            actorPrincipal = memoryContextRecordedActor testContext,+            archivedAt = now+          }+  retained <- get (page 1)+  check "archived tags retained" [longTag] (map (.value) (nodes retained))+  archived <- right =<< M.getMetadataWithContext testContext mid+  check "archived metadata retained" (Just ("archived", 205)) ((\row -> (row.status, row.tagCount)) <$> archived)+  let replacement = Set.fromList ["replacement", "新しい"]+  _ <-+    right+      =<< M.updateTagsWithContext+        testContext+        UpdateMemoryTagsData+          { memoryId = short,+            memorySpaceId = testSpace,+            actorPrincipal = memoryContextRecordedActor testContext,+            tags = replacement,+            updatedAt = addUTCTime 1 now+          }+  replaced <-+    walkForward+      ( \req -> do+          result <- right =<< M.getTagsPageWithContext testContext short req+          maybe (liftIO (assertFailure "updated parent absent")) pure result+      )+  check "fresh traversal after update" (Set.toAscList replacement) (map (.value) replaced)+  metadata <- right =<< M.getMetadataWithContext testContext short+  check "updated scalar count" (Just 2) ((.tagCount) <$> metadata)++recencyAndKinds :: Eff AppEffects ()+recencyAndKinds = do+  now <- liftIO getCurrentTime+  globals <- replicateM 105 (recordWithPriority testContext (ScopeGlobal ns) now 1)+  let otherRef = ScopeEntity ns (ScopeKind "intention") "two"+      differentKind = ScopeEntity ns (ScopeKind "habit") "one"+      later = addUTCTime 10 now+  scoped <- forM [1 :: Int .. 105] \i -> recordWithPriority testContext (if even i then entity else otherRef) later 100+  sid <- start testContext entity later Nothing+  preference <- recordMemory testContext entity (addUTCTime 20 now) 100 (Just sid) MemoryPreference+  archived <- record testContext entity (addUTCTime 30 now)+  _ <-+    right+      =<< M.archiveWithContext+        testContext+        ArchiveMemoryData+          { memoryId = archived,+            memorySpaceId = testSpace,+            actorPrincipal = memoryContextRecordedActor testContext,+            archivedAt = addUTCTime 31 now+          }+  _ <- record otherContext entity (addUTCTime 40 now)+  habit <- record testContext differentKind later+  let filters = M.MemoryFilter (NamespaceWide ns) Nothing Nothing Nothing Nothing+      kind = filters {Filter.scopeKind = Just (ScopeKind "intention")}+      getNewest f = fmap (.memoryId) <$> (right =<< M.getNewestActiveMetadataWithContext testContext f)+      assertPopulation label f expected = do+        rich <- walkForward (\req -> right =<< M.getPageWithContext testContext (M.FilteredMemories f) req)+        metadata <- walkForward (\req -> right =<< M.getMetadataPageWithContext testContext (M.FilteredMemories f) req)+        counts <- right =<< M.getCountsWithContext testContext (M.FilteredMemories f)+        check (label <> " rich/metadata agree") (map (.memoryId) rich) (map (.memoryId) metadata)+        check (label <> " complete count") (fromIntegral expected) counts.total+        check (label <> " population") expected (length metadata)+  ordinary <- right =<< M.getPageWithContext testContext (M.FilteredMemories filters) (page 1)+  check "ordinary list chooses older priority one" [minimum (map idText globals)] (map (.memoryId) (nodes ordinary))+  newest <- getNewest filters+  check "recency ignores priority and archived/foreign newer rows" (Just (idText preference)) newest+  tied <- getNewest (kind {Filter.memoryType = Just MemoryFact})+  check "recency ties use ascending id" (Just (minimum (map idText scoped))) tied+  assertPopulation "namespace" filters 213+  assertPopulation "kind beyond first unfiltered page" kind 107+  kindCounts <- right =<< M.getCountsWithContext testContext (M.FilteredMemories kind)+  check "complete kind status scalars" (107, 106, 1, 0, 0) (kindCounts.total, kindCounts.active, kindCounts.archived, kindCounts.superseded, kindCounts.merged)+  assertPopulation "exact global" (filters {Filter.target = ExactScope (ScopeGlobal ns)}) 105+  assertPopulation "global plus entity kind" (kind {Filter.target = ExactScope (ScopeGlobal ns)}) 0+  assertPopulation "mismatched exact entity kind" (kind {Filter.target = ExactScope differentKind}) 0+  assertPopulation "exact entity intersection" (kind {Filter.target = ExactScope entity}) 54+  assertPopulation "kind/type/status/session" (kind {Filter.status = Just MemoryActive, Filter.memoryType = Just MemoryPreference, Filter.sessionId = Just (idText sid)}) 1+  assertPopulation "archived kind" (kind {Filter.status = Just MemoryArchived}) 1+  forM_ [filters {Filter.status = Just MemoryArchived}, kind {Filter.target = ExactScope (ScopeGlobal ns)}, kind {Filter.memoryType = Just MemoryConstraint}] \f -> do+    absent <- getNewest f+    check "incompatible/empty newest is absent" Nothing absent+  globalNewest <- getNewest (filters {Filter.target = ExactScope (ScopeGlobal ns)})+  check "exact global recency" (Just (minimum (map idText globals))) globalNewest+  exactNewest <- getNewest (kind {Filter.target = ExactScope entity})+  check "exact entity recency" (Just (idText preference)) exactNewest+  habitNewest <- getNewest (filters {Filter.scopeKind = Just (ScopeKind "habit")})+  check "kind selects independent vocabulary" (Just (idText habit)) habitNewest++-- Include valid, malformed and missing-parent inputs for every paged facade.+memoryProbes :: (IOE :> es, Store :> es) => MemoryAccessContext -> MemoryId -> Eff es [Either BoundedReadError ()]+memoryProbes context mid =+  sequence+    [ fmap (const ()) <$> M.getMetadataWithContext context mid,+      fmap (const ()) <$> M.getMetadataPageWithContext context selection (page 1),+      fmap (const ()) <$> M.getTagsPageWithContext context mid (page 1),+      fmap (const ()) <$> M.getNewestActiveMetadataWithContext context filters,+      fmap (const ()) <$> M.getCountsWithContext context selection+    ]+  where+    filters = M.MemoryFilter (NamespaceWide ns) Nothing Nothing Nothing (Just (ScopeKind "intention"))+    selection = M.FilteredMemories filters++deniedWithoutStore :: IO ()+deniedWithoutStore = do+  missing <- genMemoryId+  let writer = Internal.MemoryAccessContext {Internal.memorySpaceId = testSpace, Internal.actor = testActor, Internal.grantedPermissions = Set.singleton MemoryRecord, Internal.decisionToken = Nothing}+      filters = M.MemoryFilter (NamespaceWide ns) Nothing Nothing Nothing (Just (ScopeKind "intention"))+      selection = M.FilteredMemories filters+      run :: Eff '[Store, IOE] a -> IO a+      run = runEff . interpret_ (\_ -> liftIO (assertFailure "permission denial invoked Store"))+  results <- run do+    regular <- memoryProbes writer missing+    invalid <- forM [page (-1), page 101, PageRequest 1 Forward (Just (Cursor "!"))] \request -> do+      metadata <- M.getMetadataPageWithContext writer selection request+      tags <- M.getTagsPageWithContext writer missing request+      pure [fmap (const ()) metadata, fmap (const ()) tags]+    pure (regular <> concat invalid)+  assertEqual "every denial precedes Store and validation" (replicate 11 (Left (BoundedReadNotPermitted MemoryRead))) results++memoryFailures :: Eff AppEffects ()+memoryFailures = do+  missing <- liftIO genMemoryId+  let selection = M.FilteredMemories (M.MemoryFilter (NamespaceWide ns) Nothing Nothing Nothing Nothing)+  invalid <- M.getMetadataPageWithContext testContext selection (PageRequest 1 Forward (Just (Cursor "!")))+  check "metadata malformed cursor" True (case pageError invalid of Just (InvalidPageCursor _) -> True; _ -> False)+  healthy <- memoryProbes testContext missing+  check "absence is healthy" (replicate 5 (Right ())) healthy+  runTransaction (Tx.sql "UPDATE keiro.keiro_read_models SET version=0 WHERE name LIKE 'kioku-memory-%' OR name='kioku-memories-count'")+  stale <- memoryProbes testContext missing+  check "all new models and kind counts fail stale" True (all (\case Left (BoundedReadFailed (ReadModelStaleSchema {})) -> True; _ -> False) stale)+  _ <- reconcileReadModelRegistry+  runTransaction (Tx.sql "UPDATE keiro.keiro_read_models SET status='rebuilding' WHERE name LIKE 'kioku-memory-%' OR name='kioku-memories-count'")+  unavailable <- memoryProbes testContext missing+  check "rebuilding is unavailable" True (all (\case Left (BoundedReadFailed (ReadModelNotLive {})) -> True; _ -> False) unavailable)+  runTransaction (Tx.sql "DELETE FROM keiro.keiro_read_models WHERE name LIKE 'kioku-memory-%' OR name='kioku-memories-count'")+  absent <- memoryProbes testContext missing+  check "unregistered is distinct from absent Memory" True (all (\case Left (BoundedReadFailed (ReadModelUnregistered _)) -> True; _ -> False) absent)+  _ <- reconcileReadModelRegistry+  repaired <- memoryProbes testContext missing+  check "reconciled extended inventory serves reads" (replicate 5 (Right ())) repaired++storageFailures :: IO ()+storageFailures = withKiokuMigratedDatabase \conn -> withNoopAppEnv (defaultConnectionSettings conn) \env -> do+  missing <- genMemoryId+  renamed <- runAppIO env (runTransaction (Tx.sql "ALTER TABLE kioku.memories RENAME TO memories_unavailable"))+  either (assertFailure . show) pure renamed+  let filters = M.MemoryFilter (NamespaceWide ns) Nothing Nothing Nothing (Just (ScopeKind "intention"))+      selection = M.FilteredMemories filters+      probes =+        [ fmap (const ()) <$> M.getMetadataWithContext testContext missing,+          fmap (const ()) <$> M.getMetadataPageWithContext testContext selection (page 1),+          fmap (const ()) <$> M.getTagsPageWithContext testContext missing (page 1),+          fmap (const ()) <$> M.getNewestActiveMetadataWithContext testContext filters,+          fmap (const ()) <$> M.getCountsWithContext testContext selection+        ]+  forM_ probes \probe -> do+    result <- runAppIO env probe+    case result of+      Left _ -> pure ()+      Right other -> assertFailure ("storage failure was swallowed: " <> show other)++-- The direct SQL rows are planner-scale projection noise; semantic fixtures above+-- are written through real commands. No planner switches force an index choice.+memoryAccessPlans :: Eff AppEffects ()+memoryAccessPlans = do+  runTransaction+    ( Tx.sql+        """+        INSERT INTO kioku.memories+          (memory_space_id,memory_id,agent_id,namespace,scope_kind,scope_ref,memory_type,content,priority,confidence,tags,status,created_at,updated_at)+        SELECT 'plan-space-' || (i % 4), 'plan-memory-' || i, 'planner', 'bounded',+          CASE WHEN i % 8 < 4 THEN 'intention' ELSE 'habit' END, 'ref-' || (i % 50),+          'fact', repeat('content ',20), (i % 100)+1, 'high', '[]'::jsonb,+          CASE WHEN i % 5 = 0 THEN 'archived' ELSE 'active' END,+          '2026-01-01'::timestamptz + i * interval '1 second', '2026-01-01'::timestamptz+        FROM generate_series(1,40000) i;+        ANALYZE kioku.memories;+        """+    )+  forM_ [("namespace recency", ""), ("kind recency", " AND scope_kind='intention'")] \(label, kind) -> do+    explainPlan label ("SELECT memory_space_id,memory_id,agent_id,session_id,namespace,scope_kind,scope_ref,memory_type,content,priority,confidence,jsonb_array_length(tags)::bigint,status,superseded_by,supersedes,created_at,updated_at FROM kioku.memories WHERE memory_space_id='plan-space-1' AND namespace='bounded' AND status='active'" <> kind <> " ORDER BY created_at DESC,memory_id ASC LIMIT 1")+  explainPlan "metadata page" "SELECT memory_space_id,memory_id,agent_id,session_id,namespace,scope_kind,scope_ref,memory_type,content,priority,confidence,jsonb_array_length(tags)::bigint,status,superseded_by,supersedes,created_at,updated_at FROM kioku.memories WHERE memory_space_id='plan-space-1' AND namespace='bounded' ORDER BY priority ASC,created_at DESC,memory_id ASC LIMIT 38"++explainPlan :: Text -> Text -> Eff AppEffects ()+explainPlan label query = do+  rows <- runTransaction (Tx.statement () (preparable ("EXPLAIN (ANALYZE, BUFFERS) " <> query) E.noParams (D.rowList (D.column (D.nonNullable D.text)))))+  liftIO (putStrLn (Text.unpack ("\n" <> label <> "\n" <> Text.unlines rows)))+  check "plan uses a partition-first ordered index" True (any (Text.isInfixOf (if label == "metadata page" then "memories_space_namespace_page_idx" else "memories_space_active_recency_idx")) rows)+  check "plan needs no collection sort" False (any (Text.isInfixOf "Sort Key:") rows)+  check "plan retains space predicate" True (any (Text.isInfixOf "memory_space_id") rows)

@@ -1,12 +1,14 @@ module Kioku.ProjectionCatalogSpec (tests) where +import Control.Exception (IOException, try) import Data.Foldable (for_) import Data.List.NonEmpty (NonEmpty (..)) import Data.List.NonEmpty qualified as NonEmpty import Data.Set qualified as Set+import Data.Text (Text) import Data.Time (getCurrentTime) import Data.Vector qualified as Vector-import Effectful (liftIO)+import Effectful (Eff, liftIO) import Keiro.Command   ( SqlCommandOutcome (..),     SqlTransactionDecision (..),@@ -50,7 +52,7 @@ import Keiro.Timer (lookupTimer) import Kioku.Api.Scope (MemoryScope (..), Namespace (..)) import Kioku.Api.Types (Confidence (..), MemoryType (..))-import Kioku.App (runAppIO, withNoopAppEnv)+import Kioku.App (AppEffects, AppEnv (..), noopTracer, runAppIO, withNoopAppEnv) import Kioku.Distill.L2 (l2SceneTimerId, l2SceneTimerScheduleProjection) import Kioku.Id (genMemoryId, genSessionId, idText) import Kioku.Memory qualified as Memory@@ -83,6 +85,7 @@     "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 "0.10.0.0 adopts before startup and preserves existing metadata" testMetadataAdoption,       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,@@ -103,8 +106,8 @@   assertEqual "targets" 3 (length kiokuCatalogInventory.inventoryTargets)   assertEqual "groups" 2 (length kiokuCatalogInventory.inventoryGroups)   assertEqual "projection owners" 2 (length kiokuCatalogInventory.inventoryProjections)-  assertEqual "query models" 25 (length kiokuCatalogInventory.inventoryQueryModels)-  assertEqual "registrations" 25 (length (catalogRegistrations kiokuProjectionCatalog))+  assertEqual "query models" 29 (length kiokuCatalogInventory.inventoryQueryModels)+  assertEqual "registrations" 29 (length (catalogRegistrations kiokuProjectionCatalog))   assertBool     "every query is immediate and cursorless"     ( all@@ -113,7 +116,7 @@     )   assertEqual     "canonical fingerprint"-    "catalog-v7:8cce393084799278ee21a4aba3356e1f88d34c630e8c1b97aa8743e543616956"+    "catalog-v7:e5d496cc534d2438d880b7708a87d36c017b129fd8fc38d3c3af788075bb96d4"     (catalogFingerprintText kiokuCatalogFingerprint)   where     noCursor :: Maybe InventoryQueryCursor -> Bool@@ -361,7 +364,7 @@ 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"]+    let added = metadataQueries <> ["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)@@ -382,3 +385,71 @@       registered <- registerProjectionCatalog kiokuProjectionCatalog       liftIO (either (assertFailure . show) (const (pure ())) registered)     either (assertFailure . show) pure result++-- Preserve the complete released twenty-five-query catalog independently of later additions.+metadataQueries :: [Text]+metadataQueries = ["kioku-memory-metadata-by-id", "kioku-memory-metadata-page", "kioku-memory-tags-page", "kioku-memory-newest-active-metadata"]++testMetadataAdoption :: Assertion+testMetadataAdoption = withKiokuMigratedDatabase \conn -> do+  tracer <- noopTracer+  let settings = defaultConnectionSettings conn+      env = AppEnv {connectionSettings = settings, tracer, metrics = Nothing}+      historical definition = definition {queryModels = filter (\(SomeQueryModelBinding binding) -> binding.readModel.name `notElem` metadataQueries) definition.queryModels}+      run :: Eff AppEffects a -> IO a+      run action = runAppIO env action >>= either (assertFailure . show) pure+      checked :: (Show e) => Eff AppEffects (Either e a) -> IO a+      checked action = run action >>= either (assertFailure . show) pure+  prior <- case validateKiokuProjectionCatalogWith historical of+    Failure errors -> assertFailure (show errors)+    Success catalog -> pure catalog+  assertEqual "0.10.0.0 inventory" 25 (length (catalogRegistrations prior))+  assertEqual "0.10.0.0 fingerprint" "catalog-v7:8cce393084799278ee21a4aba3356e1f88d34c630e8c1b97aa8743e543616956" (catalogFingerprintText (catalogFingerprint prior))+  _ <- checked (registerProjectionCatalog prior)+  now <- getCurrentTime+  mid <- genMemoryId+  _ <-+    checked+      ( Memory.recordWithContext+          testContext+          RecordMemoryData+            { memoryId = mid,+              memorySpaceId = testSpace,+              actorPrincipal = testActorPrincipal,+              ownerPrincipal = Nothing,+              agentId = "upgrade",+              sessionId = Nothing,+              scope = ScopeGlobal (Namespace "upgrade"),+              memoryType = MemoryFact,+              content = "existing complete content — 記憶",+              priority = 50,+              confidence = HighConfidence,+              tags = Set.fromList ["one", "two"],+              supersedes = Nothing,+              recordedAt = now+            }+      )+  startup <- try @IOException (withNoopAppEnv settings (const (pure ())))+  assertBool "ordinary startup refuses old catalog" (case startup of Left _ -> True; Right _ -> False)+  -- This is the compiled administrative recipe documented in bounded-reads.md.+  preview <- run (previewCatalogAdoption kiokuProjectionCatalog)+  let groups =+        NonEmpty.fromList+          [ group.rebuildGroupId+          | group <- kiokuCatalogInventory.inventoryGroups,+            any (\(identity, state) -> identity == group.rebuildGroupId && case state of AdoptionSliceChanged _ _ -> True; _ -> False) preview.groupStates+          ]+  assertEqual "only memory group changes" 1 (length groups)+  _ <- checked (adoptCatalogGroups kiokuProjectionCatalog groups)+  _ <- checked (registerProjectionCatalog kiokuProjectionCatalog)+  _ <- checked (adoptCatalogGroups kiokuProjectionCatalog groups)+  _ <- checked (registerProjectionCatalog kiokuProjectionCatalog)+  withNoopAppEnv settings \newEnv -> do+    result <- runAppIO newEnv (Memory.getMetadataWithContext testContext mid)+    case result of+      Right (Right (Just row)) -> do+        assertEqual "identity" (idText mid) row.memoryId+        assertEqual "content" "existing complete content — 記憶" row.content+        assertEqual "timestamps" (now, now) (row.createdAt, row.updatedAt)+        assertEqual "tag count" 2 row.tagCount+      other -> assertFailure (show other)

@@ -1,6 +1,7 @@ module Main where  import Kioku.AIRuntimeSpec qualified as AIRuntimeSpec+import Kioku.ArchiveReceiptSpec qualified as ArchiveReceiptSpec import Kioku.AwaitingSpec qualified as AwaitingSpec import Kioku.BoundedReadSpec qualified as BoundedReadSpec import Kioku.CodecCompatSpec qualified as CodecCompatSpec@@ -30,6 +31,7 @@     testGroup       "kioku"       [ BoundedReadSpec.tests,+        ArchiveReceiptSpec.tests,         AIRuntimeSpec.tests,         AwaitingSpec.tests,         CodecCompatSpec.tests,