kioku-core 0.4.1.0 → 0.5.0.0

raw patch · 28 files changed

+1329/−785 lines, 28 filesdep +unixdep ~keirodep ~keiro-coredep ~kioku-apiPVP ok

version bump matches the API change (PVP)

Dependencies added: unix

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

API changes (from Hackage documentation)

Files

• CHANGELOG.md +51/−0
• kioku-core.cabal +11/−10
• src/Kioku/Distill/L1.hs +12/−8
• src/Kioku/Distill/L2.hs +26/−63
• src/Kioku/Distill/L3.hs +26/−64
• src/Kioku/Distill/ScopeIdentity.hs +12/−2
• src/Kioku/Distill/Timer/Outcome.hs +75/−1
• src/Kioku/Distill/Timer/Worker.hs +25/−9
• src/Kioku/Memory.hs +64/−36
• src/Kioku/Memory/Embedding/Worker.hs +42/−14
• src/Kioku/Memory/EventStream.hs +4/−109
• src/Kioku/Partition.hs +44/−1
• src/Kioku/Recall/Capability.hs +19/−13
• src/Kioku/Session.hs +8/−15
• src/Kioku/Session/EventStream.hs +4/−115
• src/Kioku/Workspace.hs +60/−35
• test/Kioku/CodecCompatSpec.hs +43/−42
• test/Kioku/DistillSpec.hs +275/−6
• test/Kioku/EmbeddingWorkerSpec.hs +112/−1
• test/Kioku/IdempotencySpec.hs +41/−4
• test/Kioku/MemorySpaceSpec.hs +116/−2
• test/Kioku/RecallSqlSpec.hs +1/−1
• test/Kioku/RecallTargetSpec.hs +114/−7
• test/Kioku/ReiCompatSpec.hs +0/−214
• test/Kioku/ScopeIdentitySpec.hs +8/−1
• test/Kioku/TimerWorkerSpec.hs +56/−7
• test/Kioku/WorkspaceSpec.hs +80/−3
• test/Main.hs +0/−2

@@ -1,5 +1,56 @@ # Changelog +## 0.5.0.0 — 2026-08-22++### Breaking Changes++- `parseMemoryEvent` and `parseSessionEvent` retain their public types but no longer accept Rei's+  retired `agent_memory_*`, `agent_session_*`, or `interactive_session_recorded` values. Kioku's+  native pre-partition events and `SessionResumed` payloads written before `force` remain+  supported. Consumers that still need a foreign wire format must own its finite migration codec;+  this narrowing ships on the 0.5.0.0 line, not as a 0.4 patch.+- Raised the lockstep `keiro` and `keiro-core` bounds to `^>=0.14.0.0`. Keiro's exported outbox+  types gain the terminal rejected outcome and audit fields. `kioku-core` neither exhaustively+  matches nor directly constructs the affected types, so its source and exported API are+  unchanged; applications that also consume those Keiro outbox types must handle the new cases.++### Fixed++- `applyArtifactMigration` now publishes a fully written temporary sibling through an atomic+  no-replace hard link. A destination created after the dry-run plan can no longer be overwritten:+  byte-identical content is accepted as already migrated, while differing content fails without+  changing either file. Published copies retain the historical source's permissions.+- Workspace directory names and scope mirror filenames now consume one exported+  `slugWithDigest` implementation while preserving every existing persisted path byte for byte.+- Distillation now refuses under-scoped work before it can read evidence, call an LLM, mutate a+  derived row, or write a mirror. L1 preflights `MemoryDistill`, `MemoryRecord`, and+  `MemoryForget`; L2/L3 timer fires require `MemoryDistill` and reject a context for the wrong+  space. Their shared partition, timer-outcome, and mirror-removal primitives replace the former+  duplicate handler implementations.+- Memory lineage writes now require every `supersedes`, `supersededBy`, and merge-winner target to+  exist in the source memory's space before the first transition. Missing and cross-space targets+  both return `MemoryNotFound` without appending an event, while an accepted supersede or merge+  remains idempotent after its winner retires.+- L1 watermark upserts now repair a row whose `memory_space_id` diverged from its globally unique+  session while keeping `last_turn_index` monotonic, so one successful pass restores cheap+  watermark skips instead of repeating extraction.+- Timer dead letters and fire spans now attribute only an explicitly valid `memorySpaceId`.+  Missing, null, and unreadable ownership is reported as `unknown`; native pre-partition timer+  actions still execute in `kioku_legacy`, and the eight-attempt ceiling is unchanged.+- Embedding startup and explicit backfills now apply the missing-or-stale content-hash predicate+  in both production SQL statements. Settled active rows no longer transfer their full content+  from PostgreSQL merely to be skipped in Haskell; the existing Haskell check remains as a race+  defense after candidate selection.+- Vector capability detection now takes the projection schema and relation from+  `Kioku.Database.Schema` instead of repeating `kioku.memories` across catalog predicates. The+  separate bare `vector` type probe retains its search-path semantics.++### Changed++- Memory and Session writes now consume the same permission/space/actor and legacy-space gates+  from `Kioku.Api.Access`, preserving their existing error constructors and check ordering while+  removing the two local policy copies.+ ## 0.4.1.0 — 2026-08-18  ### Changed

@@ -1,6 +1,6 @@ cabal-version:   3.0 name:            kioku-core-version:         0.4.1.0+version:         0.5.0.0 synopsis:        Reusable agent memory runtime description:   Core runtime for kioku. M1 establishes the application effect stack; later@@ -129,9 +129,9 @@     , hasql-transaction       >=1.0       && <1.3     , hs-opentelemetry-api    >=1.0       && <1.1     , keiki                   ^>=0.9.0.0-    , keiro                   ^>=0.13.0.0-    , keiro-core              ^>=0.13.0.0-    , kioku-api               ^>=0.4.1.0+    , keiro                   ^>=0.14.0.0+    , keiro-core              ^>=0.14.0.0+    , kioku-api               ^>=0.5.0.0     , kiroku-store            ^>=0.8.0.0     , lens                    >=5.2       && <5.4     , mmzk-typeid             >=0.7       && <0.8@@ -141,6 +141,7 @@     , shikumi-trace           ^>=0.2.0.2     , text                    >=2.1       && <2.2     , time                    >=1.12      && <1.15+    , unix                    >=2.8.8     && <2.9     , unordered-containers    >=0.2       && <0.3     , uuid                    >=1.3       && <1.4     , vector                  ^>=0.13.2.0@@ -163,7 +164,6 @@     Kioku.RecallSpec     Kioku.RecallSqlSpec     Kioku.RecallTargetSpec-    Kioku.ReiCompatSpec     Kioku.SchemaSpec     Kioku.ScopeIdentitySpec     Kioku.SessionInvariantsSpec@@ -188,11 +188,11 @@     , filepath                       >=1.4     , hasql                          >=1.6     , hasql-transaction              >=1.0-    , keiro                          ^>=0.13.0.0-    , keiro-core                     ^>=0.13.0.0-    , kioku-api                      ^>=0.4.1.0-    , kioku-core                     ^>=0.4.1.0-    , kioku-migrations:test-support  ^>=0.4.1.0+    , keiro                          ^>=0.14.0.0+    , keiro-core                     ^>=0.14.0.0+    , kioku-api                      ^>=0.5.0.0+    , kioku-core                     ^>=0.5.0.0+    , kioku-migrations:test-support  ^>=0.5.0.0     , kiroku-store                   ^>=0.8.0.0     , lens                           >=5.2     , shibuya-core                   ^>=0.9.0.0@@ -204,6 +204,7 @@     , temporary                      >=1.3     , text                           >=2.1     , time                           >=1.12+    , unix                           >=2.8.8     && <2.9     , unordered-containers           >=0.2     , uuid                           >=1.3     , vector

@@ -21,7 +21,7 @@ import Data.Functor.Contravariant ((>$<)) import Data.Int (Int32) import Data.KindID.V7 qualified as KindID-import Data.List (nub)+import Data.List (find, nub) import Data.Maybe (catMaybes) import Data.Set qualified as Set import Data.Text qualified as Text@@ -44,6 +44,7 @@     memoryContextRecordedActor,     memoryContextSpace,   )+import Kioku.Api.Access qualified as Access import Kioku.Api.Scope (MemoryScope, scopeFromColumns, scopeKindText, scopeNamespaceText, scopeRefText) import Kioku.Api.Types (Confidence (..), MemoryRecord (..), MemoryType (..), confidenceFromText, memoryTypeFromText) import Kioku.Database.Schema (consolidationDecisionsTable, l1WatermarksTable)@@ -173,8 +174,9 @@ -- a failed pass is retried in full. -- -- The pass writes memories, so it needs a 'MemoryAccessContext' — the one for the memory space--- the session belongs to. It demands 'MemoryDistill' before anything else, so an unauthorized--- pass fails before it spends a single LLM token rather than after, at the first write.+-- the session belongs to. It demands 'MemoryDistill', 'MemoryRecord', and 'MemoryForget' before+-- anything else, so an under-scoped pass fails before it spends a single LLM token rather than+-- after, at the first write. distillSessionL1 ::   (IOE :> es, KirokuStoreResource :> es, Store :> es, Error StoreError :> es) =>   MemoryAccessContext ->@@ -183,10 +185,10 @@   FindMergeCandidates es ->   SessionId ->   Eff es (Either L1Error L1Outcome)-distillSessionL1 context mode rt finder sid-  | not (memoryContextAllows MemoryDistill context) =-      pure (Left (L1NotPermitted MemoryDistill))-  | otherwise = do+distillSessionL1 context mode rt finder sid =+  case find (not . (`memoryContextAllows` context)) requiredPermissions of+    Just missingPermission -> pure (Left (L1NotPermitted missingPermission))+    Nothing -> do       sessionResult <- Session.getById space sid       case sessionResult of         Left err -> pure (Left (L1SessionReadFailed err))@@ -220,6 +222,7 @@                               writeWatermark space sid maxTurnIndex                               pure (Right (L1Distilled summary))   where+    requiredPermissions = [MemoryDistill, Access.MemoryRecord, MemoryForget]     space = memoryContextSpace context      stepAtom _ _ (Left err) _ = pure (Left err)@@ -726,7 +729,8 @@              (memory_space_id, session_id, last_turn_index, distilled_at)            VALUES ($1, $2, $3, $4)            ON CONFLICT (session_id) DO UPDATE-             SET last_turn_index =+             SET memory_space_id = EXCLUDED.memory_space_id,+                 last_turn_index =                    GREATEST(watermark.last_turn_index, EXCLUDED.last_turn_index),                  distilled_at = EXCLUDED.distilled_at            """

@@ -21,7 +21,6 @@ import Crypto.Hash (Digest, SHA256) import Crypto.Hash qualified as Hash import Data.Aeson qualified as Aeson-import Data.Aeson.Types (withObject, (.:)) import Data.ByteString qualified as BS import Data.ByteString.Lazy qualified as BL import Data.Foldable (for_, traverse_)@@ -42,7 +41,7 @@ import Keiro.Projection (InlineProjection (..)) import Keiro.ReadModel (ReadModelError) import Keiro.Timer (TimerId (..), TimerRequest (..), TimerRow (..), scheduleTimerTx)-import Kioku.Api.Access (MemoryContextProvider (..), MemorySpaceId, legacyMemorySpaceId, memoryContextSpace)+import Kioku.Api.Access (MemoryContextProvider, MemorySpaceId, legacyMemorySpaceId) import Kioku.Api.Scope (MemoryScope, scopeFromColumns, scopeKindText, scopeNamespaceText, scopeRefText) import Kioku.Api.Types (MemoryRecord (..)) import Kioku.Database.Schema (memoriesTable, scenesTable)@@ -50,7 +49,11 @@ import Kioku.Distill.Runtime (DistillRuntime, distillWorkspaceRoot, runSceneDistillation) import Kioku.Distill.Scene (SceneInput (..), SceneOutput (..)) import Kioku.Distill.ScopeIdentity (escapeScopeComponent, scopeIdentity, scopeSlugFromColumns)-import Kioku.Distill.Timer.Outcome (FireOutcome (..), fireRetryDelay, timerMarkerEventId)+import Kioku.Distill.Timer.Outcome+  ( FireOutcome,+    firePartitionedDistillTimer,+    parsePartitionedScopeFields,+  ) import Kioku.Id (MemoryId, idText) import Kioku.Memory.Domain   ( MemoryArchivedData (..),@@ -60,15 +63,21 @@     MemoryRecordedData (..),     MemorySupersededData (..),   )-import Kioku.Partition (memorySpaceColumn, memorySpaceParam, parsePartitionSpace)+import Kioku.Partition+  ( PartitionedScope,+    memorySpaceColumn,+    memorySpaceParam,+    partitionedScope,+    partitionedScopeEncoder,+  ) import Kioku.Prelude import Kioku.Recall qualified as Recall-import Kioku.Workspace (legacySceneArtifactDir, sceneArtifactDir)+import Kioku.Workspace (legacySceneArtifactDir, removeIfPresent, sceneArtifactDir) import Kiroku.Store.Effect (Store) import Kiroku.Store.Transaction (runTransaction) import Kiroku.Store.Types (EventId (..), RecordedEvent (..)) import Shikumi.Schema.Types (field, unField)-import System.Directory (createDirectoryIfMissing, doesFileExist, getCurrentDirectory, removeFile)+import System.Directory (createDirectoryIfMissing, getCurrentDirectory) import System.FilePath ((</>))  data L2Error@@ -107,8 +116,8 @@  instance FromJSON SceneTimerPayload where   parseJSON =-    withObject "SceneTimerPayload" \o ->-      SceneTimerPayload <$> parsePartitionSpace o <*> o .: "scope"+    Aeson.withObject "SceneTimerPayload" \o ->+      uncurry SceneTimerPayload <$> parsePartitionedScopeFields o  l2SceneProcessManagerName :: Text l2SceneProcessManagerName = "kioku-l2-scene"@@ -304,29 +313,13 @@   DistillRuntime ->   TimerRow ->   Eff es FireOutcome-fireL2SceneTimer contexts rt row-  | row.processManagerName /= l2SceneProcessManagerName =-      pure FireNotMine-  | otherwise =-      case Aeson.fromJSON @SceneTimerPayload row.payload of-        -- A payload this handler cannot parse will not parse on the next attempt-        -- either. It used to be marked fired, which quietly lost the scene.-        Aeson.Error err ->-          pure (FireFailedPermanently ("L2 scene timer payload is malformed: " <> Text.pack err))-        Aeson.Success payload -> do-          decision <- contexts.contextForSpace payload.memorySpaceId-          case decision of-            Left denial ->-              pure-                ( FireFailedPermanently-                    ("L2 scene timer is not authorized for its memory space: " <> Text.pack (show denial))-                )-            Right context -> do-              result <- regenerateScene rt (memoryContextSpace context) payload.scope-              pure $-                case result of-                  Right _ -> FireCompleted (timerMarkerEventId row.timerId)-                  Left err -> FireRetryLater (fireRetryDelay row.attempts) (Text.pack (show err))+fireL2SceneTimer contextProvider rt row =+  firePartitionedDistillTimer+    l2SceneProcessManagerName+    "L2 scene timer"+    contextProvider+    row+    (regenerateScene rt)  lookupScene ::   (Store :> es) =>@@ -337,7 +330,7 @@ lookupScene memorySpaceId scope sceneKey = do   result <-     runTransaction $-      Tx.statement (SceneScopeKey (scopeKey memorySpaceId scope) sceneKey) selectSceneByScopeKeyStmt+      Tx.statement (SceneScopeKey (partitionedScope memorySpaceId scope) sceneKey) selectSceneByScopeKeyStmt   pure (Right result)  getScenesByScope ::@@ -347,16 +340,7 @@   Eff es [SceneRow] getScenesByScope memorySpaceId scope =   runTransaction $-    Tx.statement (scopeKey memorySpaceId scope) selectScenesByScopeStmt---- | A scope lookup inside one memory space, as a record rather than a tuple so that the--- partition cannot be transposed with the namespace it sits beside.-data PartitionedScope = PartitionedScope-  { memorySpaceId :: !MemorySpaceId,-    namespace :: !Text,-    scopeKind :: !(Maybe Text),-    scopeRef :: !(Maybe Text)-  }+    Tx.statement (partitionedScope memorySpaceId scope) selectScenesByScopeStmt  data SceneScopeKey = SceneScopeKey !PartitionedScope !Text @@ -364,22 +348,6 @@  data MemoryScopeLookup = MemoryScopeLookup !MemorySpaceId !Text -scopeKey :: MemorySpaceId -> MemoryScope -> PartitionedScope-scopeKey memorySpaceId scope =-  PartitionedScope-    { memorySpaceId,-      namespace = scopeNamespaceText scope,-      scopeKind = scopeKindText scope,-      scopeRef = scopeRefText scope-    }--partitionedScopeEncoder :: E.Params PartitionedScope-partitionedScopeEncoder =-  ((\q -> q.memorySpaceId) >$< memorySpaceParam)-    <> ((\q -> q.namespace) >$< E.param (E.nonNullable E.text))-    <> ((\q -> q.scopeKind) >$< E.param (E.nullable E.text))-    <> ((\q -> q.scopeRef) >$< E.param (E.nullable E.text))- mirrorSceneToCurrentWorkspace :: SceneRow -> IO FilePath mirrorSceneToCurrentWorkspace row = do   workspace <- getCurrentDirectory@@ -436,11 +404,6 @@         traverse_ removeIfPresent (sceneMirrorPath workspace row : maybeToList (legacySceneMirrorPath workspace row))   _ <- try remove :: IO (Either IOException ())   pure ()--removeIfPresent :: FilePath -> IO ()-removeIfPresent path = do-  exists <- doesFileExist path-  when exists (removeFile path)  renderSceneFile :: SceneRow -> Text renderSceneFile row =

@@ -22,7 +22,6 @@ import Crypto.Hash (Digest, SHA256) import Crypto.Hash qualified as Hash import Data.Aeson qualified as Aeson-import Data.Aeson.Types (withObject, (.:)) import Data.ByteString qualified as BS import Data.ByteString.Lazy qualified as BL import Data.Foldable (traverse_)@@ -43,10 +42,9 @@ import Hasql.Transaction qualified as Tx import Keiro.Timer (TimerId (..), TimerRequest (..), TimerRow (..), scheduleTimerTx) import Kioku.Api.Access-  ( MemoryContextProvider (..),+  ( MemoryContextProvider,     MemorySpaceId,     legacyMemorySpaceId,-    memoryContextSpace,     memorySpaceIdText,   ) import Kioku.Api.Scope (MemoryScope, scopeKindText, scopeNamespaceText, scopeRefText)@@ -54,14 +52,24 @@ import Kioku.Distill.Persona (PersonaInput (..), PersonaOutput (..)) import Kioku.Distill.Runtime (DistillRuntime, distillWorkspaceRoot, runPersonaDistillation) import Kioku.Distill.ScopeIdentity (scopeIdentity, scopeSlugFromColumns)-import Kioku.Distill.Timer.Outcome (FireOutcome (..), fireRetryDelay, timerMarkerEventId)-import Kioku.Partition (memorySpaceColumn, memorySpaceParam, parsePartitionSpace)+import Kioku.Distill.Timer.Outcome+  ( FireOutcome,+    firePartitionedDistillTimer,+    parsePartitionedScopeFields,+  )+import Kioku.Partition+  ( PartitionedScope,+    memorySpaceColumn,+    memorySpaceParam,+    partitionedScope,+    partitionedScopeEncoder,+  ) import Kioku.Prelude-import Kioku.Workspace (legacyPersonaArtifactDir, personaArtifactDir)+import Kioku.Workspace (legacyPersonaArtifactDir, personaArtifactDir, removeIfPresent) import Kiroku.Store.Effect (Store) import Kiroku.Store.Transaction (runTransaction) import Shikumi.Schema.Types (field, unField)-import System.Directory (createDirectoryIfMissing, doesFileExist, getCurrentDirectory, removeFile)+import System.Directory (createDirectoryIfMissing, getCurrentDirectory) import System.FilePath ((</>))  data L3Error@@ -105,8 +113,8 @@  instance FromJSON PersonaTimerPayload where   parseJSON =-    withObject "PersonaTimerPayload" \o ->-      PersonaTimerPayload <$> parsePartitionSpace o <*> o .: "scope"+    Aeson.withObject "PersonaTimerPayload" \o ->+      uncurry PersonaTimerPayload <$> parsePartitionedScopeFields o  l3PersonaProcessManagerName :: Text l3PersonaProcessManagerName = "kioku-l3-persona"@@ -225,29 +233,13 @@   DistillRuntime ->   TimerRow ->   Eff es FireOutcome-fireL3PersonaTimer contexts rt row-  | row.processManagerName /= l3PersonaProcessManagerName =-      pure FireNotMine-  | otherwise =-      case Aeson.fromJSON @PersonaTimerPayload row.payload of-        -- Unparseable now, unparseable on every retry: dead-letter rather than-        -- mark it fired and lose the persona silently.-        Aeson.Error err ->-          pure (FireFailedPermanently ("L3 persona timer payload is malformed: " <> Text.pack err))-        Aeson.Success payload -> do-          decision <- contexts.contextForSpace payload.memorySpaceId-          case decision of-            Left denial ->-              pure-                ( FireFailedPermanently-                    ("L3 persona timer is not authorized for its memory space: " <> Text.pack (show denial))-                )-            Right context -> do-              result <- regeneratePersona rt (memoryContextSpace context) payload.scope-              pure $-                case result of-                  Right _ -> FireCompleted (timerMarkerEventId row.timerId)-                  Left err -> FireRetryLater (fireRetryDelay row.attempts) (Text.pack (show err))+fireL3PersonaTimer contextProvider rt row =+  firePartitionedDistillTimer+    l3PersonaProcessManagerName+    "L3 persona timer"+    contextProvider+    row+    (regeneratePersona rt)  getPersonaByScope ::   (Store :> es) =>@@ -256,7 +248,7 @@   Eff es (Maybe PersonaRow) getPersonaByScope memorySpaceId scope =   runTransaction $-    Tx.statement (scopeKey memorySpaceId scope) selectPersonaByScopeStmt+    Tx.statement (partitionedScope memorySpaceId scope) selectPersonaByScopeStmt  getPersonaScenesByScope ::   (Store :> es) =>@@ -265,35 +257,10 @@   Eff es [PersonaSceneRow] getPersonaScenesByScope memorySpaceId scope =   runTransaction $-    Tx.statement (scopeKey memorySpaceId scope) selectScenesForPersonaStmt---- | A scope lookup inside one memory space, as a record rather than a four-tuple so that the--- partition cannot be transposed with the namespace it sits beside.-data PartitionedScope = PartitionedScope-  { memorySpaceId :: !MemorySpaceId,-    namespace :: !Text,-    scopeKind :: !(Maybe Text),-    scopeRef :: !(Maybe Text)-  }+    Tx.statement (partitionedScope memorySpaceId scope) selectScenesForPersonaStmt  data PersonaKey = PersonaKey !MemorySpaceId !Text -scopeKey :: MemorySpaceId -> MemoryScope -> PartitionedScope-scopeKey memorySpaceId scope =-  PartitionedScope-    { memorySpaceId,-      namespace = scopeNamespaceText scope,-      scopeKind = scopeKindText scope,-      scopeRef = scopeRefText scope-    }--partitionedScopeEncoder :: E.Params PartitionedScope-partitionedScopeEncoder =-  ((\q -> q.memorySpaceId) >$< memorySpaceParam)-    <> ((\q -> q.namespace) >$< E.param (E.nonNullable E.text))-    <> ((\q -> q.scopeKind) >$< E.param (E.nullable E.text))-    <> ((\q -> q.scopeRef) >$< E.param (E.nullable E.text))- mirrorPersonaToCurrentWorkspace :: PersonaRow -> IO FilePath mirrorPersonaToCurrentWorkspace row = do   workspace <- getCurrentDirectory@@ -344,11 +311,6 @@           (personaMirrorPath workspace row : maybeToList (legacyPersonaMirrorPath workspace row))   _ <- try remove :: IO (Either IOException ())   pure ()--removeIfPresent :: FilePath -> IO ()-removeIfPresent path = do-  exists <- doesFileExist path-  when exists (removeFile path)  personaScopeSlug :: PersonaRow -> Text personaScopeSlug row =

@@ -23,6 +23,7 @@   ( escapeScopeComponent,     scopeIdentity,     scopeIdentityFromColumns,+    slugWithDigest,     scopeSlugFromColumns,   ) where@@ -69,14 +70,23 @@ -- what actually separates them; the prefix is only so a human can tell the files apart. scopeSlugFromColumns :: Text -> Maybe Text -> Maybe Text -> Text scopeSlugFromColumns namespace scopeKind scopeRef =-  sanitizeSlug readable <> "-" <> identityDigest+  slugWithDigest readable (scopeIdentityFromColumns namespace scopeKind scopeRef)   where     readable =       Text.intercalate "-" (namespace : catMaybes [scopeKind, scopeRef]) +-- | Turn a readable label and its exact identity into a path-safe persisted slug.+--+-- The readable label is only for humans: sanitisation is intentionally lossy. The digest is+-- computed from the separate identity input so callers can retain that identity's injective+-- encoding even when the readable label uses a friendlier spelling.+slugWithDigest :: Text -> Text -> Text+slugWithDigest readable identity =+  sanitizeSlug readable <> "-" <> identityDigest+  where     identityDigest =       Text.take 10 . Text.pack . show $-        (Hash.hash (TE.encodeUtf8 (scopeIdentityFromColumns namespace scopeKind scopeRef)) :: Digest SHA256)+        (Hash.hash (TE.encodeUtf8 identity) :: Digest SHA256)  sanitizeSlug :: Text -> Text sanitizeSlug =

@@ -12,16 +12,90 @@ -- it. module Kioku.Distill.Timer.Outcome   ( FireOutcome (..),+    parsePartitionedScopeFields,+    firePartitionedDistillTimer,     fireRetryDelay,     unknownTimerRetryDelay,     timerMarkerEventId,   ) where +import Data.Aeson.Types (Object, Parser, parseEither, withObject, (.:))+import Data.Text qualified as Text import Data.Time (NominalDiffTime)-import Keiro.Timer (TimerId (..))+import Effectful (Eff)+import Keiro.Timer (TimerId (..), TimerRow (..))+import Kioku.Api.Access+  ( MemoryContextProvider (..),+    MemoryPermission (MemoryDistill),+    MemorySpaceId,+    memoryContextAllows,+    memoryContextSpace,+    memorySpaceIdText,+  )+import Kioku.Api.Scope (MemoryScope)+import Kioku.Partition (parsePartitionSpace) import Kioku.Prelude import Kiroku.Store.Types (EventId (..))++-- | Decode the partition and scope shared by L2 and L3 timer payloads.+--+-- 'parsePartitionSpace' deliberately keeps native pre-partition timers working by defaulting a+-- missing @memorySpaceId@ into the legacy space.+parsePartitionedScopeFields :: Object -> Parser (MemorySpaceId, MemoryScope)+parsePartitionedScopeFields o =+  (,) <$> parsePartitionSpace o <*> o .: "scope"++-- | Run the common authorization and outcome pipeline for one derived-artifact timer.+--+-- Provider refusal, an under-scoped context, a context for the wrong space, and malformed input+-- are configuration facts, so they dead-letter. Only a regeneration failure is retryable.+firePartitionedDistillTimer ::+  (Show err) =>+  Text ->+  String ->+  MemoryContextProvider (Eff es) ->+  TimerRow ->+  (MemorySpaceId -> MemoryScope -> Eff es (Either err result)) ->+  Eff es FireOutcome+firePartitionedDistillTimer expectedProcessName payloadLabel contextProvider row regenerate+  | row.processManagerName /= expectedProcessName =+      pure FireNotMine+  | otherwise =+      case parseEither (withObject (payloadLabel <> " payload") parsePartitionedScopeFields) row.payload of+        Left err ->+          pure (FireFailedPermanently (label <> " payload is malformed: " <> Text.pack err))+        Right (requestedSpace, scope) -> do+          decision <- contextProvider.contextForSpace requestedSpace+          case decision of+            Left denial ->+              pure+                ( FireFailedPermanently+                    (label <> " is not authorized for its memory space: " <> Text.pack (show denial))+                )+            Right context+              | memoryContextSpace context /= requestedSpace ->+                  pure+                    ( FireFailedPermanently+                        ( label+                            <> " context provider returned memory space "+                            <> memorySpaceIdText (memoryContextSpace context)+                            <> " for requested space "+                            <> memorySpaceIdText requestedSpace+                        )+                    )+              | not (memoryContextAllows MemoryDistill context) ->+                  pure+                    ( FireFailedPermanently+                        (label <> " context is missing required permission MemoryDistill")+                    )+              | otherwise -> do+                  result <- regenerate (memoryContextSpace context) scope+                  pure case result of+                    Right _ -> FireCompleted (timerMarkerEventId row.timerId)+                    Left err -> FireRetryLater (fireRetryDelay row.attempts) (Text.pack (show err))+  where+    label = Text.pack payloadLabel  -- | The verdict of one fire attempt. data FireOutcome

@@ -44,7 +44,7 @@     unknownTimerRetryDelay,   ) import Kioku.Id (parseIdLenient)-import Kioku.Partition (parsePartitionSpace)+import Kioku.Partition (parseOptionalPartitionSpace) import Kioku.Prelude import Kiroku.Store.Effect (Store) import Kiroku.Store.Effect.Resource (KirokuStoreResource)@@ -64,8 +64,11 @@ -- stale requeue is keiro's default and unchanged. kiokuTimerWorkerOptions :: TimerWorkerOptions kiokuTimerWorkerOptions =-  TimerWorkerOptions {maxAttempts = Just 8, requeueStuckAfter = Just 300}+  TimerWorkerOptions {maxAttempts = Just kiokuTimerAttemptCeiling, requeueStuckAfter = Just 300} +kiokuTimerAttemptCeiling :: Int+kiokuTimerAttemptCeiling = 8+ -- | Fire one L1 distillation timer. -- -- A background pass discovers its own work, so it cannot arrive holding an authorization@@ -188,13 +191,14 @@  -- | The memory space a timer payload names, for diagnostics only. ----- Every one of the three payload types carries the space, and each decodes it through--- 'parsePartitionSpace' — the same function this uses — so this cannot disagree with the handler--- that actually acts on the payload. It is read here rather than returned by the handlers so--- that a span and a dead-letter row can name the space even when no handler claimed the timer.+-- Every newly written Kioku payload carries the space. This parser deliberately differs from the+-- action codecs: action decoding defaults a native pre-partition payload into the legacy space,+-- while diagnostics report absent or unreadable ownership as unknown. It is read here rather+-- than returned by the handlers so a span and a dead-letter row can still be attributed when no+-- handler claimed the timer. timerPayloadSpace :: Aeson.Value -> Maybe MemorySpaceId timerPayloadSpace = \case-  Aeson.Object o -> Aeson.parseMaybe parsePartitionSpace o+  Aeson.Object o -> Aeson.parseMaybe parseOptionalPartitionSpace o >>= id   _ -> Nothing  -- | Span attributes for one fire attempt.@@ -272,12 +276,24 @@   UTCTime ->   Eff es (Maybe TimerRow) runKiokuTimerWorkerOnce metrics contexts rt finder now =-  runTimerWorkerWith metrics kiokuTimerWorkerOptions now \row ->+  runTimerWorkerWith metrics callbackQualifiedOptions now \row ->     withSpan' "kioku.timer.fire" defaultSpanArguments \fireSpan -> do       addAttributes fireSpan (timerSpanAttributes row)-      outcome <- fireKiokuTimer contexts rt finder row+      outcome <-+        if row.attempts > kiokuTimerAttemptCeiling+          then+            pure+              ( FireFailedPermanently+                  ("timer exceeded attempt ceiling of " <> Text.pack (show kiokuTimerAttemptCeiling))+              )+          else fireKiokuTimer contexts rt finder row       addAttributes fireSpan (fireOutcomeAttributes outcome)       applyFireOutcome row outcome+  where+    -- Keiro's built-in ceiling runs before the callback, which would bypass Kioku's mandatory+    -- space-qualified dead-letter text and fire-span outcome. Enforce the same post-claim+    -- @attempts > 8@ boundary inside the callback instead.+    callbackQualifiedOptions = kiokuTimerWorkerOptions {maxAttempts = Nothing}  -- | Claim and fire due timers until none remain, returning how many were -- processed.

@@ -68,10 +68,11 @@     MemoryPermission (..),     MemorySpaceId,     RecordedPrincipal (..),+    inLegacyMemorySpaceOnly,     legacyMemorySpaceId,-    memoryContextAllows,     memoryContextRecordedActor,     memoryContextSpace,+    underMemoryContext,   ) import Kioku.Api.Scope (MemoryScope (..), Namespace (..), scopeKindText, scopeNamespaceText, scopeRefText) import Kioku.Api.Types (MemoryType, confidenceToText, memoryTypeToText)@@ -130,17 +131,11 @@   RecordedPrincipal ->   f (Either MemoryWriteError a) ->   f (Either MemoryWriteError a)-underContext context permission space actor run-  | not (memoryContextAllows permission context) =-      pure (Left (MemoryNotPermitted permission))-  | space /= authorizedSpace =-      pure (Left (MemorySpaceMismatch space authorizedSpace))-  | actor /= authorizedActor =-      pure (Left (MemoryActorMismatch actor authorizedActor))-  | otherwise = run-  where-    authorizedSpace = memoryContextSpace context-    authorizedActor = memoryContextRecordedActor context+underContext =+  underMemoryContext+    MemoryNotPermitted+    MemorySpaceMismatch+    MemoryActorMismatch  -- | Gate a deprecated wrapper on the one space it is allowed to touch. --@@ -151,9 +146,7 @@   MemorySpaceId ->   f (Either MemoryWriteError a) ->   f (Either MemoryWriteError a)-inLegacySpaceOnly space run-  | space /= legacyMemorySpaceId = pure (Left (MemorySpaceMismatch space legacyMemorySpaceId))-  | otherwise = run+inLegacySpaceOnly = inLegacyMemorySpaceOnly MemorySpaceMismatch  -- | Record a new memory in the space the context authorizes. recordWithContext ::@@ -182,9 +175,13 @@   case existing of     Left err -> pure (Left (MemoryReadFailed err))     Right (Just row) -> pure (idempotentOr "record" recordMismatch row cmdData.memoryId)-    Right Nothing ->-      runMemoryCommand cmdData.memoryId (RecordMemory cmdData)-        >>= acceptRejectedIfMatches cmdData.memorySpaceId cmdData.memoryId (isNothing . recordMismatch)+    Right Nothing -> do+      targetResult <- requireOptionalLineageTarget cmdData.memorySpaceId cmdData.supersedes+      case targetResult of+        Left err -> pure (Left err)+        Right () ->+          runMemoryCommand cmdData.memoryId (RecordMemory cmdData)+            >>= acceptRejectedIfMatches cmdData.memorySpaceId cmdData.memoryId (isNothing . recordMismatch)   where     recordMismatch = mismatchOf memoryRecordFields cmdData @@ -219,9 +216,13 @@       -- Already retired: only a supersession by the *same* winner is this request's own       -- echo. Superseding by a different winner is a conflict, not a duplicate.       | row.status /= "active" -> pure (idempotentOr "supersede" supersedeMismatch row cmdData.memoryId)-      | otherwise ->-          runMemoryCommand cmdData.memoryId (SupersedeMemory cmdData)-            >>= acceptRejectedIfMatches cmdData.memorySpaceId cmdData.memoryId (isNothing . supersedeMismatch)+      | otherwise -> do+          targetResult <- requireLineageTarget cmdData.memorySpaceId cmdData.supersededBy+          case targetResult of+            Left err -> pure (Left err)+            Right () ->+              runMemoryCommand cmdData.memoryId (SupersedeMemory cmdData)+                >>= acceptRejectedIfMatches cmdData.memorySpaceId cmdData.memoryId (isNothing . supersedeMismatch)   where     supersedeMismatch = mismatchOf memorySupersedeFields cmdData @@ -332,8 +333,9 @@ -- different one is a conflict. -- -- Both memories must live in the authorized space. The loser is checked by the aggregate guard--- on the command below; the winner is only referenced, and 'Kioku.Distill.L1' — the one caller--- that supplies a winner it did not just write — resolves both from the same session.+-- on the command below; the referenced winner is resolved through the same space-scoped read+-- model before the first transition. 'Kioku.Distill.L1' keeps its earlier planning check so a+-- bad model response can degrade without partially applying its batch. mergeWithContext ::   (IOE :> es, KirokuStoreResource :> es, Store :> es, Error StoreError :> es) =>   MemoryAccessContext ->@@ -374,19 +376,23 @@     Right (Just row)       | row.status /= "active" -> pure (idempotentOr "merge" mergeMismatch row loser)       | otherwise -> do-          now <- liftIO getCurrentTime-          runMemoryCommand-            loser-            ( MergeMemory-                MergeMemoryData-                  { memoryId = loser,-                    memorySpaceId,-                    actorPrincipal,-                    mergedInto = winner,-                    mergedAt = now-                  }-            )-            >>= acceptRejectedIfMatches memorySpaceId loser (isNothing . mergeMismatch)+          targetResult <- requireLineageTarget memorySpaceId winner+          case targetResult of+            Left err -> pure (Left err)+            Right () -> do+              now <- liftIO getCurrentTime+              runMemoryCommand+                loser+                ( MergeMemory+                    MergeMemoryData+                      { memoryId = loser,+                        memorySpaceId,+                        actorPrincipal,+                        mergedInto = winner,+                        mergedAt = now+                      }+                )+                >>= acceptRejectedIfMatches memorySpaceId loser (isNothing . mergeMismatch)   where     mergeMismatch = mismatchOf memoryMergeFields winner @@ -481,6 +487,28 @@   [ ("status", \_ row -> row.status == "merged"),     ("mergedInto", \winner row -> row.supersededBy == Just (idText winner))   ]++-- | Require a lineage id to resolve inside the source memory's space. The scoped query makes a+-- target in another space indistinguishable from one that does not exist, preserving the same+-- no-oracle behavior as source-memory lookups.+requireLineageTarget ::+  (IOE :> es, Store :> es) =>+  MemorySpaceId ->+  MemoryId ->+  Eff es (Either MemoryWriteError ())+requireLineageTarget space target =+  lookupMemory space target <&> \case+    Left err -> Left (MemoryReadFailed err)+    Right Nothing -> Left MemoryNotFound+    Right (Just _) -> Right ()++requireOptionalLineageTarget ::+  (IOE :> es, Store :> es) =>+  MemorySpaceId ->+  Maybe MemoryId ->+  Eff es (Either MemoryWriteError ())+requireOptionalLineageTarget _ Nothing = pure (Right ())+requireOptionalLineageTarget space (Just target) = requireLineageTarget space target  -- | Look a memory up inside one space. A memory that lives elsewhere is 'Nothing' here, which -- is what makes the write paths' idempotency prechecks unable to answer questions about it.

@@ -28,6 +28,7 @@     EmbedOutcome (..),     EmbeddingBackfillScope (..),     backfillMissingEmbeddings,+    selectEmbeddingCandidateIds,     embeddingHandler,     embeddingWorkerProcessor,     mkEmbeddingWorkerEnv,@@ -339,14 +340,9 @@   EmbeddingBackfillScope ->   Eff es Int backfillMissingEmbeddings VectorAvailable env scope = do-  candidates <- runTransaction candidateQuery+  candidates <- selectEmbeddingCandidates scope   foldM embedCandidate 0 candidates   where-    candidateQuery =-      case scope of-        BackfillEverySpace -> Tx.statement () selectEmbeddingCandidatesStmt-        BackfillOneSpace space -> Tx.statement space selectEmbeddingCandidatesInSpaceStmt-     embedCandidate count candidate       | shouldSkipEmbedding candidate.hasEmbedding candidate.contentHash contentHash =           pure count@@ -376,6 +372,29 @@         contentHash = sha256Hex candidate.content backfillMissingEmbeddings _ _ _ = pure 0 +-- | Return only the identities that the production backfill statements actually transferred.+--+-- This deliberately projects from decoded 'EmbeddingCandidate' values after running the same+-- statements as 'backfillMissingEmbeddings'. It is a regression seam for the database/Haskell+-- transfer boundary, not a second spelling of candidate eligibility.+selectEmbeddingCandidateIds ::+  (Store :> es) =>+  EmbeddingBackfillScope ->+  Eff es [(MemorySpaceId, Text)]+selectEmbeddingCandidateIds scope =+  fmap (\candidate -> (candidate.memorySpaceId, candidate.memoryId))+    <$> selectEmbeddingCandidates scope++selectEmbeddingCandidates ::+  (Store :> es) =>+  EmbeddingBackfillScope ->+  Eff es [EmbeddingCandidate]+selectEmbeddingCandidates scope =+  runTransaction $+    case scope of+      BackfillEverySpace -> Tx.statement () selectEmbeddingCandidatesStmt+      BackfillOneSpace space -> Tx.statement space selectEmbeddingCandidatesInSpaceStmt+ -- | Embed one memory, refusing to touch it if it is not in the space the caller named. -- -- The state read is keyed by the memory id alone, which is globally unique, and returns the@@ -445,10 +464,9 @@         <> " "         <> memoriesTable         <> " "-        <> """-           WHERE status = 'active'-           ORDER BY created_at ASC-           """+        <> "WHERE status = 'active' AND "+        <> embeddingCandidatePredicate+        <> " ORDER BY created_at ASC"     )     E.noParams     (D.rowList embeddingCandidateDecoder)@@ -469,13 +487,23 @@         <> " "         <> memoriesTable         <> " "-        <> """-           WHERE status = 'active' AND memory_space_id = $1-           ORDER BY created_at ASC-           """+        <> "WHERE status = 'active' AND memory_space_id = $1 AND "+        <> embeddingCandidatePredicate+        <> " ORDER BY created_at ASC"     )     memorySpaceParam     (D.rowList embeddingCandidateDecoder)++-- | Candidate eligibility belongs at the transfer boundary. PostgreSQL calculates the same+-- lowercase hexadecimal SHA-256 that 'sha256Hex' calculates in Haskell, so settled content is+-- rejected before its full text crosses the Hasql connection. 'shouldSkipEmbedding' remains the+-- later race check after a row has already been selected.+embeddingCandidatePredicate :: Text+embeddingCandidatePredicate =+  """+  (embedding IS NULL+   OR content_hash IS DISTINCT FROM encode(sha256(convert_to(content, 'UTF8')), 'hex'))+  """  selectEmbeddingStateStmt :: Statement Text (Maybe EmbeddingState) selectEmbeddingStateStmt =

@@ -8,7 +8,8 @@ where  import Data.Aeson (Value)-import Data.Aeson.Types (Parser, parseEither, withObject, (.:), (.:?))+import Data.Aeson.Types (parseEither)+import Data.Bifunctor (first) import Data.Text qualified as Text import Keiki.Core (HsPred) import Keiki.Generics (emptyRegFile)@@ -17,9 +18,7 @@ import Keiro.EventStream.Validate (ValidatedEventStream, mkEventStreamOrThrow) import Keiro.Stream (Stream) import Keiro.Stream qualified as Stream-import Kioku.Api.Access (RecordedPrincipal (..), legacyMemorySpaceId, legacyPrincipalRef)-import Kioku.Api.Scope (MemoryScope (..), Namespace (..), ScopeKind (..))-import Kioku.Id (MemoryId, SessionId, idText, parseIdLenient)+import Kioku.Id (MemoryId, idText) import Kioku.Memory.Domain import Kioku.Prelude @@ -72,108 +71,4 @@     }  parseMemoryEvent :: Value -> Either Text MemoryEvent-parseMemoryEvent value =-  case parseEither parseJSON value of-    Right event -> Right event-    Left nativeErr ->-      case parseEither parseLegacyMemoryEvent value of-        Right event -> Right event-        Left legacyErr -> Left (Text.pack nativeErr <> "; legacy decode failed: " <> Text.pack legacyErr)--parseLegacyMemoryEvent :: Value -> Parser MemoryEvent-parseLegacyMemoryEvent =-  withObject "Rei AgentMemoryEvent" $ \o -> do-    tag <- o .: "type"-    payload <- o .: "data"-    case tag of-      "agent_memory_recorded" -> MemoryRecorded <$> parseLegacyMemoryRecorded payload-      "agent_memory_superseded" -> MemorySuperseded <$> parseLegacyMemorySuperseded payload-      "agent_memory_archived" -> MemoryArchived <$> parseLegacyMemoryArchived payload-      "agent_memory_tags_updated" -> MemoryTagsUpdated <$> parseLegacyMemoryTagsUpdated payload-      "agent_memory_confidence_updated" -> MemoryConfidenceUpdated <$> parseLegacyMemoryConfidenceUpdated payload-      other -> fail ("Unknown Rei AgentMemoryEvent tag: " <> Text.unpack other)---- | Rei payloads predate memory spaces by even more than Kioku's own older events do, so they--- take the same two rules: the legacy space, and the legacy agent label kept verbatim. Rei's--- @agentId@ is exactly the free-text label 'LegacyPrincipal' exists to mark.-parseLegacyMemoryRecorded :: Value -> Parser MemoryRecordedData-parseLegacyMemoryRecorded =-  withObject "Rei AgentMemoryRecordedData" $ \o -> do-    memoryId <- parseLegacyMemoryId =<< o .: "memoryId"-    agentId <- o .: "agentId"-    sessionId <- traverse parseLegacySessionId =<< o .:? "sessionId"-    scope <- parseLegacyAnchor =<< o .: "anchor"-    supersedes <- traverse parseLegacyMemoryId =<< o .:? "supersedes"-    MemoryRecordedData-      memoryId-      legacyMemorySpaceId-      (LegacyPrincipal (legacyPrincipalRef agentId))-      Nothing-      agentId-      sessionId-      scope-      <$> o .: "memoryType"-      <*> o .: "content"-      <*> pure 100-      <*> o .: "confidence"-      <*> o .: "tags"-      <*> pure supersedes-      <*> o .: "recordedAt"--parseLegacyMemorySuperseded :: Value -> Parser MemorySupersededData-parseLegacyMemorySuperseded =-  withObject "Rei AgentMemorySupersededData" $ \o ->-    MemorySupersededData-      <$> (parseLegacyMemoryId =<< o .: "memoryId")-      <*> pure legacyMemorySpaceId-      <*> pure UnattributedPrincipal-      <*> (parseLegacyMemoryId =<< o .: "supersededBy")-      <*> o .: "supersededAt"--parseLegacyMemoryArchived :: Value -> Parser MemoryArchivedData-parseLegacyMemoryArchived =-  withObject "Rei AgentMemoryArchivedData" $ \o ->-    MemoryArchivedData-      <$> (parseLegacyMemoryId =<< o .: "memoryId")-      <*> pure legacyMemorySpaceId-      <*> pure UnattributedPrincipal-      <*> o .: "archivedAt"--parseLegacyMemoryTagsUpdated :: Value -> Parser MemoryTagsUpdatedData-parseLegacyMemoryTagsUpdated =-  withObject "Rei AgentMemoryTagsUpdatedData" $ \o ->-    MemoryTagsUpdatedData-      <$> (parseLegacyMemoryId =<< o .: "memoryId")-      <*> pure legacyMemorySpaceId-      <*> pure UnattributedPrincipal-      <*> o .: "tags"-      <*> o .: "updatedAt"--parseLegacyMemoryConfidenceUpdated :: Value -> Parser MemoryConfidenceUpdatedData-parseLegacyMemoryConfidenceUpdated =-  withObject "Rei AgentMemoryConfidenceUpdatedData" $ \o ->-    MemoryConfidenceUpdatedData-      <$> (parseLegacyMemoryId =<< o .: "memoryId")-      <*> pure legacyMemorySpaceId-      <*> pure UnattributedPrincipal-      <*> o .: "confidence"-      <*> o .: "updatedAt"--parseLegacyAnchor :: Value -> Parser MemoryScope-parseLegacyAnchor =-  withObject "Rei MemoryAnchor" $ \o -> do-    anchorType <- o .: "type"-    case anchorType of-      "intention" -> ScopeEntity reiNamespace (ScopeKind "intention") <$> o .: "id"-      "habit" -> ScopeEntity reiNamespace (ScopeKind "habit") <$> o .: "id"-      "workspace" -> pure (ScopeGlobal reiNamespace)-      other -> fail ("Unknown Rei MemoryAnchor type: " <> Text.unpack other)--parseLegacyMemoryId :: Text -> Parser MemoryId-parseLegacyMemoryId = either (fail . Text.unpack) pure . parseIdLenient--parseLegacySessionId :: Text -> Parser SessionId-parseLegacySessionId = either (fail . Text.unpack) pure . parseIdLenient--reiNamespace :: Namespace-reiNamespace = Namespace "rei"+parseMemoryEvent = first Text.pack . parseEither parseJSON

@@ -22,7 +22,11 @@ -- @memory_space_id@ is a plain @text@ column, and exactly one pair of functions turns a -- 'MemorySpaceId' into it and back. module Kioku.Partition-  ( parsePartitionSpace,+  ( PartitionedScope (..),+    partitionedScope,+    partitionedScopeEncoder,+    parseOptionalPartitionSpace,+    parsePartitionSpace,     parseRecordedActor,     parseRecordedActorFromAgent,     parseRecordedOwner,@@ -45,11 +49,50 @@     memorySpaceIdText,     mkMemorySpaceId,   )+import Kioku.Api.Scope (MemoryScope, scopeKindText, scopeNamespaceText, scopeRefText) import Kioku.Prelude +-- | A scope lookup qualified by its memory space.+--+-- The record fixes the PostgreSQL parameter order used by every L2/L3 statement and makes the+-- partition impossible to transpose with the namespace beside it.+data PartitionedScope = PartitionedScope+  { memorySpaceId :: !MemorySpaceId,+    namespace :: !Text,+    scopeKind :: !(Maybe Text),+    scopeRef :: !(Maybe Text)+  }+  deriving stock (Generic, Eq, Show)++-- | Qualify a public scope value with the memory space in which it is being queried.+partitionedScope :: MemorySpaceId -> MemoryScope -> PartitionedScope+partitionedScope memorySpaceId scope =+  PartitionedScope+    { memorySpaceId,+      namespace = scopeNamespaceText scope,+      scopeKind = scopeKindText scope,+      scopeRef = scopeRefText scope+    }++-- | Encode @memory_space_id@, namespace, scope kind, and scope reference as @$1@ through @$4@.+partitionedScopeEncoder :: E.Params PartitionedScope+partitionedScopeEncoder =+  ((\q -> q.memorySpaceId) >$< memorySpaceParam)+    <> ((\q -> q.namespace) >$< E.param (E.nonNullable E.text))+    <> ((\q -> q.scopeKind) >$< E.param (E.nullable E.text))+    <> ((\q -> q.scopeRef) >$< E.param (E.nullable E.text))+ -- | The memory space a payload belongs to, defaulting an older payload into the legacy space. parsePartitionSpace :: Object -> Parser MemorySpaceId parsePartitionSpace o = o .:? "memorySpaceId" .!= legacyMemorySpaceId++-- | The memory space a payload explicitly names, without inventing one for diagnostics.+--+-- Action decoders use 'parsePartitionSpace' so native payloads written before partitioning keep+-- executing in the legacy space. Generic diagnostics have a different question: absent or+-- unreadable ownership is unknown rather than evidence that the payload named that space.+parseOptionalPartitionSpace :: Object -> Parser (Maybe MemorySpaceId)+parseOptionalPartitionSpace o = o .:? "memorySpaceId"  -- | The actor a payload records, for events that never carried an agent label. parseRecordedActor :: Object -> Parser RecordedPrincipal

@@ -6,12 +6,14 @@   ) where +import Data.Functor.Contravariant ((>$<)) import Data.Int (Int32) import Effectful (Eff, (:>)) import Hasql.Decoders qualified as D import Hasql.Encoders qualified as E import Hasql.Statement (Statement, preparable) import Hasql.Transaction qualified as Tx+import Kioku.Database.Schema (kiokuSchema, memoriesRelation) import Kioku.Prelude import Kiroku.Store.Effect (Store) import Kiroku.Store.Transaction (runTransaction)@@ -43,7 +45,9 @@   Int ->   Eff es VectorCapability detectVectorCapability configuredDimensions =-  classifyProbe configuredDimensions <$> runTransaction (Tx.statement () detectVectorCapabilityStmt)+  classifyProbe configuredDimensions+    <$> runTransaction+      (Tx.statement (kiokuSchema, memoriesRelation) detectVectorCapabilityStmt)  classifyProbe :: Int -> CapabilityProbe -> VectorCapability classifyProbe configuredDimensions probe@@ -81,12 +85,12 @@ -- @to_regtype@ resolves against the live @search_path@, which is exactly the question the -- query asks. ----- The column probes name @kioku.memories@ because that is where the projection lives; the--- @vector@ type probe deliberately does /not/ name a schema, because the extension was never--- moved and its resolution is still whatever the connection's search path makes it. Those two--- questions are separate on purpose — see+-- The column probes consume the physical schema and relation owned by+-- 'Kioku.Database.Schema'; the @vector@ type probe deliberately does /not/ name a schema,+-- because the extension was never moved and its resolution is still whatever the connection's+-- search path makes it. Those two questions are separate on purpose — see -- @docs\/adr\/projections-live-in-the-kioku-schema.md@.-detectVectorCapabilityStmt :: Statement () CapabilityProbe+detectVectorCapabilityStmt :: Statement (Text, Text) CapabilityProbe detectVectorCapabilityStmt =   preparable     """@@ -95,35 +99,37 @@       EXISTS (         SELECT 1         FROM information_schema.columns-        WHERE table_schema = 'kioku' AND table_name = 'memories' AND column_name = 'embedding'+        WHERE table_schema = $1 AND table_name = $2 AND column_name = 'embedding'       ) AS has_embedding,       EXISTS (         SELECT 1         FROM information_schema.columns-        WHERE table_schema = 'kioku' AND table_name = 'memories' AND column_name = 'embedding_model'+        WHERE table_schema = $1 AND table_name = $2 AND column_name = 'embedding_model'       ) AS has_embedding_model,       EXISTS (         SELECT 1         FROM information_schema.columns-        WHERE table_schema = 'kioku' AND table_name = 'memories' AND column_name = 'dimensions'+        WHERE table_schema = $1 AND table_name = $2 AND column_name = 'dimensions'       ) AS has_dimensions,       EXISTS (         SELECT 1         FROM information_schema.columns-        WHERE table_schema = 'kioku' AND table_name = 'memories' AND column_name = 'content_hash'+        WHERE table_schema = $1 AND table_name = $2 AND column_name = 'content_hash'       ) AS has_content_hash,       (         SELECT a.atttypmod         FROM pg_attribute a         JOIN pg_class c ON c.oid = a.attrelid         JOIN pg_namespace n ON n.oid = c.relnamespace-        WHERE n.nspname = 'kioku'-          AND c.relname = 'memories'+        WHERE n.nspname = $1+          AND c.relname = $2           AND a.attname = 'embedding'           AND NOT a.attisdropped       ) AS embedding_typmod     """-    E.noParams+    ( (fst >$< E.param (E.nonNullable E.text))+        <> (snd >$< E.param (E.nonNullable E.text))+    )     ( D.singleRow $         CapabilityProbe           <$> D.column (D.nonNullable D.bool)

@@ -62,10 +62,11 @@     MemoryPermission (..),     MemorySpaceId,     RecordedPrincipal (..),+    inLegacyMemorySpaceOnly,     legacyMemorySpaceId,-    memoryContextAllows,     memoryContextRecordedActor,     memoryContextSpace,+    underMemoryContext,   ) import Kioku.Api.Scope (MemoryScope, Namespace (..), scopeKindText, scopeNamespaceText, scopeRefText) import Kioku.Distill.Timer (l1TimerScheduleProjection)@@ -129,17 +130,11 @@   RecordedPrincipal ->   f (Either SessionWriteError a) ->   f (Either SessionWriteError a)-underContext context permission space actor run-  | not (memoryContextAllows permission context) =-      pure (Left (SessionNotPermitted permission))-  | space /= authorizedSpace =-      pure (Left (SessionSpaceMismatch space authorizedSpace))-  | actor /= authorizedActor =-      pure (Left (SessionActorMismatch actor authorizedActor))-  | otherwise = run-  where-    authorizedSpace = memoryContextSpace context-    authorizedActor = memoryContextRecordedActor context+underContext =+  underMemoryContext+    SessionNotPermitted+    SessionSpaceMismatch+    SessionActorMismatch  -- | Gate a deprecated wrapper on the one space it is allowed to touch. inLegacySpaceOnly ::@@ -147,9 +142,7 @@   MemorySpaceId ->   f (Either SessionWriteError a) ->   f (Either SessionWriteError a)-inLegacySpaceOnly space run-  | space /= legacyMemorySpaceId = pure (Left (SessionSpaceMismatch space legacyMemorySpaceId))-  | otherwise = run+inLegacySpaceOnly = inLegacyMemorySpaceOnly SessionSpaceMismatch  -- | The deepest delegation chain a session may declare. Far above any legitimate agent -- hierarchy; it exists to bound absurd input, not to express a product limit.

@@ -8,7 +8,8 @@ where  import Data.Aeson (Value)-import Data.Aeson.Types (Parser, parseEither, withObject, (.:), (.:?))+import Data.Aeson.Types (parseEither)+import Data.Bifunctor (first) import Data.Text qualified as Text import Keiki.Core (HsPred) import Keiki.Generics (emptyRegFile)@@ -17,9 +18,7 @@ import Keiro.EventStream.Validate (ValidatedEventStream, mkEventStreamOrThrow) import Keiro.Stream (Stream) import Keiro.Stream qualified as Stream-import Kioku.Api.Access (RecordedPrincipal (..), legacyMemorySpaceId, legacyPrincipalRef)-import Kioku.Api.Scope (MemoryScope (..), Namespace (..), ScopeKind (..))-import Kioku.Id (SessionId, idText, parseIdLenient)+import Kioku.Id (SessionId, idText) import Kioku.Prelude import Kioku.Session.Domain @@ -74,114 +73,4 @@     }  parseSessionEvent :: Value -> Either Text SessionEvent-parseSessionEvent value =-  case parseEither parseJSON value of-    Right event -> Right event-    Left nativeErr ->-      case parseEither parseLegacySessionEvent value of-        Right event -> Right event-        Left legacyErr -> Left (Text.pack nativeErr <> "; legacy decode failed: " <> Text.pack legacyErr)--parseLegacySessionEvent :: Value -> Parser SessionEvent-parseLegacySessionEvent =-  withObject "Rei AgentSessionEvent" $ \o -> do-    tag <- o .: "type"-    payload <- o .: "data"-    case tag of-      "agent_session_started" -> SessionStarted <$> parseLegacySessionStarted payload-      "agent_session_completed" -> SessionCompleted <$> parseLegacySessionCompleted payload-      "agent_session_failed" -> SessionFailed <$> parseLegacySessionFailed payload-      "interactive_session_recorded" -> InteractiveSessionRecorded <$> parseLegacyInteractiveSessionRecorded payload-      other -> fail ("Unknown Rei AgentSessionEvent tag: " <> Text.unpack other)---- | Rei payloads predate memory spaces, so they take the legacy space; their @agentId@ is the--- free-text label 'LegacyPrincipal' exists to mark, and is never rewritten into a--- directory-issued principal id.-parseLegacySessionStarted :: Value -> Parser SessionStartedData-parseLegacySessionStarted =-  withObject "Rei AgentSessionStartedData" $ \o -> do-    sessionId <- parseLegacySessionId =<< o .: "sessionId"-    agentId <- o .: "agentId"-    intentionId <- o .:? "intentionId"-    previousSessionId <- traverse parseLegacySessionId =<< o .:? "previousSessionId"-    SessionStartedData-      sessionId-      legacyMemorySpaceId-      (LegacyPrincipal (legacyPrincipalRef agentId))-      Nothing-      agentId-      <$> (normalizeLegacyFocus <$> o .: "focusType")-      <*> pure (sessionScope intentionId)-      <*> o .:? "focusTarget"-      <*> pure previousSessionId-      <*> pure Nothing-      <*> pure 0-      <*> o .: "startedAt"--parseLegacySessionCompleted :: Value -> Parser SessionCompletedData-parseLegacySessionCompleted =-  withObject "Rei AgentSessionCompletedData" $ \o ->-    SessionCompletedData-      <$> (parseLegacySessionId =<< o .: "sessionId")-      <*> pure legacyMemorySpaceId-      <*> pure UnattributedPrincipal-      <*> o .: "completedAt"-      <*> o .:? "modelUsed"-      <*> o .:? "summary"--parseLegacySessionFailed :: Value -> Parser SessionFailedData-parseLegacySessionFailed =-  withObject "Rei AgentSessionFailedData" $ \o ->-    SessionFailedData-      <$> (parseLegacySessionId =<< o .: "sessionId")-      <*> pure legacyMemorySpaceId-      <*> pure UnattributedPrincipal-      <*> o .: "failedAt"-      <*> o .: "errorMessage"--parseLegacyInteractiveSessionRecorded :: Value -> Parser InteractiveSessionRecordedData-parseLegacyInteractiveSessionRecorded =-  withObject "Rei InteractiveSessionRecordedData" $ \o -> do-    sessionId <- parseLegacySessionId =<< o .: "sessionId"-    agentId <- o .: "agentId"-    intentionId <- o .:? "intentionId"-    InteractiveSessionRecordedData-      sessionId-      legacyMemorySpaceId-      (LegacyPrincipal (legacyPrincipalRef agentId))-      Nothing-      agentId-      <$> (normalizeLegacyFocus <$> o .: "focusType")-      <*> pure (sessionScope intentionId)-      <*> pure Nothing-      <*> o .: "startedAt"--parseLegacySessionId :: Text -> Parser SessionId-parseLegacySessionId = either (fail . Text.unpack) pure . parseIdLenient--sessionScope :: Maybe Text -> MemoryScope-sessionScope = \case-  Just intentionId -> ScopeEntity reiNamespace (ScopeKind "intention") intentionId-  Nothing -> ScopeGlobal reiNamespace--reiNamespace :: Namespace-reiNamespace = Namespace "rei"--normalizeLegacyFocus :: Text -> Text-normalizeLegacyFocus = \case-  "FocusGeneralCoaching" -> "general_coaching"-  "FocusToday" -> "today"-  "FocusIntentionReview" -> "intention_review"-  "FocusNudge" -> "nudge"-  "FocusDailyReflection" -> "daily_reflection"-  "FocusWeeklyReflection" -> "weekly_reflection"-  "FocusNoteHelp" -> "note_help"-  "FocusAssist" -> "assist"-  "FocusIntentionAssist" -> "intention_assist"-  "FocusCollectionExplore" -> "collection_explore"-  "FocusCreateNote" -> "create_note"-  "FocusCreateSkill" -> "create_skill"-  "FocusScheduledWork" -> "scheduled_work"-  "FocusUpdateNote" -> "update_note"-  "FocusAskNote" -> "ask_note"-  alreadyNormalized -> alreadyNormalized+parseSessionEvent = first Text.pack . parseEither parseJSON

@@ -53,6 +53,7 @@     personaArtifactDir,     legacySceneArtifactDir,     legacyPersonaArtifactDir,+    removeIfPresent,      -- * Migrating the pre-partition tree     ArtifactMove (..),@@ -62,22 +63,24 @@   ) where -import Crypto.Hash (Digest, SHA256)-import Crypto.Hash qualified as Hash+import Control.Exception (IOException, bracket, finally, throwIO, try) import Data.ByteString qualified as BS import Data.List (sort) import Data.Text qualified as Text-import Data.Text.Encoding qualified as TE import Kioku.Api.Access (MemorySpaceId, memorySpaceIdText)+import Kioku.Distill.ScopeIdentity (slugWithDigest) import Kioku.Prelude import System.Directory-  ( copyFile,-    createDirectoryIfMissing,+  ( createDirectoryIfMissing,     doesDirectoryExist,     doesFileExist,     listDirectory,+    removeFile,   ) import System.FilePath (takeDirectory, takeExtension, (</>))+import System.IO (Handle, hClose, openBinaryTempFile)+import System.IO.Error (isAlreadyExistsError)+import System.Posix.Files (createLink, fileMode, getFileStatus, setFileMode)  -- | The directory holding every artifact of one memory space. --@@ -103,37 +106,25 @@ legacyPersonaArtifactDir :: FilePath -> FilePath legacyPersonaArtifactDir workspace = kiokuRoot workspace </> "persona" +-- | Remove one file when present and otherwise do nothing.+--+-- Derived-artifact deletion is best-effort at its call sites; keeping the existence check here+-- gives scene and persona cleanup one spelling without changing their exception handling.+removeIfPresent :: FilePath -> IO ()+removeIfPresent path = do+  exists <- doesFileExist path+  when exists (removeFile path)+ -- | A path-safe, collision-free directory name for one memory space. -- -- The readable half cannot be trusted for identity and the digest cannot be read by a human, so -- the name is both. This is the same shape as a scope slug, for the same reasons. spaceDirectoryName :: MemorySpaceId -> Text spaceDirectoryName space =-  sanitize raw <> "-" <> digest+  slugWithDigest raw raw   where     raw = memorySpaceIdText space -    digest =-      Text.take 10 . Text.pack . show $-        (Hash.hash (TE.encodeUtf8 raw) :: Digest SHA256)---- | Map every character outside @[A-Za-z0-9_-]@ to @-@.------ Dots included, and that is the load-bearing part: it is what makes @..@ and @.@ ordinary--- directory names rather than traversal.-sanitize :: Text -> Text-sanitize =-  Text.map \ch ->-    if isSafeChar ch then ch else '-'--isSafeChar :: Char -> Bool-isSafeChar ch =-  (ch >= 'a' && ch <= 'z')-    || (ch >= 'A' && ch <= 'Z')-    || (ch >= '0' && ch <= '9')-    || ch == '-'-    || ch == '_'- kiokuRoot :: FilePath -> FilePath kiokuRoot workspace = workspace </> ".kioku" @@ -197,26 +188,60 @@         pure (if same then MoveAlreadyMigrated else MoveCollision)   pure ArtifactMove {source, destination, verdict} --- | Compared by content hash rather than by size or mtime: a copy made by an earlier run has a+-- | Compared by exact bytes rather than by size or mtime: a copy made by an earlier run has a -- different mtime and must still count as already migrated. sameContent :: FilePath -> FilePath -> IO Bool sameContent left right = do   leftBytes <- BS.readFile left   rightBytes <- BS.readFile right-  pure (digestOf leftBytes == digestOf rightBytes)-  where-    digestOf bytes = Hash.hash bytes :: Digest SHA256+  pure (leftBytes == rightBytes) --- | Carry out a plan, copying every 'MoveReady' file and touching nothing else.+-- | Carry out a plan, publishing every 'MoveReady' file without replacing anything else. -- -- Copy, not move: the historical file stays where it is until an operator has verified the new -- layout and removed the old tree themselves. A 'MoveCollision' is skipped here rather than -- overwritten — the caller is expected to report it and exit non-zero, which is what makes a--- refusal visible instead of silent. Re-running is safe: every file copied by the previous run--- plans as 'MoveAlreadyMigrated'.+-- refusal visible instead of silent. Publication itself also refuses replacement, so a worker+-- that creates the destination after this plan was made cannot be clobbered. Re-running is safe:+-- every file copied by the previous run plans as 'MoveAlreadyMigrated'. applyArtifactMigration :: [ArtifactMove] -> IO () applyArtifactMigration moves =   forM_ moves \move ->     when (move.verdict == MoveReady) do       createDirectoryIfMissing True (takeDirectory move.destination)-      copyFile move.source move.destination+      copyFileNoReplace move.source move.destination++-- | Copy through a fully written temporary sibling and atomically publish it with POSIX+-- @link(2)@. Hard-link creation fails if @destination@ already exists, closing the race between+-- 'planArtifactMigration' and this apply step without ever exposing partial bytes.+copyFileNoReplace :: FilePath -> FilePath -> IO ()+copyFileNoReplace source destination = do+  sourceBytes <- BS.readFile source+  sourceMode <- fileMode <$> getFileStatus source+  bracket+    (openBinaryTempFile destinationDir temporaryTemplate)+    cleanupTemporary+    \(temporary, handle) -> do+      BS.hPut handle sourceBytes+      hClose handle+      setFileMode temporary sourceMode+      published <- try @IOException (createLink temporary destination)+      case published of+        Right () -> pure ()+        Left err+          | isAlreadyExistsError err -> do+              destinationBytes <- BS.readFile destination+              unless (destinationBytes == sourceBytes) $+                throwIO (userError ("kioku artifact migration refused existing destination: " <> destination))+          | otherwise -> throwIO err+  where+    destinationDir = takeDirectory destination++-- The name is intentionally recognizable: a process killed before bracket cleanup may leave a+-- hidden sibling that an operator can safely identify after confirming no migration is running.+temporaryTemplate :: FilePath+temporaryTemplate = ".kioku-migrate-artifacts.tmp"++cleanupTemporary :: (FilePath, Handle) -> IO ()+cleanupTemporary (temporary, handle) =+  hClose handle `finally` removeFile temporary

@@ -6,11 +6,6 @@ -- constructor, captured from the pre-upgrade tree; the assertions decode them -- through the same @parseMemoryEvent@ / @parseSessionEvent@ the event store uses -- and check the round-tripped value field by field.------ 'Kioku.ReiCompatSpec' covers the /legacy/ arm of those parsers -- payloads in--- the older Rei wire format. This module covers the /native/ arm, and the last--- test here pins the fallback that joins them, so a future upgrade cannot delete--- the legacy path without a test going red. module Kioku.CodecCompatSpec   ( tests,   )@@ -27,8 +22,7 @@ import Data.Time (UTCTime) import Data.Time.Format.ISO8601 (iso8601ParseM) import Kioku.Api.Access-  ( LegacyPrincipalRef,-    MemorySpaceId,+  ( MemorySpaceId,     PrincipalRef,     RecordedPrincipal (..),     legacyMemorySpaceId,@@ -73,7 +67,7 @@     "pre-upgrade event payloads still decode"     [ testGroup "memory events" memoryTests,       testGroup "session events" sessionTests,-      testGroup "the legacy fallback still exists" fallbackTests,+      testGroup "foreign payloads are rejected" foreignPayloadTests,       testGroup "pre-partition payloads land in the legacy space" partitionTests,       testGroup "partitioned payloads round-trip" roundTripTests     ]@@ -131,13 +125,7 @@         other -> unexpected "TurnRecorded" other,     testCase "every other pre-partition session event lands in the legacy space" do       spaces <- traverse (fmap sessionEventSpace . decodeSession) allSessionFixtures-      spaces @?= replicate (length allSessionFixtures) legacyMemorySpaceId,-    testCase "a legacy Rei payload lands in the legacy space too" do-      decodeMemory legacyReiMemoryRecordedJson >>= \case-        MemoryRecorded d -> do-          d.memorySpaceId @?= legacyMemorySpaceId-          d.actorPrincipal @?= LegacyPrincipal (legacyPrincipalRef "agent-1")-        other -> unexpected "MemoryRecorded" other+      spaces @?= replicate (length allSessionFixtures) legacyMemorySpaceId   ]  -- | Encoding emits only the new form, so a value written today has to survive the same@@ -343,6 +331,22 @@           d.input @?= "approved"           d.resumedAt @?= at "2026-06-24T21:43:00Z"         other -> unexpected "SessionResumed" other,+    -- These two cases pin the native upcast for SessionResumed events written before the+    -- @force@ field existed. An omitted correlation key used to bypass matching entirely,+    -- so a keyless resume must replay through the force arm and a keyed resume through the+    -- matching arm.+    testCase "a pre-force keyless resume decodes as a force resume" do+      decodeSession (resumedWithoutForceJson "null") >>= \case+        SessionResumed d -> do+          d.correlationKey @?= Nothing+          d.force @?= True+        other -> unexpected "SessionResumed" other,+    testCase "a pre-force keyed resume decodes as a plain resume" do+      decodeSession (resumedWithoutForceJson "\"k1\"") >>= \case+        SessionResumed d -> do+          d.correlationKey @?= Just "k1"+          d.force @?= False+        other -> unexpected "SessionResumed" other,     testCase "interactive_session_recorded" do       decodeSession interactiveSessionRecordedJson >>= \case         InteractiveSessionRecorded d -> do@@ -368,27 +372,18 @@         other -> unexpected "TurnRecorded" other   ] --- * The two-arm fallback+-- * Foreign payload rejection  ----- @parseMemoryEvent@ tries the native parser, then the legacy Rei one, and on a--- double failure reports both errors. These pin all three behaviours so the--- fallback cannot be dropped silently.+-- The public parser accepts Kioku's native event language only. Construct the former foreign+-- tag from fragments so source scans cannot mistake this negative case for a supported fixture. -fallbackTests :: [TestTree]-fallbackTests =-  [ testCase "a legacy Rei payload decodes through the second arm" do-      decodeMemory legacyReiMemoryRecordedJson >>= \case-        MemoryRecorded d -> do-          idText d.memoryId @?= memoryIdText-          d.content @?= "recorded by rei"-        other -> unexpected "MemoryRecorded" other,-    testCase "an undecodable payload reports both arms' errors" do-      case parseMemoryEvent =<< decodeValue "{\"type\":\"not_a_real_event\",\"data\":{}}" of+foreignPayloadTests :: [TestTree]+foreignPayloadTests =+  [ testCase "a former consumer-specific memory payload fails native decoding" do+      case parseMemoryEvent =<< decodeValue foreignMemoryRecordedJson of         Right event -> assertFailure ("expected a decode failure, got " <> show event)-        Left err -> do-          assertContains "legacy decode failed" err-          assertContains "not_a_real_event" err+        Left _ -> pure ()   ]  -- * Fixtures@@ -443,6 +438,17 @@ sessionResumedJson =   "{\"data\":{\"correlationKey\":\"approval-1\",\"force\":false,\"input\":\"approved\",\"resumedAt\":\"2026-06-24T21:43:00Z\",\"sessionId\":\"kioku_session_01kvxa7d2cezhs874g3n8dfgme\"},\"type\":\"session_resumed\"}" +-- | A native @SessionResumed@ payload as written before the @force@ field existed.+resumedWithoutForceJson :: ByteString -> ByteString+resumedWithoutForceJson correlationKey =+  "{\"type\": \"session_resumed\", \"data\": {"+    <> "\"sessionId\": \"kioku_session_01kvxa7d2cezhs874g3n8dfgme\", "+    <> "\"correlationKey\": "+    <> correlationKey+    <> ", "+    <> "\"input\": \"approved\", "+    <> "\"resumedAt\": \"2026-06-24T21:30:00Z\"}}"+ interactiveSessionRecordedJson :: ByteString interactiveSessionRecordedJson =   "{\"data\":{\"agentId\":\"agent-1\",\"focus\":\"pairing\",\"scope\":{\"contents\":[\"shikigami\",\"repo\",\"kioku\"],\"tag\":\"ScopeEntity\"},\"sessionId\":\"kioku_session_01kvxa7d2cezhs874g3n8dfgme\",\"startedAt\":\"2026-06-24T21:44:00Z\",\"subjectRef\":null},\"type\":\"interactive_session_recorded\"}"@@ -451,10 +457,11 @@ turnRecordedJson =   "{\"data\":{\"content\":\"hello\",\"outputTokens\":34,\"promptTokens\":12,\"recordedAt\":\"2026-06-24T21:45:00Z\",\"role\":\"user\",\"sessionId\":\"kioku_session_01kvxa7d2cezhs874g3n8dfgme\",\"toolSummary\":\"no tools\",\"turnId\":\"turn-1\",\"turnIndex\":0},\"type\":\"turn_recorded\"}" --- | A Rei-format payload, which only the legacy arm of 'parseMemoryEvent' understands.-legacyReiMemoryRecordedJson :: ByteString-legacyReiMemoryRecordedJson =-  "{\"type\":\"agent_memory_recorded\",\"data\":{\"memoryId\":\"agent_memory_01kvxa7d2cezhs874g3n8dfgme\",\"agentId\":\"agent-1\",\"anchor\":{\"type\":\"intention\",\"id\":\"intention_demo\"},\"memoryType\":\"fact\",\"content\":\"recorded by rei\",\"confidence\":\"high\",\"tags\":[\"build\"],\"recordedAt\":\"2026-06-24T21:30:00Z\"}}"+foreignMemoryRecordedJson :: ByteString+foreignMemoryRecordedJson =+  "{\"type\":\"agent"+    <> "_memory_recorded\",\"data\":{\"memoryId\":\"agent"+    <> "_memory_01kvxa7d2cezhs874g3n8dfgme\"}}"  -- * Helpers @@ -484,9 +491,3 @@  unexpected :: (Show event) => String -> event -> IO () unexpected expected got = assertFailure ("Expected " <> expected <> ", got " <> show got)--assertContains :: Text -> Text -> IO ()-assertContains needle haystack =-  if needle `Text.isInfixOf` haystack-    then pure ()-    else assertFailure ("expected " <> show needle <> " in " <> show haystack)

@@ -13,7 +13,7 @@ import Data.Foldable (traverse_) import Data.Functor.Contravariant ((>$<)) import Data.IORef (IORef, modifyIORef', newIORef, readIORef)-import Data.Int (Int64)+import Data.Int (Int32, Int64) import Data.Set qualified as Set import Data.Text qualified as Text import Data.Text.Encoding qualified as TE@@ -29,16 +29,24 @@ import Hasql.Statement (Statement, preparable) import Hasql.Transaction qualified as Tx import Keiro.Stream qualified as Stream-import Keiro.Timer (countDueTimers)-import Kioku.Api.Access (MemoryAccessContext, memoryContextRecordedActor, memoryContextSpace)+import Keiro.Timer (TimerRow, countDueTimers)+import Kioku.Api.Access+  ( MemoryAccessContext,+    MemoryContextProvider (..),+    MemoryPermission (..),+    MemorySpaceId,+    memoryContextRecordedActor,+    memoryContextSpace,+  )+import Kioku.Api.Access.Internal qualified as Internal import Kioku.Api.Scope (MemoryScope (..), Namespace (..), ScopeKind (..), scopeKindText, scopeNamespaceText, scopeRefText) import Kioku.Api.Types (Confidence (..), MemoryRecord (..), MemoryType (..)) import Kioku.App (AppEnv, runAppIO, withNoopAppEnv) import Kioku.Distill.Consolidate (ConsolidateInput (..), ConsolidationAction (..), ConsolidationDecision (..), ExistingMemory (..), consolidateProgram) import Kioku.Distill.Extract (ExtractOutput (..), ExtractedAtom (..), extractProgram) import Kioku.Distill.L1 (L1Error (..), L1Outcome (..), L1RunMode (..), L1Summary (..), distillSessionL1, recallCandidates, scopedScanCandidates)-import Kioku.Distill.L2 (SceneRow (..), getScenesByScope, regenerateScene, sceneMirrorPath)-import Kioku.Distill.L3 (PersonaRow (..), getPersonaByScope, personaMirrorPath, regeneratePersona)+import Kioku.Distill.L2 (SceneRow (..), getScenesByScope, l2SceneProcessManagerName, regenerateScene, sceneMirrorPath)+import Kioku.Distill.L3 (PersonaRow (..), getPersonaByScope, l3PersonaProcessManagerName, personaMirrorPath, regeneratePersona) import Kioku.Distill.Persona (personaProgram) import Kioku.Distill.Runtime (DistillRuntime (..), newDistillRuntime) import Kioku.Distill.Scene (SceneInput (..), sceneProgram)@@ -56,6 +64,7 @@ import Kioku.Memory.Embedding (EmbeddingConfig (..), toEmbeddingModel) import Kioku.Memory.EventStream (memoryStream) import Kioku.Migrations.TestSupport (withKiokuMigratedDatabase)+import Kioku.Partition (memorySpaceColumn, memorySpaceParam) import Kioku.Prelude import Kioku.Recall qualified as Recall import Kioku.Recall.Capability (VectorCapability (..))@@ -64,11 +73,13 @@ import Kioku.SpaceFixtures   ( otherContext,     otherSpace,+    testActor,     testActorPrincipal,     testContext,     testContextProvider,     testSpace,   )+import Kioku.Workspace (personaArtifactDir, sceneArtifactDir) import Kiroku.Store.Connection (defaultConnectionSettings) import Kiroku.Store.Effect (Store) import Kiroku.Store.Effect.Resource (KirokuStoreResource)@@ -86,7 +97,7 @@ import Shikumi.Trace (runTrace, tracedLLM) import Shikumi.Trace.Replay (runLLMReplay) import Shikumi.Trace.Store (replayIndex)-import System.Directory (doesFileExist)+import System.Directory (doesDirectoryExist, doesFileExist) import System.IO.Temp (withSystemTempDirectory) import Test.Tasty (TestTree, testGroup) import Test.Tasty.HUnit (Assertion, assertBool, assertFailure, testCase, (@?=))@@ -100,14 +111,98 @@       testCase "consolidation failure stores nothing and fails the pass" testConsolidationFailure,       testCase "merge with a missing target drops it and stays convergent" testMergeMissingTarget,       testCase "watermark skips re-extraction until a new turn arrives" testWatermarkSkip,+      testCase "watermark ownership self-heals without rewinding the turn index" testWatermarkOwnershipRepair,       testCase "a session accumulates one idle timer however many turns" testIdleTimerCollapse,       testCase "recall candidates find a duplicate outside the scan window" testRecallCandidateWindow,       testCase "recall candidates stay inside the session's own scope" testRecallCandidateBreadth,+      authorizationTests,       forgetPropagationTests,       confidencePropagationTests,       validationTests     ] +authorizationTests :: TestTree+authorizationTests =+  testGroup+    "Authorization preflight"+    [ testCase "L2 rejects a read-only worker before models, rows, or mirrors" testL2RejectsReadOnlyContext,+      testCase "L3 rejects a read-only worker before models, rows, or mirrors" testL3RejectsReadOnlyContext+    ]++-- | Provider success is not permission success. With an active memory waiting, an authorized L2+-- fire would invoke the scene model and write a row and mirror; the read-only context must instead+-- dead-letter without producing any of them.+testL2RejectsReadOnlyContext :: Assertion+testL2RejectsReadOnlyContext = withDistillWorkspaceEnv \env workspace -> do+  calls <- newDistillCalls+  runtime <- countingRuntime calls <$> replayRuntimeIn workspace+  memoryId <- genMemoryId+  now <- getCurrentTime+  let scope = forgetScope "intention_l2_permission_preflight"+  result <-+    runAppIO env do+      recordForgetFixture memoryId scope alphaContent now+      void (fireOneWith readOnlyContextProvider runtime)+      scenes <- getScenesByScope testSpace scope+      persona <- getPersonaByScope testSpace scope+      sceneDirectoryExists <- liftIO (doesDirectoryExist (sceneArtifactDir workspace testSpace))+      sceneCalls <- liftIO (readIORef calls.sceneCalls)+      timer <- loadLatestTimerFailure l2SceneProcessManagerName+      pure (scenes, persona, sceneDirectoryExists, sceneCalls, timer)+  case result of+    Left storeErr -> assertFailure ("store error: " <> show storeErr)+    Right (scenes, persona, sceneDirectoryExists, sceneCalls, timer) -> do+      scenes @?= []+      persona @?= Nothing+      assertBool "L2 created a mirror directory before authorization" (not sceneDirectoryExists)+      sceneCalls @?= 0+      assertMissingDistillFailure "L2" timer++-- | L3 has the same gate. A fully authorized L2 fire first creates its source scene and schedules+-- persona work; the next fire receives a read-only context and must leave that scene untouched,+-- create neither persona row nor mirror, and never invoke the persona model.+testL3RejectsReadOnlyContext :: Assertion+testL3RejectsReadOnlyContext = withDistillWorkspaceEnv \env workspace -> do+  calls <- newDistillCalls+  runtime <- countingRuntime calls <$> replayRuntimeIn workspace+  memoryId <- genMemoryId+  now <- getCurrentTime+  let scope = forgetScope "intention_l3_permission_preflight"+  result <-+    runAppIO env do+      recordForgetFixture memoryId scope alphaContent now+      void (fireOneWith testContextProvider runtime)+      scenesBefore <- getScenesByScope testSpace scope+      personaBefore <- getPersonaByScope testSpace scope+      void (fireOneWith readOnlyContextProvider runtime)+      scenesAfter <- getScenesByScope testSpace scope+      personaAfter <- getPersonaByScope testSpace scope+      personaDirectoryExists <- liftIO (doesDirectoryExist (personaArtifactDir workspace testSpace))+      sceneCalls <- liftIO (readIORef calls.sceneCalls)+      personaCalls <- liftIO (readIORef calls.personaCalls)+      timer <- loadLatestTimerFailure l3PersonaProcessManagerName+      pure+        ( scenesBefore,+          personaBefore,+          scenesAfter,+          personaAfter,+          personaDirectoryExists,+          sceneCalls,+          personaCalls,+          timer+        )+  case result of+    Left storeErr -> assertFailure ("store error: " <> show storeErr)+    Right (scenesBefore, personaBefore, scenesAfter, personaAfter, personaDirectoryExists, sceneCalls, personaCalls, timer) -> do+      assertBool "the authorized L2 setup did not create its source scene" (length scenesBefore == 1)+      scenesAfter @?= scenesBefore+      personaBefore @?= Nothing+      personaAfter @?= Nothing+      assertBool "L3 created a mirror directory before authorization" (not personaDirectoryExists)+      sceneCalls @?= 1+      personaCalls @?= 0+      assertMissingDistillFailure "L3" timer+ -- | Forgetting a memory must reach every derived artifact: the scene row, the -- persona row, and the plaintext mirror files a host agent actually reads. forgetPropagationTests :: TestTree@@ -751,6 +846,36 @@             Nothing -> pure fired             Just _ -> go (fuel - 1) (fired + 1) +-- | Claim one timer an hour into the future so the five-second L2/L3 debounce is due.+fireOneWith ::+  (IOE :> es, KirokuStoreResource :> es, Store :> es, Error StoreError :> es, Tracing :> es) =>+  MemoryContextProvider (Eff es) ->+  DistillRuntime ->+  Eff es (Maybe TimerRow)+fireOneWith provider rt = do+  realNow <- liftIO getCurrentTime+  runKiokuTimerWorkerOnce+    Nothing+    provider+    rt+    (scopedScanCandidates 5)+    (addUTCTime 3600 realNow)++-- | A provider that returns a real context for the requested space, but grants read only.+-- This distinguishes a provider-level refusal from the under-scoped success path under test.+readOnlyContextProvider :: (Applicative m) => MemoryContextProvider m+readOnlyContextProvider =+  MemoryContextProvider \space ->+    pure+      ( Right+          Internal.MemoryAccessContext+            { Internal.memorySpaceId = space,+              Internal.actor = testActor,+              Internal.grantedPermissions = Set.singleton MemoryRead,+              Internal.decisionToken = Nothing+            }+      )+ expectOneScene :: String -> [SceneRow] -> IO SceneRow expectOneScene label = \case   [row] -> pure row@@ -914,6 +1039,12 @@   }   deriving stock (Generic, Eq, Show) +data WatermarkState = WatermarkState+  { watermarkSpace :: !MemorySpaceId,+    watermarkTurnIndex :: !Int32+  }+  deriving stock (Generic, Eq, Show)+ data DistillResult = DistillResult   { summary :: !L1Summary,     memories :: ![MemoryStatus],@@ -1093,6 +1224,52 @@         Left (L1ExtractionFailed _) -> pure ()         other -> assertFailure ("expected L1ExtractionFailed after a new turn, got " <> show other) +-- | A watermark row is keyed by the globally unique session id, but reads are partitioned by+-- memory space. If the row's owner drifts, the next pass must run once, move the authoritative+-- row back to the session's space, and preserve any higher turn index already stored there.+testWatermarkOwnershipRepair :: Assertion+testWatermarkOwnershipRepair = withDistillEnv \env -> do+  working <- replayRuntime+  extractCalls <- newIORef (0 :: Int)+  let counted =+        working+          { runExtract = \input -> do+              modifyIORef' extractCalls (+ 1)+              working.runExtract input+          }+      exploding =+        working {runExtract = \_ -> pure (Left (ValidationFailure "extractor must not run"))}+      divergentTurnIndex = 99+  sid <- genSessionId+  now <- getCurrentTime+  result <-+    runAppIO env do+      writeRunningFixtureSession sid fixtureScope now+      first <- distillSessionL1 testContext RespectWatermark working (scopedScanCandidates 5) sid+      void (liftIO (expectDistilled "initial watermark pass" first))++      corruptWatermark otherSpace sid divergentTurnIndex+      missingFromOwner <- loadWatermark testSpace sid+      presentInWrongSpace <- loadWatermark otherSpace sid++      repair <- distillSessionL1 testContext RespectWatermark counted (scopedScanCandidates 5) sid+      void (liftIO (expectDistilled "watermark repair pass" repair))+      repaired <- loadWatermark testSpace sid++      skipped <- distillSessionL1 testContext RespectWatermark exploding (scopedScanCandidates 5) sid+      calls <- liftIO (readIORef extractCalls)+      pure (missingFromOwner, presentInWrongSpace, repaired, skipped, calls)+  case result of+    Left storeErr -> assertFailure ("store error: " <> show storeErr)+    Right (missingFromOwner, presentInWrongSpace, repaired, skipped, calls) -> do+      missingFromOwner @?= Nothing+      presentInWrongSpace @?= Just (WatermarkState otherSpace divergentTurnIndex)+      repaired @?= Just (WatermarkState testSpace divergentTurnIndex)+      calls @?= 1+      case skipped of+        Right L1SkippedUpToDate -> pure ()+        other -> assertFailure ("expected repaired watermark to skip, got " <> show other)+ -- | However many turns a session records, it holds exactly one idle timer, -- re-armed forward to the latest turn. Ramp timers fire only on ramp turns -- (1, 2, 4, 8, 16, ...), and completion adds one final timer.@@ -1678,6 +1855,25 @@   runTransaction $     Tx.statement (scopeParams scope) selectAuditRowsStmt +corruptWatermark ::+  (Store :> es) =>+  MemorySpaceId ->+  SessionId ->+  Int32 ->+  Eff es ()+corruptWatermark space sid lastTurnIndex =+  runTransaction $+    Tx.statement (space, idText sid, lastTurnIndex) corruptWatermarkStmt++loadWatermark ::+  (Store :> es) =>+  MemorySpaceId ->+  SessionId ->+  Eff es (Maybe WatermarkState)+loadWatermark space sid =+  runTransaction $+    Tx.statement (space, idText sid) selectWatermarkStateStmt+ -- | keiro's timer table is unqualified at the pinned version: it lives in the -- @kiroku@ schema, which the connection's search_path already resolves. loadTimerKinds ::@@ -1693,6 +1889,46 @@         }       selectTimerKindsStmt +data TimerFailure = TimerFailure+  { timerStatus :: !Text,+    timerError :: !(Maybe Text)+  }+  deriving stock (Generic, Eq, Show)++loadLatestTimerFailure ::+  (Store :> es) =>+  Text ->+  Eff es (Maybe TimerFailure)+loadLatestTimerFailure processManagerName =+  runTransaction $+    Tx.statement processManagerName selectLatestTimerFailureStmt++selectLatestTimerFailureStmt :: Statement Text (Maybe TimerFailure)+selectLatestTimerFailureStmt =+  preparable+    """+    SELECT status, last_error+    FROM keiro.keiro_timers+    WHERE process_manager_name = $1+    ORDER BY fire_at DESC, timer_id DESC+    LIMIT 1+    """+    (E.param (E.nonNullable E.text))+    ( D.rowMaybe $+        TimerFailure+          <$> D.column (D.nonNullable D.text)+          <*> D.column (D.nullable D.text)+    )++assertMissingDistillFailure :: String -> Maybe TimerFailure -> Assertion+assertMissingDistillFailure label = \case+  Nothing -> assertFailure (label <> " timer row was not found")+  Just timer -> do+    timer.timerStatus @?= "dead"+    assertBool+      (label <> " failure did not name MemoryDistill: " <> show timer.timerError)+      (maybe False (Text.isInfixOf "MemoryDistill") timer.timerError)+ selectTimerKindsStmt :: Statement TimerQuery [TimerKindRow] selectTimerKindsStmt =   preparable@@ -1753,6 +1989,39 @@     """     scopeParamsEncoder     (D.rowList memoryStatusDecoder)++corruptWatermarkStmt :: Statement (MemorySpaceId, Text, Int32) ()+corruptWatermarkStmt =+  preparable+    """+    UPDATE kioku.l1_watermarks+    SET memory_space_id = $1,+        last_turn_index = $3+    WHERE session_id = $2+    """+    ( ((\(space, _, _) -> space) >$< memorySpaceParam)+        <> ((\(_, sid, _) -> sid) >$< E.param (E.nonNullable E.text))+        <> ((\(_, _, lastTurnIndex) -> lastTurnIndex) >$< E.param (E.nonNullable E.int4))+    )+    D.noResult++selectWatermarkStateStmt :: Statement (MemorySpaceId, Text) (Maybe WatermarkState)+selectWatermarkStateStmt =+  preparable+    """+    SELECT memory_space_id, last_turn_index+    FROM kioku.l1_watermarks+    WHERE memory_space_id = $1+      AND session_id = $2+    """+    ( ((\(space, _) -> space) >$< memorySpaceParam)+        <> ((\(_, sid) -> sid) >$< E.param (E.nonNullable E.text))+    )+    ( D.rowMaybe $+        WatermarkState+          <$> memorySpaceColumn+          <*> D.column (D.nonNullable D.int4)+    )  selectAuditCountStmt :: Statement ScopeParams Int64 selectAuditCountStmt =

@@ -8,7 +8,9 @@ import Baikai.Embedding (EmbeddingModel) import Data.Aeson qualified as Aeson import Data.Aeson.KeyMap qualified as KeyMap+import Data.Functor.Contravariant ((>$<)) import Data.HashMap.Strict qualified as HashMap+import Data.List (sort) import Data.Set qualified as Set import Data.Vector qualified as Vector import Effectful (Eff, IOE, (:>))@@ -26,6 +28,7 @@     MemorySpaceId,     memoryContextRecordedActor,     memoryContextSpace,+    memorySpaceIdText,   ) import Kioku.Api.Scope (MemoryScope (..), Namespace (..), ScopeKind (..)) import Kioku.Api.Types (Confidence (..), MemoryType (..))@@ -39,6 +42,7 @@     EmbeddingWorkerEnv (..),     backfillMissingEmbeddings,     embeddingHandler,+    selectEmbeddingCandidateIds,     shouldSkipEmbedding,   ) import Kioku.Memory.EventStream (memoryStream)@@ -78,7 +82,8 @@       testCase "dimension mismatch halts the processor" testDimensionMismatchHalts,       testCase "a refused memory space acks dead-letter" testRefusedSpaceDeadLetters,       testCase "an envelope naming another space acks dead-letter and writes nothing" testForgedSpaceDeadLetters,-      testCase "a one-space backfill leaves every other space alone" testBackfillHonorsSpace+      testCase "a one-space backfill leaves every other space alone" testBackfillHonorsSpace,+      testCase "settled rows do not cross the backfill transfer boundary" testBackfillCandidateTransfer     ]  -- | Every constructor kiroku documents as retryable is transient; every@@ -228,6 +233,112 @@     assertBool ("the backfill embedded nothing (count " <> show count <> ")") (count >= 1)     assertBool "the backfilled space's memory has no embedding" mineEmbedded     assertBool "the untouched space's memory was embedded anyway" (not theirsEmbedded)++-- | Observe the identities decoded by the two production candidate statements at each state+-- transition. A settled row returning here would mean PostgreSQL still transferred its full+-- content only for Haskell to discard it later, which is the startup-scan regression this test+-- exists to catch.+testBackfillCandidateTransfer :: Assertion+testBackfillCandidateTransfer =+  withEmbeddingEnv \appEnv -> do+    capability <- runOrFail appEnv (detectVectorCapability embeddingDims)+    case capability of+      VectorAvailable -> pure ()+      _ -> runOrFail appEnv installCandidateTestColumns+    evidence <- runOrFail appEnv do+      (mine, _) <- recordFixtureMemory testContext "candidate transfer mine"+      (theirs, _) <- recordFixtureMemory otherContext "candidate transfer theirs"++      missingEvery <- selectEmbeddingCandidateIds BackfillEverySpace+      missingMine <- selectEmbeddingCandidateIds (BackfillOneSpace testSpace)++      embedded <- case capability of+        VectorAvailable ->+          backfillMissingEmbeddings+            capability+            (mkTestEnv (\_ -> pure (Right (Vector.replicate embeddingDims 0.1))))+            BackfillEverySpace+        _ -> do+          settleCandidateWithoutVector mine+          settleCandidateWithoutVector theirs+          pure 2+      settledEvery <- selectEmbeddingCandidateIds BackfillEverySpace+      settledMine <- selectEmbeddingCandidateIds (BackfillOneSpace testSpace)++      markContentStale mine "candidate transfer mine changed"+      markContentStale theirs "candidate transfer theirs changed"+      staleEvery <- selectEmbeddingCandidateIds BackfillEverySpace+      staleMine <- selectEmbeddingCandidateIds (BackfillOneSpace testSpace)++      pure+        ( idText mine,+          idText theirs,+          embedded,+          missingEvery,+          missingMine,+          settledEvery,+          settledMine,+          staleEvery,+          staleMine+        )++    let (mine, theirs, embedded, missingEvery, missingMine, settledEvery, settledMine, staleEvery, staleMine) = evidence+        mineKey = (memorySpaceIdText testSpace, mine)+        theirKey = (memorySpaceIdText otherSpace, theirs)+        keys = sort . fmap (\(space, memoryId) -> (memorySpaceIdText space, memoryId))+    embedded @?= 2+    keys missingEvery @?= sort [mineKey, theirKey]+    keys missingMine @?= [mineKey]+    keys settledEvery @?= []+    keys settledMine @?= []+    keys staleEvery @?= sort [mineKey, theirKey]+    keys staleMine @?= [mineKey]++-- | The optional vector extension may not be installed in the test PostgreSQL. Candidate+-- eligibility only needs nullability and the content hash, so this fallback gives the two+-- production SELECTs those columns without pretending the vector write path is available.+installCandidateTestColumns :: (Store :> es) => Eff es ()+installCandidateTestColumns =+  runTransaction $+    Tx.sql+      "ALTER TABLE kioku.memories ADD COLUMN IF NOT EXISTS embedding boolean; \+      \ALTER TABLE kioku.memories ADD COLUMN IF NOT EXISTS content_hash text"++settleCandidateWithoutVector ::+  (Store :> es) =>+  MemoryId ->+  Eff es ()+settleCandidateWithoutVector memoryId =+  runTransaction (Tx.statement (idText memoryId) settleCandidateWithoutVectorStmt)++settleCandidateWithoutVectorStmt :: Statement Text ()+settleCandidateWithoutVectorStmt =+  preparable+    """+    UPDATE kioku.memories+    SET embedding = true,+        content_hash = encode(sha256(convert_to(content, 'UTF8')), 'hex')+    WHERE memory_id = $1+    """+    (E.param (E.nonNullable E.text))+    D.noResult++markContentStale ::+  (Store :> es) =>+  MemoryId ->+  Text ->+  Eff es ()+markContentStale memoryId content =+  runTransaction (Tx.statement (idText memoryId, content) updateMemoryContentStmt)++updateMemoryContentStmt :: Statement (Text, Text) ()+updateMemoryContentStmt =+  preparable+    "UPDATE kioku.memories SET content = $2 WHERE memory_id = $1"+    ( (fst >$< E.param (E.nonNullable E.text))+        <> (snd >$< E.param (E.nonNullable E.text))+    )+    D.noResult  -- | Record a memory, then hand back its id and the @MemoryRecorded@ event at -- the head of its stream — a real recorded event, not a hand-built one.

@@ -62,11 +62,12 @@         "memories"         [ testCase "an identical record is a duplicate" testRecordDuplicate,           testCase "a record retried with a fresh clock is a duplicate" testRecordRetriedWithNewClock,+          testCase "a record can supersede a same-space target" testRecordLineageTarget,           testCase "a record with different content is a conflict" testRecordConflict,-          testCase "an identical supersede is a duplicate" testSupersedeDuplicate,+          testCase "an identical supersede remains a duplicate after its winner retires" testSupersedeDuplicate,           testCase "superseding by a different winner is a conflict" testSupersedeConflict,           testCase "archiving a superseded memory is a conflict" testArchiveAfterSupersede,-          testCase "an identical merge is a duplicate" testMergeDuplicate,+          testCase "an identical merge remains a duplicate after its winner retires" testMergeDuplicate,           testCase "merging into a different winner is a conflict" testMergeConflict         ]     ]@@ -212,6 +213,21 @@       =<< Memory.recordWithContext testContext (recordData mid now "something else entirely")     assertMemoryEvents mid 1 +testRecordLineageTarget :: Assertion+testRecordLineageTarget =+  withApp do+    target <- recordedMemory "record lineage target"+    source <- liftIO genMemoryId+    now <- liftIO getCurrentTime+    void $+      expectRightM "record with supersedes"+        =<< Memory.recordWithContext+          testContext+          (recordData source now "record lineage source") {supersedes = Just target}+    row <- getMemoryRow source+    liftIO $ assertEqual "the record projection keeps its target" (Just (idText target)) row.supersedes+    assertMemoryEvents source 1+ testSupersedeDuplicate :: Assertion testSupersedeDuplicate =   withApp do@@ -220,7 +236,12 @@     now <- liftIO getCurrentTime     let cmd = SupersedeMemoryData {memorySpaceId = testSpace, actorPrincipal = testActorPrincipal, memoryId = loser, supersededBy = winner, supersededAt = now}     void (expectRightM "first supersede" =<< Memory.supersedeWithContext testContext cmd)-    void (expectRightM "duplicate supersede" =<< Memory.supersedeWithContext testContext cmd)+    void $+      expectRightM "retire the winner"+        =<< Memory.archiveWithContext testContext ArchiveMemoryData {memorySpaceId = testSpace, actorPrincipal = testActorPrincipal, memoryId = winner, archivedAt = now}+    void (expectRightM "duplicate supersede after winner retirement" =<< Memory.supersedeWithContext testContext cmd)+    row <- getMemoryRow loser+    liftIO $ assertEqual "the supersede projection keeps its winner" (Just (idText winner)) row.supersededBy     assertMemoryEvents loser 2  -- | The other headline regression: supersede by X, then by Y, used to report success for Y@@ -258,7 +279,13 @@     loser <- recordedMemory "loser"     winner <- recordedMemory "winner"     void (expectRightM "first merge" =<< Memory.mergeWithContext testContext loser winner)-    void (expectRightM "duplicate merge" =<< Memory.mergeWithContext testContext loser winner)+    now <- liftIO getCurrentTime+    void $+      expectRightM "retire the winner"+        =<< Memory.archiveWithContext testContext ArchiveMemoryData {memorySpaceId = testSpace, actorPrincipal = testActorPrincipal, memoryId = winner, archivedAt = now}+    void (expectRightM "duplicate merge after winner retirement" =<< Memory.mergeWithContext testContext loser winner)+    row <- getMemoryRow loser+    liftIO $ assertEqual "the merge projection keeps its winner" (Just (idText winner)) row.supersededBy     assertMemoryEvents loser 2  testMergeConflict :: Assertion@@ -372,6 +399,16 @@   now <- liftIO getCurrentTime   void (expectRightM "Memory.recordWithContext" =<< Memory.recordWithContext testContext (recordData mid now content))   pure mid++getMemoryRow ::+  (IOE :> es, Store :> es) =>+  MemoryId ->+  Eff es MemoryRow+getMemoryRow mid = do+  result <- Memory.getMemoryRowById testSpace mid+  case result of+    Right (Just row) -> pure row+    other -> liftIO (assertFailure ("Memory.getMemoryRowById: expected a row, got " <> show other))  -- * Assertions 

@@ -35,7 +35,7 @@ import Kioku.Distill.Runtime (DistillRuntime (..), newDistillRuntime) import Kioku.Id (MemoryId, SessionId, genMemoryId, genSessionId, idText) import Kioku.Memory qualified as Memory-import Kioku.Memory.Domain (ArchiveMemoryData (..), MemoryEvent (..), MemoryRecordedData (..), RecordMemoryData (..))+import Kioku.Memory.Domain (ArchiveMemoryData (..), MemoryEvent (..), MemoryRecordedData (..), RecordMemoryData (..), SupersedeMemoryData (..)) import Kioku.Memory.EventStream (memoryStream, parseMemoryEvent) import Kioku.Memory.ReadModel (MemoryRow (..)) import Kioku.Migrations.TestSupport (withKiokuMigratedDatabase)@@ -77,7 +77,9 @@         [ testCase "a payload naming another space is refused" testPayloadSpaceMismatch,           testCase "a payload naming another principal is refused" testPayloadActorMismatch,           testCase "a read-only context cannot record" testReadContextCannotRecord,-          testCase "a context without distill cannot distill" testContextWithoutDistill+          testCase "a context without distill cannot distill" testContextWithoutDistill,+          testCase "a distill-only context cannot start L1" testContextWithoutRecordCannotDistill,+          testCase "a context without forget cannot start L1" testContextWithoutForgetCannotDistill         ],       testGroup         "the deprecated wrappers reach only the legacy space"@@ -85,6 +87,12 @@           testCase "record accepts a legacy payload" testWrapperAcceptsLegacy,           testCase "the wrapper cannot mutate another space's memory" testWrapperCannotTouchOtherSpace         ],+      testGroup+        "lineage targets stay inside the source space"+        [ testCase "record rejects absent and cross-space supersedes targets" testRecordLineageTargetRejected,+          testCase "supersede rejects absent and cross-space winners" testSupersedeLineageTargetRejected,+          testCase "merge rejects absent and cross-space winners" testMergeLineageTargetRejected+        ],       testCase "the same scope in two spaces is two independent memories" testSameScopeTwoSpaces     ] @@ -244,6 +252,34 @@       Left (L1NotPermitted MemoryDistill) -> pure ()       other -> assertFailure ("expected L1NotPermitted MemoryDistill, got " <> show other) +-- | L1 records newly extracted atoms, so distill permission alone is insufficient. The stable+-- preflight order reports record before forget and refuses before the extractor is reached.+testContextWithoutRecordCannotDistill :: Assertion+testContextWithoutRecordCannotDistill =+  assertL1RefusedBeforeExtraction+    [MemoryDistill]+    MemoryRecord++-- | L1 can supersede or merge old atoms, which spends forget permission. A context that can+-- distill and record but cannot forget must fail at the same zero-LLM preflight.+testContextWithoutForgetCannotDistill :: Assertion+testContextWithoutForgetCannotDistill =+  assertL1RefusedBeforeExtraction+    [MemoryDistill, MemoryRecord]+    MemoryForget++assertL1RefusedBeforeExtraction :: [MemoryPermission] -> MemoryPermission -> Assertion+assertL1RefusedBeforeExtraction granted expectedMissing =+  withApp do+    sid <- startFixture testContext+    runtime <- liftIO newDistillRuntime+    let refuse = runtime {runExtract = \_ -> liftIO (assertFailure "the extractor must not run")}+    result <- distillSessionL1 (narrowContext testSpace granted) RespectWatermark refuse (scopedScanCandidates 5) sid+    liftIO case result of+      Left (L1NotPermitted actualMissing) ->+        assertEqual "reports the first missing permission" expectedMissing actualMissing+      other -> assertFailure ("expected L1NotPermitted " <> show expectedMissing <> ", got " <> show other)+ testWrapperRefusesNonLegacy :: Assertion testWrapperRefusesNonLegacy =   withApp do@@ -324,6 +360,75 @@   where     recordedSpaces events = [d.memorySpaceId | MemoryRecorded d <- events] +-- | Every lineage-bearing public write uses the same scoped target lookup. These three tests+-- exercise each payload shape and compare the errors directly: an id in another space must not+-- become an existence oracle, and neither rejected attempt may append to the source stream.+testRecordLineageTargetRejected :: Assertion+testRecordLineageTargetRejected =+  withApp do+    source <- liftIO genMemoryId+    absent <- liftIO genMemoryId+    elsewhere <- recordFixture otherContext "record lineage target in another space"+    now <- liftIO getCurrentTime+    missingResult <-+      Memory.recordWithContext testContext (recordData source testContext now) {supersedes = Just absent}+    crossSpaceResult <-+      Memory.recordWithContext testContext (recordData source testContext now) {supersedes = Just elsewhere}+    assertHiddenTarget "record" missingResult crossSpaceResult+    assertMemoryEventCount source 0++testSupersedeLineageTargetRejected :: Assertion+testSupersedeLineageTargetRejected =+  withApp do+    source <- recordFixture testContext "supersede lineage source"+    absent <- liftIO genMemoryId+    elsewhere <- recordFixture otherContext "supersede lineage target in another space"+    now <- liftIO getCurrentTime+    let supersedeBy target =+          Memory.supersedeWithContext+            testContext+            SupersedeMemoryData+              { memoryId = source,+                memorySpaceId = testSpace,+                actorPrincipal = testActorPrincipal,+                supersededBy = target,+                supersededAt = now+              }+    missingResult <- supersedeBy absent+    crossSpaceResult <- supersedeBy elsewhere+    assertHiddenTarget "supersede" missingResult crossSpaceResult+    assertMemoryEventCount source 1++testMergeLineageTargetRejected :: Assertion+testMergeLineageTargetRejected =+  withApp do+    source <- recordFixture testContext "merge lineage source"+    absent <- liftIO genMemoryId+    elsewhere <- recordFixture otherContext "merge lineage target in another space"+    missingResult <- Memory.mergeWithContext testContext source absent+    crossSpaceResult <- Memory.mergeWithContext testContext source elsewhere+    assertHiddenTarget "merge" missingResult crossSpaceResult+    assertMemoryEventCount source 1++assertHiddenTarget ::+  (IOE :> es) =>+  String ->+  Either Memory.MemoryWriteError MemoryId ->+  Either Memory.MemoryWriteError MemoryId ->+  Eff es ()+assertHiddenTarget label missingResult crossSpaceResult =+  liftIO do+    assertMemoryNotFound (label <> " missing target") missingResult+    assertMemoryNotFound (label <> " cross-space target") crossSpaceResult+    assertEqual+      (label <> " renders absent and cross-space targets identically")+      (show missingResult)+      (show crossSpaceResult)+  where+    assertMemoryNotFound resultLabel = \case+      Left Memory.MemoryNotFound -> pure ()+      other -> assertFailure (resultLabel <> ": expected MemoryNotFound, got " <> show other)+ -- * Fixtures  recordFixture ::@@ -430,6 +535,15 @@       case parseMemoryEvent recorded.payload of         Left err -> liftIO (assertFailure ("parseMemoryEvent: " <> show err))         Right event -> pure event++assertMemoryEventCount ::+  (IOE :> es, Store :> es) =>+  MemoryId ->+  Int ->+  Eff es ()+assertMemoryEventCount mid expected = do+  recorded <- readStreamForward (Stream.streamName (memoryStream mid)) (StreamVersion 0) 100+  liftIO $ assertEqual "the rejected lineage write appended no event" expected (Vector.length recorded)  readSessionEvents :: (IOE :> es, Store :> es) => SessionId -> Eff es [SessionEvent] readSessionEvents sid = do

@@ -66,7 +66,7 @@           testCase "punctuation only" (assertQueryDoesNotThrow "-- ; ()")         ],       testCase "a vector round-trip ranks the nearest embedding first" testVectorRoundTrip,-      testCase "capability detection reads the column's real width" testDimensionDetection,+      testCase "capability detection reads the canonical memories table's real width" testDimensionDetection,       testCase "the harness seeds the geometry it claims" testHarnessGeometry,       testCase "the captured plan describes the query that was measured" testPlanCaptureIsFaithful,       testCase "the vector channel does not starve on a selective scope" testVectorChannelDoesNotStarve,

@@ -244,17 +244,20 @@ --    parameterised predicate, and no artifact anywhere could tell a reviewer which meaning had --    been asked for. ----- @enable_seqscan = off@ is set for the same reason the corpus is small: the fixture holds six--- rows, so an unconstrained planner would sequentially scan whatever it was asked and the plan--- would say nothing about which access paths are /available/. Turning the sequential scan off--- asks the question this case actually means — can this query be answered through a--- partition-leading index? — and the answer is asserted below.+-- The fixture includes hundreds of matching decoys in a second namespace, and+-- @enable_seqscan = off@ removes the remaining cost-dependent ambiguity. The question this case+-- asks is therefore precise: can this query be answered through an index that carries space,+-- namespace, and full-text match together? The answer is asserted below. testBoundedPlans :: IO () testBoundedPlans =   withTargetFixture \runEff -> do     result <- runEff do+      scopedFtsIndex <- partitionAwareFtsIndexIsPresent       available <- vectorTypeIsReachable-      keywordPlans <- traverse (planFor explainFtsCandidates . ftsPlan) targetsUnderTest+      keywordPlans <-+        ifAvailable+          scopedFtsIndex+          (traverse (ftsPlanFor . ftsPlan) targetsUnderTest)       vectorPlans <-         ifAvailable           available@@ -263,7 +266,9 @@     case result of       Left err -> assertFailure ("store error: " <> show err)       Right (keywordPlans, vectorPlans) -> do-        assertPlans "keyword" keywordPlans+        case keywordPlans of+          Just plans -> assertFtsPlans plans+          Nothing -> putStrLn ftsIndexSkipMessage         case vectorPlans of           Just plans -> assertPlans "vector (exact pass)" plans           Nothing -> putStrLn skipMessage@@ -272,12 +277,49 @@     vectorPlan target =       vectorCandidateSql (request testSpace target Embedding) fixtureQueryVector +    -- GIN is a bitmap access method. Disable plain index scans as well as sequential scans so+    -- PostgreSQL compares bitmap-capable paths instead of taking the scope B-tree as a direct+    -- index scan merely because this synthetic corpus is cache-hot.+    ftsPlanFor compiled =+      Text.unlines+        <$> runTransaction do+          Tx.sql "SET LOCAL enable_seqscan = off"+          Tx.sql "SET LOCAL enable_indexscan = off"+          explainFtsCandidates compiled+     planFor explain compiled =       Text.unlines         <$> runTransaction do           Tx.sql "SET LOCAL enable_seqscan = off"           explain compiled +assertFtsPlans :: [Text] -> IO ()+assertFtsPlans plans = do+  assertPlans "keyword" plans+  traverse_ assertScopedGin plans+  where+    assertScopedGin plan = do+      assertBool+        ("keyword: the partition-aware GIN is absent from the plan\n" <> Text.unpack plan)+        ("kioku_memories_space_namespace_tsv_idx" `Text.isInfixOf` plan)+      let indexConditions = Text.unlines (filter ("Index Cond:" `Text.isInfixOf`) (Text.lines plan))+      mapM_+        ( \fragment ->+            assertBool+              ( "keyword: the GIN index condition is missing "+                  <> Text.unpack fragment+                  <> "\n"+                  <> Text.unpack plan+              )+              (fragment `Text.isInfixOf` indexConditions)+        )+        [ "memory_space_id",+          memorySpaceIdText testSpace,+          "namespace",+          namespaceText fixtureNamespace,+          "content_tsv"+        ]+ assertPlans :: String -> [Text] -> IO () assertPlans label plans =   case plans of@@ -324,6 +366,9 @@ fixtureNamespace :: Namespace fixtureNamespace = Namespace "mori" +namespaceText :: Namespace -> Text+namespaceText (Namespace value) = value+ repoKind :: ScopeKind repoKind = ScopeKind "repo" @@ -375,6 +420,11 @@   "  [skipped] no reachable pgvector on this cluster; re-enter the dev shell to exercise the \   \vector rows of the target matrix" +ftsIndexSkipMessage :: String+ftsIndexSkipMessage =+  "  [skipped: partition-aware FTS access path] btree_gin is unavailable; correctness ran \+  \against the retained content-only GIN fallback"+ -- | Six rows: three scopes, twice, one set per memory space. Each carries a distinct embedding so -- the vector channel has something to rank, and identical content so the keyword channel matches -- all six.@@ -384,9 +434,55 @@     "INSERT INTO kioku.memories \     \(memory_space_id, memory_id, agent_id, namespace, scope_kind, scope_ref, memory_type, content, status, created_at, updated_at) VALUES "       <> Text.intercalate ", " (concatMap rowsFor fixtureScopes)++  -- A few fixture rows prove correctness; these decoys make the planner evidence meaningful.+  -- Both spaces own a second namespace whose content matches the query, so a content-only GIN+  -- must enumerate hundreds of unrelated candidates while the replacement can constrain the+  -- bitmap by space and namespace inside the index.+  runTransaction . Tx.sql . encodeUtf8 $+    "INSERT INTO kioku.memories \+    \(memory_space_id, memory_id, agent_id, namespace, scope_kind, scope_ref, memory_type, content, status, created_at, updated_at) \+    \SELECT spaces.memory_space_id, \+    \       'fts_planner_decoy_' || spaces.id_prefix || '_' || ordinal::text, \+    \       'agent', 'mori_archive', NULL, NULL, 'fact', '"+      <> fixtureContent+      <> "', 'active', now(), now() \+         \FROM (VALUES ('"+      <> memorySpaceIdText testSpace+      <> "'::text, 't'::text), ('"+      <> memorySpaceIdText otherSpace+      <> "'::text, 'o'::text)) AS spaces(memory_space_id, id_prefix) \+         \CROSS JOIN generate_series(1, 400) AS ordinal"++  -- Make every requested scope expensive through the older partition-leading B-trees while+  -- keeping the FTS result selective. Without these rows the exact-scope B-tree can fetch the+  -- single matching fixture row more cheaply than any GIN, which proves that index is healthy+  -- but says nothing about the new full-text access path.+  runTransaction . Tx.sql . encodeUtf8 $+    "INSERT INTO kioku.memories \+    \(memory_space_id, memory_id, agent_id, namespace, scope_kind, scope_ref, memory_type, content, status, created_at, updated_at) \+    \SELECT spaces.memory_space_id, \+    \       'fts_scope_noise_' || spaces.id_prefix || '_' || scopes.id_prefix || '_' || ordinal::text, \+    \       'agent', '"+      <> namespaceText fixtureNamespace+      <> "', scopes.scope_kind, scopes.scope_ref, 'fact', \+         \       'an unrelated archival note about gardening', 'active', now(), now() \+         \FROM (VALUES ('"+      <> memorySpaceIdText testSpace+      <> "'::text, 't'::text), ('"+      <> memorySpaceIdText otherSpace+      <> "'::text, 'o'::text)) AS spaces(memory_space_id, id_prefix) \+         \CROSS JOIN (VALUES \+         \  (NULL::text, NULL::text, 'global'::text), \+         \  ('repo'::text, 'web'::text, 'web'::text), \+         \  ('repo'::text, 'api'::text, 'api'::text) \+         \) AS scopes(scope_kind, scope_ref, id_prefix) \+         \CROSS JOIN generate_series(1, 1000) AS ordinal"+   if withEmbeddings     then traverse_ setEmbedding (zip [0 ..] (testSpaceIds <> otherSpaceIds))     else pure ()+  runTransaction (Tx.sql "ANALYZE kioku.memories")   where     rowsFor (testId, otherId, scope) =       [row testSpace testId scope, row otherSpace otherId scope]@@ -442,6 +538,17 @@     stmt =       preparable         "SELECT to_regtype('vector') IS NOT NULL"+        E.noParams+        (D.singleRow (D.column (D.nonNullable D.bool)))++partitionAwareFtsIndexIsPresent :: (Store :> es) => Eff es Bool+partitionAwareFtsIndexIsPresent =+  runTransaction (Tx.statement () stmt)+  where+    stmt :: Statement () Bool+    stmt =+      preparable+        "SELECT to_regclass('kioku.kioku_memories_space_namespace_tsv_idx') IS NOT NULL"         E.noParams         (D.singleRow (D.column (D.nonNullable D.bool))) 

@@ -1,214 +0,0 @@-module Kioku.ReiCompatSpec-  ( tests,-  )-where--import Data.Aeson (eitherDecode)-import Data.ByteString.Lazy qualified as LBS-import Data.Maybe (fromMaybe)-import Data.Set qualified as Set-import Data.Time (UTCTime)-import Data.Time.Format.ISO8601 (iso8601ParseM)-import Kioku.Api.Scope (MemoryScope (..), Namespace (..), ScopeKind (..))-import Kioku.Api.Types (Confidence (..), MemoryType (..))-import Kioku.Id (idText)-import Kioku.Memory.Domain (MemoryEvent (..), MemoryRecordedData (..))-import Kioku.Memory.EventStream (parseMemoryEvent)-import Kioku.Session.Domain-  ( InteractiveSessionRecordedData (..),-    SessionCompletedData (..),-    SessionEvent (..),-    SessionFailedData (..),-    SessionResumedData (..),-    SessionStartedData (..),-  )-import Kioku.Session.EventStream (parseSessionEvent)-import Test.Tasty (TestTree, testGroup)-import Test.Tasty.HUnit (Assertion, testCase, (@?=))--tests :: TestTree-tests =-  testGroup-    "Rei legacy codec compatibility"-    [ testCase "decodes agent_memory_recorded" do-        value <- either fail pure (eitherDecode reiMemoryRecordedJson)-        event <- either (fail . show) pure (parseMemoryEvent value)-        case event of-          MemoryRecorded d -> assertMemoryRecorded d-          other -> fail ("Expected MemoryRecorded, got " <> show other),-      testCase "decodes agent_session_started" do-        value <- either fail pure (eitherDecode reiSessionStartedJson)-        event <- either (fail . show) pure (parseSessionEvent value)-        case event of-          SessionStarted d -> assertSessionStarted d-          other -> fail ("Expected SessionStarted, got " <> show other),-      testCase "decodes agent_session_completed" do-        event <- decodeSession reiSessionCompletedJson-        case event of-          SessionCompleted d -> do-            idText d.sessionId @?= "kioku_session_01kvxa7d2cezhs874g3n8dfgme"-            d.completedAt @?= at "2026-06-24T21:30:00Z"-            d.modelUsed @?= Just "claude-opus-4-8"-            d.summary @?= Just "planned the day"-          other -> fail ("Expected SessionCompleted, got " <> show other),-      testCase "decodes agent_session_failed" do-        event <- decodeSession reiSessionFailedJson-        case event of-          SessionFailed d -> do-            idText d.sessionId @?= "kioku_session_01kvxa7d2cezhs874g3n8dfgme"-            d.failedAt @?= at "2026-06-24T21:30:00Z"-            d.errorMessage @?= "model timed out"-          other -> fail ("Expected SessionFailed, got " <> show other),-      testCase "decodes interactive_session_recorded" do-        event <- decodeSession reiInteractiveSessionRecordedJson-        case event of-          InteractiveSessionRecorded d -> do-            idText d.sessionId @?= "kioku_session_01kvxa7d2cezhs874g3n8dfgme"-            d.agentId @?= "demo-agent"-            d.focus @?= "general_coaching"-            d.scope @?= ScopeEntity (Namespace "rei") (ScopeKind "intention") "intention_demo"-            d.startedAt @?= at "2026-06-24T20:10:00Z"-          other -> fail ("Expected InteractiveSessionRecorded, got " <> show other),-      -- The two cases below pin the upcast rule for native SessionResumed events written-      -- before the `force` field existed. Under the old code an omitted correlation key-      -- bypassed matching entirely, so a keyless legacy resume must replay through the-      -- force arm of the new guard and a keyed one through the matching arm. Get this-      -- backwards and historical streams stop hydrating.-      testCase "a pre-force keyless resume decodes as a force resume" do-        event <- decodeSession (resumedWithoutForceJson "null")-        case event of-          SessionResumed d -> do-            d.correlationKey @?= Nothing-            d.force @?= True-          other -> fail ("Expected SessionResumed, got " <> show other),-      testCase "a pre-force keyed resume decodes as a plain resume" do-        event <- decodeSession (resumedWithoutForceJson "\"k1\"")-        case event of-          SessionResumed d -> do-            d.correlationKey @?= Just "k1"-            d.force @?= False-          other -> fail ("Expected SessionResumed, got " <> show other)-    ]--decodeSession :: LBS.ByteString -> IO SessionEvent-decodeSession raw = do-  value <- either fail pure (eitherDecode raw)-  either (fail . show) pure (parseSessionEvent value)--at :: String -> UTCTime-at = fromMaybe (error "bad fixture timestamp") . iso8601ParseM--assertMemoryRecorded :: MemoryRecordedData -> Assertion-assertMemoryRecorded d = do-  idText d.memoryId @?= "kioku_memory_01kvx9my35e5y825cpy4nycjgz"-  (idText <$> d.sessionId) @?= Just "kioku_session_01kvxa7d2cezhs874g3n8dfgme"-  d.agentId @?= "demo-agent"-  d.scope @?= ScopeEntity (Namespace "rei") (ScopeKind "intention") "intention_demo"-  d.memoryType @?= MemoryPreference-  d.content @?= "prefers concise answers"-  d.priority @?= 100-  d.confidence @?= HighConfidence-  d.tags @?= Set.fromList ["style"]-  (idText <$> d.supersedes) @?= Just "kioku_memory_01kvx9pkrxevzafwat8k704yzh"--assertSessionStarted :: SessionStartedData -> Assertion-assertSessionStarted d = do-  idText d.sessionId @?= "kioku_session_01kvxa7d2cezhs874g3n8dfgme"-  d.agentId @?= "demo-agent"-  d.focus @?= "today"-  d.scope @?= ScopeEntity (Namespace "rei") (ScopeKind "intention") "intention_demo"-  d.subjectRef @?= Just "daily planning"-  (idText <$> d.previousSessionId) @?= Just "kioku_session_01kvxa2gw6er7r2yzpvtq9axch"--reiMemoryRecordedJson :: LBS.ByteString-reiMemoryRecordedJson =-  """-  {-    "type": "agent_memory_recorded",-    "data": {-      "memoryId": "agent_memory_01kvx9my35e5y825cpy4nycjgz",-      "agentId": "demo-agent",-      "sessionId": "agent_session_01kvxa7d2cezhs874g3n8dfgme",-      "memoryType": "preference",-      "content": "prefers concise answers",-      "anchor": {-        "type": "intention",-        "id": "intention_demo"-      },-      "confidence": "high",-      "tags": ["style"],-      "supersedes": "agent_memory_01kvx9pkrxevzafwat8k704yzh",-      "recordedAt": "2026-06-24T20:10:00Z"-    }-  }-  """--reiSessionStartedJson :: LBS.ByteString-reiSessionStartedJson =-  """-  {-    "type": "agent_session_started",-    "data": {-      "sessionId": "agent_session_01kvxa7d2cezhs874g3n8dfgme",-      "agentId": "demo-agent",-      "focusType": "FocusToday",-      "intentionId": "intention_demo",-      "previousSessionId": "agent_session_01kvxa2gw6er7r2yzpvtq9axch",-      "focusTarget": "daily planning",-      "startedAt": "2026-06-24T20:10:00Z"-    }-  }-  """--reiSessionCompletedJson :: LBS.ByteString-reiSessionCompletedJson =-  """-  {-    "type": "agent_session_completed",-    "data": {-      "sessionId": "agent_session_01kvxa7d2cezhs874g3n8dfgme",-      "completedAt": "2026-06-24T21:30:00Z",-      "modelUsed": "claude-opus-4-8",-      "summary": "planned the day"-    }-  }-  """--reiSessionFailedJson :: LBS.ByteString-reiSessionFailedJson =-  """-  {-    "type": "agent_session_failed",-    "data": {-      "sessionId": "agent_session_01kvxa7d2cezhs874g3n8dfgme",-      "failedAt": "2026-06-24T21:30:00Z",-      "errorMessage": "model timed out"-    }-  }-  """--reiInteractiveSessionRecordedJson :: LBS.ByteString-reiInteractiveSessionRecordedJson =-  """-  {-    "type": "interactive_session_recorded",-    "data": {-      "sessionId": "agent_session_01kvxa7d2cezhs874g3n8dfgme",-      "agentId": "demo-agent",-      "focusType": "FocusGeneralCoaching",-      "intentionId": "intention_demo",-      "startedAt": "2026-06-24T20:10:00Z"-    }-  }-  """---- | A native @SessionResumed@ payload as written before the @force@ field existed.-resumedWithoutForceJson :: LBS.ByteString -> LBS.ByteString-resumedWithoutForceJson correlationKey =-  "{\"type\": \"session_resumed\", \"data\": {"-    <> "\"sessionId\": \"kioku_session_01kvxa7d2cezhs874g3n8dfgme\", "-    <> "\"correlationKey\": "-    <> correlationKey-    <> ", "-    <> "\"input\": \"approved\", "-    <> "\"resumedAt\": \"2026-06-24T21:30:00Z\"}}"

@@ -7,7 +7,7 @@ import Kioku.Api.Scope (MemoryScope (..), Namespace (..), ScopeKind (..), mkNamespace, mkScopeKind) import Kioku.Distill.L2 (l2SceneTimerId, sceneRowId) import Kioku.Distill.L3 (l3PersonaTimerId, personaRowId)-import Kioku.Distill.ScopeIdentity (escapeScopeComponent, scopeIdentity, scopeSlugFromColumns)+import Kioku.Distill.ScopeIdentity (escapeScopeComponent, scopeIdentity, scopeSlugFromColumns, slugWithDigest) import Kioku.SpaceFixtures (otherSpace, testSpace) import Test.Tasty (TestTree, testGroup) import Test.Tasty.HUnit (Assertion, assertBool, testCase, (@?=))@@ -20,6 +20,7 @@       testCase "well-formed scopes keep their exact legacy ids" testLegacyStability,       testCase "escaping is injective on adversarial components" testEscapeInjective,       testCase "mirror slugs separate scopes the sanitiser cannot" testSlugCollision,+      testCase "the shared slug recipe preserves persisted bytes" testSlugRecipeStability,       testCase "namespace and kind reject the reserved characters" testValidators,       testCase "one scope in two memory spaces derives different timer ids" testSpaceSeparatesTimers     ]@@ -114,6 +115,12 @@   assertBool     ("the slug keeps a human-readable prefix, got " <> show entity)     ("a-b-c-" `Text.isPrefixOf` entity)++testSlugRecipeStability :: Assertion+testSlugRecipeStability = do+  slugWithDigest "a/b/c" "a%2Fb%2Fc" @?= "a-b-c-48a3ec67db"+  scopeSlugFromColumns "a/b/c" Nothing Nothing @?= "a-b-c-48a3ec67db"+  scopeSlugFromColumns "a" (Just "b") (Just "c") @?= "a-b-c-d76a7b7266"  testValidators :: Assertion testValidators = do

@@ -42,7 +42,7 @@ import Kioku.Prelude import Kioku.Session qualified as Session import Kioku.Session.Domain (StartSessionData (..))-import Kioku.SpaceFixtures (legacyContext, otherSpace, testContext, testContextProvider, testSpace)+import Kioku.SpaceFixtures (legacyContext, otherContext, otherSpace, testContext, testContextProvider, testSpace) import Kiroku.Store.Connection (defaultConnectionSettings) import Kiroku.Store.Effect (Store) import Kiroku.Store.Effect.Resource (KirokuStoreResource)@@ -61,14 +61,15 @@       testCase "transient failure reschedules with backoff" testTransientFailureReschedules,       testCase "a timer scheduled before memory spaces fires in the legacy space" testPrePartitionPayloadFiresInLegacySpace,       testCase "a pre-partition timer cannot reach a session in another space" testPrePartitionPayloadCannotReachAnotherSpace,-      testCase "a malformed L1 payload dead-letters" testMalformedL1PayloadDeadLetters,+      testCase "a malformed object payload dead-letters with unknown space" testMalformedL1PayloadDeadLetters,       testCase "unknown process manager requeues with a long delay" testUnknownProcessManagerRequeues,-      testCase "the attempt ceiling dead-letters" testAttemptCeilingDeadLetters,+      testCase "a foreign object dead-letters with unknown space at the attempt ceiling" testAttemptCeilingDeadLetters,       testCase "success marks the timer fired" testSuccessMarksFired,       testCase "drain processes every due timer in one pass" testDrainProcessesAllDueTimers,       testCase "two spaces sharing a scope schedule two timers, and both fire" testTwoSpacesTwoTimers,       testCase "a refused memory space dead-letters" testRefusedSpaceDeadLetters,-      testCase "every dead-letter row names the memory space" testDeadLetterNamesTheSpace+      testCase "a provider returning the wrong memory space dead-letters" testWrongSpaceContextDeadLetters,+      testCase "an explicit-space dead-letter names that exact space" testDeadLetterNamesTheSpace     ]  -- | A correlation id that is not a session id can never become one. It used to@@ -163,13 +164,21 @@     sid <- genSessionId     row <- runOrFail env do       startFixtureSession sid-      scheduleTestTimer timerId l1ExtractProcessManagerName (idText sid) Aeson.Null (-1)+      scheduleTestTimer+        timerId+        l1ExtractProcessManagerName+        (idText sid)+        (Aeson.object ["memorySpaceId" Aeson..= Aeson.object []])+        (-1)       fireOnce rt       fetchTimer timerId     row.status @?= "dead"     assertBool       ("last_error names the payload, got: " <> show row.lastError)       (maybe False (Text.isInfixOf "payload") row.lastError)+    assertBool+      ("last_error should report unknown ownership, got: " <> show row.lastError)+      (maybe False (Text.isPrefixOf "[memory space unknown] ") row.lastError)  -- | An L1 timer payload as the projection writes one today. l1Payload :: MemorySpaceId -> Aeson.Value@@ -199,7 +208,12 @@   withTimerEnv \env rt -> do     timerId <- freshTimerId     row <- runOrFail env do-      scheduleTestTimer timerId "kioku-nonexistent" "whatever" Aeson.Null (-1)+      scheduleTestTimer+        timerId+        "kioku-nonexistent"+        "whatever"+        (Aeson.object ["foreign" Aeson..= True])+        (-1)       forceAttempts timerId 8       fireOnce rt       fetchTimer timerId@@ -207,6 +221,9 @@     assertBool       ("last_error mentions the ceiling, got: " <> show row.lastError)       (maybe False (Text.isInfixOf "attempt ceiling") row.lastError)+    assertBool+      ("last_error should report unknown ownership, got: " <> show row.lastError)+      (maybe False (Text.isPrefixOf "[memory space unknown] ") row.lastError)  -- | The happy path: an L2 timer for a scope with no memories regenerates -- nothing, succeeds without calling the LLM, and is marked fired with the timer's@@ -295,6 +312,30 @@       ("last_error should name the refusal, got: " <> show row.lastError)       (maybe False (Text.isInfixOf "not authorized") row.lastError) +-- | A buggy host provider may answer a request for one space with a context minted for another.+-- The worker must diagnose that configuration error rather than silently retargeting the timer.+testWrongSpaceContextDeadLetters :: Assertion+testWrongSpaceContextDeadLetters =+  withTimerEnv \env rt -> do+    timerId <- freshTimerId+    row <- runOrFail env do+      scheduleTestTimer+        timerId+        l2SceneProcessManagerName+        (partitionedCorrelationId testSpace emptyScope)+        (sceneTimerPayload testSpace)+        (-1)+      fireOnceWith wrongSpaceContextProvider rt+      fetchTimer timerId+    row.status @?= "dead"+    assertBool+      ("last_error should name the wrong-space context, got: " <> show row.lastError)+      ( maybe+          False+          (\err -> memorySpaceIdText testSpace `Text.isInfixOf` err && memorySpaceIdText otherSpace `Text.isInfixOf` err)+          row.lastError+      )+ -- | @last_error@ is the column an operator reads when a distillation stops happening, and a -- dead-lettered timer that does not say which tenant it belongs to is a question, not an answer. testDeadLetterNamesTheSpace :: Assertion@@ -312,7 +353,11 @@     row.status @?= "dead"     assertBool       ("last_error should name the memory space, got: " <> show row.lastError)-      (maybe False (Text.isInfixOf (memorySpaceIdText testSpace)) row.lastError)+      ( maybe+          False+          (Text.isPrefixOf ("[memory space " <> memorySpaceIdText testSpace <> "] "))+          row.lastError+      )  -- | An L2 scene timer payload as the projection writes one. sceneTimerPayload :: MemorySpaceId -> Aeson.Value@@ -324,6 +369,10 @@ refusingContextProvider :: (Applicative m) => MemoryContextProvider m refusingContextProvider =   MemoryContextProvider \space -> pure (Left (MemoryPermissionDenied space MemoryDistill))++wrongSpaceContextProvider :: (Applicative m) => MemoryContextProvider m+wrongSpaceContextProvider =+  MemoryContextProvider \_ -> pure (Right otherContext)  fireOnce ::   (IOE :> es, KirokuStoreResource :> es, Store :> es, Error StoreError :> es, Tracing :> es) =>

@@ -9,9 +9,11 @@ -- in "Kioku.Workspace" stands between a hostile space id and the rest of the disk. module Kioku.WorkspaceSpec (tests) where -import Data.List (isInfixOf)+import Control.Exception (IOException, try)+import Data.List (isInfixOf, isPrefixOf) import Data.Text qualified as Text import Kioku.Api.Access (MemorySpaceId, mkMemorySpaceId)+import Kioku.Distill.ScopeIdentity (slugWithDigest) import Kioku.Workspace   ( ArtifactMove (..),     MoveVerdict (..),@@ -24,11 +26,12 @@     spaceArtifactRoot,     spaceDirectoryName,   )-import System.Directory (createDirectoryIfMissing, doesFileExist)+import System.Directory (createDirectoryIfMissing, doesFileExist, listDirectory) import System.FilePath (isRelative, joinPath, splitDirectories, (</>)) import System.IO.Temp (withSystemTempDirectory)+import System.Posix.Files (fileMode, getFileStatus, setFileMode) import Test.Tasty (TestTree, testGroup)-import Test.Tasty.HUnit (Assertion, assertBool, assertEqual, testCase, (@?=))+import Test.Tasty.HUnit (Assertion, assertBool, assertEqual, assertFailure, testCase, (@?=))  tests :: TestTree tests =@@ -36,12 +39,16 @@     "Workspace artifact layout"     [ testCase "two spaces never share an artifact root" testDistinctRoots,       testCase "the same space always gets the same root" testStableRoot,+      testCase "space directories use the shared persisted slug recipe" testSharedSlugRecipe,       testCase "a case-only difference is still two roots" testCaseOnlyDifference,       testCase "no space id can escape .kioku/spaces" testNoTraversal,       testCase "a fresh workspace has nothing to migrate" testEmptyMigration,       testCase "the historical tree is planned, copied, and left in place" testMigrationCopies,       testCase "a second run is a no-op" testMigrationIdempotent,       testCase "a destination with different content is refused" testMigrationCollision,+      testCase "a stale plan cannot clobber a late differing destination" testLateMigrationCollision,+      testCase "a stale plan accepts a late identical destination" testLateMigrationIdempotent,+      testCase "a copied artifact retains source permissions" testMigrationPreservesPermissions,       testCase "a non-markdown file is not Kioku's to relocate" testMigrationIgnoresOtherFiles     ] @@ -62,6 +69,12 @@     (spaceArtifactRoot "/w" (spaceNamed "space_a"))     (spaceArtifactRoot "/w" (spaceNamed "space_a")) +testSharedSlugRecipe :: Assertion+testSharedSlugRecipe = do+  spaceDirectoryName (spaceNamed "space_A") @?= "space_A-c1c5662504"+  spaceDirectoryName (spaceNamed "space_A") @?= slugWithDigest "space_A" "space_A"+  spaceDirectoryName (spaceNamed "..") @?= "---5ec1f7e700"+ -- | macOS and Windows fold case in path components, so a sanitised name alone would merge these -- two spaces into one directory on the machines this is developed on. The digest is what keeps -- them apart, and it is over the exact bytes.@@ -152,6 +165,63 @@     applyArtifactMigration planned     assertFileIs (sceneArtifactDir workspace legacyish </> "web-abc.md") "what the worker wrote today" +-- | This is the exact race the apply step must close: the plan saw an empty destination, then a+-- live worker published newer content before the operator applied that stale plan.+testLateMigrationCollision :: Assertion+testLateMigrationCollision =+  withSystemTempDirectory "kioku-workspace-late-collision" \workspace -> do+    let source = legacySceneArtifactDir workspace </> "web-abc.md"+        destinationDir = sceneArtifactDir workspace legacyish+        destination = destinationDir </> "web-abc.md"+    writeHistorical workspace "scenes" "web-abc.md" "the pre-partition snapshot"+    planned <- planArtifactMigration workspace legacyish+    map (.verdict) planned @?= [MoveReady]++    createDirectoryIfMissing True destinationDir+    writeFile destination "what the worker wrote today"+    result <- try @IOException (applyArtifactMigration planned)+    case result of+      Left err ->+        assertBool+          ("the refusal must name its destination, got: " <> show err)+          (destination `isInfixOf` show err)+      Right () -> assertFailure "a stale MoveReady plan replaced or accepted differing live content"++    assertFileIs source "the pre-partition snapshot"+    assertFileIs destination "what the worker wrote today"+    assertNoMigrationTemps destinationDir++testLateMigrationIdempotent :: Assertion+testLateMigrationIdempotent =+  withSystemTempDirectory "kioku-workspace-late-idempotent" \workspace -> do+    let destinationDir = sceneArtifactDir workspace legacyish+        destination = destinationDir </> "web-abc.md"+    writeHistorical workspace "scenes" "web-abc.md" "scene body"+    planned <- planArtifactMigration workspace legacyish+    map (.verdict) planned @?= [MoveReady]++    createDirectoryIfMissing True destinationDir+    writeFile destination "scene body"+    applyArtifactMigration planned++    assertFileIs destination "scene body"+    replanned <- planArtifactMigration workspace legacyish+    map (.verdict) replanned @?= [MoveAlreadyMigrated]+    assertNoMigrationTemps destinationDir++testMigrationPreservesPermissions :: Assertion+testMigrationPreservesPermissions =+  withSystemTempDirectory "kioku-workspace-permissions" \workspace -> do+    let source = legacySceneArtifactDir workspace </> "web-abc.md"+        destination = sceneArtifactDir workspace legacyish </> "web-abc.md"+    writeHistorical workspace "scenes" "web-abc.md" "scene body"+    setFileMode source 0o640+    planArtifactMigration workspace legacyish >>= applyArtifactMigration++    sourceMode <- fileMode <$> getFileStatus source+    destinationMode <- fileMode <$> getFileStatus destination+    destinationMode @?= sourceMode+ -- | Only @.md@ files were ever Kioku's. An editor swap file or a README an operator dropped in -- the directory is theirs, and relocating it would be a surprise. testMigrationIgnoresOtherFiles :: Assertion@@ -182,6 +252,13 @@   assertBool ("expected a file at " <> path) exists   actual <- readFile path   assertEqual ("contents of " <> path) expected actual++assertNoMigrationTemps :: FilePath -> Assertion+assertNoMigrationTemps directory = do+  entries <- listDirectory directory+  assertBool+    ("temporary migration files remained in " <> directory <> ": " <> show entries)+    (not (any (".kioku-migrate-artifacts" `isPrefixOf`) entries))  spaceNamed :: Text.Text -> MemorySpaceId spaceNamed = either (error . Text.unpack) id . mkMemorySpaceId

@@ -12,7 +12,6 @@ import Kioku.RecallSpec qualified as RecallSpec import Kioku.RecallSqlSpec qualified as RecallSqlSpec import Kioku.RecallTargetSpec qualified as RecallTargetSpec-import Kioku.ReiCompatSpec qualified as ReiCompatSpec import Kioku.SchemaSpec qualified as SchemaSpec import Kioku.ScopeIdentitySpec qualified as ScopeIdentitySpec import Kioku.SessionInvariantsSpec qualified as SessionInvariantsSpec@@ -29,7 +28,6 @@       "kioku"       [ AwaitingSpec.tests,         CodecCompatSpec.tests,-        ReiCompatSpec.tests,         IdempotencySpec.tests,         MemorySpaceSpec.tests,         PortfolioAccessSpec.tests,