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