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