never executed always true always false
1 module PureClaw.CLI.Config
2 ( -- * File config
3 FileConfig (..)
4 , emptyFileConfig
5 -- * Loading
6 , loadFileConfig
7 , loadConfig
8 -- * Diagnostic loading
9 , ConfigLoadResult (..)
10 , loadFileConfigDiag
11 , loadConfigDiag
12 , configFileConfig
13 -- * Writing
14 , updateVaultConfig
15 -- * Directory helpers
16 , getPureclawDir
17 ) where
18
19 import Control.Applicative ((<|>))
20 import Control.Exception
21 import Data.Text (Text)
22 import Data.Text.IO qualified as TIO
23 import System.Directory (getHomeDirectory)
24 import System.FilePath ((</>))
25 import Toml (TomlCodec, (.=))
26 import Toml qualified
27
28 -- | Configuration that can be read from a TOML file.
29 -- All fields are optional — missing fields default to Nothing.
30 data FileConfig = FileConfig
31 { _fc_apiKey :: Maybe Text
32 , _fc_model :: Maybe Text
33 , _fc_provider :: Maybe Text
34 , _fc_system :: Maybe Text
35 , _fc_memory :: Maybe Text
36 , _fc_allow :: Maybe [Text]
37 , _fc_vault_path :: Maybe Text -- ^ vault file path (default: ~/.pureclaw/vault.age)
38 , _fc_vault_recipient :: Maybe Text -- ^ age recipient string (required to enable vault)
39 , _fc_vault_identity :: Maybe Text -- ^ age identity path or plugin string
40 , _fc_vault_unlock :: Maybe Text -- ^ "startup", "on_demand", or "per_access"
41 } deriving stock (Show, Eq)
42
43 emptyFileConfig :: FileConfig
44 emptyFileConfig =
45 FileConfig Nothing Nothing Nothing Nothing Nothing Nothing
46 Nothing Nothing Nothing Nothing
47
48 fileConfigCodec :: TomlCodec FileConfig
49 fileConfigCodec = FileConfig
50 <$> Toml.dioptional (Toml.text "api_key") .= _fc_apiKey
51 <*> Toml.dioptional (Toml.text "model") .= _fc_model
52 <*> Toml.dioptional (Toml.text "provider") .= _fc_provider
53 <*> Toml.dioptional (Toml.text "system") .= _fc_system
54 <*> Toml.dioptional (Toml.text "memory") .= _fc_memory
55 <*> Toml.dioptional (Toml.arrayOf Toml._Text "allow") .= _fc_allow
56 <*> Toml.dioptional (Toml.text "vault_path") .= _fc_vault_path
57 <*> Toml.dioptional (Toml.text "vault_recipient") .= _fc_vault_recipient
58 <*> Toml.dioptional (Toml.text "vault_identity") .= _fc_vault_identity
59 <*> Toml.dioptional (Toml.text "vault_unlock") .= _fc_vault_unlock
60
61 -- | Load config from a single file path.
62 -- Returns 'emptyFileConfig' if the file does not exist or cannot be parsed.
63 loadFileConfig :: FilePath -> IO FileConfig
64 loadFileConfig path = do
65 text <- try @IOError (TIO.readFile path)
66 pure $ case text of
67 Left _ -> emptyFileConfig
68 Right toml -> case Toml.decode fileConfigCodec toml of
69 Left _ -> emptyFileConfig
70 Right c -> c
71
72 -- | The PureClaw home directory: @~\/.pureclaw@.
73 -- This is where config, memory, and vault files are stored by default.
74 getPureclawDir :: IO FilePath
75 getPureclawDir = do
76 home <- getHomeDirectory
77 pure (home </> ".pureclaw")
78
79 -- | Load config from the default locations, trying each in order:
80 --
81 -- 1. @~\/.pureclaw\/config.toml@ (user home)
82 -- 2. @~\/.config\/pureclaw\/config.toml@ (XDG fallback)
83 --
84 -- Returns the first config found, or 'emptyFileConfig' if none exists.
85 loadConfig :: IO FileConfig
86 loadConfig = configFileConfig <$> loadConfigDiag
87
88 -- | Result of attempting to load a config file.
89 data ConfigLoadResult
90 = ConfigLoaded FilePath FileConfig -- ^ File found and parsed successfully
91 | ConfigParseError FilePath Text -- ^ File exists but contains invalid TOML
92 | ConfigFileNotFound FilePath -- ^ Specific file was not found
93 | ConfigNotFound [FilePath] -- ^ No config found at any default location
94 deriving stock (Show, Eq)
95
96 -- | Extract the 'FileConfig' from a result, defaulting to 'emptyFileConfig' on error.
97 configFileConfig :: ConfigLoadResult -> FileConfig
98 configFileConfig (ConfigLoaded _ fc) = fc
99 configFileConfig (ConfigParseError _ _) = emptyFileConfig
100 configFileConfig (ConfigFileNotFound _) = emptyFileConfig
101 configFileConfig (ConfigNotFound _) = emptyFileConfig
102
103 -- | Load config from a single file, returning diagnostic information.
104 -- Unlike 'loadFileConfig', parse errors are not silently discarded.
105 loadFileConfigDiag :: FilePath -> IO ConfigLoadResult
106 loadFileConfigDiag path = do
107 text <- try @IOError (TIO.readFile path)
108 pure $ case text of
109 Left _ -> ConfigFileNotFound path
110 Right toml -> case Toml.decode fileConfigCodec toml of
111 Left errs -> ConfigParseError path (Toml.prettyTomlDecodeErrors errs)
112 Right c -> ConfigLoaded path c
113
114 -- | Load config from default locations with diagnostics.
115 -- Stops at the first file that exists (even if it has errors).
116 loadConfigDiag :: IO ConfigLoadResult
117 loadConfigDiag = do
118 home <- try @IOError getHomeDirectory
119 case home of
120 Left _ -> pure (ConfigNotFound [])
121 Right h -> do
122 let homePath = h </> ".pureclaw" </> "config.toml"
123 xdgPath = h </> ".config" </> "pureclaw" </> "config.toml"
124 homeResult <- loadFileConfigDiag homePath
125 case homeResult of
126 ConfigFileNotFound _ -> do
127 xdgResult <- loadFileConfigDiag xdgPath
128 case xdgResult of
129 ConfigFileNotFound _ -> pure (ConfigNotFound [homePath, xdgPath])
130 _ -> pure xdgResult
131 _ -> pure homeResult
132
133 -- | Update vault-related fields in a config file, preserving all other settings.
134 -- 'Nothing' means "leave this field unchanged". If all four arguments are
135 -- 'Nothing', this is a no-op (no file write occurs).
136 updateVaultConfig
137 :: FilePath -- ^ Config file path
138 -> Maybe Text -- ^ vault_path
139 -> Maybe Text -- ^ vault_recipient
140 -> Maybe Text -- ^ vault_identity
141 -> Maybe Text -- ^ vault_unlock
142 -> IO ()
143 updateVaultConfig _ Nothing Nothing Nothing Nothing = pure ()
144 updateVaultConfig path vaultPath vaultRecipient vaultIdentity vaultUnlock = do
145 existing <- loadFileConfig path
146 let updated = existing
147 { _fc_vault_path = vaultPath <|> _fc_vault_path existing
148 , _fc_vault_recipient = vaultRecipient -- Direct: Nothing clears stale age creds
149 , _fc_vault_identity = vaultIdentity -- Direct: Nothing clears stale age creds
150 , _fc_vault_unlock = vaultUnlock <|> _fc_vault_unlock existing
151 }
152 TIO.writeFile path (Toml.encode fileConfigCodec updated)