better descriptions for properties

Propellor.hs

@@ -45,10 +45,11 @@ standardSystem suite = propertyList "standard system"
 	, check (Ssh.hasAuthorizedKeys "root") $
 		User.lockedPassword "root"
 	, Apt.installed ["vim"]
-	, User.nonsystem "joey"
+	, User.sshAccountFor "joey"
 	, Apt.installed ["sudo"]
 	-- nopasswd because no password is set up for joey.
 	, "/etc/sudoers" `File.containsLine` "joey ALL=(ALL:ALL) NOPASSWD:ALL"
+		`describe` "sudoer joey"
 	, GitHome.installedFor "joey"
 	]
 
@@ -59,10 +60,10 @@ cleanCloudAtCost hostname = propertyList "cloudatcost cleanup"
 	, Apt.removed ["exim4"] `onChange` Apt.autoRemove
 	, Hostname.set hostname
 	, Ssh.uniqueHostKeys
-	-- Work around for #612402
 	, "/etc/default/grub" `File.containsLine` "GRUB_DISABLE_LINUX_UUID=true"
 		`onChange` cmdProperty "update-grub" []
 		`onChange` cmdProperty "update-initramfs" [Param "-u"]
+		`describe` "work around grub/lvm boot bug #743126"
 	-- Cruft
 	, File.notPresent "/etc/rc.local"
 	, File.notPresent "/etc/init.d/S97-setup.sh"

Property.hs

@@ -83,6 +83,9 @@ property `onChange` hook = Property (propertyDesc property) $ do
 requires :: Property -> Property -> Property
 x `requires` y = combineProperties (propertyDesc x) [y, x]
 
+describe :: Property -> Desc -> Property
+describe p d = p { propertyDesc = d }
+
 {- Makes a Property only be performed when a test succeeds. -}
 check :: IO Bool -> Property -> Property
 check c property = Property (propertyDesc property) $ ifM c

Property/Apt.hs

@@ -59,19 +59,23 @@ runApt ps = cmdProperty' "apt-get" ps env
 
 update :: Property
 update = runApt [Param "update"]
+	`describe` "apt update"
 
 upgrade :: Property
 upgrade = runApt [Params "-y dist-upgrade"]
+	`describe` "apt dist-upgrade"
 
 type Package = String
 
 installed :: [Package] -> Property
 installed ps = check (isInstallable ps) go
+	`describe` (unwords $ "apt installed":ps)
   where
 	go = runApt $ [Param "-y", Param "install"] ++ map Param ps
 
 removed :: [Package] -> Property
 removed ps = check (or <$> isInstalled ps) go
+	`describe` (unwords $ "apt removed":ps)
   where
 	go = runApt $ [Param "-y", Param "remove"] ++ map Param ps
 
@@ -95,18 +99,24 @@ isInstalled ps = catMaybes . map parse . lines
 
 autoRemove :: Property
 autoRemove = runApt [Param "-y", Param "autoremove"]
+	`describe` "apt autoremove"
 
 unattendedUpgrades :: Bool -> Property
-unattendedUpgrades enabled = installed ["unattended-upgrades"]
+unattendedUpgrades enabled =
+	(if enabled then installed else removed) ["unattended-upgrades"]
 	`onChange` reConfigure "unattended-upgrades"
-		[("unattended-upgrades/enable_auto_updates"
-		 , "boolean"
-		 , if enabled then "true" else "false")]
+		[("unattended-upgrades/enable_auto_updates" , "boolean", v)]
+	`describe` ("unattended upgrades " ++ v)
+  where
+	v
+		| enabled = "true"
+		| otherwise = "false"
 
 {- Preseeds debconf values and reconfigures the package so it takes
  - effect. -}
 reConfigure :: Package -> [(String, String, String)] -> Property
 reConfigure package vals = reconfigure `requires` setselections
+	`describe` ("reconfigure " ++ package)
   where
 	setselections = Property "preseed" $ makeChange $
 		withHandle StdinHandle createProcessSuccess

Property/Reboot.hs

@@ -4,3 +4,4 @@ import Common
 
 now :: Property
 now = cmdProperty "reboot" []
+	`describe` "reboot now"

Property/Tor.hs

@@ -6,6 +6,7 @@ import qualified Property.Apt as Apt
 
 isBridge :: Property
 isBridge = setup `requires` Apt.installed ["tor"]
+	`describe` "tor bridge"
   where
 	setup = "/etc/tor/torrc" `File.hasContent`
 		[ "SocksPort 0"

Property/User.hs

@@ -6,12 +6,13 @@ import Common
 
 type UserName = String
 
-nonsystem :: UserName -> Property
-nonsystem user = check (isNothing <$> homedir user) $ cmdProperty "adduser"
+sshAccountFor :: UserName -> Property
+sshAccountFor user = check (isNothing <$> homedir user) $ cmdProperty "adduser"
 	[ Param "--disabled-password"
 	, Param "--gecos", Param ""
 	, Param user
 	]
+	`describe` ("ssh account " ++ user)
 
 {- Removes user home directory!! Use with caution. -}
 nuked :: UserName -> Property
@@ -19,12 +20,14 @@ nuked user = check (isJust <$> homedir user) $ cmdProperty "userdel"
 	[ Param "-r"
 	, Param user
 	]
+	`describe` ("nuked user " ++ user)
 
 lockedPassword :: UserName -> Property
 lockedPassword user = check (not <$> isLockedPassword user) $ cmdProperty "passwd"
 	[ Param "--lock"
 	, Param user
 	]
+	`describe` ("locked " ++ user ++ " password")
 
 isLockedPassword :: UserName -> IO Bool
 isLockedPassword user = parse . words <$> readProcess "passwd" ["-S", user]