etc 0.3.0.0 → 0.3.1.0

raw patch · 9 files changed

+194/−42 lines, 9 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• CHANGELOG.md +7/−0
• etc.cabal +2/−1
• src/System/Etc/Internal/Extra/Printer.hs +15/−4
• src/System/Etc/Internal/Resolver/File.hs +45/−18
• src/System/Etc/Internal/Spec/Types.hs +33/−3
• src/System/Etc/Internal/Types.hs +6/−1
• test/System/Etc/Resolver/FileTest.hs +78/−10
• test/System/Etc/SpecTest.hs +5/−5
• test/fixtures/config.env.json +3/−0

@@ -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**

@@ -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

@@ -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'

@@ -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)

@@ -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"))       _ ->

@@ -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 {

@@ -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)   ]

@@ -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")

@@ -0,0 +1,3 @@+{+    "greeting": "hello environment"+}