never executed always true always false
1 module PureClaw.CLI.Config
2 ( -- * File config
3 FileConfig (..)
4 , FileSignalConfig (..)
5 , FileTelegramConfig (..)
6 , emptyFileConfig
7 , emptyFileSignalConfig
8 , emptyFileTelegramConfig
9 -- * Loading
10 , loadFileConfig
11 , loadConfig
12 -- * Diagnostic loading
13 , ConfigLoadResult (..)
14 , loadFileConfigDiag
15 , loadConfigDiag
16 , configFileConfig
17 -- * Writing
18 , writeFileConfig
19 , FieldUpdate (..)
20 , updateVaultConfig
21 -- * Directory helpers
22 , getPureclawDir
23 ) where
24
25 import Control.Exception
26 import Data.Text (Text)
27 import Data.Text.IO qualified as TIO
28 import System.Directory (getHomeDirectory)
29 import System.FilePath ((</>))
30 import Toml (TomlCodec, (.=))
31 import Toml qualified
32
33 -- | Configuration that can be read from a TOML file.
34 -- All fields are optional — missing fields default to Nothing.
35 data FileConfig = FileConfig
36 { _fc_apiKey :: Maybe Text
37 , _fc_model :: Maybe Text
38 , _fc_provider :: Maybe Text
39 , _fc_system :: Maybe Text
40 , _fc_memory :: Maybe Text
41 , _fc_allow :: Maybe [Text]
42 , _fc_autonomy :: Maybe Text -- ^ "full", "supervised", or "deny"
43 , _fc_defaultChannel :: Maybe Text -- ^ "cli", "signal", or "telegram"
44 , _fc_signal :: Maybe FileSignalConfig -- ^ [signal] TOML table
45 , _fc_telegram :: Maybe FileTelegramConfig -- ^ [telegram] TOML table
46 , _fc_reasoningEffort :: Maybe Text -- ^ "high", "medium", or "low"
47 , _fc_maxTurns :: Maybe Int -- ^ Maximum tool-call iterations per turn
48 , _fc_timezone :: Maybe Text -- ^ IANA timezone (e.g. "America/New_York")
49 , _fc_baseUrl :: Maybe Text -- ^ Provider base URL override (e.g. Ollama endpoint)
50 , _fc_vault_path :: Maybe Text -- ^ vault file path (default: ~/.pureclaw/vault.age)
51 , _fc_vault_recipient :: Maybe Text -- ^ age recipient string (required to enable vault)
52 , _fc_vault_identity :: Maybe Text -- ^ age identity path or plugin string
53 , _fc_vault_unlock :: Maybe Text -- ^ "startup", "on_demand", or "per_access"
54 , _fc_defaultAgent :: Maybe Text -- ^ Name of the agent loaded when @--agent@ is omitted
55 , _fc_agentTruncateLimit :: Maybe Int -- ^ Per-file truncation limit (chars) for composed prompts; default 8000
56 } deriving stock (Show, Eq)
57
58 -- | Signal channel configuration from the @[signal]@ TOML table.
59 data FileSignalConfig = FileSignalConfig
60 { _fsc_account :: Maybe Text -- ^ E.164 phone number
61 , _fsc_dmPolicy :: Maybe Text -- ^ "pairing", "allowlist", "open", "disabled"
62 , _fsc_allowFrom :: Maybe [Text] -- ^ E.164 numbers or UUIDs
63 , _fsc_textChunkLimit :: Maybe Int -- ^ Max chars per message (default: 6000)
64 } deriving stock (Show, Eq)
65
66 emptyFileConfig :: FileConfig
67 emptyFileConfig =
68 FileConfig Nothing Nothing Nothing Nothing Nothing Nothing
69 Nothing Nothing Nothing Nothing Nothing Nothing Nothing
70 Nothing Nothing Nothing Nothing Nothing
71 Nothing Nothing
72
73 emptyFileSignalConfig :: FileSignalConfig
74 emptyFileSignalConfig = FileSignalConfig Nothing Nothing Nothing Nothing
75
76 -- | Telegram channel configuration from the @[telegram]@ TOML table.
77 data FileTelegramConfig = FileTelegramConfig
78 { _ftc_botToken :: Maybe Text -- ^ Bot API token
79 , _ftc_dmPolicy :: Maybe Text -- ^ "pairing", "allowlist", "open", "disabled"
80 , _ftc_allowFrom :: Maybe [Text] -- ^ Allowed usernames or IDs
81 } deriving stock (Show, Eq)
82
83 emptyFileTelegramConfig :: FileTelegramConfig
84 emptyFileTelegramConfig = FileTelegramConfig Nothing Nothing Nothing
85
86 fileConfigCodec :: TomlCodec FileConfig
87 fileConfigCodec = FileConfig
88 <$> Toml.dioptional (Toml.text "api_key") .= _fc_apiKey
89 <*> Toml.dioptional (Toml.text "model") .= _fc_model
90 <*> Toml.dioptional (Toml.text "provider") .= _fc_provider
91 <*> Toml.dioptional (Toml.text "system") .= _fc_system
92 <*> Toml.dioptional (Toml.text "memory") .= _fc_memory
93 <*> Toml.dioptional (Toml.arrayOf Toml._Text "allow") .= _fc_allow
94 <*> Toml.dioptional (Toml.text "autonomy") .= _fc_autonomy
95 <*> Toml.dioptional (Toml.text "default_channel") .= _fc_defaultChannel
96 <*> Toml.dioptional (Toml.table fileSignalConfigCodec "signal") .= _fc_signal
97 <*> Toml.dioptional (Toml.table fileTelegramConfigCodec "telegram") .= _fc_telegram
98 <*> Toml.dioptional (Toml.text "reasoning_effort") .= _fc_reasoningEffort
99 <*> Toml.dioptional (Toml.int "max_turns") .= _fc_maxTurns
100 <*> Toml.dioptional (Toml.text "timezone") .= _fc_timezone
101 <*> Toml.dioptional (Toml.text "base_url") .= _fc_baseUrl
102 <*> Toml.dioptional (Toml.text "vault_path") .= _fc_vault_path
103 <*> Toml.dioptional (Toml.text "vault_recipient") .= _fc_vault_recipient
104 <*> Toml.dioptional (Toml.text "vault_identity") .= _fc_vault_identity
105 <*> Toml.dioptional (Toml.text "vault_unlock") .= _fc_vault_unlock
106 <*> Toml.dioptional (Toml.text "default_agent") .= _fc_defaultAgent
107 <*> Toml.dioptional (Toml.int "agent_truncate_limit") .= _fc_agentTruncateLimit
108
109 fileSignalConfigCodec :: TomlCodec FileSignalConfig
110 fileSignalConfigCodec = FileSignalConfig
111 <$> Toml.dioptional (Toml.text "account") .= _fsc_account
112 <*> Toml.dioptional (Toml.text "dm_policy") .= _fsc_dmPolicy
113 <*> Toml.dioptional (Toml.arrayOf Toml._Text "allow_from") .= _fsc_allowFrom
114 <*> Toml.dioptional (Toml.int "text_chunk_limit") .= _fsc_textChunkLimit
115
116 fileTelegramConfigCodec :: TomlCodec FileTelegramConfig
117 fileTelegramConfigCodec = FileTelegramConfig
118 <$> Toml.dioptional (Toml.text "bot_token") .= _ftc_botToken
119 <*> Toml.dioptional (Toml.text "dm_policy") .= _ftc_dmPolicy
120 <*> Toml.dioptional (Toml.arrayOf Toml._Text "allow_from") .= _ftc_allowFrom
121
122 -- | Load config from a single file path.
123 -- Returns 'emptyFileConfig' if the file does not exist or cannot be parsed.
124 loadFileConfig :: FilePath -> IO FileConfig
125 loadFileConfig path = do
126 text <- try @IOError (TIO.readFile path)
127 pure $ case text of
128 Left _ -> emptyFileConfig
129 Right toml -> case Toml.decode fileConfigCodec toml of
130 Left _ -> emptyFileConfig
131 Right c -> c
132
133 -- | The PureClaw home directory: @~\/.pureclaw@.
134 -- This is where config, memory, and vault files are stored by default.
135 getPureclawDir :: IO FilePath
136 getPureclawDir = do
137 home <- getHomeDirectory
138 pure (home </> ".pureclaw")
139
140 -- | Load config from the default locations, trying each in order:
141 --
142 -- 1. @~\/.pureclaw\/config.toml@ (user home)
143 -- 2. @~\/.config\/pureclaw\/config.toml@ (XDG fallback)
144 --
145 -- Returns the first config found, or 'emptyFileConfig' if none exists.
146 loadConfig :: IO FileConfig
147 loadConfig = configFileConfig <$> loadConfigDiag
148
149 -- | Result of attempting to load a config file.
150 data ConfigLoadResult
151 = ConfigLoaded FilePath FileConfig -- ^ File found and parsed successfully
152 | ConfigParseError FilePath Text -- ^ File exists but contains invalid TOML
153 | ConfigFileNotFound FilePath -- ^ Specific file was not found
154 | ConfigNotFound [FilePath] -- ^ No config found at any default location
155 deriving stock (Show, Eq)
156
157 -- | Extract the 'FileConfig' from a result, defaulting to 'emptyFileConfig' on error.
158 configFileConfig :: ConfigLoadResult -> FileConfig
159 configFileConfig (ConfigLoaded _ fc) = fc
160 configFileConfig (ConfigParseError _ _) = emptyFileConfig
161 configFileConfig (ConfigFileNotFound _) = emptyFileConfig
162 configFileConfig (ConfigNotFound _) = emptyFileConfig
163
164 -- | Load config from a single file, returning diagnostic information.
165 -- Unlike 'loadFileConfig', parse errors are not silently discarded.
166 loadFileConfigDiag :: FilePath -> IO ConfigLoadResult
167 loadFileConfigDiag path = do
168 text <- try @IOError (TIO.readFile path)
169 pure $ case text of
170 Left _ -> ConfigFileNotFound path
171 Right toml -> case Toml.decode fileConfigCodec toml of
172 Left errs -> ConfigParseError path (Toml.prettyTomlDecodeErrors errs)
173 Right c -> ConfigLoaded path c
174
175 -- | Load config from default locations with diagnostics.
176 -- Stops at the first file that exists (even if it has errors).
177 loadConfigDiag :: IO ConfigLoadResult
178 loadConfigDiag = do
179 home <- try @IOError getHomeDirectory
180 case home of
181 Left _ -> pure (ConfigNotFound [])
182 Right h -> do
183 let homePath = h </> ".pureclaw" </> "config.toml"
184 xdgPath = h </> ".config" </> "pureclaw" </> "config.toml"
185 homeResult <- loadFileConfigDiag homePath
186 case homeResult of
187 ConfigFileNotFound _ -> do
188 xdgResult <- loadFileConfigDiag xdgPath
189 case xdgResult of
190 ConfigFileNotFound _ -> pure (ConfigNotFound [homePath, xdgPath])
191 _ -> pure xdgResult
192 _ -> pure homeResult
193
194 -- | Write a complete 'FileConfig' to a TOML file.
195 -- Overwrites the file entirely. Creates the file if it does not exist.
196 writeFileConfig :: FilePath -> FileConfig -> IO ()
197 writeFileConfig path cfg = TIO.writeFile path (Toml.encode fileConfigCodec cfg)
198
199 -- | Three-valued update: set a new value, clear the field, or keep the existing value.
200 data FieldUpdate a
201 = Set a -- ^ Replace with this value
202 | Clear -- ^ Remove the field (set to Nothing)
203 | Keep -- ^ Leave the existing value unchanged
204 deriving stock (Show, Eq)
205
206 -- | Apply a 'FieldUpdate' to an existing 'Maybe' value.
207 applyUpdate :: FieldUpdate a -> Maybe a -> Maybe a
208 applyUpdate (Set x) _ = Just x
209 applyUpdate Clear _ = Nothing
210 applyUpdate Keep v = v
211
212 -- | Update vault-related fields in a config file, preserving all other settings.
213 -- 'Keep' means "leave this field unchanged", 'Clear' means "remove the field",
214 -- 'Set' means "replace with this value".
215 -- If all four arguments are 'Keep', this is a no-op (no file write occurs).
216 updateVaultConfig
217 :: FilePath -- ^ Config file path
218 -> FieldUpdate Text -- ^ vault_path
219 -> FieldUpdate Text -- ^ vault_recipient
220 -> FieldUpdate Text -- ^ vault_identity
221 -> FieldUpdate Text -- ^ vault_unlock
222 -> IO ()
223 updateVaultConfig _ Keep Keep Keep Keep = pure ()
224 updateVaultConfig path vaultPath vaultRecipient vaultIdentity vaultUnlock = do
225 existing <- loadFileConfig path
226 let updated = existing
227 { _fc_vault_path = applyUpdate vaultPath (_fc_vault_path existing)
228 , _fc_vault_recipient = applyUpdate vaultRecipient (_fc_vault_recipient existing)
229 , _fc_vault_identity = applyUpdate vaultIdentity (_fc_vault_identity existing)
230 , _fc_vault_unlock = applyUpdate vaultUnlock (_fc_vault_unlock existing)
231 }
232 TIO.writeFile path (Toml.encode fileConfigCodec updated)