Merge branch 'joeyconfig'

1 files changed, 60 insertions, 64 deletions

diff --git a/src/Propellor/Property/Apt.hs b/src/Propellor/Property/Apt.hs
index b9182baf..5771750d 100644
--- a/src/Propellor/Property/Apt.hs
+++ b/src/Propellor/Property/Apt.hs
@@ -75,42 +75,41 @@ securityUpdates suite
 		in [l, srcLine l]
 	| otherwise = []
 
--- | Makes sources.list have a standard content using the mirror CDN,
+-- | Makes sources.list have a standard content using the Debian mirror CDN,
 -- with the Debian suite configured by the os.
 --
 -- Since the CDN is sometimes unreliable, also adds backup lines using
 -- kernel.org.
-stdSourcesList :: Property NoInfo
-stdSourcesList = withOS "standard sources.list" $ \o ->
-	case o of
-		(Just (System (Debian suite) _)) ->
-			ensureProperty $ stdSourcesListFor suite
-		_ -> error "os is not declared to be Debian"
+stdSourcesList :: Property Debian
+stdSourcesList = withOS "standard sources.list" $ \w o -> case o of
+	(Just (System (Debian suite) _)) ->
+		ensureProperty w $ stdSourcesListFor suite
+	_ -> unsupportedOS'
 
-stdSourcesListFor :: DebianSuite -> Property NoInfo
+stdSourcesListFor :: DebianSuite -> Property Debian
 stdSourcesListFor suite = stdSourcesList' suite []
 
 -- | Adds additional sources.list generators.
 --
 -- Note that if a Property needs to enable an apt source, it's better
 -- to do so via a separate file in </etc/apt/sources.list.d/>
-stdSourcesList' :: DebianSuite -> [SourcesGenerator] -> Property NoInfo
-stdSourcesList' suite more = setSourcesList
+stdSourcesList' :: DebianSuite -> [SourcesGenerator] -> Property Debian
+stdSourcesList' suite more = tightenTargets $ setSourcesList
 	(concatMap (\gen -> gen suite) generators)
 	`describe` ("standard sources.list for " ++ show suite)
   where
 	generators = [debCdn, kernelOrg, securityUpdates] ++ more
 
-setSourcesList :: [Line] -> Property NoInfo
+setSourcesList :: [Line] -> Property DebianLike
 setSourcesList ls = sourcesList `File.hasContent` ls `onChange` update
 
-setSourcesListD :: [Line] -> FilePath -> Property NoInfo
+setSourcesListD :: [Line] -> FilePath -> Property DebianLike
 setSourcesListD ls basename = f `File.hasContent` ls `onChange` update
   where
 	f = "/etc/apt/sources.list.d/" ++ basename ++ ".list"
 
-runApt :: [String] -> UncheckedProperty NoInfo
-runApt ps = cmdPropertyEnv "apt-get" ps noninteractiveEnv
+runApt :: [String] -> UncheckedProperty DebianLike
+runApt ps = tightenTargets $ cmdPropertyEnv "apt-get" ps noninteractiveEnv
 
 noninteractiveEnv :: [(String, String)]
 noninteractiveEnv =
@@ -118,68 +117,67 @@ noninteractiveEnv =
 		, ("APT_LISTCHANGES_FRONTEND", "none")
 		]
 
-update :: Property NoInfo
-update = combineProperties ("apt update")
-	[ pendingConfigured
-	, runApt ["update"]
+update :: Property DebianLike
+update = combineProperties ("apt update") $ props
+	& pendingConfigured
+	& runApt ["update"]
 		`assume` MadeChange
-	]
 
 -- | Have apt upgrade packages, adding new packages and removing old as
 -- necessary.
-upgrade :: Property NoInfo
+upgrade :: Property DebianLike
 upgrade = upgrade' "dist-upgrade"
 
-upgrade' :: String -> Property NoInfo
-upgrade' p = combineProperties ("apt " ++ p)
-	[ pendingConfigured
-	, runApt ["-y", p]
+upgrade' :: String -> Property DebianLike
+upgrade' p = combineProperties ("apt " ++ p) $ props
+	& pendingConfigured
+	& runApt ["-y", p]
 		`assume` MadeChange
-	]
 
 -- | Have apt upgrade packages, but never add new packages or remove
 -- old packages. Not suitable for upgrading acrocess major versions
 -- of the distribution.
-safeUpgrade :: Property NoInfo
+safeUpgrade :: Property DebianLike
 safeUpgrade = upgrade' "upgrade"
 
 -- | Have dpkg try to configure any packages that are not fully configured.
-pendingConfigured :: Property NoInfo
-pendingConfigured = cmdPropertyEnv "dpkg" ["--configure", "--pending"] noninteractiveEnv
-	`assume` MadeChange
-	`describe` "dpkg configured pending"
+pendingConfigured :: Property DebianLike
+pendingConfigured = tightenTargets $
+	cmdPropertyEnv "dpkg" ["--configure", "--pending"] noninteractiveEnv
+		`assume` MadeChange
+		`describe` "dpkg configured pending"
 
 type Package = String
 
-installed :: [Package] -> Property NoInfo
+installed :: [Package] -> Property DebianLike
 installed = installed' ["-y"]
 
-installed' :: [String] -> [Package] -> Property NoInfo
+installed' :: [String] -> [Package] -> Property DebianLike
 installed' params ps = robustly $ check (isInstallable ps) go
 	`describe` unwords ("apt installed":ps)
   where
 	go = runApt (params ++ ["install"] ++ ps)
 
-installedBackport :: [Package] -> Property NoInfo
-installedBackport ps = withOS desc $ \o -> case o of
+installedBackport :: [Package] -> Property Debian
+installedBackport ps = withOS desc $ \w o -> case o of
 	(Just (System (Debian suite) _)) -> case backportSuite suite of
-		Nothing -> unsupportedOS
-		Just bs -> ensureProperty $
+		Nothing -> unsupportedOS'
+		Just bs -> ensureProperty w $
 			runApt (["install", "-t", bs, "-y"] ++ ps)
 				`changesFile` dpkgStatus
-	_ -> unsupportedOS
+	_ -> unsupportedOS'
   where
 	desc = unwords ("apt installed backport":ps)
 
 -- | Minimal install of package, without recommends.
-installedMin :: [Package] -> Property NoInfo
+installedMin :: [Package] -> Property DebianLike
 installedMin = installed' ["--no-install-recommends", "-y"]
 
-removed :: [Package] -> Property NoInfo
+removed :: [Package] -> Property DebianLike
 removed ps = check (or <$> isInstalled' ps) (runApt (["-y", "remove"] ++ ps))
 	`describe` unwords ("apt removed":ps)
 
-buildDep :: [Package] -> Property NoInfo
+buildDep :: [Package] -> Property DebianLike
 buildDep ps = robustly $ go
 	`changesFile` dpkgStatus
 	`describe` unwords ("apt build-dep":ps)
@@ -189,7 +187,7 @@ buildDep ps = robustly $ go
 -- | Installs the build deps for the source package unpacked
 -- in the specifed directory, with a dummy package also
 -- installed so that autoRemove won't remove them.
-buildDepIn :: FilePath -> Property NoInfo
+buildDepIn :: FilePath -> Property DebianLike
 buildDepIn dir = cmdPropertyEnv "sh" ["-c", cmd] noninteractiveEnv
 	`changesFile` dpkgStatus
 	`requires` installedMin ["devscripts", "equivs"]
@@ -198,14 +196,8 @@ buildDepIn dir = cmdPropertyEnv "sh" ["-c", cmd] noninteractiveEnv
 
 -- | Package installation may fail becuse the archive has changed.
 -- Run an update in that case and retry.
-robustly :: (Combines (Property i) (Property NoInfo)) => Property i -> Property i
-robustly p = adjustPropertySatisfy p $ \satisfy -> do
-	r <- satisfy
-	if r == FailedChange
-		-- Safe to use ignoreInfo because we're re-running
-		-- the same property.
-		then ensureProperty $ ignoreInfo $ p `requires` update
-		else return r
+robustly :: Property DebianLike -> Property DebianLike
+robustly p = p `fallback` (update `before` p)
 
 isInstallable :: [Package] -> IO Bool
 isInstallable ps = do
@@ -230,13 +222,13 @@ isInstalled' ps = (mapMaybe parse . lines) <$> policy
 		environ <- addEntry "LANG" "C" <$> getEnvironment
 		readProcessEnv "apt-cache" ("policy":ps) (Just environ)
 
-autoRemove :: Property NoInfo
+autoRemove :: Property DebianLike
 autoRemove = runApt ["-y", "autoremove"]
 	`changesFile` dpkgStatus
 	`describe` "apt autoremove"
 
 -- | Enables unattended upgrades. Revert to disable.
-unattendedUpgrades :: RevertableProperty NoInfo
+unattendedUpgrades :: RevertableProperty DebianLike DebianLike
 unattendedUpgrades = enable <!> disable
   where
 	enable = setup True
@@ -255,11 +247,12 @@ unattendedUpgrades = enable <!> disable
 			| enabled = "true"
 			| otherwise = "false"
 
-	configure = withOS "unattended upgrades configured" $ \o ->
+	configure :: Property DebianLike
+	configure = withOS "unattended upgrades configured" $ \w o ->
 		case o of
 			-- the package defaults to only upgrading stable
 			(Just (System (Debian suite) _))
-				| not (isStable suite) -> ensureProperty $
+				| not (isStable suite) -> ensureProperty w $
 					"/etc/apt/apt.conf.d/50unattended-upgrades"
 						`File.containsLine`
 					("Unattended-Upgrade::Origins-Pattern { \"o=Debian,a="++showSuite suite++"\"; };")
@@ -271,10 +264,13 @@ type DebconfTemplateValue = String
 
 -- | Preseeds debconf values and reconfigures the package so it takes
 -- effect.
-reConfigure :: Package -> [(DebconfTemplate, DebconfTemplateType, DebconfTemplateValue)] -> Property NoInfo
-reConfigure package vals = reconfigure `requires` setselections
-	`describe` ("reconfigure " ++ package)
+reConfigure :: Package -> [(DebconfTemplate, DebconfTemplateType, DebconfTemplateValue)] -> Property DebianLike
+reConfigure package vals = tightenTargets $ 
+	reconfigure 
+		`requires` setselections
+		`describe` ("reconfigure " ++ package)
   where
+	setselections :: Property DebianLike
 	setselections = property "preseed" $
 		if null vals
 			then noChange
@@ -291,7 +287,7 @@ reConfigure package vals = reconfigure `requires` setselections
 --
 -- Assumes that there is a 1:1 mapping between service names and apt
 -- package names.
-serviceInstalledRunning :: Package -> Property NoInfo
+serviceInstalledRunning :: Package -> Property DebianLike
 serviceInstalledRunning svc = Service.running svc `requires` installed [svc]
 
 data AptKey = AptKey
@@ -299,10 +295,10 @@ data AptKey = AptKey
 	, pubkey :: String
 	}
 
-trustsKey :: AptKey -> RevertableProperty NoInfo
+trustsKey :: AptKey -> RevertableProperty DebianLike DebianLike
 trustsKey k = trustsKey' k <!> untrustKey k
 
-trustsKey' :: AptKey -> Property NoInfo
+trustsKey' :: AptKey -> Property DebianLike
 trustsKey' k = check (not <$> doesFileExist f) $ property desc $ makeChange $ do
 	withHandle StdinHandle createProcessSuccess
 		(proc "gpg" ["--no-default-keyring", "--keyring", f, "--import", "-"]) $ \h -> do
@@ -313,21 +309,21 @@ trustsKey' k = check (not <$> doesFileExist f) $ property desc $ makeChange $ do
 	desc = "apt trusts key " ++ keyname k
 	f = aptKeyFile k
 
-untrustKey :: AptKey -> Property NoInfo
-untrustKey = File.notPresent . aptKeyFile
+untrustKey :: AptKey -> Property DebianLike
+untrustKey = tightenTargets . File.notPresent . aptKeyFile
 
 aptKeyFile :: AptKey -> FilePath
 aptKeyFile k = "/etc/apt/trusted.gpg.d" </> keyname k ++ ".gpg"
 
 -- | Cleans apt's cache of downloaded packages to avoid using up disk
 -- space.
-cacheCleaned :: Property NoInfo
-cacheCleaned = cmdProperty "apt-get" ["clean"]
+cacheCleaned :: Property DebianLike
+cacheCleaned = tightenTargets $ cmdProperty "apt-get" ["clean"]
 	`assume` NoChange
 	`describe` "apt cache cleaned"
 
 -- | Add a foreign architecture to dpkg and apt.
-hasForeignArch :: String -> Property NoInfo
+hasForeignArch :: String -> Property DebianLike
 hasForeignArch arch = check notAdded (add `before` update)
 	`describe` ("dpkg has foreign architecture " ++ arch)
   where