use HostAttr to simplify config file

Propellor/Property/Docker.hs

@@ -40,17 +40,24 @@ installed = Apt.installed ["docker.io"]
 -- removed.
 docked
 	:: (HostName -> ContainerName -> Maybe (Container))
-	-> HostName
 	-> ContainerName
 	-> RevertableProperty
-docked findc hn cn = findContainer findc hn cn $
-	\(Container image containerprops) ->
-		let setup = provisionContainer cid
+docked findc 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 findc hn cn $ a cid]
+
+	setup cid (Container image containerprops) =
+		provisionContainer cid
 			`requires`
 		runningContainer cid image containerprops
 			`requires`
 		installed
-		    teardown = combineProperties ("undocked " ++ fromContainerId cid)
+
+	teardown cid (Container image _) =
+		combineProperties ("undocked " ++ fromContainerId cid)
 			[ stoppedContainer cid
 			, Property ("cleaned up " ++ fromContainerId cid) $
 				liftIO $ report <$> mapM id
@@ -58,18 +65,15 @@ docked findc hn cn = findContainer findc hn cn $
 					, removeImage image
 					]
 			]
-		in RevertableProperty setup teardown
-  where
-  	cid = ContainerId hn cn
 
 findContainer
 	:: (HostName -> ContainerName -> Maybe (Container))
 	-> HostName
 	-> ContainerName
-	-> (Container -> RevertableProperty)
-	-> RevertableProperty
+	-> (Container -> Property)
+	-> Property
 findContainer findc hn cn mk = case findc hn cn of
-	Nothing -> RevertableProperty cantfind cantfind
+	Nothing -> cantfind
 	Just container -> mk container
   where
   	cid = ContainerId hn cn

Propellor/Property/Hostname.hs

@@ -3,14 +3,17 @@ module Propellor.Property.Hostname where
 import Propellor
 import qualified Propellor.Property.File as File
 
--- | Sets the hostname. Configures both /etc/hostname and the current
--- hostname.
+-- | Ensures that the hostname is set to the HostAttr value.
+-- Configures both /etc/hostname and the current hostname.
 --
--- When provided with a FQDN, also configures /etc/hosts,
+-- When the hostname is 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).
-set :: HostName -> Property
-set hostname = combineProperties desc go
+sane :: Property
+sane = Property ("sane hostname") (ensureProperty . setTo =<< getHostName)
+
+setTo :: HostName -> Property
+setTo hostname = combineProperties desc go
 	`onChange` cmdProperty "hostname" [host]
   where
 	desc = "hostname " ++ hostname

Propellor/Types.hs

@@ -27,7 +27,7 @@ data RevertableProperty = RevertableProperty Property Property
 
 -- | Propellor's monad provides read-only access to attributes of the
 -- system.
-newtype Propellor a = Propellor { runWithHostAttr :: ReaderT HostAttr IO a }
+newtype Propellor p = Propellor { runWithHostAttr :: ReaderT HostAttr IO p }
 	deriving
 		( Monad
 		, Functor

config-joey.hs

@@ -32,35 +32,35 @@ main = defaultMain [host, Docker.containerProperties container]
 -- Edit this to configure propellor!
 host :: HostName -> Maybe [Property]
 -- Clam is a tor bridge, and an olduse.net shellbox and other fun stuff.
-host hostname@"clam.kitenet.net" = Just $ withSystemd $ props
-	& cleanCloudAtCost hostname
+host "clam.kitenet.net" = Just $ withSystemd $ props
+	& cleanCloudAtCost
 	& standardSystem Unstable
 	& Apt.unattendedUpgrades
 	& Network.ipv6to4
 	& Apt.installed ["git-annex", "mtr"]
 	& Tor.isBridge
 	& JoeySites.oldUseNetshellBox
-	& Docker.docked container hostname "openid-provider"
+	& Docker.docked container "openid-provider"
 		`requires` Apt.installed ["ntp"]
-	& Docker.docked container hostname "ancient-kitenet"
+	& Docker.docked container "ancient-kitenet"
 	& Docker.configured
 	& Docker.garbageCollected `period` Daily
 -- Orca is the main git-annex build box.
-host hostname@"orca.kitenet.net" = Just $ props -- no systemd due to #726375
+host "orca.kitenet.net" = Just $ props -- no systemd due to #726375
 	& standardSystem Unstable
-	& Hostname.set hostname
+	& Hostname.sane
 	& Apt.unattendedUpgrades
 	& Docker.configured
 	& Apt.buildDep ["git-annex"] `period` Daily
-	& Docker.docked container hostname "amd64-git-annex-builder"
-	& Docker.docked container hostname "i386-git-annex-builder"
-	! Docker.docked container hostname "armel-git-annex-builder-companion"
-	! Docker.docked container hostname "armel-git-annex-builder"
+	& Docker.docked container "amd64-git-annex-builder"
+	& Docker.docked container "i386-git-annex-builder"
+	! Docker.docked container "armel-git-annex-builder-companion"
+	! Docker.docked container "armel-git-annex-builder"
 	& Docker.garbageCollected `period` Daily
 -- Diatom is my downloads and git repos server, and secondary dns server.
-host hostname@"diatom.kitenet.net" = Just $ props
+host "diatom.kitenet.net" = Just $ props
 	& standardSystem Stable
-	& Hostname.set hostname
+	& Hostname.sane
 	& Apt.unattendedUpgrades
 	& Apt.serviceInstalledRunning "ntp"
 	& Dns.zones myDnsSecondary
@@ -78,7 +78,7 @@ host hostname@"diatom.kitenet.net" = Just $ props
 	-- gitweb
 	-- downloads.kitenet.net setup (including ssh key to turtle)
 -- My laptop
-host _hostname@"darkstar.kitenet.net" = Just $ props
+host "darkstar.kitenet.net" = Just $ props
 	& Docker.configured
 	& Apt.buildDep ["git-annex"] `period` Daily
 	
@@ -192,9 +192,9 @@ standardContainer suite arch ps = Docker.containerFrom
 	] ++ ps
 
 -- Clean up a system as installed by cloudatcost.com
-cleanCloudAtCost :: HostName -> Property
-cleanCloudAtCost hostname = propertyList "cloudatcost cleanup"
-	[ Hostname.set hostname
+cleanCloudAtCost :: Property
+cleanCloudAtCost = propertyList "cloudatcost cleanup"
+	[ Hostname.sane
 	, Ssh.uniqueHostKeys
 	, "worked around grub/lvm boot bug #743126" ==>
 		"/etc/default/grub" `File.containsLine` "GRUB_DISABLE_LINUX_UUID=true"

config-simple.hs

@@ -25,7 +25,7 @@ main = defaultMain [host, Docker.containerProperties container]
 --
 -- Edit this to configure propellor!
 host :: HostName -> Maybe [Property]
-host hostname@"mybox.example.com" = Just $ props
+host "mybox.example.com" = Just $ props
 	& Apt.stdSourcesList Unstable
 		`onChange` Apt.upgrade
 	& Apt.unattendedUpgrades
@@ -34,7 +34,7 @@ host hostname@"mybox.example.com" = Just $ props
 	& User.hasSomePassword "root"
 	& Network.ipv6to4
 	& File.dirExists "/var/www"
-	& Docker.docked container hostname "webserver"
+	& Docker.docked container "webserver"
 	& Docker.garbageCollected `period` Daily
 	& Cron.runPropellor "30 * * * *"
 -- add more hosts here...