kioku-core 0.5.2.0 → 0.6.0.0
raw patch · 26 files changed
+1480/−232 lines, 26 filesdep +asyncdep +baikai-openaidep ~baikaidep ~baikai-claudedep ~baikai-effectfulPVP ok
version bump matches the API change (PVP)
Dependencies added: async, baikai-openai
Dependency ranges changed: baikai, baikai-claude, baikai-effectful, keiro, keiro-core, kioku-api, kioku-core, kioku-migrations, shikumi, shikumi-trace
API changes (from Hackage documentation)
- Kioku.Distill.Runtime: DistillRuntime :: !LLMConfig -> !Model -> !Maybe FilePath -> !ExtractInput -> IO (Either ShikumiError ExtractOutput) -> !ConsolidateInput -> IO (Either ShikumiError ConsolidationDecision) -> !SceneInput -> IO (Either ShikumiError SceneOutput) -> !PersonaInput -> IO (Either ShikumiError PersonaOutput) -> DistillRuntime
- Kioku.Distill.Runtime: [config] :: DistillRuntime -> !LLMConfig
- Kioku.Distill.Runtime: [defaultModel] :: DistillRuntime -> !Model
- Kioku.Distill.Runtime: [workspaceRoot] :: DistillRuntime -> !Maybe FilePath
+ Kioku.AI.Config: AIConfig :: DistillationConfig -> Map AIFeature DistillationConfig -> Map AIFeature EmbeddingModel -> AIConfig
+ Kioku.AI.Config: AIDisabled :: AIFeature -> AIExecutionError
+ Kioku.AI.Config: AIExecutionRefused :: AIFeature -> Text -> AIExecutionError
+ Kioku.AI.Config: AIInteractiveFailed :: AIFeature -> Text -> AIExecutionError
+ Kioku.AI.Config: AIProgramFailed :: ShikumiError -> AIExecutionError
+ Kioku.AI.Config: API :: ExecutionMode
+ Kioku.AI.Config: Batch :: ExecutionMode
+ Kioku.AI.Config: CandidateEmbedding :: AIFeature
+ Kioku.AI.Config: CompletionConfig :: ExecutionMode -> Model -> Options -> DistillationConfig
+ Kioku.AI.Config: Consolidation :: AIFeature
+ Kioku.AI.Config: Disabled :: ExecutionMode
+ Kioku.AI.Config: DistillationDisabled :: DistillationConfig
+ Kioku.AI.Config: Extraction :: AIFeature
+ Kioku.AI.Config: Interactive :: ExecutionMode
+ Kioku.AI.Config: InteractiveConfig :: InteractiveProvider -> InteractiveLaunchRequest -> DistillationConfig
+ Kioku.AI.Config: InteractiveUnavailable :: AIFeature -> AIExecutionError
+ Kioku.AI.Config: InvalidAIConfiguration :: Maybe AIFeature -> Text -> AIConfigurationError
+ Kioku.AI.Config: MemoryEmbedding :: AIFeature
+ Kioku.AI.Config: Persona :: AIFeature
+ Kioku.AI.Config: QueryEmbedding :: AIFeature
+ Kioku.AI.Config: Scene :: AIFeature
+ Kioku.AI.Config: [distillationDefault] :: AIConfig -> DistillationConfig
+ Kioku.AI.Config: [embeddingSettings] :: AIConfig -> Map AIFeature EmbeddingModel
+ Kioku.AI.Config: [featureOverrides] :: AIConfig -> Map AIFeature DistillationConfig
+ Kioku.AI.Config: data AIConfig
+ Kioku.AI.Config: data AIConfigurationError
+ Kioku.AI.Config: data AIExecutionError
+ Kioku.AI.Config: data AIFeature
+ Kioku.AI.Config: data DistillationConfig
+ Kioku.AI.Config: data ExecutionMode
+ Kioku.AI.Config: disabledAIConfig :: AIConfig
+ Kioku.AI.Config: distillationFeatures :: [AIFeature]
+ Kioku.AI.Config: embeddingFeatures :: [AIFeature]
+ Kioku.AI.Config: featureName :: AIFeature -> Text
+ Kioku.AI.Config: instance GHC.Classes.Eq Kioku.AI.Config.AIConfigurationError
+ Kioku.AI.Config: instance GHC.Classes.Eq Kioku.AI.Config.AIExecutionError
+ Kioku.AI.Config: instance GHC.Classes.Eq Kioku.AI.Config.AIFeature
+ Kioku.AI.Config: instance GHC.Classes.Eq Kioku.AI.Config.ExecutionMode
+ Kioku.AI.Config: instance GHC.Classes.Ord Kioku.AI.Config.AIFeature
+ Kioku.AI.Config: instance GHC.Classes.Ord Kioku.AI.Config.ExecutionMode
+ Kioku.AI.Config: instance GHC.Internal.Enum.Bounded Kioku.AI.Config.AIFeature
+ Kioku.AI.Config: instance GHC.Internal.Enum.Enum Kioku.AI.Config.AIFeature
+ Kioku.AI.Config: instance GHC.Internal.Show.Show Kioku.AI.Config.AIConfigurationError
+ Kioku.AI.Config: instance GHC.Internal.Show.Show Kioku.AI.Config.AIExecutionError
+ Kioku.AI.Config: instance GHC.Internal.Show.Show Kioku.AI.Config.AIFeature
+ Kioku.AI.Config: instance GHC.Internal.Show.Show Kioku.AI.Config.ExecutionMode
+ Kioku.AI.Config: parseFeature :: Text -> Either AIConfigurationError AIFeature
+ Kioku.AI.File: loadAIRuntime :: Bool -> Maybe FilePath -> IO AIRuntime
+ Kioku.AI.File: parseAIConfig :: Value -> Parser (AIConfig, [ExecutionMode])
+ Kioku.AI.Interactive: runInteractiveSignature :: (ToPrompt i, ToPrompt o, ToSchema o, FromModel o, Validatable o) => AIRuntime -> AIFeature -> Signature i o -> i -> IO (Either AIExecutionError o)
+ Kioku.AI.Runtime: HostCapabilities :: Maybe ProviderRegistry -> Maybe ProviderRegistry -> Bool -> Maybe (AIFeature -> InteractiveLaunchRequest -> IO (Either AIExecutionError InteractiveLaunchResult)) -> Bool -> HostCapabilities
+ Kioku.AI.Runtime: [allowEmbeddingAPI] :: HostCapabilities -> Bool
+ Kioku.AI.Runtime: [allowInteractive] :: HostCapabilities -> Bool
+ Kioku.AI.Runtime: [apiRegistry] :: HostCapabilities -> Maybe ProviderRegistry
+ Kioku.AI.Runtime: [batchRegistry] :: HostCapabilities -> Maybe ProviderRegistry
+ Kioku.AI.Runtime: [launchInteractive] :: HostCapabilities -> Maybe (AIFeature -> InteractiveLaunchRequest -> IO (Either AIExecutionError InteractiveLaunchResult))
+ Kioku.AI.Runtime: data AIRuntime
+ Kioku.AI.Runtime: data HostCapabilities
+ Kioku.AI.Runtime: disabledAIRuntime :: AIRuntime
+ Kioku.AI.Runtime: executionAvailability :: AIRuntime -> AIFeature -> Either AIExecutionError ()
+ Kioku.AI.Runtime: featureConfiguration :: AIRuntime -> AIFeature -> DistillationConfig
+ Kioku.AI.Runtime: interactiveLauncher :: AIRuntime -> Maybe (AIFeature -> InteractiveLaunchRequest -> IO (Either AIExecutionError InteractiveLaunchResult))
+ Kioku.AI.Runtime: newAIRuntime :: HostCapabilities -> AIConfig -> IO (Either AIConfigurationError AIRuntime)
+ Kioku.AI.Runtime: noHostCapabilities :: HostCapabilities
+ Kioku.AI.Runtime: runAIProgram :: AIRuntime -> AIFeature -> Program i o -> i -> IO (Either AIExecutionError o)
+ Kioku.AI.Runtime: runtimeEmbeddingModel :: AIRuntime -> AIFeature -> Either AIExecutionError EmbeddingModel
+ Kioku.Distill.L1: L1ExecutionFailed :: !AIExecutionError -> L1Error
+ Kioku.Distill.L1: recallCandidatesWithEmbeddingAdapter :: forall (es :: [Effect]). (IOE :> es, Store :> es) => EmbeddingModel -> VectorCapability -> Int -> FindMergeCandidates es
+ Kioku.Distill.L2: L2ExecutionFailed :: !AIExecutionError -> L2Error
+ Kioku.Distill.L3: L3ExecutionFailed :: !AIExecutionError -> L3Error
+ Kioku.Distill.Runtime: TestRunners :: (ExtractInput -> IO (Either ShikumiError ExtractOutput)) -> (ConsolidateInput -> IO (Either ShikumiError ConsolidationDecision)) -> (SceneInput -> IO (Either ShikumiError SceneOutput)) -> (PersonaInput -> IO (Either ShikumiError PersonaOutput)) -> TestRunners
+ Kioku.Distill.Runtime: data TestRunners
+ Kioku.Distill.Runtime: distillAvailability :: DistillRuntime -> AIFeature -> Either AIExecutionError ()
+ Kioku.Distill.Runtime: testDistillRuntime :: IO DistillRuntime
+ Kioku.Distill.Runtime: withDistillWorkspace :: FilePath -> DistillRuntime -> DistillRuntime
+ Kioku.Distill.Runtime: withTestRunners :: DistillRuntime -> (TestRunners -> TestRunners) -> DistillRuntime
+ Kioku.Distill.Timer.Deferred: DeferredAccessDenied :: !MemoryAccessDenial -> DeferredResumeResult
+ Kioku.Distill.Timer.Deferred: DeferredClaimRefused :: DeferredResumeResult
+ Kioku.Distill.Timer.Deferred: DeferredExecutionUnavailable :: !AIExecutionError -> DeferredResumeResult
+ Kioku.Distill.Timer.Deferred: DeferredFinished :: !FireOutcome -> DeferredResumeResult
+ Kioku.Distill.Timer.Deferred: DeferredNotEligible :: DeferredResumeResult
+ Kioku.Distill.Timer.Deferred: DeferredOwnershipLost :: DeferredResumeResult
+ Kioku.Distill.Timer.Deferred: DeferredPage :: ![DeferredTimer] -> !Maybe TimerId -> DeferredPage
+ Kioku.Distill.Timer.Deferred: DeferredTimer :: !TimerRow -> !MemorySpaceId -> ![AIFeature] -> !Text -> DeferredTimer
+ Kioku.Distill.Timer.Deferred: [entries] :: DeferredPage -> ![DeferredTimer]
+ Kioku.Distill.Timer.Deferred: [features] :: DeferredTimer -> ![AIFeature]
+ Kioku.Distill.Timer.Deferred: [memorySpace] :: DeferredTimer -> !MemorySpaceId
+ Kioku.Distill.Timer.Deferred: [nextAfterTimerId] :: DeferredPage -> !Maybe TimerId
+ Kioku.Distill.Timer.Deferred: [reason] :: DeferredTimer -> !Text
+ Kioku.Distill.Timer.Deferred: [timer] :: DeferredTimer -> !TimerRow
+ Kioku.Distill.Timer.Deferred: data DeferredPage
+ Kioku.Distill.Timer.Deferred: data DeferredResumeResult
+ Kioku.Distill.Timer.Deferred: data DeferredTimer
+ Kioku.Distill.Timer.Deferred: instance GHC.Classes.Eq Kioku.Distill.Timer.Deferred.DeferredPage
+ Kioku.Distill.Timer.Deferred: instance GHC.Classes.Eq Kioku.Distill.Timer.Deferred.DeferredResumeResult
+ Kioku.Distill.Timer.Deferred: instance GHC.Classes.Eq Kioku.Distill.Timer.Deferred.DeferredTimer
+ Kioku.Distill.Timer.Deferred: instance GHC.Internal.Show.Show Kioku.Distill.Timer.Deferred.DeferredPage
+ Kioku.Distill.Timer.Deferred: instance GHC.Internal.Show.Show Kioku.Distill.Timer.Deferred.DeferredResumeResult
+ Kioku.Distill.Timer.Deferred: instance GHC.Internal.Show.Show Kioku.Distill.Timer.Deferred.DeferredTimer
+ Kioku.Distill.Timer.Deferred: listDeferredTimers :: forall (es :: [Effect]). Store :> es => MemoryContextProvider (Eff es) -> DeadTimerPageRequest -> Eff es (Either DeadTimerReadError DeferredPage)
+ Kioku.Distill.Timer.Deferred: resumeDeferredTimer :: forall (es :: [Effect]). (IOE :> es, Store :> es, KirokuStoreResource :> es, Error StoreError :> es) => MemoryContextProvider (Eff es) -> DistillRuntime -> FindMergeCandidates es -> TimerId -> Eff es DeferredResumeResult
+ Kioku.Distill.Timer.Outcome: FireDeferred :: !Text -> FireOutcome
+ Kioku.Distill.Timer.Outcome: executionFireOutcome :: Int -> AIExecutionError -> FireOutcome
+ Kioku.Memory.Embedding: EmbedModelMismatch :: EmbedError
+ Kioku.Memory.Embedding: embeddingModelCompatible :: forall (es :: [Effect]). Store :> es => MemorySpaceId -> EmbeddingModel -> Eff es Bool
+ Kioku.Memory.Embedding: embeddingModelsCompatible :: forall (es :: [Effect]). Store :> es => Maybe MemorySpaceId -> EmbeddingModel -> Eff es Bool
+ Kioku.Recall: RecallAIUnavailable :: !AIExecutionError -> RecallError
+ Kioku.Recall: recallWithEmbeddingAdapter :: forall (es :: [Effect]). (IOE :> es, Store :> es) => EmbeddingModel -> VectorCapability -> MemoryAccessContext -> RecallQuery -> Eff es (Either RecallError [RecallHit])
- Kioku.Distill.L1: recallCandidates :: forall (es :: [Effect]). (IOE :> es, Store :> es) => EmbeddingModel -> VectorCapability -> Int -> FindMergeCandidates es
+ Kioku.Distill.L1: recallCandidates :: forall (es :: [Effect]). (IOE :> es, Store :> es) => AIRuntime -> VectorCapability -> Int -> FindMergeCandidates es
- Kioku.Distill.Runtime: [runConsolidate] :: DistillRuntime -> !ConsolidateInput -> IO (Either ShikumiError ConsolidationDecision)
+ Kioku.Distill.Runtime: [runConsolidate] :: TestRunners -> ConsolidateInput -> IO (Either ShikumiError ConsolidationDecision)
- Kioku.Distill.Runtime: [runExtract] :: DistillRuntime -> !ExtractInput -> IO (Either ShikumiError ExtractOutput)
+ Kioku.Distill.Runtime: [runExtract] :: TestRunners -> ExtractInput -> IO (Either ShikumiError ExtractOutput)
- Kioku.Distill.Runtime: [runPersona] :: DistillRuntime -> !PersonaInput -> IO (Either ShikumiError PersonaOutput)
+ Kioku.Distill.Runtime: [runPersona] :: TestRunners -> PersonaInput -> IO (Either ShikumiError PersonaOutput)
- Kioku.Distill.Runtime: [runScene] :: DistillRuntime -> !SceneInput -> IO (Either ShikumiError SceneOutput)
+ Kioku.Distill.Runtime: [runScene] :: TestRunners -> SceneInput -> IO (Either ShikumiError SceneOutput)
- Kioku.Distill.Runtime: newDistillRuntime :: IO DistillRuntime
+ Kioku.Distill.Runtime: newDistillRuntime :: AIRuntime -> Maybe FilePath -> DistillRuntime
- Kioku.Distill.Runtime: runConsolidation :: DistillRuntime -> ConsolidateInput -> IO (Either ShikumiError ConsolidationDecision)
+ Kioku.Distill.Runtime: runConsolidation :: DistillRuntime -> ConsolidateInput -> IO (Either AIExecutionError ConsolidationDecision)
- Kioku.Distill.Runtime: runDistillProgram :: DistillRuntime -> Program i o -> i -> IO (Either ShikumiError o)
+ Kioku.Distill.Runtime: runDistillProgram :: DistillRuntime -> AIFeature -> Program i o -> i -> IO (Either AIExecutionError o)
- Kioku.Distill.Runtime: runExtraction :: DistillRuntime -> ExtractInput -> IO (Either ShikumiError ExtractOutput)
+ Kioku.Distill.Runtime: runExtraction :: DistillRuntime -> ExtractInput -> IO (Either AIExecutionError ExtractOutput)
- Kioku.Distill.Runtime: runPersonaDistillation :: DistillRuntime -> PersonaInput -> IO (Either ShikumiError PersonaOutput)
+ Kioku.Distill.Runtime: runPersonaDistillation :: DistillRuntime -> PersonaInput -> IO (Either AIExecutionError PersonaOutput)
- Kioku.Distill.Runtime: runSceneDistillation :: DistillRuntime -> SceneInput -> IO (Either ShikumiError SceneOutput)
+ Kioku.Distill.Runtime: runSceneDistillation :: DistillRuntime -> SceneInput -> IO (Either AIExecutionError SceneOutput)
- Kioku.Distill.Timer.Outcome: firePartitionedDistillTimer :: forall err (es :: [Effect]) result. Show err => Text -> String -> MemoryContextProvider (Eff es) -> TimerRow -> (MemorySpaceId -> MemoryScope -> Eff es (Either err result)) -> Eff es FireOutcome
+ Kioku.Distill.Timer.Outcome: firePartitionedDistillTimer :: forall err (es :: [Effect]) result. Show err => Text -> String -> MemoryContextProvider (Eff es) -> TimerRow -> (err -> Maybe AIExecutionError) -> (MemorySpaceId -> MemoryScope -> Eff es (Either err result)) -> Eff es FireOutcome
- Kioku.Memory.Embedding: resolveEmbeddingConfig :: IO EmbeddingConfig
+ Kioku.Memory.Embedding: resolveEmbeddingConfig :: AIRuntime -> AIFeature -> Either AIExecutionError EmbeddingModel
- Kioku.Memory.Embedding.Worker: embeddingWorkerProcessor :: forall (es :: [Effect]). (IOE :> es, Store :> es, Error StoreError :> es) => MemoryContextProvider (Eff es) -> VectorCapability -> EmbeddingModel -> Int -> KirokuStore -> Eff es (ProcessorId, QueueProcessor es)
+ Kioku.Memory.Embedding.Worker: embeddingWorkerProcessor :: forall (es :: [Effect]). (IOE :> es, Store :> es, Error StoreError :> es) => MemoryContextProvider (Eff es) -> VectorCapability -> EmbeddingWorkerEnv -> KirokuStore -> Eff es (ProcessorId, QueueProcessor es)
- Kioku.Memory.Embedding.Worker: mkEmbeddingWorkerEnv :: EmbeddingModel -> Int -> EmbeddingWorkerEnv
+ Kioku.Memory.Embedding.Worker: mkEmbeddingWorkerEnv :: AIRuntime -> Either AIExecutionError EmbeddingWorkerEnv
- Kioku.Memory.Embedding.Worker: runEmbeddingWorkerHost :: forall (es :: [Effect]). (IOE :> es, Store :> es, Error StoreError :> es, Tracing :> es) => KirokuStore -> MemoryContextProvider (Eff es) -> VectorCapability -> EmbeddingModel -> Int -> Eff es ()
+ Kioku.Memory.Embedding.Worker: runEmbeddingWorkerHost :: forall (es :: [Effect]). (IOE :> es, Store :> es, Error StoreError :> es, Tracing :> es) => KirokuStore -> MemoryContextProvider (Eff es) -> VectorCapability -> AIRuntime -> Eff es ()
- Kioku.Recall: recall :: forall (es :: [Effect]). (IOE :> es, Store :> es) => EmbeddingModel -> VectorCapability -> MemoryAccessContext -> RecallQuery -> Eff es (Either RecallError [RecallHit])
+ Kioku.Recall: recall :: forall (es :: [Effect]). (IOE :> es, Store :> es) => AIRuntime -> VectorCapability -> MemoryAccessContext -> RecallQuery -> Eff es (Either RecallError [RecallHit])
Files
- CHANGELOG.md +61/−0
- kioku-core.cabal +26/−22
- src/Kioku/AI/Config.hs +82/−0
- src/Kioku/AI/File.hs +129/−0
- src/Kioku/AI/Interactive.hs +88/−0
- src/Kioku/AI/Runtime.hs +155/−0
- src/Kioku/Distill/L1.hs +24/−7
- src/Kioku/Distill/L2.hs +9/−3
- src/Kioku/Distill/L3.hs +9/−3
- src/Kioku/Distill/Runtime.hs +78/−71
- src/Kioku/Distill/Timer/Deferred.hs +181/−0
- src/Kioku/Distill/Timer/Outcome.hs +13/−2
- src/Kioku/Distill/Timer/Worker.hs +12/−1
- src/Kioku/Memory/Embedding.hs +33/−25
- src/Kioku/Memory/Embedding/Worker.hs +22/−14
- src/Kioku/Recall.hs +26/−5
- test/Kioku/AIRuntimeSpec.hs +203/−0
- test/Kioku/DistillSpec.hs +65/−58
- test/Kioku/EmbeddingWorkerSpec.hs +16/−0
- test/Kioku/MemorySpaceSpec.hs +5/−5
- test/Kioku/RecallCompatSpec.hs +2/−2
- test/Kioku/RecallSqlSpec.hs +1/−1
- test/Kioku/RecallTargetSpec.hs +5/−5
- test/Kioku/SpaceIsolationSpec.hs +1/−1
- test/Kioku/TimerWorkerSpec.hs +231/−6
- test/Main.hs +3/−1
CHANGELOG.md view
@@ -1,5 +1,66 @@ # Changelog +## 0.6.0.0 — 2026-09-08++### Breaking Changes++- `DistillRuntime` no longer exports its constructor or record fields, and `newDistillRuntime` is+ gone. A runtime is now built from an explicit host-owned `AIRuntime`: there is no implicit+ provider, model, or credential activation, and the settings a runtime captures cannot be+ record-updated. Tests construct one through the new `testDistillRuntime`, `withTestRunners`, and+ `withDistillWorkspace` seam.+- `Kioku.Recall.recall` takes an `AIRuntime` where it took an `EmbeddingModel`, and resolves the+ query embedding model through host policy. The previous shape survives unchanged as+ `recallWithEmbeddingAdapter`, so a caller that already owns a model can move by renaming the+ call. `RecallError` gains `RecallAIUnavailable`.+- `Kioku.Distill.L1.recallCandidates` changes the same way; its previous shape is+ `recallCandidatesWithEmbeddingAdapter`.+- `resolveEmbeddingConfig` changes from `IO EmbeddingConfig` to+ `AIRuntime -> AIFeature -> Either AIExecutionError EmbeddingModel`. The `KIOKU_EMBEDDING_BASE_URL`,+ `KIOKU_EMBEDDING_MODEL`, `KIOKU_EMBEDDING_DIMENSIONS`, `KIOKU_EMBEDDING_API_KEY`, and+ `OPENAI_API_KEY` environment variables no longer configure embedding; configuration comes from the+ host's AI configuration file. `EmbeddingConfig`'s derived `Show` is replaced by a redacting+ instance so credentials cannot reach a log through it.+- `mkEmbeddingWorkerEnv` takes an `AIRuntime` and returns `Either AIExecutionError+ EmbeddingWorkerEnv`. `runEmbeddingWorkerHost` takes an `AIRuntime` in place of an+ `EmbeddingModel` and an explicit dimension count, and `embeddingWorkerProcessor` takes an already+ prepared `EmbeddingWorkerEnv`.+- Distillation error constructors are consolidated onto the execution error: `L1ExtractionFailed`+ and `L1ConsolidationFailed` become `L1ExecutionFailed !AIExecutionError`, and L2 and L3 gain+ `L2ExecutionFailed` and `L3ExecutionFailed` in place of their stringly-typed generation failures.+- Requires the released 0.16 cohort from `mori://shinzui/keiro/packages/keiro` and+ `mori://shinzui/keiro/packages/keiro-core`.++### Added++- `Kioku.AI.Config`, `Kioku.AI.File`, `Kioku.AI.Interactive`, and `Kioku.AI.Runtime`: per-feature AI+ configuration, an explicit versioned file boundary for loading it, and validated interactive+ signature execution. Every AI-touching entry point now dispatches through one host-owned runtime,+ and a missing configuration disables AI rather than falling back to ambient credentials.+- `Kioku.Distill.Timer.Deferred`: authorized paginated discovery and foreground resume of the+ original parked timer. Resume rechecks permissions and execution availability, renews its lease,+ fences finalization, and re-parks failed work for bounded explicit retry.+- `embeddingModelCompatible` and `embeddingModelsCompatible`, which refuse semantic recall,+ candidate search, and backfill when a memory space's stored embedding model differs from the+ configured one, instead of comparing vectors from two different models.++### Changed++- Upgraded to `mori://shinzui/baikai/packages/baikai` 0.7.0.0 and+ `mori://shinzui/shikumi/packages/shikumi` 0.4.0.0 with their compatible provider and tracing+ packages: `baikai-claude ^>=0.7.0.0`, `baikai-effectful ^>=0.4.0.1`, the newly required+ `baikai-openai ^>=0.7.0.0`, `shikumi ^>=0.4.0.0`, and `shikumi-trace ^>=0.3.0.0`. API+ configuration now supports the explicitly selected `openai-responses` transport, replacing the+ hardcoded transport distillation used before. The `shikumi` bounds no longer need to sit at a+ patch floor to stay on the cohort, so the pin's explanatory comment is dropped.+- A hybrid recall whose query embeddings are disabled by AI policy now warns on stderr and falls+ back to keyword search; an `Embedding` strategy under the same policy fails with+ `RecallAIUnavailable` rather than silently degrading.+- An L1 timer whose resolved context belongs to a different memory space than its payload now fails+ permanently instead of proceeding, and a background worker that cannot execute interactively+ dead-letters the timer with a `deferred` outcome naming the space, so the work can be resumed in+ an authorized interactive session rather than being retried forever.+ ## 0.5.2.0 — 2026-08-31 ### Changed
kioku-core.cabal view
@@ -1,6 +1,6 @@ cabal-version: 3.0 name: kioku-core-version: 0.5.2.0+version: 0.6.0.0 synopsis: Reusable agent memory runtime description: Core runtime for kioku. M1 establishes the application effect stack; later@@ -46,6 +46,10 @@ import: warnings, shared hs-source-dirs: src exposed-modules:+ Kioku.AI.Config+ Kioku.AI.File+ Kioku.AI.Interactive+ Kioku.AI.Runtime Kioku.App Kioku.Distill.Consolidate Kioku.Distill.Extract@@ -57,6 +61,7 @@ Kioku.Distill.Scene Kioku.Distill.ScopeIdentity Kioku.Distill.Timer+ Kioku.Distill.Timer.Deferred Kioku.Distill.Timer.Outcome Kioku.Distill.Timer.Worker Kioku.Memory@@ -99,16 +104,12 @@ -- Retest and drop once the toolchain moves off GHC 9.12.4. Full write-up: -- mori://MMZK1526/mmzk-typeid/upstream-issues/mmzk-typeid-kindid-ghc-9-12-4-profiling-coercionkind-panic ghc-prof-options: -fno-opt-coercion-- -- shikumi and shikumi-trace are pinned at their newest patch rather than- -- their series floor, because only shikumi 0.3.0.3 and shikumi-trace 0.2.0.3- -- carry the baikai 0.6 bounds. The earlier patches are tied to baikai 0.5 and- -- would give the solver a way to silently fall off this cohort. build-depends: , aeson >=2.2 && <2.3- , baikai ^>=0.6.0.0- , baikai-claude ^>=0.6.0.0- , baikai-effectful ^>=0.4.0.0+ , baikai ^>=0.7.0.0+ , baikai-claude ^>=0.7.0.0+ , baikai-effectful ^>=0.4.0.1+ , baikai-openai ^>=0.7.0.0 , base >=4.21 && <5 , bytestring >=0.11 && <0.13 , containers >=0.6 && <0.8@@ -125,16 +126,16 @@ , hasql-transaction >=1.0 && <1.3 , hs-opentelemetry-api >=1.0 && <1.1 , keiki ^>=0.9.0.0- , keiro ^>=0.15.0.0- , keiro-core ^>=0.15.0.0- , kioku-api ^>=0.5.2.0+ , keiro ^>=0.16.0.0+ , keiro-core ^>=0.16.0.0+ , kioku-api ^>=0.6.0.0 , kiroku-store ^>=0.8.0.0 , lens >=5.2 && <5.4 , mmzk-typeid >=0.7 && <0.8 , shibuya-core ^>=0.9.0.0 , shibuya-kiroku-adapter ^>=0.5.1.1- , shikumi ^>=0.3.0.3- , shikumi-trace ^>=0.2.0.3+ , shikumi ^>=0.4.0.0+ , shikumi-trace ^>=0.3.0.0 , text >=2.1 && <2.2 , time >=1.12 && <1.15 , unix >=2.8.8 && <2.9@@ -147,6 +148,7 @@ type: exitcode-stdio-1.0 main-is: Main.hs other-modules:+ Kioku.AIRuntimeSpec Kioku.AwaitingSpec Kioku.CodecCompatSpec Kioku.DistillSpec@@ -173,7 +175,8 @@ ghc-options: -threaded -rtsopts -with-rtsopts=-N build-depends: , aeson >=2.2- , baikai ^>=0.6.0.0+ , async >=2.2 && <2.3+ , baikai ^>=0.7.0.0 , base >=4.21 && <5 , bytestring >=0.11 , containers >=0.6@@ -182,18 +185,19 @@ , effectful >=2.5 , effectful-core >=2.5 , filepath >=1.4+ , generic-lens >=2.2 && <2.4 , hasql >=1.6 , hasql-transaction >=1.0- , keiro ^>=0.15.0.0- , keiro-core ^>=0.15.0.0- , kioku-api ^>=0.5.2.0- , kioku-core ^>=0.5.2.0- , kioku-migrations:test-support ^>=0.5.2.0+ , keiro ^>=0.16.0.0+ , keiro-core ^>=0.16.0.0+ , kioku-api ^>=0.6.0.0+ , kioku-core ^>=0.6.0.0+ , kioku-migrations:test-support ^>=0.6.0.0 , kiroku-store ^>=0.8.0.0 , lens >=5.2 , shibuya-core ^>=0.9.0.0- , shikumi ^>=0.3.0.3- , shikumi-trace ^>=0.2.0.3+ , shikumi ^>=0.4.0.0+ , shikumi-trace ^>=0.3.0.0 , tasty >=1.5 , tasty-expected-failure >=0.12 , tasty-hunit >=0.10
+ src/Kioku/AI/Config.hs view
@@ -0,0 +1,82 @@+-- | Host-selected settings. Values describe execution; they do not grant it.+module Kioku.AI.Config+ ( AIFeature (..),+ ExecutionMode (..),+ DistillationConfig (..),+ AIConfig (..),+ disabledAIConfig,+ featureName,+ parseFeature,+ distillationFeatures,+ embeddingFeatures,+ AIConfigurationError (..),+ AIExecutionError (..),+ )+where++import Baikai.Embedding (EmbeddingModel)+import Baikai.Interactive (InteractiveLaunchRequest, InteractiveProvider)+import Baikai.Model (Model)+import Baikai.Options (Options)+import Data.Map.Strict (Map)+import Data.Map.Strict qualified as Map+import Kioku.Prelude hiding (Options)+import Shikumi.Error (ShikumiError)++data AIFeature+ = Extraction+ | Consolidation+ | Scene+ | Persona+ | MemoryEmbedding+ | QueryEmbedding+ | CandidateEmbedding+ deriving stock (Eq, Ord, Show, Enum, Bounded)++data ExecutionMode = Disabled | API | Batch | Interactive+ deriving stock (Eq, Ord, Show)++data DistillationConfig+ = DistillationDisabled+ | CompletionConfig ExecutionMode Model Options+ | InteractiveConfig InteractiveProvider InteractiveLaunchRequest++data AIConfig = AIConfig+ { distillationDefault :: DistillationConfig,+ featureOverrides :: Map AIFeature DistillationConfig,+ embeddingSettings :: Map AIFeature EmbeddingModel+ }++disabledAIConfig :: AIConfig+disabledAIConfig = AIConfig DistillationDisabled Map.empty Map.empty++distillationFeatures, embeddingFeatures :: [AIFeature]+distillationFeatures = [Extraction, Consolidation, Scene, Persona]+embeddingFeatures = [MemoryEmbedding, QueryEmbedding, CandidateEmbedding]++featureName :: AIFeature -> Text+featureName = \case+ Extraction -> "extraction"+ Consolidation -> "consolidation"+ Scene -> "scene"+ Persona -> "persona"+ MemoryEmbedding -> "memory-embedding"+ QueryEmbedding -> "query-embedding"+ CandidateEmbedding -> "candidate-embedding"++parseFeature :: Text -> Either AIConfigurationError AIFeature+parseFeature name = case filter ((== name) . featureName) [minBound .. maxBound] of+ [feature] -> Right feature+ _ -> Left (InvalidAIConfiguration Nothing "unknown AI feature")++-- | Diagnostics contain remedies, never rendered provider settings or secrets.+data AIConfigurationError = InvalidAIConfiguration (Maybe AIFeature) Text+ deriving stock (Eq, Show)++data AIExecutionError+ = AIDisabled AIFeature+ | InteractiveUnavailable AIFeature+ | AIExecutionRefused AIFeature Text+ | AIProgramFailed ShikumiError+ | AIInteractiveFailed AIFeature Text+ deriving stock (Eq, Show)
+ src/Kioku/AI/File.hs view
@@ -0,0 +1,129 @@+-- | Versioned AI files shared by command-line and embedding hosts.+module Kioku.AI.File (loadAIRuntime, parseAIConfig) where++import Baikai.Auth (ApiKeySource (..))+import Baikai.Embedding qualified as E+import Baikai.Interactive qualified as I+import Baikai.Model qualified as M+import Baikai.Options qualified as O+import Baikai.Provider.Claude.Api qualified as Claude+import Baikai.Provider.Claude.Cli qualified as ClaudeCli+import Baikai.Provider.Claude.Interactive qualified as ClaudeInteractive+import Baikai.Provider.OpenAI.Api qualified as OpenAI+import Baikai.Provider.OpenAI.Cli qualified as Codex+import Baikai.Provider.OpenAI.Interactive qualified as CodexInteractive+import Baikai.Provider.OpenAI.Responses qualified as Responses+import Baikai.Provider.Registry (newProviderRegistryFrom)+import Control.Applicative ((<|>))+import Control.Monad (unless)+import Data.Aeson+import Data.Aeson.Key qualified as Key+import Data.Aeson.KeyMap qualified as KM+import Data.Aeson.Types (Parser, parseEither)+import Data.ByteString qualified as BS+import Data.Map.Strict qualified as Map+import Data.Text (Text)+import Kioku.AI.Config+import Kioku.AI.Runtime+import System.Environment (lookupEnv)++-- | Background workers never receive the foreground session capability.+loadAIRuntime :: Bool -> Maybe FilePath -> IO AIRuntime+loadAIRuntime foreground explicit = do+ environment <- lookupEnv "KIOKU_AI_CONFIG"+ case explicit <|> environment of+ Nothing -> pure disabledAIRuntime+ Just path -> do+ bytes <- BS.readFile path+ (cfg, permissions) <- either (const (ioError (userError "kioku: invalid AI configuration; check version, feature names, modes and required settings"))) pure (eitherDecodeStrict bytes >>= parseEither parseAIConfig)+ api <- if API `elem` permissions then Just <$> newProviderRegistryFrom [Claude.claudeMessagesProvider, OpenAI.openaiChatProvider, Responses.openaiResponsesProvider] else pure Nothing+ batch <- if Batch `elem` permissions then Just <$> newProviderRegistryFrom [ClaudeCli.claudeCliProvider ClaudeCli.defaultClaudeCliConfig, Codex.codexCliProvider Codex.defaultCodexCliConfig] else pure Nothing+ let launcher feature request = case Map.findWithDefault cfg.distillationDefault feature cfg.featureOverrides of+ InteractiveConfig I.InteractiveClaude _ -> either (const (Left (AIInteractiveFailed feature "Baikai refused interactive safety settings"))) Right <$> ClaudeInteractive.launchClaudeInteractive ClaudeInteractive.defaultClaudeInteractiveConfig request+ InteractiveConfig I.InteractiveCodex _ -> either (const (Left (AIInteractiveFailed feature "Baikai refused interactive safety settings"))) Right <$> CodexInteractive.launchCodexInteractive CodexInteractive.defaultCodexInteractiveConfig request+ _ -> pure (Left (AIExecutionRefused feature "interactive mode was not selected"))+ caps =+ noHostCapabilities+ { apiRegistry = api,+ batchRegistry = batch,+ allowInteractive = Interactive `elem` permissions,+ launchInteractive = if foreground && Interactive `elem` permissions then Just launcher else Nothing,+ allowEmbeddingAPI = API `elem` permissions+ }+ newAIRuntime caps cfg >>= either (ioError . userError . show) pure++parseAIConfig :: Value -> Parser (AIConfig, [ExecutionMode])+parseAIConfig = withObject "AI configuration" $ \o -> do+ strictKeys ["version", "permissions", "distillation", "features", "embeddings"] o+ version <- o .: "version"+ unless (version == (1 :: Int)) (fail "unsupported AI configuration version")+ permissions <- o .:? "permissions" .!= [] >>= traverse mode+ defaults <- maybe (pure DistillationDisabled) distillation =<< o .:? "distillation"+ overrides <- o .:? "features" .!= KM.empty >>= featureMap distillation+ embeddings <- o .:? "embeddings" .!= KM.empty >>= featureMap embedding+ pure (AIConfig defaults overrides embeddings, permissions)++featureMap :: (Value -> Parser a) -> Object -> Parser (Map.Map AIFeature a)+featureMap parseValue o = Map.fromList <$> traverse one (KM.toList o)+ where+ one (key, value) = (,) <$> either (const (fail "unknown feature")) pure (parseFeature (Key.toText key)) <*> parseValue value++mode :: Text -> Parser ExecutionMode+mode = \case+ "disabled" -> pure Disabled+ "api" -> pure API+ "batch" -> pure Batch+ "interactive" -> pure Interactive+ _ -> fail "invalid execution mode"++distillation :: Value -> Parser DistillationConfig+distillation = withObject "distillation" $ \o -> do+ selected <- o .: "mode" >>= mode+ case selected of+ Disabled -> strictKeys ["mode"] o >> pure DistillationDisabled+ Interactive -> do+ strictKeys ["mode", "provider", "model", "workingDir", "effort"] o+ provider <-+ o .: "provider" >>= \case+ "claude" -> pure I.InteractiveClaude+ "codex" -> pure I.InteractiveCodex+ (_ :: Text) -> fail "unknown interactive provider"+ model <- o .: "model"+ working <- o .: "workingDir"+ effort <- o .:? "effort"+ let safety = case provider of+ I.InteractiveClaude -> I.ClaudeAllowedTools ["Read", "Write"]+ I.InteractiveCodex -> I.CodexSandbox I.CodexWorkspaceWrite I.CodexApprovalOnRequest+ pure (InteractiveConfig provider ((I.interactiveLaunchRequest "") {I.modelId = Just model, I.workingDir = Just working, I.safety = safety, I.effort = effort}))+ _ -> do+ strictKeys ["mode", "api", "model", "provider", "baseUrl", "options"] o+ api <- o .: "api"+ modelId <- o .: "model"+ baseUrl <- o .: "baseUrl"+ provider <- o .: "provider"+ options <- maybe (pure O.emptyOptions) parseOptions =<< o .:? "options"+ pure (CompletionConfig selected ((M.mkModel api modelId baseUrl) {M.provider = provider}) options)++parseOptions :: Value -> Parser O.Options+parseOptions = withObject "Baikai options" $ \o -> do+ strictKeys ["apiKeyEnv", "maxTokens", "temperature", "timeoutMs", "thinking"] o+ key <- fmap ApiKeyEnv <$> o .:? "apiKeyEnv"+ maxTokens <- o .:? "maxTokens"+ temperature <- o .:? "temperature"+ timeout <- o .:? "timeoutMs"+ thinking <- o .:? "thinking"+ pure O.emptyOptions {O.apiKey = key, O.maxTokens = maxTokens, O.temperature = temperature, O.timeoutMs = timeout, O.thinking = thinking}++embedding :: Value -> Parser E.EmbeddingModel+embedding = withObject "embedding" $ \o -> do+ strictKeys ["mode", "model", "baseUrl", "dimensions", "apiKeyEnv"] o+ selected <- o .: "mode" >>= mode+ unless (selected == API) (fail "embeddings require independently authorized API mode")+ model <- o .: "model"+ baseUrl <- o .: "baseUrl"+ dimensions <- o .: "dimensions"+ key <- fmap ApiKeyEnv <$> o .:? "apiKeyEnv"+ pure E.emptyEmbeddingModel {E.modelId = model, E.baseUrl = baseUrl, E.dimensions = Just dimensions, E.apiKey = key}++strictKeys :: [Text] -> Object -> Parser ()+strictKeys allowed o = unless (all ((`elem` allowed) . Key.toText) (KM.keys o)) (fail "unknown configuration field")
+ src/Kioku/AI/Interactive.hs view
@@ -0,0 +1,88 @@+-- | Checked result handoff for a host-authorized interactive session.+module Kioku.AI.Interactive (runInteractiveSignature) where++import Baikai.Interactive qualified as Interactive+import Control.Exception (IOException, bracket, try)+import Data.Aeson qualified as Aeson+import Data.Aeson.Types (parseEither, withObject, (.:))+import Data.ByteString qualified as BS+import Data.ByteString.Lazy qualified as LBS+import Data.Text.Encoding (decodeUtf8)+import Data.UUID qualified as UUID+import Data.UUID.V4 qualified as UUID+import Kioku.AI.Config+import Kioku.AI.Runtime+import Kioku.Prelude+import Shikumi.Adapter (ToPrompt (..), nativeRenderPieces)+import Shikumi.Schema (FromModel, ToSchema, Validatable, deriveSchema, fromModelChecked)+import Shikumi.Signature (Signature)+import System.Directory (getTemporaryDirectory, removePathForcibly)+import System.Exit (ExitCode (..))+import System.FilePath ((</>))+import System.IO (hClose)+import System.Posix.Files (fileSize, getFdStatus, isRegularFile, linkCount)+import System.Posix.IO (OpenFileFlags (..), OpenMode (ReadOnly), closeFd, defaultFileFlags, dup, fdToHandle, openFd)+import System.Posix.Temp (mkdtemp)++runInteractiveSignature ::+ forall i o.+ (ToPrompt i, ToPrompt o, ToSchema o, FromModel o, Validatable o) =>+ AIRuntime -> AIFeature -> Signature i o -> i -> IO (Either AIExecutionError o)+runInteractiveSignature rt feature signature input = case executionAvailability rt feature of+ Left err -> pure (Left err)+ Right () -> case (featureConfiguration rt feature, interactiveLauncher rt) of+ (InteractiveConfig provider settings, Just launch) -> do+ result <- try @IOException $ do+ temp <- getTemporaryDirectory+ bracket (mkdtemp (temp </> "kioku-ai-")) removePathForcibly $ \workspace -> do+ requestId <- UUID.toText <$> UUID.nextRandom+ let output = workspace </> "result.json"+ manifest =+ Aeson.object+ [ "requestId" Aeson..= requestId,+ "feature" Aeson..= featureName feature,+ "schema" Aeson..= deriveSchema @o,+ "instructions" Aeson..= fst (nativeRenderPieces signature),+ "input" Aeson..= toPrompt input,+ "outputFile" Aeson..= output+ ]+ contract =+ "Read this request and write exactly one JSON object to outputFile. "+ <> "The envelope must contain requestId and feature copied from the request, "+ <> "and result containing the output object matching schema. Do not write to memory or databases.\n"+ <> decodeUtf8 (LBS.toStrict (Aeson.encode manifest))+ request =+ settings+ { Interactive.userPrompt = contract,+ Interactive.systemPrompt = Just "Perform the single Kioku request in the user message. Write the designated output file as a JSON envelope with exactly requestId, feature, and result. Copy requestId and feature verbatim. The manifest's instructions and schema describe ONLY the result field, never the outer envelope. Do not substitute a prose response or a bare result object. Do not access databases or write memory directly.",+ Interactive.extraDirs = workspace : settings.extraDirs+ }+ LBS.writeFile (workspace </> "request.json") (Aeson.encode manifest)+ launched <- launch feature request+ case launched of+ Left err -> pure (Left err)+ Right session+ | session.provider /= provider -> pure (failure "interactive provider mismatch")+ | session.exitCode /= ExitSuccess -> pure (failure "interactive session exited unsuccessfully")+ | otherwise -> bracket (openFd output ReadOnly defaultFileFlags {nofollow = True, nonBlock = True, cloexec = True}) closeFd $ \fd -> do+ status <- getFdStatus fd+ if not (isRegularFile status) || linkCount status /= 1 || fileSize status > fromIntegral maxResultBytes+ then pure (failure "result must be a bounded regular file with no links")+ else do+ bytes <- bracket (dup fd >>= fdToHandle) hClose (\h -> BS.hGet h (maxResultBytes + 1))+ pure $+ if BS.length bytes > maxResultBytes+ then failure "result exceeds size limit"+ else case Aeson.eitherDecodeStrict bytes >>= parseEither (envelope requestId) of+ Left _ -> failure "missing, invalid, or mismatched result envelope"+ Right value -> either (Left . AIProgramFailed) Right (fromModelChecked value)+ pure $ either (const (failure "interactive result I/O failed")) id result+ _ -> pure (Left (AIExecutionRefused feature "select interactive execution for this signature"))+ where+ maxResultBytes = 1024 * 1024+ failure = Left . AIInteractiveFailed feature+ envelope requestId = withObject "interactive result" $ \o -> do+ actualId <- o .: "requestId"+ actualFeature <- o .: "feature"+ unless (actualId == requestId && actualFeature == featureName feature) (fail "result identity mismatch")+ o .: "result"
+ src/Kioku/AI/Runtime.hs view
@@ -0,0 +1,155 @@+{-# LANGUAGE DataKinds #-}++-- | Immutable dispatch through capabilities supplied by the embedding host.+module Kioku.AI.Runtime+ ( AIRuntime,+ HostCapabilities (..),+ noHostCapabilities,+ newAIRuntime,+ disabledAIRuntime,+ featureConfiguration,+ executionAvailability,+ runAIProgram,+ runtimeEmbeddingModel,+ interactiveLauncher,+ )+where++import Baikai.Api (Api (..), normaliseApi)+import Baikai.Embedding qualified as Embedding+import Baikai.Interactive (InteractiveLaunchRequest, InteractiveLaunchResult)+import Baikai.Interactive qualified+import Baikai.Model qualified as Model+import Baikai.Options qualified as Options+import Baikai.Provider.Registry qualified as Registry+import Data.Map.Strict qualified as Map+import Data.Maybe (catMaybes)+import Data.Text qualified as Text+import Effectful (runEff)+import Effectful.Concurrent (runConcurrent)+import Effectful.Dispatch.Dynamic (interpose)+import Effectful.Error.Static (runErrorNoCallStack)+import Kioku.AI.Config+import Kioku.Prelude+import Shikumi.Error (ShikumiError)+import Shikumi.LLM qualified as LLM+import Shikumi.Program (Program, runProgram)+import Shikumi.Routing (routeLLM, runRouting)++-- | Registries grant separate API and batch capabilities. The callback grants a+-- fresh interactive session; presence of a terminal or executable grants none.+data HostCapabilities = HostCapabilities+ { apiRegistry :: Maybe Registry.ProviderRegistry,+ batchRegistry :: Maybe Registry.ProviderRegistry,+ allowInteractive :: Bool,+ launchInteractive :: Maybe (AIFeature -> InteractiveLaunchRequest -> IO (Either AIExecutionError InteractiveLaunchResult)),+ allowEmbeddingAPI :: Bool+ }++noHostCapabilities :: HostCapabilities+noHostCapabilities = HostCapabilities Nothing Nothing False Nothing False++data AIRuntime = AIRuntime AIConfig HostCapabilities (Map.Map AIFeature Registry.ProviderRegistry)++disabledAIRuntime :: AIRuntime+disabledAIRuntime = AIRuntime disabledAIConfig noHostCapabilities Map.empty++featureConfiguration :: AIRuntime -> AIFeature -> DistillationConfig+featureConfiguration (AIRuntime cfg _ _) feature+ | feature `elem` distillationFeatures = Map.findWithDefault cfg.distillationDefault feature cfg.featureOverrides+ | otherwise = DistillationDisabled++runtimeEmbeddingModel :: AIRuntime -> AIFeature -> Either AIExecutionError Embedding.EmbeddingModel+runtimeEmbeddingModel (AIRuntime cfg _ _) feature = maybe (Left (AIDisabled feature)) Right (Map.lookup feature cfg.embeddingSettings)++interactiveLauncher :: AIRuntime -> Maybe (AIFeature -> InteractiveLaunchRequest -> IO (Either AIExecutionError InteractiveLaunchResult))+interactiveLauncher (AIRuntime _ caps _) = caps.launchInteractive++executionAvailability :: AIRuntime -> AIFeature -> Either AIExecutionError ()+executionAvailability rt feature+ | feature `elem` embeddingFeatures = () <$ runtimeEmbeddingModel rt feature+ | otherwise = case featureConfiguration rt feature of+ DistillationDisabled -> Left (AIDisabled feature)+ InteractiveConfig {} -> maybe (Left (InteractiveUnavailable feature)) (const (Right ())) (interactiveLauncher rt)+ CompletionConfig {} -> Right ()++-- | Validate without reading credentials or invoking handlers. Snapshot selected+-- handlers into private registries so later host registration cannot widen them.+newAIRuntime :: HostCapabilities -> AIConfig -> IO (Either AIConfigurationError AIRuntime)+newAIRuntime caps cfg = case validateShape of+ Left err -> pure (Left err)+ Right () -> do+ selected <- traverse validateFeature distillationFeatures+ pure $ AIRuntime cfg caps . Map.fromList . catMaybes <$> sequence selected+ where+ invalid f = Left . InvalidAIConfiguration (Just f)+ validateShape = do+ forM_ (Map.keys cfg.featureOverrides) $ \f ->+ unless (f `elem` distillationFeatures) (invalid f "embedding features require embedding settings")+ forM_ (Map.toList cfg.embeddingSettings) $ \(f, model) -> do+ unless (f `elem` embeddingFeatures) (invalid f "distillation features require distillation settings")+ unless caps.allowEmbeddingAPI (invalid f "host has not granted embedding API execution")+ when (Text.null (Text.strip model.modelId)) (invalid f "select an embedding model")+ unless (model.dimensions == Just 1536) (invalid f "stored vectors require 1536 dimensions; migrate and re-embed before changing models")+ case Map.elems cfg.embeddingSettings of+ [] -> Right ()+ model : rest ->+ unless+ (all (\other -> other.modelId == model.modelId && other.baseUrl == model.baseUrl) rest)+ (Left (InvalidAIConfiguration Nothing "memory, query and candidate embeddings must use the same model and endpoint"))+ validateFeature f = case featureConfiguration (AIRuntime cfg caps Map.empty) f of+ DistillationDisabled -> pure (Right Nothing)+ InteractiveConfig _ request -> pure $ do+ unless caps.allowInteractive (invalid f "host has not granted interactive execution")+ when (maybe True (Text.null . Text.strip) request.modelId) (invalid f "select an interactive model")+ Right Nothing+ CompletionConfig mode model _ -> do+ let registry = case mode of API -> caps.apiRegistry; Batch -> caps.batchRegistry; _ -> Nothing+ tag = normaliseApi model.api+ tagAllowed = case tag of+ AnthropicMessagesCli -> mode == Batch+ OpenAICompletionsCli -> mode == Batch+ Custom _ -> mode == API || mode == Batch+ _ -> mode == API+ if Text.null (Text.strip (Model.modelId model))+ then pure (invalid f "select a completion model")+ else+ if not tagAllowed+ then pure (invalid f "model transport does not match execution mode")+ else case registry of+ Nothing -> pure (invalid f "host has not granted this completion mode")+ Just reg ->+ Registry.lookupApiProviderWith reg tag >>= \case+ Nothing -> pure (invalid f "register the selected transport in the host registry")+ Just handler -> do+ snapshot <- Registry.newProviderRegistryFrom [handler]+ pure (Right (Just (f, snapshot)))++-- | Force both model and options at the final LLM boundary. A Program's nested+-- routing choices cannot escape the selected feature capability.+runAIProgram :: AIRuntime -> AIFeature -> Program i o -> i -> IO (Either AIExecutionError o)+runAIProgram rt@(AIRuntime _ _ registries) feature prog input = case executionAvailability rt feature of+ Left err -> pure (Left err)+ Right () -> case (featureConfiguration rt feature, Map.lookup feature registries) of+ (CompletionConfig _ model selected, Just reg) -> do+ result <-+ runEff+ . runErrorNoCallStack @ShikumiError+ . runConcurrent+ . runRouting model+ . LLM.runLLMResilient (LLM.defaultLLMConfig reg)+ . interpose+ ( \_ -> \case+ LLM.Complete _ ctx opts -> LLM.complete model ctx (wireOptions selected opts)+ LLM.Stream _ ctx opts -> LLM.stream model ctx (wireOptions selected opts)+ )+ . routeLLM+ $ runProgram prog input+ pure (either (Left . AIProgramFailed) Right result)+ _ -> pure (Left (AIExecutionRefused feature "interactive execution requires a typed signature result handoff"))+ where+ wireOptions selected rendered =+ selected+ { Options.responseFormat = rendered.responseFormat,+ Options.metadata = Map.union rendered.metadata selected.metadata+ }
src/Kioku/Distill/L1.hs view
@@ -8,6 +8,7 @@ L1Summary (..), distillSessionL1, recallCandidates,+ recallCandidatesWithEmbeddingAdapter, scopedScanCandidates, ) where@@ -36,6 +37,8 @@ import Hasql.Statement (Statement, preparable) import Hasql.Transaction qualified as Tx import Keiro.ReadModel (ReadModelError)+import Kioku.AI.Config+import Kioku.AI.Runtime (AIRuntime, runtimeEmbeddingModel) import Kioku.Api.Access ( MemoryAccessContext, MemoryPermission (..),@@ -55,15 +58,16 @@ ExistingMemory (..), ) import Kioku.Distill.Extract (ExtractInput (..), ExtractOutput (..), ExtractedAtom (..))-import Kioku.Distill.Runtime (DistillRuntime, runConsolidation, runExtraction)+import Kioku.Distill.Runtime (DistillRuntime, distillAvailability, runConsolidation, runExtraction) import Kioku.Id (MemoryId, SessionId, idText, parseIdLenient) import Kioku.Memory qualified as Memory import Kioku.Memory.Domain (RecordMemoryData (..))+import Kioku.Memory.Embedding (embeddingModelCompatible) import Kioku.Memory.ReadModel (MemoryRow (..)) import Kioku.Partition (memorySpaceParam) import Kioku.Prelude import Kioku.Recall qualified as Recall-import Kioku.Recall.Capability (VectorCapability)+import Kioku.Recall.Capability (VectorCapability (..)) import Kioku.Session qualified as Session import Kioku.Session.ReadModel (SessionRow (..), TurnRow (..)) import Kiroku.Store.Effect (Store)@@ -94,6 +98,7 @@ | L1SessionNotFound !SessionId | L1TurnReadFailed !ReadModelError | L1MemoryReadFailed !ReadModelError+ | L1ExecutionFailed !AIExecutionError | L1ExtractionFailed !Text | L1ConsolidationFailed !Text | L1MemoryWriteFailed !Memory.MemoryWriteError@@ -188,6 +193,9 @@ distillSessionL1 context mode rt finder sid = case find (not . (`memoryContextAllows` context)) requiredPermissions of Just missingPermission -> pure (Left (L1NotPermitted missingPermission))+ Nothing+ | Left err <- distillAvailability rt Extraction >> distillAvailability rt Consolidation ->+ pure (Left (L1ExecutionFailed err)) Nothing -> do sessionResult <- Session.getById space sid case sessionResult of@@ -209,7 +217,7 @@ Right input -> do extractedResult <- liftIO (runExtraction rt input) case extractedResult of- Left err -> pure (Left (L1ExtractionFailed (Text.pack (show err))))+ Left err -> pure (Left (L1ExecutionFailed err)) Right output -> do foldResult <- foldM@@ -293,13 +301,22 @@ -- Nobody chose that; it is what @ScopeGlobal@ meaning two things looked like from inside one -- module. See @docs\/plans\/30-migrate-recall-consumers-to-explicit-targets.md@ for the decision -- and what it costs: a globally-scoped session now stores where it used to merge across scopes.-recallCandidates ::+recallCandidates :: (IOE :> es, Store :> es) => AIRuntime -> VectorCapability -> Int -> FindMergeCandidates es+recallCandidates ai capability limit = case runtimeEmbeddingModel ai CandidateEmbedding of+ Left _ -> scopedScanCandidates limit+ Right model -> FindMergeCandidates $ \context scope query -> do+ compatible <- if capability == VectorAvailable then embeddingModelCompatible (memoryContextSpace context) model else pure True+ if compatible+ then let FindMergeCandidates findCandidates = recallCandidatesWithEmbeddingAdapter model capability limit in findCandidates context scope query+ else pure (Left (L1ExecutionFailed (AIExecutionRefused CandidateEmbedding "stored embedding model differs; re-embed before semantic candidates")))++recallCandidatesWithEmbeddingAdapter :: (IOE :> es, Store :> es) => EmbeddingModel -> VectorCapability -> Int -> FindMergeCandidates es-recallCandidates model capability limit =+recallCandidatesWithEmbeddingAdapter model capability limit = FindMergeCandidates \context scope query -> -- A limit of zero or less asks for no candidates, which is what the pre-'RecallLimit' -- @take (max 0 limit)@ produced. Anything above the bound is clamped rather than refused:@@ -308,7 +325,7 @@ Left _ -> pure (Right []) Right maxResults -> do hits <-- Recall.recall+ Recall.recallWithEmbeddingAdapter model capability context@@ -390,7 +407,7 @@ existing = existingMemory <$> candidates } case decisionResult of- Left err -> pure (Left (L1ConsolidationFailed (Text.pack (show err))))+ Left err -> pure (Left (L1ExecutionFailed err)) Right decision -> do appliedResult <- applyDecision context sid session atom decision case appliedResult of
src/Kioku/Distill/L2.hs view
@@ -41,12 +41,13 @@ import Keiro.Projection (InlineProjection (..)) import Keiro.ReadModel (ReadModelError) import Keiro.Timer (TimerId (..), TimerRequest (..), TimerRow (..), scheduleTimerTx)+import Kioku.AI.Config import Kioku.Api.Access (MemoryContextProvider, MemorySpaceId, legacyMemorySpaceId) import Kioku.Api.Scope (MemoryScope, scopeFromColumns, scopeKindText, scopeNamespaceText, scopeRefText) import Kioku.Api.Types (MemoryRecord (..)) import Kioku.Database.Schema (memoriesTable, scenesTable) import Kioku.Distill.L3 (partitionedCorrelationId, scheduleL3PersonaTimerTx)-import Kioku.Distill.Runtime (DistillRuntime, distillWorkspaceRoot, runSceneDistillation)+import Kioku.Distill.Runtime (DistillRuntime, distillAvailability, distillWorkspaceRoot, runSceneDistillation) import Kioku.Distill.Scene (SceneInput (..), SceneOutput (..)) import Kioku.Distill.ScopeIdentity (escapeScopeComponent, scopeIdentity, scopeSlugFromColumns) import Kioku.Distill.Timer.Outcome@@ -83,6 +84,7 @@ data L2Error = L2MemoryReadFailed !ReadModelError | L2SceneReadFailed+ | L2ExecutionFailed !AIExecutionError | L2SceneGenerationFailed !Text deriving stock (Generic, Show) @@ -278,7 +280,7 @@ atoms = field (renderAtoms atoms) } case outputResult of- Left err -> pure (Left (L2SceneGenerationFailed (Text.pack (show err))))+ Left err -> pure (Left (L2ExecutionFailed err)) Right output -> do now <- liftIO getCurrentTime let row =@@ -319,7 +321,11 @@ "L2 scene timer" contextProvider row- (regenerateScene rt)+ (\case L2ExecutionFailed err -> Just err; _ -> Nothing)+ ( \space scope -> case distillAvailability rt Scene of+ Left err -> pure (Left (L2ExecutionFailed err))+ Right () -> regenerateScene rt space scope+ ) lookupScene :: (Store :> es) =>
src/Kioku/Distill/L3.hs view
@@ -41,6 +41,7 @@ import Hasql.Statement (Statement, preparable) import Hasql.Transaction qualified as Tx import Keiro.Timer (TimerId (..), TimerRequest (..), TimerRow (..), scheduleTimerTx)+import Kioku.AI.Config import Kioku.Api.Access ( MemoryContextProvider, MemorySpaceId,@@ -50,7 +51,7 @@ import Kioku.Api.Scope (MemoryScope, scopeKindText, scopeNamespaceText, scopeRefText) import Kioku.Database.Schema (personasTable, scenesTable) import Kioku.Distill.Persona (PersonaInput (..), PersonaOutput (..))-import Kioku.Distill.Runtime (DistillRuntime, distillWorkspaceRoot, runPersonaDistillation)+import Kioku.Distill.Runtime (DistillRuntime, distillAvailability, distillWorkspaceRoot, runPersonaDistillation) import Kioku.Distill.ScopeIdentity (scopeIdentity, scopeSlugFromColumns) import Kioku.Distill.Timer.Outcome ( FireOutcome,@@ -74,6 +75,7 @@ data L3Error = L3SceneGenerationUnavailable+ | L3ExecutionFailed !AIExecutionError | L3PersonaGenerationFailed !Text deriving stock (Generic, Show) @@ -202,7 +204,7 @@ scenes = field (renderScenes scenes) } case outputResult of- Left err -> pure (Left (L3PersonaGenerationFailed (Text.pack (show err))))+ Left err -> pure (Left (L3ExecutionFailed err)) Right output -> do now <- liftIO getCurrentTime let row =@@ -239,7 +241,11 @@ "L3 persona timer" contextProvider row- (regeneratePersona rt)+ (\case L3ExecutionFailed err -> Just err; _ -> Nothing)+ ( \space scope -> case distillAvailability rt Persona of+ Left err -> pure (Left (L3ExecutionFailed err))+ Right () -> regeneratePersona rt space scope+ ) getPersonaByScope :: (Store :> es) =>
src/Kioku/Distill/Runtime.hs view
@@ -1,7 +1,12 @@ {-# LANGUAGE DataKinds #-} module Kioku.Distill.Runtime- ( DistillRuntime (..),+ ( DistillRuntime,+ TestRunners (..),+ testDistillRuntime,+ withTestRunners,+ withDistillWorkspace,+ distillAvailability, RuntimeSmokeInput (..), RuntimeSmokeOutput (..), distillWorkspaceRoot,@@ -15,47 +20,51 @@ ) where -import Baikai.Model (Model)-import Baikai.Models.Generated qualified as Models-import Baikai.Provider.Claude.Api qualified as ClaudeApi-import Baikai.Provider.Registry (globalProviderRegistry)-import Effectful (runEff)-import Effectful.Concurrent (runConcurrent)-import Effectful.Error.Static (runErrorNoCallStack)-import Kioku.Distill.Consolidate (ConsolidateInput, ConsolidationDecision, consolidateProgram)-import Kioku.Distill.Extract (ExtractInput, ExtractOutput, extractProgram)-import Kioku.Distill.Persona (PersonaInput, PersonaOutput, personaProgram)-import Kioku.Distill.Scene (SceneInput, SceneOutput, sceneProgram)+import Kioku.AI.Config+import Kioku.AI.Interactive+import Kioku.AI.Runtime+import Kioku.Distill.Consolidate (ConsolidateInput, ConsolidationDecision, consolidateProgram, consolidateSignature)+import Kioku.Distill.Extract (ExtractInput, ExtractOutput, extractProgram, extractSignature)+import Kioku.Distill.Persona (PersonaInput, PersonaOutput, personaProgram, personaSignature)+import Kioku.Distill.Scene (SceneInput, SceneOutput, sceneProgram, sceneSignature) import Kioku.Prelude import Shikumi.Adapter (ToPrompt) import Shikumi.Error (ShikumiError)-import Shikumi.LLM (LLMConfig, defaultLLMConfig, runLLMResilient) import Shikumi.Module (predict)-import Shikumi.Program (Program, runProgram)-import Shikumi.Routing (routeLLM, runRouting)+import Shikumi.Program (Program) import Shikumi.Schema (FromModel, ToSchema, Validatable) import Shikumi.Schema.Types (Field)-import Shikumi.Signature (mkSignature)+import Shikumi.Signature (Signature, mkSignature) import System.Directory (getCurrentDirectory) -data DistillRuntime = DistillRuntime- { config :: !LLMConfig,- defaultModel :: !Model,- -- | Where the plaintext scene and persona mirrors are written and removed.- -- 'Nothing' means the process's working directory, which is what the CLI- -- wants: an agent's workspace is wherever it was invoked. Tests pin it to a- -- temp directory instead, because tasty runs cases concurrently and a- -- process-wide @chdir@ would race between them.- workspaceRoot :: !(Maybe FilePath),- runExtract :: !(ExtractInput -> IO (Either ShikumiError ExtractOutput)),- runConsolidate :: !(ConsolidateInput -> IO (Either ShikumiError ConsolidationDecision)),- runScene :: !(SceneInput -> IO (Either ShikumiError SceneOutput)),- runPersona :: !(PersonaInput -> IO (Either ShikumiError PersonaOutput))+data DistillRuntime = DistillRuntime AIRuntime (Maybe FilePath) (Maybe TestRunners)++-- | Explicit controlled-runner seam for tests. Production construction accepts+-- only a validated AIRuntime; its captured settings cannot be record-updated.+data TestRunners = TestRunners+ { runExtract :: ExtractInput -> IO (Either ShikumiError ExtractOutput),+ runConsolidate :: ConsolidateInput -> IO (Either ShikumiError ConsolidationDecision),+ runScene :: SceneInput -> IO (Either ShikumiError SceneOutput),+ runPersona :: PersonaInput -> IO (Either ShikumiError PersonaOutput) } +testDistillRuntime :: IO DistillRuntime+testDistillRuntime = pure (DistillRuntime disabledAIRuntime Nothing (Just emptyTestRunners))++emptyTestRunners :: TestRunners+emptyTestRunners = TestRunners (const missing) (const missing) (const missing) (const missing)+ where+ missing = fail "test distillation runner was not supplied"++withTestRunners :: DistillRuntime -> (TestRunners -> TestRunners) -> DistillRuntime+withTestRunners (DistillRuntime ai root runners) f =+ DistillRuntime ai root (Just (f (fromMaybe emptyTestRunners runners)))++withDistillWorkspace :: FilePath -> DistillRuntime -> DistillRuntime+withDistillWorkspace root (DistillRuntime ai _ runners) = DistillRuntime ai (Just root) runners+ distillWorkspaceRoot :: DistillRuntime -> IO FilePath-distillWorkspaceRoot rt =- maybe getCurrentDirectory pure rt.workspaceRoot+distillWorkspaceRoot (DistillRuntime _ root _) = maybe getCurrentDirectory pure root newtype RuntimeSmokeInput = RuntimeSmokeInput { prompt :: Field "short input text to echo" Text@@ -69,52 +78,50 @@ deriving stock (Generic, Eq, Show) deriving anyclass (ToSchema, FromModel, ToPrompt, Validatable) -newDistillRuntime :: IO DistillRuntime-newDistillRuntime = do- ClaudeApi.register- let config = defaultLLMConfig globalProviderRegistry- defaultModel = Models.anthropic_claude_haiku_4_5- liveRun = runLiveDistillProgram config defaultModel- pure- DistillRuntime- { config,- defaultModel,- workspaceRoot = Nothing,- runExtract = liveRun extractProgram,- runConsolidate = liveRun consolidateProgram,- runScene = liveRun sceneProgram,- runPersona = liveRun personaProgram- }+newDistillRuntime :: AIRuntime -> Maybe FilePath -> DistillRuntime+newDistillRuntime ai root = DistillRuntime ai root Nothing -runDistillProgram :: DistillRuntime -> Program i o -> i -> IO (Either ShikumiError o)-runDistillProgram rt prog input =- runLiveDistillProgram rt.config rt.defaultModel prog input+distillAvailability :: DistillRuntime -> AIFeature -> Either AIExecutionError ()+distillAvailability (DistillRuntime ai _ runners) feature =+ maybe (executionAvailability ai feature) (const (Right ())) runners -runExtraction :: DistillRuntime -> ExtractInput -> IO (Either ShikumiError ExtractOutput)-runExtraction rt =- rt.runExtract+runDistillProgram :: DistillRuntime -> AIFeature -> Program i o -> i -> IO (Either AIExecutionError o)+runDistillProgram (DistillRuntime ai _ _) = runAIProgram ai -runConsolidation :: DistillRuntime -> ConsolidateInput -> IO (Either ShikumiError ConsolidationDecision)-runConsolidation rt =- rt.runConsolidate+runTyped ::+ (ToPrompt i, ToPrompt o, ToSchema o, FromModel o, Validatable o) =>+ AIRuntime -> AIFeature -> Signature i o -> Program i o -> i -> IO (Either AIExecutionError o)+runTyped ai feature signature program = case featureConfiguration ai feature of+ InteractiveConfig {} -> runInteractiveSignature ai feature signature+ _ -> runAIProgram ai feature program -runSceneDistillation :: DistillRuntime -> SceneInput -> IO (Either ShikumiError SceneOutput)-runSceneDistillation rt =- rt.runScene+runExtraction :: DistillRuntime -> ExtractInput -> IO (Either AIExecutionError ExtractOutput)+runExtraction (DistillRuntime ai _ runners) =+ maybe+ (runTyped ai Extraction extractSignature extractProgram)+ (\r i -> either (Left . AIProgramFailed) Right <$> r.runExtract i)+ runners -runPersonaDistillation :: DistillRuntime -> PersonaInput -> IO (Either ShikumiError PersonaOutput)-runPersonaDistillation rt =- rt.runPersona+runConsolidation :: DistillRuntime -> ConsolidateInput -> IO (Either AIExecutionError ConsolidationDecision)+runConsolidation (DistillRuntime ai _ runners) =+ maybe+ (runTyped ai Consolidation consolidateSignature consolidateProgram)+ (\r i -> either (Left . AIProgramFailed) Right <$> r.runConsolidate i)+ runners -runLiveDistillProgram :: LLMConfig -> Model -> Program i o -> i -> IO (Either ShikumiError o)-runLiveDistillProgram config model prog input =- runEff- . runErrorNoCallStack @ShikumiError- . runConcurrent- . runRouting model- . runLLMResilient config- . routeLLM- $ runProgram prog input+runSceneDistillation :: DistillRuntime -> SceneInput -> IO (Either AIExecutionError SceneOutput)+runSceneDistillation (DistillRuntime ai _ runners) =+ maybe+ (runTyped ai Scene sceneSignature sceneProgram)+ (\r i -> either (Left . AIProgramFailed) Right <$> r.runScene i)+ runners++runPersonaDistillation :: DistillRuntime -> PersonaInput -> IO (Either AIExecutionError PersonaOutput)+runPersonaDistillation (DistillRuntime ai _ runners) =+ maybe+ (runTyped ai Persona personaSignature personaProgram)+ (\r i -> either (Left . AIProgramFailed) Right <$> r.runPersona i)+ runners runtimeSmokeProgram :: Program RuntimeSmokeInput RuntimeSmokeOutput runtimeSmokeProgram =
+ src/Kioku/Distill/Timer/Deferred.hs view
@@ -0,0 +1,181 @@+{-# LANGUAGE DataKinds #-}++-- | Authorized discovery and foreground execution of parked distillation work.+module Kioku.Distill.Timer.Deferred+ ( DeferredTimer (..),+ DeferredPage (..),+ DeferredResumeResult (..),+ listDeferredTimers,+ resumeDeferredTimer,+ )+where++import Control.Concurrent (threadDelay)+import Data.Aeson qualified as Aeson+import Data.Text qualified as Text+import Effectful (Eff, IOE, raise, (:>))+import Effectful.Concurrent (runConcurrent)+import Effectful.Concurrent.Async (race)+import Effectful.Error.Static (Error)+import Effectful.Exception (finally, mask)+import Keiro.Timer qualified as Timer+import Kioku.AI.Config (AIExecutionError, AIFeature (..))+import Kioku.Api.Access+import Kioku.Distill.L1 (FindMergeCandidates)+import Kioku.Distill.L2 (SceneTimerPayload (..), l2SceneProcessManagerName)+import Kioku.Distill.L3 (PersonaTimerPayload (..), l3PersonaProcessManagerName)+import Kioku.Distill.Runtime (DistillRuntime, distillAvailability)+import Kioku.Distill.Timer (L1TimerPayload (..), l1ExtractProcessManagerName)+import Kioku.Distill.Timer.Outcome (FireOutcome (..))+import Kioku.Distill.Timer.Worker (fireKiokuTimer)+import Kioku.Id (SessionId, parseIdLenient)+import Kioku.Prelude+import Kiroku.Store.Effect (Store)+import Kiroku.Store.Effect.Resource (KirokuStoreResource)+import Kiroku.Store.Error (StoreError)++data DeferredTimer = DeferredTimer+ { timer :: !Timer.TimerRow,+ memorySpace :: !MemorySpaceId,+ features :: ![AIFeature],+ reason :: !Text+ }+ deriving stock (Eq, Show)++-- | Continue even when authorization removes every entry from a storage page.+-- The cursor is opaque storage position, not permission to inspect its timer.+data DeferredPage = DeferredPage+ { entries :: ![DeferredTimer],+ nextAfterTimerId :: !(Maybe Timer.TimerId)+ }+ deriving stock (Eq, Show)++data DeferredResumeResult+ = DeferredNotEligible+ | DeferredAccessDenied !MemoryAccessDenial+ | DeferredExecutionUnavailable !AIExecutionError+ | DeferredClaimRefused+ | DeferredOwnershipLost+ | DeferredFinished !FireOutcome+ deriving stock (Eq, Show)++deferredPrefix :: Text+deferredPrefix = "kioku:deferred:interactive-unavailable "++-- Decode exactly the handler's payload before authorizing or claiming anything.+inspectDeferred :: Timer.TimerInspection -> Maybe DeferredTimer+inspectDeferred inspection = do+ let row = inspection.timer+ guard (row.status == Timer.Dead)+ reason <- inspection.lastError+ guard (deferredPrefix `Text.isPrefixOf` reason)+ (space, features) <-+ if row.processManagerName == l1ExtractProcessManagerName+ then do+ _ <- either (const Nothing) Just (parseIdLenient row.correlationId :: Either Text SessionId)+ payload <- decode @L1TimerPayload row.payload+ pure (payload.memorySpaceId, [Extraction, Consolidation])+ else+ if row.processManagerName == l2SceneProcessManagerName+ then do+ payload <- decode @SceneTimerPayload row.payload+ pure (payload.memorySpaceId, [Scene])+ else+ if row.processManagerName == l3PersonaProcessManagerName+ then do+ payload <- decode @PersonaTimerPayload row.payload+ pure (payload.memorySpaceId, [Persona])+ else Nothing+ pure (DeferredTimer row space features reason)+ where+ decode :: (FromJSON a) => Aeson.Value -> Maybe a+ decode value = case Aeson.fromJSON value of+ Aeson.Success result -> Just result+ Aeson.Error _ -> Nothing++authorizeDeferred :: MemoryContextProvider (Eff es) -> DeferredTimer -> Eff es (Either MemoryAccessDenial ())+authorizeDeferred contexts entry = do+ let space = entry.memorySpace+ permissions = if Extraction `elem` entry.features then [MemoryDistill, MemoryRecord, MemoryForget] else [MemoryDistill]+ decision <- contexts.contextForSpace space+ pure $ do+ context <- decision+ if memoryContextSpace context /= space+ then Left (MemoryPermissionDenied space MemoryDistill)+ else case filter (not . (`memoryContextAllows` context)) permissions of+ missing : _ -> Left (MemoryPermissionDenied space missing)+ [] -> Right ()++-- | Recover expired leases, read one bounded storage page, and omit every row+-- whose payload or current authorization cannot be validated. No AI is invoked.+listDeferredTimers ::+ (Store :> es) =>+ MemoryContextProvider (Eff es) ->+ Timer.DeadTimerPageRequest ->+ Eff es (Either Timer.DeadTimerReadError DeferredPage)+listDeferredTimers contexts request = do+ void Timer.recoverExpiredTimerResumes+ page <- Timer.findDeadTimers (Timer.DeadTimerFilter Nothing (Timer.ReasonPrefix deferredPrefix)) request+ case page of+ Left err -> pure (Left err)+ Right found -> do+ authorized <- forM (mapMaybe inspectDeferred found.timers) $ \entry -> do+ decision <- authorizeDeferred contexts entry+ pure (either (const Nothing) (const (Just entry)) decision)+ pure (Right (DeferredPage (mapMaybe id authorized) found.nextAfterTimerId))++-- | Claims count toward the same eight-attempt ceiling as background work.+-- Unavailable preflights do not claim. All unsuccessful foreground outcomes+-- re-park with the original reason; retries require another explicit resume.+-- A renewing lease fences finalization and stops local work on ownership loss.+-- External effects still rely on distillation's existing idempotent writes.+resumeDeferredTimer ::+ (IOE :> es, Store :> es, KirokuStoreResource :> es, Error StoreError :> es) =>+ MemoryContextProvider (Eff es) ->+ DistillRuntime ->+ FindMergeCandidates es ->+ Timer.TimerId ->+ Eff es DeferredResumeResult+resumeDeferredTimer contexts rt finder tid = do+ void Timer.recoverExpiredTimerResumes+ inspection <- Timer.lookupTimerInspection tid+ case inspection >>= inspectDeferred of+ Nothing -> pure DeferredNotEligible+ Just entry -> do+ decision <- authorizeDeferred contexts entry+ case decision of+ Left denial -> pure (DeferredAccessDenied denial)+ Right () -> case traverse (distillAvailability rt) entry.features of+ Left err -> pure (DeferredExecutionUnavailable err)+ Right _ -> mask $ \restore -> do+ claimed <-+ Timer.claimDeadTimer+ Timer.DeadTimerClaimRequest+ { timerId = tid,+ processManagerName = entry.timer.processManagerName,+ expectedReason = entry.reason,+ maxAttempts = 8,+ leaseSeconds = 120+ }+ case claimed of+ Left _ -> pure DeferredClaimRefused+ Right Nothing -> pure DeferredClaimRefused+ Right (Just claim) ->+ restore (runClaim claim) `finally` void (Timer.parkTimerResume claim)+ where+ runClaim claim = do+ -- Keep renewal alive through execution and token-checked finalization.+ result <- runConcurrent $ race (raise (execute claim)) (raise (heartbeat claim))+ pure (either id (const DeferredOwnershipLost) result)+ execute claim = do+ outcome <- fireKiokuTimer contexts rt finder (Timer.resumeClaimTimer claim)+ finalized <- case outcome of+ FireCompleted event -> Timer.completeTimerResume claim event+ _ -> Timer.parkTimerResume claim+ pure (if finalized then DeferredFinished outcome else DeferredOwnershipLost)+ heartbeat claim = do+ liftIO (threadDelay (30 * 1000 * 1000))+ renewed <- Timer.renewTimerResume claim 120+ case renewed of+ Right True -> heartbeat claim+ _ -> pure ()
src/Kioku/Distill/Timer/Outcome.hs view
@@ -17,6 +17,7 @@ fireRetryDelay, unknownTimerRetryDelay, timerMarkerEventId,+ executionFireOutcome, ) where @@ -25,6 +26,7 @@ import Data.Time (NominalDiffTime) import Effectful (Eff) import Keiro.Timer (TimerId (..), TimerRow (..))+import Kioku.AI.Config import Kioku.Api.Access ( MemoryContextProvider (..), MemoryPermission (MemoryDistill),@@ -37,6 +39,7 @@ import Kioku.Partition (parsePartitionSpace) import Kioku.Prelude import Kiroku.Store.Types (EventId (..))+import Shikumi.Error (isTransient) -- | Decode the partition and scope shared by L2 and L3 timer payloads. --@@ -56,9 +59,10 @@ String -> MemoryContextProvider (Eff es) -> TimerRow ->+ (err -> Maybe AIExecutionError) -> (MemorySpaceId -> MemoryScope -> Eff es (Either err result)) -> Eff es FireOutcome-firePartitionedDistillTimer expectedProcessName payloadLabel contextProvider row regenerate+firePartitionedDistillTimer expectedProcessName payloadLabel contextProvider row executionError regenerate | row.processManagerName /= expectedProcessName = pure FireNotMine | otherwise =@@ -93,7 +97,7 @@ result <- regenerate (memoryContextSpace context) scope pure case result of Right _ -> FireCompleted (timerMarkerEventId row.timerId)- Left err -> FireRetryLater (fireRetryDelay row.attempts) (Text.pack (show err))+ Left err -> maybe (FireRetryLater (fireRetryDelay row.attempts) (Text.pack (show err))) (executionFireOutcome row.attempts) (executionError err) where label = Text.pack payloadLabel @@ -108,9 +112,16 @@ | -- | This can never succeed (a corrupt payload, an unparseable correlation -- id). Dead-letter it with this reason instead of faking success. FireFailedPermanently !Text+ | FireDeferred !Text | -- | This timer's process manager is not mine; I did not touch the row. FireNotMine deriving stock (Generic, Eq, Show)++executionFireOutcome :: Int -> AIExecutionError -> FireOutcome+executionFireOutcome attempts = \case+ InteractiveUnavailable feature -> FireDeferred ("kioku:deferred:interactive-unavailable feature=" <> featureName feature)+ AIProgramFailed err | isTransient err -> FireRetryLater (fireRetryDelay attempts) (Text.pack (show err))+ err -> FireFailedPermanently (Text.pack (show err)) -- | Backoff for a transient fire failure, by post-claim attempt count: -- 30s, 60s, 120s, … doubling, capped at 900s.
src/Kioku/Distill/Timer/Worker.hs view
@@ -31,7 +31,7 @@ runTimerWorkerWith, scheduleTimerTx, )-import Kioku.Api.Access (MemoryContextProvider (..), MemorySpaceId, memorySpaceIdText)+import Kioku.Api.Access (MemoryContextProvider (..), MemorySpaceId, memoryContextSpace, memorySpaceIdText) import Kioku.Distill.L1 (FindMergeCandidates, L1Error (..), L1RunMode (..), distillSessionL1) import Kioku.Distill.L2 (fireL2SceneTimer) import Kioku.Distill.L3 (fireL3PersonaTimer)@@ -39,6 +39,7 @@ import Kioku.Distill.Timer (L1TimerPayload (..), l1ExtractProcessManagerName) import Kioku.Distill.Timer.Outcome ( FireOutcome (..),+ executionFireOutcome, fireRetryDelay, timerMarkerEventId, unknownTimerRetryDelay,@@ -112,6 +113,9 @@ ( FireFailedPermanently ("L1 timer is not authorized for its memory space: " <> Text.pack (show denial)) )+ Right context+ | memoryContextSpace context /= payload.memorySpaceId ->+ pure (FireFailedPermanently "L1 timer context belongs to a different memory space") Right context -> do result <- distillSessionL1 context RespectWatermark rt finder sid pure $@@ -120,6 +124,7 @@ Right _outcome -> FireCompleted (timerMarkerEventId row.timerId) -- A session may legitimately be gone (deleted data); nothing to do. Left (L1SessionNotFound _) -> FireCompleted (timerMarkerEventId row.timerId)+ Left (L1ExecutionFailed err) -> executionFireOutcome row.attempts err -- Everything else — a failed LLM extraction or consolidation, a -- read-model error, a failed write — is worth another attempt, and -- the attempt ceiling bounds how many.@@ -172,6 +177,11 @@ logTimer row ("dead-lettering: " <> annotated) void (deadLetterTimer row.timerId annotated) pure Nothing+ FireDeferred reason -> do+ let annotated = reason <> " " <> spaceQualified row "resume in an authorized interactive session"+ logTimer row ("deferred: " <> annotated)+ void (deadLetterTimer row.timerId annotated)+ pure Nothing FireNotMine -> do logTimer row "no handler owns this process manager; requeueing" rescheduleClaimedTimer row unknownTimerRetryDelay@@ -225,6 +235,7 @@ -- reason is free text — an LLM provider message, a codec error — and stays on the span. fireOutcomeAttributes :: FireOutcome -> HashMap Text Attr.Attribute fireOutcomeAttributes = \case+ FireDeferred reason -> HashMap.fromList [outcomeAttr "deferred", reasonAttr reason] FireCompleted _ -> HashMap.fromList [outcomeAttr "completed"] FireRetryLater _ note -> HashMap.fromList [outcomeAttr "retry", reasonAttr note] FireFailedPermanently reason -> HashMap.fromList [outcomeAttr "dead_letter", reasonAttr reason]
src/Kioku/Memory/Embedding.hs view
@@ -5,23 +5,35 @@ toEmbeddingModel, embedWithRetry, sha256Hex,+ embeddingModelCompatible,+ embeddingModelsCompatible, ) where import Baikai.Auth (ApiKeySource (..)) import Baikai.Embedding (EmbeddingModel (..), embedOne, emptyEmbeddingModel)+import Contravariant.Extras (contrazip2) import Control.Concurrent (threadDelay) import Control.Exception (SomeException, try) import Crypto.Hash (Digest, SHA256) import Crypto.Hash qualified as Hash+import Data.Functor.Contravariant ((>$<)) import Data.Text qualified as Text import Data.Text.Encoding qualified as TE import Data.Vector (Vector) import Data.Vector qualified as Vector+import Effectful (Eff, (:>))+import Hasql.Decoders qualified as D+import Hasql.Encoders qualified as E+import Hasql.Statement (preparable)+import Hasql.Transaction qualified as Tx+import Kioku.AI.Config+import Kioku.AI.Runtime (AIRuntime, runtimeEmbeddingModel)+import Kioku.Api.Access (MemorySpaceId, memorySpaceIdText) import Kioku.Prelude+import Kiroku.Store.Effect (Store)+import Kiroku.Store.Transaction (runTransaction) import Numeric.Natural (Natural)-import System.Environment (lookupEnv)-import Text.Read (readMaybe) data EmbeddingConfig = EmbeddingConfig { baseUrl :: !Text,@@ -29,20 +41,19 @@ dimensions :: !Int, apiKey :: !Text }- deriving stock (Generic, Eq, Show)+ deriving stock (Generic, Eq) +instance Show EmbeddingConfig where+ show _ = "EmbeddingConfig <redacted; use Baikai embedding settings>"+ data EmbedError = EmbedTransport !Text+ | EmbedModelMismatch | EmbedEmpty deriving stock (Generic, Eq, Show) -resolveEmbeddingConfig :: IO EmbeddingConfig-resolveEmbeddingConfig = do- baseUrl <- envText "KIOKU_EMBEDDING_BASE_URL" "https://api.openai.com"- model <- envText "KIOKU_EMBEDDING_MODEL" "text-embedding-3-small"- dimensions <- envInt "KIOKU_EMBEDDING_DIMENSIONS" 1536- apiKey <- envTextFallback ["KIOKU_EMBEDDING_API_KEY", "OPENAI_API_KEY"] ""- pure EmbeddingConfig {baseUrl, model, dimensions, apiKey}+resolveEmbeddingConfig :: AIRuntime -> AIFeature -> Either AIExecutionError EmbeddingModel+resolveEmbeddingConfig = runtimeEmbeddingModel toEmbeddingModel :: EmbeddingConfig -> EmbeddingModel toEmbeddingModel cfg =@@ -77,19 +88,16 @@ attemptDelayMicros :: Int -> Int attemptDelayMicros attempt = 200000 * (2 ^ max 0 (attempt - 1)) -envText :: String -> Text -> IO Text-envText name fallback =- maybe fallback Text.pack <$> lookupEnv name--envInt :: String -> Int -> IO Int-envInt name fallback = do- found <- lookupEnv name- pure $ fromMaybe fallback (found >>= readMaybe)+-- | Refuse mixing model-labelled vectors within an authorized memory space.+-- Call only after the vector capability probe succeeds.+embeddingModelCompatible :: (Store :> es) => MemorySpaceId -> EmbeddingModel -> Eff es Bool+embeddingModelCompatible space = embeddingModelsCompatible (Just space) -envTextFallback :: [String] -> Text -> IO Text-envTextFallback [] fallback = pure fallback-envTextFallback (name : rest) fallback = do- found <- lookupEnv name- case found of- Just value -> pure (Text.pack value)- Nothing -> envTextFallback rest fallback+embeddingModelsCompatible :: (Store :> es) => Maybe MemorySpaceId -> EmbeddingModel -> Eff es Bool+embeddingModelsCompatible space model =+ runTransaction $+ Tx.statement (space, model.modelId) $+ preparable+ "SELECT NOT EXISTS (SELECT 1 FROM kioku.memories WHERE ($1::text IS NULL OR memory_space_id = $1) AND embedding IS NOT NULL AND (embedding_model IS DISTINCT FROM $2 OR dimensions IS DISTINCT FROM 1536))"+ (contrazip2 (fmap memorySpaceIdText >$< E.param (E.nullable E.text)) (E.param (E.nonNullable E.text)))+ (D.singleRow (D.column (D.nonNullable D.bool)))
src/Kioku/Memory/Embedding/Worker.hs view
@@ -53,6 +53,8 @@ import Hasql.Statement (Statement, preparable) import Hasql.Transaction qualified as Tx import Keiro.Codec (decodeRecorded)+import Kioku.AI.Config+import Kioku.AI.Runtime (AIRuntime, runtimeEmbeddingModel) import Kioku.Api.Access ( MemoryContextProvider (..), MemoryPermission (..),@@ -64,7 +66,7 @@ import Kioku.Database.Schema (memoriesTable) import Kioku.Id (MemoryId, idText) import Kioku.Memory.Domain (MemoryEvent (..), MemoryRecordedData (..))-import Kioku.Memory.Embedding (EmbedError, embedWithRetry, sha256Hex)+import Kioku.Memory.Embedding (EmbedError (..), embedWithRetry, embeddingModelCompatible, embeddingModelsCompatible, sha256Hex) import Kioku.Memory.EventStream (memoryCodec) import Kioku.Partition (memorySpaceColumn, memorySpaceParam) import Kioku.Prelude@@ -149,9 +151,10 @@ -- | The production environment: the real provider, retried three times -- in-process (~0.6s of jitter-free backoff) before the failure is reported to -- the caller, which then decides whether the /event/ should be redelivered.-mkEmbeddingWorkerEnv :: EmbeddingModel -> Int -> EmbeddingWorkerEnv-mkEmbeddingWorkerEnv model dims =- EmbeddingWorkerEnv {model, dimensions = dims, embed = embedWithRetry model 3}+mkEmbeddingWorkerEnv :: AIRuntime -> Either AIExecutionError EmbeddingWorkerEnv+mkEmbeddingWorkerEnv ai = do+ model <- runtimeEmbeddingModel ai MemoryEmbedding+ pure EmbeddingWorkerEnv {model, dimensions = 1536, embed = embedWithRetry model 3} -- | What one embedding attempt did. --@@ -176,11 +179,11 @@ KirokuStore -> MemoryContextProvider (Eff es) -> VectorCapability ->- EmbeddingModel ->- Int ->+ AIRuntime -> Eff es ()-runEmbeddingWorkerHost store contexts capability model dims = do- processor <- embeddingWorkerProcessor contexts capability model dims store+runEmbeddingWorkerHost store contexts capability ai = do+ env <- either (liftIO . ioError . userError . show) pure (mkEmbeddingWorkerEnv ai)+ processor <- embeddingWorkerProcessor contexts capability env store started <- runApp defaultAppConfig [processor] case started of Left appErr ->@@ -193,11 +196,10 @@ (IOE :> es, Store :> es, Error StoreError :> es) => MemoryContextProvider (Eff es) -> VectorCapability ->- EmbeddingModel ->- Int ->+ EmbeddingWorkerEnv -> KirokuStore -> Eff es (ProcessorId, QueueProcessor es)-embeddingWorkerProcessor contexts capability model dims store = do+embeddingWorkerProcessor contexts capability env store = do adapter <- kirokuAdapter store embeddingAdapterConfig pure ( ProcessorId embeddingWorkerName,@@ -206,7 +208,7 @@ -- The kiroku bridge is ack-coupled: a synchronous exception escaping -- the handler leaves the ack unfinalized and blocks the subscription -- worker forever. The guard turns that into a one-second retry.- handler = guardKirokuHandler (embeddingMessageHandler contexts capability (mkEmbeddingWorkerEnv model dims)),+ handler = guardKirokuHandler (embeddingMessageHandler contexts capability env), ordering = StrictInOrder, concurrency = Serial }@@ -302,6 +304,7 @@ (idText (d.memoryId :: MemoryId)) d.content case outcome of+ EmbedFailed EmbedModelMismatch -> pure (AckDeadLetter (InvalidPayload "stored embedding model differs; re-embed this memory space")) EmbedFailed err -> do logWorker ("embedding failed, retrying: " <> Text.pack (show err)) pure (AckRetry retryDelay)@@ -340,6 +343,8 @@ EmbeddingBackfillScope -> Eff es Int backfillMissingEmbeddings VectorAvailable env scope = do+ compatible <- embeddingModelsCompatible (case scope of BackfillEverySpace -> Nothing; BackfillOneSpace space -> Just space) env.model+ unless compatible (liftIO (ioError (userError "stored embedding model differs; re-embed the selected spaces before backfill"))) candidates <- selectEmbeddingCandidates scope foldM embedCandidate 0 candidates where@@ -347,6 +352,8 @@ | shouldSkipEmbedding candidate.hasEmbedding candidate.contentHash contentHash = pure count | otherwise = do+ compatible <- embeddingModelCompatible candidate.memorySpaceId env.model+ unless compatible (liftIO (ioError (userError "stored embedding model differs; re-embed the memory space before backfill"))) outcome <- embedAndStore env candidate.memorySpaceId candidate.memoryId candidate.content contentHash case outcome of@@ -418,8 +425,9 @@ pure (EmbedSpaceMismatch memorySpaceId state.memorySpaceId) | shouldSkipEmbedding state.hasEmbedding state.contentHash contentHash -> pure EmbedSkipped- | otherwise ->- embedAndStore env memorySpaceId memoryId content contentHash+ | otherwise -> do+ compatible <- embeddingModelCompatible memorySpaceId env.model+ if compatible then embedAndStore env memorySpaceId memoryId content contentHash else pure (EmbedFailed EmbedModelMismatch) where contentHash = sha256Hex content embedMemoryContent _ _ _ _ _ = pure EmbedSkipped
src/Kioku/Recall.hs view
@@ -33,6 +33,7 @@ RecallHit (..), RecallExecutionPlan (..), recall,+ recallWithEmbeddingAdapter, -- * The pre-target API, kept for one release RecallRequest (..),@@ -75,7 +76,7 @@ ) where -import Baikai.Embedding (EmbeddingModel)+import Baikai.Embedding (EmbeddingModel, emptyEmbeddingModel) import Data.Aeson qualified as Aeson import Data.ByteString (ByteString) import Data.ByteString.Lazy qualified as BL@@ -97,6 +98,8 @@ import Hasql.Statement (Statement, preparable) import Hasql.Transaction qualified as Tx import Keiro.ReadModel (ConsistencyMode (..), ReadModelError, runQueryWith)+import Kioku.AI.Config+import Kioku.AI.Runtime (AIRuntime, runtimeEmbeddingModel) import Kioku.Api.Access (MemoryAccessContext, MemorySpaceId, memoryContextSpace) import Kioku.Api.Recall ( RecallLimit,@@ -120,7 +123,7 @@ import Kioku.Api.Types (MemoryRecord (..), MemoryType, memoryTypeToText) import Kioku.Database.Schema (memoriesTable) import Kioku.Id (MemoryId, SessionId, idText)-import Kioku.Memory.Embedding (embedWithRetry)+import Kioku.Memory.Embedding (embedWithRetry, embeddingModelCompatible) import Kioku.Memory.ReadModel ( MemoriesByNamespaceQuery (..), MemoriesByScopeQuery (..),@@ -139,6 +142,7 @@ import Kioku.Recall.Capability (VectorCapability (..)) import Kiroku.Store.Effect (Store) import Kiroku.Store.Transaction (runTransaction)+import System.IO qualified -- $testSeams -- Exported so the candidate SQL can be exercised directly against a real database@@ -198,6 +202,7 @@ -- @RecallSpaceMismatch requested authorized@. Only 'legacyRecall' can produce this, because -- only the legacy request carries a space of its own. RecallSpaceMismatch !MemorySpaceId !MemorySpaceId+ | RecallAIUnavailable !AIExecutionError deriving stock (Generic, Eq, Show) data RecallHit = RecallHit@@ -346,14 +351,30 @@ -- The context is not asked for a second permission. A 'MemoryAccessContext' exists only for -- permissions 'Kioku.Api.Access.authorizeMemoryAccess' already checked against this space, which -- is the same reason the read functions below take only a space — see "Kioku.Memory".-recall ::+-- | Policy-aware recall. Hybrid degrades visibly to keyword; explicit vector+-- requests retain an unavailable error rather than reporting an empty success.+recall :: (IOE :> es, Store :> es) => AIRuntime -> VectorCapability -> MemoryAccessContext -> RecallQuery -> Eff es (Either RecallError [RecallHit])+recall ai capability context request = case runtimeEmbeddingModel ai QueryEmbedding of+ Right model -> do+ compatible <- if capability == VectorAvailable && request.strategy /= Keyword then embeddingModelCompatible (memoryContextSpace context) model else pure True+ if compatible+ then recallWithEmbeddingAdapter model capability context request+ else pure (Left (RecallAIUnavailable (AIExecutionRefused QueryEmbedding "stored embedding model differs; re-embed the memory space before semantic recall")))+ Left err -> case request.strategy of+ Embedding -> pure (Left (RecallAIUnavailable err))+ _ -> do+ when (request.strategy == Hybrid) (liftIO (System.IO.hPutStrLn System.IO.stderr "kioku recall: query embeddings disabled by AI policy; using keyword search"))+ recallWithEmbeddingAdapter emptyEmbeddingModel VectorExtensionUnavailable context request {strategy = Keyword}++-- | Explicit host/test adapter. The supplied model is an independent API capability.+recallWithEmbeddingAdapter :: (IOE :> es, Store :> es) => EmbeddingModel -> VectorCapability -> MemoryAccessContext -> RecallQuery -> Eff es (Either RecallError [RecallHit])-recall model capability context request =+recallWithEmbeddingAdapter model capability context request = Right <$> runResolvedRecall model capability (resolveRecall (memoryContextSpace context) request) {-# DEPRECATED legacyRecall "Use recall with a RecallQuery. ScopeGlobal in a RecallRequest means namespace-wide, which is legacyRecallTarget's mapping; the exact global bucket is ExactScope (ScopeGlobal ns)." #-}@@ -384,7 +405,7 @@ pure (Left (RecallSpaceMismatch req.memorySpaceId authorized)) | req.maxResults <= 0 = pure (Right []) | otherwise =- recall+ recallWithEmbeddingAdapter model capability context
+ test/Kioku/AIRuntimeSpec.hs view
@@ -0,0 +1,203 @@+module Kioku.AIRuntimeSpec (tests) where++import Baikai.Api (Api (..))+import Baikai.Content (AssistantContent (..), emptyTextContent)+import Baikai.Interactive qualified as I+import Baikai.Model qualified as M+import Baikai.Options qualified as O+import Baikai.Provider.Registry qualified as R+import Baikai.Response (emptyResponse)+import Control.Concurrent (forkIO, newEmptyMVar, putMVar, takeMVar)+import Control.Exception (IOException, try)+import Control.Lens ((&), (.~))+import Data.Aeson qualified as A+import Data.Aeson.KeyMap qualified as KM+import Data.Aeson.Types (parseEither)+import Data.ByteString.Lazy qualified as LBS+import Data.Generics.Labels ()+import Data.IORef+import Data.Map.Strict qualified as Map+import Data.Text qualified as T+import Data.Text.Encoding (encodeUtf8)+import Data.Vector qualified as V+import Kioku.AI.Config+import Kioku.AI.File (loadAIRuntime, parseAIConfig)+import Kioku.AI.Runtime+import Kioku.Distill.Consolidate+import Kioku.Distill.Extract+import Kioku.Distill.Persona+import Kioku.Distill.Runtime+import Kioku.Distill.Scene+import Shikumi.Schema.Types (field)+import System.Exit (ExitCode (..))+import System.IO (hClose)+import System.IO.Temp (withSystemTempFile)+import System.Posix.Files (createSymbolicLink)+import Test.Tasty+import Test.Tasty.HUnit++tests :: TestTree+tests =+ testGroup+ "AI runtime"+ [ testCase "versioned configuration rejects unknown modes and features" $ do+ mapM_+ ( \raw -> case A.eitherDecodeStrict raw >>= parseEither parseAIConfig of+ Left _ -> pure ()+ Right _ -> assertFailure "accepted invalid configuration"+ )+ [ "{\"version\":2}",+ "{\"version\":1,\"permissions\":[\"automatic\"]}",+ "{\"version\":1,\"features\":{\"unknown\":{\"mode\":\"disabled\"}}}",+ "{\"version\":1,\"distillation\":{\"mode\":\"api\"}}"+ ],+ testCase "file assembler authorizes Responses only with API permission" $+ withSystemTempFile "kioku-responses.json" $ \path handle -> do+ hClose handle+ let config permissions =+ A.object+ [ "version" A..= (1 :: Int),+ "permissions" A..= (permissions :: [T.Text]),+ "distillation"+ A..= A.object+ [ "mode" A..= ("api" :: T.Text),+ "api" A..= ("openai-responses" :: T.Text),+ "provider" A..= ("openai" :: T.Text),+ "model" A..= ("fixture-model" :: T.Text),+ "baseUrl" A..= ("https://example.invalid/v1" :: T.Text)+ ]+ ]+ LBS.writeFile path (A.encode (config ["api"]))+ rt <- loadAIRuntime False (Just path)+ executionAvailability rt Extraction @?= Right ()+ LBS.writeFile path (A.encode (config []))+ refused <- try @IOException (loadAIRuntime False (Just path))+ case refused of+ Left _ -> pure ()+ Right _ -> assertFailure "Responses was authorized without API permission",+ testCase "disabled construction and all features make no calls" $ do+ rt <- expect =<< newAIRuntime noHostCapabilities disabledAIConfig+ mapM_ (\f -> executionAvailability rt f @?= Left (AIDisabled f)) [minBound .. maxBound]+ result <- runExtraction (newDistillRuntime rt Nothing) input+ result @?= Left (AIDisabled Extraction),+ testCase "overrides cannot grant API authority" $ do+ result <- newAIRuntime noHostCapabilities {allowInteractive = True} completionConfig+ case result of Left _ -> pure (); Right _ -> assertFailure "API was permitted",+ testCase "transport aliases cannot disguise batch as API" $ do+ registry <- R.newProviderRegistry+ let cfg = disabledAIConfig {distillationDefault = CompletionConfig API ((M.mkModel (Custom "anthropic-messages-cli") "m" "")) O.emptyOptions}+ result <- newAIRuntime noHostCapabilities {apiRegistry = Just registry} cfg+ case result of Left _ -> pure (); Right _ -> assertFailure "batch was permitted",+ testCase "concurrent host registries and model/options remain isolated" $ do+ left <- host "left"+ right <- host "right"+ l <- newEmptyMVar+ r <- newEmptyMVar+ _ <- forkIO (smoke left >>= putMVar l)+ _ <- forkIO (smoke right >>= putMVar r)+ takeMVar l >>= (@?= Right (RuntimeSmokeOutput (field "left")))+ takeMVar r >>= (@?= Right (RuntimeSmokeOutput (field "right"))),+ testCase "per-feature batch override uses only its authorized registry and options" testBatchOverride,+ testCase "interactive background ownership is deferred without a call" $ do+ rt <- expect =<< newAIRuntime noHostCapabilities {allowInteractive = True} interactiveConfig+ result <- runExtraction (newDistillRuntime rt Nothing) input+ result @?= Left (InteractiveUnavailable Extraction),+ testCase "real result file is decoded through extraction validation" $ do+ rt <- interactive (fixture Valid)+ result <- runExtraction (newDistillRuntime rt Nothing) input+ result @?= Right (ExtractOutput []),+ testCase "interactive handoff checks all remaining feature signatures" $ do+ ai <- interactive (fixture Valid)+ let rt = newDistillRuntime ai Nothing+ runSceneDistillation rt (SceneInput (field "fixture") (field "facts")) >>= (@?= Right (SceneOutput (field "Fixture") (field "Facts")))+ runPersonaDistillation rt (PersonaInput (field "fixture") (field "facts")) >>= (@?= Right (PersonaOutput (field "Facts")))+ let atom = ExtractedAtom (field "fact") (field "fixture") (field 100) (field "high")+ result <- runConsolidation rt (ConsolidateInput (field "fixture") atom [])+ result @?= Right (ConsolidationDecision StoreAtom [] Nothing (field "Fixture")),+ testCase "invalid result files never succeed" $+ mapM_+ ( \variant -> do+ rt <- interactive (fixture variant)+ result <- runExtraction (newDistillRuntime rt Nothing) input+ case result of Left _ -> pure (); Right _ -> assertFailure ("accepted " <> show variant)+ )+ [WrongId, Missing, BadDomain, Nonzero, Symlink, Oversized, Cancelled]+ ]++testBatchOverride :: IO ()+testBatchOverride = do+ let model name = M.mkModel (Custom "fixture") name ""+ handler name tokens = R.apiProviderWith (Custom "fixture") (\_ _ _ -> error "unexpected stream") $ \chosen _ opts -> do+ M.modelId chosen @?= name+ opts.maxTokens @?= Just tokens+ pure (emptyResponse & #message . #content .~ V.singleton (AssistantText (emptyTextContent & #text .~ ("[[ ## answer ## ]]\n" <> name <> "\n[[ ## completed ## ]]"))))+ api <- R.newProviderRegistryFrom [handler "api" 17]+ batch <- R.newProviderRegistryFrom [handler "batch" 23]+ let cfg =+ disabledAIConfig+ { distillationDefault = CompletionConfig API (model "api") (O.emptyOptions {O.maxTokens = Just 17}),+ featureOverrides = Map.singleton Persona (CompletionConfig Batch (model "batch") (O.emptyOptions {O.maxTokens = Just 23}))+ }+ ai <- expect =<< newAIRuntime noHostCapabilities {apiRegistry = Just api, batchRegistry = Just batch} cfg+ let rt = newDistillRuntime ai Nothing+ runDistillProgram rt Extraction runtimeSmokeProgram (RuntimeSmokeInput (field "fixture")) >>= (@?= Right (RuntimeSmokeOutput (field "api")))+ runDistillProgram rt Persona runtimeSmokeProgram (RuntimeSmokeInput (field "fixture")) >>= (@?= Right (RuntimeSmokeOutput (field "batch")))++expect :: (Show e) => Either e a -> IO a+expect = either (assertFailure . show) pure++input :: ExtractInput+input = ExtractInput (field "fixture") (field "test") (field "No durable facts.")++completionConfig :: AIConfig+completionConfig = disabledAIConfig {distillationDefault = CompletionConfig API model (O.emptyOptions {O.maxTokens = Just 17})}+ where+ model = (M.mkModel (Custom "fixture") "chosen" "") {M.provider = "fixture"}++host :: T.Text -> IO AIRuntime+host answer = do+ calls <- newIORef (0 :: Int)+ let handler = R.apiProviderWith (Custom "fixture") (\_ _ _ -> error "unexpected stream") $ \model _ opts -> do+ M.modelId model @?= "chosen"+ opts.maxTokens @?= Just 17+ modifyIORef' calls (+ 1)+ pure (emptyResponse & #message . #content .~ V.singleton (AssistantText (emptyTextContent & #text .~ ("[[ ## answer ## ]]\n" <> answer <> "\n[[ ## completed ## ]]"))))+ reg <- R.newProviderRegistryFrom [handler]+ rt <- expect =<< newAIRuntime noHostCapabilities {apiRegistry = Just reg} completionConfig+ readIORef calls >>= (@?= 0)+ R.registerApiProviderWith reg (handler {R.complete = \_ _ _ -> assertFailure "mutated host registry reached runtime"})+ pure rt++smoke :: AIRuntime -> IO (Either AIExecutionError RuntimeSmokeOutput)+smoke rt = runDistillProgram (newDistillRuntime rt Nothing) Extraction runtimeSmokeProgram (RuntimeSmokeInput (field "hello"))++interactiveConfig :: AIConfig+interactiveConfig = disabledAIConfig {distillationDefault = InteractiveConfig I.InteractiveClaude ((I.interactiveLaunchRequest "") {I.modelId = Just "fixture"})}++interactive launch = expect =<< newAIRuntime noHostCapabilities {allowInteractive = True, launchInteractive = Just launch} interactiveConfig++data Variant = Valid | WrongId | Missing | BadDomain | Nonzero | Symlink | Oversized | Cancelled deriving (Show)++fixture Cancelled feature _ = pure (Left (AIInteractiveFailed feature "cancelled"))+fixture variant feature req = do+ let raw = T.drop 1 (snd (T.breakOn "\n" req.userPrompt))+ value <- expect (A.eitherDecodeStrict (encodeUtf8 raw))+ case value of+ A.Object manifest -> do+ let lookupField key = maybe (error "missing manifest field") id (KM.lookup key manifest)+ output = case lookupField "outputFile" of A.String p -> T.unpack p; _ -> error "invalid outputFile"+ result = case variant of+ BadDomain -> A.object ["atoms" A..= [A.object ["atomType" A..= ("invalid" :: T.Text), "content" A..= ("x" :: T.Text), "priority" A..= (100 :: Int), "confidence" A..= ("high" :: T.Text)]]]+ _ -> case feature of+ Scene -> A.object ["title" A..= ("Fixture" :: T.Text), "bodyMd" A..= ("Facts" :: T.Text)]+ Persona -> A.object ["bodyMd" A..= ("Facts" :: T.Text)]+ Consolidation -> A.object ["action" A..= ("StoreAtom" :: T.Text), "targetMemoryIds" A..= ([] :: [T.Text]), "resultContent" A..= A.Null, "rationale" A..= ("Fixture" :: T.Text)]+ _ -> A.object ["atoms" A..= ([] :: [A.Value])]+ envelope = A.object ["requestId" A..= (case variant of WrongId -> A.String "stale"; _ -> lookupField "requestId"), "feature" A..= lookupField "feature", "result" A..= result]+ case variant of+ Missing -> pure ()+ Oversized -> LBS.writeFile output (LBS.replicate (1024 * 1024 + 1) 32)+ Symlink -> createSymbolicLink "request.json" output+ _ -> LBS.writeFile output (A.encode envelope)+ pure (Right (I.interactiveLaunchResult I.InteractiveClaude (case variant of Nonzero -> ExitFailure 1; _ -> ExitSuccess)))+ _ -> assertFailure "invalid manifest"
test/Kioku/DistillSpec.hs view
@@ -44,11 +44,11 @@ import Kioku.App (AppEnv, runAppIO, withNoopAppEnv) import Kioku.Distill.Consolidate (ConsolidateInput (..), ConsolidationAction (..), ConsolidationDecision (..), ExistingMemory (..), consolidateProgram) import Kioku.Distill.Extract (ExtractOutput (..), ExtractedAtom (..), extractProgram)-import Kioku.Distill.L1 (L1Error (..), L1Outcome (..), L1RunMode (..), L1Summary (..), distillSessionL1, recallCandidates, scopedScanCandidates)+import Kioku.Distill.L1 (L1Error (..), L1Outcome (..), L1RunMode (..), L1Summary (..), distillSessionL1, recallCandidatesWithEmbeddingAdapter, scopedScanCandidates) import Kioku.Distill.L2 (SceneRow (..), getScenesByScope, l2SceneProcessManagerName, regenerateScene, sceneMirrorPath) import Kioku.Distill.L3 (PersonaRow (..), getPersonaByScope, l3PersonaProcessManagerName, personaMirrorPath, regeneratePersona) import Kioku.Distill.Persona (personaProgram)-import Kioku.Distill.Runtime (DistillRuntime (..), newDistillRuntime)+import Kioku.Distill.Runtime (DistillRuntime, TestRunners (..), testDistillRuntime, withDistillWorkspace, withTestRunners) import Kioku.Distill.Scene (SceneInput (..), sceneProgram) import Kioku.Distill.Timer (idleFlushSeconds, l1ExtractProcessManagerName) import Kioku.Distill.Timer.Worker (runKiokuTimerWorkerOnce)@@ -1132,7 +1132,7 @@ testConsolidationFailure :: Assertion testConsolidationFailure = withDistillEnv \env -> do base <- replayRuntime- let runtime = base {runConsolidate = \_ -> pure (Left (ValidationFailure "boom"))}+ let runtime = withTestRunners base $ \r -> r {runConsolidate = \_ -> pure (Left (ValidationFailure "boom"))} sid <- genSessionId now <- getCurrentTime result <-@@ -1146,7 +1146,7 @@ Left storeErr -> assertFailure ("store error: " <> show storeErr) Right (distilled, memories, audits) -> do case distilled of- Left (L1ConsolidationFailed _) -> pure ()+ Left (L1ExecutionFailed _) -> pure () other -> assertFailure ("expected L1ConsolidationFailed, got " <> show other) memories @?= [] audits @?= 0@@ -1160,10 +1160,11 @@ ghostId <- genMemoryId let mergeResponse = mergeTargetsResponse [idText existingId, idText ghostId] runtime =- base- { runExtract = replayProgram singleAtomExtractResponse extractProgram,- runConsolidate = replayProgram mergeResponse consolidateProgram- }+ withTestRunners base $ \r ->+ r+ { runExtract = replayProgram singleAtomExtractResponse extractProgram,+ runConsolidate = replayProgram mergeResponse consolidateProgram+ } sid <- genSessionId now <- getCurrentTime result <-@@ -1202,7 +1203,7 @@ testWatermarkSkip = withDistillEnv \env -> do working <- replayRuntime let exploding =- working {runExtract = \_ -> pure (Left (ValidationFailure "extractor must not run"))}+ withTestRunners working $ \r -> r {runExtract = \_ -> pure (Left (ValidationFailure "extractor must not run"))} sid <- genSessionId now <- getCurrentTime result <-@@ -1221,7 +1222,7 @@ Right L1SkippedUpToDate -> pure () other -> assertFailure ("expected L1SkippedUpToDate, got " <> show other) case afterNewTurn of- Left (L1ExtractionFailed _) -> pure ()+ Left (L1ExecutionFailed _) -> pure () other -> assertFailure ("expected L1ExtractionFailed after a new turn, got " <> show other) -- | A watermark row is keyed by the globally unique session id, but reads are partitioned by@@ -1232,13 +1233,14 @@ working <- replayRuntime extractCalls <- newIORef (0 :: Int) let counted =- working- { runExtract = \input -> do- modifyIORef' extractCalls (+ 1)- working.runExtract input- }+ withTestRunners working $ \r ->+ r+ { runExtract = \input -> do+ modifyIORef' extractCalls (+ 1)+ r.runExtract input+ } exploding =- working {runExtract = \_ -> pure (Left (ValidationFailure "extractor must not run"))}+ withTestRunners working $ \r -> r {runExtract = \_ -> pure (Left (ValidationFailure "extractor must not run"))} divergentTurnIndex = 99 sid <- genSessionId now <- getCurrentTime@@ -1323,13 +1325,14 @@ scanScope = ScopeEntity (Namespace "rei") (ScopeKind "intention") "intention_scan_window" -- Merge only when the consolidator was actually shown the duplicate. runtimeFor duplicateId =- base- { runExtract = replayProgram singleAtomExtractResponse extractProgram,- runConsolidate = \input ->- if any (\existing -> unField existing.memoryId == idText duplicateId) input.existing- then replayProgram (mergeTargetsResponse [idText duplicateId]) consolidateProgram input- else replayProgram storeAtomResponse consolidateProgram input- }+ withTestRunners base $ \r ->+ r+ { runExtract = replayProgram singleAtomExtractResponse extractProgram,+ runConsolidate = \input ->+ if any (\existing -> unField existing.memoryId == idText duplicateId) input.existing+ then replayProgram (mergeTargetsResponse [idText duplicateId]) consolidateProgram input+ else replayProgram storeAtomResponse consolidateProgram input+ } -- Inject the capability rather than probing the cluster. This case is about the candidate -- finder -- that recall reaches a duplicate the priority scan window hides -- and nothing -- about vectors. Pinning it to the keyword plan is what makes dummyEmbeddingModel safe: it@@ -1345,7 +1348,7 @@ testContext RespectWatermark (runtimeFor recallDuplicateId)- (recallCandidates dummyEmbeddingModel capability 8)+ (recallCandidatesWithEmbeddingAdapter dummyEmbeddingModel capability 8) recallSid recallSummary <- liftIO (expectDistilled "recall pass" recallOutcome) recallMemories <- loadMemoryStatuses recallScope@@ -1383,7 +1386,7 @@ -- | The recall finder searches the session's own scope, not its whole namespace. -- -- A globally-scoped session used to draw merge candidates from every entity scope beside it,--- because 'recallCandidates' mapped the scope through @legacyRecallTarget@ and a global scope+-- because 'recallCandidatesWithEmbeddingAdapter' mapped the scope through @legacyRecallTarget@ and a global scope -- means /namespace-wide/ to recall. The consolidator could then merge an atom into a memory -- belonging to a sibling entity — rewriting content that feeds a scene the session has nothing to -- do with, and one that 'scopedScanCandidates' would never have offered.@@ -1404,19 +1407,20 @@ -- keep it out of the candidate set. siblingContent = "The user prefers concise answers." runtime =- base- { runExtract = replayProgram singleAtomExtractResponse extractProgram,- runConsolidate = \input ->- if any (\existing -> unField existing.memoryId == idText siblingId) input.existing- then replayProgram (mergeTargetsResponse [idText siblingId]) consolidateProgram input- else replayProgram storeAtomResponse consolidateProgram input- }+ withTestRunners base $ \r ->+ r+ { runExtract = replayProgram singleAtomExtractResponse extractProgram,+ runConsolidate = \input ->+ if any (\existing -> unField existing.memoryId == idText siblingId) input.existing+ then replayProgram (mergeTargetsResponse [idText siblingId]) consolidateProgram input+ else replayProgram storeAtomResponse consolidateProgram input+ } -- Keyword only, so dummyEmbeddingModel is never called. recallWith target = case Recall.mkRecallQuery target siblingContent Recall.Keyword 8 of Left err -> liftIO (assertFailure ("mkRecallQuery: " <> Text.unpack err)) Right request -> do- hits <- Recall.recall dummyEmbeddingModel VectorExtensionUnavailable testContext request+ hits <- Recall.recallWithEmbeddingAdapter dummyEmbeddingModel VectorExtensionUnavailable testContext request case hits of Left recallErr -> liftIO (assertFailure ("recall: " <> show recallErr)) Right found -> pure (fmap (\hit -> hit.memory.content) found)@@ -1431,7 +1435,7 @@ testContext RespectWatermark runtime- (recallCandidates dummyEmbeddingModel VectorExtensionUnavailable 8)+ (recallCandidatesWithEmbeddingAdapter dummyEmbeddingModel VectorExtensionUnavailable 8) sid summary <- liftIO (expectDistilled "global-scoped pass" outcome) siblingMemories <- loadMemoryStatuses siblingScope@@ -1622,14 +1626,15 @@ replayRuntime :: IO DistillRuntime replayRuntime = do- rt <- newDistillRuntime- pure- rt- { runExtract = replayProgram extractResponse extractProgram,- runConsolidate = \input -> replayProgram (consolidateResponse input) consolidateProgram input,- runScene = replayProgram sceneResponse sceneProgram,- runPersona = replayProgram personaResponse personaProgram- }+ rt <- testDistillRuntime+ pure $+ withTestRunners rt $ \r ->+ r+ { runExtract = replayProgram extractResponse extractProgram,+ runConsolidate = \input -> replayProgram (consolidateResponse input) consolidateProgram input,+ runScene = replayProgram sceneResponse sceneProgram,+ runPersona = replayProgram personaResponse personaProgram+ } -- | A replay runtime whose plaintext mirrors go to a private directory rather -- than the process's working directory. Any test that asserts on mirror files —@@ -1638,7 +1643,7 @@ replayRuntimeIn :: FilePath -> IO DistillRuntime replayRuntimeIn workspace = do rt <- replayRuntime- pure rt {workspaceRoot = Just workspace}+ pure (withDistillWorkspace workspace rt) -- | An 'AppEnv' plus the private workspace its mirrors are written into. withDistillWorkspaceEnv :: (AppEnv -> FilePath -> IO a) -> IO a@@ -1660,15 +1665,16 @@ countingRuntime :: DistillCalls -> DistillRuntime -> DistillRuntime countingRuntime calls rt =- rt- { runScene = \input -> do- modifyIORef' calls.sceneCalls (+ 1)- modifyIORef' calls.sceneAtoms (<> [unField input.atoms])- rt.runScene input,- runPersona = \input -> do- modifyIORef' calls.personaCalls (+ 1)- rt.runPersona input- }+ withTestRunners rt $ \r ->+ r+ { runScene = \input -> do+ modifyIORef' calls.sceneCalls (+ 1)+ modifyIORef' calls.sceneAtoms (<> [unField input.atoms])+ r.runScene input,+ runPersona = \input -> do+ modifyIORef' calls.personaCalls (+ 1)+ r.runPersona input+ } -- | 'countingRuntime', but the scene body echoes the atoms it was built from, so -- the mirror file's bytes on disk are a direct function of which memories@@ -1677,12 +1683,13 @@ -- settling for the row metadata. echoingRuntime :: DistillCalls -> DistillRuntime -> DistillRuntime echoingRuntime calls rt =- (countingRuntime calls rt)- { runScene = \input -> do- modifyIORef' calls.sceneCalls (+ 1)- modifyIORef' calls.sceneAtoms (<> [unField input.atoms])- replayProgram (echoSceneResponse (unField input.atoms)) sceneProgram input- }+ withTestRunners (countingRuntime calls rt) $ \r ->+ r+ { runScene = \input -> do+ modifyIORef' calls.sceneCalls (+ 1)+ modifyIORef' calls.sceneAtoms (<> [unField input.atoms])+ replayProgram (echoSceneResponse (unField input.atoms)) sceneProgram input+ } -- | Newlines are flattened because the response format is line-oriented: the -- atoms are a bulleted list, and each bullet would otherwise look like a field.
test/Kioku/EmbeddingWorkerSpec.hs view
@@ -6,6 +6,7 @@ where import Baikai.Embedding (EmbeddingModel)+import Baikai.Embedding qualified as Embedding import Data.Aeson qualified as Aeson import Data.Aeson.KeyMap qualified as KeyMap import Data.Functor.Contravariant ((>$<))@@ -79,6 +80,7 @@ testCase "provider failure acks retry" testProviderFailureRetries, testCase "undecodable payload acks dead-letter" testUndecodablePayloadDeadLetters, testCase "successful embedding acks ok and stores the vector" testSuccessStoresEmbedding,+ testCase "changing embedding model refuses before invoking the provider" testModelMismatchRefuses, testCase "dimension mismatch halts the processor" testDimensionMismatchHalts, testCase "a refused memory space acks dead-letter" testRefusedSpaceDeadLetters, testCase "an envelope naming another space acks dead-letter and writes nothing" testForgedSpaceDeadLetters,@@ -152,6 +154,20 @@ pure (decision, stored) decision @?= AckOk assertBool "the memory row has an embedding and a content hash" stored++testModelMismatchRefuses :: Assertion+testModelMismatchRefuses = withVectorEnv "model compatibility" $ \app capability -> do+ decision <- runOrFail app $ do+ (_, recorded) <- recordFixtureMemory testContext "first model's vector"+ let original = mkTestEnv (\_ -> pure (Right (Vector.replicate embeddingDims 0.1)))+ first <- embeddingHandler testContextProvider capability original (mkIngested recorded (Just 0))+ liftIO (first @?= AckOk)+ (_, second) <- recordFixtureMemory testContext "must not mix another model"+ let changed = original {model = testModel {Embedding.modelId = "different-model"}, embed = \_ -> assertFailure "incompatible embedding provider was called"}+ embeddingHandler testContextProvider capability changed (mkIngested second (Just 0))+ case decision of+ AckDeadLetter (InvalidPayload _) -> pure ()+ other -> assertFailure ("expected permanent model mismatch, got " <> show other) -- | The one case where halting is right. A dimension mismatch is a permanent, -- systemic store error: every subsequent event would fail identically, so
test/Kioku/MemorySpaceSpec.hs view
@@ -32,7 +32,7 @@ import Kioku.Api.Types (Confidence (..), MemoryType (..)) import Kioku.App (AppEffects, runAppIO, withNoopAppEnv) import Kioku.Distill.L1 (L1Error (..), L1RunMode (..), distillSessionL1, scopedScanCandidates)-import Kioku.Distill.Runtime (DistillRuntime (..), newDistillRuntime)+import Kioku.Distill.Runtime (DistillRuntime, TestRunners (..), testDistillRuntime, withDistillWorkspace, withTestRunners) import Kioku.Id (MemoryId, SessionId, genMemoryId, genSessionId, idText) import Kioku.Memory qualified as Memory import Kioku.Memory.Domain (ArchiveMemoryData (..), MemoryEvent (..), MemoryRecordedData (..), RecordMemoryData (..), SupersedeMemoryData (..))@@ -245,8 +245,8 @@ testContextWithoutDistill = withApp do sid <- startFixture testContext- runtime <- liftIO newDistillRuntime- let refuse = runtime {runExtract = \_ -> liftIO (assertFailure "the extractor must not run")}+ runtime <- liftIO testDistillRuntime+ let refuse = withTestRunners runtime $ \r -> r {runExtract = \_ -> liftIO (assertFailure "the extractor must not run")} result <- distillSessionL1 (narrowContext testSpace [MemoryRecord]) RespectWatermark refuse (scopedScanCandidates 5) sid liftIO case result of Left (L1NotPermitted MemoryDistill) -> pure ()@@ -272,8 +272,8 @@ assertL1RefusedBeforeExtraction granted expectedMissing = withApp do sid <- startFixture testContext- runtime <- liftIO newDistillRuntime- let refuse = runtime {runExtract = \_ -> liftIO (assertFailure "the extractor must not run")}+ runtime <- liftIO testDistillRuntime+ let refuse = withTestRunners runtime $ \r -> r {runExtract = \_ -> liftIO (assertFailure "the extractor must not run")} result <- distillSessionL1 (narrowContext testSpace granted) RespectWatermark refuse (scopedScanCandidates 5) sid liftIO case result of Left (L1NotPermitted actualMissing) ->
test/Kioku/RecallCompatSpec.hs view
@@ -38,7 +38,7 @@ RecallTarget (..), legacyRecall, mkRecallLimit,- recall,+ recallWithEmbeddingAdapter, ) import Kioku.Recall.Capability (VectorCapability (..)) import Kioku.SpaceFixtures (otherSpace, testContext, testSpace)@@ -138,7 +138,7 @@ runLegacy = legacyRecall undefinedModel VectorExtensionUnavailable testContext runExplicit :: (Store :> es, IOE :> es) => RecallQuery -> Eff es (Either RecallError [RecallHit])-runExplicit = recall undefinedModel VectorExtensionUnavailable testContext+runExplicit = recallWithEmbeddingAdapter undefinedModel VectorExtensionUnavailable testContext -- * Fixture
test/Kioku/RecallSqlSpec.hs view
@@ -494,7 +494,7 @@ ns1Exact = ExactScope ns1Entity ns1ExactGlobal = ExactScope ns1Global --- | A request resolved against the test space, the way 'Kioku.Recall.recall' resolves one. The+-- | A request resolved against the test space, the way 'Kioku.Recall.recallWithEmbeddingAdapter' resolves one. The -- candidate statements are reached only through 'resolveRecall', so a test cannot hand the SQL a -- statement family that the target mapping would never choose. request :: RecallTarget -> Text -> ResolvedRecall
test/Kioku/RecallTargetSpec.hs view
@@ -14,13 +14,13 @@ -- -- @embedding@ and @hybrid@ recall embed the query through -- 'Baikai.Embedding.EmbeddingModel', which is an HTTP endpoint; running them through--- 'Kioku.Recall.recall' would need a live embedding service. The target predicate lives in the+-- 'Kioku.Recall.recallWithEmbeddingAdapter' would need a live embedding service. The target predicate lives in the -- channels, not above them, so the matrix drives 'Kioku.Recall.selectFtsCandidates' and -- 'Kioku.Recall.selectVectorCandidates' directly and fuses their results with -- 'Kioku.Recall.fuseRecallCandidates' for the hybrid row — which is exactly what recall does with -- them. Fusion is pure and set-union-like, so it cannot introduce a row neither channel returned. ----- The keyword row is /also/ run through the public 'Kioku.Recall.recall', which needs no+-- The keyword row is /also/ run through the public 'Kioku.Recall.recallWithEmbeddingAdapter', which needs no -- embedding, so the whole entry point is proven for all three targets and not just the SQL under -- it. module Kioku.RecallTargetSpec (tests) where@@ -56,7 +56,7 @@ ftsCandidateSql, fuseRecallCandidates, mkRecallLimit,- recall,+ recallWithEmbeddingAdapter, resolveRecall, selectFtsCandidates, selectVectorCandidates,@@ -183,7 +183,7 @@ -- * The public entry point --- | The same three targets through 'Kioku.Recall.recall' itself, keyword-only so that no+-- | The same three targets through 'Kioku.Recall.recallWithEmbeddingAdapter' itself, keyword-only so that no -- embedding endpoint is involved. -- -- 'VectorExtensionUnavailable' makes the keyword plan a guarantee rather than a hope, which is@@ -213,7 +213,7 @@ Eff es (Either RecallError [Text]) runKeywordRecall context target = fmap (sort . fmap (\hit -> hit.memory.memoryId))- <$> recall+ <$> recallWithEmbeddingAdapter undefinedModel VectorExtensionUnavailable context
test/Kioku/SpaceIsolationSpec.hs view
@@ -279,7 +279,7 @@ -- from the context rather than from the request -- so there is no argument a caller could -- pass here that would reach the other space. hits <-- Recall.recall+ Recall.recallWithEmbeddingAdapter undefinedModel VectorExtensionUnavailable testContext
test/Kioku/TimerWorkerSpec.hs view
@@ -5,10 +5,18 @@ ) where +import Baikai.Interactive qualified as Interactive+import Control.Concurrent (threadDelay)+import Control.Concurrent.Async (cancel, concurrently, waitCatch, withAsync)+import Control.Concurrent.MVar import Data.Aeson qualified as Aeson+import Data.Aeson.KeyMap qualified as KM+import Data.ByteString.Lazy qualified as LBS import Data.Functor.Contravariant ((>$<))+import Data.IORef import Data.Int (Int64) import Data.Text qualified as Text+import Data.Text.Encoding (encodeUtf8) import Data.Time (NominalDiffTime, addUTCTime, diffUTCTime) import Data.UUID qualified as UUID import Data.UUID.V4 qualified as UUIDv4@@ -19,6 +27,9 @@ import Hasql.Statement (Statement, preparable) import Hasql.Transaction qualified as Tx import Keiro.Timer (TimerId (..), TimerRequest (..), scheduleTimerTx)+import Keiro.Timer qualified as Timer+import Kioku.AI.Config+import Kioku.AI.Runtime import Kioku.Api.Access ( MemoryAccessContext, MemoryAccessDenial (..),@@ -34,8 +45,10 @@ import Kioku.Distill.L1 (scopedScanCandidates) import Kioku.Distill.L2 (SceneTimerPayload (..), l2SceneProcessManagerName, l2SceneTimerId) import Kioku.Distill.L3 (partitionedCorrelationId)-import Kioku.Distill.Runtime (DistillRuntime (..), newDistillRuntime)+import Kioku.Distill.Runtime (DistillRuntime, TestRunners (..), newDistillRuntime, testDistillRuntime, withDistillWorkspace, withTestRunners) import Kioku.Distill.Timer (L1TimerPayload (..), l1ExtractProcessManagerName)+import Kioku.Distill.Timer.Deferred+import Kioku.Distill.Timer.Outcome (FireOutcome (..), timerMarkerEventId) import Kioku.Distill.Timer.Worker (drainKiokuTimers, runKiokuTimerWorkerOnce) import Kioku.Id (SessionId, genSessionId, idText) import Kioku.Migrations.TestSupport (withKiokuMigratedDatabase)@@ -50,6 +63,7 @@ import Kiroku.Store.Transaction (runTransaction) import Shibuya.Telemetry.Effect (Tracing) import Shikumi.Error (ShikumiError (..))+import System.Exit (ExitCode (..)) import Test.Tasty (TestTree, testGroup) import Test.Tasty.HUnit (Assertion, assertBool, assertFailure, testCase, (@?=)) @@ -57,7 +71,14 @@ tests = testGroup "Timer worker"- [ testCase "permanent failure dead-letters the timer" testPermanentFailureDeadLetters,+ [ testCase "deferred discovery recovers an expired foreground claim" testExpiredResume,+ testCase "ordinary dead letters and malformed payloads cannot resume" testNonDeferredRefusal,+ testCase "deferred resume preflights preserve attempts and recheck access" testResumePreflight,+ testCase "deferred resume has one concurrent winner" testConcurrentResume,+ testCase "deferred listing follows storage pages across denied entries" testDeferredListing,+ testCase "cancelled foreground resume re-parks the original timer" testCancelledResume,+ testCase "interactive unavailability stays parked across repeated worker runs" testInteractiveDeferred,+ testCase "permanent failure dead-letters the timer" testPermanentFailureDeadLetters, testCase "transient failure reschedules with backoff" testTransientFailureReschedules, testCase "a timer scheduled before memory spaces fires in the legacy space" testPrePartitionPayloadFiresInLegacySpace, testCase "a pre-partition timer cannot reach a session in another space" testPrePartitionPayloadCannotReachAnotherSpace,@@ -72,6 +93,33 @@ testCase "an explicit-space dead-letter names that exact space" testDeadLetterNamesTheSpace ] +testInteractiveDeferred :: Assertion+testInteractiveDeferred = withTimerEnv $ \env _ -> do+ ai <-+ expectRight "AI configuration"+ =<< newAIRuntime+ noHostCapabilities {allowInteractive = True}+ disabledAIConfig {distillationDefault = InteractiveConfig Interactive.InteractiveClaude ((Interactive.interactiveLaunchRequest "") {Interactive.modelId = Just "fixture"})}+ let rt = newDistillRuntime ai Nothing+ timerId <- freshTimerId+ sid <- genSessionId+ before <- runOrFail env $ do+ startFixtureSession sid+ scheduleTestTimer timerId l1ExtractProcessManagerName (idText sid) (l1Payload testSpace) (-1)+ fireOnce rt+ fetchTimer timerId+ before.status @?= "dead"+ before.attempts @?= 1+ assertBool "stable deferred prefix" (maybe False (Text.isPrefixOf "kioku:deferred:interactive-unavailable") before.lastError)+ -- New runAppIO scopes model successive worker polls/restarts against durable state.+ after <- runOrFail env $ do+ fireOnce rt+ fireOnce rt+ fetchTimer timerId+ after.status @?= "dead"+ after.attempts @?= before.attempts+ after.lastError @?= before.lastError+ -- | A correlation id that is not a session id can never become one. It used to -- be marked fired — a fake success that lost the distillation silently. testPermanentFailureDeadLetters :: Assertion@@ -95,7 +143,7 @@ withTimerEnv \env rt -> do timerId <- freshTimerId sid <- genSessionId- let failing = rt {runExtract = \_ -> pure (Left (ProviderFailure "the model is down"))}+ let failing = withTestRunners rt $ \r -> r {runExtract = \_ -> pure (Left (ProviderFailure "the model is down"))} before <- getCurrentTime row <- runOrFail env do startFixtureSession sid@@ -123,7 +171,7 @@ withTimerEnv \env rt -> do timerId <- freshTimerId sid <- genSessionId- let failing = rt {runExtract = \_ -> pure (Left (ProviderFailure "the model is down"))}+ let failing = withTestRunners rt $ \r -> r {runExtract = \_ -> pure (Left (ProviderFailure "the model is down"))} row <- runOrFail env do startFixtureSessionIn legacyContext legacyMemorySpaceId sid scheduleTestTimer timerId l1ExtractProcessManagerName (idText sid) prePartitionL1Payload (-1)@@ -142,7 +190,7 @@ withTimerEnv \env rt -> do timerId <- freshTimerId sid <- genSessionId- let failing = rt {runExtract = \_ -> liftIO (assertFailure "the extractor must not run")}+ let failing = withTestRunners rt $ \r -> r {runExtract = \_ -> liftIO (assertFailure "the extractor must not run")} row <- runOrFail env do startFixtureSession sid scheduleTestTimer timerId l1ExtractProcessManagerName (idText sid) prePartitionL1Payload (-1)@@ -526,7 +574,7 @@ withTimerEnv action = withKiokuMigratedDatabase \connStr -> withNoopAppEnv (defaultConnectionSettings connStr) \env -> do- rt <- newDistillRuntime+ rt <- testDistillRuntime action env rt runOrFail :: AppEnv -> Eff AppEffects a -> IO a@@ -536,3 +584,180 @@ expectRight label = \case Left err -> assertFailure (label <> " failed: " <> show err) Right value -> pure value++parkFixture :: AppEnv -> IO TimerId+parkFixture env = do+ tid <- freshTimerId+ sid <- genSessionId+ runOrFail env $ do+ startFixtureSession sid+ scheduleTestTimer tid l1ExtractProcessManagerName (idText sid) (l1Payload testSpace) (-1)+ void (Timer.deadLetterTimer tid "kioku:deferred:interactive-unavailable feature=extraction")+ pure tid++testResumePreflight :: Assertion+testResumePreflight = withTimerEnv $ \env rt -> do+ tid <- parkFixture env+ before <- runOrFail env (fetchTimer tid)+ denied <- runOrFail env (resumeDeferredTimer refusingContextProvider rt (scopedScanCandidates 5) tid)+ denied @?= DeferredAccessDenied (MemoryPermissionDenied testSpace MemoryDistill)+ wrong <- runOrFail env (resumeDeferredTimer wrongSpaceContextProvider rt (scopedScanCandidates 5) tid)+ wrong @?= denied+ disabled <- runOrFail env (resumeDeferredTimer testContextProvider (newDistillRuntime disabledAIRuntime Nothing) (scopedScanCandidates 5) tid)+ disabled @?= DeferredExecutionUnavailable (AIDisabled Extraction)+ unavailableAI <-+ expectRight "unavailable runtime"+ =<< newAIRuntime+ noHostCapabilities {allowInteractive = True}+ disabledAIConfig+ { distillationDefault =+ InteractiveConfig+ Interactive.InteractiveClaude+ ((Interactive.interactiveLaunchRequest "") {Interactive.modelId = Just "fixture"})+ }+ unavailable <- runOrFail env (resumeDeferredTimer testContextProvider (newDistillRuntime unavailableAI Nothing) (scopedScanCandidates 5) tid)+ unavailable @?= DeferredExecutionUnavailable (InteractiveUnavailable Extraction)+ after <- runOrFail env (fetchTimer tid)+ after @?= before+ runOrFail env (forceAttempts tid 8)+ capped <- runOrFail env (resumeDeferredTimer testContextProvider rt (scopedScanCandidates 5) tid)+ capped @?= DeferredClaimRefused++testConcurrentResume :: Assertion+testConcurrentResume = withTimerEnv $ \env _ -> do+ tid <- parkFixture env+ calls <- newIORef (0 :: Int)+ entered <- newEmptyMVar+ release <- newEmptyMVar+ ai <-+ expectRight "interactive runtime"+ =<< newAIRuntime+ noHostCapabilities+ { allowInteractive = True,+ launchInteractive =+ Just+ ( \_ request -> do+ modifyIORef' calls (+ 1)+ putMVar entered ()+ takeMVar release+ manifest <- expectRight "manifest" (Aeson.eitherDecodeStrict (encodeUtf8 (Text.drop 1 (snd (Text.breakOn "\n" request.userPrompt)))))+ case manifest of+ Aeson.Object object -> do+ let get key = fromMaybe (error "missing manifest key") (KM.lookup key object)+ output <- case get "outputFile" of+ Aeson.String path -> pure (Text.unpack path)+ _ -> fail "missing output file"+ LBS.writeFile+ output+ ( Aeson.encode+ ( Aeson.object+ [ "requestId" Aeson..= get "requestId",+ "feature" Aeson..= get "feature",+ "result" Aeson..= Aeson.object ["atoms" Aeson..= ([] :: [Aeson.Value])]+ ]+ )+ )+ _ -> fail "invalid manifest"+ pure (Right (Interactive.interactiveLaunchResult Interactive.InteractiveClaude ExitSuccess))+ )+ }+ disabledAIConfig+ { distillationDefault =+ InteractiveConfig+ Interactive.InteractiveClaude+ ((Interactive.interactiveLaunchRequest "") {Interactive.modelId = Just "fixture"})+ }+ let resume = runOrFail env (resumeDeferredTimer testContextProvider (newDistillRuntime ai Nothing) (scopedScanCandidates 5) tid)+ (winner, loser) <- concurrently resume (takeMVar entered >> resume <* putMVar release ())+ case winner of+ DeferredFinished (FireCompleted _) -> pure ()+ other -> assertFailure (show other)+ loser @?= DeferredNotEligible+ readIORef calls >>= (@?= 1)+ row <- runOrFail env (fetchTimer tid)+ row.status @?= "fired"+ row.attempts @?= 1+ again <- resume+ again @?= DeferredNotEligible++testCancelledResume :: Assertion+testCancelledResume = withTimerEnv $ \env rt -> do+ tid <- parkFixture env+ entered <- newEmptyMVar+ never <- newEmptyMVar+ let controlled = withTestRunners rt $ \r -> r {runExtract = \_ -> putMVar entered () >> takeMVar never}+ withAsync (runOrFail env (resumeDeferredTimer testContextProvider controlled (scopedScanCandidates 5) tid)) $ \running -> do+ takeMVar entered+ cancel running+ void (waitCatch running)+ row <- runOrFail env (fetchTimer tid)+ row.status @?= "dead"+ row.attempts @?= 1+ assertBool "reason preserved" (maybe False (Text.isPrefixOf "kioku:deferred:") row.lastError)++testDeferredListing :: Assertion+testDeferredListing = withTimerEnv $ \env _ -> do+ tid <- parkFixture env+ denied <- runOrFail env (listDeferredTimers refusingContextProvider (Timer.DeadTimerPageRequest 1 Nothing)) >>= expectRight "list"+ denied.entries @?= []+ allowed <- runOrFail env (listDeferredTimers testContextProvider (Timer.DeadTimerPageRequest 1 Nothing)) >>= expectRight "list"+ map (\entry -> entry.timer.timerId) allowed.entries @?= [tid]+ -- Include enough denied rows to put an allowed timer beyond an empty page.+ otherIds <- sequence [freshTimerId, freshTimerId]+ sid <- genSessionId+ runOrFail env $ forM_ otherIds $ \other -> do+ scheduleTestTimer other l1ExtractProcessManagerName (idText sid) (l1Payload otherSpace) (-1)+ void (Timer.deadLetterTimer other "kioku:deferred:interactive-unavailable feature=extraction")+ let onlyTest = MemoryContextProvider $ \space ->+ pure $+ if space == testSpace then Right testContext else Left (MemoryPermissionDenied space MemoryDistill)+ collect cursor = do+ page <- runOrFail env (listDeferredTimers onlyTest (Timer.DeadTimerPageRequest 1 cursor)) >>= expectRight "page"+ rest <- maybe (pure []) (collect . Just) page.nextAfterTimerId+ pure (map (\entry -> entry.timer.timerId) page.entries <> rest)+ collect Nothing >>= (@?= [tid])++testExpiredResume :: Assertion+testExpiredResume = withTimerEnv $ \env _ -> do+ tid <- parkFixture env+ claimed <-+ runOrFail+ env+ ( Timer.claimDeadTimer+ ( Timer.DeadTimerClaimRequest+ tid+ l1ExtractProcessManagerName+ "kioku:deferred:interactive-unavailable feature=extraction"+ 8+ 1+ )+ )+ >>= expectRight "claim"+ claim <- maybe (assertFailure "claim refused") pure claimed+ threadDelay 1200000+ page <- runOrFail env (listDeferredTimers testContextProvider (Timer.DeadTimerPageRequest 100 Nothing)) >>= expectRight "recover/list"+ map (\entry -> entry.timer.timerId) page.entries @?= [tid]+ stale <- runOrFail env (Timer.completeTimerResume claim (timerMarkerEventId tid))+ stale @?= False+ row <- runOrFail env (fetchTimer tid)+ row.status @?= "dead"+ row.attempts @?= 1++testNonDeferredRefusal :: Assertion+testNonDeferredRefusal = withTimerEnv $ \env rt -> do+ sid <- genSessionId+ forM_+ [ (l1ExtractProcessManagerName, l1Payload testSpace, "ordinary failure"),+ (l1ExtractProcessManagerName, Aeson.Null, "kioku:deferred:interactive-unavailable feature=extraction"),+ ("another-owner", l1Payload testSpace, "kioku:deferred:interactive-unavailable feature=extraction")+ ]+ $ \(owner, payload, reason) -> do+ tid <- freshTimerId+ runOrFail env $ do+ scheduleTestTimer tid owner (idText sid) payload (-1)+ void (Timer.deadLetterTimer tid reason)+ result <- runOrFail env (resumeDeferredTimer testContextProvider rt (scopedScanCandidates 5) tid)+ result @?= DeferredNotEligible+ row <- runOrFail env (fetchTimer tid)+ row.attempts @?= 0+ row.status @?= "dead"
test/Main.hs view
@@ -1,5 +1,6 @@ module Main where +import Kioku.AIRuntimeSpec qualified as AIRuntimeSpec import Kioku.AwaitingSpec qualified as AwaitingSpec import Kioku.CodecCompatSpec qualified as CodecCompatSpec import Kioku.DistillSpec qualified as DistillSpec@@ -26,7 +27,8 @@ defaultMain $ testGroup "kioku"- [ AwaitingSpec.tests,+ [ AIRuntimeSpec.tests,+ AwaitingSpec.tests, CodecCompatSpec.tests, IdempotencySpec.tests, MemorySpaceSpec.tests,