never executed always true always false
1 module PureClaw.CLI.Commands
2 ( -- * Entry point
3 runCLI
4 -- * Command types (exported for testing)
5 , Command (..)
6 , ChatOptions (..)
7 , chatOptionsParser
8 -- * Enums (exported for testing)
9 , ProviderType (..)
10 , MemoryBackend (..)
11 -- * Policy (exported for testing)
12 , buildPolicy
13 ) where
14
15 import Control.Exception (IOException, bracket_, try)
16 import Data.ByteString (ByteString)
17 import Data.IORef
18 import Data.Maybe
19 import Data.Set qualified as Set
20 import Data.Text qualified as T
21 import Data.Text.Encoding qualified as TE
22 import Data.Time.Clock (getCurrentTime)
23 import Network.HTTP.Client qualified as HTTP
24 import Network.HTTP.Client.TLS qualified as HTTP
25 import Options.Applicative
26 import System.Directory (doesFileExist)
27
28 import System.IO
29 import System.Process.Typed qualified as P
30
31 import PureClaw.Auth.AnthropicOAuth
32 import PureClaw.CLI.Config
33
34 import PureClaw.Agent.Env
35 import PureClaw.Agent.Identity
36 import PureClaw.Agent.Loop
37 import PureClaw.Channels.CLI
38 import PureClaw.Channels.Signal
39 import PureClaw.Channels.Signal.Transport
40 import PureClaw.Core.Types
41 import PureClaw.Handles.Channel
42 import PureClaw.Handles.File
43 import PureClaw.Handles.Log
44 import PureClaw.Handles.Memory
45 import PureClaw.Handles.Network
46 import PureClaw.Handles.Shell
47 import PureClaw.Memory.Markdown
48 import PureClaw.Memory.SQLite
49 import PureClaw.Providers.Anthropic
50 import PureClaw.Providers.Class
51 import PureClaw.Providers.Ollama
52 import PureClaw.Providers.OpenAI
53 import PureClaw.Providers.OpenRouter
54 import PureClaw.Security.Policy
55 import PureClaw.Security.Secrets
56 import PureClaw.Security.Vault
57 import PureClaw.Security.Vault.Age
58 import PureClaw.Security.Vault.Passphrase
59 import PureClaw.Security.Vault.Plugin
60 import PureClaw.Tools.FileRead
61 import PureClaw.Tools.FileWrite
62 import PureClaw.Tools.Git
63 import PureClaw.Tools.HttpRequest
64 import PureClaw.Tools.Memory
65 import PureClaw.Tools.Registry
66 import PureClaw.Tools.Shell
67
68 -- | Supported LLM providers.
69 data ProviderType
70 = Anthropic
71 | OpenAI
72 | OpenRouter
73 | Ollama
74 deriving stock (Show, Eq, Ord, Bounded, Enum)
75
76 -- | Supported memory backends.
77 data MemoryBackend
78 = NoMemory
79 | SQLiteMemory
80 | MarkdownMemory
81 deriving stock (Show, Eq, Ord, Bounded, Enum)
82
83 -- | CLI chat options.
84 -- Fields with defaults use 'Maybe' so config file values can fill in omitted flags.
85 data ChatOptions = ChatOptions
86 { _co_model :: Maybe String
87 , _co_apiKey :: Maybe String
88 , _co_system :: Maybe String
89 , _co_provider :: Maybe ProviderType
90 , _co_allowCommands :: [String]
91 , _co_autonomy :: Maybe AutonomyLevel
92 , _co_channel :: Maybe String
93 , _co_memory :: Maybe MemoryBackend
94 , _co_soul :: Maybe String
95 , _co_config :: Maybe FilePath
96 , _co_noVault :: Bool
97 , _co_oauth :: Bool
98 }
99 deriving stock (Show, Eq)
100
101 -- | Parser for chat options.
102 chatOptionsParser :: Parser ChatOptions
103 chatOptionsParser = ChatOptions
104 <$> optional (strOption
105 ( long "model"
106 <> short 'm'
107 <> help "Model to use (default: claude-sonnet-4-20250514)"
108 ))
109 <*> optional (strOption
110 ( long "api-key"
111 <> help "API key (default: from config file or env var for chosen provider)"
112 ))
113 <*> optional (strOption
114 ( long "system"
115 <> short 's'
116 <> help "System prompt (overrides SOUL.md)"
117 ))
118 <*> optional (option parseProviderType
119 ( long "provider"
120 <> short 'p'
121 <> help "LLM provider: anthropic, openai, openrouter, ollama (default: anthropic)"
122 ))
123 <*> many (strOption
124 ( long "allow"
125 <> short 'a'
126 <> help "Allow a shell command (repeatable, e.g. --allow git --allow ls)"
127 ))
128 <*> optional (option parseAutonomyLevel
129 ( long "autonomy"
130 <> help "Autonomy level: full, supervised, deny (default: deny with no --allow, full with --allow)"
131 ))
132 <*> optional (strOption
133 ( long "channel"
134 <> help "Chat channel: cli, signal, telegram (default: cli)"
135 ))
136 <*> optional (option parseMemoryBackend
137 ( long "memory"
138 <> help "Memory backend: none, sqlite, markdown (default: none)"
139 ))
140 <*> optional (strOption
141 ( long "soul"
142 <> help "Path to SOUL.md identity file (default: ./SOUL.md if it exists)"
143 ))
144 <*> optional (strOption
145 ( long "config"
146 <> short 'c'
147 <> help "Path to config file (default: ~/.pureclaw/config.toml or ~/.config/pureclaw/config.toml)"
148 ))
149 <*> switch
150 ( long "no-vault"
151 <> help "Disable vault even if configured in config file"
152 )
153 <*> switch
154 ( long "oauth"
155 <> help "Authenticate with Anthropic via OAuth (opens browser). Tokens are cached in the vault."
156 )
157
158 -- | Parse a provider type from a CLI string.
159 parseProviderType :: ReadM ProviderType
160 parseProviderType = eitherReader $ \s -> case s of
161 "anthropic" -> Right Anthropic
162 "openai" -> Right OpenAI
163 "openrouter" -> Right OpenRouter
164 "ollama" -> Right Ollama
165 _ -> Left $ "Unknown provider: " <> s <> ". Choose: anthropic, openai, openrouter, ollama"
166
167 -- | Display a provider type as a CLI string.
168 providerToText :: ProviderType -> String
169 providerToText Anthropic = "anthropic"
170 providerToText OpenAI = "openai"
171 providerToText OpenRouter = "openrouter"
172 providerToText Ollama = "ollama"
173
174 -- | Parse a memory backend from a CLI string.
175 parseMemoryBackend :: ReadM MemoryBackend
176 parseMemoryBackend = eitherReader $ \s -> case s of
177 "none" -> Right NoMemory
178 "sqlite" -> Right SQLiteMemory
179 "markdown" -> Right MarkdownMemory
180 _ -> Left $ "Unknown memory backend: " <> s <> ". Choose: none, sqlite, markdown"
181
182 -- | Display a memory backend as a CLI string.
183 memoryToText :: MemoryBackend -> String
184 memoryToText NoMemory = "none"
185 memoryToText SQLiteMemory = "sqlite"
186 memoryToText MarkdownMemory = "markdown"
187
188 -- | Top-level CLI command.
189 data Command
190 = CmdTui ChatOptions -- ^ Interactive terminal UI (always CLI channel)
191 | CmdGateway ChatOptions -- ^ Gateway mode (channel from config/flags)
192 deriving stock (Show, Eq)
193
194 -- | Full CLI parser with subcommands.
195 cliParserInfo :: ParserInfo Command
196 cliParserInfo = info (commandParser <**> helper)
197 ( fullDesc
198 <> progDesc "Haskell-native AI agent runtime"
199 <> header "pureclaw — Haskell-native AI agent runtime"
200 )
201
202 -- | Parser for the top-level command.
203 -- @pureclaw tui@ — interactive terminal
204 -- @pureclaw gateway run@ — channel-aware agent
205 -- No subcommand defaults to @tui@ for backward compatibility.
206 commandParser :: Parser Command
207 commandParser = subparser
208 ( command "tui" (info (CmdTui <$> chatOptionsParser <**> helper)
209 (progDesc "Interactive terminal chat UI"))
210 <> command "gateway" (info (subparser
211 (command "run" (info (CmdGateway <$> chatOptionsParser <**> helper)
212 (progDesc "Run the agent with channel from config (Signal, Telegram, CLI)"))))
213 (progDesc "Gateway — channel-aware agent"))
214 )
215 <|> (CmdTui <$> chatOptionsParser) -- default to tui when no subcommand
216
217 -- | Main CLI entry point.
218 runCLI :: IO ()
219 runCLI = do
220 cmd <- execParser cliParserInfo
221 case cmd of
222 CmdTui opts -> runChat opts { _co_channel = Just "cli" }
223 CmdGateway opts -> runChat opts
224
225 -- | Run an interactive chat session.
226 runChat :: ChatOptions -> IO ()
227 runChat opts = do
228 let logger = mkStderrLogHandle
229
230 -- Load config file: --config flag overrides default search locations
231 configResult <- maybe loadConfigDiag loadFileConfigDiag (_co_config opts)
232 let fileCfg = configFileConfig configResult
233
234 -- Log config loading result
235 case configResult of
236 ConfigLoaded path _ ->
237 _lh_logInfo logger $ "Config: " <> T.pack path
238 ConfigParseError path err -> do
239 _lh_logWarn logger $ "Config file has errors: " <> T.pack path
240 _lh_logWarn logger err
241 _lh_logWarn logger "Using default configuration."
242 ConfigFileNotFound path ->
243 _lh_logWarn logger $ "Config file not found: " <> T.pack path
244 ConfigNotFound _paths ->
245 _lh_logInfo logger "No config file found"
246
247 -- Resolve effective values: CLI flag > config file > default
248 let effectiveProvider = fromMaybe Anthropic (_co_provider opts <|> parseProviderMaybe (_fc_provider fileCfg))
249 effectiveModel = fromMaybe "claude-sonnet-4-20250514" (_co_model opts <|> fmap T.unpack (_fc_model fileCfg))
250 effectiveMemory = fromMaybe NoMemory (_co_memory opts <|> parseMemoryMaybe (_fc_memory fileCfg))
251 effectiveApiKey = _co_apiKey opts <|> fmap T.unpack (_fc_apiKey fileCfg)
252 effectiveSystem = _co_system opts <|> fmap T.unpack (_fc_system fileCfg)
253 effectiveAllow = _co_allowCommands opts <> maybe [] (map T.unpack) (_fc_allow fileCfg)
254 effectiveAutonomy = _co_autonomy opts
255 <|> parseAutonomyMaybe (_fc_autonomy fileCfg)
256
257 -- Vault (opened before provider so API keys can be fetched from vault)
258 vaultOpt <- resolveVault fileCfg (_co_noVault opts) logger
259
260 -- Provider (may be Nothing if no credentials are configured yet)
261 manager <- HTTP.newTlsManager
262 mProvider <- if effectiveProvider == Anthropic && _co_oauth opts
263 then Just <$> resolveAnthropicOAuth vaultOpt manager
264 else resolveProvider effectiveProvider effectiveApiKey vaultOpt manager
265
266 -- Model
267 let model = ModelId (T.pack effectiveModel)
268
269 -- System prompt: effective --system flag > SOUL.md > nothing
270 sysPrompt <- case effectiveSystem of
271 Just s -> pure (Just (T.pack s))
272 Nothing -> do
273 let soulPath = fromMaybe "SOUL.md" (_co_soul opts)
274 ident <- loadIdentity soulPath
275 if ident == defaultIdentity
276 then pure Nothing
277 else pure (Just (identitySystemPrompt ident))
278
279 -- Security policy
280 let policy = buildPolicy effectiveAutonomy effectiveAllow
281
282 -- Handles
283 let workspace = WorkspaceRoot "."
284 sh = mkShellHandle logger
285 fh = mkFileHandle workspace
286 nh = mkNetworkHandle manager
287 mh <- resolveMemory effectiveMemory
288
289 -- Tool registry
290 let registry = buildRegistry policy sh workspace fh mh nh
291
292 hSetBuffering stdout LineBuffering
293 case mProvider of
294 Just _ -> _lh_logInfo logger $ "Provider: " <> T.pack (providerToText effectiveProvider)
295 Nothing -> _lh_logInfo logger
296 "No providers configured \x2014 use /provider to get started"
297 _lh_logInfo logger $ "Model: " <> T.pack effectiveModel
298 _lh_logInfo logger $ "Memory: " <> T.pack (memoryToText effectiveMemory)
299 case (_sp_allowedCommands policy, _sp_autonomy policy) of
300 (AllowAll, Full) -> do
301 _lh_logInfo logger "Commands: allow all (unrestricted mode)"
302 _lh_logInfo logger
303 "\x26a0\xfe0f Running in unrestricted mode \x2014 the agent can execute any command without approval."
304 (_, Deny) ->
305 _lh_logInfo logger "Commands: none (deny all)"
306 (AllowList s, _) | Set.null s ->
307 _lh_logInfo logger "Commands: none (deny all)"
308 _ ->
309 _lh_logInfo logger $ "Commands: " <> T.intercalate ", " (map T.pack effectiveAllow)
310
311 -- Channel selection: CLI flag > config file > default (cli)
312 let effectiveChannel = fromMaybe "cli"
313 (_co_channel opts <|> fmap T.unpack (_fc_defaultChannel fileCfg))
314
315 let startWithChannel :: ChannelHandle -> IO ()
316 startWithChannel channel = do
317 putStrLn "PureClaw 0.1.0 \x2014 Haskell-native AI agent runtime"
318 case effectiveChannel of
319 "cli" -> putStrLn "Type your message and press Enter. Ctrl-D to exit."
320 _ -> putStrLn $ "Channel: " <> effectiveChannel
321 putStrLn ""
322 vaultRef <- newIORef vaultOpt
323 providerRef <- newIORef mProvider
324 let env = AgentEnv
325 { _env_provider = providerRef
326 , _env_model = model
327 , _env_channel = channel
328 , _env_logger = logger
329 , _env_systemPrompt = sysPrompt
330 , _env_registry = registry
331 , _env_vault = vaultRef
332 , _env_pluginHandle = mkPluginHandle
333 }
334 runAgentLoop env
335
336 case effectiveChannel of
337 "signal" -> do
338 let sigCfg = resolveSignalConfig fileCfg
339 -- Check that signal-cli is installed
340 signalCliResult <- try @IOException $
341 P.readProcess (P.proc "signal-cli" ["--version"])
342 case signalCliResult of
343 Left _ -> do
344 _lh_logWarn logger "signal-cli is not installed or not in PATH."
345 _lh_logWarn logger "Install it from: https://github.com/AsamK/signal-cli"
346 _lh_logWarn logger " brew install signal-cli (macOS)"
347 _lh_logWarn logger " nix-env -i signal-cli (NixOS)"
348 _lh_logWarn logger "Falling back to CLI channel."
349 startWithChannel mkCLIChannelHandle
350 Right _ -> do
351 _lh_logInfo logger $ "Signal account: " <> _sc_account sigCfg
352 transport <- mkSignalCliTransport (_sc_account sigCfg) logger
353 withSignalChannel sigCfg transport logger startWithChannel
354 "cli" ->
355 startWithChannel mkCLIChannelHandle
356 other -> do
357 _lh_logWarn logger $ "Unknown channel: " <> T.pack other <> ". Using CLI."
358 startWithChannel mkCLIChannelHandle
359
360 -- | Parse a provider type from a text value (used for config file).
361 parseProviderMaybe :: Maybe T.Text -> Maybe ProviderType
362 parseProviderMaybe Nothing = Nothing
363 parseProviderMaybe (Just t) = case T.unpack t of
364 "anthropic" -> Just Anthropic
365 "openai" -> Just OpenAI
366 "openrouter" -> Just OpenRouter
367 "ollama" -> Just Ollama
368 _ -> Nothing
369
370 -- | Parse an autonomy level from a CLI string.
371 parseAutonomyLevel :: ReadM AutonomyLevel
372 parseAutonomyLevel = eitherReader $ \s -> case s of
373 "full" -> Right Full
374 "supervised" -> Right Supervised
375 "deny" -> Right Deny
376 _ -> Left $ "Unknown autonomy level: " <> s <> ". Choose: full, supervised, deny"
377
378 -- | Parse an autonomy level from a text value (used for config file).
379 parseAutonomyMaybe :: Maybe T.Text -> Maybe AutonomyLevel
380 parseAutonomyMaybe Nothing = Nothing
381 parseAutonomyMaybe (Just t) = case t of
382 "full" -> Just Full
383 "supervised" -> Just Supervised
384 "deny" -> Just Deny
385 _ -> Nothing
386
387 -- | Parse a memory backend from a text value (used for config file).
388 parseMemoryMaybe :: Maybe T.Text -> Maybe MemoryBackend
389 parseMemoryMaybe Nothing = Nothing
390 parseMemoryMaybe (Just t) = case T.unpack t of
391 "none" -> Just NoMemory
392 "sqlite" -> Just SQLiteMemory
393 "markdown" -> Just MarkdownMemory
394 _ -> Nothing
395
396 -- | Build the tool registry with all available tools.
397 buildRegistry :: SecurityPolicy -> ShellHandle -> WorkspaceRoot -> FileHandle -> MemoryHandle -> NetworkHandle -> ToolRegistry
398 buildRegistry policy sh workspace fh mh nh =
399 let reg = uncurry registerTool
400 in reg (shellTool policy sh)
401 $ reg (fileReadTool workspace fh)
402 $ reg (fileWriteTool workspace fh)
403 $ reg (gitTool policy sh)
404 $ reg (memoryStoreTool mh)
405 $ reg (memoryRecallTool mh)
406 $ reg (httpRequestTool AllowAll nh)
407 emptyRegistry
408
409 -- | Build a security policy from optional autonomy level and allowed commands.
410 --
411 -- Behavior:
412 -- * @Just Full@ + empty allow list → 'AllowAll' + 'Full' (unrestricted mode)
413 -- * @Just Full@ + allow list → 'AllowList' of those commands + 'Full'
414 -- * @Just Supervised@ + allow list → 'AllowList' + 'Supervised'
415 -- * @Just Deny@ → 'defaultPolicy' ('Deny', empty 'AllowList')
416 -- * @Nothing@ + empty allow list → 'defaultPolicy' (backward compat)
417 -- * @Nothing@ + allow list → 'Full' + 'AllowList' (backward compat)
418 buildPolicy :: Maybe AutonomyLevel -> [String] -> SecurityPolicy
419 buildPolicy (Just Deny) _ = defaultPolicy
420 buildPolicy (Just level) [] = SecurityPolicy
421 { _sp_allowedCommands = AllowAll
422 , _sp_autonomy = level
423 }
424 buildPolicy (Just level) cmds =
425 let cmdNames = Set.fromList (map (CommandName . T.pack) cmds)
426 in SecurityPolicy
427 { _sp_allowedCommands = AllowList cmdNames
428 , _sp_autonomy = level
429 }
430 buildPolicy Nothing [] = defaultPolicy
431 buildPolicy Nothing cmds =
432 let cmdNames = Set.fromList (map (CommandName . T.pack) cmds)
433 in SecurityPolicy
434 { _sp_allowedCommands = AllowList cmdNames
435 , _sp_autonomy = Full
436 }
437
438 -- | Resolve the LLM provider from the provider type.
439 -- Checks CLI flag first, then the vault for the API key.
440 -- Returns 'Nothing' if no credentials are available (the agent loop
441 -- will still start, allowing the user to configure credentials via
442 -- slash commands like /vault setup).
443 resolveProvider :: ProviderType -> Maybe String -> Maybe VaultHandle -> HTTP.Manager -> IO (Maybe SomeProvider)
444 resolveProvider Anthropic keyOpt vaultOpt manager = do
445 mApiKey <- resolveApiKey keyOpt "ANTHROPIC_API_KEY" vaultOpt
446 case mApiKey of
447 Just k -> pure (Just (MkProvider (mkAnthropicProvider manager k)))
448 Nothing -> do
449 -- Fall back to cached OAuth tokens in the vault
450 cachedBs <- tryVaultLookup vaultOpt oauthVaultKey
451 case cachedBs >>= eitherToMaybe . deserializeTokens of
452 Nothing -> pure Nothing
453 Just tokens -> do
454 let cfg = defaultOAuthConfig
455 now <- getCurrentTime
456 t <- if _oat_expiresAt tokens <= now
457 then do
458 putStrLn "OAuth access token expired \x2014 refreshing..."
459 newT <- refreshOAuthToken cfg manager (_oat_refreshToken tokens)
460 saveOAuthTokens vaultOpt newT
461 pure newT
462 else pure tokens
463 handle <- mkOAuthHandle cfg manager t
464 pure (Just (MkProvider (mkAnthropicProviderOAuth manager handle)))
465 resolveProvider OpenAI keyOpt vaultOpt manager = do
466 mApiKey <- resolveApiKey keyOpt "OPENAI_API_KEY" vaultOpt
467 pure (fmap (MkProvider . mkOpenAIProvider manager) mApiKey)
468 resolveProvider OpenRouter keyOpt vaultOpt manager = do
469 mApiKey <- resolveApiKey keyOpt "OPENROUTER_API_KEY" vaultOpt
470 pure (fmap (MkProvider . mkOpenRouterProvider manager) mApiKey)
471 resolveProvider Ollama _ _ manager =
472 pure (Just (MkProvider (mkOllamaProvider manager)))
473
474 -- | Vault key used to cache OAuth tokens between sessions.
475 oauthVaultKey :: T.Text
476 oauthVaultKey = "ANTHROPIC_OAUTH_TOKENS"
477
478 -- | Resolve an Anthropic provider via OAuth 2.0 PKCE.
479 -- Loads cached tokens from the vault if available; runs the full browser
480 -- flow otherwise. Refreshes expired access tokens automatically.
481 resolveAnthropicOAuth :: Maybe VaultHandle -> HTTP.Manager -> IO SomeProvider
482 resolveAnthropicOAuth vaultOpt manager = do
483 let cfg = defaultOAuthConfig
484 cachedBs <- tryVaultLookup vaultOpt oauthVaultKey
485 tokens <- case cachedBs >>= eitherToMaybe . deserializeTokens of
486 Just t -> do
487 now <- getCurrentTime
488 if _oat_expiresAt t <= now
489 then do
490 putStrLn "OAuth access token expired — refreshing..."
491 newT <- refreshOAuthToken cfg manager (_oat_refreshToken t)
492 saveOAuthTokens vaultOpt newT
493 pure newT
494 else pure t
495 Nothing -> do
496 t <- runOAuthFlow cfg manager
497 saveOAuthTokens vaultOpt t
498 pure t
499 handle <- mkOAuthHandle cfg manager tokens
500 pure (MkProvider (mkAnthropicProviderOAuth manager handle))
501
502 -- | Save OAuth tokens to the vault (best-effort; logs on failure).
503 saveOAuthTokens :: Maybe VaultHandle -> OAuthTokens -> IO ()
504 saveOAuthTokens Nothing _ = pure ()
505 saveOAuthTokens (Just vh) tokens = do
506 result <- _vh_put vh oauthVaultKey (serializeTokens tokens)
507 case result of
508 Left err -> putStrLn $ "Warning: could not cache OAuth tokens: " <> show err
509 Right () -> pure ()
510
511 -- | Convert 'Either' to 'Maybe', discarding the error.
512 eitherToMaybe :: Either e a -> Maybe a
513 eitherToMaybe (Left _) = Nothing
514 eitherToMaybe (Right a) = Just a
515
516 -- | Resolve an API key from: CLI flag → vault.
517 -- Returns 'Nothing' if no key is found.
518 resolveApiKey :: Maybe String -> String -> Maybe VaultHandle -> IO (Maybe ApiKey)
519 resolveApiKey (Just key) _ _ = pure (Just (mkApiKey (TE.encodeUtf8 (T.pack key))))
520 resolveApiKey Nothing vaultKeyName vaultOpt = do
521 vaultKey <- tryVaultLookup vaultOpt (T.pack vaultKeyName)
522 case vaultKey of
523 Just bs -> pure (Just (mkApiKey bs))
524 Nothing -> pure Nothing
525
526 -- | Try to look up a key from the vault. Returns 'Nothing' if the vault is
527 -- absent, locked, or does not contain the key.
528 tryVaultLookup :: Maybe VaultHandle -> T.Text -> IO (Maybe ByteString)
529 tryVaultLookup Nothing _ = pure Nothing
530 tryVaultLookup (Just vh) key = do
531 result <- _vh_get vh key
532 case result of
533 Right bs -> pure (Just bs)
534 Left _ -> pure Nothing
535
536 -- | Resolve the memory backend.
537 resolveMemory :: MemoryBackend -> IO MemoryHandle
538 resolveMemory NoMemory = pure mkNoOpMemoryHandle
539 resolveMemory SQLiteMemory = do
540 dir <- getPureclawDir
541 mkSQLiteMemoryHandle (dir ++ "/memory.db")
542 resolveMemory MarkdownMemory = do
543 dir <- getPureclawDir
544 mkMarkdownMemoryHandle (dir ++ "/memory")
545
546 -- | Open the vault if configured. Returns 'Nothing' if @--no-vault@ is set.
547 -- When age keys are configured, uses age public-key encryption.
548 -- Otherwise, falls back to passphrase-based encryption (works out of the box).
549 resolveVault :: FileConfig -> Bool -> LogHandle -> IO (Maybe VaultHandle)
550 resolveVault _ True _ = pure Nothing
551 resolveVault fileCfg False logger =
552 case (_fc_vault_recipient fileCfg, _fc_vault_identity fileCfg) of
553 (Just recipient, Just identity) -> resolveAgeVault fileCfg recipient identity logger
554 _ -> resolvePassphraseVault fileCfg logger
555
556 -- | Resolve vault using age public-key encryption (existing behaviour).
557 resolveAgeVault :: FileConfig -> T.Text -> T.Text -> LogHandle -> IO (Maybe VaultHandle)
558 resolveAgeVault fileCfg recipient identity logger = do
559 encResult <- mkAgeEncryptor
560 case encResult of
561 Left err -> do
562 _lh_logInfo logger $ "Vault disabled (age not available): " <> T.pack (show err)
563 pure Nothing
564 Right enc -> do
565 dir <- getPureclawDir
566 let path = maybe (dir ++ "/vault/vault.age") T.unpack (_fc_vault_path fileCfg)
567 mode = parseUnlockMode (_fc_vault_unlock fileCfg)
568 enc' = ageVaultEncryptor enc recipient identity
569 cfg = VaultConfig
570 { _vc_path = path
571 , _vc_keyType = inferAgeKeyType recipient
572 , _vc_unlock = mode
573 }
574 vault <- openVault cfg enc'
575 exists <- doesFileExist path
576 if exists
577 then do
578 case mode of
579 UnlockStartup -> do
580 result <- _vh_unlock vault
581 case result of
582 Left err -> _lh_logInfo logger $
583 "Vault startup unlock failed (vault will be locked): " <> T.pack (show err)
584 Right () -> _lh_logInfo logger "Vault unlocked."
585 _ -> pure ()
586 pure (Just vault)
587 else do
588 _lh_logInfo logger "No vault found — use `/vault setup` to create one."
589 pure Nothing
590
591 -- | Resolve vault using passphrase-based encryption (default when no age keys configured).
592 -- Prompts for passphrase on stdin at startup (if vault file exists).
593 resolvePassphraseVault :: FileConfig -> LogHandle -> IO (Maybe VaultHandle)
594 resolvePassphraseVault fileCfg logger = do
595 dir <- getPureclawDir
596 let path = maybe (dir ++ "/vault/vault.age") T.unpack (_fc_vault_path fileCfg)
597 cfg = VaultConfig
598 { _vc_path = path
599 , _vc_keyType = "AES-256 (passphrase)"
600 , _vc_unlock = UnlockStartup
601 }
602 let getPass = do
603 putStr "Vault passphrase: "
604 hFlush stdout
605 pass <- bracket_
606 (hSetEcho stdin False)
607 (hSetEcho stdin True >> putStrLn "")
608 getLine
609 pure (TE.encodeUtf8 (T.pack pass))
610 enc <- mkPassphraseVaultEncryptor getPass
611 vault <- openVault cfg enc
612 exists <- doesFileExist path
613 if exists
614 then do
615 result <- _vh_unlock vault
616 case result of
617 Left err -> _lh_logInfo logger $
618 "Vault unlock failed: " <> T.pack (show err)
619 Right () -> _lh_logInfo logger "Vault unlocked."
620 pure (Just vault)
621 else do
622 _lh_logInfo logger "No vault found — use `/vault setup` to create one."
623 pure Nothing
624
625 -- | Infer a human-readable key type from the age recipient prefix.
626 inferAgeKeyType :: T.Text -> T.Text
627 inferAgeKeyType recipient
628 | "age-plugin-yubikey" `T.isPrefixOf` recipient = "YubiKey PIV"
629 | "age1" `T.isPrefixOf` recipient = "X25519"
630 | otherwise = "Unknown"
631
632 -- | Parse vault unlock mode from config text.
633 parseUnlockMode :: Maybe T.Text -> UnlockMode
634 parseUnlockMode Nothing = UnlockOnDemand
635 parseUnlockMode (Just t) = case t of
636 "startup" -> UnlockStartup
637 "on_demand" -> UnlockOnDemand
638 "per_access" -> UnlockPerAccess
639 _ -> UnlockOnDemand
640
641 -- | Resolve Signal channel config from the file config.
642 resolveSignalConfig :: FileConfig -> SignalConfig
643 resolveSignalConfig fileCfg =
644 let sigCfg = _fc_signal fileCfg
645 dmPolicy = sigCfg >>= _fsc_dmPolicy
646 allowFrom = case dmPolicy of
647 Just "open" -> AllowAll
648 _ -> case sigCfg >>= _fsc_allowFrom of
649 Nothing -> AllowAll
650 Just [] -> AllowAll
651 Just users -> AllowList (Set.fromList (map UserId users))
652 in SignalConfig
653 { _sc_account = fromMaybe "+0000000000" (sigCfg >>= _fsc_account)
654 , _sc_textChunkLimit = fromMaybe 6000 (sigCfg >>= _fsc_textChunkLimit)
655 , _sc_allowFrom = allowFrom
656 }