packages feed

kioku-cli (empty) → 0.1.0.0

raw patch · 16 files changed

+1332/−0 lines, 16 filesdep +asyncdep +basedep +containers

Dependencies added: async, base, containers, effectful, kioku-api, kioku-cli, kioku-core, kiroku-store, optparse-applicative, tasty, tasty-hunit, text, time

Files

+ CHANGELOG.md view
@@ -0,0 +1,24 @@+# Changelog++## 0.1.0.0 — 2026-07-14++### Added++- Added commands for memory and session demonstrations, hybrid recall, manual L1 distillation, L2+  scenes, L3 personas, and background workers.+- Added one-shot embedding backfill, timer processing, continuous worker supervision, startup+  backfill, and graceful worker draining.+- Added parser validation for session identifiers, scope references, mutually exclusive worker+  modes, and bounded result limits.++### Fixed++- Wired recall-based merge candidates into timer-driven distillation.+- Allowed colons in scope references while preserving namespace and kind boundaries.++### Changed++- `demo` and `demo-session` now require `--yes-write-events`, redact database credentials in their+  warning, and write only to the isolated `kioku_demo/demo/demo` scope.+- Session arguments now require the `kioku_session` prefix instead of silently rebranding other+  TypeID prefixes.
+ LICENSE view
@@ -0,0 +1,29 @@+BSD 3-Clause License++Copyright (c) 2026, Nadeem Bitar+All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++1. Redistributions of source code must retain the above copyright notice, this+   list of conditions and the following disclaimer.++2. Redistributions in binary form must reproduce the above copyright notice,+   this list of conditions and the following disclaimer in the documentation+   and/or other materials provided with the distribution.++3. Neither the name of the copyright holder nor the names of its+   contributors may be used to endorse or promote products derived from+   this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"+AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE+IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE+DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE+FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL+DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR+SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER+CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,+OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ app/Main.hs view
@@ -0,0 +1,6 @@+module Main where++import Kioku.Cli qualified++main :: IO ()+main = Kioku.Cli.main
+ kioku-cli.cabal view
@@ -0,0 +1,94 @@+cabal-version:   3.0+name:            kioku-cli+version:         0.1.0.0+synopsis:        kioku command-line interface+description:+  Command-line entry point for kioku demos and operational commands.++license:         BSD-3-Clause+license-file:    LICENSE+author:          Nadeem Bitar+maintainer:      nadeem@gmail.com+copyright:       2026 Nadeem Bitar+category:        Data+build-type:      Simple+tested-with:     GHC >=9.12 && <9.13+homepage:        https://github.com/shinzui/kioku+bug-reports:     https://github.com/shinzui/kioku/issues+extra-doc-files: CHANGELOG.md++source-repository head+  type:     git+  location: https://github.com/shinzui/kioku.git+  subdir:   kioku-cli++common warnings+  ghc-options:+    -Wall -Wcompat -Widentities -Wincomplete-record-updates+    -Wincomplete-uni-patterns -Wpartial-fields -Wredundant-constraints++common shared+  default-language:   GHC2024+  default-extensions:+    BlockArguments+    DeriveAnyClass+    DuplicateRecordFields+    MultilineStrings+    OverloadedLabels+    OverloadedRecordDot+    OverloadedStrings+    QualifiedDo+    TemplateHaskell++library+  import:          warnings, shared+  hs-source-dirs:  src+  exposed-modules:+    Kioku.Cli+    Kioku.Cli.Commands.Demo+    Kioku.Cli.Commands.DemoSession+    Kioku.Cli.Commands.Distill+    Kioku.Cli.Commands.Persona+    Kioku.Cli.Commands.Recall+    Kioku.Cli.Commands.Scenes+    Kioku.Cli.Commands.Worker+    Kioku.Cli.Options+    Kioku.Cli.Scope++  build-depends:+    , async                 >=2.2      && <2.3+    , base                  >=4.21     && <5+    , containers            >=0.6      && <0.8+    , effectful             >=2.5      && <2.7+    , kioku-api             ^>=0.1.0.0+    , kioku-core            ^>=0.1.0.0+    , kiroku-store          ^>=0.3.0.1+    , optparse-applicative  >=0.18     && <0.20+    , text                  >=2.1      && <2.2+    , time                  >=1.12     && <1.15++executable kioku+  import:         warnings, shared+  main-is:        Main.hs+  hs-source-dirs: app+  ghc-options:    -threaded -rtsopts -with-rtsopts=-N+  build-depends:+    , base       >=4.21     && <5+    , kioku-cli  ^>=0.1.0.0++test-suite kioku-cli-test+  import:         warnings, shared+  type:           exitcode-stdio-1.0+  main-is:        Main.hs+  hs-source-dirs: test+  other-modules:  Kioku.Cli.ParserSpec+  ghc-options:    -threaded -rtsopts -with-rtsopts=-N+  build-depends:+    , base                  >=4.21     && <5+    , kioku-api             ^>=0.1.0.0+    , kioku-cli             ^>=0.1.0.0+    , kioku-core            ^>=0.1.0.0+    , optparse-applicative  >=0.18+    , tasty                 >=1.5+    , tasty-hunit           >=0.10+    , text                  >=2.1
+ src/Kioku/Cli.hs view
@@ -0,0 +1,60 @@+module Kioku.Cli+  ( main,+  )+where++import Kioku.Cli.Commands.Demo (DemoOptions, demoOptionsParser, runDemo)+import Kioku.Cli.Commands.DemoSession (DemoSessionOptions, demoSessionOptionsParser, runDemoSession)+import Kioku.Cli.Commands.Distill (DistillOptions, distillOptionsParser, runDistill)+import Kioku.Cli.Commands.Persona (PersonaOptions, personaOptionsParser, runPersona)+import Kioku.Cli.Commands.Recall (RecallOptions, recallOptionsParser, runRecall)+import Kioku.Cli.Commands.Scenes (ScenesOptions, runScenes, scenesOptionsParser)+import Kioku.Cli.Commands.Worker (WorkerOptions, runWorker, workerOptionsParser)+import Options.Applicative++data Command = Demo DemoOptions | DemoSession DemoSessionOptions | Distill DistillOptions | Persona PersonaOptions | Recall RecallOptions | Scenes ScenesOptions | Worker WorkerOptions++main :: IO ()+main = run =<< execParser opts+  where+    opts =+      info+        (commandParser <**> helper)+        ( fullDesc+            <> progDesc "kioku reusable agent memory tools"+            <> header "kioku"+        )++commandParser :: Parser Command+commandParser =+  subparser $+    command+      "demo"+      (info (Demo <$> (helper <*> demoOptionsParser)) (progDesc "Run the memory/session demonstration (writes permanent events)"))+      <> command+        "demo-session"+        (info (DemoSession <$> (helper <*> demoSessionOptionsParser)) (progDesc "Run the session aggregate demonstration (writes permanent events)"))+      <> command+        "distill"+        (info (Distill <$> (helper <*> distillOptionsParser)) (progDesc "Run distillation commands"))+      <> command+        "persona"+        (info (Persona <$> (helper <*> personaOptionsParser)) (progDesc "Print distilled L3 persona"))+      <> command+        "recall"+        (info (Recall <$> (helper <*> recallOptionsParser)) (progDesc "Recall memories by query"))+      <> command+        "scenes"+        (info (Scenes <$> (helper <*> scenesOptionsParser)) (progDesc "Print distilled L2 scenes"))+      <> command+        "worker"+        (info (Worker <$> (helper <*> workerOptionsParser)) (progDesc "Run kioku background workers"))++run :: Command -> IO ()+run (Demo opts) = runDemo opts+run (DemoSession opts) = runDemoSession opts+run (Distill opts) = runDistill opts+run (Persona opts) = runPersona opts+run (Recall opts) = runRecall opts+run (Scenes opts) = runScenes opts+run (Worker opts) = runWorker opts
+ src/Kioku/Cli/Commands/Demo.hs view
@@ -0,0 +1,93 @@+module Kioku.Cli.Commands.Demo+  ( DemoOptions (..),+    demoOptionsParser,+    demoScope,+    runDemo,+  )+where++import Data.Set qualified as Set+import Data.Text qualified as Text+import Data.Time (getCurrentTime)+import Kioku.Api.Scope (MemoryScope (..), Namespace (..), ScopeKind (..))+import Kioku.Api.Types (Confidence (..), MemoryRecord (..), MemoryType (..))+import Kioku.App (runAppIO, withNoopAppEnv)+import Kioku.Cli.Options (redactConnectionString, yesWriteEventsFlag)+import Kioku.Id (genMemoryId, idText)+import Kioku.Memory qualified as Memory+import Kioku.Memory.Domain (RecordMemoryData (..))+import Kioku.Recall qualified as Recall+import Kiroku.Store.Connection (defaultConnectionSettings)+import Options.Applicative+import System.Environment (lookupEnv)++data DemoOptions = DemoOptions+  deriving stock (Eq, Show)++demoOptionsParser :: Parser DemoOptions+demoOptionsParser = DemoOptions <$ yesWriteEventsFlag++-- | The demo writes into a namespace nothing else reads.+--+-- It used to write into @rei:intention:intention_demo@ — the same namespace real Rei data+-- lives in — and those events are permanent, because kioku has no delete. They also fed the+-- distillation timers. A dedicated @kioku_demo@ namespace makes demo residue unmistakable and+-- keeps distillation of demo data confined to a namespace nothing else reads.+demoScope :: MemoryScope+demoScope = ScopeEntity (Namespace "kioku_demo") (ScopeKind "demo") "demo"++runDemo :: DemoOptions -> IO ()+runDemo DemoOptions = do+  connStr <- requireEnv "PG_CONNECTION_STRING"+  putStrLn "kioku demo appends permanent memory events (kioku has no delete)."+  putStrLn ("Target: " <> Text.unpack (redactConnectionString (Text.pack connStr)))+  putStrLn "Scope:  kioku_demo/demo/demo"+  withNoopAppEnv (defaultConnectionSettings (Text.pack connStr)) \env -> do+    mid <- genMemoryId+    now <- getCurrentTime+    let scope = demoScope+        payload =+          RecordMemoryData+            { memoryId = mid,+              agentId = "demo-agent",+              sessionId = Nothing,+              scope = scope,+              memoryType = MemoryPreference,+              content = "prefers concise answers",+              priority = 100,+              confidence = HighConfidence,+              tags = Set.fromList ["style"],+              supersedes = Nothing,+              recordedAt = now+            }+    result <- runAppIO env do+      writeResult <- Memory.record payload+      recallResult <- Recall.getActiveByScope scope+      pure (writeResult, recallResult)+    case result of+      Left storeErr -> ioError (userError ("kioku demo store error: " <> show storeErr))+      Right (Left writeErr, _) -> ioError (userError ("kioku demo write error: " <> show writeErr))+      Right (Right writtenId, Left recallErr) ->+        ioError (userError ("kioku demo recall error after writing " <> show writtenId <> ": " <> show recallErr))+      Right (Right writtenId, Right records) -> do+        putStrLn ("Recorded memory " <> Text.unpack (idText writtenId) <> " in scope kioku_demo/demo/demo")+        mapM_ printRecord records++requireEnv :: String -> IO String+requireEnv name = do+  found <- lookupEnv name+  case found of+    Just value -> pure value+    Nothing -> ioError (userError (name <> " is not set"))++printRecord :: MemoryRecord -> IO ()+printRecord record =+  putStrLn $+    "- "+      <> Text.unpack record.memoryId+      <> " ["+      <> Text.unpack record.memoryType+      <> "/"+      <> Text.unpack record.confidence+      <> "] "+      <> Text.unpack record.content
+ src/Kioku/Cli/Commands/DemoSession.hs view
@@ -0,0 +1,103 @@+module Kioku.Cli.Commands.DemoSession+  ( DemoSessionOptions (..),+    demoSessionOptionsParser,+    runDemoSession,+  )+where++import Data.Text qualified as Text+import Data.Time (getCurrentTime)+import Kioku.App (runAppIO, withNoopAppEnv)+import Kioku.Cli.Commands.Demo (demoScope)+import Kioku.Cli.Options (redactConnectionString, yesWriteEventsFlag)+import Kioku.Id (genSessionId, idText)+import Kioku.Session qualified as Session+import Kioku.Session.Domain (CompleteSessionData (..), RecordTurnData (..), StartSessionData (..))+import Kioku.Session.ReadModel (SessionRow (..), TurnRow (..))+import Kiroku.Store.Connection (defaultConnectionSettings)+import Options.Applicative+import System.Environment (lookupEnv)++data DemoSessionOptions = DemoSessionOptions+  deriving stock (Eq, Show)++demoSessionOptionsParser :: Parser DemoSessionOptions+demoSessionOptionsParser = DemoSessionOptions <$ yesWriteEventsFlag++runDemoSession :: DemoSessionOptions -> IO ()+runDemoSession DemoSessionOptions = do+  connStr <- requireEnv "PG_CONNECTION_STRING"+  putStrLn "kioku demo-session appends permanent session events (kioku has no delete)."+  putStrLn ("Target: " <> Text.unpack (redactConnectionString (Text.pack connStr)))+  putStrLn "Scope:  kioku_demo/demo/demo"+  putStrLn "Note:   completing this session schedules a distillation timer; a running worker will process it (an LLM call)."+  withNoopAppEnv (defaultConnectionSettings (Text.pack connStr)) \env -> do+    sid <- genSessionId+    now <- getCurrentTime+    let scope = demoScope+        startPayload =+          StartSessionData+            { sessionId = sid,+              agentId = "demo-agent",+              focus = "demo",+              scope = scope,+              subjectRef = Just "demo",+              previousSessionId = Nothing,+              parentSessionId = Nothing,+              delegationDepth = 0,+              startedAt = now+            }+        turnPayload =+          RecordTurnData+            { sessionId = sid,+              turnId = idText sid <> "-turn-1",+              turnIndex = 1,+              role = "user",+              content = "Please remember I prefer concise answers.",+              toolSummary = Nothing,+              promptTokens = Just 7,+              outputTokens = Nothing,+              recordedAt = now+            }+        completePayload =+          CompleteSessionData+            { sessionId = sid,+              completedAt = now,+              modelUsed = Just "demo-model",+              summary = Just "Demo session completed"+            }+    result <- runAppIO env do+      startResult <- Session.start startPayload+      turnResult <- Session.recordTurn turnPayload+      completeResult <- Session.complete completePayload+      rowResult <- Session.getById sid+      turnsResult <- Session.getTurns sid+      pure (startResult, turnResult, completeResult, rowResult, turnsResult)+    case result of+      Left storeErr -> ioError (userError ("kioku session demo store error: " <> show storeErr))+      Right (Left writeErr, _, _, _, _) -> ioError (userError ("kioku session demo start error: " <> show writeErr))+      Right (_, Left writeErr, _, _, _) -> ioError (userError ("kioku session demo turn error: " <> show writeErr))+      Right (_, _, Left writeErr, _, _) -> ioError (userError ("kioku session demo complete error: " <> show writeErr))+      Right (_, _, _, Left readErr, _) -> ioError (userError ("kioku session demo read error: " <> show readErr))+      Right (_, _, _, _, Left readErr) -> ioError (userError ("kioku session demo turns read error: " <> show readErr))+      Right (_, _, _, Right Nothing, Right _) -> ioError (userError "kioku session demo did not project the session row")+      Right (_, _, _, Right (Just row), Right turns) -> do+        putStrLn ("Recorded session " <> Text.unpack (idText sid) <> " with status " <> Text.unpack row.status)+        mapM_ printTurn turns++requireEnv :: String -> IO String+requireEnv name = do+  found <- lookupEnv name+  case found of+    Just value -> pure value+    Nothing -> ioError (userError (name <> " is not set"))++printTurn :: TurnRow -> IO ()+printTurn turn =+  putStrLn $+    "- turn "+      <> show turn.turnIndex+      <> " "+      <> Text.unpack turn.role+      <> ": "+      <> Text.unpack turn.content
+ src/Kioku/Cli/Commands/Distill.hs view
@@ -0,0 +1,131 @@+module Kioku.Cli.Commands.Distill+  ( CandidateSource (..),+    DistillOptions (..),+    distillOptionsParser,+    runDistill,+  )+where++import Data.Text qualified as Text+import Kioku.App (runAppIO, withNoopAppEnv)+import Kioku.Cli.Options (boundedIntReader)+import Kioku.Distill.L1 (L1Outcome (..), L1RunMode (..), L1Summary (..), distillSessionL1, recallCandidates, scopedScanCandidates)+import Kioku.Distill.Runtime (newDistillRuntime)+import Kioku.Id (SessionId, idText, parseId)+import Kioku.Memory.Embedding (EmbeddingConfig (..), resolveEmbeddingConfig, toEmbeddingModel)+import Kioku.Recall.Capability (detectVectorCapability)+import Kiroku.Store.Connection (defaultConnectionSettings)+import Options.Applicative+import System.Environment (lookupEnv)++data CandidateSource = CandidateScan | CandidateRecall+  deriving stock (Eq, Show)++data DistillOptions = DistillOptions+  { sessionId :: !SessionId,+    candidateSource :: !CandidateSource,+    candidateLimit :: !Int,+    force :: !Bool+  }+  deriving stock (Eq, Show)++distillOptionsParser :: Parser DistillOptions+distillOptionsParser =+  hsubparser $+    command+      "session"+      ( info+          sessionOptionsParser+          (progDesc "Run one L1 distillation pass for a session")+      )++sessionOptionsParser :: Parser DistillOptions+sessionOptionsParser =+  DistillOptions+    <$> argument+      (eitherReader parseSessionId)+      (metavar "SESSION_ID")+    <*> option+      (eitherReader parseCandidateSource)+      ( long "candidates"+          <> metavar "scan|recall"+          <> value CandidateScan+          <> help "Candidate lookup source"+      )+    <*> option+      (boundedIntReader "LIMIT" 1 50)+      ( long "limit"+          <> metavar "N"+          <> value 5+          <> help "Maximum merge candidates per extracted atom (1-50)"+      )+    <*> switch+      ( long "force"+          <> help "Re-run even when the session has no turns newer than the last successful pass"+      )++runDistill :: DistillOptions -> IO ()+runDistill opts = do+  connStr <- requireEnv "PG_CONNECTION_STRING"+  rt <- newDistillRuntime+  recallConfig <-+    case opts.candidateSource of+      CandidateScan -> pure Nothing+      CandidateRecall -> Just <$> resolveEmbeddingConfig+  withNoopAppEnv (defaultConnectionSettings (Text.pack connStr)) \env -> do+    result <- runAppIO env do+      finder <-+        case (opts.candidateSource, recallConfig) of+          (CandidateRecall, Just config) -> do+            capability <- detectVectorCapability config.dimensions+            pure (recallCandidates (toEmbeddingModel config) capability opts.candidateLimit)+          _ ->+            pure (scopedScanCandidates opts.candidateLimit)+      distillSessionL1 (runMode opts) rt finder opts.sessionId+    case result of+      Left storeErr -> ioError (userError ("kioku distill store error: " <> show storeErr))+      Right (Left l1Err) -> ioError (userError ("kioku distill error: " <> show l1Err))+      Right (Right (L1Distilled summary)) -> printSummary opts.sessionId summary+      Right (Right L1SkippedUpToDate) ->+        putStrLn "Session already distilled (no new turns); use --force to re-run."++runMode :: DistillOptions -> L1RunMode+runMode opts+  | opts.force = IgnoreWatermark+  | otherwise = RespectWatermark++-- | Strict: only a @kioku_session@ id is accepted here. The lenient parser this used to call+-- would take a @kioku_memory@ id, throw its prefix away, and rebrand the UUID — so the pass ran+-- against a session that does not exist and reported nothing wrong.+parseSessionId :: String -> Either String SessionId+parseSessionId raw =+  case parseId (Text.pack raw) of+    Left err -> Left (Text.unpack err)+    Right sid -> Right sid++parseCandidateSource :: String -> Either String CandidateSource+parseCandidateSource = \case+  "scan" -> Right CandidateScan+  "recall" -> Right CandidateRecall+  other -> Left ("unknown candidate source: " <> other)++printSummary :: SessionId -> L1Summary -> IO ()+printSummary sid summary =+  putStrLn $+    "Distilled session "+      <> Text.unpack (idText sid)+      <> ": extracted="+      <> show summary.extracted+      <> " stored="+      <> show summary.stored+      <> " merged="+      <> show summary.merged+      <> " skipped="+      <> show summary.skipped++requireEnv :: String -> IO String+requireEnv name = do+  found <- lookupEnv name+  case found of+    Just envValue -> pure envValue+    Nothing -> ioError (userError (name <> " is not set"))
+ src/Kioku/Cli/Commands/Persona.hs view
@@ -0,0 +1,51 @@+module Kioku.Cli.Commands.Persona+  ( PersonaOptions (..),+    personaOptionsParser,+    runPersona,+  )+where++import Data.Text qualified as Text+import Kioku.Api.Scope (MemoryScope)+import Kioku.App (runAppIO, withNoopAppEnv)+import Kioku.Cli.Scope (parseScope)+import Kioku.Distill.L3 (PersonaRow (..), getPersonaByScope)+import Kiroku.Store.Connection (defaultConnectionSettings)+import Options.Applicative+import System.Environment (lookupEnv)++newtype PersonaOptions = PersonaOptions+  { scope :: MemoryScope+  }+  deriving stock (Eq, Show)++personaOptionsParser :: Parser PersonaOptions+personaOptionsParser =+  PersonaOptions+    <$> option+      (eitherReader parseScope)+      ( long "scope"+          <> metavar "NAMESPACE[:KIND:REF]"+          <> help "Memory scope whose persona should be printed; REF may contain ':'"+      )++runPersona :: PersonaOptions -> IO ()+runPersona opts = do+  connStr <- requireEnv "PG_CONNECTION_STRING"+  withNoopAppEnv (defaultConnectionSettings (Text.pack connStr)) \env -> do+    result <- runAppIO env (getPersonaByScope opts.scope)+    case result of+      Left storeErr -> ioError (userError ("kioku persona store error: " <> show storeErr))+      Right Nothing -> putStrLn "(no persona yet)"+      Right (Just persona) -> printPersona persona++printPersona :: PersonaRow -> IO ()+printPersona row =+  putStrLn (Text.unpack row.bodyMd)++requireEnv :: String -> IO String+requireEnv name = do+  found <- lookupEnv name+  case found of+    Just envValue -> pure envValue+    Nothing -> ioError (userError (name <> " is not set"))
+ src/Kioku/Cli/Commands/Recall.hs view
@@ -0,0 +1,121 @@+module Kioku.Cli.Commands.Recall+  ( RecallOptions (..),+    recallOptionsParser,+    runRecall,+  )+where++import Data.Text (Text)+import Data.Text qualified as Text+import Kioku.Api.Scope (MemoryScope)+import Kioku.Api.Types (MemoryRecord (..))+import Kioku.App (runAppIO, withNoopAppEnv)+import Kioku.Cli.Options (boundedIntReader)+import Kioku.Cli.Scope (parseScope)+import Kioku.Memory.Embedding (EmbeddingConfig (..), resolveEmbeddingConfig, toEmbeddingModel)+import Kioku.Recall (RecallHit (..), RecallRequest (..), RecallStrategy (..), recall)+import Kioku.Recall.Capability (detectVectorCapability)+import Kiroku.Store.Connection (defaultConnectionSettings)+import Options.Applicative+import System.Environment (lookupEnv)+import Text.Printf (printf)++data RecallOptions = RecallOptions+  { query :: !Text,+    scope :: !MemoryScope,+    strategy :: !RecallStrategy,+    limit :: !Int,+    showScores :: !Bool+  }+  deriving stock (Eq, Show)++recallOptionsParser :: Parser RecallOptions+recallOptionsParser =+  RecallOptions+    <$> (Text.pack <$> argument str (metavar "QUERY"))+    <*> option+      (eitherReader parseScope)+      ( long "scope"+          <> metavar "NAMESPACE[:KIND:REF]"+          <> help "Memory scope to search; REF may contain ':'"+      )+    <*> option+      (eitherReader parseStrategy)+      ( long "strategy"+          <> metavar "keyword|embedding|hybrid"+          <> value Hybrid+          <> help "Recall strategy"+      )+    <*> option+      (boundedIntReader "LIMIT" 1 100)+      ( long "limit"+          <> metavar "N"+          <> value 8+          <> help "Maximum hits to return (1-100)"+      )+    <*> switch+      ( long "show-scores"+          <> help "Print fused scores and component ranks"+      )++runRecall :: RecallOptions -> IO ()+runRecall opts = do+  connStr <- requireEnv "PG_CONNECTION_STRING"+  config <- resolveEmbeddingConfig+  withNoopAppEnv (defaultConnectionSettings (Text.pack connStr)) \env -> do+    let model = toEmbeddingModel config+        request =+          RecallRequest+            { scope = opts.scope,+              query = opts.query,+              strategy = opts.strategy,+              maxResults = opts.limit+            }+    result <- runAppIO env do+      capability <- detectVectorCapability config.dimensions+      recall model capability request+    case result of+      Left storeErr -> ioError (userError ("kioku recall store error: " <> show storeErr))+      Right [] -> putStrLn "(no matches)"+      Right hits -> mapM_ (printHit opts.showScores) (zip [(1 :: Int) ..] hits)++parseStrategy :: String -> Either String RecallStrategy+parseStrategy = \case+  "keyword" -> Right Keyword+  "embedding" -> Right Embedding+  "hybrid" -> Right Hybrid+  other -> Left ("unknown strategy: " <> other)++printHit :: Bool -> (Int, RecallHit) -> IO ()+printHit showScores (index, hit)+  | showScores =+      putStrLn $+        show index+          <> ". score="+          <> printf "%.4f" hit.score+          <> " fts="+          <> rankText hit.ftsRank+          <> " vec="+          <> rankText hit.vecRank+          <> " "+          <> Text.unpack hit.memory.memoryType+          <> " "+          <> show (Text.unpack hit.memory.content)+  | otherwise =+      putStrLn $+        show index+          <> ". "+          <> Text.unpack hit.memory.memoryType+          <> " "+          <> show (Text.unpack hit.memory.content)++rankText :: Maybe Int -> String+rankText Nothing = "-"+rankText (Just rank) = show rank++requireEnv :: String -> IO String+requireEnv name = do+  found <- lookupEnv name+  case found of+    Just envValue -> pure envValue+    Nothing -> ioError (userError (name <> " is not set"))
+ src/Kioku/Cli/Commands/Scenes.hs view
@@ -0,0 +1,53 @@+module Kioku.Cli.Commands.Scenes+  ( ScenesOptions (..),+    runScenes,+    scenesOptionsParser,+  )+where++import Data.Text qualified as Text+import Kioku.Api.Scope (MemoryScope)+import Kioku.App (runAppIO, withNoopAppEnv)+import Kioku.Cli.Scope (parseScope)+import Kioku.Distill.L2 (SceneRow (..), getScenesByScope)+import Kiroku.Store.Connection (defaultConnectionSettings)+import Options.Applicative+import System.Environment (lookupEnv)++newtype ScenesOptions = ScenesOptions+  { scope :: MemoryScope+  }+  deriving stock (Eq, Show)++scenesOptionsParser :: Parser ScenesOptions+scenesOptionsParser =+  ScenesOptions+    <$> option+      (eitherReader parseScope)+      ( long "scope"+          <> metavar "NAMESPACE[:KIND:REF]"+          <> help "Memory scope whose scenes should be printed; REF may contain ':'"+      )++runScenes :: ScenesOptions -> IO ()+runScenes opts = do+  connStr <- requireEnv "PG_CONNECTION_STRING"+  withNoopAppEnv (defaultConnectionSettings (Text.pack connStr)) \env -> do+    result <- runAppIO env (getScenesByScope opts.scope)+    case result of+      Left storeErr -> ioError (userError ("kioku scenes store error: " <> show storeErr))+      Right [] -> putStrLn "(no scenes)"+      Right scenes -> mapM_ printScene scenes++printScene :: SceneRow -> IO ()+printScene row = do+  putStrLn ("# " <> Text.unpack row.title)+  putStrLn ""+  putStrLn (Text.unpack row.bodyMd)++requireEnv :: String -> IO String+requireEnv name = do+  found <- lookupEnv name+  case found of+    Just envValue -> pure envValue+    Nothing -> ioError (userError (name <> " is not set"))
+ src/Kioku/Cli/Commands/Worker.hs view
@@ -0,0 +1,237 @@+module Kioku.Cli.Commands.Worker+  ( WorkerOptions (..),+    workerOptionsParser,+    runWorker,+  )+where++import Control.Concurrent (threadDelay)+import Control.Concurrent.Async (race)+import Control.Exception (SomeException, displayException, try)+import Data.Text qualified as Text+import Data.Time (getCurrentTime)+import Effectful (IOE, (:>))+import Kioku.App (AppEnv, runAppIO, withNoopAppEnv)+import Kioku.Distill.L1 (FindMergeCandidates, recallCandidates)+import Kioku.Distill.Runtime (newDistillRuntime)+import Kioku.Distill.Timer.Worker (drainKiokuTimers, runKiokuTimerWorkerOnce)+import Kioku.Memory.Embedding (EmbeddingConfig (..), resolveEmbeddingConfig, toEmbeddingModel)+import Kioku.Memory.Embedding.Worker (backfillMissingEmbeddings, runEmbeddingWorkerHost)+import Kioku.Recall.Capability (VectorCapability (..), detectVectorCapability)+import Kiroku.Store.Connection (KirokuStore, defaultConnectionSettings, withStore)+import Kiroku.Store.Effect (Store)+import Options.Applicative+import System.Environment (lookupEnv)+import System.Exit (ExitCode (..), exitWith)+import System.IO (hPutStrLn, stderr)++-- | The two one-shot modes are unrelated — an embedding backfill and firing one distillation+-- timer — so there is no combined meaning to define. As two 'switch'es they were silently+-- ordered: @--backfill --timers-once@ checked @timersOnce@ first and ignored @--backfill@+-- without a word. As a sum parsed from mutually exclusive alternatives, passing both is a+-- parse error.+data WorkerOptions+  = WorkerContinuous+  | WorkerBackfill+  | WorkerTimersOnce+  deriving stock (Eq, Show)++workerOptionsParser :: Parser WorkerOptions+workerOptionsParser =+  flag'+    WorkerBackfill+    ( long "backfill"+        <> help "Run one embedding backfill pass and exit (conflicts with --timers-once)"+    )+    <|> flag'+      WorkerTimersOnce+      ( long "timers-once"+          <> help "Claim and fire at most one due kioku distillation timer, then exit (conflicts with --backfill)"+      )+    <|> pure WorkerContinuous++runWorker :: WorkerOptions -> IO ()+runWorker opts = do+  connStr <- requireEnv "PG_CONNECTION_STRING"+  config <- resolveEmbeddingConfig+  let settings = defaultConnectionSettings (Text.pack connStr)+  withStore settings $ \st ->+    withNoopAppEnv settings \env ->+      case opts of+        WorkerTimersOnce -> runTimerOnce env config+        WorkerBackfill -> withCapability env config \capability ->+          runBackfill env capability config+        WorkerContinuous -> withCapability env config \capability ->+          runContinuousWorker env st capability config++withCapability :: AppEnv -> EmbeddingConfig -> (VectorCapability -> IO a) -> IO a+withCapability env config k = do+  result <- runAppIO env (detectVectorCapability config.dimensions)+  case result of+    Left storeErr -> ioError (userError ("kioku worker store error: " <> show storeErr))+    Right capability -> k capability++-- | Merge candidates come from hybrid recall over the atom's own text, not from+-- a priority-ordered scan prefix: a duplicate ranked below the scan window was+-- invisible to the consolidator and got re-stored forever. Recall degrades to+-- FTS-only without pgvector and to keyword-only when the embedding call fails,+-- so no capability gating is needed here.+mergeCandidateFinder ::+  (IOE :> es, Store :> es) =>+  EmbeddingConfig ->+  VectorCapability ->+  FindMergeCandidates es+mergeCandidateFinder config capability =+  recallCandidates (toEmbeddingModel config) capability mergeCandidateLimit++mergeCandidateLimit :: Int+mergeCandidateLimit = 8++runBackfill :: AppEnv -> VectorCapability -> EmbeddingConfig -> IO ()+runBackfill env capability config = do+  -- Refuse before any event is touched: a backfill under a mismatched dimension count would+  -- embed every memory in the store and fail the ::vector cast on every single one.+  case capability of+    VectorDimensionMismatch configured actual ->+      dieWorker (dimensionMismatchMessage configured actual)+    _ -> pure ()+  let model = toEmbeddingModel config+  result <- runAppIO env (backfillMissingEmbeddings capability model config.dimensions)+  case result of+    Left storeErr -> ioError (userError ("kioku worker backfill store error: " <> show storeErr))+    Right count -> putStrLn ("Backfilled " <> show count <> " memory embeddings.")++-- | Run both pipelines under supervision.+--+-- The timer loop used to run on a bare 'forkIO', which produced two silent+-- deaths. A store error aborted the loop's single error scope and killed only+-- the forked thread, leaving a process that looked alive while all distillation+-- had stopped. In the other direction, an embedding halt made shibuya exit its+-- processor gracefully, 'waitApp' return, and the whole process exit 0 — taking+-- the timer loop with it.+--+-- 'race' makes both directions loud: whichever pipeline stops first ends the+-- race, and the process exits non-zero with a reason so a supervisor restarts+-- it. Neither side is expected to return at all.+runContinuousWorker :: AppEnv -> KirokuStore -> VectorCapability -> EmbeddingConfig -> IO ()+runContinuousWorker env store capability config = do+  let model = toEmbeddingModel config+  case capability of+    VectorAvailable -> do+      startupBackfill env capability config+      outcome <-+        try @SomeException $+          race+            (runTimerLoop env capability config)+            (runAppIO env (runEmbeddingWorkerHost store capability model config.dimensions))+      case outcome of+        -- A halted processor can tear its own machinery down hard enough to+        -- surface as an exception rather than a clean return (shibuya's halt path+        -- can leave a thread blocked in STM). Either way the pipeline is gone;+        -- what matters is that the operator gets a reason and a non-zero exit+        -- instead of a process that looks alive.+        Left err ->+          dieWorker ("worker pipeline crashed: " <> displayException err)+        Right (Left ()) ->+          dieWorker "timer loop stopped unexpectedly"+        Right (Right (Left storeErr)) ->+          dieWorker ("embedding worker stopped with store error: " <> show storeErr)+        Right (Right (Right ())) ->+          -- The handler already printed the halt reason at decision time.+          dieWorker "embedding worker stopped (processor halted or subscription ended)"+    VectorExtensionUnavailable -> do+      putStrLn "pgvector is not available; recall will run FTS-only; running kioku timer worker only."+      runTimerLoop env capability config+    VectorColumnsUnavailable missing -> do+      putStrLn ("pgvector columns are missing (" <> Text.unpack (Text.intercalate ", " missing) <> "); running kioku timer worker only.")+      runTimerLoop env capability config+    -- Loud, but not fatal. Every embedding write would fail on the ::vector cast, so there+    -- is no point starting the embedding host — but distillation timers have nothing to do+    -- with embeddings, and killing the whole worker would stop them too.+    VectorDimensionMismatch configured actual -> do+      hPutStrLn stderr ("kioku worker: " <> dimensionMismatchMessage configured actual <> "; running kioku timer worker only.")+      runTimerLoop env capability config++-- | A dimension mismatch would otherwise be discovered one failed event at a time, forever.+dimensionMismatchMessage :: Int -> Int -> String+dimensionMismatchMessage configured actual =+  "embedding dimension mismatch: KIOKU_EMBEDDING_DIMENSIONS="+    <> show configured+    <> " but kiroku.kioku_memories.embedding is vector("+    <> show actual+    <> "); fix the env var or migrate the column"++-- | Recover embeddings lost to an outage that outlasted the retry window.+-- Idempotent, so it is safe on every start. A failure here is only a warning:+-- if the database is down, the loops' own retry and exit behavior is the honest+-- place for that to surface, not a special case at startup.+startupBackfill :: AppEnv -> VectorCapability -> EmbeddingConfig -> IO ()+startupBackfill env capability config = do+  result <- runAppIO env (backfillMissingEmbeddings capability (toEmbeddingModel config) config.dimensions)+  case result of+    Left storeErr ->+      hPutStrLn stderr ("kioku worker: startup backfill failed: " <> show storeErr)+    Right count ->+      putStrLn ("Startup backfill: embedded " <> show count <> " missing memory embeddings.")++dieWorker :: String -> IO ()+dieWorker msg = do+  hPutStrLn stderr ("kioku worker: " <> msg <> "; exiting")+  exitWith (ExitFailure 1)++runTimerOnce :: AppEnv -> EmbeddingConfig -> IO ()+runTimerOnce env config = do+  rt <- newDistillRuntime+  now <- getCurrentTime+  result <- runAppIO env do+    capability <- detectVectorCapability config.dimensions+    runKiokuTimerWorkerOnce Nothing rt (mergeCandidateFinder config capability) now+  case result of+    Left storeErr -> ioError (userError ("kioku timer worker store error: " <> show storeErr))+    Right Nothing -> putStrLn "No due kioku distillation timers."+    Right (Just _) -> putStrLn "Processed one due kioku distillation timer."++-- | Drain due timers, sleep, repeat — forever.+--+-- Each pass gets its own 'runAppIO', and therefore its own store-error scope.+-- That is the whole point: the old loop lived inside a single 'runAppIO', so the+-- first transient store error aborted the @forever@ and killed the loop. Here a+-- store error is logged and retried with capped exponential backoff (5s doubling+-- to 60s, reset on success), because a database outage should not require an+-- operator to restart anything — and restarting would not have helped.+--+-- This never returns normally, so 'race' seeing it finish genuinely means+-- something impossible happened. Non-store exceptions propagate to 'race', which+-- is equally loud.+runTimerLoop :: AppEnv -> VectorCapability -> EmbeddingConfig -> IO ()+runTimerLoop env capability config = do+  rt <- newDistillRuntime+  putStrLn "kioku timer worker started."+  let go failures = do+        result <- runAppIO env (drainKiokuTimers Nothing rt (mergeCandidateFinder config capability))+        case result of+          Left storeErr -> do+            hPutStrLn stderr ("kioku timer worker: store error (will retry): " <> show storeErr)+            threadDelay (storeErrorBackoffMicros failures)+            go (failures + 1)+          Right _processed -> do+            threadDelay defaultTimerPollMicros+            go 0+  go 0++-- | 5s doubling per consecutive failure, capped at 60s.+storeErrorBackoffMicros :: Int -> Int+storeErrorBackoffMicros failures =+  min (60 * 1000 * 1000) (5 * 1000 * 1000 * (2 ^ min 8 (max 0 failures)))++-- | With draining, the poll interval no longer caps throughput: a burst of due+-- timers is processed in one pass rather than one per interval.+defaultTimerPollMicros :: Int+defaultTimerPollMicros = 5 * 1000 * 1000++requireEnv :: String -> IO String+requireEnv name = do+  found <- lookupEnv name+  case found of+    Just envValue -> pure envValue+    Nothing -> ioError (userError (name <> " is not set"))
+ src/Kioku/Cli/Options.hs view
@@ -0,0 +1,66 @@+-- | Shared option readers and helpers for the kioku CLI.+module Kioku.Cli.Options+  ( boundedIntReader,+    yesWriteEventsFlag,+    redactConnectionString,+  )+where++import Data.Text (Text)+import Data.Text qualified as Text+import Options.Applicative++-- | An integer option reader that enforces an inclusive range at parse time.+--+-- @label@ names the value in the error message, e.g. @\"LIMIT\"@. Without this, @--limit -1@+-- travelled all the way to Postgres and came back as @LIMIT must not be negative@, and an+-- unbounded large value was a cost and latency footgun rather than a parse error.+boundedIntReader :: String -> Int -> Int -> ReadM Int+boundedIntReader label lo hi = do+  n <- auto+  if n >= lo && n <= hi+    then pure n+    else+      readerError+        (label <> " must be between " <> show lo <> " and " <> show hi <> " (got " <> show n <> ")")++-- | Required opt-in for a command that appends permanent events.+--+-- 'flag'' with no default, so omitting it is a parse error (@Missing: --yes-write-events@) and+-- the requirement is visible in @--help@. Deliberately not an environment variable: an+-- exported @KIOKU_ALLOW_DEMO=1@ is sticky state that outlives the moment of consent, which is+-- exactly how accidents happen in a long-lived shell.+yesWriteEventsFlag :: Parser ()+yesWriteEventsFlag =+  flag'+    ()+    ( long "yes-write-events"+        <> help+          "Required confirmation: this command appends PERMANENT events (kioku has no delete) to the database at PG_CONNECTION_STRING"+    )++-- | Best-effort password redaction for printing a libpq connection string.+--+-- Handles the keyword form (@password=...@) and the URI form (@user:pass\@host@). Best-effort+-- is the honest description: it exists so the preflight can show the operator which database+-- they are about to write to without echoing a secret into a terminal or a CI log.+redactConnectionString :: Text -> Text+redactConnectionString conn =+  case Text.stripPrefix "postgres://" conn of+    Just rest -> "postgres://" <> redactUserInfo rest+    Nothing ->+      case Text.stripPrefix "postgresql://" conn of+        Just rest -> "postgresql://" <> redactUserInfo rest+        Nothing -> Text.unwords (map redactPair (Text.words conn))+  where+    redactPair kv+      | "password=" `Text.isPrefixOf` kv = "password=REDACTED"+      | otherwise = kv++    redactUserInfo rest =+      case Text.breakOn "@" rest of+        (_, "") -> rest+        (userinfo, hostPart) ->+          case Text.breakOn ":" userinfo of+            (_, "") -> userinfo <> hostPart+            (user, _) -> user <> ":REDACTED" <> hostPart
+ src/Kioku/Cli/Scope.hs view
@@ -0,0 +1,43 @@+module Kioku.Cli.Scope+  ( parseScope,+    scopeGrammarError,+  )+where++import Data.Text qualified as Text+import Kioku.Api.Scope (MemoryScope (..), mkNamespace, mkScopeKind)++-- | @NAMESPACE@ or @NAMESPACE:KIND:REF@.+--+-- Only the first two colons split. Everything after the second colon is the ref, colons+-- included, so a URL or a @host:port@ pair is expressible: @ops:host:db.internal:5432@ has the+-- ref @db.internal:5432@. Splitting on /every/ colon (the old behavior) made those refs+-- unreachable from the CLI — they parsed as four segments and were rejected.+--+-- Namespace and kind still go through the validating constructors, so a @\/@ or @%@ that would+-- make the scope's derived identity ambiguous is rejected here rather than silently escaped+-- into a row id; a @:@ in either is now impossible by construction rather than by validation.+-- The ref is not validated beyond being non-empty: refs are host free text, and+-- 'Kioku.Distill.ScopeIdentity.escapeScopeComponent' escapes the colons they may now contain,+-- so a colon-bearing ref still gets a collision-free identity.+parseScope :: String -> Either String MemoryScope+parseScope raw =+  case Text.breakOn ":" (Text.pack raw) of+    (ns, afterNs)+      | Text.null afterNs -> ScopeGlobal <$> namespace ns+      | otherwise ->+          case Text.breakOn ":" (Text.drop 1 afterNs) of+            (kind, afterKind)+              | Text.null afterKind -> Left scopeGrammarError+              | ref <- Text.drop 1 afterKind ->+                  if Text.null ref+                    then Left "REF must not be empty"+                    else ScopeEntity <$> namespace ns <*> scopeKind kind <*> pure ref+  where+    namespace = first Text.unpack . mkNamespace+    scopeKind = first Text.unpack . mkScopeKind+    first f = either (Left . f) Right++scopeGrammarError :: String+scopeGrammarError =+  "expected NAMESPACE or NAMESPACE:KIND:REF (REF may contain ':'; NAMESPACE and KIND may not)"
+ test/Kioku/Cli/ParserSpec.hs view
@@ -0,0 +1,214 @@+-- | Pure tests for the CLI's parsing boundary: no database, no network, no environment.+--+-- optparse-applicative parsers are ordinary values, so 'execParserPure' exercises exactly what+-- an operator's argv hits — including the failure text they will read.+module Kioku.Cli.ParserSpec (tests) where++import Data.List (isInfixOf)+import Data.Text qualified as Text+import Kioku.Api.Scope (MemoryScope (..), Namespace (..), ScopeKind (..))+import Kioku.Cli.Commands.Demo (DemoOptions (..), demoOptionsParser, demoScope)+import Kioku.Cli.Commands.DemoSession (DemoSessionOptions (..), demoSessionOptionsParser)+import Kioku.Cli.Commands.Distill (DistillOptions (..), distillOptionsParser)+import Kioku.Cli.Commands.Recall (RecallOptions (..), recallOptionsParser)+import Kioku.Cli.Commands.Worker (WorkerOptions (..), workerOptionsParser)+import Kioku.Cli.Options (redactConnectionString)+import Kioku.Cli.Scope (parseScope)+import Kioku.Id (genMemoryId, genSessionId, idText)+import Options.Applicative+import Test.Tasty (TestTree, testGroup)+import Test.Tasty.HUnit (assertBool, testCase, (@?=))++tests :: TestTree+tests =+  testGroup+    "Kioku.Cli parsers"+    [ sessionIdTests,+      scopeTests,+      limitTests,+      demoGuardTests,+      redactionTests,+      workerModeTests+    ]++-- | Run a parser against an argument list, rendering a failure the way the real CLI would.+parseWith :: Parser a -> [String] -> Either String a+parseWith p args =+  case execParserPure defaultPrefs (info (p <**> helper) mempty) args of+    Success a -> Right a+    Failure failure -> Left (fst (renderFailure failure "kioku"))+    CompletionInvoked _ -> Left "unexpected completion"++sessionIdTests :: TestTree+sessionIdTests =+  testGroup+    "distill session id parsing is strict"+    [ testCase "a kioku_session id is accepted" do+        sid <- genSessionId+        case parseWith distillOptionsParser ["session", Text.unpack (idText sid)] of+          Left err -> assertBool ("expected success, got: " <> err) False+          Right opts -> opts.sessionId @?= sid,+      testCase "a kioku_memory id is rejected, naming both prefixes" do+        mid <- genMemoryId+        case parseWith distillOptionsParser ["session", Text.unpack (idText mid)] of+          Right _ ->+            assertBool "expected a memory id to be rejected where a session id is expected" False+          Left err -> do+            assertBool ("error should name the expected prefix: " <> err) ("kioku_session" `isInfixOf` err)+            assertBool ("error should name the received prefix: " <> err) ("kioku_memory" `isInfixOf` err),+      testCase "a bare uuid with no prefix is rejected" do+        case parseWith distillOptionsParser ["session", "01h455vb4pex5vsknk084sn02q"] of+          Right _ -> assertBool "expected a prefixless id to be rejected" False+          Left err -> assertBool ("error should name the expected prefix: " <> err) ("kioku_session" `isInfixOf` err)+    ]++-- | The ref is everything after the second colon, colons included; the namespace and kind are+-- not. Splitting on every colon used to make a URL or @host:port@ ref unreachable.+scopeTests :: TestTree+scopeTests =+  testGroup+    "scope grammar splits on the first two colons only"+    [ testCase "a bare namespace is the global scope" do+        parseScope "mori" @?= Right (ScopeGlobal (Namespace "mori")),+      testCase "a plain entity scope" do+        parseScope "rei:intention:intention_demo"+          @?= Right (ScopeEntity (Namespace "rei") (ScopeKind "intention") "intention_demo"),+      testCase "a ref may contain slashes" do+        parseScope "mori:repo:github.com/shinzui/kioku"+          @?= Right (ScopeEntity (Namespace "mori") (ScopeKind "repo") "github.com/shinzui/kioku"),+      testCase "a host:port ref keeps its colon" do+        parseScope "ops:host:db.internal:5432"+          @?= Right (ScopeEntity (Namespace "ops") (ScopeKind "host") "db.internal:5432"),+      testCase "a URL ref keeps every colon" do+        parseScope "rei:url:https://example.com:8080/x"+          @?= Right (ScopeEntity (Namespace "rei") (ScopeKind "url") "https://example.com:8080/x"),+      testCase "one colon is not an entity scope" do+        assertLeft "a:b" (parseScope "a:b"),+      testCase "an empty ref is rejected" do+        assertLeft "a:b:" (parseScope "a:b:"),+      testCase "an empty namespace is rejected" do+        assertLeft ":b:c" (parseScope ":b:c"),+      testCase "an empty kind is rejected" do+        assertLeft "a::c" (parseScope "a::c"),+      testCase "the empty string is rejected" do+        assertLeft "" (parseScope ""),+      -- The identity encoding gives these characters meaning; EP-5 (docs/plans/13) rejects+      -- them at the constructor, and the CLI must not route around that.+      testCase "a slash in the namespace is still rejected" do+        assertLeft "a/b:kind:ref" (parseScope "a/b:kind:ref")+    ]+  where+    assertLeft label = \case+      Left _ -> pure ()+      Right scope -> assertBool (label <> " should not parse, got: " <> show scope) False++-- | Out-of-range limits are a parse error, not a Postgres error (@--limit -1@ used to reach+-- SQL and come back as @LIMIT must not be negative@).+limitTests :: TestTree+limitTests =+  testGroup+    "--limit is bounded at the parser"+    [ testCase "recall rejects a negative limit, naming the range" do+        assertLimitError "between 1 and 100" (recallWith ["--limit", "-1"]),+      testCase "recall rejects zero" do+        assertLimitError "between 1 and 100" (recallWith ["--limit", "0"]),+      testCase "recall rejects one past the maximum" do+        assertLimitError "between 1 and 100" (recallWith ["--limit", "101"]),+      testCase "recall accepts both ends of the range" do+        fmap (.limit) (recallWith ["--limit", "1"]) @?= Right 1+        fmap (.limit) (recallWith ["--limit", "100"]) @?= Right 100,+      testCase "recall's default limit is unchanged" do+        fmap (.limit) (recallWith []) @?= Right 8,+      testCase "distill rejects one past its lower maximum" do+        sid <- genSessionId+        assertLimitError "between 1 and 50" (distillWith sid ["--limit", "51"]),+      testCase "distill accepts the top of its range" do+        sid <- genSessionId+        fmap (.candidateLimit) (distillWith sid ["--limit", "50"]) @?= Right 50,+      testCase "distill's default limit is unchanged" do+        sid <- genSessionId+        fmap (.candidateLimit) (distillWith sid []) @?= Right 5+    ]+  where+    recallWith extra =+      parseWith recallOptionsParser (["query", "--scope", "mori"] <> extra)++    distillWith sid extra =+      parseWith distillOptionsParser (["session", Text.unpack (idText sid)] <> extra)++    assertLimitError needle = \case+      Right _ -> assertBool ("expected a parse error mentioning " <> show needle) False+      Left err -> assertBool ("error should state the valid range: " <> err) (needle `isInfixOf` err)++-- | The demo commands append permanent events (kioku has no delete) to whatever+-- @PG_CONNECTION_STRING@ points at. Consent is a required flag, so a bare invocation dies in+-- the parser — before the environment is read and before anything is written.+demoGuardTests :: TestTree+demoGuardTests =+  testGroup+    "demo commands require --yes-write-events"+    [ testCase "bare `demo` does not parse" do+        assertMissingFlag (parseWith demoOptionsParser []),+      testCase "`demo --yes-write-events` parses" do+        parseWith demoOptionsParser ["--yes-write-events"] @?= Right DemoOptions,+      testCase "bare `demo-session` does not parse" do+        assertMissingFlag (parseWith demoSessionOptionsParser []),+      testCase "`demo-session --yes-write-events` parses" do+        parseWith demoSessionOptionsParser ["--yes-write-events"] @?= Right DemoSessionOptions,+      testCase "the demo writes into its own namespace, not rei" do+        demoScope @?= ScopeEntity (Namespace "kioku_demo") (ScopeKind "demo") "demo"+    ]+  where+    assertMissingFlag = \case+      Right _ -> assertBool "expected the demo command to refuse without --yes-write-events" False+      Left err ->+        assertBool+          ("failure should name the missing flag: " <> err)+          ("Missing: --yes-write-events" `isInfixOf` err)++-- | The preflight prints the target database. A password must not travel with it into a+-- terminal or a CI log.+redactionTests :: TestTree+redactionTests =+  testGroup+    "redactConnectionString"+    [ testCase "keyword form: the password is replaced" do+        let redacted = redactConnectionString "host=x dbname=y password=hunter2"+        assertBool "password should be redacted" ("password=REDACTED" `Text.isInfixOf` redacted)+        assertBool "the secret should not survive" (not ("hunter2" `Text.isInfixOf` redacted)),+      testCase "URI form: the userinfo password is replaced" do+        let redacted = redactConnectionString "postgres://me:hunter2@db:5432/kioku"+        assertBool+          ("host and user should survive: " <> Text.unpack redacted)+          ("me:REDACTED@db:5432" `Text.isInfixOf` redacted)+        assertBool "the secret should not survive" (not ("hunter2" `Text.isInfixOf` redacted)),+      testCase "a connection string with no password is unchanged" do+        redactConnectionString "host=x dbname=y user=me" @?= "host=x dbname=y user=me",+      testCase "a URI with no password is unchanged" do+        redactConnectionString "postgres://db:5432/kioku" @?= "postgres://db:5432/kioku"+    ]++-- | The two one-shot worker modes are unrelated, so passing both is a mistake. It used to be a+-- silent one: --timers-once was checked first and --backfill was ignored without a word.+workerModeTests :: TestTree+workerModeTests =+  testGroup+    "worker one-shot modes are mutually exclusive"+    [ testCase "no flags means the continuous worker" do+        parseWith workerOptionsParser [] @?= Right WorkerContinuous,+      testCase "--backfill" do+        parseWith workerOptionsParser ["--backfill"] @?= Right WorkerBackfill,+      testCase "--timers-once" do+        parseWith workerOptionsParser ["--timers-once"] @?= Right WorkerTimersOnce,+      testCase "both flags is a parse error" do+        assertConflict "--timers-once" (parseWith workerOptionsParser ["--backfill", "--timers-once"]),+      testCase "both flags in the other order is also a parse error" do+        assertConflict "--backfill" (parseWith workerOptionsParser ["--timers-once", "--backfill"])+    ]+  where+    assertConflict rejected = \case+      Right mode -> assertBool ("expected a conflict error, got: " <> show mode) False+      Left err ->+        assertBool+          ("failure should name the conflicting flag " <> rejected <> ": " <> err)+          (rejected `isInfixOf` err)
+ test/Main.hs view
@@ -0,0 +1,7 @@+module Main where++import Kioku.Cli.ParserSpec qualified as ParserSpec+import Test.Tasty (defaultMain)++main :: IO ()+main = defaultMain ParserSpec.tests