Property tree

Properties now form a tree, instead of the flat list used before.

This simplifies propigation of Info from the Properties used inside a
container to the outer host; the Property that docks the container on the
host can just have as child properties all the inner Properties, and their
Info can then be gathered recursively. (Although in practice it still needs
to be filtered, since not all Info should propigate out of a container.)

Note that there is no change to how Properties are actually satisfied.
Just because a Property lists some child properties, this does not mean
they always have their propertySatisfy actions run. It's still up to the
parent property to run those actions.

That's necessary so that a container's properties can be satisfied inside
it, not outside. It also allows property combinators to
add the combined Properties to their childProperties list, even if,
like onChange, they don't always run the child properties at all.

Testing: I tested that the exact same Info is calculated before and after
this change, for every Host in my config file.

debian/changelog

@@ -1,7 +1,9 @@
 propellor (1.4.0) UNRELEASED; urgency=medium
 
   * Add descriptions of how to set missing fields to --list-fields output.
-    (Minor API changes)
+  * Properties now form a tree, instead of the flat list used before.
+    This includes the properties used inside a container.
+    (API change)
 
  -- Joey Hess <id@joeyh.name>  Thu, 15 Jan 2015 20:14:29 -0400
 

src/Propellor/Engine.hs

@@ -35,7 +35,7 @@ import Utility.Monad
 mainProperties :: Host -> IO ()
 mainProperties host = do
 	ret <- runPropellor host $
-		ensureProperties [Property "overall" (ensureProperties $ hostProperties host) mempty]
+		ensureProperties [Property "overall" (ensureProperties $ hostProperties host) mempty mempty]
 	h <- mkMessageHandle
         whenConsole h $
 		setTitle "propellor: done"

src/Propellor/Host.hs

@@ -3,12 +3,9 @@
 module Propellor.Host where
 
 import Data.Monoid
-import qualified Data.Set as S
 
 import Propellor.Types
-import Propellor.Info
 import Propellor.Property
-import Propellor.PrivData
 
 -- | Starts accumulating the properties of a Host.
 --
@@ -35,8 +32,10 @@ class Hostlike h where
 	getHost :: h -> Host
 
 instance Hostlike Host where
-	(Host hn ps is) &  p = Host hn (ps ++ [toProp p]) (is <> getInfo p)
-	(Host hn ps is) &^ p = Host hn ([toProp p] ++ ps) (getInfo p <> is)
+	(Host hn ps is) &  p = Host hn (ps ++ [toProp p])
+		(is <> getInfoRecursive p)
+	(Host hn ps is) &^ p = Host hn ([toProp p] ++ ps)
+		(getInfoRecursive p <> is)
 	getHost h = h
 
 -- | Adds a property in reverted form.
@@ -47,18 +46,29 @@ infixl 1 &^
 infixl 1 &
 infixl 1 !
 
--- | When eg, docking a container, some of the Info about the container
--- should propigate out to the Host it's on. This includes DNS info,
--- so that eg, aliases of the container are reflected in the dns for the
--- host where it runs.
+-- | Adjust the provided Property, adding to its
+-- propertyChidren the properties of the Hostlike.
+
+-- The Info of the propertyChildren is adjusted to only include 
+-- info that should be propigated out to the Property.
 --
--- This adjusts the Property that docks a container, to include such info
--- from the container.
-propigateInfo :: Hostlike hl => hl -> Property -> (Info -> Info) -> Property
-propigateInfo hl p f = combineProperties (propertyDesc p) $
-	p' : dnsprops ++ privprops
+-- DNS Info is propigated, so that eg, aliases of a Hostlike
+-- are reflected in the dns for the host where it runs.
+--
+-- PrivData Info is propigated, so that properties used inside a
+-- Hostlike will have the necessary PrivData available.
+propigateHostLike :: Hostlike hl => hl -> Property -> Property
+propigateHostLike hl prop = prop
+	{ propertyChildren = propertyChildren prop ++ hostprops
+	}
   where
-	p' = p { propertyInfo = f (propertyInfo p) }
-	i = hostInfo (getHost hl)
-	dnsprops = map addDNS (S.toList $ _dns i)
-	privprops = map addPrivData (S.toList $ _privData i)
+	hostprops = map go $ hostProperties $ getHost hl
+	go p = 
+		let i = propertyInfo p
+		in p
+			{ propertyInfo = mempty
+				{ _dns = _dns i
+				, _privData = _privData i
+				}
+			, propertyChildren = map go (propertyChildren p)
+			}

src/Propellor/Info.hs

@@ -12,7 +12,7 @@ import Data.Monoid
 import Control.Applicative
 
 pureInfoProperty :: Desc -> Info -> Property 
-pureInfoProperty desc = Property ("has " ++ desc) (return NoChange)
+pureInfoProperty desc i = Property ("has " ++ desc) (return NoChange) i mempty
 
 askInfo :: (Info -> Val a) -> Propellor (Maybe a)
 askInfo f = asks (fromVal . f . hostInfo)

src/Propellor/Property.hs

@@ -16,19 +16,19 @@ import Utility.Monad
 
 -- Constructs a Property.
 property :: Desc -> Propellor Result -> Property
-property d s = Property d s mempty
+property d s = Property d s mempty mempty
 
 -- | Combines a list of properties, resulting in a single property
 -- that when run will run each property in the list in turn,
 -- and print out the description of each as it's run. Does not stop
 -- on failure; does propigate overall success/failure.
 propertyList :: Desc -> [Property] -> Property
-propertyList desc ps = Property desc (ensureProperties ps) (combineInfos ps)
+propertyList desc ps = Property desc (ensureProperties ps) mempty ps
 
 -- | Combines a list of properties, resulting in one property that
 -- ensures each in turn. Stops if a property fails.
 combineProperties :: Desc -> [Property] -> Property
-combineProperties desc ps = Property desc (go ps NoChange) (combineInfos ps)
+combineProperties desc ps = Property desc (go ps NoChange) mempty ps
   where
 	go [] rs = return rs
 	go (l:ls) rs = do
@@ -67,15 +67,16 @@ flagFile' p getflagfile = adjustProperty p $ \satisfy -> do
 --- | Whenever a change has to be made for a Property, causes a hook
 -- Property to also be run, but not otherwise.
 onChange :: Property -> Property -> Property
-p `onChange` hook = Property (propertyDesc p) satisfy (combineInfo p hook)
-  where
-	satisfy = do
+p `onChange` hook = p
+	{ propertySatisfy = do
 		r <- ensureProperty p
 		case r of
 			MadeChange -> do
 				r' <- ensureProperty hook
 				return $ r <> r'
 			_ -> return r
+	, propertyChildren = propertyChildren p ++ [hook]
+	}
 
 (==>) :: Desc -> Property -> Property
 (==>) = flip describe
@@ -128,13 +129,6 @@ revert (RevertableProperty p1 p2) = RevertableProperty p2 p1
 adjustProperty :: Property -> (Propellor Result -> Propellor Result) -> Property
 adjustProperty p f = p { propertySatisfy = f (propertySatisfy p) }
 
--- | Combines the Info of two properties.
-combineInfo :: (IsProp p, IsProp q) => p -> q -> Info
-combineInfo p q = getInfo p <> getInfo q
-
-combineInfos :: IsProp p => [p] -> Info
-combineInfos = mconcat . map getInfo
-
 makeChange :: IO () -> Propellor Result
 makeChange a = liftIO a >> return MadeChange
 

src/Propellor/Property/Chroot.hs

@@ -76,7 +76,9 @@ provisioned' propigator c@(Chroot loc system builderconf _) systemdonly = Revert
 	teardown = toProp (revert built)
 
 propigateChrootInfo :: Chroot -> Property -> Property
-propigateChrootInfo c p = propigateInfo c p (<> chrootInfo c)
+propigateChrootInfo c p = propigateHostLike c p'
+  where
+	p' = p { propertyInfo = propertyInfo p <> chrootInfo c }
 
 chrootInfo :: Chroot -> Info
 chrootInfo (Chroot loc _ _ h) =

src/Propellor/Property/Dns.hs

@@ -78,7 +78,7 @@ setupPrimary zonefile mknamedconffile hosts domain soa rs =
 	
 	(partialzone, zonewarnings) = genZone indomain hostmap domain soa
 	baseprop = Property ("dns primary for " ++ domain) satisfy
-		(addNamedConf conf)
+		(addNamedConf conf) []
 	satisfy = do
 		sshfps <- concat <$> mapM (genSSHFP domain) (M.elems hostmap)
 		let zone = partialzone

src/Propellor/Property/Docker.hs

@@ -134,9 +134,9 @@ docked ctr@(Container _ h) = RevertableProperty
 			]
 
 propigateContainerInfo :: Container -> Property -> Property
-propigateContainerInfo ctr@(Container _ h) p =
-	propigateInfo ctr p (<> dockerinfo)
+propigateContainerInfo ctr@(Container _ h) p = propigateHostLike ctr p'
   where
+	p' = p { propertyInfo = propertyInfo p <> dockerinfo }
 	dockerinfo = dockerInfo $
 		mempty { _dockerContainers = M.singleton (hostName h) h }
 

src/Propellor/Property/SiteSpecific/JoeySites.hs

@@ -419,7 +419,6 @@ kiteMailServer = propertyList "kitenet.net mail server"
 	, "/etc/default/spamassassin" `File.containsLines`
 		[ "# Propellor deployed"
 		, "ENABLED=1"
-		, "CRON=1"
 		, "OPTIONS=\"--create-prefs --max-children 5 --helper-home-dir\""
 		, "CRON=1"
 		, "NICE=\"--nicelevel 15\""

src/Propellor/Types.hs

@@ -4,7 +4,7 @@
 module Propellor.Types
 	( Host(..)
 	, Info(..)
-	, getInfo
+	, getInfoRecursive
 	, Propellor(..)
 	, Property(..)
 	, RevertableProperty(..)
@@ -38,7 +38,6 @@ import "mtl" Control.Monad.RWS.Strict
 import "MonadCatchIO-transformers" Control.Monad.CatchIO
 import qualified Data.Set as S
 import qualified Data.Map as M
-import qualified Propellor.Types.Dns as Dns
 
 import Propellor.Types.OS
 import Propellor.Types.Chroot
@@ -46,9 +45,10 @@ import Propellor.Types.Dns
 import Propellor.Types.Docker
 import Propellor.Types.PrivData
 import Propellor.Types.Empty
+import qualified Propellor.Types.Dns as Dns
 
 -- | Everything Propellor knows about a system: Its hostname,
--- properties and other info.
+-- properties and their collected info.
 data Host = Host
 	{ hostName :: HostName
 	, hostProperties :: [Property]
@@ -77,7 +77,15 @@ data Property = Property
 	, propertySatisfy :: Propellor Result
 	-- ^ must be idempotent; may run repeatedly
 	, propertyInfo :: Info
-	-- ^ a property can add info to the host.
+	-- ^ info associated with the property
+	, propertyChildren :: [Property]
+	-- ^ A property can include a list of child properties.
+	-- This allows them to be introspected to collect their info,
+	-- etc.
+	--
+	-- Note that listing Properties here does not ensure that
+	-- their propertySatisfy is run when satisfying the parent
+	-- property; it's up to the parent's propertySatisfy to do that.
 	}
 
 instance Show Property where
@@ -93,21 +101,22 @@ class IsProp p where
 	-- | Indicates that the first property can only be satisfied
 	-- once the second one is.
 	requires :: p -> Property -> p
-	getInfo :: p -> Info
+	-- | Gets the info of the property, combined with all info
+	-- of all children properties.
+	getInfoRecursive :: p -> Info
 
 instance IsProp Property where
 	describe p d = p { propertyDesc = d }
 	toProp p = p
-	getInfo = propertyInfo
-	x `requires` y = Property (propertyDesc x) satisfy info
-	  where
-		info = getInfo y <> getInfo x
-		satisfy = do
+	getInfoRecursive p = propertyInfo p <> mconcat (map getInfoRecursive (propertyChildren p))
+	x `requires` y = x 
+		{ propertySatisfy = do
 			r <- propertySatisfy y
 			case r of
 				FailedChange -> return FailedChange
 				_ -> propertySatisfy x
-			
+		, propertyChildren = y : propertyChildren x
+		}
 
 instance IsProp RevertableProperty where
 	-- | Sets the description of both sides.
@@ -117,7 +126,7 @@ instance IsProp RevertableProperty where
 	(RevertableProperty p1 p2) `requires` y =
 		RevertableProperty (p1 `requires` y) p2
 	-- | Return the Info of the currently active side.
-	getInfo (RevertableProperty p1 _p2) = getInfo p1
+	getInfoRecursive (RevertableProperty p1 _p2) = getInfoRecursive p1
 
 type Desc = String