kioku-api 0.3.0.0 → 0.4.0.0

raw patch · 8 files changed

+1926/−1 lines, 8 filesdep +bytestringdep +kioku-apidep +tastyPVP ok

version bump matches the API change (PVP)

Dependencies added: bytestring, kioku-api, tasty, tasty-hunit

API changes (from Hackage documentation)

Files

• CHANGELOG.md +30/−0
• kioku-api.cabal +25/−1
• src/Kioku/Api/Access.hs +198/−0
• src/Kioku/Api/Access/Internal.hs +694/−0
• src/Kioku/Api/Recall.hs +338/−0
• test/Kioku/Api/AccessSpec.hs +350/−0
• test/Kioku/Api/RecallSpec.hs +277/−0
• test/Main.hs +14/−0

@@ -1,5 +1,35 @@ # Changelog +## 0.4.0.0 — 2026-08-17++### Added++- `Kioku.Api.Recall`: `RecallTarget`, which says whether a recall call searches one exact scope+  (`ExactScope`) or every scope in one namespace (`NamespaceWide`). `ExactScope (ScopeGlobal ns)`+  is the exact global bucket, a request that had no representation before. The wire format carries+  a required discriminator with one tag per meaning — `exact_global`, `exact_entity`,+  `namespace_wide` — and decoding refuses an unknown tag or a variant carrying a field it has no+  meaning for.+- `RecallQuery`, the request a caller composes: a target, query text, a strategy, and a+  `RecallLimit` validated to 1–100. It deliberately carries no memory space; that comes from the+  `MemoryAccessContext` at execution.+- `legacyRecallTarget`, the migration helper: it maps a pre-target `MemoryScope` to the target+  that returns the same rows (`ScopeGlobal ns` to `NamespaceWide ns`). It is not deprecated,+  because it is what a migrating caller must call.+- `RecallStrategy` moved here from `kioku-core`'s `Kioku.Recall`, which re-exports it, so an+  existing `import Kioku.Recall (RecallStrategy (..))` keeps working. It gained+  `recallStrategyText`, `parseRecallStrategy`, `allRecallStrategies`, and a bare-string JSON+  encoding.++- `RecordedPrincipal` and `LegacyPrincipalRef` in `Kioku.Api.Access`: who a stored fact says+  acted. Three cases — a principal a directory issued, a pre-memory-space free-text agent label+  kept verbatim and marked, and an event that recorded no actor at all. The wire markers+  `kioku:legacy:` and `kioku:unattributed` are unambiguous because `mkPrincipalRef` rejects `:`.+- `memoryContextRecordedActor`, the supported way to attribute a write. Attribution comes from the+  context that authorized it, never from a separate caller-supplied name.+- `MemoryContextProvider` and `assumeAuthorizedContextProvider`, for background work that+  discovers which memory space it belongs to only after claiming it.+ ## 0.3.0.0 — 2026-08-05  ### Changed

@@ -1,6 +1,6 @@ cabal-version:   3.0 name:            kioku-api-version:         0.3.0.0+version:         0.4.0.0 synopsis:        Reusable agent memory wire types description:   Wire contract for kioku: custom prelude, TypeID identifiers, memory@@ -27,6 +27,7 @@   ghc-options:     -Wall -Wcompat -Widentities -Wincomplete-record-updates     -Wincomplete-uni-patterns -Wpartial-fields -Wredundant-constraints+    -Werror=incomplete-patterns  common shared   default-language:   GHC2024@@ -45,6 +46,9 @@   import:          warnings, shared   hs-source-dirs:  src   exposed-modules:+    Kioku.Api.Access+    Kioku.Api.Access.Internal+    Kioku.Api.Recall     Kioku.Api.Scope     Kioku.Api.Types     Kioku.Id@@ -58,3 +62,23 @@     , mmzk-typeid  >=0.7  && <0.8     , text         >=2.1  && <2.2     , time         >=1.12 && <1.15++test-suite kioku-api-test+  import:         warnings, shared+  type:           exitcode-stdio-1.0+  main-is:        Main.hs+  hs-source-dirs: test+  other-modules:+    Kioku.Api.AccessSpec+    Kioku.Api.RecallSpec++  ghc-options:    -threaded -rtsopts -with-rtsopts=-N+  build-depends:+    , aeson        >=2.2      && <2.3+    , base         >=4.21     && <5+    , bytestring   >=0.11     && <0.13+    , containers   >=0.6      && <0.8+    , kioku-api    ^>=0.4.0.0+    , tasty        >=1.5      && <1.6+    , tasty-hunit  >=0.10     && <0.11+    , text         >=2.1      && <2.2

@@ -0,0 +1,198 @@+-- | Memory spaces, principals, and the authorization context Kioku's core requires.+--+-- Kioku stores memory. It does not authenticate anyone, hold a roster of users or teams, or+-- decide who may read what — and it takes no dependency on anything that does. What it requires+-- is that somebody else has already decided, and says so by handing it a 'MemoryAccessContext'.+--+-- There are exactly two ways to obtain one.+--+-- A trusted in-process host — a CLI, a test, an application that authenticated its user long+-- before it reached the memory layer — calls 'assumeAuthorizedMemoryContext'. Nothing else is+-- required: no directory, no authorization engine, no configuration. This is the ordinary case+-- and it is why Kioku is usable standalone.+--+-- A host serving untrusted callers uses 'authorizeMemoryAccess', which runs three gates in a+-- fixed order and refuses to skip any of them:+--+-- 1. a coarse credential claim ('MemoryCoarseScope') proves the caller may talk to Kioku about+--    this /kind/ of action at all;+-- 2. a directory ('PrincipalDirectory') resolves the authenticated subject to a+--    'PrincipalRef', which is what makes an unlinked credential or a paused agent fail closed;+-- 3. an authorization engine ('PermissionChecker') decides whether that principal may perform+--    this action on /this memory space/.+--+-- Each gate answers a question the others cannot. A coarse @kioku:read@ scope says nothing about+-- which space; a resolved principal says nothing about permission; and a permission check on a+-- subject nobody vouched for is a check on a string the caller made up.+--+-- The two seams in steps 2 and 3 are records of plain functions. Kioku names no identity+-- service, and the object type and permission names it asks about come from the host as a+-- 'MemoryAuthorizationBinding'. See @docs\/user\/integrations.md@ for a worked integration.+module Kioku.Api.Access+  ( -- * The isolation boundary+    MemorySpaceId,+    mkMemorySpaceId,+    memorySpaceIdText,+    legacyMemorySpaceId,++    -- * Principals+    PrincipalRef,+    mkPrincipalRef,+    principalRefText,+    MemoryActor (..),+    MemoryOwner (..),+    actorPrincipal,+    ownerPrincipal,++    -- * Principals as they appear on stored facts+    LegacyPrincipalRef,+    legacyPrincipalRef,+    legacyPrincipalRefText,+    RecordedPrincipal (..),+    recordedPrincipalText,+    parseRecordedPrincipal,++    -- * Kioku's own action vocabulary+    MemoryPermission (..),+    allMemoryPermissions,+    memoryPermissionText,+    parseMemoryPermission,++    -- * Naming the authorization object, which Kioku does not own+    MemoryObjectType,+    mkMemoryObjectType,+    memoryObjectTypeText,+    MemoryPermissionName,+    mkMemoryPermissionName,+    memoryPermissionNameText,+    MemoryCoarseScope,+    mkMemoryCoarseScope,+    memoryCoarseScopeText,+    MemoryObjectRef (..),+    memoryObjectRefText,+    MemoryPermissionBinding (..),+    MemoryAuthorizationBinding,+    mkMemoryAuthorizationBinding,+    memoryPermissionBinding,+    memorySpaceObjectRef,++    -- * Freshness+    MemoryDecisionToken,+    mkMemoryDecisionToken,+    memoryDecisionTokenText,+    MemoryFreshness (..),+    atLeastAsFresh,++    -- * What an authorization seam answers+    MemoryDecisionOutcome (..),+    MemoryDecision (..),++    -- * Why access was refused+    MemoryAccessDenial (..),++    -- * The authenticated caller+    AuthenticatedSubject (..),++    -- * The seams Kioku does not implement+    PrincipalDirectory (..),+    PermissionChecker (..),+    MemoryContextProvider (..),+    assumeAuthorizedContextProvider,++    -- * The authorized decision+    MemoryAccessContext,+    memoryContextSpace,+    memoryContextActor,+    memoryContextPermissions,+    memoryContextDecisionToken,+    memoryContextAllows,+    memoryContextFreshness,+    memoryContextRecordedActor,+    assumeAuthorizedMemoryContext,+    authorizeMemoryAccess,+  )+where++import Data.List.NonEmpty qualified as NonEmpty+import Data.Set qualified as Set+import Kioku.Api.Access.Internal+import Kioku.Prelude++-- | Run the three gates for one memory space and a set of requested actions, and mint a+-- 'MemoryAccessContext' only if every one of them passes.+--+-- The order is fixed and the failures stay distinct. A missing coarse scope, an unresolved+-- principal, a denial, and a conditional answer are four different 'MemoryAccessDenial'+-- constructors, and a caller must keep them apart all the way out: none of them may become a+-- successful recall that happens to return no rows. A caller cannot tell "you may not look here"+-- from "there is nothing here", and only one of those is worth acting on.+--+-- All requested permissions are checked, not just the first. A context that claimed five+-- permissions on the strength of one check would be exactly the confused-deputy bug the whole+-- boundary exists to prevent.+--+-- The @freshness@ argument is what a caller passes after writing a grant or a membership: hand+-- back the 'MemoryDecisionToken' from the write (or from a previous decision, via+-- 'memoryContextFreshness') and the check is guaranteed to observe it. Without it a replica that+-- has not caught up can deny a permission that already exists. The minted context carries the+-- token of the last check it ran, so a follow-up read can chain from it.+--+-- A 'MemoryConditional' answer is treated as a refusal. The relationship exists but is gated on+-- context this request did not supply, and quietly promoting that to an allow is how a+-- time-limited grant becomes a permanent one.+authorizeMemoryAccess ::+  (Monad m) =>+  MemoryAuthorizationBinding ->+  PrincipalDirectory m ->+  PermissionChecker m ->+  MemoryFreshness ->+  AuthenticatedSubject ->+  MemorySpaceId ->+  NonEmpty MemoryPermission ->+  m (Either MemoryAccessDenial MemoryAccessContext)+authorizeMemoryAccess binding directory authorizer freshness subject spaceId requested =+  case coarseGate of+    Left denial -> pure (Left denial)+    Right () -> do+      resolved <- directory.resolvePrincipal subject.subjectId+      case resolved of+        Nothing -> pure (Left (MemoryPrincipalUnresolved subject.subjectId))+        Just principal -> checkAll principal Nothing permissions+  where+    permissions = NonEmpty.toList requested+    object = memorySpaceObjectRef binding spaceId++    -- Every requested action must clear its coarse claim before the directory is consulted, so+    -- an unauthorized caller cannot use Kioku as an oracle for which subjects exist.+    coarseGate =+      case filter scopeMissing permissions of+        [] -> Right ()+        permission : _ ->+          Left (MemoryCoarseScopeMissing (memoryPermissionBinding binding permission).coarseScope)++    scopeMissing permission =+      not (Set.member (memoryPermissionBinding binding permission).coarseScope subject.grantedScopes)++    checkAll principal latestToken = \case+      [] ->+        pure+          ( Right+              MemoryAccessContext+                { memorySpaceId = spaceId,+                  actor = MemoryActor principal,+                  grantedPermissions = Set.fromList permissions,+                  decisionToken = latestToken+                }+          )+      permission : rest -> do+        decision <-+          authorizer.checkMemoryPermission+            freshness+            principal+            (memoryPermissionBinding binding permission).objectPermission+            object+        case decision.outcome of+          MemoryDenied -> pure (Left (MemoryPermissionDenied spaceId permission))+          MemoryConditional obligations ->+            pure (Left (MemoryDecisionConditional spaceId permission obligations))+          MemoryAllowed -> checkAll principal (Just decision.checkedAt) rest

@@ -0,0 +1,694 @@+-- | The memory-space access vocabulary, with every constructor exposed.+--+-- This module exists so that an adapter which has already obtained an authorization decision+-- by some other route can build a 'MemoryAccessContext' directly. Everything here is also+-- re-exported by "Kioku.Api.Access" /except/ the 'MemoryAccessContext' data constructor, which+-- is the one value in this vocabulary that asserts "a decision was made and it said yes".+--+-- Importing this module is a deliberate act. If you find yourself reaching for it because+-- 'Kioku.Api.Access.authorizeMemoryAccess' is inconvenient, use+-- 'Kioku.Api.Access.assumeAuthorizedMemoryContext' instead: it says the same thing, in one+-- grep-able name, and a reviewer can see it.+module Kioku.Api.Access.Internal+  ( -- * The isolation boundary+    MemorySpaceId (..),+    mkMemorySpaceId,+    memorySpaceIdText,+    legacyMemorySpaceId,++    -- * Principals+    PrincipalRef (..),+    mkPrincipalRef,+    principalRefText,+    MemoryActor (..),+    MemoryOwner (..),+    actorPrincipal,+    ownerPrincipal,++    -- * Principals as they appear on stored facts+    LegacyPrincipalRef (..),+    legacyPrincipalRef,+    legacyPrincipalRefText,+    RecordedPrincipal (..),+    recordedPrincipalText,+    parseRecordedPrincipal,++    -- * Kioku's own action vocabulary+    MemoryPermission (..),+    allMemoryPermissions,+    memoryPermissionText,+    parseMemoryPermission,++    -- * Naming the authorization object (owned by the schema owner, not by Kioku)+    MemoryObjectType (..),+    mkMemoryObjectType,+    memoryObjectTypeText,+    MemoryPermissionName (..),+    mkMemoryPermissionName,+    memoryPermissionNameText,+    MemoryCoarseScope (..),+    mkMemoryCoarseScope,+    memoryCoarseScopeText,+    MemoryObjectRef (..),+    memoryObjectRefText,+    MemoryPermissionBinding (..),+    MemoryAuthorizationBinding (..),+    mkMemoryAuthorizationBinding,+    memoryPermissionBinding,+    memorySpaceObjectRef,++    -- * Freshness+    MemoryDecisionToken (..),+    mkMemoryDecisionToken,+    memoryDecisionTokenText,+    MemoryFreshness (..),+    atLeastAsFresh,++    -- * What an authorization port answers+    MemoryDecisionOutcome (..),+    MemoryDecision (..),++    -- * Why access was refused+    MemoryAccessDenial (..),++    -- * The authenticated caller, before any space-specific work+    AuthenticatedSubject (..),++    -- * The seams Kioku does not implement+    PrincipalDirectory (..),+    PermissionChecker (..),+    MemoryContextProvider (..),+    assumeAuthorizedContextProvider,++    -- * The authorized decision+    MemoryAccessContext (..),+    memoryContextSpace,+    memoryContextActor,+    memoryContextPermissions,+    memoryContextDecisionToken,+    memoryContextAllows,+    memoryContextFreshness,+    memoryContextRecordedActor,+    assumeAuthorizedMemoryContext,+  )+where++import Data.Aeson (withText)+import Data.Char qualified as Char+import Data.Map.Strict (Map)+import Data.Map.Strict qualified as Map+import Data.Set (Set)+import Data.Set qualified as Set+import Data.Text qualified as Text+import Kioku.Prelude++-- | The outer isolation boundary: everything Kioku stores belongs to exactly one memory space,+-- and a caller authorized for one space is never thereby authorized for another.+--+-- This is deliberately /not/ a principal id. A person or a team can own or reach many spaces,+-- and "who may touch this space" is a relationship the authorization service answers, not a+-- property of the identifier. It is also deliberately opaque text rather than a Kioku-minted+-- TypeID: a host may create spaces in some other system entirely, and Kioku's job is to carry+-- whatever identifier that owner issues, not to mint one.+--+-- Compare with 'Kioku.Api.Scope.Namespace', which it does not replace. A namespace organizes+-- memories inside one deployment (@rei@, @mori@, @shikigami@); a memory space isolates them.+-- Two hosts sharing a database are separated by namespace; two tenants who must never see each+-- other's data are separated by memory space.+newtype MemorySpaceId = MemorySpaceId Text+  deriving stock (Eq, Ord, Show, Generic)++-- | Validating constructor. A space id becomes an authorization object id, an indexed database+-- column, and part of a rendered object reference, so it must not contain the characters those+-- encodings give meaning to: @%@, @\/@ and @:@ (reserved by+-- 'Kioku.Api.Scope.mkNamespace' and by the scope-identity encoding) and @#@ (which separates an+-- object from a relation in a relationship tuple). Whitespace and control characters are+-- rejected too — no legitimate identifier contains them, and they corrupt logs and query plans.+mkMemorySpaceId :: Text -> Either Text MemorySpaceId+mkMemorySpaceId = fmap MemorySpaceId . validateOpaqueId "memory space id" reservedRefChars++memorySpaceIdText :: MemorySpaceId -> Text+memorySpaceIdText (MemorySpaceId value) = value++-- | The single explicit space that data written before memory spaces existed is backfilled into.+--+-- The important word is /explicit/. It would be simpler to let a missing space mean "visible+-- everywhere", and that is exactly the mistake this constant exists to prevent: absence of a+-- partition must never read as unrestricted access. An upgraded single-space deployment keeps+-- its old behaviour because all of its rows land in this one space — not because unpartitioned+-- rows are special.+legacyMemorySpaceId :: MemorySpaceId+legacyMemorySpaceId = MemorySpaceId "kioku_legacy"++-- | A principal identifier issued by whatever directory the host uses, carried verbatim.+--+-- The wire form is exactly that directory's rendered form — @person_01h9x…@, @team_01h9x…@,+-- @agent_01h9x…@, @service_01h9x…@, @org_01h9x…@ and so on. Kioku stores it, compares it by+-- string equality, and does nothing else with it. In particular it never splits the prefix off+-- to learn the principal's kind, and it holds no profile, handle, membership, or lifecycle+-- state: a paused agent, a departed person, and a renamed team are all the directory's business,+-- and they reach Kioku as a subject that no longer resolves.+newtype PrincipalRef = PrincipalRef Text+  deriving stock (Eq, Ord, Show, Generic)++-- | Validating constructor. This is edge hygiene, not a directory parser: it rejects the empty+-- string, whitespace, control characters, and the @:@ and @#@ that a relationship tuple gives+-- meaning to. It deliberately does not check the prefix against a list of kinds — that list+-- belongs to the directory, and duplicating it here would fork it on the day it grows.+mkPrincipalRef :: Text -> Either Text PrincipalRef+mkPrincipalRef = fmap PrincipalRef . validateOpaqueId "principal reference" tupleRefChars++principalRefText :: PrincipalRef -> Text+principalRefText (PrincipalRef value) = value++-- | The principal responsible for an action: whoever the request was authorized as.+newtype MemoryActor = MemoryActor PrincipalRef+  deriving stock (Eq, Ord, Show, Generic)++-- | The principal a memory belongs to, where that differs from the actor.+--+-- An agent recording on a person's behalf is the motivating case: the actor is the agent, the+-- owner is the person, and later retention or deletion questions are asked about the owner.+newtype MemoryOwner = MemoryOwner PrincipalRef+  deriving stock (Eq, Ord, Show, Generic)++actorPrincipal :: MemoryActor -> PrincipalRef+actorPrincipal (MemoryActor value) = value++ownerPrincipal :: MemoryOwner -> PrincipalRef+ownerPrincipal (MemoryOwner value) = value++-- | A free-text agent label from before canonical principals existed, carried verbatim.+--+-- Kioku's events used to record an @agentId@ that was whatever string the host felt like+-- sending: @rei@, @demo-agent@, @claude@. That is not a principal — nobody issued it, nobody+-- can resolve it, and two hosts can pick the same one — so it must never be laundered into a+-- 'PrincipalRef' by pasting a kind prefix onto it. It is kept exactly as it was written and+-- marked as legacy wherever it appears.+--+-- The constructor is deliberately total and validates nothing. This value only ever comes from+-- data that is already on disk, and a validating constructor here would mean a historical event+-- that fails to decode — which is to say, an aggregate that can no longer be rebuilt.+newtype LegacyPrincipalRef = LegacyPrincipalRef Text+  deriving stock (Eq, Ord, Show, Generic)++legacyPrincipalRef :: Text -> LegacyPrincipalRef+legacyPrincipalRef = LegacyPrincipalRef++legacyPrincipalRefText :: LegacyPrincipalRef -> Text+legacyPrincipalRefText (LegacyPrincipalRef value) = value++-- | Who a stored fact says acted, as far as the event stream knows.+--+-- Three cases, and the last two exist because history is not uniform. Everything written through+-- the memory-space API names a real principal. Events written before it carry a legacy agent+-- label, or — for the many events that never recorded an agent at all, such as archiving a+-- memory or completing a session — nothing.+--+-- 'UnattributedPrincipal' is the honest answer for that last group. The alternative is inventing+-- an actor for a fact that did not record one, which would put a fabricated identity into an+-- audit trail.+data RecordedPrincipal+  = -- | a principal a directory issued and vouched for+    KnownPrincipal !PrincipalRef+  | -- | a pre-memory-space free-text agent label, marked as such+    LegacyPrincipal !LegacyPrincipalRef+  | -- | a pre-memory-space event that recorded no actor+    UnattributedPrincipal+  deriving stock (Eq, Ord, Show, Generic)++-- | The canonical text rendering, which is also the wire form.+--+-- The two non-canonical cases are spelled with a @kioku:@ prefix, and that is unambiguous rather+-- than merely unlikely: 'mkPrincipalRef' rejects @:@ outright, so no principal a directory can+-- issue is spellable as either marker. Round-tripping is exact even for a legacy label that+-- itself begins with @kioku:legacy:@, because only the first marker is stripped.+recordedPrincipalText :: RecordedPrincipal -> Text+recordedPrincipalText = \case+  KnownPrincipal principal -> principalRefText principal+  LegacyPrincipal legacy -> legacyPrincipalMarker <> legacyPrincipalRefText legacy+  UnattributedPrincipal -> unattributedPrincipalMarker++-- | Parse the rendering above. An unrecognized @kioku:@ form is an error rather than a legacy+-- label, so a marker added by a later version fails loudly here instead of being silently+-- demoted to free text.+parseRecordedPrincipal :: Text -> Either Text RecordedPrincipal+parseRecordedPrincipal value+  | value == unattributedPrincipalMarker = Right UnattributedPrincipal+  | Just legacy <- Text.stripPrefix legacyPrincipalMarker value =+      Right (LegacyPrincipal (LegacyPrincipalRef legacy))+  | Just unknown <- Text.stripPrefix kiokuPrincipalMarker value =+      Left ("unknown kioku principal marker: " <> unknown)+  | otherwise = KnownPrincipal <$> mkPrincipalRef value++kiokuPrincipalMarker :: Text+kiokuPrincipalMarker = "kioku:"++legacyPrincipalMarker :: Text+legacyPrincipalMarker = kiokuPrincipalMarker <> "legacy:"++unattributedPrincipalMarker :: Text+unattributedPrincipalMarker = kiokuPrincipalMarker <> "unattributed"++-- | What a caller wants to do to a memory space, in Kioku's own words.+--+-- These name Kioku's operations, not the authorization service's schema. The mapping from one+-- to the other is a 'MemoryAuthorizationBinding' the host supplies, because the names on the+-- other side belong to whoever owns that schema.+data MemoryPermission+  = -- | recall, scene reads, persona reads — anything that returns stored memory+    MemoryRead+  | -- | record a memory, start a session, append a turn+    MemoryRecord+  | -- | run distillation, which reads evidence and writes derived memory+    MemoryDistill+  | -- | forget, retire, or otherwise remove memory+    MemoryForget+  | -- | administer the space itself, including sharing it with another principal+    MemoryAdmin+  deriving stock (Eq, Ord, Show, Enum, Bounded, Generic)++-- | Every permission, in declaration order. Used to prove a binding is total.+allMemoryPermissions :: [MemoryPermission]+allMemoryPermissions = [minBound .. maxBound]++-- | The stable wire spelling. Changing one of these is a breaking change to stored events.+memoryPermissionText :: MemoryPermission -> Text+memoryPermissionText = \case+  MemoryRead -> "read"+  MemoryRecord -> "record"+  MemoryDistill -> "distill"+  MemoryForget -> "forget"+  MemoryAdmin -> "admin"++parseMemoryPermission :: Text -> Either Text MemoryPermission+parseMemoryPermission = \case+  "read" -> Right MemoryRead+  "record" -> Right MemoryRecord+  "distill" -> Right MemoryDistill+  "forget" -> Right MemoryForget+  "admin" -> Right MemoryAdmin+  other -> Left ("unknown memory permission: " <> other)++-- | The object type a memory space is represented by in the authorization schema.+--+-- Kioku does not choose this string, because Kioku does not own that schema. The host passes it+-- in through 'mkMemoryAuthorizationBinding'.+newtype MemoryObjectType = MemoryObjectType Text+  deriving stock (Eq, Ord, Show, Generic)++mkMemoryObjectType :: Text -> Either Text MemoryObjectType+mkMemoryObjectType = fmap MemoryObjectType . validateOpaqueId "object type" tupleRefChars++memoryObjectTypeText :: MemoryObjectType -> Text+memoryObjectTypeText (MemoryObjectType value) = value++-- | The permission (relation) name asked of the authorization schema. Also not Kioku's to+-- choose — see 'MemoryObjectType'.+newtype MemoryPermissionName = MemoryPermissionName Text+  deriving stock (Eq, Ord, Show, Generic)++mkMemoryPermissionName :: Text -> Either Text MemoryPermissionName+mkMemoryPermissionName = fmap MemoryPermissionName . validateOpaqueId "permission name" tupleRefChars++memoryPermissionNameText :: MemoryPermissionName -> Text+memoryPermissionNameText (MemoryPermissionName value) = value++-- | A coarse claim the authentication service must have minted onto the caller's credential+-- before Kioku will do any space-specific work — an OAuth-style scope such as @kioku:read@.+--+-- It is coarse on purpose: it says "this credential is allowed to talk to Kioku at all about+-- reads", never "…about this space". Passing this gate is necessary and nowhere near sufficient.+newtype MemoryCoarseScope = MemoryCoarseScope Text+  deriving stock (Eq, Ord, Show, Generic)++mkMemoryCoarseScope :: Text -> Either Text MemoryCoarseScope+mkMemoryCoarseScope = fmap MemoryCoarseScope . validateOpaqueId "coarse scope" ""++memoryCoarseScopeText :: MemoryCoarseScope -> Text+memoryCoarseScopeText (MemoryCoarseScope value) = value++-- | A concrete object in the authorization schema: a type and an id within that type.+data MemoryObjectRef = MemoryObjectRef+  { objectType :: !MemoryObjectType,+    objectId :: !Text+  }+  deriving stock (Eq, Ord, Show, Generic)++-- | The canonical @type:id@ rendering. Both halves reject @:@ and @#@ at construction, so this+-- rendering is injective: two different object references can never produce the same text.+memoryObjectRefText :: MemoryObjectRef -> Text+memoryObjectRefText ref = memoryObjectTypeText ref.objectType <> ":" <> ref.objectId++-- | How one Kioku action is expressed on the other side of the boundary.+data MemoryPermissionBinding = MemoryPermissionBinding+  { -- | the credential claim the authentication service must have minted+    coarseScope :: !MemoryCoarseScope,+    -- | the permission asked of the authorization service+    objectPermission :: !MemoryPermissionName+  }+  deriving stock (Eq, Ord, Show, Generic)++-- | The complete translation from Kioku's actions to a host's identity stack.+--+-- Kioku ships no default value for this, and that absence is the design. The object type and+-- permission names live in a schema Kioku does not own and which, at the time of writing, does+-- not yet contain a memory-space object at all. Inventing plausible names here would let Kioku+-- claim a compatibility it cannot demonstrate; requiring the host to supply them makes the+-- dependency visible at the call site.+data MemoryAuthorizationBinding = MemoryAuthorizationBinding+  { spaceObjectType :: !MemoryObjectType,+    permissionBindings :: !(Map MemoryPermission MemoryPermissionBinding)+  }+  deriving stock (Eq, Show, Generic)++-- | Build a binding, refusing anything partial.+--+-- Every one of 'allMemoryPermissions' must be present. A binding with a hole in it would fail+-- at the moment some rarely-exercised path — forgetting, say — first ran in production, which is+-- the worst possible time to discover it. Making construction total makes+-- 'memoryPermissionBinding' total.+mkMemoryAuthorizationBinding ::+  MemoryObjectType ->+  [(MemoryPermission, MemoryPermissionBinding)] ->+  Either Text MemoryAuthorizationBinding+mkMemoryAuthorizationBinding spaceObjectType entries+  | not (null missing) =+      Left+        ( "authorization binding is missing: "+            <> Text.intercalate ", " (fmap memoryPermissionText missing)+        )+  | otherwise = Right MemoryAuthorizationBinding {spaceObjectType, permissionBindings}+  where+    permissionBindings = Map.fromList entries+    missing = filter (`Map.notMember` permissionBindings) allMemoryPermissions++-- | Total, because 'mkMemoryAuthorizationBinding' rejects incomplete bindings.+memoryPermissionBinding :: MemoryAuthorizationBinding -> MemoryPermission -> MemoryPermissionBinding+memoryPermissionBinding binding permission =+  case Map.lookup permission binding.permissionBindings of+    Just found -> found+    Nothing ->+      -- Unreachable: the smart constructor is the only way to build a binding and it requires+      -- every permission. Kept as an error rather than a default so a future constructor that+      -- forgets the check fails loudly instead of silently authorizing against the wrong name.+      error+        ( "kioku: incomplete MemoryAuthorizationBinding, missing "+            <> Text.unpack (memoryPermissionText permission)+        )++-- | The authorization object for a memory space under a given binding.+--+-- Note what makes two spaces distinct here: the space id, and nothing else. The same namespace+-- and scope in two different spaces produce two different object references, so a decision about+-- one can never be replayed as a decision about the other.+memorySpaceObjectRef :: MemoryAuthorizationBinding -> MemorySpaceId -> MemoryObjectRef+memorySpaceObjectRef binding spaceId =+  MemoryObjectRef+    { objectType = binding.spaceObjectType,+      objectId = memorySpaceIdText spaceId+    }++-- | An opaque token naming the revision an authorization decision was made at.+--+-- The authorization service mints it; Kioku only carries it. Presenting it on a later call is+-- what makes that call observe at least everything the first one did — the fix for the case+-- where a grant is written, the caller immediately retries, and a replica that has not caught up+-- answers "denied" about a permission that now exists.+newtype MemoryDecisionToken = MemoryDecisionToken Text+  deriving stock (Eq, Ord, Show, Generic)++-- | Wrap a token minted elsewhere. The only rule Kioku imposes is that it is not empty: the+-- encoding belongs entirely to whoever issued it, and an adapter that invented structure here+-- would break the first time that issuer changed its own.+mkMemoryDecisionToken :: Text -> Either Text MemoryDecisionToken+mkMemoryDecisionToken value+  | Text.null value = Left "decision token must not be empty"+  | otherwise = Right (MemoryDecisionToken value)++memoryDecisionTokenText :: MemoryDecisionToken -> Text+memoryDecisionTokenText (MemoryDecisionToken value) = value++-- | How fresh an authorization read has to be.+--+-- Two cases, not four. The authorization service offers more (an exact snapshot, a fully+-- consistent head read), but Kioku only ever needs "whatever is cheap" and "at least as fresh as+-- this decision", and offering the others would invite a caller to pin a snapshot that ages.+data MemoryFreshness+  = -- | cheapest available; may be slightly stale+    MemoryFreshnessDefault+  | -- | at least as fresh as the named decision+    MemoryFreshnessAtLeast !MemoryDecisionToken+  deriving stock (Eq, Show, Generic)++-- | Request a read at least as fresh as a decision already observed. This is what a caller does+-- after a membership or grant write, and what a caller does when retrying a denial that a+-- just-written grant should have turned into an allow.+atLeastAsFresh :: MemoryDecisionToken -> MemoryFreshness+atLeastAsFresh = MemoryFreshnessAtLeast++-- | What an authorization check can answer.+--+-- @MemoryConditional@ is the one that catches people out. It means the relationship exists but+-- is gated on context the request did not supply, and it is /not/ an allow. Treating it as one+-- is how a time-limited or condition-limited grant becomes a permanent one.+data MemoryDecisionOutcome+  = MemoryAllowed+  | MemoryDenied+  | -- | names of the unmet conditions+    MemoryConditional ![Text]+  deriving stock (Eq, Show, Generic)++-- | A decision, and the revision it was decided at.+data MemoryDecision = MemoryDecision+  { outcome :: !MemoryDecisionOutcome,+    checkedAt :: !MemoryDecisionToken+  }+  deriving stock (Eq, Show, Generic)++-- | Why a request was refused. These stay distinct all the way to the caller.+--+-- Collapsing them is tempting and wrong. In particular none of them may be turned into a+-- successful recall that happens to return no rows: a caller cannot distinguish "you may not+-- look here" from "there is nothing here", and only one of those is worth retrying with+-- different credentials.+data MemoryAccessDenial+  = -- | the credential lacks the coarse claim for this action+    MemoryCoarseScopeMissing !MemoryCoarseScope+  | -- | the authenticated subject maps to no principal: unlinked, departed, or paused+    MemoryPrincipalUnresolved !Text+  | -- | the authorization service said no for this space and action+    MemoryPermissionDenied !MemorySpaceId !MemoryPermission+  | -- | allowed only under conditions the request did not satisfy+    MemoryDecisionConditional !MemorySpaceId !MemoryPermission ![Text]+  deriving stock (Eq, Show, Generic)++-- | What the authentication service established: who is calling, and what coarse claims they+-- carry. The subject is the credential's subject identifier, which is /not/ a principal+-- reference — resolving one to the other is the directory's job.+data AuthenticatedSubject = AuthenticatedSubject+  { subjectId :: !Text,+    grantedScopes :: !(Set MemoryCoarseScope)+  }+  deriving stock (Eq, Show, Generic)++-- | The directory seam: turn an authenticated credential subject into a principal reference.+--+-- 'Nothing' covers every reason a subject has no usable principal — never linked, since removed,+-- or an agent the directory has paused. Kioku deliberately cannot tell those apart, because+-- distinguishing them would mean holding directory state it has no business holding.+--+-- This is a record of plain functions, not an interface to any particular service. A host wires+-- it to whatever it already has; a host with no directory at all does not build one, and uses+-- 'assumeAuthorizedMemoryContext' instead.+newtype PrincipalDirectory m = PrincipalDirectory+  { resolvePrincipal :: Text -> m (Maybe PrincipalRef)+  }++-- | The authorization seam: may this principal do this to this object, read at this freshness?+newtype PermissionChecker m = PermissionChecker+  { checkMemoryPermission ::+      MemoryFreshness ->+      PrincipalRef ->+      MemoryPermissionName ->+      MemoryObjectRef ->+      m MemoryDecision+  }++-- | How a process that /discovers/ its own work obtains authorization for it.+--+-- Interactive callers arrive holding a context. A background worker does not: it claims a due+-- timer or a queued task, reads which memory space that work belongs to, and only then needs a+-- decision about that space. This is the seam that lets it ask for one without inventing it.+--+-- A trusted in-process host uses 'assumeAuthorizedContextProvider'. A host behind a service+-- boundary wires this to its own authorizer, typically a partially applied+-- 'Kioku.Api.Access.authorizeMemoryAccess' over the credential the worker runs under.+newtype MemoryContextProvider m = MemoryContextProvider+  { contextForSpace :: MemorySpaceId -> m (Either MemoryAccessDenial MemoryAccessContext)+  }++-- | The embedded-host provider: assume authorization for every space, as one named actor.+--+-- Named to be conspicuous for the same reason 'assumeAuthorizedMemoryContext' is. A worker+-- wired to this one will happily act in any space a timer names.+assumeAuthorizedContextProvider :: (Applicative m) => MemoryActor -> MemoryContextProvider m+assumeAuthorizedContextProvider actor =+  MemoryContextProvider (pure . Right . (`assumeAuthorizedMemoryContext` actor))++-- | The proof that an authorization decision was made, carried into Kioku's core.+--+-- Holding one of these means the three gates have already been passed for the listed+-- permissions on the named space. Kioku's core does not re-derive it, cannot re-derive it, and+-- must not proceed without it.+--+-- The data constructor is not exported from "Kioku.Api.Access" precisely because constructing+-- one is an assertion. Use 'Kioku.Api.Access.authorizeMemoryAccess' to earn one, or+-- 'assumeAuthorizedMemoryContext' to state plainly that you are not checking.+data MemoryAccessContext = MemoryAccessContext+  { memorySpaceId :: !MemorySpaceId,+    actor :: !MemoryActor,+    grantedPermissions :: !(Set MemoryPermission),+    decisionToken :: !(Maybe MemoryDecisionToken)+  }+  deriving stock (Eq, Show, Generic)++-- Read-only accessors rather than exported field selectors.+--+-- Exporting the fields would export record-update syntax with them, and+-- @context { grantedPermissions = everything }@ widens an authorized decision without ever+-- naming the constructor — which is the exact hole keeping the constructor internal is meant to+-- close. Reading is safe; rewriting is not.++memoryContextSpace :: MemoryAccessContext -> MemorySpaceId+memoryContextSpace context = context.memorySpaceId++memoryContextActor :: MemoryAccessContext -> MemoryActor+memoryContextActor context = context.actor++memoryContextPermissions :: MemoryAccessContext -> Set MemoryPermission+memoryContextPermissions context = context.grantedPermissions++-- | The revision this context's decision was made at, if a decision was actually made.+memoryContextDecisionToken :: MemoryAccessContext -> Maybe MemoryDecisionToken+memoryContextDecisionToken context = context.decisionToken++-- | Was this particular action authorized? A context authorizes exactly the permissions it was+-- minted for, so a read context cannot be spent on a write.+memoryContextAllows :: MemoryPermission -> MemoryAccessContext -> Bool+memoryContextAllows permission context =+  Set.member permission context.grantedPermissions++-- | The actor to record on a fact written under this context.+--+-- Every write Kioku accepts through the memory-space API is attributed to the principal the+-- context was minted for, never to one the caller names separately. That is what stops a caller+-- authorized as one principal from writing an event claiming another one acted.+memoryContextRecordedActor :: MemoryAccessContext -> RecordedPrincipal+memoryContextRecordedActor context =+  KnownPrincipal (actorPrincipal context.actor)++-- | The freshness a follow-up authorization read should use, given what this context already+-- observed. This is the forwarding rule: a context minted from a real decision pins later reads+-- to at least that revision, and an assumed context pins nothing because it observed nothing.+memoryContextFreshness :: MemoryAccessContext -> MemoryFreshness+memoryContextFreshness context =+  maybe MemoryFreshnessDefault MemoryFreshnessAtLeast context.decisionToken++-- | Build a context without consulting anyone: the embedded-host escape hatch.+--+-- This is for a single-tenant, in-process host that owns its own database and has no+-- authentication boundary — a CLI, a test, a library embedded in an application that has already+-- authorized the user by other means. It grants every permission on the named space and carries+-- no decision token, because no decision was made.+--+-- It is named the way it is so that it cannot be used by accident and cannot be missed in+-- review. A service that reaches for this is shipping an unauthenticated endpoint.+assumeAuthorizedMemoryContext :: MemorySpaceId -> MemoryActor -> MemoryAccessContext+assumeAuthorizedMemoryContext memorySpaceId actor =+  MemoryAccessContext+    { memorySpaceId,+      actor,+      grantedPermissions = Set.fromList allMemoryPermissions,+      decisionToken = Nothing+    }++-- Wire instances. The leaf identifiers cross the wire as plain strings and decode through their+-- validating constructors, so a decoded value obeys the same rules as a constructed one.+--+-- 'MemoryAccessContext' has none, deliberately. It is a decision, not a document: giving it a+-- 'FromJSON' instance would let an authorized context be written down, stored, and replayed+-- later against a grant that has since been revoked.++instance ToJSON MemorySpaceId where+  toJSON = toJSON . memorySpaceIdText++instance FromJSON MemorySpaceId where+  parseJSON = withText "MemorySpaceId" (orFail . mkMemorySpaceId)++instance ToJSON PrincipalRef where+  toJSON = toJSON . principalRefText++instance FromJSON PrincipalRef where+  parseJSON = withText "PrincipalRef" (orFail . mkPrincipalRef)++instance ToJSON RecordedPrincipal where+  toJSON = toJSON . recordedPrincipalText++instance FromJSON RecordedPrincipal where+  parseJSON = withText "RecordedPrincipal" (orFail . parseRecordedPrincipal)++instance ToJSON MemoryActor where+  toJSON = toJSON . actorPrincipal++instance FromJSON MemoryActor where+  parseJSON = fmap MemoryActor . parseJSON++instance ToJSON MemoryOwner where+  toJSON = toJSON . ownerPrincipal++instance FromJSON MemoryOwner where+  parseJSON = fmap MemoryOwner . parseJSON++instance ToJSON MemoryPermission where+  toJSON = toJSON . memoryPermissionText++instance FromJSON MemoryPermission where+  parseJSON = withText "MemoryPermission" (orFail . parseMemoryPermission)++instance ToJSON MemoryDecisionToken where+  toJSON = toJSON . memoryDecisionTokenText++instance FromJSON MemoryDecisionToken where+  parseJSON = withText "MemoryDecisionToken" (orFail . mkMemoryDecisionToken)++orFail :: (MonadFail m) => Either Text a -> m a+orFail = either (fail . Text.unpack) pure++-- | Characters a rendered object reference gives meaning to: @:@ separates type from id and @#@+-- separates an object from a relation.+tupleRefChars :: Text+tupleRefChars = ":#"++-- | Everything 'tupleRefChars' reserves, plus the characters Kioku's own scope-identity encoding+-- reserves (see 'Kioku.Api.Scope.mkNamespace').+reservedRefChars :: Text+reservedRefChars = tupleRefChars <> "%/"++-- | Shared edge validation for the opaque identifiers Kioku carries but does not own: reject the+-- empty string, anything unprintable, and any character the caller's own encodings reserve.+validateOpaqueId :: Text -> Text -> Text -> Either Text Text+validateOpaqueId label reserved value+  | Text.null value = Left (label <> " must not be empty")+  | Text.length value > maxOpaqueIdLength =+      Left (label <> " must be at most " <> Text.pack (show maxOpaqueIdLength) <> " characters")+  | Just offending <- Text.find (\c -> Char.isSpace c || Char.isControl c) value =+      Left (label <> " must not contain whitespace or control characters: " <> Text.pack (show offending))+  | Just offending <- Text.find (`Text.elem` reserved) value =+      Left (label <> " must not contain " <> Text.singleton offending <> ": " <> value)+  | otherwise = Right value++-- | A bound generous enough for any rendered TypeID or scope name and small enough to keep a+-- hostile caller from turning an identifier column into a blob.+maxOpaqueIdLength :: Int+maxOpaqueIdLength = 128

@@ -0,0 +1,338 @@+-- | What a recall call searches, said out loud.+--+-- Recall has always been able to do two quite different things, and until this module existed it+-- said both of them with the same value. A 'Kioku.Api.Scope.MemoryScope' of+-- @ScopeGlobal (Namespace "mori")@ handed to recall meant /every scope in the namespace/ — the+-- scope filter vanished and entity-scoped rows came back too — while the same value handed to+-- 'Kioku.Recall.getActiveByScope' meant /the global bucket only/. Both behaviours are wanted.+-- Neither is wrong. But one value naming both of them is a defect you cannot see at a call site,+-- and the difference is how many rows a caller gets and which ones.+--+-- 'RecallTarget' names the two meanings apart:+--+-- * @'ExactScope' scope@ searches exactly that scope. @'ExactScope' ('Kioku.Api.Scope.ScopeGlobal'+--   ns)@ is the global bucket of @ns@ and nothing else — a request that had no representation at+--   all before this type.+-- * @'NamespaceWide' ns@ searches every scope in @ns@.+--+-- __The target never selects a tenant.__ A memory space is the isolation boundary+-- ('Kioku.Api.Access.MemorySpaceId'), and it is supplied at execution by the+-- 'Kioku.Api.Access.MemoryAccessContext' that authorized the call — never by the target.+-- "Namespace-wide" therefore means every scope in one namespace /of one already authorized+-- space/. Widening what you search must never widen who you are.+--+-- Nothing here knows about SQL, PostgreSQL, or the effect stack; this module is the vocabulary,+-- and "Kioku.Recall" is where a target is executed.+module Kioku.Api.Recall+  ( -- * What a recall call targets+    RecallTarget (..),+    recallTargetNamespace,+    recallTargetExactScope,+    recallTargetIsNamespaceWide,++    -- * Migrating from the overloaded scope+    legacyRecallTarget,++    -- * How a recall call searches+    RecallStrategy (..),+    allRecallStrategies,+    recallStrategyText,+    parseRecallStrategy,++    -- * How many results it may return+    RecallLimit,+    mkRecallLimit,+    recallLimitInt,+    defaultRecallLimit,+    maxRecallLimit,++    -- * The request+    RecallQuery (..),+    mkRecallQuery,+  )+where++import Data.Aeson (Key, (.:), (.:?))+import Data.Aeson qualified as Aeson+import Data.Aeson.Types qualified as Aeson (Pair, Parser)+import Data.Text qualified as Text+import Kioku.Api.Scope+  ( MemoryScope (..),+    Namespace (..),+    ScopeKind (..),+    mkNamespace,+    mkScopeKind,+  )+import Kioku.Prelude++-- | The two things a recall call can search, kept apart by construction.+--+-- There is deliberately no third constructor and no \"unspecified\" case. A target that could be+-- absent would immediately grow a default, and the only sensible default for a search is the+-- widest one — which is how the overloaded scope became a hazard in the first place.+data RecallTarget+  = -- | Exactly this scope. For @'ScopeGlobal' ns@ that is the global bucket of @ns@: rows+    -- recorded with no entity scope. For @'ScopeEntity' ns kind ref@ it is that entity and no+    -- other.+    ExactScope !MemoryScope+  | -- | Every scope in this namespace: the global bucket and every entity scope under it. This+    -- is what a pre-'RecallTarget' recall did with a global scope.+    NamespaceWide !Namespace+  deriving stock (Eq, Show, Generic)++-- | The namespace a target searches. Every target names exactly one; a target that spanned+-- namespaces has never existed and is not being introduced here.+recallTargetNamespace :: RecallTarget -> Namespace+recallTargetNamespace = \case+  ExactScope (ScopeGlobal ns) -> ns+  ExactScope (ScopeEntity ns _ _) -> ns+  NamespaceWide ns -> ns++-- | The scope an exact target names, or 'Nothing' for a namespace-wide one.+recallTargetExactScope :: RecallTarget -> Maybe MemoryScope+recallTargetExactScope = \case+  ExactScope scope -> Just scope+  NamespaceWide _ -> Nothing++-- | Whether this target widens past a single scope. Worth a name of its own: this is the+-- predicate an audit log, a CLI confirmation, or a policy check actually wants to ask.+recallTargetIsNamespaceWide :: RecallTarget -> Bool+recallTargetIsNamespaceWide = \case+  ExactScope _ -> False+  NamespaceWide _ -> True++-- | The target a pre-'RecallTarget' caller was asking for, given the 'MemoryScope' it passed.+--+-- @+-- 'ScopeGlobal' ns        -> 'NamespaceWide' ns+-- 'ScopeEntity' ns k r    -> 'ExactScope' ('ScopeEntity' ns k r)+-- @+--+-- Use this exactly once per call site, while migrating, to keep the results you have today. Then+-- decide: if you wanted the global bucket rather than the whole namespace, the answer is+-- @'ExactScope' ('ScopeGlobal' ns)@, which this function deliberately never produces.+--+-- Mapping the global scope to 'NamespaceWide' rather than to an exact global bucket is the whole+-- point. The opposite mapping would compile, run, and silently return a small fraction of the+-- rows the caller used to get.+legacyRecallTarget :: MemoryScope -> RecallTarget+legacyRecallTarget = \case+  ScopeGlobal ns -> NamespaceWide ns+  scope@ScopeEntity {} -> ExactScope scope++-- | Which retrieval channels a recall call runs.+--+-- This lived in @Kioku.Recall@ until targets became explicit. It belongs beside them: a request+-- is a target, a query, a strategy and a bound, and all four are pure vocabulary that a host,+-- an HTTP service, or an SDK has to be able to name without depending on the runtime.+data RecallStrategy+  = -- | Full-text search only. Needs no embedding endpoint.+    Keyword+  | -- | Vector similarity only. Needs the query embedded.+    Embedding+  | -- | Both channels, fused by reciprocal rank. The default and what you almost always want.+    Hybrid+  deriving stock (Generic, Eq, Show, Enum, Bounded)++-- | Every strategy, in the order they are documented.+allRecallStrategies :: [RecallStrategy]+allRecallStrategies = [minBound .. maxBound]++-- | The wire and command-line spelling of a strategy. These three strings appear in+-- @kioku recall --strategy@ and in every request body, so changing one is a breaking change.+recallStrategyText :: RecallStrategy -> Text+recallStrategyText = \case+  Keyword -> "keyword"+  Embedding -> "embedding"+  Hybrid -> "hybrid"++parseRecallStrategy :: Text -> Either Text RecallStrategy+parseRecallStrategy = \case+  "keyword" -> Right Keyword+  "embedding" -> Right Embedding+  "hybrid" -> Right Hybrid+  other ->+    Left+      ( "unknown recall strategy: "+          <> other+          <> " (expected "+          <> Text.intercalate ", " (recallStrategyText <$> allRecallStrategies)+          <> ")"+      )++-- | How many hits a recall call may return: at least one, at most 'maxRecallLimit'.+--+-- A validated newtype rather than a bare 'Int' because the two ends mean different things and+-- both were previously unenforced at the library boundary. Zero or negative is not \"no limit\",+-- it is a caller bug that silently returns nothing; and an unbounded upper end invites a request+-- for a million rows that the database would have to plan for. The command line has enforced+-- @1-100@ since it was written — this puts the same rule where library callers meet it.+newtype RecallLimit = RecallLimit Int+  deriving stock (Eq, Ord, Show, Generic)++-- | The largest number of hits a single recall call may ask for.+--+-- 100 matches the range @kioku recall --limit@ has always accepted, and it is also the most a+-- request can produce: each channel contributes at most 50 candidates, so a fused result set+-- holds at most 100 distinct memories. Asking for more has never returned more.+maxRecallLimit :: Int+maxRecallLimit = 100++-- | What @kioku recall@ uses when no limit is given.+defaultRecallLimit :: RecallLimit+defaultRecallLimit = RecallLimit 8++mkRecallLimit :: Int -> Either Text RecallLimit+mkRecallLimit value+  | value < 1 = Left ("recall limit must be at least 1: " <> Text.pack (show value))+  | value > maxRecallLimit =+      Left+        ( "recall limit must be at most "+            <> Text.pack (show maxRecallLimit)+            <> ": "+            <> Text.pack (show value)+        )+  | otherwise = Right (RecallLimit value)++recallLimitInt :: RecallLimit -> Int+recallLimitInt (RecallLimit value) = value++-- | Everything a recall call needs except the space it runs in.+--+-- The memory space is deliberately absent. It comes from the+-- 'Kioku.Api.Access.MemoryAccessContext' passed to 'Kioku.Recall.recall', because a request is+-- something a caller composes and a space is something an authorization decision granted. Keeping+-- them in separate values means no code path can widen a target and a tenancy in one edit.+--+-- Every field is already validated by its own type, so the record constructor is safe to export:+-- a 'RecallTarget' cannot be ambiguous and a 'RecallLimit' cannot be zero. 'mkRecallQuery' is a+-- convenience for callers holding a plain 'Int'.+--+-- The query text is /not/ validated. It is user input on its way to+-- @websearch_to_tsquery@, which is total by design and never raises, and rejecting empty or+-- punctuation-only text here would break callers that rely on today's \"no matches\" answer.+data RecallQuery = RecallQuery+  { target :: !RecallTarget,+    query :: !Text,+    strategy :: !RecallStrategy,+    maxResults :: !RecallLimit+  }+  deriving stock (Eq, Show, Generic)++mkRecallQuery :: RecallTarget -> Text -> RecallStrategy -> Int -> Either Text RecallQuery+mkRecallQuery target query strategy limit = do+  maxResults <- mkRecallLimit limit+  Right RecallQuery {target, query, strategy, maxResults}++-- * Wire format++-- $+-- The encoding is hand-written rather than derived, and the discriminator is required. Three+-- meanings, three tags, no field whose /absence/ changes what the request means:+--+-- @+-- {"kind":"exact_global","namespace":"mori"}+-- {"kind":"exact_entity","namespace":"mori","scope_kind":"repo","scope_ref":"shinzui\/kikan"}+-- {"kind":"namespace_wide","namespace":"mori"}+-- @+--+-- A derived encoding would have spelled the two Haskell constructors instead, leaving the+-- exact-global and exact-entity cases separated only by whether @scope_kind@ was present — which+-- is the null-means-something representation this whole change exists to remove, moved from SQL+-- onto the wire.+--+-- Decoding is strict in both directions: an unknown @kind@ is an error, and a variant carrying a+-- field it has no meaning for ('exact_global' with a @scope_kind@, say) is an error too, rather+-- than a value with a silently ignored field.++instance ToJSON RecallTarget where+  toJSON = \case+    ExactScope (ScopeGlobal (Namespace ns)) ->+      Aeson.object [pair "kind" exactGlobalTag, pair "namespace" ns]+    ExactScope (ScopeEntity (Namespace ns) (ScopeKind kind) ref) ->+      Aeson.object+        [ pair "kind" exactEntityTag,+          pair "namespace" ns,+          pair "scope_kind" kind,+          pair "scope_ref" ref+        ]+    NamespaceWide (Namespace ns) ->+      Aeson.object [pair "kind" namespaceWideTag, pair "namespace" ns]++instance FromJSON RecallTarget where+  parseJSON = Aeson.withObject "RecallTarget" \o -> do+    kind <- o .: "kind"+    namespace <- parseValidated mkNamespace =<< o .: "namespace"+    scopeKind <- o .:? "scope_kind"+    scopeRef <- o .:? "scope_ref"+    case (kind :: Text, scopeKind, scopeRef) of+      (k, Nothing, Nothing)+        | k == exactGlobalTag -> pure (ExactScope (ScopeGlobal namespace))+        | k == namespaceWideTag -> pure (NamespaceWide namespace)+      (k, Just kindText, Just ref)+        | k == exactEntityTag -> do+            entityKind <- parseValidated mkScopeKind kindText+            pure (ExactScope (ScopeEntity namespace entityKind ref))+      (k, _, _)+        | k `elem` [exactGlobalTag, exactEntityTag, namespaceWideTag] ->+            fail+              ( "recall target "+                  <> show k+                  <> " must carry "+                  <> ( if k == exactEntityTag+                         then "both scope_kind and scope_ref"+                         else "neither scope_kind nor scope_ref"+                     )+              )+        | otherwise ->+            fail+              ( "unknown recall target kind: "+                  <> show k+                  <> " (expected exact_global, exact_entity or namespace_wide)"+              )++instance ToJSON RecallStrategy where+  toJSON = toJSON . recallStrategyText++instance FromJSON RecallStrategy where+  parseJSON = Aeson.withText "RecallStrategy" (parseValidated parseRecallStrategy)++instance ToJSON RecallLimit where+  toJSON = toJSON . recallLimitInt++-- | Decoding enforces the same bounds as 'mkRecallLimit'. A newtype validated only on the path+-- the host controls is validated only where nobody attacks it.+instance FromJSON RecallLimit where+  parseJSON value = parseValidated mkRecallLimit =<< parseJSON value++instance ToJSON RecallQuery where+  toJSON request =+    Aeson.object+      [ pair "target" request.target,+        pair "query" request.query,+        pair "strategy" request.strategy,+        pair "max_results" request.maxResults+      ]++instance FromJSON RecallQuery where+  parseJSON = Aeson.withObject "RecallQuery" \o ->+    RecallQuery+      <$> o .: "target"+      <*> o .: "query"+      <*> o .: "strategy"+      <*> o .: "max_results"++exactGlobalTag, exactEntityTag, namespaceWideTag :: Text+exactGlobalTag = "exact_global"+exactEntityTag = "exact_entity"+namespaceWideTag = "namespace_wide"++-- | Run one of this project's @Either Text@ validating constructors inside a parser, so a wire+-- value is held to exactly the rule a directly constructed one is.+parseValidated :: (a -> Either Text b) -> a -> Aeson.Parser b+parseValidated validate = either (fail . Text.unpack) pure . validate++-- | 'Kioku.Prelude' re-exports @Control.Lens@, which owns @(.=)@, so aeson's stays out of scope+-- and object fields are built through this instead.+pair :: (ToJSON v) => Key -> v -> Aeson.Pair+pair key value = (key, toJSON value)

@@ -0,0 +1,350 @@+-- | Pure wire-format and validation tests for "Kioku.Api.Access".+--+-- Nothing here touches a database, a network, or any identity service. These tests pin two+-- things: the exact bytes the access vocabulary puts on the wire, and the boundary rules Kioku+-- enforces on identifiers it carries but does not own.+module Kioku.Api.AccessSpec (tests) where++import Data.Aeson (FromJSON, ToJSON, decode, encode)+import Data.ByteString.Lazy.Char8 qualified as LBS8+import Data.Set qualified as Set+import Data.Text (Text)+import Data.Text qualified as Text+import Kioku.Api.Access+import Kioku.Api.Access.Internal qualified as Internal+import Test.Tasty (TestTree, testGroup)+import Test.Tasty.HUnit (assertBool, testCase, (@?=))++tests :: TestTree+tests =+  testGroup+    "Kioku.Api.Access"+    [ memorySpaceIdTests,+      principalRefTests,+      recordedPrincipalTests,+      permissionWireTests,+      jsonRoundTripTests,+      objectRefTests,+      bindingTests,+      contextTests+    ]++-- | A memory space id is Kioku's own object identifier, so Kioku owns its rules. It has to+-- survive being an authorization object id, an indexed column, and half of a rendered object+-- reference, which is what the reserved characters are about.+memorySpaceIdTests :: TestTree+memorySpaceIdTests =+  testGroup+    "MemorySpaceId"+    [ testCase "accepts an ordinary identifier" do+        fmap memorySpaceIdText (mkMemorySpaceId "space_01h9xk3v7hf8b9c0d1e2f3g4h5")+          @?= Right "space_01h9xk3v7hf8b9c0d1e2f3g4h5",+      testCase "accepts a host-shaped label" do+        fmap memorySpaceIdText (mkMemorySpaceId "acme-tenant-3") @?= Right "acme-tenant-3",+      testCase "rejects the empty string" do+        assertLeft "empty" (mkMemorySpaceId ""),+      testGroup+        "rejects characters an encoding gives meaning to"+        [ testCase (Text.unpack ("contains " <> Text.singleton c)) do+            assertLeft ("reserved " <> show c) (mkMemorySpaceId ("space" <> Text.singleton c <> "one"))+        | c <- ":#%/"+        ],+      testCase "rejects whitespace" do+        assertLeft "space" (mkMemorySpaceId "space one"),+      testCase "rejects control characters" do+        assertLeft "control" (mkMemorySpaceId "space\ETXone"),+      testCase "rejects an over-long identifier" do+        assertLeft "too long" (mkMemorySpaceId (Text.replicate 129 "a")),+      testCase "accepts exactly the maximum length" do+        assertRight (mkMemorySpaceId (Text.replicate 128 "a")),+      testCase "the legacy space is a real, explicit id" do+        memorySpaceIdText legacyMemorySpaceId @?= "kioku_legacy",+      testCase "the legacy space is not the empty string" do+        -- The whole point of a named legacy space is that absence of a partition never means+        -- "everywhere". If this ever became empty or defaultable, that guarantee would go.+        assertBool "non-empty" (not (Text.null (memorySpaceIdText legacyMemorySpaceId)))+    ]++-- | A principal reference is somebody else's identifier. Kioku validates only what it needs to+-- store and compare the value safely, and deliberately does not know which prefixes exist.+principalRefTests :: TestTree+principalRefTests =+  testGroup+    "PrincipalRef"+    [ testGroup+        "accepts every directory-rendered principal form verbatim"+        [ testCase (Text.unpack rendered) do+            fmap principalRefText (mkPrincipalRef rendered) @?= Right rendered+        | rendered <- renderedPrincipals+        ],+      testCase "accepts a prefix Kioku has never heard of" do+        -- This is the load-bearing test for the boundary: Kioku holds no principal-kind+        -- vocabulary, so a directory that grows an eighth kind tomorrow needs no change here.+        -- A version of this constructor that validated prefixes would fail this case and would+        -- have forked the directory's own list.+        fmap principalRefText (mkPrincipalRef "workload_01h9xk3v7hf8b9c0d1e2f3g4h5")+          @?= Right "workload_01h9xk3v7hf8b9c0d1e2f3g4h5",+      testCase "rejects the empty string" do+        assertLeft "empty" (mkPrincipalRef ""),+      testCase "rejects a tuple separator" do+        assertLeft "colon" (mkPrincipalRef "person:01h9xk"),+      testCase "rejects a userset separator" do+        assertLeft "hash" (mkPrincipalRef "team_01h9xk#member"),+      testCase "rejects whitespace" do+        assertLeft "space" (mkPrincipalRef "person_01h9 xk"),+      testCase "permits characters a space id forbids" do+        -- '%' and '/' are reserved by Kioku's own scope encoding, not by anything the directory+        -- owns, so they must not be imposed on a value the directory renders.+        assertRight (mkPrincipalRef "person_01h9/xk")+    ]++-- | Rendered principal identifiers in the shape a real directory produces: a kind prefix, an+-- underscore, and a base32 UUIDv7 suffix.+renderedPrincipals :: [Text]+renderedPrincipals =+  [ "person_01h9xk3v7hf8b9c0d1e2f3g4h5",+    "agent_01h9xk3v7hf8b9c0d1e2f3g4h6",+    "team_01h9xk3v7hf8b9c0d1e2f3g4h7",+    "role_01h9xk3v7hf8b9c0d1e2f3g4h8",+    "service_01h9xk3v7hf8b9c0d1e2f3g4h9",+    "connector_01h9xk3v7hf8b9c0d1e2f3g4ha",+    "org_01h9xk3v7hf8b9c0d1e2f3g4hb"+  ]++-- | A recorded principal is what a stored event says about who acted. The property that matters+-- is that the three cases can never be confused for one another on the wire — in particular that+-- a legacy free-text agent label can never be read back as a principal a directory issued.+recordedPrincipalTests :: TestTree+recordedPrincipalTests =+  testGroup+    "RecordedPrincipal"+    [ testCase "a known principal renders as the bare directory form" do+        recordedPrincipalText (KnownPrincipal (expectRight (mkPrincipalRef "agent_01h9xk")))+          @?= "agent_01h9xk",+      testCase "a legacy agent label is marked" do+        recordedPrincipalText (LegacyPrincipal (legacyPrincipalRef "demo-agent"))+          @?= "kioku:legacy:demo-agent",+      testCase "an unattributed event says so" do+        recordedPrincipalText UnattributedPrincipal @?= "kioku:unattributed",+      testCase "a legacy label never parses back as a directory principal" do+        -- The load-bearing case. A legacy agentId is a string somebody typed; promoting it to a+        -- principal would put an identity nobody issued into an audit trail.+        parseRecordedPrincipal "kioku:legacy:demo-agent"+          @?= Right (LegacyPrincipal (legacyPrincipalRef "demo-agent")),+      testCase "a legacy label that looks like a marker still round-trips" do+        roundTripPrincipal (LegacyPrincipal (legacyPrincipalRef "kioku:legacy:nested")),+      testCase "a legacy label containing a colon round-trips" do+        roundTripPrincipal (LegacyPrincipal (legacyPrincipalRef "rei:coach")),+      testCase "an empty legacy label round-trips" do+        -- Historical agent ids were unvalidated free text, so decoding one must not fail.+        roundTripPrincipal (LegacyPrincipal (legacyPrincipalRef "")),+      testCase "an unknown kioku marker is a loud error" do+        assertLeft "unknown marker" (parseRecordedPrincipal "kioku:something-new"),+      testCase "a directory principal still has to be valid" do+        assertLeft "reserved" (parseRecordedPrincipal "person#member"),+      testCase "no directory principal can spell either marker" do+        -- This is why the marker scheme is unambiguous rather than merely unlikely.+        assertLeft "colon" (mkPrincipalRef "kioku:legacy:x")+        assertLeft "colon" (mkPrincipalRef "kioku:unattributed"),+      testCase "encodes as a bare JSON string" do+        LBS8.unpack (encode (LegacyPrincipal (legacyPrincipalRef "demo-agent")))+          @?= "\"kioku:legacy:demo-agent\"",+      testCase "a context records its own actor, not a caller-named one" do+        memoryContextRecordedActor (assumeAuthorizedMemoryContext spaceOne testActor)+          @?= KnownPrincipal (actorPrincipal testActor)+    ]++roundTripPrincipal :: RecordedPrincipal -> IO ()+roundTripPrincipal value =+  parseRecordedPrincipal (recordedPrincipalText value) @?= Right value++-- | These five spellings end up inside stored events. Changing one is a breaking change, so it+-- should have to be done on purpose, with this test in the diff.+permissionWireTests :: TestTree+permissionWireTests =+  testGroup+    "MemoryPermission"+    [ testCase "has the expected stable spellings" do+        fmap memoryPermissionText allMemoryPermissions+          @?= ["read", "record", "distill", "forget", "admin"],+      testCase "encodes as a bare JSON string" do+        LBS8.unpack (encode MemoryDistill) @?= "\"distill\"",+      testCase "parses back from every spelling" do+        traverse (parseMemoryPermission . memoryPermissionText) allMemoryPermissions+          @?= Right allMemoryPermissions,+      testCase "rejects an unknown spelling" do+        assertLeft "unknown" (parseMemoryPermission "write"),+      testCase "enumerates exactly five actions" do+        length allMemoryPermissions @?= 5+    ]++jsonRoundTripTests :: TestTree+jsonRoundTripTests =+  testGroup+    "JSON round-trips"+    [ roundTrip "MemorySpaceId" (expectRight (mkMemorySpaceId "space_01h9xk")),+      roundTrip "PrincipalRef" (expectRight (mkPrincipalRef "person_01h9xk")),+      roundTrip "MemoryActor" (MemoryActor (expectRight (mkPrincipalRef "agent_01h9xk"))),+      roundTrip "MemoryOwner" (MemoryOwner (expectRight (mkPrincipalRef "person_01h9xk"))),+      roundTrip "RecordedPrincipal (known)" (KnownPrincipal (expectRight (mkPrincipalRef "agent_01h9xk"))),+      roundTrip "RecordedPrincipal (legacy)" (LegacyPrincipal (legacyPrincipalRef "demo-agent")),+      roundTrip "RecordedPrincipal (unattributed)" UnattributedPrincipal,+      testGroup+        "MemoryPermission"+        [roundTrip (show permission) permission | permission <- allMemoryPermissions],+      testCase "identifiers cross the wire as bare strings, not objects" do+        LBS8.unpack (encode (expectRight (mkMemorySpaceId "space_01h9xk"))) @?= "\"space_01h9xk\"",+      testCase "decoding enforces the same rules as constructing" do+        -- Without this, a validated newtype is only validated on the path nobody attacks.+        decode @MemorySpaceId "\"space:one\"" @?= Nothing,+      testCase "decoding rejects an empty principal reference" do+        decode @PrincipalRef "\"\"" @?= Nothing+    ]++-- | The object reference is what makes two memory spaces genuinely separate questions to ask an+-- authorization engine.+objectRefTests :: TestTree+objectRefTests =+  testGroup+    "object references"+    [ testCase "renders as type:id" do+        memoryObjectRefText (memorySpaceObjectRef testBinding spaceOne)+          @?= "memory_space:space_one",+      testCase "two spaces produce two different objects" do+        assertBool+          "distinct"+          ( memoryObjectRefText (memorySpaceObjectRef testBinding spaceOne)+              /= memoryObjectRefText (memorySpaceObjectRef testBinding spaceTwo)+          ),+      testCase "the object depends on the space and nothing else" do+        -- Namespace and scope organize memory inside a space; they are not part of its identity+        -- as an authorization object. Two hosts sharing one space share one object.+        memorySpaceObjectRef testBinding spaceOne @?= memorySpaceObjectRef testBinding spaceOne,+      testCase "the host names the object type" do+        let other = expectRight (mkMemoryAuthorizationBinding (expectRight (mkMemoryObjectType "tenant")) fullBindings)+        memoryObjectRefText (memorySpaceObjectRef other spaceOne) @?= "tenant:space_one"+    ]++bindingTests :: TestTree+bindingTests =+  testGroup+    "MemoryAuthorizationBinding"+    [ testCase "rejects a binding with any action missing" do+        assertLeft+          "incomplete"+          ( mkMemoryAuthorizationBinding+              (expectRight (mkMemoryObjectType "memory_space"))+              (filter ((/= MemoryForget) . fst) fullBindings)+          ),+      testCase "names the missing actions" do+        case mkMemoryAuthorizationBinding+          (expectRight (mkMemoryObjectType "memory_space"))+          (filter ((`notElem` [MemoryForget, MemoryAdmin]) . fst) fullBindings) of+          Right _ -> fail "expected an incomplete binding to be rejected"+          Left message -> do+            assertBool "names forget" ("forget" `Text.isInfixOf` message)+            assertBool "names admin" ("admin" `Text.isInfixOf` message),+      testCase "a complete binding resolves every action" do+        fmap+          (memoryPermissionNameText . objectPermission . memoryPermissionBinding testBinding)+          allMemoryPermissions+          @?= ["can_read", "can_record", "can_distill", "can_forget", "can_administer"],+      testCase "each action carries its own coarse scope" do+        fmap+          (memoryCoarseScopeText . coarseScope . memoryPermissionBinding testBinding)+          allMemoryPermissions+          @?= ["kioku:read", "kioku:record", "kioku:distill", "kioku:forget", "kioku:admin"]+    ]++contextTests :: TestTree+contextTests =+  testGroup+    "MemoryAccessContext"+    [ testCase "an assumed context grants every action" do+        let context = assumeAuthorizedMemoryContext spaceOne testActor+        fmap (`memoryContextAllows` context) allMemoryPermissions+          @?= replicate 5 True,+      testCase "an assumed context observed nothing, so it pins nothing" do+        memoryContextFreshness (assumeAuthorizedMemoryContext spaceOne testActor)+          @?= MemoryFreshnessDefault,+      testCase "an assumed context names the space it was assumed for" do+        memoryContextSpace (assumeAuthorizedMemoryContext spaceOne testActor) @?= spaceOne,+      testCase "an assumed context names its actor" do+        memoryContextActor (assumeAuthorizedMemoryContext spaceOne testActor) @?= testActor,+      testCase "a context carrying a decision pins later reads to it" do+        let token = expectRight (mkMemoryDecisionToken "rev-42")+            context =+              Internal.MemoryAccessContext+                { Internal.memorySpaceId = spaceOne,+                  Internal.actor = testActor,+                  Internal.grantedPermissions = Set.singleton MemoryRead,+                  Internal.decisionToken = Just token+                }+        memoryContextFreshness context @?= atLeastAsFresh token+        memoryContextDecisionToken context @?= Just token,+      testCase "a read context cannot be spent on a write" do+        -- The narrow context above is the one that matters. An assumed context grants+        -- everything by construction, so only a minted one can demonstrate that the granted+        -- set is actually consulted.+        let context =+              Internal.MemoryAccessContext+                { Internal.memorySpaceId = spaceOne,+                  Internal.actor = testActor,+                  Internal.grantedPermissions = Set.singleton MemoryRead,+                  Internal.decisionToken = Nothing+                }+        memoryContextAllows MemoryRead context @?= True+        memoryContextAllows MemoryForget context @?= False+        memoryContextPermissions context @?= Set.singleton MemoryRead+    ]++testActor :: MemoryActor+testActor = MemoryActor (expectRight (mkPrincipalRef "person_01h9xk3v7hf8b9c0d1e2f3g4h5"))++spaceOne, spaceTwo :: MemorySpaceId+spaceOne = expectRight (mkMemorySpaceId "space_one")+spaceTwo = expectRight (mkMemorySpaceId "space_two")++-- | A binding a host might plausibly write. Kioku ships no default one, so a test has to supply+-- its own — which is the property being demonstrated as much as it is test scaffolding.+testBinding :: MemoryAuthorizationBinding+testBinding =+  expectRight+    ( mkMemoryAuthorizationBinding+        (expectRight (mkMemoryObjectType "memory_space"))+        fullBindings+    )++fullBindings :: [(MemoryPermission, MemoryPermissionBinding)]+fullBindings =+  [ binding MemoryRead "kioku:read" "can_read",+    binding MemoryRecord "kioku:record" "can_record",+    binding MemoryDistill "kioku:distill" "can_distill",+    binding MemoryForget "kioku:forget" "can_forget",+    binding MemoryAdmin "kioku:admin" "can_administer"+  ]+  where+    binding permission scope name =+      ( permission,+        MemoryPermissionBinding+          { coarseScope = expectRight (mkMemoryCoarseScope scope),+            objectPermission = expectRight (mkMemoryPermissionName name)+          }+      )++roundTrip :: (ToJSON a, FromJSON a, Eq a, Show a) => String -> a -> TestTree+roundTrip name value =+  testCase name (decode (encode value) @?= Just value)++assertLeft :: (Show a) => String -> Either Text a -> IO ()+assertLeft label = \case+  Left _ -> pure ()+  Right unexpected -> fail (label <> ": expected rejection, got " <> show unexpected)++assertRight :: (Show a) => Either Text a -> IO ()+assertRight = \case+  Right _ -> pure ()+  Left message -> fail ("expected acceptance, got: " <> Text.unpack message)++expectRight :: Either Text a -> a+expectRight = either (error . Text.unpack) id

@@ -0,0 +1,277 @@+-- 'rejects' names the type it is decoding at each call site rather than inferring it from an+-- expected value, because the whole point is that there /is/ no value.+{-# LANGUAGE AllowAmbiguousTypes #-}++-- | Pure tests for "Kioku.Api.Recall": the three things a recall call can target, the bytes+-- they put on the wire, and the conversion that keeps a pre-'RecallTarget' caller's results+-- unchanged.+--+-- Nothing here touches a database. What is being pinned is a vocabulary — specifically that the+-- exact global bucket, the exact entity scope, and the whole namespace are three distinguishable+-- values in Haskell and three distinguishable objects in JSON, which is the property whose+-- absence made @ScopeGlobal@ mean two different things depending on which function received it.+module Kioku.Api.RecallSpec (tests) where++import Data.Aeson (FromJSON, ToJSON, Value (..), decode, encode)+import Data.Aeson.KeyMap qualified as KeyMap+import Data.ByteString.Lazy (ByteString)+import Data.List (sort)+import Data.Text (Text)+import Data.Text qualified as Text+import Kioku.Api.Recall+import Kioku.Api.Scope (MemoryScope (..), Namespace (..), ScopeKind (..))+import Test.Tasty (TestTree, testGroup)+import Test.Tasty.HUnit (assertBool, testCase, (@?=))++tests :: TestTree+tests =+  testGroup+    "Kioku.Api.Recall"+    [ targetDistinctionTests,+      legacyConversionTests,+      targetWireTests,+      targetDecodingTests,+      strategyTests,+      limitTests,+      queryTests+    ]++-- | The whole reason this type exists: three meanings, three values.+targetDistinctionTests :: TestTree+targetDistinctionTests =+  testGroup+    "the three targets are three values"+    [ testCase "the exact global bucket is not the whole namespace" do+        assertBool+          "distinct"+          (ExactScope (ScopeGlobal mori) /= NamespaceWide mori),+      testCase "the exact global bucket is not an exact entity" do+        assertBool+          "distinct"+          (ExactScope (ScopeGlobal mori) /= ExactScope moriRepo),+      testCase "every target names exactly one namespace" do+        fmap+          recallTargetNamespace+          [ExactScope (ScopeGlobal mori), ExactScope moriRepo, NamespaceWide mori]+          @?= [mori, mori, mori],+      testCase "only an exact target has a scope" do+        recallTargetExactScope (ExactScope moriRepo) @?= Just moriRepo+        recallTargetExactScope (NamespaceWide mori) @?= Nothing,+      testCase "widening is a question a caller can ask" do+        -- An audit line, a CLI confirmation, or a policy check wants this predicate, and none of+        -- them should have to pattern-match a scope to compute it.+        fmap+          recallTargetIsNamespaceWide+          [ExactScope (ScopeGlobal mori), ExactScope moriRepo, NamespaceWide mori]+          @?= [False, False, True]+    ]++-- | The compatibility mapping. It preserves what a caller gets today, which means it must send+-- the global scope to the /wide/ target — the mapping that returns more rows, not fewer.+legacyConversionTests :: TestTree+legacyConversionTests =+  testGroup+    "legacyRecallTarget"+    [ testCase "a global scope stays namespace-wide" do+        legacyRecallTarget (ScopeGlobal mori) @?= NamespaceWide mori,+      testCase "an entity scope becomes an exact target" do+        legacyRecallTarget moriRepo @?= ExactScope moriRepo,+      testCase "it never silently narrows a caller to the global bucket" do+        -- The load-bearing case. The other mapping compiles, runs, and returns a small fraction+        -- of the rows the caller had yesterday, with no error and no warning.+        assertBool+          "not narrowed"+          (legacyRecallTarget (ScopeGlobal mori) /= ExactScope (ScopeGlobal mori)),+      testCase "the exact global bucket is reachable only by asking for it" do+        assertBool+          "no scope converts to an exact global target"+          ( ExactScope (ScopeGlobal mori)+              `notElem` fmap legacyRecallTarget [ScopeGlobal mori, moriRepo]+          )+    ]++-- | The wire contract. These three shapes end up in HTTP request bodies and SDK unions, so+-- changing one is a breaking change and should have to be done on purpose, with this test in the+-- diff.+targetWireTests :: TestTree+targetWireTests =+  testGroup+    "targets on the wire"+    [ encodesAs+        "exact global"+        (ExactScope (ScopeGlobal mori))+        "{\"kind\":\"exact_global\",\"namespace\":\"mori\"}",+      encodesAs+        "exact entity"+        (ExactScope moriRepo)+        "{\"kind\":\"exact_entity\",\"namespace\":\"mori\",\"scope_kind\":\"repo\",\"scope_ref\":\"shinzui/kikan\"}",+      encodesAs+        "namespace wide"+        (NamespaceWide mori)+        "{\"kind\":\"namespace_wide\",\"namespace\":\"mori\"}",+      testCase "the discriminator is what separates exact-global from namespace-wide" do+        -- Both carry a namespace and nothing else, so if the tag were dropped or defaulted the+        -- two would be the same object — which is the SQL-level defect this vocabulary replaces,+        -- moved onto the wire.+        assertBool+          "distinct encodings"+          (encode (ExactScope (ScopeGlobal mori)) /= encode (NamespaceWide mori)),+      testGroup+        "round-trips"+        [ roundTrip "exact global" (ExactScope (ScopeGlobal mori)),+          roundTrip "exact entity" (ExactScope moriRepo),+          roundTrip "namespace wide" (NamespaceWide mori),+          roundTrip "a ref containing a slash" (ExactScope moriRepo),+          roundTrip+            "a ref containing a colon"+            (ExactScope (ScopeEntity mori (ScopeKind "agent") "rei:coach"))+        ]+    ]++-- | Decoding is a contract, not a guess.+targetDecodingTests :: TestTree+targetDecodingTests =+  testGroup+    "decoding refuses what it cannot mean"+    [ testCase "an unknown kind is an error, not a default" do+        rejects @RecallTarget "{\"kind\":\"everything\",\"namespace\":\"mori\"}",+      testCase "a missing kind is an error, not namespace-wide" do+        rejects @RecallTarget "{\"namespace\":\"mori\"}",+      testCase "an exact global target may not carry a scope kind" do+        -- Accepting and ignoring it would let a caller believe they had asked for an entity.+        rejects @RecallTarget+          "{\"kind\":\"exact_global\",\"namespace\":\"mori\",\"scope_kind\":\"repo\"}",+      testCase "a namespace-wide target may not carry scope fields" do+        rejects @RecallTarget+          "{\"kind\":\"namespace_wide\",\"namespace\":\"mori\",\"scope_kind\":\"repo\",\"scope_ref\":\"x\"}",+      testCase "an exact entity target needs both halves of the scope" do+        rejects @RecallTarget "{\"kind\":\"exact_entity\",\"namespace\":\"mori\",\"scope_kind\":\"repo\"}"+        rejects @RecallTarget "{\"kind\":\"exact_entity\",\"namespace\":\"mori\",\"scope_ref\":\"x\"}"+        rejects @RecallTarget "{\"kind\":\"exact_entity\",\"namespace\":\"mori\"}",+      testCase "a namespace is held to the same rule as a constructed one" do+        -- 'mkNamespace' rejects the characters the scope-identity encoding gives meaning to. A+        -- decoder that skipped that check would validate only the path nobody attacks.+        rejects @RecallTarget "{\"kind\":\"namespace_wide\",\"namespace\":\"mori/other\"}"+        rejects @RecallTarget "{\"kind\":\"namespace_wide\",\"namespace\":\"\"}",+      testCase "a scope kind is held to the same rule as a constructed one" do+        rejects @RecallTarget+          "{\"kind\":\"exact_entity\",\"namespace\":\"mori\",\"scope_kind\":\"re:po\",\"scope_ref\":\"x\"}",+      testCase "a scope ref is deliberately free text" do+        -- Refs are host-controlled and legitimately contain '/' and ':' — repo-style refs and+        -- arbitrary agent names. Validating them here would reject data that already exists.+        decode @RecallTarget+          "{\"kind\":\"exact_entity\",\"namespace\":\"mori\",\"scope_kind\":\"repo\",\"scope_ref\":\"shinzui/kikan\"}"+          @?= Just (ExactScope moriRepo)+    ]++strategyTests :: TestTree+strategyTests =+  testGroup+    "RecallStrategy"+    [ testCase "has the expected stable spellings" do+        fmap recallStrategyText allRecallStrategies @?= ["keyword", "embedding", "hybrid"],+      testCase "parses back from every spelling" do+        traverse (parseRecallStrategy . recallStrategyText) allRecallStrategies+          @?= Right allRecallStrategies,+      testCase "rejects an unknown spelling, naming the alternatives" do+        case parseRecallStrategy "semantic" of+          Right unexpected -> fail ("expected rejection, got " <> show unexpected)+          Left message -> do+            assertBool "names keyword" ("keyword" `Text.isInfixOf` message)+            assertBool "names hybrid" ("hybrid" `Text.isInfixOf` message),+      testCase "crosses the wire as a bare string" do+        encode Hybrid @?= "\"hybrid\"",+      testCase "decoding rejects an unknown spelling" do+        rejects @RecallStrategy "\"semantic\"",+      testGroup+        "round-trips"+        [roundTrip (show strategy) strategy | strategy <- allRecallStrategies]+    ]++limitTests :: TestTree+limitTests =+  testGroup+    "RecallLimit"+    [ testCase "rejects zero, which silently returns nothing" do+        rejected (mkRecallLimit 0),+      testCase "rejects a negative limit" do+        rejected (mkRecallLimit (-1)),+      testCase "accepts both ends of the range" do+        fmap recallLimitInt (mkRecallLimit 1) @?= Right 1+        fmap recallLimitInt (mkRecallLimit maxRecallLimit) @?= Right maxRecallLimit,+      testCase "rejects one past the maximum" do+        rejected (mkRecallLimit (maxRecallLimit + 1)),+      testCase "the maximum is the most a fused result set can hold" do+        -- Each channel contributes at most 50 candidates, so 100 distinct memories is the+        -- ceiling. A larger limit has never returned more rows; it only widened what the+        -- database was asked to plan for.+        maxRecallLimit @?= 100,+      testCase "the default is what the command line has always used" do+        recallLimitInt defaultRecallLimit @?= 8,+      testCase "crosses the wire as a bare number" do+        encode defaultRecallLimit @?= "8",+      testCase "decoding enforces the same bounds as constructing" do+        rejects @RecallLimit "0"+        rejects @RecallLimit "101"+    ]++queryTests :: TestTree+queryTests =+  testGroup+    "RecallQuery"+    [ testCase "the smart constructor validates the limit and nothing else" do+        fmap (\q -> q.target) (mkRecallQuery (NamespaceWide mori) "commit style" Hybrid 8)+          @?= Right (NamespaceWide mori)+        rejected (mkRecallQuery (NamespaceWide mori) "commit style" Hybrid 0),+      testCase "empty query text is accepted, because websearch_to_tsquery accepts it" do+        -- Today an empty or punctuation-only query returns no matches rather than an error.+        -- Rejecting it here would be a behaviour change for every caller that relies on that.+        fmap (\q -> q.query) (mkRecallQuery (NamespaceWide mori) "" Keyword 8) @?= Right "",+      encodesAs+        "a whole request"+        (expectRight (mkRecallQuery (ExactScope moriRepo) "commit style" Hybrid 8))+        "{\"target\":{\"kind\":\"exact_entity\",\"namespace\":\"mori\",\"scope_kind\":\"repo\",\+        \\"scope_ref\":\"shinzui/kikan\"},\"query\":\"commit style\",\"strategy\":\"hybrid\",\+        \\"max_results\":8}",+      roundTrip+        "a whole request round-trips"+        (expectRight (mkRecallQuery (NamespaceWide mori) "commit style" Keyword 3)),+      testCase "a request has exactly four fields, and none of them is a memory space" do+        -- The space comes from the MemoryAccessContext at execution. If it were a field here, a+        -- caller composing a request could widen a target and a tenancy in one edit.+        case decode @Value (encode (expectRight (mkRecallQuery (NamespaceWide mori) "q" Hybrid 3))) of+          Just (Object fields) ->+            sort (KeyMap.keys fields) @?= ["max_results", "query", "strategy", "target"]+          other -> fail ("expected a JSON object, got " <> show other)+    ]++mori :: Namespace+mori = Namespace "mori"++moriRepo :: MemoryScope+moriRepo = ScopeEntity mori (ScopeKind "repo") "shinzui/kikan"++-- | Compare the encoding as a decoded 'Value' rather than as bytes: aeson's object key order is+-- unspecified, and pinning it would make this test fail for a reason that is not a contract+-- change.+encodesAs :: (ToJSON a) => String -> a -> ByteString -> TestTree+encodesAs name value expected =+  testCase name (decode @Value (encode value) @?= decode @Value expected)++roundTrip :: (ToJSON a, FromJSON a, Eq a, Show a) => String -> a -> TestTree+roundTrip name value =+  testCase name (decode (encode value) @?= Just value)++rejects :: forall a. (FromJSON a, Show a) => ByteString -> IO ()+rejects raw =+  case decode @a raw of+    Nothing -> pure ()+    Just unexpected -> fail ("expected rejection of " <> show raw <> ", got " <> show unexpected)++rejected :: (Show a) => Either Text a -> IO ()+rejected = \case+  Left _ -> pure ()+  Right unexpected -> fail ("expected rejection, got " <> show unexpected)++expectRight :: Either Text a -> a+expectRight = either (error . Text.unpack) id

@@ -0,0 +1,14 @@+module Main where++import Kioku.Api.AccessSpec qualified as AccessSpec+import Kioku.Api.RecallSpec qualified as RecallSpec+import Test.Tasty (defaultMain, testGroup)++main :: IO ()+main =+  defaultMain $+    testGroup+      "kioku-api"+      [ AccessSpec.tests,+        RecallSpec.tests+      ]