diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,3 +1,10 @@ +0.3.1.0 +---- + +* Add new `etc/files` entry to the spec file which allows to specify an + environment variable to fetch a file + + 0.3.0.0 ---- **BREAKING CHANGES** diff --git a/etc.cabal b/etc.cabal --- a/etc.cabal +++ b/etc.cabal @@ -1,5 +1,5 @@ name: etc -version: 0.3.0.0 +version: 0.3.1.0 cabal-version: >=1.10 build-type: Simple license: MIT @@ -18,6 +18,7 @@ data-files: test/fixtures/config.foo test/fixtures/config.json + test/fixtures/config.env.json test/fixtures/config.null.json test/fixtures/config.spec.yaml test/fixtures/config.yaml diff --git a/src/System/Etc/Internal/Extra/Printer.hs b/src/System/Etc/Internal/Extra/Printer.hs --- a/src/System/Etc/Internal/Extra/Printer.hs +++ b/src/System/Etc/Internal/Extra/Printer.hs @@ -54,10 +54,21 @@ renderSource key source' = case source' of Default value' -> (renderJsonValue key value', brackets' (fill 10 (text "Default"))) - File _index filepath' value' -> - ( renderJsonValue key value' - , brackets' (fill 10 (text "File:" <+> text (Text.unpack filepath'))) - ) + File _index fileSource value' -> case fileSource of + FilePathSource filepath' -> + ( renderJsonValue key value' + , brackets' (fill 10 (text "File:" <+> text (Text.unpack filepath'))) + ) + EnvVarFileSource envVar filepath' -> + ( renderJsonValue key value' + , brackets' + (fill + 10 + (text "File:" <+> text (Text.unpack envVar) <> "=" <> text + (Text.unpack filepath') + ) + ) + ) Env varname value' -> ( renderJsonValue key value' diff --git a/src/System/Etc/Internal/Resolver/File.hs b/src/System/Etc/Internal/Resolver/File.hs --- a/src/System/Etc/Internal/Resolver/File.hs +++ b/src/System/Etc/Internal/Resolver/File.hs @@ -1,4 +1,5 @@ {-# LANGUAGE CPP #-} +{-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE OverloadedStrings #-} module System.Etc.Internal.Resolver.File (resolveFiles) where @@ -18,6 +19,8 @@ import qualified Data.Aeson.Internal as JSON (IResult (..), iparse) import qualified RIO.ByteString.Lazy as LB8 +import System.Environment (lookupEnv) + import qualified System.Etc.Internal.Spec.Types as Spec import System.Etc.Internal.Types hiding (filepath) @@ -31,8 +34,13 @@ -------------------------------------------------------------------------------- parseConfigValue - :: Monad m => Maybe (Spec.ConfigValue cmd) -> Int -> Text -> JSON.Value -> m ConfigValue -parseConfigValue mSpec fileIndex filepath json = case json of + :: Monad m + => Maybe (Spec.ConfigValue cmd) + -> Int + -> FileSource + -> JSON.Value + -> m ConfigValue +parseConfigValue mSpec fileIndex fileSource json = case json of JSON.Object object -> SubConfig <$> foldM (\acc (key, subConfigValue) -> do let msubConfigSpec = do @@ -43,7 +51,7 @@ -- TODO: This should be an error given the config doesn't match spec fail "configuration spec and configuration value are different" - value1 <- parseConfigValue msubConfigSpec fileIndex filepath subConfigValue + value1 <- parseConfigValue msubConfigSpec fileIndex fileSource subConfigValue return $ HashMap.insert key value1 acc ) HashMap.empty @@ -57,7 +65,7 @@ _ -> fail "configuration spec and configuration value are different" toValue = fromMaybe Plain mToValue - in return $ ConfigValue (Set.singleton $ File fileIndex filepath (toValue json)) + in return $ ConfigValue (Set.singleton $ File fileIndex fileSource (toValue json)) eitherDecode :: ConfigFile -> Either String JSON.Value @@ -75,14 +83,15 @@ #endif -parseConfig :: MonadThrow m => Spec.ConfigValue cmd -> Int -> Text -> ConfigFile -> m Config -parseConfig spec fileIndex filepath contents = case eitherDecode contents of - Left err -> throwM $ InvalidConfiguration Nothing (Text.pack err) - - Right json -> case JSON.iparse (parseConfigValue (Just spec) fileIndex filepath) json of - JSON.IError _ err -> throwM $ InvalidConfiguration Nothing (Text.pack err) +parseConfig + :: MonadThrow m => Spec.ConfigValue cmd -> Int -> FileSource -> ConfigFile -> m Config +parseConfig spec fileIndex fileSource contents = case eitherDecode contents of + Left err -> throwM $ InvalidConfiguration Nothing (Text.pack err) - JSON.ISuccess result -> return (Config result) + Right json -> + case JSON.iparse (parseConfigValue (Just spec) fileIndex fileSource) json of + JSON.IError _ err -> throwM $ InvalidConfiguration Nothing (Text.pack err) + JSON.ISuccess result -> return (Config result) readConfigFile :: MonadThrow m => Text -> IO (m ConfigFile) readConfigFile filepath = @@ -103,18 +112,19 @@ (throwM $ InvalidConfiguration Nothing "Unsupported file extension") else return $ throwM $ ConfigurationFileNotFound filepath -readConfigFromFiles :: Spec.ConfigSpec cmd -> IO (Config, [SomeException]) -readConfigFromFiles spec = - Spec.specConfigFilepaths spec +readConfigFromFileSources + :: Spec.ConfigSpec cmd -> [FileSource] -> IO (Config, [SomeException]) +readConfigFromFileSources spec fileSources = + fileSources & zip [1 ..] & mapM - (\(fileIndex, filepath) -> do - mContents <- readConfigFile filepath + (\(fileIndex, fileSource) -> do + mContents <- readConfigFile (fileSourcePath fileSource) return ( mContents >>= parseConfig (Spec.SubConfig $ Spec.specConfigValues spec) fileIndex - filepath + fileSource ) ) & (foldl' @@ -125,6 +135,23 @@ (mempty, []) <$> ) +processFilesSpec :: Spec.ConfigSpec cmd -> IO (Config, [SomeException]) +processFilesSpec spec = case Spec.specConfigFilepaths spec of + Nothing -> readConfigFromFileSources spec [] + Just (Spec.FilePathsSpec paths) -> + readConfigFromFileSources spec (map FilePathSource paths) + Just (Spec.FilesSpec fileEnvVar paths0) -> do + let getPaths = case fileEnvVar of + Nothing -> return $ map FilePathSource paths0 + Just filePath -> do + envFilePath <- lookupEnv (Text.unpack filePath) + let envPath = + maybeToList ((EnvVarFileSource filePath . Text.pack) <$> envFilePath) + return $ map FilePathSource paths0 ++ envPath + + paths <- getPaths + readConfigFromFileSources spec paths + {-| Gathers configuration values from a list of files specified on the @@ -137,5 +164,5 @@ :: Spec.ConfigSpec cmd -- ^ Config Spec -> IO (Config, Vector SomeException) -- ^ Configuration Map with all values from files filled in and a list of warnings resolveFiles spec = do - (config, exceptions) <- readConfigFromFiles spec + (config, exceptions) <- processFilesSpec spec return (config, Vector.fromList exceptions) diff --git a/src/System/Etc/Internal/Spec/Types.hs b/src/System/Etc/Internal/Spec/Types.hs --- a/src/System/Etc/Internal/Spec/Types.hs +++ b/src/System/Etc/Internal/Spec/Types.hs @@ -94,9 +94,14 @@ } deriving (Show, Eq) +data FilesSpec + = FilePathsSpec ![Text] + | FilesSpec { fileLocationEnvVar :: !(Maybe Text), fileLocationPaths :: ![Text] } + deriving (Show, Eq) + data ConfigSpec cmd = ConfigSpec { - specConfigFilepaths :: ![Text] + specConfigFilepaths :: !(Maybe FilesSpec) , specCliProgramSpec :: !(Maybe CliProgramSpec) , specConfigValues :: !(HashMap Text (ConfigValue cmd)) } @@ -258,12 +263,37 @@ , configSources = ConfigSources Nothing Nothing } + +parseFiles :: JSON.Value -> JSON.Parser FilesSpec +parseFiles = JSON.withObject "FilesSpec" $ \object -> do + files <- object .: "etc/files" + mEnv <- files .:? "env" + mPaths <- files .:? "paths" + if isNothing mEnv && isNothing mPaths + then fail "either `env` or a `paths` keys are required when using `etc/files`" + else return $ FilesSpec mEnv (fromMaybe [] mPaths) + +parseFilePaths :: JSON.Value -> JSON.Parser FilesSpec +parseFilePaths = + JSON.withObject "FilesSpec" $ \object -> FilePathsSpec <$> object .: "etc/filepaths" + +parseFileSpec :: JSON.Value -> JSON.Parser (Maybe FilesSpec) +parseFileSpec json@(JSON.Object object) = do + mFiles <- object .:? "etc/files" + mFilePaths <- object .:? "etc/filepaths" + if isJust (mFiles :: Maybe JSON.Value) && isJust (mFilePaths :: Maybe JSON.Value) + then fail "either the `etc/files` or `etc/filepaths` key can be used; not both" + else if isJust mFiles + then Just <$> parseFiles json + else if isJust mFilePaths then Just <$> parseFilePaths json else pure Nothing +parseFileSpec _ = pure Nothing + instance JSON.FromJSON cmd => JSON.FromJSON (ConfigSpec cmd) where - parseJSON json = + parseJSON json = case json of JSON.Object object -> ConfigSpec - <$> (fromMaybe [] <$> (object .:? "etc/filepaths")) + <$> parseFileSpec json <*> (object .:? "etc/cli") <*> (fromMaybe HashMap.empty <$> (object .:? "etc/entries")) _ -> diff --git a/src/System/Etc/Internal/Types.hs b/src/System/Etc/Internal/Types.hs --- a/src/System/Etc/Internal/Types.hs +++ b/src/System/Etc/Internal/Types.hs @@ -53,10 +53,15 @@ boolToValue :: Bool -> (a -> Value a) boolToValue = bool Plain Sensitive +data FileSource + = FilePathSource { fileSourcePath :: !Text } + | EnvVarFileSource { fileSourceEnvVar :: !Text, fileSourcePath :: !Text } + deriving (Show, Eq) + data ConfigSource = File { configIndex :: !Int - , filepath :: !Text + , filepath :: !FileSource , value :: !(Value JSON.Value) } | Env { diff --git a/test/System/Etc/Resolver/FileTest.hs b/test/System/Etc/Resolver/FileTest.hs --- a/test/System/Etc/Resolver/FileTest.hs +++ b/test/System/Etc/Resolver/FileTest.hs @@ -16,12 +16,30 @@ import qualified Data.Aeson as JSON import Paths_etc (getDataFileName) -import System.Etc +import System.Environment (setEnv) +import System.Etc +import System.Etc.Internal.Types (FileSource (..)) tests :: TestTree tests = testGroup - "file" + "files" + [ testCase "fail if using both `etc/files` and `etc/filepaths`" $ do + let input = "{\"etc/files\": {}, \"etc/filepaths\": []}" + + (espec :: Either ConfigurationError (ConfigSpec ())) <- try $ parseConfigSpec input + case espec of + Left (InvalidConfiguration _ _) -> return () + _ -> + assertFailure ("Expecting InvalidConfigurationError; got instead " <> show espec) + , filePathsTests + , filesTest + ] + + +filePathsTests :: TestTree +filePathsTests = testGroup + "etc/filepaths" [ testCase "supports json, yaml and yml extensions" $ do jsonFilepath <- getDataFileName "test/fixtures/config.json" #ifdef WITH_YAML @@ -47,14 +65,14 @@ ("expecting to get entries for greeting (check fixtures)\n" <> show config) Just aSet -> assertBool ("expecting to see entry from json config file " <> show aSet) - (Set.member (File 1 (Text.pack jsonFilepath) "hello json") aSet) + (Set.member (File 1 (FilePathSource $ Text.pack jsonFilepath) "hello json") aSet) #ifdef WITH_YAML >> assertBool ("expecting to see entry from yaml config file " <> show aSet) - (Set.member (File 2 (Text.pack jsonFilepath) "hello yaml") aSet) + (Set.member (File 2 (FilePathSource $ Text.pack jsonFilepath) "hello yaml") aSet) >> assertBool ("expecting to see entry from yml config file " <> show aSet) - (Set.member (File 3 (Text.pack jsonFilepath) "hello yml") aSet) + (Set.member (File 3 (FilePathSource $ Text.pack jsonFilepath) "hello yml") aSet) #endif , testCase "does not support any other file extension" $ do fooFilepath <- getDataFileName "test/fixtures/config.foo" @@ -69,9 +87,11 @@ if Vector.null errs then assertFailure "expecting one error, got none" else - let err = Vector.head errs + let err = do + e <- errs Vector.!? 0 + fromException e in - case fromException err of + case err of Just (InvalidConfiguration _ _) -> return () _ -> assertFailure ("Expecting InvalidConfigurationError; got instead " <> show err) @@ -92,14 +112,16 @@ ("expecting to get entries for greeting (check fixtures)\n" <> show config) Just aSet -> assertBool ("expecting to see entry from json config file " <> show aSet) - (Set.member (File 1 (Text.pack jsonFilepath) "hello json") aSet) + (Set.member (File 1 (FilePathSource $ Text.pack jsonFilepath) "hello json") aSet) if Vector.null errs then assertFailure "expecting one error, got none" else - let err = Vector.head errs + let err = do + e <- errs Vector.!? 0 + fromException e in - case fromException err of + case err of Just (ConfigurationFileNotFound _) -> return () _ -> assertFailure ("Expecting ConfigurationFileNotFound; got instead " <> show err) @@ -137,4 +159,50 @@ ("hola" :: Text) greeting Nothing -> assertFailure "Expecting config value, but got nothing" + ] + +filesTest :: TestTree +filesTest = testGroup + "etc/files" + [ testCase "at least the `env` or `paths` keys must be present" $ do + let input = "{\"etc/files\": {}}" + + (espec :: Either ConfigurationError (ConfigSpec ())) <- try $ parseConfigSpec input + case espec of + Left (InvalidConfiguration _ _) -> return () + _ -> + assertFailure ("Expecting InvalidConfigurationError; got instead " <> show espec) + , testCase "environment variable has precedence over all others" $ do + jsonFilepath <- getDataFileName "test/fixtures/config.json" + envFilePath <- getDataFileName "test/fixtures/config.env.json" + let input = mconcat + [ "{\"etc/files\": {" + , " \"env\": \"ENV_FILE_TEST\"," + , " \"paths\": [\"" <> Text.pack jsonFilepath <> "\"]" + , "}}" + ] + + envFileTest = "ENV_FILE_TEST" + + setEnv (Text.unpack envFileTest) envFilePath + + (spec :: ConfigSpec ()) <- parseConfigSpec input + (config, _) <- resolveFiles spec + + case getAllConfigSources ["greeting"] config of + Nothing -> assertFailure + ("expecting to get entries for greeting (check fixtures)\n" <> show config) + Just aSet -> do + assertBool + ("expecting to see entry from env config file " <> show aSet) + (Set.member + (File 1 + (EnvVarFileSource envFileTest $ Text.pack envFilePath) + "hello environment" + ) + aSet + ) + assertBool + ("expecting to see entry from json config file " <> show aSet) + (Set.member (File 2 (FilePathSource $ Text.pack jsonFilepath) "hello json") aSet) ] diff --git a/test/System/Etc/SpecTest.hs b/test/System/Etc/SpecTest.hs --- a/test/System/Etc/SpecTest.hs +++ b/test/System/Etc/SpecTest.hs @@ -260,13 +260,13 @@ let keys = ["greeting"] path <- getDataFileName "test/fixtures/config.spec.yaml" - mconfig <- YAML.decodeFile path + econfig <- YAML.decodeFileEither path - case mconfig of - Nothing -> - assertFailure "yaml file did not have a configuration spec" + case econfig of + Left err -> + assertFailure $ "yaml file did not have a configuration spec: " <> show err - Just (config :: ConfigSpec ()) -> + Right (config :: ConfigSpec ()) -> case getConfigValue keys (specConfigValues config) of Nothing -> assertFailure (show keys ++ " should map to a config value, got sub config map instead") diff --git a/test/fixtures/config.env.json b/test/fixtures/config.env.json new file mode 100644 --- /dev/null +++ b/test/fixtures/config.env.json @@ -0,0 +1,3 @@ +{ + "greeting": "hello environment" +}