From 42a0c832483296fb111279fc3512a3dfd44f2089 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Sun, 7 Dec 2014 17:09:55 -0400 Subject: [PATCH] Display a warning when ensureProperty is used on a property which has Info and is so prevented from propigating it. Would much rather a type-based fixed, but this is all I have for now. --- debian/changelog | 7 +++++++ propellor.cabal | 1 + src/Propellor/Engine.hs | 32 +++++++++++++++++++++++++------- src/Propellor/Types.hs | 17 +++++++++++++++++ src/Propellor/Types/Chroot.hs | 12 +++++++++++- src/Propellor/Types/Dns.hs | 4 ++++ src/Propellor/Types/Docker.hs | 7 +++++++ src/Propellor/Types/Empty.hs | 16 ++++++++++++++++ 8 files changed, 88 insertions(+), 8 deletions(-) create mode 100644 src/Propellor/Types/Empty.hs diff --git a/debian/changelog b/debian/changelog index 0ea2767..827c798 100644 --- a/debian/changelog +++ b/debian/changelog @@ -1,3 +1,10 @@ +propellor (1.1.1) UNRELEASED; urgency=medium + + * Display a warning when ensureProperty is used on a property which has + Info and is so prevented from propigating it. + + -- Joey Hess Sun, 07 Dec 2014 17:08:55 -0400 + propellor (1.1.0) unstable; urgency=medium * --spin target --via relay causes propellor to bounce through an diff --git a/propellor.cabal b/propellor.cabal index 91d08bd..fb10964 100644 --- a/propellor.cabal +++ b/propellor.cabal @@ -118,6 +118,7 @@ Library Propellor.Types.Chroot Propellor.Types.Docker Propellor.Types.Dns + Propellor.Types.Empty Propellor.Types.OS Propellor.Types.PrivData Other-Modules: diff --git a/src/Propellor/Engine.hs b/src/Propellor/Engine.hs index aa2ea4a..dc8b2bc 100644 --- a/src/Propellor/Engine.hs +++ b/src/Propellor/Engine.hs @@ -1,6 +1,14 @@ {-# LANGUAGE PackageImports #-} -module Propellor.Engine where +module Propellor.Engine ( + mainProperties, + runPropellor, + ensureProperty, + ensureProperties, + fromHost, + onlyProcess, + processChainOutput, +) where import System.Exit import System.IO @@ -15,6 +23,7 @@ import System.FilePath import System.Directory import Propellor.Types +import Propellor.Types.Empty import Propellor.Message import Propellor.Exception import Propellor.Info @@ -27,7 +36,7 @@ import Utility.Monad mainProperties :: Host -> IO () mainProperties host = do ret <- runPropellor host $ - ensureProperties [Property "overall" (ensureProperties $ hostProperties host) mempty] + ensureProperties [Property "overall" (ensurePropertiesWith ensureProperty' $ hostProperties host) mempty] h <- mkMessageHandle whenConsole h $ setTitle "propellor: done" @@ -57,18 +66,27 @@ runEndAction host res (EndAction desc a) = actionMessageOn (hostName host) desc -- -- Note that any info of the Property is not propigated out to -- the enclosing Property, and so will not be available for propellor to --- use. +-- use. A warning message will be printed if this is detected. ensureProperty :: Property -> Propellor Result -ensureProperty = catchPropellor . propertySatisfy +ensureProperty p = do + unless (isEmpty (getInfo p)) $ + warningMessage $ "ensureProperty called on " ++ show p ++ "; will not propigate its info: " ++ show (getInfo p) + ensureProperty' p + +ensureProperty' :: Property -> Propellor Result +ensureProperty' = catchPropellor . propertySatisfy -- | Ensures a list of Properties, with a display of each as it runs. ensureProperties :: [Property] -> Propellor Result -ensureProperties ps = ensure ps NoChange +ensureProperties = ensurePropertiesWith ensureProperty + +ensurePropertiesWith :: (Property -> Propellor Result) -> [Property] -> Propellor Result +ensurePropertiesWith a ps = ensure ps NoChange where ensure [] rs = return rs - ensure (l:ls) rs = do + ensure (p:ls) rs = do hn <- asks hostName - r <- actionMessageOn hn (propertyDesc l) (ensureProperty l) + r <- actionMessageOn hn (propertyDesc p) (a p) ensure ls (r <> rs) -- | Lifts an action into a different host. diff --git a/src/Propellor/Types.hs b/src/Propellor/Types.hs index e00a457..72e0e7a 100644 --- a/src/Propellor/Types.hs +++ b/src/Propellor/Types.hs @@ -43,6 +43,7 @@ import Propellor.Types.Chroot import Propellor.Types.Dns import Propellor.Types.Docker import Propellor.Types.PrivData +import Propellor.Types.Empty -- | Everything Propellor knows about a system: Its hostname, -- properties and other info. @@ -188,6 +189,18 @@ instance Monoid Info where , _chrootinfo = _chrootinfo old <> _chrootinfo new } +instance Empty Info where + isEmpty i = and + [ isEmpty (_os i) + , isEmpty (_privDataFields i) + , isEmpty (_sshPubKey i) + , isEmpty (_aliases i) + , isEmpty (_dns i) + , isEmpty (_namedconf i) + , isEmpty (_dockerinfo i) + , isEmpty (_chrootinfo i) + ] + data Val a = Val a | NoVal deriving (Eq, Show) @@ -197,6 +210,10 @@ instance Monoid (Val a) where NoVal -> old _ -> new +instance Empty (Val a) where + isEmpty NoVal = True + isEmpty _ = False + fromVal :: Val a -> Maybe a fromVal (Val a) = Just a fromVal NoVal = Nothing diff --git a/src/Propellor/Types/Chroot.hs b/src/Propellor/Types/Chroot.hs index b7ed780..d37d34c 100644 --- a/src/Propellor/Types/Chroot.hs +++ b/src/Propellor/Types/Chroot.hs @@ -2,6 +2,7 @@ module Propellor.Types.Chroot where import Data.Monoid import qualified Data.Map as M +import Propellor.Types.Empty data ChrootInfo host = ChrootInfo { _chroots :: M.Map FilePath host @@ -16,10 +17,16 @@ instance Monoid (ChrootInfo host) where , _chrootCfg = _chrootCfg old <> _chrootCfg new } +instance Empty (ChrootInfo host) where + isEmpty i = and + [ isEmpty (_chroots i) + , isEmpty (_chrootCfg i) + ] + data ChrootCfg = NoChrootCfg | SystemdNspawnCfg [(String, Bool)] - deriving (Show) + deriving (Show, Eq) instance Monoid ChrootCfg where mempty = NoChrootCfg @@ -27,3 +34,6 @@ instance Monoid ChrootCfg where mappend NoChrootCfg v = v mappend (SystemdNspawnCfg l1) (SystemdNspawnCfg l2) = SystemdNspawnCfg (l1 <> l2) + +instance Empty ChrootCfg where + isEmpty c= c == NoChrootCfg diff --git a/src/Propellor/Types/Dns.hs b/src/Propellor/Types/Dns.hs index 66fbd1a..5e9666d 100644 --- a/src/Propellor/Types/Dns.hs +++ b/src/Propellor/Types/Dns.hs @@ -1,6 +1,7 @@ module Propellor.Types.Dns where import Propellor.Types.OS (HostName) +import Propellor.Types.Empty import Data.Word import Data.Monoid @@ -108,5 +109,8 @@ instance Monoid NamedConfMap where (Secondary, Master) -> o _ -> n +instance Empty NamedConfMap where + isEmpty (NamedConfMap m) = isEmpty m + fromNamedConfMap :: NamedConfMap -> M.Map Domain NamedConf fromNamedConfMap (NamedConfMap m) = m diff --git a/src/Propellor/Types/Docker.hs b/src/Propellor/Types/Docker.hs index 42a6592..3eafa59 100644 --- a/src/Propellor/Types/Docker.hs +++ b/src/Propellor/Types/Docker.hs @@ -1,6 +1,7 @@ module Propellor.Types.Docker where import Propellor.Types.OS +import Propellor.Types.Empty import Data.Monoid import qualified Data.Map as M @@ -18,6 +19,12 @@ instance Monoid (DockerInfo h) where , _dockerContainers = M.union (_dockerContainers old) (_dockerContainers new) } +instance Empty (DockerInfo h) where + isEmpty i = and + [ isEmpty (_dockerRunParams i) + , isEmpty (_dockerContainers i) + ] + newtype DockerRunParam = DockerRunParam (HostName -> String) instance Show DockerRunParam where diff --git a/src/Propellor/Types/Empty.hs b/src/Propellor/Types/Empty.hs new file mode 100644 index 0000000..dcd2f4a --- /dev/null +++ b/src/Propellor/Types/Empty.hs @@ -0,0 +1,16 @@ +module Propellor.Types.Empty where + +import qualified Data.Map as M +import qualified Data.Set as S + +class Empty t where + isEmpty :: t -> Bool + +instance Empty [a] where + isEmpty = null + +instance Empty (M.Map k v) where + isEmpty = M.null + +instance Empty (S.Set v) where + isEmpty = S.null