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 } deriving stock (Show, Eq)
55
56 -- | Signal channel configuration from the @[signal]@ TOML table.
57 data FileSignalConfig = FileSignalConfig
58 { _fsc_account :: Maybe Text -- ^ E.164 phone number
59 , _fsc_dmPolicy :: Maybe Text -- ^ "pairing", "allowlist", "open", "disabled"
60 , _fsc_allowFrom :: Maybe [Text] -- ^ E.164 numbers or UUIDs
61 , _fsc_textChunkLimit :: Maybe Int -- ^ Max chars per message (default: 6000)
62 } deriving stock (Show, Eq)
63
64 emptyFileConfig :: FileConfig
65 emptyFileConfig =
66 FileConfig Nothing Nothing Nothing Nothing Nothing Nothing
67 Nothing Nothing Nothing Nothing Nothing Nothing Nothing
68 Nothing Nothing Nothing Nothing Nothing
69
70 emptyFileSignalConfig :: FileSignalConfig
71 emptyFileSignalConfig = FileSignalConfig Nothing Nothing Nothing Nothing
72
73 -- | Telegram channel configuration from the @[telegram]@ TOML table.
74 data FileTelegramConfig = FileTelegramConfig
75 { _ftc_botToken :: Maybe Text -- ^ Bot API token
76 , _ftc_dmPolicy :: Maybe Text -- ^ "pairing", "allowlist", "open", "disabled"
77 , _ftc_allowFrom :: Maybe [Text] -- ^ Allowed usernames or IDs
78 } deriving stock (Show, Eq)
79
80 emptyFileTelegramConfig :: FileTelegramConfig
81 emptyFileTelegramConfig = FileTelegramConfig Nothing Nothing Nothing
82
83 fileConfigCodec :: TomlCodec FileConfig
84 fileConfigCodec = FileConfig
85 <$> Toml.dioptional (Toml.text "api_key") .= _fc_apiKey
86 <*> Toml.dioptional (Toml.text "model") .= _fc_model
87 <*> Toml.dioptional (Toml.text "provider") .= _fc_provider
88 <*> Toml.dioptional (Toml.text "system") .= _fc_system
89 <*> Toml.dioptional (Toml.text "memory") .= _fc_memory
90 <*> Toml.dioptional (Toml.arrayOf Toml._Text "allow") .= _fc_allow
91 <*> Toml.dioptional (Toml.text "autonomy") .= _fc_autonomy
92 <*> Toml.dioptional (Toml.text "default_channel") .= _fc_defaultChannel
93 <*> Toml.dioptional (Toml.table fileSignalConfigCodec "signal") .= _fc_signal
94 <*> Toml.dioptional (Toml.table fileTelegramConfigCodec "telegram") .= _fc_telegram
95 <*> Toml.dioptional (Toml.text "reasoning_effort") .= _fc_reasoningEffort
96 <*> Toml.dioptional (Toml.int "max_turns") .= _fc_maxTurns
97 <*> Toml.dioptional (Toml.text "timezone") .= _fc_timezone
98 <*> Toml.dioptional (Toml.text "base_url") .= _fc_baseUrl
99 <*> Toml.dioptional (Toml.text "vault_path") .= _fc_vault_path
100 <*> Toml.dioptional (Toml.text "vault_recipient") .= _fc_vault_recipient
101 <*> Toml.dioptional (Toml.text "vault_identity") .= _fc_vault_identity
102 <*> Toml.dioptional (Toml.text "vault_unlock") .= _fc_vault_unlock
103
104 fileSignalConfigCodec :: TomlCodec FileSignalConfig
105 fileSignalConfigCodec = FileSignalConfig
106 <$> Toml.dioptional (Toml.text "account") .= _fsc_account
107 <*> Toml.dioptional (Toml.text "dm_policy") .= _fsc_dmPolicy
108 <*> Toml.dioptional (Toml.arrayOf Toml._Text "allow_from") .= _fsc_allowFrom
109 <*> Toml.dioptional (Toml.int "text_chunk_limit") .= _fsc_textChunkLimit
110
111 fileTelegramConfigCodec :: TomlCodec FileTelegramConfig
112 fileTelegramConfigCodec = FileTelegramConfig
113 <$> Toml.dioptional (Toml.text "bot_token") .= _ftc_botToken
114 <*> Toml.dioptional (Toml.text "dm_policy") .= _ftc_dmPolicy
115 <*> Toml.dioptional (Toml.arrayOf Toml._Text "allow_from") .= _ftc_allowFrom
116
117 -- | Load config from a single file path.
118 -- Returns 'emptyFileConfig' if the file does not exist or cannot be parsed.
119 loadFileConfig :: FilePath -> IO FileConfig
120 loadFileConfig path = do
121 text <- try @IOError (TIO.readFile path)
122 pure $ case text of
123 Left _ -> emptyFileConfig
124 Right toml -> case Toml.decode fileConfigCodec toml of
125 Left _ -> emptyFileConfig
126 Right c -> c
127
128 -- | The PureClaw home directory: @~\/.pureclaw@.
129 -- This is where config, memory, and vault files are stored by default.
130 getPureclawDir :: IO FilePath
131 getPureclawDir = do
132 home <- getHomeDirectory
133 pure (home </> ".pureclaw")
134
135 -- | Load config from the default locations, trying each in order:
136 --
137 -- 1. @~\/.pureclaw\/config.toml@ (user home)
138 -- 2. @~\/.config\/pureclaw\/config.toml@ (XDG fallback)
139 --
140 -- Returns the first config found, or 'emptyFileConfig' if none exists.
141 loadConfig :: IO FileConfig
142 loadConfig = configFileConfig <$> loadConfigDiag
143
144 -- | Result of attempting to load a config file.
145 data ConfigLoadResult
146 = ConfigLoaded FilePath FileConfig -- ^ File found and parsed successfully
147 | ConfigParseError FilePath Text -- ^ File exists but contains invalid TOML
148 | ConfigFileNotFound FilePath -- ^ Specific file was not found
149 | ConfigNotFound [FilePath] -- ^ No config found at any default location
150 deriving stock (Show, Eq)
151
152 -- | Extract the 'FileConfig' from a result, defaulting to 'emptyFileConfig' on error.
153 configFileConfig :: ConfigLoadResult -> FileConfig
154 configFileConfig (ConfigLoaded _ fc) = fc
155 configFileConfig (ConfigParseError _ _) = emptyFileConfig
156 configFileConfig (ConfigFileNotFound _) = emptyFileConfig
157 configFileConfig (ConfigNotFound _) = emptyFileConfig
158
159 -- | Load config from a single file, returning diagnostic information.
160 -- Unlike 'loadFileConfig', parse errors are not silently discarded.
161 loadFileConfigDiag :: FilePath -> IO ConfigLoadResult
162 loadFileConfigDiag path = do
163 text <- try @IOError (TIO.readFile path)
164 pure $ case text of
165 Left _ -> ConfigFileNotFound path
166 Right toml -> case Toml.decode fileConfigCodec toml of
167 Left errs -> ConfigParseError path (Toml.prettyTomlDecodeErrors errs)
168 Right c -> ConfigLoaded path c
169
170 -- | Load config from default locations with diagnostics.
171 -- Stops at the first file that exists (even if it has errors).
172 loadConfigDiag :: IO ConfigLoadResult
173 loadConfigDiag = do
174 home <- try @IOError getHomeDirectory
175 case home of
176 Left _ -> pure (ConfigNotFound [])
177 Right h -> do
178 let homePath = h </> ".pureclaw" </> "config.toml"
179 xdgPath = h </> ".config" </> "pureclaw" </> "config.toml"
180 homeResult <- loadFileConfigDiag homePath
181 case homeResult of
182 ConfigFileNotFound _ -> do
183 xdgResult <- loadFileConfigDiag xdgPath
184 case xdgResult of
185 ConfigFileNotFound _ -> pure (ConfigNotFound [homePath, xdgPath])
186 _ -> pure xdgResult
187 _ -> pure homeResult
188
189 -- | Write a complete 'FileConfig' to a TOML file.
190 -- Overwrites the file entirely. Creates the file if it does not exist.
191 writeFileConfig :: FilePath -> FileConfig -> IO ()
192 writeFileConfig path cfg = TIO.writeFile path (Toml.encode fileConfigCodec cfg)
193
194 -- | Three-valued update: set a new value, clear the field, or keep the existing value.
195 data FieldUpdate a
196 = Set a -- ^ Replace with this value
197 | Clear -- ^ Remove the field (set to Nothing)
198 | Keep -- ^ Leave the existing value unchanged
199 deriving stock (Show, Eq)
200
201 -- | Apply a 'FieldUpdate' to an existing 'Maybe' value.
202 applyUpdate :: FieldUpdate a -> Maybe a -> Maybe a
203 applyUpdate (Set x) _ = Just x
204 applyUpdate Clear _ = Nothing
205 applyUpdate Keep v = v
206
207 -- | Update vault-related fields in a config file, preserving all other settings.
208 -- 'Keep' means "leave this field unchanged", 'Clear' means "remove the field",
209 -- 'Set' means "replace with this value".
210 -- If all four arguments are 'Keep', this is a no-op (no file write occurs).
211 updateVaultConfig
212 :: FilePath -- ^ Config file path
213 -> FieldUpdate Text -- ^ vault_path
214 -> FieldUpdate Text -- ^ vault_recipient
215 -> FieldUpdate Text -- ^ vault_identity
216 -> FieldUpdate Text -- ^ vault_unlock
217 -> IO ()
218 updateVaultConfig _ Keep Keep Keep Keep = pure ()
219 updateVaultConfig path vaultPath vaultRecipient vaultIdentity vaultUnlock = do
220 existing <- loadFileConfig path
221 let updated = existing
222 { _fc_vault_path = applyUpdate vaultPath (_fc_vault_path existing)
223 , _fc_vault_recipient = applyUpdate vaultRecipient (_fc_vault_recipient existing)
224 , _fc_vault_identity = applyUpdate vaultIdentity (_fc_vault_identity existing)
225 , _fc_vault_unlock = applyUpdate vaultUnlock (_fc_vault_unlock existing)
226 }
227 TIO.writeFile path (Toml.encode fileConfigCodec updated)