From 9836bdf4c96eba09fbe4649e32240682566d4887 Mon Sep 17 00:00:00 2001
From: Joey Hess <joey@kitenet.net>
Date: Sat, 31 May 2014 13:41:28 -0400
Subject: [PATCH 01/21] propellor spin

---
 config-joey.hs | 10 +++++-----
 1 file changed, 5 insertions(+), 5 deletions(-)

diff --git a/config-joey.hs b/config-joey.hs
index e67bced..44e2533 100644
--- a/config-joey.hs
+++ b/config-joey.hs
@@ -76,9 +76,10 @@ hosts =                 --                  (o)  `
 		& alias "znc.kitenet.net"
 		& JoeySites.ircBouncer
 
-		-- Nothing is using https on clam, so listen on that port
-		-- for ssh, for traveling on bad networks.
-		& "/etc/ssh/sshd_config" `File.containsLine` "Port 443"
+		-- Nothing is using http port 80 on clam, so listen on
+		-- that port for ssh, for traveling on bad networks that
+		-- block 22.
+		& "/etc/ssh/sshd_config" `File.containsLine` "Port 80"
 			`onChange` Service.restarted "ssh"
 
 		& Docker.garbageCollected `period` Daily
@@ -307,7 +308,6 @@ monsters =	      -- but do want to track their public keys etc.
 		& alias "www.wortroot.kitenet.net"
 		& alias "joey.kitenet.net"
 		& alias "anna.kitenet.net"
-		& alias "ipv6.kitenet.net"
 		& alias "bitlbee.kitenet.net"
 		{- Remaining services on kite:
 		 - 
@@ -333,7 +333,7 @@ monsters =	      -- but do want to track their public keys etc.
 		 - ftpd (EOL)
 		 -
 		 - user shell stuff:
-		 -   pine, zsh, make, ...
+		 -   pine, zsh, make, git-annex, myrepos, ...
 		 -}
 	, host "mouse.kitenet.net"
 		& ipv6 "2001:4830:1600:492::2"

From 2d740c92c9c392d7799d51140bf8691588fd68df Mon Sep 17 00:00:00 2001
From: Joey Hess <joey@kitenet.net>
Date: Sat, 31 May 2014 13:44:28 -0400
Subject: [PATCH 02/21] propellor spin

---
 config-joey.hs | 8 +++++++-
 1 file changed, 7 insertions(+), 1 deletion(-)

diff --git a/config-joey.hs b/config-joey.hs
index 44e2533..b14e06f 100644
--- a/config-joey.hs
+++ b/config-joey.hs
@@ -42,6 +42,8 @@ hosts =                 --                  (o)  `
 		& Docker.docked hosts "android-git-annex"
 
 	-- Nothing super-important lives here.
+	-- Any services I care about are containerized so they can easily
+	-- be moved.
 	, standardSystem "clam.kitenet.net" Unstable "amd64"
 		& ipv4 "162.248.143.249"
 		& ipv6 "2002:5044:5531::1"
@@ -54,7 +56,7 @@ hosts =                 --                  (o)  `
 		& Docker.configured
 
 		& alias "shell.olduse.net"
-		& JoeySites.oldUseNetShellBox
+		& Docker.docked hosts "oldusenet-shellbox"
 
 		& alias "openid.kitenet.net"
 		& Docker.docked hosts "openid-provider"
@@ -191,6 +193,10 @@ hosts =                 --                  (o)  `
 		& Git.cloned "root" "git://kitenet-net.branchable.com/" "/var/www"
 			(Just "remotes/origin/old-kitenet.net")
 	
+	, standardContainer "oldusenet-shellbox" Stable "amd64"
+		& Docker.publish "4200:4200"
+		& JoeySites.oldUseNetShellBox
+
 	-- git-annex autobuilder containers
 	, GitAnnexBuilder.standardAutoBuilderContainer dockerImage "amd64" 15 "2h"
 	, GitAnnexBuilder.standardAutoBuilderContainer dockerImage "i386" 45 "2h"

From 5a895c21b5a2f43ab74b3514b3c75f1dba09dd97 Mon Sep 17 00:00:00 2001
From: Joey Hess <joey@kitenet.net>
Date: Sat, 31 May 2014 14:15:16 -0400
Subject: [PATCH 03/21] propellor spin

---
 config-joey.hs                                |  9 +++++---
 .../Property/SiteSpecific/JoeySites.hs        | 22 +++++++++++++++++++
 2 files changed, 28 insertions(+), 3 deletions(-)

diff --git a/config-joey.hs b/config-joey.hs
index b14e06f..f5d226b 100644
--- a/config-joey.hs
+++ b/config-joey.hs
@@ -41,9 +41,7 @@ hosts =                 --                  (o)  `
 		& Apt.buildDep ["git-annex"] `period` Daily
 		& Docker.docked hosts "android-git-annex"
 
-	-- Nothing super-important lives here.
-	-- Any services I care about are containerized so they can easily
-	-- be moved.
+	-- Nothing super-important lives here and mostly it's docker containers.
 	, standardSystem "clam.kitenet.net" Unstable "amd64"
 		& ipv4 "162.248.143.249"
 		& ipv6 "2002:5044:5531::1"
@@ -78,6 +76,11 @@ hosts =                 --                  (o)  `
 		& alias "znc.kitenet.net"
 		& JoeySites.ircBouncer
 
+		-- For https port 443, shellinabox with ssh login to
+		-- kitenet.net
+		& alias "shell.kitenet.net"
+		& JoeySites.kiteShellBox
+
 		-- Nothing is using http port 80 on clam, so listen on
 		-- that port for ssh, for traveling on bad networks that
 		-- block 22.
diff --git a/src/Propellor/Property/SiteSpecific/JoeySites.hs b/src/Propellor/Property/SiteSpecific/JoeySites.hs
index 587e16a..5121081 100644
--- a/src/Propellor/Property/SiteSpecific/JoeySites.hs
+++ b/src/Propellor/Property/SiteSpecific/JoeySites.hs
@@ -317,3 +317,25 @@ ircBouncer = propertyList "IRC bouncer"
 	]
   where
 	conf = "/home/znc/.znc/configs/znc.conf"
+
+kiteShellBox :: Property
+kiteShellBox = propertyList "kitenet.net shellinabox"
+	[ Apt.installed ["shellinabox"]
+
+	-- Install ssl cert, let shellinabox read it.
+	, File.dirExists certdir
+	, File.ownerGroup certdir "shellinabox" "shellinabox"
+	, File.mode certdir (combineModes [ownerWriteMode, ownerReadMode, ownerExecuteMode])
+	, File.hasPrivContentExposed (certdir </> "certificate.pem")
+
+	, File.hasContent "/etc/default/shellinabox"
+		[ "# Deployed by propellor"
+		, "SHELLINABOX_DAEMON_START=1"
+		, "SHELLINABOX_PORT=443"
+		, "SHELLINABOX_ARGS=\"--no-beep --service=/:SSH:kitenet.net --cert=" ++ certdir ++ "\""
+		]
+		`onChange` Service.restarted "shellinabox"
+	, Service.running "shellinabox"
+	]
+  where
+	certdir = "/etc/shellinabox/certs"

From 8e57f0bbfb45777b3d4a786381fc2c549dc52e7d Mon Sep 17 00:00:00 2001
From: Joey Hess <joey@kitenet.net>
Date: Sat, 31 May 2014 14:19:46 -0400
Subject: [PATCH 04/21] propellor spin

---
 src/Propellor/Property/SiteSpecific/JoeySites.hs | 4 ++--
 1 file changed, 2 insertions(+), 2 deletions(-)

diff --git a/src/Propellor/Property/SiteSpecific/JoeySites.hs b/src/Propellor/Property/SiteSpecific/JoeySites.hs
index 5121081..fd536ad 100644
--- a/src/Propellor/Property/SiteSpecific/JoeySites.hs
+++ b/src/Propellor/Property/SiteSpecific/JoeySites.hs
@@ -322,11 +322,11 @@ kiteShellBox :: Property
 kiteShellBox = propertyList "kitenet.net shellinabox"
 	[ Apt.installed ["shellinabox"]
 
-	-- Install ssl cert, let shellinabox read it.
+	-- Set up certs directory, allowing shellinabox write access.
+	-- It will create its own self-signed cert.
 	, File.dirExists certdir
 	, File.ownerGroup certdir "shellinabox" "shellinabox"
 	, File.mode certdir (combineModes [ownerWriteMode, ownerReadMode, ownerExecuteMode])
-	, File.hasPrivContentExposed (certdir </> "certificate.pem")
 
 	, File.hasContent "/etc/default/shellinabox"
 		[ "# Deployed by propellor"

From 7ba8556a97578d0402e7580f41eb3557a04e1713 Mon Sep 17 00:00:00 2001
From: Joey Hess <joey@kitenet.net>
Date: Sat, 31 May 2014 14:21:29 -0400
Subject: [PATCH 05/21] propellor spin


From c7b74717783a997ea646bde8cc8bbcca22d94e52 Mon Sep 17 00:00:00 2001
From: Joey Hess <joey@kitenet.net>
Date: Sat, 31 May 2014 14:28:12 -0400
Subject: [PATCH 06/21] propellor spin

---
 src/Propellor/Property/SiteSpecific/JoeySites.hs | 11 +----------
 1 file changed, 1 insertion(+), 10 deletions(-)

diff --git a/src/Propellor/Property/SiteSpecific/JoeySites.hs b/src/Propellor/Property/SiteSpecific/JoeySites.hs
index fd536ad..f6e1e37 100644
--- a/src/Propellor/Property/SiteSpecific/JoeySites.hs
+++ b/src/Propellor/Property/SiteSpecific/JoeySites.hs
@@ -321,21 +321,12 @@ ircBouncer = propertyList "IRC bouncer"
 kiteShellBox :: Property
 kiteShellBox = propertyList "kitenet.net shellinabox"
 	[ Apt.installed ["shellinabox"]
-
-	-- Set up certs directory, allowing shellinabox write access.
-	-- It will create its own self-signed cert.
-	, File.dirExists certdir
-	, File.ownerGroup certdir "shellinabox" "shellinabox"
-	, File.mode certdir (combineModes [ownerWriteMode, ownerReadMode, ownerExecuteMode])
-
 	, File.hasContent "/etc/default/shellinabox"
 		[ "# Deployed by propellor"
 		, "SHELLINABOX_DAEMON_START=1"
 		, "SHELLINABOX_PORT=443"
-		, "SHELLINABOX_ARGS=\"--no-beep --service=/:SSH:kitenet.net --cert=" ++ certdir ++ "\""
+		, "SHELLINABOX_ARGS=\"--no-beep --service=/:SSH:kitenet.net\""
 		]
 		`onChange` Service.restarted "shellinabox"
 	, Service.running "shellinabox"
 	]
-  where
-	certdir = "/etc/shellinabox/certs"

From 1a83bf26300a225f044205e2208783e664377e25 Mon Sep 17 00:00:00 2001
From: Joey Hess <joey@kitenet.net>
Date: Sat, 31 May 2014 15:54:41 -0400
Subject: [PATCH 07/21] propellor spin

---
 config-joey.hs | 1 -
 1 file changed, 1 deletion(-)

diff --git a/config-joey.hs b/config-joey.hs
index f5d226b..7a99b9b 100644
--- a/config-joey.hs
+++ b/config-joey.hs
@@ -338,7 +338,6 @@ monsters =	      -- but do want to track their public keys etc.
 		 -   (branchable is still pushing to here
 		 -    (thinking it's ns2.branchable.com), but it's no
 		 -   longer a primary or secondary for anything)
-		 - ajaxterm
 		 - ftpd (EOL)
 		 -
 		 - user shell stuff:

From 6383d8c38893c160382eb9bf69e0315c5e87269e Mon Sep 17 00:00:00 2001
From: Joey Hess <joey@kitenet.net>
Date: Sat, 31 May 2014 16:48:14 -0400
Subject: [PATCH 08/21] propellor spin

---
 config-joey.hs                   |  2 +-
 debian/changelog                 |  9 +++++++++
 doc/todo/docker_todo_list.mdwn   |  2 --
 propellor.cabal                  |  2 +-
 src/Propellor/Attr.hs            | 26 ++++++++++++++++++--------
 src/Propellor/Property/Docker.hs | 24 +++++++++++++++++++-----
 6 files changed, 48 insertions(+), 17 deletions(-)

diff --git a/config-joey.hs b/config-joey.hs
index 7a99b9b..b667f79 100644
--- a/config-joey.hs
+++ b/config-joey.hs
@@ -53,7 +53,6 @@ hosts =                 --                  (o)  `
 		& Postfix.satellite
 		& Docker.configured
 
-		& alias "shell.olduse.net"
 		& Docker.docked hosts "oldusenet-shellbox"
 
 		& alias "openid.kitenet.net"
@@ -198,6 +197,7 @@ hosts =                 --                  (o)  `
 	
 	, standardContainer "oldusenet-shellbox" Stable "amd64"
 		& Docker.publish "4200:4200"
+		& alias "shell.olduse.net"
 		& JoeySites.oldUseNetShellBox
 
 	-- git-annex autobuilder containers
diff --git a/debian/changelog b/debian/changelog
index 916b9b3..98cbee1 100644
--- a/debian/changelog
+++ b/debian/changelog
@@ -1,3 +1,12 @@
+propellor (0.6.0) UNRELEASED; urgency=medium
+
+  * Docker containers now propigate DNS attributes out to the host they're
+    docked in. So if a docker container sets a DNS alias, every container
+    it's docked in will automatically become part of a round-robin DNS,
+    if propellor is used to manage DNS for the domain.
+
+ -- Joey Hess <joeyh@debian.org>  Sat, 31 May 2014 16:41:56 -0400
+
 propellor (0.5.3) unstable; urgency=medium
 
   * Fix unattended-upgrades config for !stable.
diff --git a/doc/todo/docker_todo_list.mdwn b/doc/todo/docker_todo_list.mdwn
index 65762cf..2bf095f 100644
--- a/doc/todo/docker_todo_list.mdwn
+++ b/doc/todo/docker_todo_list.mdwn
@@ -4,5 +4,3 @@
 * There is no way for a property of a docker container to require
   some property be met outside the container. For example, some servers
   need ntp installed for a good date source.
-* Docking a container in a host should add to the host any cnames that
-  are assigned to the container.
diff --git a/propellor.cabal b/propellor.cabal
index 80c353b..1ca9f3a 100644
--- a/propellor.cabal
+++ b/propellor.cabal
@@ -1,5 +1,5 @@
 Name: propellor
-Version: 0.5.3
+Version: 0.6.0
 Cabal-Version: >= 1.6
 License: BSD3
 Maintainer: Joey Hess <joey@kitenet.net>
diff --git a/src/Propellor/Attr.hs b/src/Propellor/Attr.hs
index 98cfc64..e2b64bf 100644
--- a/src/Propellor/Attr.hs
+++ b/src/Propellor/Attr.hs
@@ -33,21 +33,31 @@ getOS = asks _os
 -- TODO check at run time if the host really has this address.
 -- (Can't change the host's address, but as a sanity check.)
 ipv4 :: String -> Property
-ipv4 addr = pureAttrProperty ("ipv4 " ++ addr)
-	(addDNS $ Address $ IPv4 addr)
+ipv4 = addDNS . Address . IPv4
 
 -- | Indidate that a host has an AAAA record in the DNS.
 ipv6 :: String -> Property
-ipv6 addr = pureAttrProperty ("ipv6 " ++ addr)
-	(addDNS $ Address $ IPv6 addr)
+ipv6 = addDNS . Address . IPv6
 
 -- | Indicates another name for the host in the DNS.
 alias :: Domain -> Property
-alias domain = pureAttrProperty ("alias " ++ domain)
-	(addDNS $ CNAME $ AbsDomain domain)
+alias = addDNS . CNAME . AbsDomain
 
-addDNS :: Record -> SetAttr
-addDNS record d = d { _dns = S.insert record (_dns d) }
+addDNS :: Record -> Property
+addDNS r = pureAttrProperty (rdesc r) $
+	\d -> d { _dns = S.insert r (_dns d) }
+  where
+	rdesc (CNAME d) = unwords ["alias", ddesc d]
+	rdesc (Address (IPv4 addr)) = unwords ["ipv4", addr]
+	rdesc (Address (IPv6 addr)) = unwords ["ipv6", addr]
+	rdesc (MX n d) = unwords ["MX", show n, ddesc d]
+	rdesc (NS d) = unwords ["NS", ddesc d]
+	rdesc (TXT s) = unwords ["TXT", s]
+	rdesc (SRV x y z d) = unwords ["SRV", show x, show y, show z, ddesc d]
+
+	ddesc (AbsDomain domain) = domain
+	ddesc (RelDomain domain) = domain
+	ddesc RootDomain = "@"
 
 -- | Adds a DNS NamedConf stanza.
 --
diff --git a/src/Propellor/Property/Docker.hs b/src/Propellor/Property/Docker.hs
index 68fbced..465fe0b 100644
--- a/src/Propellor/Property/Docker.hs
+++ b/src/Propellor/Property/Docker.hs
@@ -21,6 +21,7 @@ import System.Posix.Directory
 import System.Posix.Process
 import Data.List
 import Data.List.Utils
+import qualified Data.Set as S
 
 -- | Configures docker with an authentication file, so that images can be
 -- pushed to index.docker.io.
@@ -54,7 +55,10 @@ cn2hn cn = cn ++ ".docker"
 
 -- | Ensures that a docker container is set up and running. The container
 -- has its own Properties which are handled by running propellor
--- inside the container.
+-- inside the container. 
+--
+-- Additionally, the container can have DNS attributes, such as a CNAME.
+-- These become attributes of the host(s) it's docked in.
 --
 -- Reverting this property ensures that the container is stopped and
 -- removed.
@@ -62,12 +66,16 @@ docked
 	:: [Host]
 	-> ContainerName
 	-> RevertableProperty
-docked hosts cn = RevertableProperty (go "docked" setup) (go "undocked" teardown)
+docked hosts cn = RevertableProperty
+	(go "docked" setup)
+	(go "undocked" teardown)
   where
 	go desc a = property (desc ++ " " ++ cn) $ do
 		hn <- getHostName
   		let cid = ContainerId hn cn
-		ensureProperties [findContainer hosts cid cn $ a cid]
+		ensureProperties [findContainer mhost cid cn $ a cid]
+		
+	mhost = findHost hosts (cn2hn cn)
 
 	setup cid (Container image runparams) =
 		provisionContainer cid
@@ -86,13 +94,19 @@ docked hosts cn = RevertableProperty (go "docked" setup) (go "undocked" teardown
 					]
 			]
 
+exposeDnsAttrs :: Host -> Property -> Property
+exposeDnsAttrs (Host _ containerattr) p = combineProperties (propertyDesc p) $
+	p : map addDNS (S.toList containerdns)
+  where
+	containerdns = _dns $ containerattr $ newAttr undefined
+
 findContainer
-	:: [Host]
+	:: Maybe Host
 	-> ContainerId
 	-> ContainerName
 	-> (Container -> Property)
 	-> Property
-findContainer hosts cid cn mk = case findHost hosts (cn2hn cn) of
+findContainer mhost cid cn mk = case mhost of
 	Nothing -> cantfind
 	Just h -> maybe cantfind mk (mkContainer cid h)
   where

From c742c2eb1b7141fbe0628870e899d3461a88686a Mon Sep 17 00:00:00 2001
From: Joey Hess <joey@kitenet.net>
Date: Sat, 31 May 2014 17:22:35 -0400
Subject: [PATCH 09/21] propellor spin

---
 src/Propellor/Attr.hs            | 13 ++++---------
 src/Propellor/Property.hs        |  6 +++---
 src/Propellor/Property/Docker.hs |  9 +++++----
 src/Propellor/Types.hs           | 10 +++++++---
 4 files changed, 19 insertions(+), 19 deletions(-)

diff --git a/src/Propellor/Attr.hs b/src/Propellor/Attr.hs
index e2b64bf..6bc4fcf 100644
--- a/src/Propellor/Attr.hs
+++ b/src/Propellor/Attr.hs
@@ -83,22 +83,17 @@ sshPubKey k = pureAttrProperty ("ssh pubkey known") $
 getSshPubKey :: Propellor (Maybe String)
 getSshPubKey = asks _sshPubKey
 
-hostnameless :: Attr
-hostnameless = newAttr (error "hostname Attr not specified")
-
 hostAttr :: Host -> Attr
-hostAttr (Host _ mkattrs) = mkattrs hostnameless
+hostAttr (Host hn _ mkattrs) = mkattrs (newAttr hn)
 
 hostProperties :: Host -> [Property]
-hostProperties (Host ps _) = ps
+hostProperties (Host _ ps _) = ps
 
 hostMap :: [Host] -> M.Map HostName Host
-hostMap l = M.fromList $ zip (map (_hostname . hostAttr) l) l 
+hostMap l = M.fromList $ zip (map _hostName l) l 
 
 hostAttrMap :: [Host] -> M.Map HostName Attr
-hostAttrMap l = M.fromList $ zip (map _hostname attrs) attrs
-  where
-	attrs = map hostAttr l
+hostAttrMap l = M.fromList $ zip (map _hostName l) (map hostAttr l)
 
 findHost :: [Host] -> HostName -> Maybe Host
 findHost l hn = M.lookup hn (hostMap l)
diff --git a/src/Propellor/Property.hs b/src/Propellor/Property.hs
index 0728932..1f60262 100644
--- a/src/Propellor/Property.hs
+++ b/src/Propellor/Property.hs
@@ -130,19 +130,19 @@ revert (RevertableProperty p1 p2) = RevertableProperty p2 p1
 -- > 	! oldproperty
 -- > 	& otherproperty
 host :: HostName -> Host
-host hn = Host [] (\_ -> newAttr hn)
+host hn = Host hn [] (\_ -> newAttr hn)
 
 -- | Adds a property to a Host
 --
 -- Can add Properties and RevertableProperties
 (&) :: IsProp p => Host -> p -> Host
-(Host ps as) & p = Host (ps ++ [toProp p]) (setAttr p . as)
+(Host hn ps as) & p = Host hn (ps ++ [toProp p]) (setAttr p . as)
 
 infixl 1 &
 
 -- | Adds a property to the Host in reverted form.
 (!) :: Host -> RevertableProperty -> Host
-(Host ps as) ! p = Host (ps ++ [toProp q]) (setAttr q . as)
+(Host hn ps as) ! p = Host hn (ps ++ [toProp q]) (setAttr q . as)
   where
 	q = revert p
 
diff --git a/src/Propellor/Property/Docker.hs b/src/Propellor/Property/Docker.hs
index 465fe0b..c1340ad 100644
--- a/src/Propellor/Property/Docker.hs
+++ b/src/Propellor/Property/Docker.hs
@@ -46,9 +46,10 @@ type ContainerName = String
 -- >    & Apt.installed {"apache2"]
 -- >    & ...
 container :: ContainerName -> Image -> Host
-container cn image = Host [] (\_ -> attr)
+container cn image = Host hn [] (\_ -> attr)
   where
-	attr = (newAttr (cn2hn cn)) { _dockerImage = Just image }
+	attr = (newAttr hn) { _dockerImage = Just image }
+	hn = cn2hn cn
 
 cn2hn :: ContainerName -> HostName
 cn2hn cn = cn ++ ".docker"
@@ -67,7 +68,7 @@ docked
 	-> ContainerName
 	-> RevertableProperty
 docked hosts cn = RevertableProperty
-	(go "docked" setup)
+	((maybe id exposeDnsAttrs mhost) (go "docked" setup))
 	(go "undocked" teardown)
   where
 	go desc a = property (desc ++ " " ++ cn) $ do
@@ -95,7 +96,7 @@ docked hosts cn = RevertableProperty
 			]
 
 exposeDnsAttrs :: Host -> Property -> Property
-exposeDnsAttrs (Host _ containerattr) p = combineProperties (propertyDesc p) $
+exposeDnsAttrs (Host _ _ containerattr) p = combineProperties (propertyDesc p) $
 	p : map addDNS (S.toList containerdns)
   where
 	containerdns = _dns $ containerattr $ newAttr undefined
diff --git a/src/Propellor/Types.hs b/src/Propellor/Types.hs
index 8a4bd3d..e5f5c1c 100644
--- a/src/Propellor/Types.hs
+++ b/src/Propellor/Types.hs
@@ -34,9 +34,13 @@ import Propellor.Types.Attr
 import Propellor.Types.OS
 import Propellor.Types.Dns
 
--- | Everything Propellor knows about a system: Its properties and
--- attributes.
-data Host = Host [Property] SetAttr
+-- | Everything Propellor knows about a system: Its hostname,
+-- properties and attributes.
+data Host = Host
+	{ _hostName :: HostName
+	, _hostProps :: [Property]
+	, _hostAttrs :: SetAttr
+	}
 
 -- | Propellor's monad provides read-only access to attributes of the
 -- system.

From d3ac75a1a29e9eda60b78d25e7352d4a2d5713cc Mon Sep 17 00:00:00 2001
From: Joey Hess <joey@kitenet.net>
Date: Sat, 31 May 2014 17:25:39 -0400
Subject: [PATCH 10/21] propellor spin


From 5fc4b006517051e937cbfa13b5f7ccbc25460c1b Mon Sep 17 00:00:00 2001
From: Joey Hess <joey@kitenet.net>
Date: Sat, 31 May 2014 18:02:56 -0400
Subject: [PATCH 11/21] remove now redundant _hostname field of Attr

Now that Host includes _hostName, it's redundant to also keep it in Attr.

This requires changing the reader monad to operate on the whole Host.
---
 src/Propellor/Attr.hs            | 26 +++++---------------------
 src/Propellor/CmdLine.hs         | 23 ++++++++++-------------
 src/Propellor/Engine.hs          | 23 +++++++++++++++++------
 src/Propellor/Property.hs        |  2 +-
 src/Propellor/Property/Dns.hs    | 27 +++++++++++++++------------
 src/Propellor/Property/Docker.hs |  4 ++--
 src/Propellor/Types.hs           |  8 ++++----
 src/Propellor/Types/Attr.hs      | 15 ++++++---------
 8 files changed, 60 insertions(+), 68 deletions(-)

diff --git a/src/Propellor/Attr.hs b/src/Propellor/Attr.hs
index 6bc4fcf..5749a4b 100644
--- a/src/Propellor/Attr.hs
+++ b/src/Propellor/Attr.hs
@@ -14,19 +14,15 @@ import Control.Applicative
 pureAttrProperty :: Desc -> SetAttr -> Property 
 pureAttrProperty desc = Property ("has " ++ desc) (return NoChange)
 
-hostname :: HostName -> Property
-hostname name = pureAttrProperty ("hostname " ++ name) $
-	\d -> d { _hostname = name }
-
 getHostName :: Propellor HostName
-getHostName = asks _hostname
+getHostName = asks _hostName
 
 os :: System -> Property
 os system = pureAttrProperty ("Operating " ++ show system) $
 	\d -> d { _os = Just system }
 
 getOS :: Propellor (Maybe System)
-getOS = asks _os
+getOS = asks (_os . hostAttr)
 
 -- | Indidate that a host has an A record in the DNS.
 --
@@ -74,17 +70,17 @@ addNamedConf conf d = d { _namedconf = new }
 		_  -> M.insert domain conf m
 
 getNamedConf :: Propellor (M.Map Domain NamedConf)
-getNamedConf = asks _namedconf
+getNamedConf = asks (_namedconf . hostAttr)
 
 sshPubKey :: String -> Property
 sshPubKey k = pureAttrProperty ("ssh pubkey known") $
 	\d -> d { _sshPubKey = Just k }
 
 getSshPubKey :: Propellor (Maybe String)
-getSshPubKey = asks _sshPubKey
+getSshPubKey = asks (_sshPubKey . hostAttr)
 
 hostAttr :: Host -> Attr
-hostAttr (Host hn _ mkattrs) = mkattrs (newAttr hn)
+hostAttr (Host _ _ mkattrs) = mkattrs newAttr
 
 hostProperties :: Host -> [Property]
 hostProperties (Host _ ps _) = ps
@@ -92,9 +88,6 @@ hostProperties (Host _ ps _) = ps
 hostMap :: [Host] -> M.Map HostName Host
 hostMap l = M.fromList $ zip (map _hostName l) l 
 
-hostAttrMap :: [Host] -> M.Map HostName Attr
-hostAttrMap l = M.fromList $ zip (map _hostName l) (map hostAttr l)
-
 findHost :: [Host] -> HostName -> Maybe Host
 findHost l hn = M.lookup hn (hostMap l)
 
@@ -105,12 +98,3 @@ hostAddresses :: HostName -> [Host] -> [IPAddr]
 hostAddresses hn hosts = case hostAttr <$> findHost hosts hn of
 	Nothing -> []
 	Just attr -> mapMaybe getIPAddr $ S.toList $ _dns attr
-
--- | Lifts an action into a different host.
---
--- For example, `fromHost hosts "otherhost" getSshPubKey`
-fromHost :: [Host] -> HostName -> Propellor a -> Propellor (Maybe a)
-fromHost l hn getter = case findHost l hn of
-	Nothing -> return Nothing
-	Just h -> liftIO $ Just <$>
-		runReaderT (runWithAttr getter) (hostAttr h)
diff --git a/src/Propellor/CmdLine.hs b/src/Propellor/CmdLine.hs
index ab1d7f9..a7b7ef9 100644
--- a/src/Propellor/CmdLine.hs
+++ b/src/Propellor/CmdLine.hs
@@ -67,24 +67,21 @@ defaultMain hostlist = do
 	go _ (Continue cmdline) = go False cmdline
 	go _ (Set hn field) = setPrivData hn field
 	go _ (AddKey keyid) = addKey keyid
-	go _ (Chain hn) = withprops hn $ \attr ps -> do
-		r <- runPropellor attr $ ensureProperties ps
+	go _ (Chain hn) = withhost hn $ \h -> do
+		r <- runPropellor h $ ensureProperties $ hostProperties h
 		putStrLn $ "\n" ++ show r
 	go _ (Docker hn) = Docker.chain hn
 	go True cmdline@(Spin _) = buildFirst cmdline $ go False cmdline
 	go True cmdline = updateFirst cmdline $ go False cmdline
-	go False (Spin hn) = withprops hn $ const . const $ spin hn
+	go False (Spin hn) = withhost hn $ const $ spin hn
 	go False (Run hn) = ifM ((==) 0 <$> getRealUserID)
-		( onlyProcess $ withprops hn mainProperties
+		( onlyProcess $ withhost hn mainProperties
 		, go True (Spin hn)
 		)
-	go False (Boot hn) = onlyProcess $ withprops hn boot
+	go False (Boot hn) = onlyProcess $ withhost hn boot
 
-	withprops :: HostName -> (Attr -> [Property] -> IO ()) -> IO ()
-	withprops hn a = maybe
-		(unknownhost hn)
-		(\h -> a (hostAttr h) (hostProperties h))
-		(findHost hostlist hn)
+	withhost :: HostName -> (Host -> IO ()) -> IO ()
+	withhost hn a = maybe (unknownhost hn) a (findHost hostlist hn)
 
 onlyProcess :: IO a -> IO a
 onlyProcess a = bracket lock unlock (const a)
@@ -279,15 +276,15 @@ fromMarked marker s
 	len = length marker
 	matches = filter (marker `isPrefixOf`) $ lines s
 
-boot :: Attr -> [Property] -> IO ()
-boot attr ps = do
+boot :: Host -> IO ()
+boot h = do
 	sendMarked stdout statusMarker $ show Ready
 	reply <- hGetContentsStrict stdin
 
 	makePrivDataDir
 	maybe noop (writeFileProtected privDataLocal) $
 		fromMarked privDataMarker reply
-	mainProperties attr ps
+	mainProperties h
 
 addKey :: String -> IO ()
 addKey keyid = exitBool =<< allM id [ gpg, gitadd, gitconfig, gitcommit ]
diff --git a/src/Propellor/Engine.hs b/src/Propellor/Engine.hs
index 55ce7f7..9bb3531 100644
--- a/src/Propellor/Engine.hs
+++ b/src/Propellor/Engine.hs
@@ -5,20 +5,22 @@ module Propellor.Engine where
 import System.Exit
 import System.IO
 import Data.Monoid
+import Control.Applicative
 import System.Console.ANSI
 import "mtl" Control.Monad.Reader
 
 import Propellor.Types
 import Propellor.Message
 import Propellor.Exception
+import Propellor.Attr
 
-runPropellor :: Attr -> Propellor a -> IO a
-runPropellor attr a = runReaderT (runWithAttr a) attr
+runPropellor :: Host -> Propellor a -> IO a
+runPropellor host a = runReaderT (runWithHost a) host
 
-mainProperties :: Attr -> [Property] -> IO ()
-mainProperties attr ps = do
-	r <- runPropellor attr $
-		ensureProperties [Property "overall" (ensureProperties ps) id]
+mainProperties :: Host -> IO ()
+mainProperties host = do
+	r <- runPropellor host $
+		ensureProperties [Property "overall" (ensureProperties $ hostProperties host) id]
 	setTitle "propellor: done"
 	hFlush stdout
 	case r of
@@ -35,3 +37,12 @@ ensureProperties ps = ensure ps NoChange
 
 ensureProperty :: Property -> Propellor Result
 ensureProperty = catchPropellor . propertySatisfy
+
+-- | Lifts an action into a different host.
+--
+-- For example, `fromHost hosts "otherhost" getSshPubKey`
+fromHost :: [Host] -> HostName -> Propellor a -> Propellor (Maybe a)
+fromHost l hn getter = case findHost l hn of
+	Nothing -> return Nothing
+	Just h -> liftIO $ Just <$>
+		runReaderT (runWithHost getter) h
diff --git a/src/Propellor/Property.hs b/src/Propellor/Property.hs
index 1f60262..f2a4b3d 100644
--- a/src/Propellor/Property.hs
+++ b/src/Propellor/Property.hs
@@ -130,7 +130,7 @@ revert (RevertableProperty p1 p2) = RevertableProperty p2 p1
 -- > 	! oldproperty
 -- > 	& otherproperty
 host :: HostName -> Host
-host hn = Host hn [] (\_ -> newAttr hn)
+host hn = Host hn [] (\_ -> newAttr)
 
 -- | Adds a property to a Host
 --
diff --git a/src/Propellor/Property/Dns.hs b/src/Propellor/Property/Dns.hs
index 5c3162c..f82d549 100644
--- a/src/Propellor/Property/Dns.hs
+++ b/src/Propellor/Property/Dns.hs
@@ -129,9 +129,9 @@ secondaryFor masters hosts domain = RevertableProperty setup cleanup
 
 otherServers :: DnsServerType -> [Host] -> Domain -> [HostName]
 otherServers wantedtype hosts domain =
-	M.keys $ M.filter wanted $ hostAttrMap hosts
+	M.keys $ M.filter wanted $ hostMap hosts
   where
-	wanted attr = case M.lookup domain (_namedconf attr) of
+	wanted h = case M.lookup domain (_namedconf $ hostAttr h) of
 		Nothing -> False
 		Just conf -> confDnsServerType conf == wantedtype
 			&& confDomain conf == domain
@@ -341,7 +341,7 @@ genZone hosts zdomain soa =
 		]
 	in (Zone zdomain soa (nub zhosts), warnings)
   where
-	m = hostAttrMap hosts
+	m = hostMap hosts
 	-- Known hosts with hostname located in the zone's domain.
 	inzdomain = M.elems $ M.filterWithKey (\hn _ -> inDomain zdomain $ AbsDomain $ hn) m
 	
@@ -350,12 +350,13 @@ genZone hosts zdomain soa =
 	--
 	-- If a host lacks any IPAddr, it's probably a misconfiguration,
 	-- so warn.
-	hostips :: Attr -> [Either WarningMessage (BindDomain, Record)]
-	hostips attr
-		| null l = [Left $ "no IP address defined for host " ++ _hostname attr]
+	hostips :: Host -> [Either WarningMessage (BindDomain, Record)]
+	hostips h
+		| null l = [Left $ "no IP address defined for host " ++ _hostName h]
 		| otherwise = map Right l
 	  where
-		l = zip (repeat $ AbsDomain $ _hostname attr)
+		attr = hostAttr h
+		l = zip (repeat $ AbsDomain $ _hostName h)
 			(map Address $ getAddresses attr)
 
 	-- Any host, whether its hostname is in the zdomain or not,
@@ -370,10 +371,11 @@ genZone hosts zdomain soa =
 	--
 	-- We typically know the host's IPAddrs anyway.
 	-- So we can just use the IPAddrs.
-	addcnames :: Attr -> [Either WarningMessage (BindDomain, Record)]
-	addcnames attr = concatMap gen $ filter (inDomain zdomain) $
+	addcnames :: Host -> [Either WarningMessage (BindDomain, Record)]
+	addcnames h = concatMap gen $ filter (inDomain zdomain) $
 		mapMaybe getCNAME $ S.toList (_dns attr)
 	  where
+		attr = hostAttr h
 		gen c = case getAddresses attr of
 			[] -> [ret (CNAME c)]
 			l -> map (ret . Address) l
@@ -381,10 +383,11 @@ genZone hosts zdomain soa =
 		  	ret record = Right (c, record)
 	
 	-- Adds any other DNS records for a host located in the zdomain.
-	hostrecords :: Attr -> [Either WarningMessage (BindDomain, Record)]
-	hostrecords attr = map Right l
+	hostrecords :: Host -> [Either WarningMessage (BindDomain, Record)]
+	hostrecords h = map Right l
 	  where
-		l = zip (repeat $ AbsDomain $ _hostname attr)
+		attr = hostAttr h
+		l = zip (repeat $ AbsDomain $ _hostName h)
 			(S.toList $ S.filter (\r -> isNothing (getIPAddr r) && isNothing (getCNAME r)) (_dns attr))
 
 inDomain :: Domain -> BindDomain -> Bool
diff --git a/src/Propellor/Property/Docker.hs b/src/Propellor/Property/Docker.hs
index c1340ad..34a9deb 100644
--- a/src/Propellor/Property/Docker.hs
+++ b/src/Propellor/Property/Docker.hs
@@ -48,7 +48,7 @@ type ContainerName = String
 container :: ContainerName -> Image -> Host
 container cn image = Host hn [] (\_ -> attr)
   where
-	attr = (newAttr hn) { _dockerImage = Just image }
+	attr = newAttr { _dockerImage = Just image }
 	hn = cn2hn cn
 
 cn2hn :: ContainerName -> HostName
@@ -99,7 +99,7 @@ exposeDnsAttrs :: Host -> Property -> Property
 exposeDnsAttrs (Host _ _ containerattr) p = combineProperties (propertyDesc p) $
 	p : map addDNS (S.toList containerdns)
   where
-	containerdns = _dns $ containerattr $ newAttr undefined
+	containerdns = _dns $ containerattr newAttr
 
 findContainer
 	:: Maybe Host
diff --git a/src/Propellor/Types.hs b/src/Propellor/Types.hs
index e5f5c1c..a96e952 100644
--- a/src/Propellor/Types.hs
+++ b/src/Propellor/Types.hs
@@ -42,14 +42,14 @@ data Host = Host
 	, _hostAttrs :: SetAttr
 	}
 
--- | Propellor's monad provides read-only access to attributes of the
--- system.
-newtype Propellor p = Propellor { runWithAttr :: ReaderT Attr IO p }
+-- | Propellor's monad provides read-only access to the host it's running
+-- on, including its attributes.
+newtype Propellor p = Propellor { runWithHost :: ReaderT Host IO p }
 	deriving
 		( Monad
 		, Functor
 		, Applicative
-		, MonadReader Attr 
+		, MonadReader Host
 		, MonadIO
 		, MonadCatchIO
 		)
diff --git a/src/Propellor/Types/Attr.hs b/src/Propellor/Types/Attr.hs
index 8b7d3b0..7f0add1 100644
--- a/src/Propellor/Types/Attr.hs
+++ b/src/Propellor/Types/Attr.hs
@@ -6,10 +6,9 @@ import qualified Propellor.Types.Dns as Dns
 import qualified Data.Set as S
 import qualified Data.Map as M
 
--- | The attributes of a host. For example, its hostname.
+-- | The attributes of a host.
 data Attr = Attr
-	{ _hostname :: HostName
-	, _os :: Maybe System
+	{ _os :: Maybe System
 	, _sshPubKey :: Maybe String
 	, _dns :: S.Set Dns.Record
 	, _namedconf :: M.Map Dns.Domain Dns.NamedConf
@@ -20,8 +19,7 @@ data Attr = Attr
 
 instance Eq Attr where
 	x == y = and
-		[ _hostname x == _hostname y
-		, _os x == _os y
+		[ _os x == _os y
 		, _dns x == _dns y
 		, _namedconf x == _namedconf y
 		, _sshPubKey x == _sshPubKey y
@@ -33,8 +31,7 @@ instance Eq Attr where
 
 instance Show Attr where
 	show a = unlines
-		[ "hostname " ++ _hostname a
-		, "OS " ++ show (_os a)
+		[ "OS " ++ show (_os a)
 		, "sshPubKey " ++ show (_sshPubKey a)
 		, "dns " ++ show (_dns a)
 		, "namedconf " ++ show (_namedconf a)
@@ -42,7 +39,7 @@ instance Show Attr where
 		, "docker run params " ++ show (map (\mk -> mk "") (_dockerRunParams a))
 		]
 
-newAttr :: HostName -> Attr
-newAttr hn = Attr hn Nothing Nothing S.empty M.empty Nothing []
+newAttr :: Attr
+newAttr = Attr Nothing Nothing S.empty M.empty Nothing []
 
 type SetAttr = Attr -> Attr

From 44244b5094032e5dba906490a58c422f2183a41b Mon Sep 17 00:00:00 2001
From: Joey Hess <joey@kitenet.net>
Date: Sat, 31 May 2014 18:35:17 -0400
Subject: [PATCH 12/21] propellor spin

---
 config-joey.hs | 8 +++-----
 1 file changed, 3 insertions(+), 5 deletions(-)

diff --git a/config-joey.hs b/config-joey.hs
index b667f79..ae575ea 100644
--- a/config-joey.hs
+++ b/config-joey.hs
@@ -54,12 +54,8 @@ hosts =                 --                  (o)  `
 		& Docker.configured
 
 		& Docker.docked hosts "oldusenet-shellbox"
-
-		& alias "openid.kitenet.net"
 		& Docker.docked hosts "openid-provider"
 		 	`requires` Apt.serviceInstalledRunning "ntp"
-
-		& alias "ancient.kitenet.net"
 		& Docker.docked hosts "ancient-kitenet"
 
 		-- I'd rather this were on diatom, but it needs unstable.
@@ -184,20 +180,22 @@ hosts =                 --                  (o)  `
 	-- My own openid provider. Uses php, so containerized for security
 	-- and administrative sanity.
 	, standardContainer "openid-provider" Stable "amd64"
+		& alias "openid.kitenet.net"
 		& Docker.publish "8081:80"
 		& OpenId.providerFor ["joey", "liw"]
 			"openid.kitenet.net:8081"
 
 	-- Exhibit: kite's 90's website.
 	, standardContainer "ancient-kitenet" Stable "amd64"
+		& alias "ancient.kitenet.net"
 		& Docker.publish "1994:80"
 		& Apt.serviceInstalledRunning "apache2"
 		& Git.cloned "root" "git://kitenet-net.branchable.com/" "/var/www"
 			(Just "remotes/origin/old-kitenet.net")
 	
 	, standardContainer "oldusenet-shellbox" Stable "amd64"
-		& Docker.publish "4200:4200"
 		& alias "shell.olduse.net"
+		& Docker.publish "4200:4200"
 		& JoeySites.oldUseNetShellBox
 
 	-- git-annex autobuilder containers

From 4722b62e45873e80bea015347bcc6e29100b63a7 Mon Sep 17 00:00:00 2001
From: Joey Hess <joey@kitenet.net>
Date: Sat, 31 May 2014 18:40:34 -0400
Subject: [PATCH 13/21] propellor spin

---
 src/Propellor/Engine.hs | 3 ++-
 1 file changed, 2 insertions(+), 1 deletion(-)

diff --git a/src/Propellor/Engine.hs b/src/Propellor/Engine.hs
index 9bb3531..773e234 100644
--- a/src/Propellor/Engine.hs
+++ b/src/Propellor/Engine.hs
@@ -32,7 +32,8 @@ ensureProperties ps = ensure ps NoChange
   where
 	ensure [] rs = return rs
 	ensure (l:ls) rs = do
-		r <- actionMessage (propertyDesc l) (ensureProperty l)
+		hn <- getHostName
+		r <- actionMessage (hn ++ " " ++ propertyDesc l) (ensureProperty l)
 		ensure ls (r <> rs)
 
 ensureProperty :: Property -> Propellor Result

From 84eb0500850138ad0145e453e2ce4204f2fc7afd Mon Sep 17 00:00:00 2001
From: Joey Hess <joey@kitenet.net>
Date: Sat, 31 May 2014 18:44:49 -0400
Subject: [PATCH 14/21] Propellor's output now includes the hostname being
 provisioned, or when provisioning a docker container, the container name.

---
 debian/changelog               | 2 ++
 doc/todo/docker_todo_list.mdwn | 3 ---
 2 files changed, 2 insertions(+), 3 deletions(-)

diff --git a/debian/changelog b/debian/changelog
index 98cbee1..695ea3f 100644
--- a/debian/changelog
+++ b/debian/changelog
@@ -4,6 +4,8 @@ propellor (0.6.0) UNRELEASED; urgency=medium
     docked in. So if a docker container sets a DNS alias, every container
     it's docked in will automatically become part of a round-robin DNS,
     if propellor is used to manage DNS for the domain.
+  * Propellor's output now includes the hostname being provisioned, or
+    when provisioning a docker container, the container name.
 
  -- Joey Hess <joeyh@debian.org>  Sat, 31 May 2014 16:41:56 -0400
 
diff --git a/doc/todo/docker_todo_list.mdwn b/doc/todo/docker_todo_list.mdwn
index 2bf095f..1321445 100644
--- a/doc/todo/docker_todo_list.mdwn
+++ b/doc/todo/docker_todo_list.mdwn
@@ -1,6 +1,3 @@
-* Display of docker container properties is a bit wonky. It always
-  says they are unchanged even when they changed and triggered a
-  reprovision.
 * There is no way for a property of a docker container to require
   some property be met outside the container. For example, some servers
   need ntp installed for a good date source.

From 4c96b0681c554965bc2aff15a04eb7a48268b3f6 Mon Sep 17 00:00:00 2001
From: Joey Hess <joey@kitenet.net>
Date: Sat, 31 May 2014 18:52:42 -0400
Subject: [PATCH 15/21] propellor spin

---
 src/Propellor/Engine.hs  |  2 +-
 src/Propellor/Message.hs | 19 +++++++++++++++++--
 2 files changed, 18 insertions(+), 3 deletions(-)

diff --git a/src/Propellor/Engine.hs b/src/Propellor/Engine.hs
index 773e234..1fba6a2 100644
--- a/src/Propellor/Engine.hs
+++ b/src/Propellor/Engine.hs
@@ -33,7 +33,7 @@ ensureProperties ps = ensure ps NoChange
 	ensure [] rs = return rs
 	ensure (l:ls) rs = do
 		hn <- getHostName
-		r <- actionMessage (hn ++ " " ++ propertyDesc l) (ensureProperty l)
+		r <- actionMessageOn hn (propertyDesc l) (ensureProperty l)
 		ensure ls (r <> rs)
 
 ensureProperty :: Property -> Propellor Result
diff --git a/src/Propellor/Message.hs b/src/Propellor/Message.hs
index 780471c..afbed1c 100644
--- a/src/Propellor/Message.hs
+++ b/src/Propellor/Message.hs
@@ -12,7 +12,15 @@ import Propellor.Types
 -- | Shows a message while performing an action, with a colored status
 -- display.
 actionMessage :: (MonadIO m, ActionResult r) => Desc -> m r -> m r
-actionMessage desc a = do
+actionMessage = actionMessage' Nothing
+
+-- | Shows a message while performing an action on a specified host,
+-- with a colored status display.
+actionMessageOn :: (MonadIO m, ActionResult r) => HostName -> Desc -> m r -> m r
+actionMessageOn = actionMessage' . Just
+
+actionMessage' :: (MonadIO m, ActionResult r) => Maybe HostName -> Desc -> m r -> m r
+actionMessage' mhn desc a = do
 	liftIO $ do
 		setTitle $ "propellor: " ++ desc
 		hFlush stdout
@@ -21,12 +29,19 @@ actionMessage desc a = do
 
 	liftIO $ do
 		setTitle "propellor: running"
-		let (msg, intensity, color) = getActionResult r
+		showhn mhn
 		putStr $ desc ++ " ... "
+		let (msg, intensity, color) = getActionResult r
 		colorLine intensity color msg
 		hFlush stdout
 
 	return r
+  where
+	showhn Nothing = return ()
+	showhn (Just hn) = do
+		setSGR [SetColor Foreground Dull Cyan]
+		putStr (hn ++ " ")
+		setSGR []
 
 warningMessage :: MonadIO m => String -> m ()
 warningMessage s = liftIO $ colorLine Vivid Magenta $ "** warning: " ++ s

From 6b835c5eeb352718a11e707a0e10d2bc5092782b Mon Sep 17 00:00:00 2001
From: Joey Hess <joey@kitenet.net>
Date: Sat, 31 May 2014 18:53:39 -0400
Subject: [PATCH 16/21] propellor spin


From 4f70fceb3a79f2c2b746407768faf363d11c11a4 Mon Sep 17 00:00:00 2001
From: Joey Hess <joey@kitenet.net>
Date: Sat, 31 May 2014 20:39:56 -0400
Subject: [PATCH 17/21] got rid of the Attr -> Attr SetAttr hack, and use
 monoids for Attr

The SetAttr hack used to be needed because the hostname was part of the
Attr, and was required to be present. Now that it's moved to Host, let's
get rid of that, since it tended to waste CPU.
---
 src/Propellor/Attr.hs            | 28 ++++++----------------------
 src/Propellor/Engine.hs          |  2 +-
 src/Propellor/Property.hs        | 28 ++++++++++++----------------
 src/Propellor/Property/Dns.hs    |  9 ++++++++-
 src/Propellor/Property/Docker.hs | 16 +++++++---------
 src/Propellor/Types.hs           | 19 +++++++++----------
 src/Propellor/Types/Attr.hs      | 26 +++++++++++++++++++-------
 src/Propellor/Types/Dns.hs       | 20 ++++++++++++++++++++
 8 files changed, 82 insertions(+), 66 deletions(-)

diff --git a/src/Propellor/Attr.hs b/src/Propellor/Attr.hs
index 5749a4b..8f1c6b7 100644
--- a/src/Propellor/Attr.hs
+++ b/src/Propellor/Attr.hs
@@ -9,9 +9,10 @@ import "mtl" Control.Monad.Reader
 import qualified Data.Set as S
 import qualified Data.Map as M
 import Data.Maybe
+import Data.Monoid
 import Control.Applicative
 
-pureAttrProperty :: Desc -> SetAttr -> Property 
+pureAttrProperty :: Desc -> Attr -> Property 
 pureAttrProperty desc = Property ("has " ++ desc) (return NoChange)
 
 getHostName :: Propellor HostName
@@ -19,7 +20,7 @@ getHostName = asks _hostName
 
 os :: System -> Property
 os system = pureAttrProperty ("Operating " ++ show system) $
-	\d -> d { _os = Just system }
+	mempty { _os = Just system }
 
 getOS :: Propellor (Maybe System)
 getOS = asks (_os . hostAttr)
@@ -41,7 +42,7 @@ alias = addDNS . CNAME . AbsDomain
 
 addDNS :: Record -> Property
 addDNS r = pureAttrProperty (rdesc r) $
-	\d -> d { _dns = S.insert r (_dns d) }
+	mempty { _dns = S.singleton r }
   where
 	rdesc (CNAME d) = unwords ["alias", ddesc d]
 	rdesc (Address (IPv4 addr)) = unwords ["ipv4", addr]
@@ -55,32 +56,15 @@ addDNS r = pureAttrProperty (rdesc r) $
 	ddesc (RelDomain domain) = domain
 	ddesc RootDomain = "@"
 
--- | Adds a DNS NamedConf stanza.
---
--- Note that adding a Master stanza for a domain always overrides an
--- existing Secondary stanza, while a Secondary stanza is only added
--- when there is no existing Master stanza.
-addNamedConf :: NamedConf -> SetAttr
-addNamedConf conf d = d { _namedconf = new }
-  where
-	m = _namedconf d
-	domain = confDomain conf
-	new = case (confDnsServerType conf, confDnsServerType <$> M.lookup domain m) of
-		(Secondary, Just Master) -> m
-		_  -> M.insert domain conf m
-
-getNamedConf :: Propellor (M.Map Domain NamedConf)
-getNamedConf = asks (_namedconf . hostAttr)
-
 sshPubKey :: String -> Property
 sshPubKey k = pureAttrProperty ("ssh pubkey known") $
-	\d -> d { _sshPubKey = Just k }
+	mempty { _sshPubKey = Just k }
 
 getSshPubKey :: Propellor (Maybe String)
 getSshPubKey = asks (_sshPubKey . hostAttr)
 
 hostAttr :: Host -> Attr
-hostAttr (Host _ _ mkattrs) = mkattrs newAttr
+hostAttr (Host _ _ attr) = attr
 
 hostProperties :: Host -> [Property]
 hostProperties (Host _ ps _) = ps
diff --git a/src/Propellor/Engine.hs b/src/Propellor/Engine.hs
index 1fba6a2..7cee42e 100644
--- a/src/Propellor/Engine.hs
+++ b/src/Propellor/Engine.hs
@@ -20,7 +20,7 @@ runPropellor host a = runReaderT (runWithHost a) host
 mainProperties :: Host -> IO ()
 mainProperties host = do
 	r <- runPropellor host $
-		ensureProperties [Property "overall" (ensureProperties $ hostProperties host) id]
+		ensureProperties [Property "overall" (ensureProperties $ hostProperties host) mempty]
 	setTitle "propellor: done"
 	hFlush stdout
 	case r of
diff --git a/src/Propellor/Property.hs b/src/Propellor/Property.hs
index f2a4b3d..e3d46ea 100644
--- a/src/Propellor/Property.hs
+++ b/src/Propellor/Property.hs
@@ -5,12 +5,10 @@ module Propellor.Property where
 import System.Directory
 import Control.Monad
 import Data.Monoid
-import Data.List
 import Control.Monad.IfElse
 import "mtl" Control.Monad.Reader
 
 import Propellor.Types
-import Propellor.Types.Attr
 import Propellor.Attr
 import Propellor.Engine
 import Utility.Monad
@@ -18,19 +16,19 @@ import System.FilePath
 
 -- Constructs a Property.
 property :: Desc -> Propellor Result -> Property
-property d s = Property d s id
+property d s = Property d s 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) (combineSetAttrs ps)
+propertyList desc ps = Property desc (ensureProperties ps) (combineAttrs ps)
 
 -- | Combines a list of properties, resulting in one property that
 -- ensures each in turn, stopping on failure.
 combineProperties :: Desc -> [Property] -> Property
-combineProperties desc ps = Property desc (go ps NoChange) (combineSetAttrs ps)
+combineProperties desc ps = Property desc (go ps NoChange) (combineAttrs ps)
   where
   	go [] rs = return rs
 	go (l:ls) rs = do
@@ -69,7 +67,7 @@ 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 (combineSetAttr p hook)
+p `onChange` hook = Property (propertyDesc p) satisfy (combineAttr p hook)
   where
 	satisfy = do
 		r <- ensureProperty p
@@ -130,21 +128,19 @@ revert (RevertableProperty p1 p2) = RevertableProperty p2 p1
 -- > 	! oldproperty
 -- > 	& otherproperty
 host :: HostName -> Host
-host hn = Host hn [] (\_ -> newAttr)
+host hn = Host hn [] mempty
 
 -- | Adds a property to a Host
 --
 -- Can add Properties and RevertableProperties
 (&) :: IsProp p => Host -> p -> Host
-(Host hn ps as) & p = Host hn (ps ++ [toProp p]) (setAttr p . as)
+(Host hn ps as) & p = Host hn (ps ++ [toProp p]) (as <> getAttr p)
 
 infixl 1 &
 
 -- | Adds a property to the Host in reverted form.
 (!) :: Host -> RevertableProperty -> Host
-(Host hn ps as) ! p = Host hn (ps ++ [toProp q]) (setAttr q . as)
-  where
-	q = revert p
+h ! p = h & revert p
 
 infixl 1 !
 
@@ -152,12 +148,12 @@ infixl 1 !
 adjustProperty :: Property -> (Propellor Result -> Propellor Result) -> Property
 adjustProperty p f = p { propertySatisfy = f (propertySatisfy p) }
 
--- Combines the Attr settings of two properties.
-combineSetAttr :: (IsProp p, IsProp q) => p -> q -> SetAttr
-combineSetAttr p q = setAttr p . setAttr q
+-- Combines the Attr of two properties.
+combineAttr :: (IsProp p, IsProp q) => p -> q -> Attr
+combineAttr p q = getAttr p <> getAttr q
 
-combineSetAttrs :: IsProp p => [p] -> SetAttr
-combineSetAttrs = foldl' (.) id . map setAttr
+combineAttrs :: IsProp p => [p] -> Attr
+combineAttrs = mconcat . map getAttr
 
 makeChange :: IO () -> Propellor Result
 makeChange a = liftIO a >> return MadeChange
diff --git a/src/Propellor/Property/Dns.hs b/src/Propellor/Property/Dns.hs
index f82d549..4437849 100644
--- a/src/Propellor/Property/Dns.hs
+++ b/src/Propellor/Property/Dns.hs
@@ -131,7 +131,7 @@ otherServers :: DnsServerType -> [Host] -> Domain -> [HostName]
 otherServers wantedtype hosts domain =
 	M.keys $ M.filter wanted $ hostMap hosts
   where
-	wanted h = case M.lookup domain (_namedconf $ hostAttr h) of
+	wanted h = case M.lookup domain (fromNamedConfMap $ _namedconf $ hostAttr h) of
 		Nothing -> False
 		Just conf -> confDnsServerType conf == wantedtype
 			&& confDomain conf == domain
@@ -406,3 +406,10 @@ domainHost base (AbsDomain d)
   where
 	dotbase = '.':base
 
+addNamedConf :: NamedConf -> Attr
+addNamedConf conf = mempty { _namedconf = NamedConfMap (M.singleton domain conf) }
+  where
+       domain = confDomain conf
+
+getNamedConf :: Propellor (M.Map Domain NamedConf)
+getNamedConf = asks $ fromNamedConfMap . _namedconf . hostAttr
diff --git a/src/Propellor/Property/Docker.hs b/src/Propellor/Property/Docker.hs
index 34a9deb..3e925bb 100644
--- a/src/Propellor/Property/Docker.hs
+++ b/src/Propellor/Property/Docker.hs
@@ -46,9 +46,9 @@ type ContainerName = String
 -- >    & Apt.installed {"apache2"]
 -- >    & ...
 container :: ContainerName -> Image -> Host
-container cn image = Host hn [] (\_ -> attr)
+container cn image = Host hn [] attr
   where
-	attr = newAttr { _dockerImage = Just image }
+	attr = mempty { _dockerImage = Just image }
 	hn = cn2hn cn
 
 cn2hn :: ContainerName -> HostName
@@ -97,9 +97,7 @@ docked hosts cn = RevertableProperty
 
 exposeDnsAttrs :: Host -> Property -> Property
 exposeDnsAttrs (Host _ _ containerattr) p = combineProperties (propertyDesc p) $
-	p : map addDNS (S.toList containerdns)
-  where
-	containerdns = _dns $ containerattr newAttr
+	p : map addDNS (S.toList $ _dns containerattr)
 
 findContainer
 	:: Maybe Host
@@ -422,14 +420,14 @@ listImages :: IO [Image]
 listImages = lines <$> readProcess dockercmd ["images", "--all", "--quiet"]
 
 runProp :: String -> RunParam -> Property
-runProp field val = pureAttrProperty (param) $ \attr ->
-	attr { _dockerRunParams = _dockerRunParams attr ++ [\_ -> "--"++param] }
+runProp field val = pureAttrProperty (param) $
+	mempty { _dockerRunParams = [\_ -> "--"++param] }
   where
 	param = field++"="++val
 
 genProp :: String -> (HostName -> RunParam) -> Property
-genProp field mkval = pureAttrProperty field $ \attr ->
-	attr { _dockerRunParams = _dockerRunParams attr ++ [\hn -> "--"++field++"=" ++ mkval hn] }
+genProp field mkval = pureAttrProperty field $
+	mempty { _dockerRunParams = [\hn -> "--"++field++"=" ++ mkval hn] }
 
 -- | The ContainerIdent of a container is written to
 -- /.propellor-ident inside it. This can be checked to see if
diff --git a/src/Propellor/Types.hs b/src/Propellor/Types.hs
index a96e952..e0d471f 100644
--- a/src/Propellor/Types.hs
+++ b/src/Propellor/Types.hs
@@ -4,14 +4,13 @@
 module Propellor.Types
 	( Host(..)
 	, Attr
-	, SetAttr
+	, getAttr
 	, Propellor(..)
 	, Property(..)
 	, RevertableProperty(..)
 	, IsProp
 	, describe
 	, toProp
-	, setAttr
 	, requires
 	, Desc
 	, Result(..)
@@ -39,7 +38,7 @@ import Propellor.Types.Dns
 data Host = Host
 	{ _hostName :: HostName
 	, _hostProps :: [Property]
-	, _hostAttrs :: SetAttr
+	, _hostAttr :: Attr
 	}
 
 -- | Propellor's monad provides read-only access to the host it's running
@@ -61,8 +60,8 @@ data Property = Property
 	{ propertyDesc :: Desc
 	, propertySatisfy :: Propellor Result
 	-- ^ must be idempotent; may run repeatedly
-	, propertyAttr :: SetAttr
-	-- ^ a property can set an Attr on the host that has the property.
+	, propertyAttr :: Attr
+	-- ^ a property can set an attribute of the host that has the property.
 	}
 
 -- | A property that can be reverted.
@@ -75,15 +74,15 @@ class IsProp p where
 	-- | Indicates that the first property can only be satisfied
 	-- once the second one is.
 	requires :: p -> Property -> p
-	setAttr :: p -> SetAttr
+	getAttr :: p -> Attr
 
 instance IsProp Property where
 	describe p d = p { propertyDesc = d }
 	toProp p = p
-	setAttr = propertyAttr
+	getAttr = propertyAttr
 	x `requires` y = Property (propertyDesc x) satisfy attr
 	  where
-	  	attr = propertyAttr x . propertyAttr y
+	  	attr = getAttr y <> getAttr x
 		satisfy = do
 			r <- propertySatisfy y
 			case r of
@@ -98,8 +97,8 @@ instance IsProp RevertableProperty where
 	toProp (RevertableProperty p1 _) = p1
 	(RevertableProperty p1 p2) `requires` y =
 		RevertableProperty (p1 `requires` y) p2
-	-- | Return the SetAttr of the currently active side.
-	setAttr (RevertableProperty p1 _p2) = setAttr p1
+	-- | Return the Attr of the currently active side.
+	getAttr (RevertableProperty p1 _p2) = getAttr p1
 
 type Desc = String
 
diff --git a/src/Propellor/Types/Attr.hs b/src/Propellor/Types/Attr.hs
index 7f0add1..4c891a4 100644
--- a/src/Propellor/Types/Attr.hs
+++ b/src/Propellor/Types/Attr.hs
@@ -4,14 +4,14 @@ import Propellor.Types.OS
 import qualified Propellor.Types.Dns as Dns
 
 import qualified Data.Set as S
-import qualified Data.Map as M
+import Data.Monoid
 
 -- | The attributes of a host.
 data Attr = Attr
 	{ _os :: Maybe System
 	, _sshPubKey :: Maybe String
 	, _dns :: S.Set Dns.Record
-	, _namedconf :: M.Map Dns.Domain Dns.NamedConf
+	, _namedconf :: Dns.NamedConfMap
 
 	, _dockerImage :: Maybe String
 	, _dockerRunParams :: [HostName -> String]
@@ -29,6 +29,23 @@ instance Eq Attr where
 		  in simpl x == simpl y
 		]
 
+instance Monoid Attr where
+	mempty = Attr Nothing Nothing mempty mempty Nothing mempty
+	mappend old new = Attr
+		{ _os = case _os new of
+			Just v -> Just v
+			Nothing -> _os old
+		, _sshPubKey = case _sshPubKey new of
+			Just v -> Just v
+			Nothing -> _sshPubKey old
+		, _dns = _dns new <> _dns old
+		, _namedconf = _namedconf new <> _namedconf old
+		, _dockerImage = case _dockerImage new of
+			Just v -> Just v
+			Nothing -> _dockerImage old
+		, _dockerRunParams = _dockerRunParams old <> _dockerRunParams new
+		}
+
 instance Show Attr where
 	show a = unlines
 		[ "OS " ++ show (_os a)
@@ -38,8 +55,3 @@ instance Show Attr where
 		, "docker image " ++ show (_dockerImage a)
 		, "docker run params " ++ show (map (\mk -> mk "") (_dockerRunParams a))
 		]
-
-newAttr :: Attr
-newAttr = Attr Nothing Nothing S.empty M.empty Nothing []
-
-type SetAttr = Attr -> Attr
diff --git a/src/Propellor/Types/Dns.hs b/src/Propellor/Types/Dns.hs
index ba6a92d..66fbd1a 100644
--- a/src/Propellor/Types/Dns.hs
+++ b/src/Propellor/Types/Dns.hs
@@ -3,6 +3,8 @@ module Propellor.Types.Dns where
 import Propellor.Types.OS (HostName)
 
 import Data.Word
+import Data.Monoid
+import qualified Data.Map as M
 
 type Domain = String
 
@@ -90,3 +92,21 @@ domainHostName :: BindDomain -> Maybe HostName
 domainHostName (RelDomain d) = Just d
 domainHostName (AbsDomain d) = Just d
 domainHostName RootDomain = Nothing
+
+newtype NamedConfMap = NamedConfMap (M.Map Domain NamedConf)
+	deriving (Eq, Ord, Show)
+
+-- | Adding a Master NamedConf stanza for a particulr domain always
+-- overrides an existing Secondary stanza for that domain, while a
+-- Secondary stanza is only added when there is no existing Master stanza.
+instance Monoid NamedConfMap where
+	mempty = NamedConfMap M.empty
+	mappend (NamedConfMap old) (NamedConfMap new) = NamedConfMap $
+		M.unionWith combiner new old
+	  where
+		combiner n o = case (confDnsServerType n, confDnsServerType o) of
+			(Secondary, Master) -> o
+			_  -> n
+
+fromNamedConfMap :: NamedConfMap -> M.Map Domain NamedConf
+fromNamedConfMap (NamedConfMap m) = m

From e133536c3f7cc4dd816b8c5fe97e3131411a5ae9 Mon Sep 17 00:00:00 2001
From: Joey Hess <joey@kitenet.net>
Date: Sat, 31 May 2014 20:43:38 -0400
Subject: [PATCH 18/21] propellor spin


From 58c8d74b4c4917f9f5e566709202ad432a7b2a6f Mon Sep 17 00:00:00 2001
From: Joey Hess <joey@kitenet.net>
Date: Sat, 31 May 2014 20:48:23 -0400
Subject: [PATCH 19/21] simplified record accessors

---
 src/Propellor/Attr.hs              | 11 +----------
 src/Propellor/Engine.hs            |  2 +-
 src/Propellor/PrivData.hs          |  3 +--
 src/Propellor/Property/Dns.hs      |  6 +++---
 src/Propellor/Property/Docker.hs   |  2 +-
 src/Propellor/Property/Hostname.hs |  2 +-
 src/Propellor/Property/Postfix.hs  |  2 +-
 src/Propellor/Types.hs             |  6 +++---
 8 files changed, 12 insertions(+), 22 deletions(-)

diff --git a/src/Propellor/Attr.hs b/src/Propellor/Attr.hs
index 8f1c6b7..29d7a01 100644
--- a/src/Propellor/Attr.hs
+++ b/src/Propellor/Attr.hs
@@ -15,9 +15,6 @@ import Control.Applicative
 pureAttrProperty :: Desc -> Attr -> Property 
 pureAttrProperty desc = Property ("has " ++ desc) (return NoChange)
 
-getHostName :: Propellor HostName
-getHostName = asks _hostName
-
 os :: System -> Property
 os system = pureAttrProperty ("Operating " ++ show system) $
 	mempty { _os = Just system }
@@ -63,14 +60,8 @@ sshPubKey k = pureAttrProperty ("ssh pubkey known") $
 getSshPubKey :: Propellor (Maybe String)
 getSshPubKey = asks (_sshPubKey . hostAttr)
 
-hostAttr :: Host -> Attr
-hostAttr (Host _ _ attr) = attr
-
-hostProperties :: Host -> [Property]
-hostProperties (Host _ ps _) = ps
-
 hostMap :: [Host] -> M.Map HostName Host
-hostMap l = M.fromList $ zip (map _hostName l) l 
+hostMap l = M.fromList $ zip (map hostName l) l 
 
 findHost :: [Host] -> HostName -> Maybe Host
 findHost l hn = M.lookup hn (hostMap l)
diff --git a/src/Propellor/Engine.hs b/src/Propellor/Engine.hs
index 7cee42e..ca0f726 100644
--- a/src/Propellor/Engine.hs
+++ b/src/Propellor/Engine.hs
@@ -32,7 +32,7 @@ ensureProperties ps = ensure ps NoChange
   where
 	ensure [] rs = return rs
 	ensure (l:ls) rs = do
-		hn <- getHostName
+		hn <- asks hostName
 		r <- actionMessageOn hn (propertyDesc l) (ensureProperty l)
 		ensure ls (r <> rs)
 
diff --git a/src/Propellor/PrivData.hs b/src/Propellor/PrivData.hs
index ad2c8d2..54f67d7 100644
--- a/src/Propellor/PrivData.hs
+++ b/src/Propellor/PrivData.hs
@@ -13,7 +13,6 @@ import Control.Monad
 import "mtl" Control.Monad.Reader
 
 import Propellor.Types
-import Propellor.Attr
 import Propellor.Message
 import Utility.Monad
 import Utility.PartialPrelude
@@ -30,7 +29,7 @@ withPrivData :: PrivDataField -> (String -> Propellor Result) -> Propellor Resul
 withPrivData field a = maybe missing a =<< liftIO (getPrivData field)
   where
 	missing = do
-		host <- getHostName
+		host <- asks hostName
 		let host' = if ".docker" `isSuffixOf` host
 			then "$parent_host"
 			else host
diff --git a/src/Propellor/Property/Dns.hs b/src/Propellor/Property/Dns.hs
index 4437849..3e5c782 100644
--- a/src/Propellor/Property/Dns.hs
+++ b/src/Propellor/Property/Dns.hs
@@ -352,11 +352,11 @@ genZone hosts zdomain soa =
 	-- so warn.
 	hostips :: Host -> [Either WarningMessage (BindDomain, Record)]
 	hostips h
-		| null l = [Left $ "no IP address defined for host " ++ _hostName h]
+		| null l = [Left $ "no IP address defined for host " ++ hostName h]
 		| otherwise = map Right l
 	  where
 		attr = hostAttr h
-		l = zip (repeat $ AbsDomain $ _hostName h)
+		l = zip (repeat $ AbsDomain $ hostName h)
 			(map Address $ getAddresses attr)
 
 	-- Any host, whether its hostname is in the zdomain or not,
@@ -387,7 +387,7 @@ genZone hosts zdomain soa =
 	hostrecords h = map Right l
 	  where
 		attr = hostAttr h
-		l = zip (repeat $ AbsDomain $ _hostName h)
+		l = zip (repeat $ AbsDomain $ hostName h)
 			(S.toList $ S.filter (\r -> isNothing (getIPAddr r) && isNothing (getCNAME r)) (_dns attr))
 
 inDomain :: Domain -> BindDomain -> Bool
diff --git a/src/Propellor/Property/Docker.hs b/src/Propellor/Property/Docker.hs
index 3e925bb..8e081ae 100644
--- a/src/Propellor/Property/Docker.hs
+++ b/src/Propellor/Property/Docker.hs
@@ -72,7 +72,7 @@ docked hosts cn = RevertableProperty
 	(go "undocked" teardown)
   where
 	go desc a = property (desc ++ " " ++ cn) $ do
-		hn <- getHostName
+		hn <- asks hostName
   		let cid = ContainerId hn cn
 		ensureProperties [findContainer mhost cid cn $ a cid]
 		
diff --git a/src/Propellor/Property/Hostname.hs b/src/Propellor/Property/Hostname.hs
index 3859649..3a6283c 100644
--- a/src/Propellor/Property/Hostname.hs
+++ b/src/Propellor/Property/Hostname.hs
@@ -9,7 +9,7 @@ import qualified Propellor.Property.File as File
 -- A FQDN also configures /etc/hosts, with an entry for 127.0.1.1, which is
 -- standard at least on Debian to set the FDQN (127.0.0.1 is localhost).
 sane :: Property
-sane = property ("sane hostname") (ensureProperty . setTo =<< getHostName)
+sane = property ("sane hostname") (ensureProperty . setTo =<< asks hostName)
 
 setTo :: HostName -> Property
 setTo hn = combineProperties desc go
diff --git a/src/Propellor/Property/Postfix.hs b/src/Propellor/Property/Postfix.hs
index 9fa4a2c..ef96e08 100644
--- a/src/Propellor/Property/Postfix.hs
+++ b/src/Propellor/Property/Postfix.hs
@@ -16,7 +16,7 @@ satellite :: Property
 satellite = setup `requires` installed
   where
 	setup = trivial $ property "postfix satellite system" $ do
-		hn <- getHostName
+		hn <- asks hostName
 		ensureProperty $ Apt.reConfigure "postfix"
 			[ ("postfix/main_mailer_type", "select", "Satellite system")
 			, ("postfix/root_address", "string", "root")
diff --git a/src/Propellor/Types.hs b/src/Propellor/Types.hs
index e0d471f..4ea97bc 100644
--- a/src/Propellor/Types.hs
+++ b/src/Propellor/Types.hs
@@ -36,9 +36,9 @@ import Propellor.Types.Dns
 -- | Everything Propellor knows about a system: Its hostname,
 -- properties and attributes.
 data Host = Host
-	{ _hostName :: HostName
-	, _hostProps :: [Property]
-	, _hostAttr :: Attr
+	{ hostName :: HostName
+	, hostProperties :: [Property]
+	, hostAttr :: Attr
 	}
 
 -- | Propellor's monad provides read-only access to the host it's running

From 67e61d29192a691a64f08d950b6143f696e1ed3a Mon Sep 17 00:00:00 2001
From: Joey Hess <joey@kitenet.net>
Date: Sat, 31 May 2014 20:53:08 -0400
Subject: [PATCH 20/21] propellor spin


From 179301f58dea22feb945004389a56662fe255138 Mon Sep 17 00:00:00 2001
From: Joey Hess <joey@kitenet.net>
Date: Sat, 31 May 2014 21:02:52 -0400
Subject: [PATCH 21/21] build w/o optimisations

I hope this will reign in ghc memory use
---
 propellor.cabal | 6 +++---
 1 file changed, 3 insertions(+), 3 deletions(-)

diff --git a/propellor.cabal b/propellor.cabal
index 1ca9f3a..67a418e 100644
--- a/propellor.cabal
+++ b/propellor.cabal
@@ -35,7 +35,7 @@ Description:
 
 Executable wrapper
   Main-Is: wrapper.hs
-  GHC-Options: -Wall -threaded
+  GHC-Options: -Wall -threaded -O0
   Hs-Source-Dirs:  src
   Build-Depends: MissingH, directory, filepath, base >= 4.5, base < 5, 
    IfElse, process, bytestring, hslogger, unix-compat, ansi-terminal,
@@ -47,7 +47,7 @@ Executable wrapper
 
 Executable config
   Main-Is: config.hs
-  GHC-Options: -Wall -threaded
+  GHC-Options: -Wall -threaded -0O
   Hs-Source-Dirs:  src
   Build-Depends: MissingH, directory, filepath, base >= 4.5, base < 5, 
    IfElse, process, bytestring, hslogger, unix-compat, ansi-terminal,
@@ -58,7 +58,7 @@ Executable config
     Build-Depends: unix
 
 Library
-  GHC-Options: -Wall
+  GHC-Options: -Wall -O0
   Hs-Source-Dirs:  src
   Build-Depends: MissingH, directory, filepath, base >= 4.5, base < 5, 
    IfElse, process, bytestring, hslogger, unix-compat, ansi-terminal,