language-puppet 1.3.3 → 1.3.4

raw patch · 4 files changed

+38/−4 lines, 4 files

Files

• CHANGELOG.markdown +4/−0
• Puppet/Interpreter.hs +32/−2
• Puppet/OptionalTests.hs +1/−1
• language-puppet.cabal +1/−1

@@ -1,3 +1,7 @@+# v1.3.4 (2016/12/14)++* Adds implicit dependencies for some types where users and groups are defined+ # v1.3.3 (2016/12/05)  * Rename some pdbquery subcommands

@@ -229,10 +229,38 @@                     ExportedRealized -> i curr :!: i cure                     _ -> curr :!: cure     verified <- HM.fromList . map (\r -> (r ^. rid, r)) <$> mapM validateNativeType (HM.elems real)-    edgemap <- makeEdgeMap verified+    withResourceDependentRelations <- traverse getResourceDependentRelations verified+    edgemap <- makeEdgeMap withResourceDependentRelations     definedRes <- use definedResources-    return (verified, edgemap, exported, HM.elems definedRes)+    return (withResourceDependentRelations, edgemap, exported, HM.elems definedRes) +-- | This extracts additional relationships between resources, that are+-- dependent on whether some resources are defined. A canonical example is+-- is the 'owner' field in a File, that can create problems if it's+-- defined!+--+-- For this reason, this function only adds dependencies when the resources+-- are defined.+getResourceDependentRelations :: Resource -> InterpreterMonad Resource+getResourceDependentRelations res = extract $ case res ^. rid . itype of+                                                  "file" -> [depOn "user" "owner", depOn "group" "group"]+                                                  "cron" -> [depOn "user" "user"]+                                                  "exec" -> [depOn "user" "user", depOn "group" "group"]+                                                  _ -> []+    where+        extract actions = do+            newrelations <- fmap (foldl' (HM.unionWith (<>)) (res ^. rrelations)) (sequence actions)+            return (res & rrelations .~ newrelations)+        depOn :: Text -> Text -> InterpreterMonad (HM.HashMap RIdentifier (HS.HashSet LinkType))+        depOn resType attributeName = case res ^? rattributes . ix attributeName of+                                              Just (PString usr) -> do+                                                  let targetResourceId = RIdentifier resType usr+                                                  existing <- has (ix targetResourceId) <$> use definedResources+                                                  return $ if existing+                                                               then HM.singleton targetResourceId (HS.singleton RRequire)+                                                               else HM.empty+                                              _ -> return HM.empty+ makeEdgeMap :: FinalCatalog -> InterpreterMonad EdgeMap makeEdgeMap ct = do     -- merge the loaded classes and resources@@ -262,11 +290,13 @@                newmap = ifromListWith (<>) resresources                resid = r ^. rid                respos = r ^. rpos+               resresources :: [(RIdentifier, [LinkInformation])]                resresources = do                    (rawdst, lts) <- itoList (r ^. rrelations)                    lt <- toList lts                    let (nsrc, ndst, nlt) = reorderlink (resid, rawdst, lt)                    return (nsrc, [LinkInformation nsrc ndst nlt respos])+        step1 :: HM.HashMap RIdentifier [LinkInformation]         step1 = foldl' addRR mempty ct     -- step 2 - add other relations (mainly stuff made from the "->"     -- operator)

@@ -35,7 +35,7 @@         checkResource' lu lg res = do             let msg att name = align (vsep [ "Resource" <+> ttext (res^.rid.itype)                                              <+> ttext (res^.rid.iname) <+> showPos (res^.rpos._1)-                                           , "reference the unknown" <+> string att <+> squotes (ttext name)])+                                           , "references the unknown" <+> string att <+> squotes (ttext name)])                                <> line             case lu of                 Just lu' -> do

@@ -2,7 +2,7 @@ -- documentation, see http://haskell.org/cabal/users-guide/  name:                language-puppet-version:             1.3.3+version:             1.3.4 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, simulationg of complex interactions between nodes, Puppet master replacement, and more ! homepage:            http://lpuppet.banquise.net/