16 files changed, 175 insertions, 118 deletions

diff --git a/src/Propellor/Property.hs b/src/Propellor/Property.hs
index 2976acf1..e862fb44 100644
--- a/src/Propellor/Property.hs
+++ b/src/Propellor/Property.hs
@@ -28,6 +28,8 @@ module Propellor.Property (
 	, UncheckedProperty
 	, unchecked
 	, changesFile
+	, changesFileContent
+	, isNewerThan
 	, checkResult
 	, Checkable
 	, assume
@@ -36,10 +38,12 @@ module Propellor.Property (
 import System.Directory
 import System.FilePath
 import Control.Monad
+import Control.Applicative
 import Data.Monoid
 import Control.Monad.IfElse
 import "mtl" Control.Monad.RWS.Strict
 import System.Posix.Files
+import qualified Data.Hash.MD5 as MD5
 
 import Propellor.Types
 import Propellor.Types.ResultCheck
@@ -47,6 +51,7 @@ import Propellor.Info
 import Propellor.Exception
 import Utility.Exception
 import Utility.Monad
+import Utility.Misc
 
 -- | Constructs a Property, from a description and an action to run to
 -- ensure the Property is met.
@@ -164,14 +169,6 @@ infixl 1 ==>
 ensureProperty :: Property NoInfo -> Propellor Result
 ensureProperty = catchPropellor . propertySatisfy
 
--- | Makes a Property only need to do anything when a test succeeds.
-check :: (LiftPropellor m) => m Bool -> Property i -> Property i
-check c p = adjustPropertySatisfy p $ \satisfy -> 
-	ifM (liftPropellor c)
-		( satisfy
-		, return NoChange
-		)
-
 -- | Tries the first property, but if it fails to work, instead uses
 -- the second.
 fallback :: (Combines p1 p2) => p1 -> p2 -> CombinedType p1 p2
@@ -185,11 +182,12 @@ fallback = combineWith combiner revertcombiner
 	revertcombiner = (<>)
 
 -- | Indicates that a Property may change a particular file. When the file
--- is modified, the property will return MadeChange instead of NoChange.
+-- is modified in any way (including changing its permissions or mtime),
+-- the property will return MadeChange instead of NoChange.
 changesFile :: Checkable p i => p i -> FilePath -> Property i
 changesFile p f = checkResult getstat comparestat p
   where
-	getstat = liftIO $ catchMaybeIO $ getSymbolicLinkStatus f
+	getstat = catchMaybeIO $ getSymbolicLinkStatus f
 	comparestat oldstat = do
 		newstat <- getstat
 		return $ if samestat oldstat newstat then NoChange else MadeChange
@@ -214,6 +212,41 @@ changesFile p f = checkResult getstat comparestat p
 		]
 	samestat _ _ = False
 
+-- | Like `changesFile`, but compares the content of the file.
+-- Changes to mtime etc that do not change file content are treated as
+-- NoChange.
+changesFileContent :: Checkable p i => p i -> FilePath -> Property i
+changesFileContent p f = checkResult getmd5 comparemd5 p
+  where
+	getmd5 = catchMaybeIO $ MD5.md5 . MD5.Str <$> readFileStrictAnyEncoding f
+	comparemd5 oldmd5 = do
+		newmd5 <- getmd5
+		return $ if oldmd5 == newmd5 then NoChange else MadeChange
+
+-- | Determines if the first file is newer than the second file.
+--
+-- This can be used with `check` to only run a command when a file
+-- has changed.
+--
+-- > check ("/etc/aliases" `isNewerThan` "/etc/aliases.db")
+-- > 	(cmdProperty "newaliases" [] `assume` MadeChange) -- updates aliases.db
+--
+-- Or it can be used with `checkResult` to test if a command made a change.
+--
+-- > checkResult (return ())
+-- > 	(\_ -> "/etc/aliases.db" `isNewerThan` "/etc/aliases")
+-- > 	(cmdProperty "newaliases" [])
+--
+-- (If one of the files does not exist, the file that does exist is
+-- considered to be the newer of the two.)
+isNewerThan :: FilePath -> FilePath -> IO Bool
+isNewerThan x y = do
+	mx <- mtime x
+	my <- mtime y
+	return (mx > my)
+  where
+	mtime f = catchMaybeIO $ modificationTimeHiRes <$> getFileStatus f
+
 -- | Makes a property that is satisfied differently depending on the host's
 -- operating system. 
 --
diff --git a/src/Propellor/Property/Apache.hs b/src/Propellor/Property/Apache.hs
index 626d3879..9e192e84 100644
--- a/src/Propellor/Property/Apache.hs
+++ b/src/Propellor/Property/Apache.hs
@@ -37,9 +37,8 @@ siteEnabled hn cf = enable <!> disable
 		[ siteAvailable hn cf
 			`requires` installed
 			`onChange` reloaded
-		, check (not <$> isenabled) $
-			cmdProperty "a2ensite" ["--quiet", hn]
-				`assume` MadeChange
+		, check (not <$> isenabled) 
+			(cmdProperty "a2ensite" ["--quiet", hn])
 				`requires` installed
 				`onChange` reloaded
 		]
@@ -63,15 +62,13 @@ siteAvailable hn cf = combineProperties ("apache site available " ++ hn) $
 modEnabled :: String -> RevertableProperty NoInfo
 modEnabled modname = enable <!> disable
   where
-	enable = check (not <$> isenabled) $
-		cmdProperty "a2enmod" ["--quiet", modname]
-			`assume` MadeChange
+	enable = check (not <$> isenabled)
+		(cmdProperty "a2enmod" ["--quiet", modname])
 			`describe` ("apache module enabled " ++ modname)
 			`requires` installed
 			`onChange` reloaded
-	disable = check isenabled $ 
-		cmdProperty "a2dismod" ["--quiet", modname]
-			`assume` MadeChange
+	disable = check isenabled
+		(cmdProperty "a2dismod" ["--quiet", modname])
 			`describe` ("apache module disabled " ++ modname)
 			`requires` installed
 			`onChange` reloaded
diff --git a/src/Propellor/Property/Apt.hs b/src/Propellor/Property/Apt.hs
index 26c151d9..a177c42f 100644
--- a/src/Propellor/Property/Apt.hs
+++ b/src/Propellor/Property/Apt.hs
@@ -137,7 +137,6 @@ installed' params ps = robustly $ check (isInstallable ps) go
 	`describe` (unwords $ "apt installed":ps)
   where
 	go = runApt (params ++ ["install"] ++ ps)
-		`assume` MadeChange
 
 installedBackport :: [Package] -> Property NoInfo
 installedBackport ps = withOS desc $ \o -> case o of
@@ -157,10 +156,8 @@ installedMin :: [Package] -> Property NoInfo
 installedMin = installed' ["--no-install-recommends", "-y"]
 
 removed :: [Package] -> Property NoInfo
-removed ps = check (or <$> isInstalled' ps) go
+removed ps = check (or <$> isInstalled' ps) (runApt (["-y", "remove"] ++ ps))
 	`describe` (unwords $ "apt removed":ps)
-  where
-	go = runApt (["-y", "remove"] ++ ps) `assume` MadeChange
 
 buildDep :: [Package] -> Property NoInfo
 buildDep ps = robustly $ go
@@ -304,7 +301,7 @@ aptKeyFile k = "/etc/apt/trusted.gpg.d" </> keyname k ++ ".gpg"
 -- space.
 cacheCleaned :: Property NoInfo
 cacheCleaned = cmdProperty "apt-get" ["clean"]
-	`assume` MadeChange
+	`assume` NoChange
 	`describe` "apt cache cleaned"
 
 -- | Add a foreign architecture to dpkg and apt.
diff --git a/src/Propellor/Property/Cmd.hs b/src/Propellor/Property/Cmd.hs
index b02376a3..83414dcb 100644
--- a/src/Propellor/Property/Cmd.hs
+++ b/src/Propellor/Property/Cmd.hs
@@ -1,7 +1,32 @@
 {-# LANGUAGE PackageImports #-}
 
+-- | This module lets you construct Properties by running commands and
+-- scripts. To get from an `UncheckedProperty` to a `Property`, it's
+-- up to the user to check if the command made a change to the system. 
+--
+-- The best approach is to `check` a property, so that the command is only
+-- run when it needs to be. With this method, you avoid running the
+-- `cmdProperty` unnecessarily.
+--
+-- > check (not <$> userExists "bob")
+-- > 	(cmdProperty "useradd" ["bob"])
+--
+-- Sometimes it's just as expensive to check a property as it would be to
+-- run the command that ensures the property. So you can let the command
+-- run every time, and use `changesFile` or `checkResult` to determine if
+-- anything changed:
+--
+-- > cmdProperty "chmod" ["600", "/etc/secret"]
+-- > 	`changesFile` "/etc/secret"
+--
+-- Or you can punt and `assume` a change was made, but then propellor will
+-- always say it make a change, and `onChange` will always fire.
+--
+-- > cmdProperty "service" ["foo", "reload"]
+-- > 	`assume` MadeChange
+
 module Propellor.Property.Cmd (
-	-- * Properties for running commands and scripts
+	-- * Constricting properties running commands and scripts
 	cmdProperty,
 	cmdProperty',
 	cmdPropertyEnv,
@@ -32,11 +57,6 @@ import Utility.Process (createProcess, CreateProcess, waitForProcess)
 -- | A property that can be satisfied by running a command.
 --
 -- The command must exit 0 on success.
---
--- This and other properties in this module are `UncheckedProperty`,
--- and return `NoChange`. It's up to the user to check if the command
--- made a change to the system, perhaps by using `checkResult` or
--- `changesFile`, or you can use @cmdProperty "foo" ["bar"] `assume` MadeChange@
 cmdProperty :: String -> [String] -> UncheckedProperty NoInfo
 cmdProperty cmd params = cmdProperty' cmd params id
 
diff --git a/src/Propellor/Property/DebianMirror.hs b/src/Propellor/Property/DebianMirror.hs
index 14024a4e..eea7b96f 100644
--- a/src/Propellor/Property/DebianMirror.hs
+++ b/src/Propellor/Property/DebianMirror.hs
@@ -126,9 +126,8 @@ mirror mirror' = propertyList
 	, User.accountFor (User "debmirror")
 	, File.dirExists dir
 	, File.ownerGroup dir (User "debmirror") (Group "debmirror")
-	, check (not . and <$> mapM suitemirrored suites) $ 
-		cmdProperty "debmirror" args
-			`assume` MadeChange
+	, check (not . and <$> mapM suitemirrored suites)
+		(cmdProperty "debmirror" args)
 			`describe` "debmirror setup"
 	, Cron.niceJob ("debmirror_" ++ dir) (_debianMirrorCronTimes mirror') (User "debmirror") "/" $
 		unwords ("/usr/bin/debmirror" : args)
diff --git a/src/Propellor/Property/DiskImage.hs b/src/Propellor/Property/DiskImage.hs
index 79237e61..6200f856 100644
--- a/src/Propellor/Property/DiskImage.hs
+++ b/src/Propellor/Property/DiskImage.hs
@@ -289,12 +289,10 @@ grubBooted bios = (Grub.installed' bios, boots)
 		, inchroot "update-initramfs" ["-u"]
 			`assume` MadeChange
 		-- work around for http://bugs.debian.org/802717
-		 , check haveosprober $ inchroot "chmod" ["-x", osprober]
-			`assume` MadeChange
+		, check haveosprober $ inchroot "chmod" ["-x", osprober]
 		, inchroot "update-grub" []
 			`assume` MadeChange
 		, check haveosprober $ inchroot "chmod" ["+x", osprober]
-			`assume` MadeChange
 		, inchroot "grub-install" [wholediskloopdev]
 			`assume` MadeChange
 		-- sync all buffered changes out to the disk image
diff --git a/src/Propellor/Property/Group.hs b/src/Propellor/Property/Group.hs
index 8499d636..f91ef1c2 100644
--- a/src/Propellor/Property/Group.hs
+++ b/src/Propellor/Property/Group.hs
@@ -5,10 +5,8 @@ import Propellor.Base
 type GID = Int
 
 exists :: Group -> Maybe GID -> Property NoInfo
-exists (Group group') mgid = check test $
-	cmdProperty "addgroup" (args mgid)
-		`assume` MadeChange
-		`describe` unwords ["group", group']
+exists (Group group') mgid = check test (cmdProperty "addgroup" (args mgid))
+	`describe` unwords ["group", group']
   where
 	groupFile = "/etc/group"
 	test = not . elem group' . words <$> readProcess "cut" ["-d:", "-f1", groupFile]
diff --git a/src/Propellor/Property/Grub.hs b/src/Propellor/Property/Grub.hs
index 024a2827..1b7f2a0a 100644
--- a/src/Propellor/Property/Grub.hs
+++ b/src/Propellor/Property/Grub.hs
@@ -20,11 +20,10 @@ data BIOS = PC | EFI64 | EFI32 | Coreboot | Xen
 --
 -- This includes running update-grub.
 installed :: BIOS -> Property NoInfo
-installed bios = installed' bios `before` mkConfig
+installed bios = installed' bios `onChange` mkConfig
 
 -- Run update-grub, to generate the grub boot menu. It will be
--- automatically updated when kernel packages are
---   -- installed.
+-- automatically updated when kernel packages are installed.
 mkConfig :: Property NoInfo
 mkConfig = cmdProperty "update-grub" []
 	`assume` MadeChange
diff --git a/src/Propellor/Property/Hostname.hs b/src/Propellor/Property/Hostname.hs
index fcb88f59..7ab350ae 100644
--- a/src/Propellor/Property/Hostname.hs
+++ b/src/Propellor/Property/Hostname.hs
@@ -35,31 +35,33 @@ setTo :: HostName -> Property NoInfo
 setTo = setTo' extractDomain
 
 setTo' :: ExtractDomain -> HostName -> Property NoInfo
-setTo' extractdomain hn = combineProperties desc go
+setTo' extractdomain hn = combineProperties desc
+	[ "/etc/hostname" `File.hasContent` [basehost]
+	, hostslines $ catMaybes
+		[ if null domain
+			then Nothing 
+			else Just ("127.0.1.1", [hn, basehost])
+		, Just ("127.0.0.1", ["localhost"])
+		]
+	, check (not <$> inChroot) $
+		cmdProperty "hostname" [basehost]
+			`assume` NoChange
+	, "/etc/mailname" `File.hasContent`
+		[if null domain then hn else domain]
+	]
   where
 	desc = "hostname " ++ hn
 	basehost = takeWhile (/= '.') hn
 	domain = extractdomain hn
-
-	go = catMaybes
-		[ Just $ "/etc/hostname" `File.hasContent` [basehost]
-		, if null domain
-			then Nothing 
-			else Just $ hostsline "127.0.1.1" [hn, basehost]
-		, Just $ hostsline "127.0.0.1" ["localhost"]
-		, Just $ check (not <$> inChroot) $
-			cmdProperty "hostname" [basehost]
-				`assume` NoChange
-		, Just $ "/etc/mailname" `File.hasContent`
-			[if null domain then hn else domain]
-		]
 	
-	hostsline ip names = File.fileProperty desc
-		(addhostsline ip names)
-		"/etc/hosts"
-	addhostsline ip names ls =
-		(ip ++ "\t" ++ (unwords names)) : filter (not . hasip ip) ls
-	hasip ip l = headMaybe (words l) == Just ip
+	hostslines ipsnames = 
+		File.fileProperty desc (addhostslines ipsnames) "/etc/hosts"
+	addhostslines :: [(String, [String])] -> [String] -> [String]
+	addhostslines ipsnames ls =
+		let ips = map fst ipsnames
+		    hasip l = maybe False (`elem` ips) (headMaybe (words l))
+		    mkline (ip, names) = ip ++ "\t" ++ (unwords names)
+		in map mkline ipsnames ++ filter (not . hasip) ls
 
 -- | Makes </etc/resolv.conf> contain search and domain lines for 
 -- the domain that the hostname is in.
diff --git a/src/Propellor/Property/Journald.hs b/src/Propellor/Property/Journald.hs
index 6c8bda80..2fbb780e 100644
--- a/src/Propellor/Property/Journald.hs
+++ b/src/Propellor/Property/Journald.hs
@@ -17,7 +17,8 @@ type DataSize = String
 configuredSize :: Systemd.Option -> DataSize -> Property NoInfo
 configuredSize option s = case readSize dataUnits s of
 	Just sz -> configured option (systemdSizeUnits sz)
-	Nothing -> property ("unable to parse " ++ option ++ " data size " ++ s) noChange
+	Nothing -> property ("unable to parse " ++ option ++ " data size " ++ s) $
+		return FailedChange
 
 systemMaxUse :: DataSize -> Property NoInfo
 systemMaxUse = configuredSize "SystemMaxUse"
diff --git a/src/Propellor/Property/Locale.hs b/src/Propellor/Property/Locale.hs
index 0342a2f2..a9fb3514 100644
--- a/src/Propellor/Property/Locale.hs
+++ b/src/Propellor/Property/Locale.hs
@@ -24,14 +24,19 @@ type LocaleVariable = String
 selectedFor :: Locale -> [LocaleVariable] -> RevertableProperty NoInfo
 locale `selectedFor` vars = select <!> deselect
   where
-	select = cmdProperty "update-locale" selectArgs
-		`assume` NoChange
+	select = check (not <$> isselected) (cmdProperty "update-locale" selectArgs)
 		`requires` available locale
 		`describe` (locale ++ " locale selected")
-	deselect = cmdProperty "update-locale" vars
-		`assume` NoChange
+	deselect = check isselected (cmdProperty "update-locale" vars)
 		`describe` (locale ++ " locale deselected")
 	selectArgs = zipWith (++) vars (repeat ('=':locale))
+	isselected = locale `isSelectedFor` vars
+
+isSelectedFor :: Locale -> [LocaleVariable] -> IO Bool
+locale `isSelectedFor` vars = do
+	ls <- catchDefaultIO [] $ lines <$> readFile "/etc/default/locale"
+	return $ and $ map (\v -> v ++ "=" ++ locale `elem` ls) vars
+	
 
 -- | Ensures a locale is generated (or, if reverted, ensure it's not).
 --
diff --git a/src/Propellor/Property/Postfix.hs b/src/Propellor/Property/Postfix.hs
index bc46ac21..1c8684c7 100644
--- a/src/Propellor/Property/Postfix.hs
+++ b/src/Propellor/Property/Postfix.hs
@@ -60,8 +60,8 @@ mappedFile f setup = setup f
 -- | Run newaliases command, which should be done after changing
 -- @/etc/aliases@.
 newaliases :: Property NoInfo
-newaliases = cmdProperty "newaliases" []
-	`assume` MadeChange
+newaliases = check ("/etc/aliases" `isNewerThan` "/etc/aliases.db")
+	(cmdProperty "newaliases" [])
 
 -- | The main config file for postfix.
 mainCfFile :: FilePath
@@ -75,7 +75,6 @@ mainCf (name, value) = check notset set
 	setting = name ++ "=" ++ value
 	notset = (/= Just value) <$> getMainCf name
 	set = cmdProperty "postconf" ["-e", setting]
-		`assume` MadeChange
 
 -- | Gets a main.cf setting.
 getMainCf :: String -> IO (Maybe String)
@@ -161,7 +160,6 @@ saslAuthdInstalled = setupdaemon
 	dirperm = check (not <$> doesDirectoryExist dir) $ 
 		cmdProperty "dpkg-statoverride"
 			[ "--add", "root", "sasl", "710", dir ]
-			`assume` MadeChange
 	postfixgroup = (User "postfix") `User.hasGroup` (Group "sasl")
 		`onChange` restarted
 	dir = "/var/spool/postfix/var/run/saslauthd"
@@ -170,15 +168,17 @@ saslAuthdInstalled = setupdaemon
 --
 -- The password is taken from the privdata.
 saslPasswdSet :: Domain -> User -> Property HasInfo
-saslPasswdSet domain (User user) = withPrivData src ctx $ \getpw -> trivial $
-	property ("sasl password for " ++ uatd) $ getpw $ \pw -> makeChange $
-		withHandle StdinHandle createProcessSuccess p $ \h -> do
-			hPutStrLn h (privDataVal pw)
-			hClose h
+saslPasswdSet domain (User user) = go `changesFileContent` "/etc/sasldb2"
   where
+	go = withPrivData src ctx $ \getpw ->
+		property desc $ getpw $ \pw -> liftIO $
+			withHandle StdinHandle createProcessSuccess p $ \h -> do
+				hPutStrLn h (privDataVal pw)
+				hClose h
+				return NoChange
+	desc = "sasl password for " ++ uatd
 	uatd = user ++ "@" ++ domain
 	ps = ["-p", "-c", "-u", domain, user]
 	p = proc "saslpasswd2" ps
 	ctx = Context "sasl"
 	src = PrivDataSource (Password uatd) "enter password"
-	trivial = flip assume NoChange
diff --git a/src/Propellor/Property/SiteSpecific/GitAnnexBuilder.hs b/src/Propellor/Property/SiteSpecific/GitAnnexBuilder.hs
index a34071ce..2312846c 100644
--- a/src/Propellor/Property/SiteSpecific/GitAnnexBuilder.hs
+++ b/src/Propellor/Property/SiteSpecific/GitAnnexBuilder.hs
@@ -65,7 +65,6 @@ tree buildarch flavor = combineProperties "gitannexbuilder tree" $ props
 	builddircloned = check (not <$> doesDirectoryExist builddir) $ userScriptProperty (User builduser)
 		[ "git clone git://git-annex.branchable.com/ " ++ builddir
 		]
-		`assume` MadeChange
 
 buildDepsApt :: Property HasInfo
 buildDepsApt = combineProperties "gitannexbuilder build deps" $ props
diff --git a/src/Propellor/Property/Systemd.hs b/src/Propellor/Property/Systemd.hs
index 04ce3b48..5a08fb1e 100644
--- a/src/Propellor/Property/Systemd.hs
+++ b/src/Propellor/Property/Systemd.hs
@@ -158,7 +158,7 @@ configured cfgfile option value = combineProperties desc
 	line = setting ++ value
 	desc = cfgfile ++ " " ++ line
 	removeother l
-		| setting `isPrefixOf` l = Nothing
+		| setting `isPrefixOf` l && l /= line = Nothing
 		| otherwise = Just l
 
 -- | Causes systemd to reload its configuration files.
diff --git a/src/Propellor/Property/User.hs b/src/Propellor/Property/User.hs
index 84d20e62..ea88a1b3 100644
--- a/src/Propellor/Property/User.hs
+++ b/src/Propellor/Property/User.hs
@@ -8,28 +8,26 @@ import qualified Propellor.Property.File as File
 data Eep = YesReallyDeleteHome
 
 accountFor :: User -> Property NoInfo
-accountFor user@(User u) = check nohomedir $
-	cmdProperty "adduser"
+accountFor user@(User u) = check nohomedir go
+	`describe` ("account for " ++ u)
+  where
+	nohomedir = isNothing <$> catchMaybeIO (homedir user)
+	go = cmdProperty "adduser"
 		[ "--disabled-password"
 		, "--gecos", ""
 		, u
 		]
-		`assume` MadeChange
-		`describe` ("account for " ++ u)
-  where
-	nohomedir = isNothing <$> catchMaybeIO (homedir user)
 
 -- | Removes user home directory!! Use with caution.
 nuked :: User -> Eep -> Property NoInfo
-nuked user@(User u) _ = check hashomedir $
-	cmdProperty "userdel"
+nuked user@(User u) _ = check hashomedir go
+	`describe` ("nuked user " ++ u)
+  where
+	hashomedir = isJust <$> catchMaybeIO (homedir user)
+	go = cmdProperty "userdel"
 		[ "-r"
 		, u
 		]
-		`assume` MadeChange
-		`describe` ("nuked user " ++ u)
-  where
-	hashomedir = isJust <$> catchMaybeIO (homedir user)
 
 -- | Only ensures that the user has some password set. It may or may
 -- not be a password from the PrivData.
@@ -83,13 +81,13 @@ chpasswd (User user) v ps = makeChange $ withHandle StdinHandle createProcessSuc
 		hClose h
 
 lockedPassword :: User -> Property NoInfo
-lockedPassword user@(User u) = check (not <$> isLockedPassword user) $ 
-	cmdProperty "passwd"
+lockedPassword user@(User u) = check (not <$> isLockedPassword user) go
+	`describe` ("locked " ++ u ++ " password")
+  where
+	go = cmdProperty "passwd"
 		[ "--lock"
 		, u
 		]
-		`assume` MadeChange
-		`describe` ("locked " ++ u ++ " password")
 
 data PasswordStatus = NoPassword | LockedPassword | HasPassword
 	deriving (Eq)
@@ -109,15 +107,14 @@ homedir :: User -> IO FilePath
 homedir (User user) = homeDirectory <$> getUserEntryForName user
 
 hasGroup :: User -> Group -> Property NoInfo
-hasGroup (User user) (Group group') = check test $
-	cmdProperty "adduser"
+hasGroup (User user) (Group group') = check test go
+	`describe` unwords ["user", user, "in group", group']
+  where
+	test = not . elem group' . words <$> readProcess "groups" [user]
+	go = cmdProperty "adduser"
 		[ user
 		, group'
 		]
-		`assume` MadeChange
-		`describe` unwords ["user", user, "in group", group']
-  where
-	test = not . elem group' . words <$> readProcess "groups" [user]
 
 -- | Gives a user access to the secondary groups, including audio and
 -- video, that the OS installer normally gives a desktop user access to.
@@ -150,13 +147,11 @@ hasDesktopGroups user@(User u) = property desc $ do
 
 -- | Controls whether shadow passwords are enabled or not.
 shadowConfig :: Bool -> Property NoInfo
-shadowConfig True = check (not <$> shadowExists) $
-	cmdProperty "shadowconfig" ["on"]
-		`assume` MadeChange
+shadowConfig True = check (not <$> shadowExists)
+	(cmdProperty "shadowconfig" ["on"])
 		`describe` "shadow passwords enabled"
-shadowConfig False = check shadowExists $
-	cmdProperty "shadowconfig" ["off"]
-		`assume` MadeChange
+shadowConfig False = check shadowExists
+	(cmdProperty "shadowconfig" ["off"])
 		`describe` "shadow passwords disabled"
 
 shadowExists :: IO Bool
@@ -168,9 +163,8 @@ hasLoginShell :: User -> FilePath -> Property NoInfo
 hasLoginShell user loginshell = shellSetTo user loginshell `requires` shellEnabled loginshell
 
 shellSetTo :: User -> FilePath -> Property NoInfo
-shellSetTo (User u) loginshell = check needchangeshell $
-	cmdProperty "chsh" ["--shell", loginshell, u]
-		`assume` MadeChange
+shellSetTo (User u) loginshell = check needchangeshell
+	(cmdProperty "chsh" ["--shell", loginshell, u])
 		`describe` (u ++ " has login shell " ++ loginshell)
   where
 	needchangeshell = do
diff --git a/src/Propellor/Types/ResultCheck.hs b/src/Propellor/Types/ResultCheck.hs
index 09fbf73b..4c6524ee 100644
--- a/src/Propellor/Types/ResultCheck.hs
+++ b/src/Propellor/Types/ResultCheck.hs
@@ -4,15 +4,16 @@ module Propellor.Types.ResultCheck (
 	UncheckedProperty,
 	unchecked,
 	checkResult,
+	check,
 	Checkable,
 	assume,
 ) where
 
 import Propellor.Types
 import Propellor.Exception
+import Utility.Monad
 
 import Data.Monoid
-import Control.Monad.IO.Class (liftIO)
 
 -- | This is a `Property` but its `Result` is not accurate; in particular
 -- it may return `NoChange` despite having made a change. 
@@ -29,30 +30,44 @@ unchecked = UncheckedProperty
 -- `UncheckedProperty` to a `Property`, but can also be used to further
 -- check a `Property`.
 checkResult 
-	:: Checkable p i
-	=> IO a
+	:: (Checkable p i, LiftPropellor m)
+	=> m a
 	-- ^ Run before ensuring the property.
-	-> (a -> IO Result)
+	-> (a -> m Result)
 	-- ^ Run after ensuring the property. Return `MadeChange` if a
 	-- change was detected, or `NoChange` if no change was detected.
 	-> p i
 	-> Property i
 checkResult precheck postcheck p = adjustPropertySatisfy (checkedProp p) $ \satisfy -> do
-	a <- liftIO precheck
+	a <- liftPropellor precheck
 	r <- catchPropellor satisfy
 	-- Always run postcheck, even if the result is already MadeChange,
 	-- as it may need to clean up after precheck.
-	r' <- liftIO $ postcheck a
+	r' <- liftPropellor $ postcheck a
 	return (r <> r')
-	
+
+-- | Makes a `Property` or an `UncheckedProperty` only run
+-- when a test succeeds.
+check :: (Checkable p i, LiftPropellor m) => m Bool -> p i -> Property i
+check test p = adjustPropertySatisfy (preCheckedProp p) $ \satisfy ->
+        ifM (liftPropellor test)
+                ( satisfy
+                , return NoChange
+                )
+
 class Checkable p i where
 	checkedProp :: p i -> Property i
+	preCheckedProp :: p i -> Property i
 
 instance Checkable Property i where
 	checkedProp = id
+	preCheckedProp = id
 
 instance Checkable UncheckedProperty i where
 	checkedProp (UncheckedProperty p) = p
+	-- Since it was pre-checked that the property needed to be run,
+	-- if the property succeeded, we can assume it made a change.
+	preCheckedProp (UncheckedProperty p) = p `assume` MadeChange
 
 -- | Sometimes it's not practical to test if a property made a change.
 -- In such a case, it's often fine to say: