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     -- * Writing
    9   , updateVaultConfig
   10     -- * Directory helpers
   11   , getPureclawDir
   12   ) where
   13 
   14 import Control.Applicative ((<|>))
   15 import Control.Exception
   16 import Data.Text (Text)
   17 import Data.Text.IO qualified as TIO
   18 import System.Directory (getHomeDirectory)
   19 import System.FilePath ((</>))
   20 import Toml (TomlCodec, (.=))
   21 import Toml qualified
   22 
   23 -- | Configuration that can be read from a TOML file.
   24 -- All fields are optional — missing fields default to Nothing.
   25 data FileConfig = FileConfig
   26   { _fc_apiKey         :: Maybe Text
   27   , _fc_model          :: Maybe Text
   28   , _fc_provider       :: Maybe Text
   29   , _fc_system         :: Maybe Text
   30   , _fc_memory         :: Maybe Text
   31   , _fc_allow          :: Maybe [Text]
   32   , _fc_vault_path      :: Maybe Text  -- ^ vault file path (default: ~/.pureclaw/vault.age)
   33   , _fc_vault_recipient :: Maybe Text  -- ^ age recipient string (required to enable vault)
   34   , _fc_vault_identity  :: Maybe Text  -- ^ age identity path or plugin string
   35   , _fc_vault_unlock    :: Maybe Text  -- ^ "startup", "on_demand", or "per_access"
   36   } deriving stock (Show, Eq)
   37 
   38 emptyFileConfig :: FileConfig
   39 emptyFileConfig =
   40   FileConfig Nothing Nothing Nothing Nothing Nothing Nothing
   41              Nothing Nothing Nothing Nothing
   42 
   43 fileConfigCodec :: TomlCodec FileConfig
   44 fileConfigCodec = FileConfig
   45   <$> Toml.dioptional (Toml.text "api_key")                   .= _fc_apiKey
   46   <*> Toml.dioptional (Toml.text "model")                     .= _fc_model
   47   <*> Toml.dioptional (Toml.text "provider")                  .= _fc_provider
   48   <*> Toml.dioptional (Toml.text "system")                    .= _fc_system
   49   <*> Toml.dioptional (Toml.text "memory")                    .= _fc_memory
   50   <*> Toml.dioptional (Toml.arrayOf Toml._Text "allow")       .= _fc_allow
   51   <*> Toml.dioptional (Toml.text "vault_path")                .= _fc_vault_path
   52   <*> Toml.dioptional (Toml.text "vault_recipient")           .= _fc_vault_recipient
   53   <*> Toml.dioptional (Toml.text "vault_identity")            .= _fc_vault_identity
   54   <*> Toml.dioptional (Toml.text "vault_unlock")              .= _fc_vault_unlock
   55 
   56 -- | Load config from a single file path.
   57 -- Returns 'emptyFileConfig' if the file does not exist or cannot be parsed.
   58 loadFileConfig :: FilePath -> IO FileConfig
   59 loadFileConfig path = do
   60   text <- try @IOError (TIO.readFile path)
   61   pure $ case text of
   62     Left  _    -> emptyFileConfig
   63     Right toml -> case Toml.decode fileConfigCodec toml of
   64       Left  _ -> emptyFileConfig
   65       Right c -> c
   66 
   67 -- | The PureClaw home directory: @~\/.pureclaw@.
   68 -- This is where config, memory, and vault files are stored by default.
   69 getPureclawDir :: IO FilePath
   70 getPureclawDir = do
   71   home <- getHomeDirectory
   72   pure (home </> ".pureclaw")
   73 
   74 -- | Load config from the default locations, trying each in order:
   75 --
   76 -- 1. @~\/.pureclaw\/config.toml@ (user home)
   77 -- 2. @~\/.config\/pureclaw\/config.toml@ (XDG fallback)
   78 --
   79 -- Returns the first config found, or 'emptyFileConfig' if none exists.
   80 loadConfig :: IO FileConfig
   81 loadConfig = do
   82   home <- try @IOError getHomeDirectory
   83   case home of
   84     Left  _ -> pure emptyFileConfig
   85     Right h -> do
   86       homeCfg <- loadFileConfig (h </> ".pureclaw" </> "config.toml")
   87       if homeCfg /= emptyFileConfig
   88         then pure homeCfg
   89         else loadFileConfig (h </> ".config" </> "pureclaw" </> "config.toml")
   90 
   91 -- | Update vault-related fields in a config file, preserving all other settings.
   92 -- 'Nothing' means "leave this field unchanged". If all four arguments are
   93 -- 'Nothing', this is a no-op (no file write occurs).
   94 updateVaultConfig
   95   :: FilePath    -- ^ Config file path
   96   -> Maybe Text  -- ^ vault_path
   97   -> Maybe Text  -- ^ vault_recipient
   98   -> Maybe Text  -- ^ vault_identity
   99   -> Maybe Text  -- ^ vault_unlock
  100   -> IO ()
  101 updateVaultConfig _ Nothing Nothing Nothing Nothing = pure ()
  102 updateVaultConfig path vaultPath vaultRecipient vaultIdentity vaultUnlock = do
  103   existing <- loadFileConfig path
  104   let updated = existing
  105         { _fc_vault_path      = vaultPath      <|> _fc_vault_path existing
  106         , _fc_vault_recipient = vaultRecipient  -- Direct: Nothing clears stale age creds
  107         , _fc_vault_identity  = vaultIdentity   -- Direct: Nothing clears stale age creds
  108         , _fc_vault_unlock    = vaultUnlock     <|> _fc_vault_unlock existing
  109         }
  110   TIO.writeFile path (Toml.encode fileConfigCodec updated)