kioku-api 0.4.1.0 → 0.5.0.0

raw patch · 4 files changed

+136/−3 lines, 4 filesdep ~kioku-apiPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: kioku-api

API changes (from Hackage documentation)

Files

• CHANGELOG.md +9/−0
• kioku-api.cabal +2/−2
• src/Kioku/Api/Access.hs +40/−0
• test/Kioku/Api/AccessSpec.hs +85/−1

@@ -1,5 +1,14 @@ # Changelog +## 0.5.0.0 — 2026-08-22++### Added++- `underMemoryContext` and `inLegacyMemorySpaceOnly`, generic `Applicative` helpers that apply an+  existing context's permission, space, and actor decision in a fixed order while letting Memory+  and Session retain their distinct public error types. These helpers consume a context; they do+  not mint or widen one.+ ## 0.4.1.0 — 2026-08-18  ### Changed

@@ -1,6 +1,6 @@ cabal-version:   3.0 name:            kioku-api-version:         0.4.1.0+version:         0.5.0.0 synopsis:        Reusable agent memory wire types description:   Wire contract for kioku: custom prelude, TypeID identifiers, memory@@ -78,7 +78,7 @@     , base         >=4.21     && <5     , bytestring   >=0.11     && <0.13     , containers   >=0.6      && <0.8-    , kioku-api    ^>=0.4.1.0+    , kioku-api    ^>=0.5.0.0     , tasty        >=1.5      && <1.6     , tasty-hunit  >=0.10     && <0.11     , text         >=2.1      && <2.2

@@ -110,6 +110,10 @@     memoryContextRecordedActor,     assumeAuthorizedMemoryContext,     authorizeMemoryAccess,++    -- * Applying an authorized decision+    underMemoryContext,+    inLegacyMemorySpaceOnly,   ) where @@ -117,6 +121,42 @@ import Data.Set qualified as Set import Kioku.Api.Access.Internal import Kioku.Prelude++-- | Gate an operation on the permission, space, and actor already captured by a context.+--+-- The three error constructors keep this policy independent of any caller's error vocabulary.+-- Permission is deliberately checked first so an unauthorized caller cannot use later mismatch+-- errors to inspect the context's space or actor.+underMemoryContext ::+  (Applicative f) =>+  (MemoryPermission -> err) ->+  (MemorySpaceId -> MemorySpaceId -> err) ->+  (RecordedPrincipal -> RecordedPrincipal -> err) ->+  MemoryAccessContext ->+  MemoryPermission ->+  MemorySpaceId ->+  RecordedPrincipal ->+  f (Either err a) ->+  f (Either err a)+underMemoryContext permissionError spaceError actorError context permission space actor run+  | not (memoryContextAllows permission context) = pure (Left (permissionError permission))+  | space /= authorizedSpace = pure (Left (spaceError space authorizedSpace))+  | actor /= authorizedActor = pure (Left (actorError actor authorizedActor))+  | otherwise = run+  where+    authorizedSpace = memoryContextSpace context+    authorizedActor = memoryContextRecordedActor context++-- | Confine a deprecated compatibility operation to the explicit legacy memory space.+inLegacyMemorySpaceOnly ::+  (Applicative f) =>+  (MemorySpaceId -> MemorySpaceId -> err) ->+  MemorySpaceId ->+  f (Either err a) ->+  f (Either err a)+inLegacyMemorySpaceOnly spaceError space run+  | space /= legacyMemorySpaceId = pure (Left (spaceError space legacyMemorySpaceId))+  | otherwise = run  -- | 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.

@@ -26,7 +26,8 @@       jsonRoundTripTests,       objectRefTests,       bindingTests,-      contextTests+      contextTests,+      contextGateTests     ]  -- | A memory space id is Kioku's own object identifier, so Kioku owns its rules. It has to@@ -297,6 +298,89 @@         memoryContextAllows MemoryForget context @?= False         memoryContextPermissions context @?= Set.singleton MemoryRead     ]++-- | The gate owns branch ordering but not an application's error type. Distinct sentinel+-- constructors make both properties visible without importing either core write-error type.+contextGateTests :: TestTree+contextGateTests =+  testGroup+    "context operation gates"+    [ testCase "permission denial precedes space and actor mismatches" do+        let context = readOnlyContext+        underMemoryContext+          GatePermission+          GateSpace+          GateActor+          context+          MemoryRecord+          spaceTwo+          otherRecordedActor+          successfulAction+          @?= Just (Left (GatePermission MemoryRecord)),+      testCase "space mismatch precedes actor mismatch" do+        let context = assumeAuthorizedMemoryContext spaceOne testActor+        underMemoryContext+          GatePermission+          GateSpace+          GateActor+          context+          MemoryRecord+          spaceTwo+          otherRecordedActor+          successfulAction+          @?= Just (Left (GateSpace spaceTwo spaceOne)),+      testCase "actor mismatch uses the injected constructor" do+        let context = assumeAuthorizedMemoryContext spaceOne testActor+        underMemoryContext+          GatePermission+          GateSpace+          GateActor+          context+          MemoryRecord+          spaceOne+          otherRecordedActor+          successfulAction+          @?= Just (Left (GateActor otherRecordedActor (KnownPrincipal (actorPrincipal testActor)))),+      testCase "a matching context runs the supplied action" do+        let context = assumeAuthorizedMemoryContext spaceOne testActor+        underMemoryContext+          GatePermission+          GateSpace+          GateActor+          context+          MemoryRecord+          spaceOne+          (memoryContextRecordedActor context)+          successfulAction+          @?= successfulAction,+      testCase "the legacy gate refuses another space through the injected constructor" do+        inLegacyMemorySpaceOnly GateSpace spaceTwo successfulAction+          @?= Just (Left (GateSpace spaceTwo legacyMemorySpaceId)),+      testCase "the legacy gate runs an operation in the explicit legacy space" do+        inLegacyMemorySpaceOnly GateSpace legacyMemorySpaceId successfulAction+          @?= successfulAction+    ]++data GateError+  = GatePermission !MemoryPermission+  | GateSpace !MemorySpaceId !MemorySpaceId+  | GateActor !RecordedPrincipal !RecordedPrincipal+  deriving stock (Eq, Show)++successfulAction :: Maybe (Either GateError Text)+successfulAction = Just (Right "ran")++readOnlyContext :: MemoryAccessContext+readOnlyContext =+  Internal.MemoryAccessContext+    { Internal.memorySpaceId = spaceOne,+      Internal.actor = testActor,+      Internal.grantedPermissions = Set.singleton MemoryRead,+      Internal.decisionToken = Nothing+    }++otherRecordedActor :: RecordedPrincipal+otherRecordedActor = KnownPrincipal (expectRight (mkPrincipalRef "person_01h9xk3v7hf8b9c0d1e2f3g4h6"))  testActor :: MemoryActor testActor = MemoryActor (expectRight (mkPrincipalRef "person_01h9xk3v7hf8b9c0d1e2f3g4h5"))