conferer-aeson 1.0.0.0 → 1.1.0.0

raw patch · 6 files changed

+164/−12 lines, 6 filesdep ~confererPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: conferer

API changes (from Hackage documentation)

Files

• CHANGELOG.md +14/−1
• conferer-aeson.cabal +3/−2
• src/Conferer/FromConfig/Aeson.hs +1/−1
• src/Conferer/Source/Aeson.hs +76/−8
• test/Conferer/FromConfig/AesonSpec.hs +18/−0
• test/Conferer/Source/AesonSpec.hs +52/−0

@@ -8,9 +8,22 @@  Nothing +## [v1.1.0.0] 2021-03-01++### Changed++* Rename `fromFilePath` to `fromFilePath'`.+* Define a new `fromFilePath` whose type is `FilePath -> SourceCreator` instaed of `FilePath -> IO Source`.+* Validate that the json value doesn't contain any wrong key name (only lowercase ascii and numbers+  are accepted) and throw otherwise.+* Treat the special key `_self` as explained in the docs to allow nesting keys that's used elsewhere.+* Even if invalid key names get through, ignore them in the source.++ ## [v1.0.0.0] 2020-12-29  First release -[Unreleased]: https://github.com/ludat/conferer/compare/conferer-aeson_v1.0.0.0...HEAD+[Unreleased]: https://github.com/ludat/conferer/compare/conferer-aeson_v1.1.0.0...HEAD+[v1.1.0.0]: https://github.com/ludat/conferer/compare/conferer-aeson_v1.0.0.0...conferer-aeson_v1.1.0.0 [v1.0.0.0]: https://github.com/ludat/conferer/compare/v0.0.0.0...conferer-aeson_v1.0.0.0

@@ -4,10 +4,10 @@ -- -- see: https://github.com/sol/hpack ----- hash: 2543e03c19711f47aefac06d11874917b5f28a3c1d272d42fbb5d4016968c1cd+-- hash: cdd4956f023c56c73b29439f3a0cafebbc5b26d1091e28a67e8b847d76974ee9  name:           conferer-aeson-version:        1.0.0.0+version:        1.1.0.0 synopsis:       conferer's source for reading json files  description:    Library to abstract the parsing of many haskell config values from different config sources@@ -51,6 +51,7 @@   type: exitcode-stdio-1.0   main-is: Spec.hs   other-modules:+      Conferer.FromConfig.AesonSpec       Conferer.Source.AesonSpec       Paths_conferer_aeson   hs-source-dirs:

@@ -17,7 +17,7 @@ import qualified Data.Text.Encoding as Text  instance FromConfig Value where-  fetchFromConfig key config = do+  fromConfig key config = do     rawAeson <- fetchFromConfig @Text key config     case eitherDecodeStrict' @Value $ Text.encodeUtf8 rawAeson of       Right value -> 

@@ -22,6 +22,8 @@ import qualified Data.ByteString.Lazy as L import Data.List (intersperse) import System.Directory (doesFileExist)+import Control.Exception+import Control.Monad (guard)  import Conferer.Source.Files import qualified Conferer.Source.Null as Null@@ -44,15 +46,24 @@ fromConfig :: Key -> SourceCreator fromConfig key config = do   fileToParse <- getFilePathFromEnv key "json" config-  fromFilePath fileToParse+  fromFilePath' fileToParse +-- | Create a 'SourceCreator' from a filepath+--+-- If the file is not present it will behave as if it had no keys.+--+-- If the file doesn't have valid json it will throw an error.+fromFilePath :: FilePath -> SourceCreator+fromFilePath fileToParse _config =+  fromFilePath' fileToParse+ -- | Create a 'Source' from a filepath -- -- If the file is not present it will behave as if it had no keys. -- -- If the file doesn't have valid json it will throw an error.-fromFilePath :: FilePath -> IO Source-fromFilePath fileToParse = do+fromFilePath' :: FilePath -> IO Source+fromFilePath' fileToParse = do   fileExists <- doesFileExist fileToParse   if fileExists     then do@@ -61,10 +72,21 @@         Nothing ->           error $ "Failed to decode json file '" ++ fileToParse ++ "'"         Just v -> do-          return $ fromValue v+          case invalidJsonKeys v of+            [] ->+              return $ fromValue v+            errors ->+              throwIO $ JsonHasInvalidKeysError fileToParse errors     else do       return $ Null.empty +-- | Exception thrown from 'fromFilePath' when the json in the+-- parsed file has incorrect keys+data JsonHasInvalidKeysError =+  JsonHasInvalidKeysError FilePath [RawKey] deriving (Eq, Show)++instance Exception JsonHasInvalidKeysError+ -- | Create a 'Source' from a json value, never fails. fromValue :: Value -> Source fromValue value =@@ -117,9 +139,16 @@   go :: Key -> Value -> [Key]   go key value =     case (unconsKey key, value) of-      (_, Object o) -> do-        (k, v) <- HashMap.toList o-        go (key /. fromText k) v+      (_, Object o) ->+        let+          self =+            case valueToText <$> HashMap.lookup "_self" o of+              Just _ -> [key]+              Nothing -> []+        in self ++ do+          (k, v) <- HashMap.toList o+          guard $ isValidKeyFragment k+          go (key /. fromText k) v       (_, Array as) -> do         (index :: Integer, v) <- zip [0..] $ Vector.toList as         go (key /. mkKey (show index)) v@@ -129,7 +158,9 @@ -- | Turn json 'Value' into 'Text' to return that key valueToText :: Value -> Maybe Text valueToText (String t) = Just t-valueToText (Object _o) = Nothing+valueToText (Object o) = do+  selfValue <- HashMap.lookup "_self" o+  valueToText selfValue valueToText (Array _as) = Nothing valueToText (Number n) = Just $ Text.decodeUtf8 $ L.toStrict $ encode $ Number n valueToText (Bool b) = Just $ boolToString b@@ -145,3 +176,40 @@ resultToMaybe (Error _) = Nothing resultToMaybe (Success a) = Just a +type RawKey = [Text]++-- | Validates that a json has the correct format for keys,+-- since Conferer 'Key's are pretty restricted.+--+-- The Source will work with incorrect keys but they will+-- be ignored.+invalidJsonKeys :: Value -> [RawKey]+invalidJsonKeys = filter (not . validKey) . allKeys+  where+    validFragmentForJSON :: Text -> Bool+    validFragmentForJSON fragment = isValidKeyFragment fragment || fragment == "_self"+    validKey :: RawKey -> Bool+    validKey fragments = all validFragmentForJSON fragments++-- | Returns all keys in a json object+allKeys :: Value -> [RawKey]+allKeys = go mempty+  where+    go :: RawKey -> Value -> [RawKey]+    go rawkey value =+      case value of+        Object o ->+          let+            keys =+              fmap (\t -> rawkey ++ [t])+              . HashMap.keys+              $ o+          in keys ++ do+          (k, v) <- HashMap.toList o+          let subkey = rawkey ++ [k]+          go subkey v+        Array as -> do+          (index :: Integer, v) <- zip [0..] $ Vector.toList as+          let subkey = rawkey ++ [Text.pack $ show index]+          go subkey v+        _ -> []

@@ -0,0 +1,18 @@+{-# LANGUAGE TypeApplications #-}+module Conferer.FromConfig.AesonSpec where++import Data.Aeson+import Data.Aeson.QQ+import Test.Hspec++import Conferer.FromConfig+import Conferer.FromConfig.Aeson ()++import Conferer.Test++spec :: Spec+spec = do+  it "getting an existing path returns the right value" $ do+    c <- configWith [] [("some.key", "{\"some\": \"some url\", \"ssl\": true}")]+    res <- fetchFromConfig @Value "some.key" c+    res `shouldBe` [aesonQQ| {"some": "some url", "ssl": true} |]

@@ -26,6 +26,18 @@         res <- getKeyInSource c "some.path"         res `shouldBe` Nothing +      context "getting a key with an object that has '_self'" $ do+        it "gets the value inside '_self'" $ do+          c <- mk [aesonQQ| { key: {_self: 72}} |]+          res <- getKeyInSource c "key"+          res `shouldBe` Just "72"++      context "with a key that's not valid" $ do+        it "ignores the value" $ do+          c <- mk [aesonQQ| { key: {key_: 72}} |]+          res <- getKeyInSource c "key"+          res `shouldBe` Nothing+       describe "with an array" $ do         it "getting a path with number gets the right value" $ do           c <- mk [aesonQQ| {"key": ["value"]} |]@@ -127,4 +139,44 @@           c <- mk [aesonQQ|[true, true, true]|]           res <- getSubkeysInSource c ""           res `shouldBe` ["0", "1", "2"]+      describe "gettings keys with invalid names" $ do+        it "ignores those names" $ do+          c <- mk [aesonQQ|{"_a": 7}|]+          res <- getSubkeysInSource c ""+          res `shouldBe` []+      describe "when json keys don't follow the conferer Key format" $ do+        it "ignores the evil keys" $ do+          c <- mk [aesonQQ|{some: {k_e_y: 0}}|]+          res <- getSubkeysInSource c ""+          res `shouldBe` []+      describe "when '_self' is present" $ do+        it "gets an object if it has '_self'" $ do+          c <- mk [aesonQQ|{some: {_self: 7, key: 0}}|]+          res <- getSubkeysInSource c ""+          res `shouldBe` ["some", "some.key"]+    describe "#invalidJsonKeys" $ do+      context "with some common keys" $+        it "works" $ do+          invalidJsonKeys [aesonQQ|{postgres: {url: "some url", ssl: true}} |]+            `shouldBe` []+      context "with one top level invalid key" $+        it "fails" $ do+          invalidJsonKeys [aesonQQ|{k_e_y: {}} |]+            `shouldBe` [["k_e_y"]]+      context "with one invalid key inside an object" $+        it "fails" $ do+          invalidJsonKeys [aesonQQ|{some: {k_e_y: {}}} |]+            `shouldBe` [["some", "k_e_y"]]+      context "with one invalid key inside an array" $+        it "fails" $ do+          invalidJsonKeys [aesonQQ|[{k_e_y: {}}]|]+            `shouldBe` [["0", "k_e_y"]]+      context "with _self" $+        it "succeeds" $ do+          invalidJsonKeys [aesonQQ|[{some: {_self: 7}}]|]+            `shouldBe` []+      context "with empty key" $+        it "fails" $ do+          invalidJsonKeys [aesonQQ|{"": 7}|]+            `shouldBe` [[""]]