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