language-puppet 1.4.4 → 1.4.5

raw patch · 29 files changed

+568/−177 lines, 29 filesdep ~aesondep ~bytestringdep ~formattingPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependency ranges changed: aeson, bytestring, formatting, hspec, lens, memory, mtl, protolude, scientific, servant, servant-client, text, vector

API changes (from Hackage documentation)

Files

• CHANGELOG +10/−0
• README.md +1/−1
• language-puppet.cabal +27/−25
• progs/yera.hs +5/−5
• src/Erb/Parser.hs +3/−1
• src/Hiera/Server.hs +107/−52
• src/Puppet/Interpreter/Helpers.hs +6/−0
• src/Puppet/Interpreter/IO.hs +21/−21
• src/Puppet/Interpreter/Resolve.hs +39/−12
• src/Puppet/Interpreter/Types.hs +1/−1
• src/Puppet/Runner/Erb.hs +3/−3
• src/Puppet/Runner/Pure.hs +2/−2
• src/Puppet/Runner/Stdlib.hs +2/−1
• src/PuppetDB/Remote.hs +5/−2
• src/XPrelude/Extra.hs +4/−0
• tests/ErbSpec.hs +3/−0
• tests/HieraSpec.hs +199/−51
• tests/Interpreter/Function/LookupSpec.hs +5/−0
• tests/hiera/interpolate/config/hiera.yaml +14/−0
• tests/hiera/interpolate/config/hiera_iplm_hiera.yaml +6/−0
• tests/hiera/interpolate/config/hiera_iplm_hiera_bad.yaml +5/−0
• tests/hiera/interpolate/data/bad_interpolation.yaml +9/−0
• tests/hiera/interpolate/data/complex.yaml +12/−0
• tests/hiera/interpolate/data/dotted_keys.yaml +43/−0
• tests/hiera/interpolate/data/empty_interpolation.yaml +13/−0
• tests/hiera/interpolate/data/niltest.yaml +2/−0
• tests/hiera/interpolate/data/recursive.yaml +3/−0
• tests/hiera/interpolate/data/weird_keys.yaml +12/−0
• tests/hiera/production.yaml +6/−0

@@ -1,5 +1,13 @@ language-puppet (1.4.5) artful; urgency=medium +  * Add the `reduce` function.+  * Change A hiera lookup using an unknown key will throw an error.+  * Implement `alias` in hiera files.+  * Fix #277 (hiera lookup in multiple layers)+  * Allow servant 0.16++ -- Pierre Radermecker <pierrer@pi3r.be>  Mo, 17 June 2019 16:12:48 +0100+ language-puppet (1.4.4) artful; urgency=medium    * Add the `deep_merge` stdlib function.@@ -22,6 +30,8 @@ language-puppet (1.4.2) artful; urgency=medium    * Bump upper version bounds for some haskell packages++ -- Pierre Radermecker <pierrer@pi3r.be>  Wed, 20 Feb 2019 21:32:48 +0100  language-puppet (1.4.1) artful; urgency=medium 

@@ -15,7 +15,7 @@  **Install with nix:** ```-nix-env -i -f https://github.com/bartavelle/language-puppet/tarball/v1.4.3+nix-env -i -f https://github.com/bartavelle/language-puppet/tarball/v1.4.5 ``` (replace `1.4.3` with any commit ref or tag). 

@@ -2,7 +2,7 @@ -- documentation, see http://haskell.org/cabal/users-guide/  name:                language-puppet-version:             1.4.4+version:             1.4.5 synopsis:            Tools to parse and evaluate the Puppet DSL. description:         This is a set of tools that is supposed to fill all your Puppet needs : syntax checks, catalog compilation, PuppetDB queries, simulation of complex interactions between nodes, Puppet master replacement, and more ! homepage:            http://lpuppet.banquise.net/@@ -16,13 +16,15 @@ cabal-version:       >=1.8 bug-reports:         https://github.com/bartavelle/language-puppet/issues -Tested-With:         GHC == 8.0.2, GHC == 8.2.2, GHC == 8.4.4+Tested-With:         GHC == 8.0.2, GHC == 8.2.2, GHC == 8.4.4, GHC == 8.6.4  extra-source-files:     CHANGELOG     README.md     HLint.hs     tests/hiera/*.yaml+    tests/hiera/interpolate/config/*.yaml+    tests/hiera/interpolate/data/*.yaml     tests/hiera/*.com.json     tests/Parser/lexer/*.pp @@ -96,49 +98,49 @@   extensions:          OverloadedStrings, BangPatterns, LambdaCase, NoImplicitPrelude, FlexibleContexts, FlexibleInstances   ghc-options:         -Wall -funbox-strict-fields   -- ghc-prof-options:    -auto-all -caf-all-  build-depends:       aeson                >= 0.8+  build-depends:       aeson                >= 1.0.0.0 && < 1.5                      , ansi-wl-pprint       >= 0.6.8                      , attoparsec           >= 0.12-                     , base >=4.9 && < 5+                     , base                 >=4.9      && < 5                      , base16-bytestring    == 0.1.*-                     , bytestring+                     , bytestring                         < 0.11                      , case-insensitive     == 1.2.*                      , containers           >= 0.5     && < 0.7                      , cryptonite           >= 0.6                      , directory            >= 1.2     && < 1.4                      , filecache            >= 0.2.9   && < 0.5                      , filepath             >= 1.4-                     , formatting+                     , formatting                         < 7                      , hashable             == 1.2.*-                     , http-api-data        >= 0.2   && < 0.5-                     , http-client          >= 0.4.30 && < 0.7-                     , hruby                >= 0.3.2 && < 0.4+                     , http-api-data        >= 0.2     && < 0.5+                     , http-client          >= 0.4.30  && < 0.7+                     , hruby                >= 0.3.2   && < 0.4                      , hslogger             == 1.2.*                      , lens                 >= 4.12    && < 5                      , lens-aeson           >= 1.0                      , megaparsec           >= 7       && < 8-                     , memory               >= 0.7+                     , memory               >= 0.14    && < 0.15                      , mtl                  >= 2.2.1   && < 2.3                      , operational          >= 0.2.3   && < 0.3                      , parsec               == 3.1.*                      , parser-combinators   == 1.*                      , pcre-utils           >= 0.1.7   && < 0.2-                     , protolude            >= 0.2+                     , protolude            >= 0.2     && < 0.3                      , random                      , regex-pcre-builtin   >= 0.94.4-                     , scientific           >= 0.2 && < 0.4-                     , servant              >= 0.9 && < 0.16-                     , servant-client       >= 0.9 && < 0.16+                     , scientific           >= 0.2     && < 0.4+                     , servant              >= 0.9     && < 0.17+                     , servant-client       >= 0.9     && < 0.17                      , split                == 0.2.*-                     , stm                  >= 2.4 && < 2.6+                     , stm                  >= 2.4     && < 2.6                      , strict-base-types    >= 0.3-                     , text                 >= 0.11-                     , time                 >= 1.5  && < 2-                     , transformers         >= 0.4  && < 0.6-                     , unix                 >= 2.7  && < 2.8+                     , text                 >= 0.11    && < 1.3+                     , time                 >= 1.5     && < 2+                     , transformers         >= 0.4     && < 0.6+                     , unix                 >= 2.7     && < 2.8                      , unordered-containers == 0.2.*-                     , vector               >= 0.10-                     , yaml                 >= 0.8.31   && < 0.12+                     , vector               >= 0.10    && < 0.13+                     , yaml                 >= 0.8.31  && < 0.12 Test-Suite spec   hs-source-dirs: tests   type:           exitcode-stdio-1.0@@ -147,13 +149,13 @@   build-depends:    base                   , Glob                   , hslogger-                  , hspec+                  , hspec                   >= 2.0 && < 3.0                   , hspec-megaparsec                   , megaparsec                   , language-puppet-                  , lens-                  , mtl-                  , scientific+                  , lens                    >= 4.12  && < 5+                  , mtl                     >= 2.2.1 && < 2.3+                  , scientific              >= 0.2   && < 0.4                   , strict-base-types                   , text                   , temporary

@@ -5,12 +5,12 @@  import           XPrelude            hiding (option) -import qualified Data.Either.Strict  as S import qualified Data.HashMap.Strict as Map import qualified Data.List           as List import           Options.Applicative  import           Hiera.Server+import           Puppet.Language (PValue(..))  data Config   = Config@@ -42,7 +42,7 @@ main = do   Config fp query qtype vars <- execParser configInfo   hiera <- startHiera "yera" fp-  hiera (Map.fromList vars) (toS query) qtype >>= \case-    S.Left rr -> panic (show rr)-    S.Right Nothing -> die "no match"-    S.Right (Just res) -> print (pretty res)+  runExceptT (hiera (PString <$> Map.fromList vars) (toS query) qtype) >>= \case+    Left rr -> panic (show rr)+    Right Nothing -> die "no match"+    Right (Just res) -> print (pretty res)

@@ -101,8 +101,10 @@ stringLiteral = Value `fmap` (doubleQuoted <|> singleQuoted)  doubleQuoted :: Parser Value-doubleQuoted = Interpolable <$> between (char '"') (char '"') quoteInternal+doubleQuoted = simplify <$> between (char '"') (char '"') quoteInternal   where+    simplify [Value x] = x+    simplify x = Interpolable x     quoteInternal = many (basicContent <|> interpvar <|> escaped)     escaped = char '\\' >> (Value . Literal . Text.singleton) `fmap` anyChar     basicContent = (Value . Literal . Text.pack) `fmap` many1 (noneOf "\"\\#")

@@ -1,6 +1,7 @@ {-# LANGUAGE FunctionalDependencies #-} {-# LANGUAGE MultiParamTypeClasses  #-} {-# LANGUAGE NamedFieldPuns         #-}+{-# LANGUAGE PatternGuards          #-} {-# LANGUAGE RecordWildCards        #-} {-# LANGUAGE ScopedTypeVariables    #-} {-# LANGUAGE TemplateHaskell        #-}@@ -17,25 +18,30 @@   , HieraQueryType (..)   , readQueryType   , HieraQueryFunc+  , varSplitter+  , mergeWith ) where  import           XPrelude  import           Data.Aeson-import qualified Data.Aeson           as Aeson+import qualified Data.Aeson                 as Aeson import           Data.Aeson.Lens-import qualified Data.Attoparsec.Text as AT-import qualified Data.ByteString.Lazy as BS-import qualified Data.Either.Strict   as S-import qualified Data.FileCache       as Cache-import qualified Data.List            as List-import           Data.String          (fromString)-import qualified Data.Text            as Text-import qualified Data.Vector          as Vector-import qualified Data.Yaml            as Yaml-import qualified System.Directory     as Directory-import qualified System.FilePath      as FilePath-import           System.FilePath.Lens (directory)+import qualified Data.Attoparsec.Text       as AT+import qualified Data.ByteString.Lazy       as BS+import qualified Data.ByteString.Lazy.Char8 as BS8+import qualified Data.Either.Strict         as S+import qualified Data.FileCache             as Cache+import qualified Data.List                  as List+import           Data.String                (fromString)+import qualified Data.Text                  as Text+import qualified Data.Vector                as Vector+import qualified Data.Yaml                  as Yaml+import qualified System.Directory           as Directory+import qualified System.FilePath            as FilePath+import           System.FilePath.Lens       (directory)+import           Text.Megaparsec            (parse, sepBy1, Parsec, satisfy)+import           Text.Megaparsec.Char       (char)  import           Puppet.Language @@ -60,10 +66,10 @@     _        -> Nothing  -- | The type of the Hiera API function associated to given hierarchy.-type HieraQueryFunc m = Container Text -- ^ Scope: all variables that Hiera can interpolate (the top level ones are prefixed with '::')+type HieraQueryFunc m = Container PValue -- ^ Scope: all variables that Hiera can interpolate (the top level ones are prefixed with '::')                      -> Text -- ^ The query                      -> HieraQueryType-                     -> m (S.Either PrettyError (Maybe PValue))+                     -> ExceptT PrettyError m (Maybe PValue)  data Backend   = YamlBackend FilePath@@ -84,11 +90,23 @@   { getInterpolableHieraString :: [HieraStringPart]   } deriving (Show) -resolveString :: Container Text -> InterpolableHieraString -> Maybe Text+varSplitter :: Text -> [Text]+varSplitter v =+   case parse (vpart `sepBy1` char '.' :: Parsec Void Text [Text]) "dummy" v of+     Left _ -> [v]+     Right lst -> lst+   where+     vpart = squotev <|> dquotev <|> rawv+     rawv = Text.pack <$> some (satisfy (/= '.'))+     -- TODO, escapes+     squotev = Text.pack <$> (char '\'' *> some (satisfy (/= '\'')) <* char '\'')+     dquotev = Text.pack <$> (char '"' *> some (satisfy (/= '"')) <* char '"')++resolveString :: Container PValue -> InterpolableHieraString -> Maybe Text resolveString vars = fmap Text.concat . mapM resolve . getInterpolableHieraString   where     resolve (HPString x)   = Just x-    resolve (HPVariable v) = vars ^? ix v+    resolve (HPVariable v) = vars ^? ix v . _PString  instance FromJSON InterpolableHieraString where   parseJSON (String s) = case parseInterpolableString s of@@ -101,7 +119,7 @@ interpolableString = AT.many1 (fmap HPString rawPart <|> fmap HPVariable interpPart)   where     rawPart = AT.takeWhile1 (/= '%')-    interpPart = AT.string "%{" *> AT.takeWhile1 (/= '}') <* AT.char '}'+    interpPart = AT.string "%{" *> AT.takeWhile (/= '}') <* AT.char '}'  parseInterpolableString :: Text -> Either String [HieraStringPart] parseInterpolableString = AT.parseOnly interpolableString@@ -113,7 +131,7 @@   } deriving (Show)  data QRead = QRead-  { _qvars :: Container Text+  { _qvars :: Container PValue   , _qtype :: HieraQueryType   , _qhier :: [Value]   }@@ -179,13 +197,14 @@     Left ex   -> panic (show ex)     Right cfg@HieraConfigFile{..} -> do       logInfoStr ("Detect a hiera " <> layer <> " configuration format in " <> fp <> " at version " <> show _version)-      cache <- Cache.newFileCache-      pure (query cfg fp cache)+      query cfg fp <$> Cache.newFileCache  -- | A dummy hiera function that will be used when hiera is not detected. dummyHiera :: Monad m => HieraQueryFunc m-dummyHiera _ _ _ = return $ S.Right Nothing+dummyHiera _ _ _ = pure Nothing +exceptt :: Applicative m => Except r a -> ExceptT r m a+exceptt = ExceptT . pure . runExcept  query :: HieraConfigFile -> FilePath -> Cache -> HieraQueryFunc IO query HieraConfigFile {_version, _backends, _hierarchy} fp cache vars hquery qt = do@@ -194,14 +213,14 @@         mhierarchy <- resolveString vars <$> _hierarchy         Just h  <- [mhierarchy]         backend    <- _backends-        let decodeInfo :: (FilePath -> IO (S.Either String Value), String, String)+        let decodeInfo :: (FilePath -> IO (Either String Value), String, String)             decodeInfo =               case backend of-                JsonBackend dir -> (fmap (strictifyEither . Aeson.eitherDecode') . BS.readFile       , dir, ".json")-                YamlBackend dir -> (fmap (strictifyEither . (_Left %~ show)) . Yaml.decodeFileEither, dir, ".yaml")+                JsonBackend dir -> (fmap Aeson.eitherDecode' . BS.readFile       , dir, ".json")+                YamlBackend dir -> (fmap (_Left %~ show) . Yaml.decodeFileEither, dir, ".yaml")         pure (decodeInfo, toS h)   -- step 2, read all the files, returning a raw data structure-  mvals <- forM searchin $ \((decodefunction, datadir, extension), h) -> do+  mvals <- liftIO $ forM searchin $ \((decodefunction, datadir, extension), h) -> do     let extension' = if snd (FilePath.splitExtension h) == ".yaml"                        then ""                        else extension@@ -210,45 +229,68 @@           '/' : _ -> mempty           _       -> fp ^. directory <> "/"         querycache = do-          efilecontent <- Cache.query cache filename (decodefunction filename)+          efilecontent <- Cache.query cache filename (strictifyEither <$> decodefunction filename)           case efilecontent of             S.Left r -> do               logWarningStr $ "Hiera: error when reading file " <> filename <> ": "<> r               pure Nothing-            S.Right val -> do-              pure (Just val)+            S.Right val -> pure (Just val)     ifM (Directory.doesFileExist filename)       querycache       (pure Nothing)   let vals = catMaybes mvals   -- step 3, query through all the results-  logDebugStr ("Looking up '" <> toS hquery <> "' with backends " <> List.unwords (fmap show _backends ))-  return (strictifyEither $ runReader (runExceptT (recursiveQuery hquery [])) (QRead vars qt vals))+  liftIO $ logDebugStr ("Looking up '" <> toS hquery <> "' with backends " <> List.unwords (fmap show _backends ))+  exceptt $ runReaderT (recursiveQuery hquery []) (QRead vars qt vals) -type QM a = ExceptT PrettyError (Reader QRead) a+type QM a = ReaderT QRead (Except PrettyError) a  checkLoop :: Text -> [Text] -> QM () checkLoop x xs =     when (x `elem` xs) (throwError ("Loop in hiera: " <> fromString (Text.unpack (Text.intercalate ", " (x:xs))))) +-- a helper function that removes prefix and suffix+textBetween :: Text -- ^ prefix+            -> Text -- ^ suffix+            -> Text+            -> Maybe Text+textBetween pr su = Text.stripPrefix pr >=> Text.stripSuffix su+ recursiveQuery :: Text -> [Text] -> QM (Maybe PValue) recursiveQuery curquery prevqueries = do-  checkLoop curquery prevqueries-  rawlookups <- mapMaybe (preview (key curquery)) <$> view qhier-  lookups <- mapM (resolveValue (curquery : prevqueries)) rawlookups-  case lookups of-    [] -> return Nothing-    (x:xs) -> do+  let (varname:allkeys) = varSplitter curquery+  checkLoop varname prevqueries+  rawlookups <- mapMaybe (preview (key varname)) <$> view qhier+  let lookupKeys keys v =+        case keys of+          [] -> pure v+          k:ks ->+            case v of+              Object hs ->+                case hs ^? ix k of+                  Nothing -> Nothing+                  Just v' -> lookupKeys ks v'+              _ -> Nothing+  rlookups <- mapM (resolveValue (varname : prevqueries)) rawlookups+  let lookups = mapMaybe (lookupKeys allkeys) rlookups+  case traverse Aeson.fromJSON lookups of+    Aeson.Error rr -> throwError ("Something horrible happened in recursiveQuery: " <> fromString rr)+    Aeson.Success [] ->+      if null rlookups+        then return Nothing+        else throwError ("Could not lookup " <> fromString (Text.unpack curquery) <> " in " <> PrettyError (list (map (fromString . BS8.unpack . encode) rlookups)) )+    Aeson.Success (x:xs) -> do       qt <- view qtype-      let evalue = foldM (mergeWith qt) x xs-      case Aeson.fromJSON <$> evalue of-        Left _ ->  return Nothing-        Right (Aeson.Success o) -> return o-        Right (Aeson.Error rr) -> throwError ("Something horrible happened in recursiveQuery: " <> fromString rr)+      Just <$> foldM (mergeWith qt) x xs  resolveValue :: [Text] -> Value -> QM Value resolveValue prevqueries value =   case value of+    String t | Just alias <- Text.stripPrefix "%{alias('" t >>= Text.stripSuffix "')}" -> do+          mr <- recursiveQuery alias (("alias:" <> alias) : prevqueries)+          case mr of+            Nothing -> throwError ("Could not alias " <> fromString (Text.unpack alias))+            Just r -> pure (toJSON r)     String t  -> String <$> resolveText prevqueries t     Array arr -> Array <$> mapM (resolveValue prevqueries) arr     Object hh -> Object <$> mapM (resolveValue prevqueries) hh@@ -264,29 +306,42 @@ resolveStringPart prevqueries sp =   case sp of     HPString s -> return s+    HPVariable "" -> return ""     HPVariable varname -> do-      let varsolve = fmap PString . preview (ix varname) <$> view qvars-      r <- case Text.stripPrefix "lookup('" varname >>= Text.stripSuffix "')" of+      let rc vars val =+            case vars of+              [] -> pure val+              v:vs -> case val of+                        PHash m -> m ^? ix v >>= rc vs+                        _ -> Nothing+          extractFunction txt = textBetween (txt <> "('") "')" varname+                            <|> textBetween (txt <> "(\"") "\")" varname+      r <- case extractFunction "lookup" <|> extractFunction "hiera" <|> extractFunction "alias" of         Just lk -> recursiveQuery lk prevqueries-        Nothing -> varsolve+        Nothing -> do+            vmap <- view qvars+            let mvar:svars = varSplitter varname+            pure (vmap ^? ix mvar >>= rc svars)       case r of         Just (PString v) -> return v-        _                -> return mempty+        Just (PNumber s) -> pure (scientific2text s)+        Just pvalue      -> throwError (PrettyError ("Variable lookup for " <> fromString (Text.unpack varname) <> " did not return a string, but " <> pretty pvalue))+        _                -> throwError ("Could not lookup variable " <> fromString (Text.unpack varname)) -mergeWith :: HieraQueryType -> Value -> Value -> Either PrettyError Value+mergeWith :: MonadError PrettyError m => HieraQueryType -> PValue -> PValue -> m PValue mergeWith qt cur new =   case qt of     QFirst -> return cur     QUnique ->       let getArray x = case x of-              Array array -> Vector.toList array+              PArray array -> Vector.toList array               _           -> [x]           curarray = getArray cur           newarray = getArray new       in  case new of-              Object _ -> throwError "Tried to merge a hash"-              _        -> return (Array (Vector.fromList (List.nub (curarray ++ newarray))))+              PHash _  -> throwError "Tried to merge a hash"+              _        -> return (PArray (Vector.fromList (List.nub (curarray ++ newarray))))     QHash -> case (cur, new) of-      (Object curh, Object newh) -> return (Object (curh <> newh))+      (PHash curh, PHash newh) -> return (PHash (curh <> newh))       _ -> throwError (PrettyError ("Tried to merge things that are not hashes: " <> ppline (show cur) <+> ppline (show new)))     QDeep{} -> throwError "deep queries not supported"

@@ -152,6 +152,12 @@     isExternal = singleton . IsExternalModule . List.head . Text.splitOn "::"  -- Logging --+error :: MonadWriter InterpreterWriter m => Doc -> m ()+error d = tell [Log.ERROR :!: d]++critical :: MonadWriter InterpreterWriter m => Doc -> m ()+critical d = tell [Log.CRITICAL :!: d]+ warn :: MonadWriter InterpreterWriter m => Doc -> m () warn d = tell [Log.WARNING :!: d] 

@@ -69,7 +69,8 @@       GetNativeTypes               -> runInstr (r ^. readerNativeTypes)       ErrorThrow d                 -> return (Left d, s, mempty)       GetNodeName                  -> runInstr (r ^. readerNodename)-      HieraQuery scps q t          -> canFail (queryHiera (r ^. readerHieraQuery) scps q t)+      HieraQuery scps q t          ->+        runExceptT (queryHiera (r ^. readerHieraQuery) scps q t) >>= either thpe runInstr       PDBInformation               -> pdbInformation pdb >>= runInstr       PDBReplaceCatalog w          -> canFailX (replaceCatalog pdb w)       PDBReplaceFacts fcts         -> canFailX (replaceFacts pdb fcts)@@ -91,25 +92,24 @@           Left rr -> interpretMonad r s (ahandle rr >>= k)           Right x -> logStuff w (interpretMonad r s' (k x)) - -- query all hiera layers-queryHiera :: Monad m =>  HieraQueryLayers m -> Container Text -> Text -> HieraQueryType -> m (S.Either PrettyError (Maybe PValue))+queryHiera :: Monad m+           => HieraQueryLayers m+           -> Container PValue+           -> Text+           -> HieraQueryType+           -> ExceptT PrettyError m (Maybe PValue) queryHiera layers scps q t = do-  val0 <- (layers^.globalLayer) scps q t-  case val0 of-    S.Right Nothing -> do-      val1 <- (layers ^.environmentLayer) scps q t-      case val1 of-        S.Right Nothing -> query_modlayer-        _ -> pure val1-    _ -> pure val0-  where-    query_modlayer = do-      let-        modname =-          case Text.splitOn "::" (Text.dropWhile (==':') q) of-            []    -> Nothing-            [_]   -> Nothing-            (m:_) -> Just m-        layer = modname >>= (\n -> layers ^.moduleLayer.at n)-      maybe (pure $ S.Right Nothing) (\hq -> hq scps q t) layer+  eglobal <- (layers^.globalLayer) scps q t+  eenvironment <- (layers ^.environmentLayer) scps q t+  let modname =+        case Text.splitOn "::" (Text.dropWhile (==':') q) of+          []    -> Nothing+          [_]   -> Nothing+          (m:_) -> Just m+      layer = modname >>= (\n -> layers ^.moduleLayer.at n)+  emodle <- maybe (pure Nothing) (\hq -> hq scps q t) layer+  case catMaybes [eglobal, eenvironment, emodle] of+    [] -> pure Nothing+    x:xs -> Just <$> foldM (mergeWith t) x xs+

@@ -93,12 +93,17 @@ runHiera q t = do   -- We need to merge the current scope with the top level scope   scps <- use scopes-  ctx  <- getScopeName-  let getV scp = mapMaybe toStr $ HM.toList $ fmap (view (_1 . _1)) (scps ^. ix scp . scopeVariables)-      toStr (k,v) = fmap (k,) (preview _PString v)-      toplevels = map (_1 %~ ("::" <>)) $ getV "::"-      locals = getV ctx-      vars = HM.fromList (toplevels <> locals)+  curscopes <- use curScope+  let getV scp = HM.toList $ fmap (view (_1 . _1)) (scps ^. ix scp . scopeVariables)+      vars = HM.unions $ do+        curscp <- curscopes+        let sname = scopeName curscp+            curv = getV sname+            prefixVarname vname =+              case curscp of+                ContRoot -> "::" <> vname+                _ -> sname <> "::" <> vname+        [HM.fromList curv, HM.fromList (map (_1 %~ prefixVarname) curv)]   Operational.singleton (HieraQuery vars q t)  -- | The implementation of all lookup functions@@ -108,7 +113,7 @@   qs <- resolvePValueString q   runHiera qs qt >>= \case     Just p  -> case dt of-      Just dt' | not (datatypeMatch dt' p) -> throwPosError "Datatype mismatched"+      Just dt' | not (datatypeMatch dt' p) -> throwPosError ("Datatype mismatched :" <+> pretty dt' <+> "/" <+> pretty p)       _        -> pure p     Nothing -> case df of       Just d  -> pure d@@ -331,10 +336,8 @@   case (ra, rb) of       (PArray ha, v) -> pure (PArray (V.snoc ha v))       _              -> integerOperation a b (\x -> shiftL x . fromIntegral)-resolveExpression a@(FunctionApplication e (Terminal (UHOLambdaCall hol))) = do-  unless (null (hol ^. hoLambdaExpr))-    (throwPosError ("You can't combine chains of higher order functions (with .) and giving them parameters, in:" <+> pretty a))-  resolveValue (UHOLambdaCall (hol & hoLambdaExpr .~ V.singleton e))+resolveExpression (FunctionApplication e (Terminal (UHOLambdaCall hol))) =+    resolveValue (UHOLambdaCall (hol & hoLambdaExpr <>~ V.singleton e)) resolveExpression (FunctionApplication _ x) = throwPosError ("Expected function application here, not" <+> pretty x) resolveExpression (Negate x) = PNumber . negate <$> resolveExpressionNumber x @@ -566,7 +569,7 @@ resolveFunction' "hiera_hash"  [q,d,o] = hieraCall QHash  q (Just d) Nothing (Just o) resolveFunction' "lookup"      [q]                        = hieraCall QFirst   q Nothing  Nothing Nothing resolveFunction' "lookup"      [q, PType dt]              = hieraCall QFirst   q Nothing (Just dt) Nothing-resolveFunction' "lookup"      [q, PType dt, PString qt, def] = do+resolveFunction' "lookup"      [q, PType dt, PString qt, def] =   case readQueryType qt of     Nothing -> throwPosError ("Unknown merge strategy " <> ppline qt)     Just qt' -> hieraCall qt' q (Just def) (Just dt) Nothing@@ -797,6 +800,30 @@         PArray ar -> pure $ PArray $ V.map fst $ V.filter snd $ V.zip ar (V.fromList res)         PHash  hh -> pure $ PHash  $ HM.fromList $ map fst $ filter snd $ zip (HM.toList hh) res         x         -> throwPosError ("Can't iterate on this data type:" <+> pretty x)+    LambdaFunc "reduce" ->+      case hol ^.. hoLambdaExpr . folded of+        [zero', foldable'] -> do+          zero'' <- resolveExpression zero'+          foldable'' <- resolveExpression foldable'+          (accname, curname) <- case hol ^.. hoLambdaParams . folded of+                                  [an, cn] -> pure (an, cn)+                                  _ -> throwPosError ("Reduce requires two parameters in its block expression, in" <+> pretty hol)+          let runStep acc cur = do+                accName <- mCheckType acc accname+                curName <- mCheckType cur curname+                runblock [(accName, acc), (curName, cur)]+              mCheckType vl (LambdaParam mt nm) = do+                forM_ mt $ \ut -> do+                  t <- resolveDataType ut+                  checkMatch t vl+                pure nm+          case foldable'' of+            PArray ar -> foldM runStep zero'' ar+            PHash hs -> foldM runStep zero'' $ do+              (k,v) <- HM.toList hs+              return (PArray (V.fromList [PString k, v]))+            x -> throwPosError ("Can't iterate on this data type:" <+> pretty x)+        _ -> throwPosError ("Reduce requires two arguments and a lambda block, in" <+> pretty hol)     x -> throwPosError ("This type of lambda function is not supported yet by language-puppet!" <+> pretty x)  -- | Checks that a value matches a puppet datatype

@@ -238,7 +238,7 @@   ExternalFunction      :: Text -> [PValue] -> InterpreterInstr PValue   Facts                 :: InterpreterInstr (Container PValue)   GetNodeName           :: InterpreterInstr Text-  HieraQuery            :: Container Text -> Text -> HieraQueryType -> InterpreterInstr (Maybe PValue)+  HieraQuery            :: Container PValue -> Text -> HieraQueryType -> InterpreterInstr (Maybe PValue)   GetCurrentCallStack   :: InterpreterInstr [String]   IsIgnoredModule       :: Text -> InterpreterInstr Bool   IsExternalModule      :: Text -> InterpreterInstr Bool

@@ -128,7 +128,7 @@       Left err -> do         let !msg = "At " <> showPPos'(intpstate^.curPos) <> " the evaluation of template '" <> template_src <> "' failed. " <> show err       -- if the haskell evaluation fails the ruby one will fallback. It is likely that the reason for the failure is a real template issue.-        logCriticalStr msg+        logErrorStr msg         measure mstats ("ruby efail - " <> toS template_src) $ mkSafe $ computeTemplateWRuby srcinfo curcontext variables intpstate intpreader   traceEventIO ("STOP template " <> template_src)   pure o@@ -136,7 +136,7 @@ getRubyScriptPath :: String -> IO String getRubyScriptPath rubybin = do   let checkpath :: FilePath -> IO FilePath -> IO FilePath-      checkpath fp nxt = do+      checkpath fp nxt =         ifM (fileExist fp)           (pure fp)           nxt@@ -200,7 +200,7 @@   contentinfo <- case fileinfo of     Filename fname -> FR.toRuby (Text.pack fname)     Inline _      -> FR.toRuby ("-" :: Text)-  let withBinding f = do+  let withBinding f =         FR.safeMethodCall "ErbBinding" "new" [rscp,rvariables,rstt,rrdr,contentinfo] >>= \case           Left x -> pure (Left x)           Right v -> do

@@ -78,8 +78,8 @@     mempty   where     pure_hiera :: HieraQueryFunc Identity-    pure_hiera _ _ _ = pure (S.Right hiera)-    hieradummy = HieraQueryLayers pure_hiera pure_hiera mempty+    pure_hiera _ _ _ = pure hiera+    hieradummy = HieraQueryLayers pure_hiera (\_ _ _ -> pure Nothing) mempty     getstatementdummy tlt n = return $ case HM.lookup (tlt,n) sttmap of       Just x  -> S.Right x       Nothing -> S.Left "Can't get statement"

@@ -22,6 +22,7 @@ import qualified System.FilePath                  as FilePath  import           Puppet.Interpreter+import           Puppet.Interpreter.Helpers  -- | Contains the implementation of the StdLib functions. stdlibFunctions :: Container ( [PValue] -> InterpreterMonad PValue )@@ -241,7 +242,7 @@         "encode" -> return (B16.encode b)         "decode" -> case B16.decode b of                       (x, "") -> return x-                      _       -> throwPosError ("base64(): could not decode" <+> pretty pb)+                      _       -> error ("base64(): could not decode" <+> pretty pb) *> pure mempty         a        -> throwPosError ("base64(): the first argument must be either 'encode' or 'decode', not" <+> ppline a)   pure $ PString (decodeUtf8 r) base64 _ = throwPosError "base64(): Expects 2 arguments"

@@ -16,7 +16,6 @@ import           Puppet.Language import           PuppetDB.Core - type PDBAPIv3 =    "nodes"     :> QueryParam "query" (Query NodeField)       :> Get '[JSON] [NodeInfo]               :<|> "nodes"     :> Capture "resourcename" Text :> "resources" :> QueryParam "query" (Query ResourceField) :> Get '[JSON] [Resource]               :<|> "facts"     :> QueryParam "query" (Query FactField)       :> Get '[JSON] [FactInfo]@@ -32,6 +31,10 @@ mkClientEnv = ClientEnv #endif +#if !MIN_VERSION_servant_client(0,16,0)+#define ClientError ServantError+#endif+ -- | Given an URL (ie. @http://localhost:8080@), will return an incomplete 'PuppetDBAPI'. pdbConnect :: Manager -> String -> IO (Either PrettyError (PuppetDBAPI IO)) pdbConnect mgr url = do@@ -54,5 +57,5 @@    sgetResources :: Maybe (Query ResourceField) -> ClientM [Resource]    (sgetNodes :<|> sgetNodeResources :<|> sgetFacts :<|> sgetResources) = client api -   prettyError :: IO (Either ServantError b)  -> ExceptT PrettyError IO b+   prettyError :: IO (Either ClientError b)  -> ExceptT PrettyError IO b    prettyError = ExceptT . fmap (_Left %~ PrettyError . pplines . show)

@@ -19,6 +19,7 @@     , logWarning     , logWarningStr     , logError+    , logErrorStr     , logCritical     , logCriticalStr ) where@@ -121,6 +122,9 @@  logError :: Text -> IO () logError = Log.errorM "language-puppet" . toS++logErrorStr :: String -> IO ()+logErrorStr = Log.errorM "language-puppet"  logCritical :: Text -> IO () logCritical = Log.criticalM "language-puppet" . toS

@@ -28,6 +28,9 @@   , ("<%= scope.lookupvar('::fqdn') %>", [ Puts (Value (Literal ""))                                          , Puts (ScopeObject (Value (Literal "::fqdn")))                                          , Puts(Value (Literal ""))])+  , ("<%= scope.lookupvar(\"::fqdn\") %>", [ Puts (Value (Literal ""))+                                           , Puts (ScopeObject (Value (Literal "::fqdn")))+                                           , Puts(Value (Literal ""))])   ]  resolvetests :: [([RubyStatement], Text)]

@@ -1,9 +1,7 @@-{-# LANGUAGE QuasiQuotes #-} module HieraSpec(spec) where  import           XPrelude -import qualified Data.Either.Strict  as S import qualified Data.HashMap.Strict as HM import qualified Data.Vector         as Vector import qualified System.Log.Logger   as Log@@ -12,69 +10,219 @@ import           Hiera.Server import           Puppet.Language -checkOutput v (S.Right x) = x `shouldBe` v-checkOutput _ (S.Left rr) = expectationFailure (show rr)+checkOutput :: (Eq a, Show rr, Show a) => a -> Either rr a -> Expectation+checkOutput v (Right x) = x `shouldBe` v+checkOutput _ (Left rr) = expectationFailure (show rr) +checkFail :: (Show a) => Either rr a -> Expectation+checkFail (Right v) = expectationFailure ("Should have failed, but returned: " ++ show v)+checkFail _ = return ()++fqdn :: Text fqdn = "node.com"++config_v3 :: FilePath config_v3 = "./tests/hiera/hiera-v3.yaml"++config_v5 :: FilePath config_v5 = "./tests/hiera/hiera-v5.yaml" +configInterpolate :: FilePath+configInterpolate = "./tests/hiera/interpolate/config/hiera.yaml"++vars :: HM.HashMap Text PValue vars = HM.fromList [ ("::environment", "production")-                   , ("::fqdn"       , fqdn)+                   , ("::fqdn"       , PString fqdn)                    ]++users :: HM.HashMap Text PValue users = HM.fromList [ ("pete", PHash (HM.singleton "uid" (PNumber 2000)))                     , ("tom" , PHash (HM.singleton "uid" (PNumber 2001)))                     ]++pusers :: HM.HashMap Text PValue pusers = HM.fromList [ ("bob", PHash (HM.singleton "uid" (PNumber 100)))                      , ("tom" , PHash (HM.singleton "uid" (PNumber 12)))                      ] +hash :: [(Text, PValue)] -> PValue+hash = PHash . HM.fromList++array :: [PValue] -> PValue+array = PArray . Vector.fromList++spec :: Spec spec = do   runIO $ Log.updateGlobalLogger loggerName (Log.setLevel Log.WARNING)-  q3 <- runIO $ startHiera "test" config_v3-  q5 <- runIO $ startHiera "test" config_v5+  q3_ <- runIO $ startHiera "test" config_v3+  q5_ <- runIO $ startHiera "test" config_v5+  let q5 vrs var t = runExceptT (q5_ vrs var t)+      q3 vrs var t = runExceptT (q3_ vrs var t)   describe "Hiera" $ do-  describe "v5 lookup hierarchy" $ do-    it "should override some values"  $ do-      q5 vars "http_port" QFirst >>= checkOutput (Just (PNumber 9090))-      q5 vars "global" QFirst >>= checkOutput (Just "glob")-  describe "v5 ~" $ do-    it "should read '~' as a Null/Nothing value"  $ do-      q5 vars "optional_value" QFirst >>= checkOutput Nothing-  describe "v3 lookup with no context variables" $ do-    it "should return nothing when called with an empty string" $-      q3 mempty "" QFirst >>= checkOutput Nothing-    it "should return nothing when called with a non existent key [First merge]" $-      q3 mempty "foo" QFirst >>= checkOutput Nothing-    it "should return nothing when called with a non existent key [Unique merge]" $-      q3 mempty "foo" QUnique >>= checkOutput Nothing-    it "should return nothing when called with a non existent key [Hash merge]" $-      q3 mempty "foo" QHash >>= checkOutput Nothing-    it "should return common data" $-      q3 mempty "http_port" QFirst >>= checkOutput (Just (PNumber 8080))-    it "should return arrays" $-      q3 mempty "ntp_servers" QFirst >>= checkOutput (Just (PArray (Vector.fromList ["0.ntp.puppetlabs.com","1.ntp.puppetlabs.com"])))-    it "should return hashes" $-      q3 mempty "users" QFirst >>= checkOutput (Just (PHash users))-  describe "v3 lookup hierarchy" $ do-    it "should override value" $-      q3 vars "http_port" QFirst >>= checkOutput (Just (PNumber 9090))-    it "should find common value" $-      q3 vars "global" QFirst >>= checkOutput (Just "glob")-  describe "v3 json backend" $-    it "resolves in json" $-      q3 vars "testjson" QFirst >>= checkOutput (Just "ok")-  describe "v3 deep interpolation" $ do-    it "resolves in strings" $-      q3 vars "interp1" QFirst >>= checkOutput (Just (PString ("**" <> fqdn <> "**")))-    it "resolves in objects" $-      q3 vars "testnode" QFirst >>= checkOutput (Just (PHash (HM.fromList [("1",PString ("**" <> fqdn <> "**")),("2",PString "nothing special")])))-    it "resolves in arrays" $-      q3 vars "arraytest" QFirst >>= checkOutput (Just (PArray (Vector.fromList [PString "a", PString fqdn, PString "c"])))-  describe "v3 other merge modes" $ do-    it "catenates arrays" $-      q3 vars "ntp_servers" QUnique >>= checkOutput (Just (PArray (Vector.fromList ["2.ntp.puppetlabs.com","3.ntp.puppetlabs.com","0.ntp.puppetlabs.com","1.ntp.puppetlabs.com"])))-    it "puts single values in arrays" $-      q3 vars "http_port" QUnique >>= checkOutput (Just (PArray (Vector.fromList [PNumber 9090, PNumber 8080])))-    it "merges hashes" $-      q3 vars "users" QHash >>= checkOutput (Just (PHash (pusers <> users)))+    interpolationSpec+    describe "v5 lookup hierarchy" $+      it "should override some values"  $ do+        q5 vars "http_port" QFirst >>= checkOutput (Just (PNumber 9090))+        q5 vars "global" QFirst >>= checkOutput (Just "glob")+    describe "v5 ~" $+      it "should read '~' as a Null/Nothing value"  $+        q5 vars "optional_value" QFirst >>= checkOutput (Just PUndef)+    describe "v3 lookup with no context variables" $ do+      it "should return nothing when called with an empty string" $+        q3 mempty "" QFirst >>= checkOutput Nothing+      it "should return nothing when called with a non existent key [First merge]" $+        q3 mempty "foo" QFirst >>= checkOutput Nothing+      it "should return nothing when called with a non existent key [Unique merge]" $+        q3 mempty "foo" QUnique >>= checkOutput Nothing+      it "should return nothing when called with a non existent key [Hash merge]" $+        q3 mempty "foo" QHash >>= checkOutput Nothing+      it "should return common data" $+        q3 mempty "http_port" QFirst >>= checkOutput (Just (PNumber 8080))+      it "should return arrays" $+        q3 mempty "ntp_servers" QFirst >>= checkOutput (Just (array ["0.ntp.puppetlabs.com","1.ntp.puppetlabs.com"]))+      it "should return hashes" $+        q3 mempty "users" QFirst >>= checkOutput (Just (PHash users))+    describe "v3 lookup hierarchy" $ do+      it "should override value" $+        q3 vars "http_port" QFirst >>= checkOutput (Just (PNumber 9090))+      it "should find common value" $+        q3 vars "global" QFirst >>= checkOutput (Just "glob")+    describe "v3 json backend" $+      it "resolves in json" $+        q3 vars "testjson" QFirst >>= checkOutput (Just "ok")+    describe "v3 deep interpolation" $ do+      it "resolves in strings" $+        q3 vars "interp1" QFirst >>= checkOutput (Just (PString ("**" <> fqdn <> "**")))+      it "resolves in objects" $+        q3 vars "testnode" QFirst >>= checkOutput (Just (hash [("1",PString ("**" <> fqdn <> "**")),("2",PString "nothing special")]))+      it "resolves in arrays" $+        q3 vars "arraytest" QFirst >>= checkOutput (Just (array [PString "a", PString fqdn, PString "c"]))+      it "resolves aliases" $+        q3 vars "aliased" QFirst >>= checkOutput (Just (array [PString "a", PString "b"]))+      it "resolves integers to strings" $+        q3 vars "server" QFirst >>= checkOutput (Just (PString "127.0.0.1:9090"))+      it "resolves lookus" $+        q3 vars "aliased_lookup" QFirst >>= checkOutput (Just (PNumber 100))+    describe "v3 other merge modes" $ do+      it "catenates arrays" $+        q3 vars "ntp_servers" QUnique >>= checkOutput (Just (array ["2.ntp.puppetlabs.com","3.ntp.puppetlabs.com","0.ntp.puppetlabs.com","1.ntp.puppetlabs.com"]))+      it "puts single values in arrays" $+        q3 vars "http_port" QUnique >>= checkOutput (Just (array [PNumber 9090, PNumber 8080]))+      it "merges hashes" $+        q3 vars "users" QHash >>= checkOutput (Just (PHash (pusers <> users)))++interpolationSpec :: Spec+interpolationSpec =+  describe "interpolation" $ do+    q_ <- runIO $ startHiera "test" configInterpolate+    let q vrs var t = runExceptT (q_ vrs var t)+    describe "when doing interpolation" $ do+      it "should prevent endless recursion" $+        q mempty "foo" QFirst >>= checkFail+      it "produces a nested hash with arrays from nested aliases with hashes and arrays" $+        q mempty "root" QHash >>= checkOutput (Just (hash [("a", hash [("aa", hash [("b", hash [("bb", PArray (Vector.fromList ["text"]))])])])]))+      it "allows keys with white space" $+        q mempty "ws_key" QFirst >>= checkOutput (Just "value for a ws key")+      it "allows keys with non alphanumeric characters" $+        q mempty "angry" QFirst >>= checkOutput (Just "not happy")++    describe "when not finding value for interpolated key" $+      it "should resolve the interpolation to an empty string" $+        q mempty "niltest" QFirst >>= checkFail -- puppet behavior: checkOutput (Just "Missing key ##. Key with nil ##")++    describe "when there are empty interpolations %{} in data" $ do+      it "should should produce an empty string for the interpolation" $ do+        pendingWith "Support empty interpolation"+        q mempty "empty_interpolation" QFirst >>= checkOutput (Just "clownshoe")+      it "the empty interpolation can be escaped" $ do+        pendingWith "Support empty interpolation"+        q mempty "escaped_empty_interpolation" QFirst >>= checkOutput (Just "clown%{shoe}s")+      it "the value can consist of only an empty escape" $ do+        pendingWith "Support empty interpolation"+        q mempty "only_empty_interpolation" QFirst >>= checkOutput (Just "")+      it "the value can consist of an empty namespace %{::}" $ do+        pendingWith "Support empty interpolation"+        q mempty "empty_namespace" QFirst >>= checkOutput (Just "")+      it "the value can consist of whitespace %{ :: }" $ do+        pendingWith "Support empty interpolation"+        q mempty "whitespace1" QFirst >>= checkOutput (Just "")+      it "the value can consist of whitespace %{  }" $ do+        pendingWith "Support empty interpolation"+        q mempty "whitespace2" QFirst >>= checkOutput (Just "")++    describe "when there are quoted empty interpolations %{} in data" $ do+      it "should should produce an empty string for the interpolation" $ do+        pendingWith "Support empty interpolation"+        q mempty "quoted_empty_interpolation" QFirst >>= checkOutput (Just "clownshoe")+      it "the empty interpolation can be escaped" $ do+        pendingWith "Support empty interpolation"+        q mempty "quoted_escaped_empty_interpolation" QFirst >>= checkOutput (Just "clown%{shoe}s")+      it "the value can consist of only an empty escape" $ do+        pendingWith "Support empty interpolation"+        q mempty "quoted_only_empty_interpolation" QFirst >>= checkOutput (Just "")+      it "the value can consist of an empty namespace %{::}" $ do+        pendingWith "Support empty interpolation"+        q mempty "quoted_empty_namespace" QFirst >>= checkOutput (Just "")+      it "the value can consist of whitespace %{ :: }" $ do+        pendingWith "Support empty interpolation"+        q mempty "quoted_whitespace1" QFirst >>= checkOutput (Just "")+      it "the value can consist of whitespace %{  }" $ do+        pendingWith "Support empty interpolation"+        q mempty "quoted_whitespace2" QFirst >>= checkOutput (Just "")++    describe "varsplitter" $ do+      it "no splitting" $ varSplitter "abcd" `shouldBe` ["abcd"]+      it "split 2" $ varSplitter "ab.cd" `shouldBe` ["ab", "cd"]+      it "split 3" $ varSplitter "ab.cd.ef" `shouldBe` ["ab", "cd", "ef"]+      it "split dq" $ varSplitter "\"ab\"" `shouldBe` ["ab"]+      it "split dq 2" $ varSplitter "\"ab.cd\"" `shouldBe` ["ab.cd"]+      it "split dq 2 mixed" $ varSplitter "\"ab.cd\".ef" `shouldBe` ["ab.cd", "ef"]+      it "split dq 2 mixed 4" $ varSplitter "\"ab.cd\".ef.\"lol.cat\".bar" `shouldBe` ["ab.cd", "ef", "lol.cat", "bar"]+      it "split sq" $ varSplitter "'ab'" `shouldBe` ["ab"]+      it "split sq 2" $ varSplitter "'ab.cd'" `shouldBe` ["ab.cd"]+      it "split sq 2 mixed" $ varSplitter "'ab.cd'.ef" `shouldBe` ["ab.cd", "ef"]+      it "split sq 2 mixed 4" $ varSplitter "'ab.cd'.ef.'lol.cat'.bar" `shouldBe` ["ab.cd", "ef", "lol.cat", "bar"]+      it "split all mixed" $ varSplitter "'a.b'.\"c.d\".e.f" `shouldBe` ["a.b", "c.d", "e", "f"]++    describe "when using dotted keys" $ do+      it "should find an entry using a quoted interpolation" $+        q (HM.fromList [("a.b", "(scope) a dot b")]) "\"a.c.scope\"" QFirst >>= checkOutput (Just "a dot c: (scope) a dot b")+      it "should find an entry using a quoted interpolation with method hiera" $+        q (HM.fromList [("a.b", "(scope) a dot b")]) "\"a.c.hiera\"" QFirst >>= checkOutput (Just "a dot c: (hiera) a dot b")+      it "should find an entry using a quoted interpolation with method alias" $+        q (HM.fromList [("a.b", "(scope) a dot b")]) "\"a.c.alias\"" QFirst >>= checkOutput (Just "(hiera) a dot b")+      it "should use a dotted key to navigate into a structure when it is not quoted" $+        q (HM.fromList [("a", hash [("d", "(scope) a dot d is a hash entry")])]) "\"a.e.scope\"" QFirst >>= checkOutput (Just "a dot e: (scope) a dot d is a hash entry")+      it "should use a dotted key to navigate into a structure when when it is not quoted with method hiera" $+        q (HM.fromList [("a", hash [("d", "(scope) a dot d is a hash entry")])]) "\"a.e.hiera\"" QFirst >>= checkOutput (Just "a dot e: (hiera) a dot d is a hash entry")+      it "should use a mix of quoted and dotted keys to navigate into a structure containing dotted keys and quoted key is last" $+        q (HM.fromList [("a", hash [("d.x", "(scope) a dot d.x is a hash entry")])]) "\"a.ex.scope\"" QFirst >>= checkOutput (Just "a dot ex: (scope) a dot d.x is a hash entry")+      it "should use a mix of quoted and dotted keys to navigate into a structure containing dotted keys and quoted key is last and method is hiera" $+        q (HM.fromList [("a", hash [("d.x", "(scope) a dot d.x is a hash entry")])]) "\"a.ex.hiera\"" QFirst >>= checkOutput (Just "a dot ex: (hiera) a dot d.x is a hash entry")+      it "should use a mix of quoted and dotted keys to navigate into a structure containing dotted keys and quoted key is first" $+        q (HM.fromList [("a.x", hash [("d", "(scope) a.x dot d is a hash entry")])]) "\"a.xe.scope\"" QFirst >>= checkOutput (Just "a dot xe: (scope) a.x dot d is a hash entry")+      it "should use a mix of quoted and dotted keys to navigate into a structure containing dotted keys and quoted key is first and method is hiera" $+        q (HM.fromList [("a.x", hash [("d", "(scope) a.x dot d is a hash entry")])]) "\"a.xe.hiera\"" QFirst >>= checkOutput (Just "a dot xe: (hiera) a.x dot d is a hash entry")+      it "should use a mix of quoted and dotted keys to navigate into a structure containing dotted keys and quoted key is in the middle" $+        q (HM.fromList [("a", hash [("d.z", hash [("g", "(scope) a dot d.z dot g is a hash entry")])])]) "\"a.xm.scope\"" QFirst >>= checkOutput (Just "a dot xm: (scope) a dot d.z dot g is a hash entry")+      it "should use a mix of quoted and dotted keys to navigate into a structure containing dotted keys and quoted key is in the middle and method is hiera" $+        q (HM.fromList [("a", hash [("d.z", hash [("g", "(scope) a dot d.z dot g is a hash entry")])])]) "\"a.xm.hiera\"" QFirst >>= checkOutput (Just "a dot xm: (hiera) a dot d.z dot g is a hash entry")+      it "should use a mix of several quoted and dotted keys to navigate into a structure containing dotted keys and quoted key is in the middle" $+        q (HM.fromList [("a.x", hash [("d.z", hash [("g", "(scope) a.x dot d.z dot g is a hash entry")])])]) "\"a.xx.scope\"" QFirst >>= checkOutput (Just "a dot xx: (scope) a.x dot d.z dot g is a hash entry")+      it "should use a mix of several quoted and dotted keys to navigate into a structure containing dotted keys and quoted key is in the middle and method is hiera" $+        q (HM.fromList [("a.x", hash [("d.z", hash [("g", "(scope) a.x dot d.z dot g is a hash entry")])])]) "\"a.xx.hiera\"" QFirst >>= checkOutput (Just "a dot xx: (hiera) a.x dot d.z dot g is a hash entry")+      it "should find an entry using using a quoted interpolation on dotted key containing numbers" $+        q (HM.fromList [("x.1", "(scope) x dot 1")]) "\"x.2.scope\"" QFirst >>= checkOutput (Just "x dot 2: (scope) x dot 1")+      it "should find an entry using using a quoted interpolation on dotted key containing numbers using method hiera" $+        q (HM.fromList [("x.1", "(scope) x dot 1")]) "\"x.2.hiera\"" QFirst >>= checkOutput (Just "x dot 2: (hiera) x dot 1")+      it "will allow strange characters in the key" $+        q mempty "very_angry" QFirst >>= checkOutput (Just "not happy at all")+      it "should not find a subkey when the dotted key is quoted" $+        q (HM.fromList [("a", hash [("f", "(scope) a dot f is a hash entry")])]) "\"a.f.scope\"" QFirst >>= checkFail -- real hiera : checkOutput (Just "a dot f: ")+      it "should not find a subkey when the dotted key is quoted with method hiera" $+        q (HM.fromList [("a", hash [("f", "(scope) a dot f is a hash entry")])]) "\"a.f.hiera\"" QFirst >>= checkFail -- real hiera : checkOutput (Just "a dot f: ")+      it "should not find a subkey that is matched within a string" $+        q mempty "ipl_key" QFirst >>= checkFail+      it "should not find a subkey that is matched within a string" $+        q mempty "key.subkey" QFirst >>= checkFail+

@@ -5,11 +5,15 @@ main :: IO () main = hspec spec +fname :: Text fname = "lookup"+expectedErrMsg :: String expectedErrMsg = "Wrong set of arguments"  -- See dummyFacts defined in Pure.hs+testkey :: Expression testkey = "foo"+expectedValue :: Text expectedValue = "dummy"  checkSuccess :: [Expression] -> Text -> Expectation@@ -18,6 +22,7 @@ checkError :: [Expression] -> String -> Expectation checkError = checkExprsError fname +boolDatatype, stringDatatype :: Expression boolDatatype = Terminal (UDataType UDTBoolean) stringDatatype = Terminal (UDataType (UDTString Nothing Nothing)) 

@@ -0,0 +1,14 @@+:backends:+  - yaml++:hierarchy:+  - recursive+  - niltest+  - complex+  - empty_%{}inter%{::}polation+  - dotted_keys+  - weird_keys+  - bad_interpolation++:yaml:+  :datadir: '../data'

@@ -0,0 +1,6 @@+:backends:+  - json++:hierarchy:+  - role+  - "%{hiera('role')}"

@@ -0,0 +1,5 @@+:backends:+  - yaml++:hierarchy:+  - "%{hiera('role')}"

@@ -0,0 +1,9 @@+---+quote_mismatch: 'Key delimited with singe quote on one side aand double qoute on the other: %{''the.key"}'+quote_mismatch_arg: 'Arg delimited with singe quote on one side and double qoute on the other: %{hiera(''the.key")}'+non_existing_method: 'The method flubber does not exist: %{flubber("hello")}'++one_quote: 'Key with only one quote: %{the.''key}'+empty_segment: 'Key with only one quote: %{the..key}'+empty_quoted_segment: 'Key with only one quote: %{the.''''.key}'+partly_quoted_segment: 'Key with only one quote: %{the.''pa''key}'

@@ -0,0 +1,12 @@+---+root:+  a:+    aa: "%{alias('aaa')}"++aaa:+  b:+    bb: "%{alias('bbb')}"++bbb: [ "%{alias('ccc')}" ]++ccc: text

@@ -0,0 +1,43 @@+---+a.b: '(hiera) a dot b'+a.c.scope: "a dot c: %{'a.b'}"+a.c.hiera: 'a dot c: %{hiera("''a.b''")}'+a.c.scope: "a dot c: %{'a.b'}"+a.c.hiera: 'a dot c: %{hiera("''a.b''")}'+a.c.alias: '%{alias("''a.b''")}'+a:+  d: '(hiera) a dot d is a hash entry'+  d.x: '(hiera) a dot d.x is a hash entry'+  d.z:+    g: '(hiera) a dot d.z dot g is a hash entry'++a.x:+  d: '(hiera) a.x dot d is a hash entry'+  d.x: '(hiera) a.x dot d.x is a hash entry'+  d.z:+    g: '(hiera) a.x dot d.z dot g is a hash entry'++a.e.scope: "a dot e: %{a.d}"+a.e.hiera: "a dot e: %{hiera('a.d')}"++a.ex.scope: "a dot ex: %{a.'d.x'}"+a.ex.hiera: 'a dot ex: %{hiera("a.''d.x''")}'++a.xe.scope: "a dot xe: %{'a.x'.d}"+a.xe.hiera: 'a dot xe: %{hiera("''a.x''.d")}'++a.xm.scope: "a dot xm: %{a.'d.z'.g}"+a.xm.hiera: 'a dot xm: %{hiera("a.''d.z''.g")}'++a.xx.scope: "a dot xx: %{'a.x'.'d.z'.g}"+a.xx.hiera: 'a dot xx: %{hiera("''a.x''.''d.z''.g")}'++a.f.scope: "a dot f: %{'a.d'}"+a.f.hiera: 'a dot f: %{hiera("''a.d''")}'++x.1: '(hiera) x dot 1'+x.2.scope: "x dot 2: %{'x.1'}"+x.2.hiera: 'x dot 2: %{hiera("''x.1''")}'++key: subkey+ipl_key: '- %{hiera("key.subkey")} -'

@@ -0,0 +1,13 @@+empty_interpolation: 'clown%{}shoe'+escaped_empty_interpolation: 'clown%%{}{shoe}s'+only_empty_interpolation: '%{}'+empty_namespace: '%{::}'+whitespace1: '%{ :: }'+whitespace2: '%{   }'++quoted_empty_interpolation: 'clown%{""}shoe'+quoted_escaped_empty_interpolation: 'clown%%{""}{shoe}s'+quoted_only_empty_interpolation: '%{""}'+quoted_empty_namespace: '%{"::"}'+quoted_whitespace1: '%{ "::" }'+quoted_whitespace2: '%{ "" }'

@@ -0,0 +1,2 @@+niltest: 'Missing key #%{hiera("knotfound")}#. Key with nil #%{hiera("knil")}#'+knil: null

@@ -0,0 +1,3 @@+foo: '%{hiera("bar")}'++bar: '%{hiera("foo")}'

@@ -0,0 +1,12 @@+---++'a key with whitespace': 'value for a ws key'+ws_key: '%{alias("a key with whitespace")}'++'#@!&%|§': 'not happy'+angry: '%{alias("#@!&%|§")}'++'!$\%!':+  '#@!&%|§': 'not happy at all'++very_angry: '%{alias("!$\%!.#@!&%|§")}'

@@ -7,3 +7,9 @@     uid: 100   tom:     uid: 12+original:+  - a+  - b+aliased: "%{alias('original')}"+server: "127.0.0.1:%{lookup('http_port')}"+aliased_lookup: "%{alias('users.bob.uid')}"