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 Data.ByteString (ByteString)
13 import Data.Maybe
14 import Data.Set qualified as Set
15 import Data.Text qualified as T
16 import Data.Text.Encoding qualified as TE
17 import Network.HTTP.Client qualified as HTTP
18 import Network.HTTP.Client.TLS qualified as HTTP
19 import Options.Applicative
20 import System.Environment
21 import System.Exit
22 import System.IO
23
24 import PureClaw.CLI.Config
25
26 import PureClaw.Agent.Env
27 import PureClaw.Agent.Identity
28 import PureClaw.Agent.Loop
29 import PureClaw.Channels.CLI
30 import PureClaw.Core.Types
31 import PureClaw.Handles.File
32 import PureClaw.Handles.Log
33 import PureClaw.Handles.Memory
34 import PureClaw.Handles.Network
35 import PureClaw.Handles.Shell
36 import PureClaw.Memory.Markdown
37 import PureClaw.Memory.SQLite
38 import PureClaw.Providers.Anthropic
39 import PureClaw.Providers.Class
40 import PureClaw.Providers.Ollama
41 import PureClaw.Providers.OpenAI
42 import PureClaw.Providers.OpenRouter
43 import PureClaw.Security.Policy
44 import PureClaw.Security.Secrets
45 import PureClaw.Security.Vault
46 import PureClaw.Security.Vault.Age
47 import PureClaw.Tools.FileRead
48 import PureClaw.Tools.FileWrite
49 import PureClaw.Tools.Git
50 import PureClaw.Tools.HttpRequest
51 import PureClaw.Tools.Memory
52 import PureClaw.Tools.Registry
53 import PureClaw.Tools.Shell
54
55 -- | Supported LLM providers.
56 data ProviderType
57 = Anthropic
58 | OpenAI
59 | OpenRouter
60 | Ollama
61 deriving stock (Show, Eq, Ord, Bounded, Enum)
62
63 -- | Supported memory backends.
64 data MemoryBackend
65 = NoMemory
66 | SQLiteMemory
67 | MarkdownMemory
68 deriving stock (Show, Eq, Ord, Bounded, Enum)
69
70 -- | CLI chat options.
71 -- Fields with defaults use 'Maybe' so config file values can fill in omitted flags.
72 data ChatOptions = ChatOptions
73 { _co_model :: Maybe String
74 , _co_apiKey :: Maybe String
75 , _co_system :: Maybe String
76 , _co_provider :: Maybe ProviderType
77 , _co_allowCommands :: [String]
78 , _co_memory :: Maybe MemoryBackend
79 , _co_soul :: Maybe String
80 , _co_config :: Maybe FilePath
81 , _co_noVault :: Bool
82 }
83 deriving stock (Show, Eq)
84
85 -- | Parser for chat options.
86 chatOptionsParser :: Parser ChatOptions
87 chatOptionsParser = ChatOptions
88 <$> optional (strOption
89 ( long "model"
90 <> short 'm'
91 <> help "Model to use (default: claude-sonnet-4-20250514)"
92 ))
93 <*> optional (strOption
94 ( long "api-key"
95 <> help "API key (default: from config file or env var for chosen provider)"
96 ))
97 <*> optional (strOption
98 ( long "system"
99 <> short 's'
100 <> help "System prompt (overrides SOUL.md)"
101 ))
102 <*> optional (option parseProviderType
103 ( long "provider"
104 <> short 'p'
105 <> help "LLM provider: anthropic, openai, openrouter, ollama (default: anthropic)"
106 ))
107 <*> many (strOption
108 ( long "allow"
109 <> short 'a'
110 <> help "Allow a shell command (repeatable, e.g. --allow git --allow ls)"
111 ))
112 <*> optional (option parseMemoryBackend
113 ( long "memory"
114 <> help "Memory backend: none, sqlite, markdown (default: none)"
115 ))
116 <*> optional (strOption
117 ( long "soul"
118 <> help "Path to SOUL.md identity file (default: ./SOUL.md if it exists)"
119 ))
120 <*> optional (strOption
121 ( long "config"
122 <> short 'c'
123 <> help "Path to config file (default: ~/.pureclaw/config.toml or ~/.config/pureclaw/config.toml)"
124 ))
125 <*> switch
126 ( long "no-vault"
127 <> help "Disable vault even if configured in config file"
128 )
129
130 -- | Parse a provider type from a CLI string.
131 parseProviderType :: ReadM ProviderType
132 parseProviderType = eitherReader $ \s -> case s of
133 "anthropic" -> Right Anthropic
134 "openai" -> Right OpenAI
135 "openrouter" -> Right OpenRouter
136 "ollama" -> Right Ollama
137 _ -> Left $ "Unknown provider: " <> s <> ". Choose: anthropic, openai, openrouter, ollama"
138
139 -- | Display a provider type as a CLI string.
140 providerToText :: ProviderType -> String
141 providerToText Anthropic = "anthropic"
142 providerToText OpenAI = "openai"
143 providerToText OpenRouter = "openrouter"
144 providerToText Ollama = "ollama"
145
146 -- | Parse a memory backend from a CLI string.
147 parseMemoryBackend :: ReadM MemoryBackend
148 parseMemoryBackend = eitherReader $ \s -> case s of
149 "none" -> Right NoMemory
150 "sqlite" -> Right SQLiteMemory
151 "markdown" -> Right MarkdownMemory
152 _ -> Left $ "Unknown memory backend: " <> s <> ". Choose: none, sqlite, markdown"
153
154 -- | Display a memory backend as a CLI string.
155 memoryToText :: MemoryBackend -> String
156 memoryToText NoMemory = "none"
157 memoryToText SQLiteMemory = "sqlite"
158 memoryToText MarkdownMemory = "markdown"
159
160 -- | Full CLI parser with help and version.
161 cliParserInfo :: ParserInfo ChatOptions
162 cliParserInfo = info (chatOptionsParser <**> helper)
163 ( fullDesc
164 <> progDesc "Interactive AI chat with tool use"
165 <> header "pureclaw — Haskell-native AI agent runtime"
166 )
167
168 -- | Main CLI entry point.
169 runCLI :: IO ()
170 runCLI = do
171 opts <- execParser cliParserInfo
172 runChat opts
173
174 -- | Run an interactive chat session.
175 runChat :: ChatOptions -> IO ()
176 runChat opts = do
177 let logger = mkStderrLogHandle
178
179 -- Load config file: --config flag overrides default search locations
180 fileCfg <- maybe loadConfig loadFileConfig (_co_config opts)
181
182 -- Resolve effective values: CLI flag > config file > default
183 let effectiveProvider = fromMaybe Anthropic (_co_provider opts <|> parseProviderMaybe (_fc_provider fileCfg))
184 effectiveModel = fromMaybe "claude-sonnet-4-20250514" (_co_model opts <|> fmap T.unpack (_fc_model fileCfg))
185 effectiveMemory = fromMaybe NoMemory (_co_memory opts <|> parseMemoryMaybe (_fc_memory fileCfg))
186 effectiveApiKey = _co_apiKey opts <|> fmap T.unpack (_fc_apiKey fileCfg)
187 effectiveSystem = _co_system opts <|> fmap T.unpack (_fc_system fileCfg)
188 effectiveAllow = _co_allowCommands opts <> maybe [] (map T.unpack) (_fc_allow fileCfg)
189
190 -- Vault (opened before provider so API keys can be fetched from vault)
191 vaultOpt <- resolveVault fileCfg (_co_noVault opts) logger
192
193 -- Provider
194 manager <- HTTP.newTlsManager
195 provider <- resolveProvider effectiveProvider effectiveApiKey vaultOpt manager
196
197 -- Model
198 let model = ModelId (T.pack effectiveModel)
199
200 -- System prompt: effective --system flag > SOUL.md > nothing
201 sysPrompt <- case effectiveSystem of
202 Just s -> pure (Just (T.pack s))
203 Nothing -> do
204 let soulPath = fromMaybe "SOUL.md" (_co_soul opts)
205 ident <- loadIdentity soulPath
206 if ident == defaultIdentity
207 then pure Nothing
208 else pure (Just (identitySystemPrompt ident))
209
210 -- Security policy
211 let policy = buildPolicy effectiveAllow
212
213 -- Handles
214 let channel = mkCLIChannelHandle
215 workspace = WorkspaceRoot "."
216 sh = mkShellHandle logger
217 fh = mkFileHandle workspace
218 nh = mkNetworkHandle manager
219 mh <- resolveMemory effectiveMemory
220
221 -- Tool registry
222 let registry = buildRegistry policy sh workspace fh mh nh
223
224 hSetBuffering stdout LineBuffering
225 _lh_logInfo logger $ "Provider: " <> T.pack (providerToText effectiveProvider)
226 _lh_logInfo logger $ "Model: " <> T.pack effectiveModel
227 _lh_logInfo logger $ "Memory: " <> T.pack (memoryToText effectiveMemory)
228 case effectiveAllow of
229 [] -> _lh_logInfo logger "Commands: none (deny all)"
230 cmds -> _lh_logInfo logger $ "Commands: " <> T.intercalate ", " (map T.pack cmds)
231 putStrLn "PureClaw 0.1.0 — Haskell-native AI agent runtime"
232 putStrLn "Type your message and press Enter. Ctrl-D to exit."
233 putStrLn ""
234 let env = AgentEnv
235 { _env_provider = provider
236 , _env_model = model
237 , _env_channel = channel
238 , _env_logger = logger
239 , _env_systemPrompt = sysPrompt
240 , _env_registry = registry
241 , _env_vault = vaultOpt
242 }
243 runAgentLoop env
244
245 -- | Parse a provider type from a text value (used for config file).
246 parseProviderMaybe :: Maybe T.Text -> Maybe ProviderType
247 parseProviderMaybe Nothing = Nothing
248 parseProviderMaybe (Just t) = case T.unpack t of
249 "anthropic" -> Just Anthropic
250 "openai" -> Just OpenAI
251 "openrouter" -> Just OpenRouter
252 "ollama" -> Just Ollama
253 _ -> Nothing
254
255 -- | Parse a memory backend from a text value (used for config file).
256 parseMemoryMaybe :: Maybe T.Text -> Maybe MemoryBackend
257 parseMemoryMaybe Nothing = Nothing
258 parseMemoryMaybe (Just t) = case T.unpack t of
259 "none" -> Just NoMemory
260 "sqlite" -> Just SQLiteMemory
261 "markdown" -> Just MarkdownMemory
262 _ -> Nothing
263
264 -- | Build the tool registry with all available tools.
265 buildRegistry :: SecurityPolicy -> ShellHandle -> WorkspaceRoot -> FileHandle -> MemoryHandle -> NetworkHandle -> ToolRegistry
266 buildRegistry policy sh workspace fh mh nh =
267 let reg = uncurry registerTool
268 in reg (shellTool policy sh)
269 $ reg (fileReadTool workspace fh)
270 $ reg (fileWriteTool workspace fh)
271 $ reg (gitTool policy sh)
272 $ reg (memoryStoreTool mh)
273 $ reg (memoryRecallTool mh)
274 $ reg (httpRequestTool AllowAll nh)
275 emptyRegistry
276
277 -- | Build a security policy from the list of allowed commands.
278 buildPolicy :: [String] -> SecurityPolicy
279 buildPolicy [] = defaultPolicy
280 buildPolicy cmds =
281 let cmdNames = Set.fromList (map (CommandName . T.pack) cmds)
282 in defaultPolicy
283 { _sp_allowedCommands = AllowList cmdNames
284 , _sp_autonomy = Full
285 }
286
287 -- | Resolve the LLM provider from the provider type.
288 -- Checks the vault for the API key (using the env var name as the vault key)
289 -- before falling back to CLI flag or environment variable.
290 resolveProvider :: ProviderType -> Maybe String -> Maybe VaultHandle -> HTTP.Manager -> IO SomeProvider
291 resolveProvider Anthropic keyOpt vaultOpt manager = do
292 apiKey <- resolveApiKey keyOpt "ANTHROPIC_API_KEY" vaultOpt
293 pure (MkProvider (mkAnthropicProvider manager apiKey))
294 resolveProvider OpenAI keyOpt vaultOpt manager = do
295 apiKey <- resolveApiKey keyOpt "OPENAI_API_KEY" vaultOpt
296 pure (MkProvider (mkOpenAIProvider manager apiKey))
297 resolveProvider OpenRouter keyOpt vaultOpt manager = do
298 apiKey <- resolveApiKey keyOpt "OPENROUTER_API_KEY" vaultOpt
299 pure (MkProvider (mkOpenRouterProvider manager apiKey))
300 resolveProvider Ollama _ _ manager =
301 pure (MkProvider (mkOllamaProvider manager))
302
303 -- | Resolve an API key from: CLI flag → vault → environment variable.
304 resolveApiKey :: Maybe String -> String -> Maybe VaultHandle -> IO ApiKey
305 resolveApiKey (Just key) _ _ = pure (mkApiKey (TE.encodeUtf8 (T.pack key)))
306 resolveApiKey Nothing envVar vaultOpt = do
307 vaultKey <- tryVaultLookup vaultOpt (T.pack envVar)
308 case vaultKey of
309 Just bs -> pure (mkApiKey bs)
310 Nothing -> do
311 envKey <- lookupEnv envVar
312 case envKey of
313 Just key -> pure (mkApiKey (TE.encodeUtf8 (T.pack key)))
314 Nothing -> die $
315 "No API key provided. Use --api-key, set " <> envVar
316 <> ", or store in vault with /vault add " <> envVar
317
318 -- | Try to look up a key from the vault. Returns 'Nothing' if the vault is
319 -- absent, locked, or does not contain the key.
320 tryVaultLookup :: Maybe VaultHandle -> T.Text -> IO (Maybe ByteString)
321 tryVaultLookup Nothing _ = pure Nothing
322 tryVaultLookup (Just vh) key = do
323 result <- _vh_get vh key
324 case result of
325 Right bs -> pure (Just bs)
326 Left _ -> pure Nothing
327
328 -- | Resolve the memory backend.
329 resolveMemory :: MemoryBackend -> IO MemoryHandle
330 resolveMemory NoMemory = pure mkNoOpMemoryHandle
331 resolveMemory SQLiteMemory = do
332 dir <- getPureclawDir
333 mkSQLiteMemoryHandle (dir ++ "/memory.db")
334 resolveMemory MarkdownMemory = do
335 dir <- getPureclawDir
336 mkMarkdownMemoryHandle (dir ++ "/memory")
337
338 -- | Open the vault if configured. Returns 'Nothing' if:
339 -- - @--no-vault@ flag is set, or
340 -- - vault_recipient or vault_identity are not configured, or
341 -- - the age binary is not installed (logs warning and continues).
342 -- For 'UnlockStartup' mode, also attempts to unlock the vault at startup.
343 resolveVault :: FileConfig -> Bool -> LogHandle -> IO (Maybe VaultHandle)
344 resolveVault _ True _ = pure Nothing
345 resolveVault fileCfg False logger =
346 case (_fc_vault_recipient fileCfg, _fc_vault_identity fileCfg) of
347 (Nothing, _) -> pure Nothing
348 (_, Nothing) -> pure Nothing
349 (Just recipient, Just identity) -> do
350 encResult <- mkAgeEncryptor
351 case encResult of
352 Left err -> do
353 _lh_logInfo logger $ "Vault disabled (age not available): " <> T.pack (show err)
354 pure Nothing
355 Right enc -> do
356 dir <- getPureclawDir
357 let path = maybe (dir ++ "/vault.age") T.unpack (_fc_vault_path fileCfg)
358 mode = parseUnlockMode (_fc_vault_unlock fileCfg)
359 cfg = VaultConfig
360 { _vc_path = path
361 , _vc_recipient = recipient
362 , _vc_identity = identity
363 , _vc_unlock = mode
364 }
365 vault <- openVault cfg enc
366 -- For startup mode, attempt unlock now; failure is non-fatal
367 case mode of
368 UnlockStartup -> do
369 result <- _vh_unlock vault
370 case result of
371 Left err -> _lh_logInfo logger $
372 "Vault startup unlock failed (vault will be locked): " <> T.pack (show err)
373 Right () -> _lh_logInfo logger "Vault unlocked."
374 _ -> pure ()
375 pure (Just vault)
376
377 -- | Parse vault unlock mode from config text.
378 parseUnlockMode :: Maybe T.Text -> UnlockMode
379 parseUnlockMode Nothing = UnlockOnDemand
380 parseUnlockMode (Just t) = case t of
381 "startup" -> UnlockStartup
382 "on_demand" -> UnlockOnDemand
383 "per_access" -> UnlockPerAccess
384 _ -> UnlockOnDemand