Allow overriding environment files to load

app/Main.hs

@@ -184,7 +184,8 @@ vaultRetryPolicy opts = Retry.fullJitterBackoff (unMilliSeconds (oRetryBaseDelay
 main :: IO ()
 main = do
   localEnvVars <- getEnvironment
-  envFileSettings <- readConfigFromEnvFiles
+
+  envFileSettings <- readConfigFromEnvFiles Nothing
 
   -- Deduplicate, give precedence to set env vars over .env files
   let envAndEnvFileConfig = nubBy (\(x, _) (y, _) -> x == y) (localEnvVars ++ envFileSettings)

src/Config.hs

@@ -18,18 +18,20 @@ module Config
 
 import Control.Applicative ((<*>), (<|>))
 import Data.List (intercalate, nubBy)
-import Data.Maybe (fromJust)
 import Data.Monoid ((<>))
 import Data.Version (showVersion)
+import Data.Void (Void)
 import Options.Applicative (value, long, auto, option, metavar, help, flag,
-                            str, argument, many, strOption)
+                            str, argument, many, strOption, maybeReader)
 import Paths_vaultenv (version) -- Magic to get the version field from cabal.
 import System.IO.Error (catchIOError)
 
 import qualified Configuration.Dotenv as DotEnv
 import qualified Options.Applicative as OptParse
 import qualified System.Directory as Dir
 import qualified Text.Read as Read
+import qualified Text.Megaparsec as MP
+import qualified Text.Megaparsec.Char as MPC
 
 -- | Type alias for enviornment variables, used for readability in this module.
 type EnvVar = (String, String)
@@ -54,6 +56,7 @@ data Options = Options
   , oRetryAttempts   :: Int
   , oLogLevel        :: LogLevel
   , oUsePath         :: Bool
+  , oConfigFiles     :: [FilePath]
   } deriving (Eq)
 
 instance Show Options where
@@ -71,6 +74,7 @@ instance Show Options where
     , "Retry attempts: " ++ (show $ oRetryAttempts opts)
     , "Log-level:      " ++ (show $ oLogLevel opts)
     , "Use PATH:       " ++ (show $ oUsePath opts)
+    , "Config files:   " ++ (show $ oConfigFiles opts)
     ]
 
 -- | Behavior flags that we allow users to set via environment variables.
@@ -102,10 +106,11 @@ instance Read LogLevel where
 
 -- | Parse program options from the command line and the process environment.
 parseOptionsFromEnvAndCli :: [EnvVar] -> IO Options
-parseOptionsFromEnvAndCli envVars =
+parseOptionsFromEnvAndCli envVars = do
+  defaultConfigFiles <- defaultEnvFiles
   let envFlags = parseEnvFlags envVars
-      parser = optionsParserWithInfo envFlags envVars
-  in OptParse.execParser parser
+      parser = optionsParserWithInfo envFlags defaultConfigFiles envVars
+  OptParse.execParser parser
 
 -- | Parses behavior flags from a list of environment variables. If an
 -- environment variable corresponding to the flag is set to @"true"@ or
@@ -131,10 +136,10 @@ parseEnvFlags envVars
 
 -- | This function adds metadata to the @Options@ parser so it can be used with
 -- execParser.
-optionsParserWithInfo :: EnvFlags -> [EnvVar] -> OptParse.ParserInfo Options
-optionsParserWithInfo envFlags localEnvVars =
+optionsParserWithInfo :: EnvFlags -> [FilePath] -> [EnvVar] -> OptParse.ParserInfo Options
+optionsParserWithInfo envFlags defaultConfigFiles localEnvVars =
   OptParse.info
-    (OptParse.helper <*> versionOption <*> optionsParser envFlags localEnvVars)
+    (OptParse.helper <*> versionOption <*> optionsParser envFlags defaultConfigFiles localEnvVars)
     (OptParse.fullDesc <> OptParse.header header)
   where
     versionOption = OptParse.infoOption (showVersion version) (long "version" <> help "Show version")
@@ -193,8 +198,8 @@ optionsParserWithInfo envFlags localEnvVars =
 -- the default values of the different behaviour switches. So, if an
 -- environment variable is used to configure the TLS option, that value will
 -- always be used, except if it is overridden on the CLI.
-optionsParser :: EnvFlags -> [EnvVar] -> OptParse.Parser Options
-optionsParser envFlags envVars = Options
+optionsParser :: EnvFlags -> [FilePath] -> [EnvVar] -> OptParse.Parser Options
+optionsParser envFlags defaultConfigFiles envVars= Options
     <$> host
     <*> port
     <*> token
@@ -208,6 +213,7 @@ optionsParser envFlags envVars = Options
     <*> retryAttempts
     <*> logLevel
     <*> usePath
+    <*> configFiles
   where
     host
       =  strOption
@@ -300,6 +306,14 @@ optionsParser envFlags envVars = Options
       <> help ("Use PATH for finding the executable that vaultenv should call. Default: " ++
               "don't search PATH. Also configurable via VAULTENV_USE_PATH.")
 
+    configFiles
+      =    option (maybeReader (MP.parseMaybe listParser))
+        $  long "config-files"
+        <> listFromEnvWithDefault "VAULTENV_CONFIG_FILES" defaultConfigFiles envVars
+        <> help ("Override the list of config files to load. Default: " ++
+                 "'/etc/vaultenv.conf,~/.config/vaultenv/vaultenv.conf,.env'. " ++
+                 "Also configurable via VAULTENV_CONFIG_FILES.")
+
 
 -- | Specialization of @readValueFromEnv@ that does not use a @Read@ instance.
 -- This is useful for "plain" string values, so the user does not have to
@@ -343,43 +357,82 @@ readValueFromEnvWithDefault key defVal envVars
   =  value defVal
   <> readValueFromEnv key envVars
 
--- | Search for environment files in default locations and load them in order.
+-- | Variant of 'readValueFromEnv' that parses a comma-separated list.
+listFromEnv :: (OptParse.HasValue f)
+            => String
+            -> [EnvVar]
+            -> OptParse.Mod f [String]
+listFromEnv key envVars =
+  let parseResult = lookup key envVars >>= MP.parseMaybe listParser
+  in foldMap value parseResult
+
+-- | Variant of 'readValueFromEnvWithDefault' for comma-separated lists.
+listFromEnvWithDefault :: (OptParse.HasValue f)
+                       => String
+                       -> [String]
+                       -> [EnvVar]
+                       -> OptParse.Mod f [String]
+listFromEnvWithDefault key defVal envVars = value defVal <> listFromEnv key envVars
+
+-- | Megaparsec parser to parse a list of comma-separated strings
+listParser :: MP.Parsec Void String [String]
+listParser = many (MPC.satisfy (/= ',')) `MP.sepBy1` MPC.char ','
+
+-- | Return the list of default configuration files to read.
+-- This list consists of the following:
+--
+--   - @\/etc\/vaultenv.conf@ (the machine config file),
+--   - @$XDG_CONFIG_HOME\/vaultenv\/vaultenv.conf@ (the user config file, if
+--   the XDG config directory exists), and
+--   - @$CWD\/.env@ (the local config file).
 --
--- This function tries to read the following files in order to obtain
--- environment configuration. This is implicit behavior and allows the user to
--- configure vaultenv without setting up environment variables or passing CLI
--- flags. This is nicer for interactive usage.
-readConfigFromEnvFiles :: IO [(String, String)]
-readConfigFromEnvFiles = do
+-- The returned paths are absolute.
+defaultEnvFiles :: IO [FilePath]
+defaultEnvFiles = do
   xdgDir <- (Just <$> Dir.getXdgDirectory Dir.XdgConfig "vaultenv")
-    `catchIOError` (const $ pure Nothing)
+    `catchIOError` const (pure Nothing)
+
   cwd <- Dir.getCurrentDirectory
+
   let
+    machineConfigFile, cwdConfigFile :: FilePath
     machineConfigFile = "/etc/vaultenv.conf"
-
-    userConfigFile :: Maybe FilePath
-    userConfigFile = fmap (++ "/vaultenv.conf") xdgDir
     cwdConfigFile = cwd ++ "/.env"
 
-  -- @doesFileExist@ doesn't throw exceptions, it catches @IOError@s and
-  -- returns @False@ if those are encountered.
-  machineConfigExists <- Dir.doesFileExist machineConfigFile
-  machineConfig <- if machineConfigExists
-    then DotEnv.parseFile machineConfigFile
-    else pure []
+  case xdgDir of
+    Nothing -> return [machineConfigFile, cwdConfigFile]
+    Just dir -> return [machineConfigFile, dir ++ "/vaultenv.conf", cwdConfigFile]
 
-  userConfigExists <- case userConfigFile of
-     Nothing -> pure False
-     Just fp -> Dir.doesFileExist fp
-  userConfig <- if userConfigExists
-    then DotEnv.parseFile (fromJust userConfigFile) -- safe because of loadUserConfig
-    else pure []
+-- | Either search for environment files in the default locations or load a set of
+-- already given environment files.
+--
+-- If given a list of file paths to load, this function will load them using
+-- 'readEnvFiles' and return the result.
+-- Otherwise, it attempts to load configuration files from the default
+-- locations defined by 'defaultEnvFiles'.
+readConfigFromEnvFiles :: Maybe [FilePath] -> IO [EnvVar]
+readConfigFromEnvFiles Nothing = do
+  defaultLocations <- defaultEnvFiles
+  readEnvFiles defaultLocations
 
-  cwdConfigExists <- Dir.doesFileExist cwdConfigFile
-  cwdConfig <- if cwdConfigExists
-    then DotEnv.parseFile cwdConfigFile
-    else pure []
+readConfigFromEnvFiles (Just fps) = readEnvFiles fps
+
+-- | Take a list of paths to environment files, and try to open and parse each of them.
+-- Return the list of key-value pairs read from the files, where values in
+-- later files override files read from files earlier in the list.
+readEnvFiles :: [FilePath] -> IO [EnvVar]
+readEnvFiles fps = do
+  values <- mapM readEnvFile fps
+  pure $ nubBy (\x y -> fst x == fst y) (concat $ reverse values)
 
-  -- Deduplicate, user config takes precedence over machine config
-  let config = nubBy (\(x, _) (y, _) -> x == y) $ cwdConfig ++ userConfig ++ machineConfig
-  pure config
+-- | Take a path to an environment file and try to parse it.
+-- If the file exists, return the key-value pairs in it, else return an empty
+-- list.
+readEnvFile :: FilePath -> IO [EnvVar]
+readEnvFile path = do
+    -- @doesFileExist@ doesn't throw exceptions, it catches @IOError@s and
+    -- returns @False@ if those are encountered.
+    fileExists <- Dir.doesFileExist path
+    if fileExists
+    then DotEnv.parseFile path
+    else pure []