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