more porting

3 files changed, 33 insertions, 22 deletions

diff --git a/src/Propellor/Property/OS.hs b/src/Propellor/Property/OS.hs
index e5da0921..42504453 100644
--- a/src/Propellor/Property/OS.hs
+++ b/src/Propellor/Property/OS.hs
@@ -64,7 +64,7 @@ import Control.Exception (throw)
 -- > & User.accountFor "joey"
 -- > & User.hasSomePassword "joey"
 -- > -- rest of system properties here
-cleanInstallOnce :: Confirmation -> Property NoInfo
+cleanInstallOnce :: Confirmation -> Property Linux
 cleanInstallOnce confirmation = check (not <$> doesFileExist flagfile) $
 	go `requires` confirmed "clean install confirmed" confirmation
   where
@@ -83,12 +83,16 @@ cleanInstallOnce confirmation = check (not <$> doesFileExist flagfile) $
 			`requires`
 		osbootstrapped
 
-	osbootstrapped = withOS (newOSDir ++ " bootstrapped") $ \o -> case o of
-		(Just d@(System (Debian _) _)) -> debootstrap d
-		(Just u@(System (Buntish _) _)) -> debootstrap u
+	osbootstrapped :: Property Linux
+	osbootstrapped = withOS (newOSDir ++ " bootstrapped") $ \w o -> case o of
+		(Just d@(System (Debian _) _)) -> ensureProperty w $
+			debootstrap d
+		(Just u@(System (Buntish _) _)) -> ensureProperty w $
+			debootstrap u
 		_ -> unsupportedOS
 	
-	debootstrap targetos = ensureProperty $
+	debootstrap :: System -> Property Linux
+	debootstrap targetos =
 		-- Ignore the os setting, and install debootstrap from
 		-- source, since we don't know what OS we're running in yet.
 		Debootstrap.built' Debootstrap.sourceInstall
@@ -100,6 +104,7 @@ cleanInstallOnce confirmation = check (not <$> doesFileExist flagfile) $
 		-- sync instead?
 
 	-- This is the fun bit.
+	flipped :: Property Linux
 	flipped = property (newOSDir ++ " moved into place") $ liftIO $ do
 		-- First, unmount most mount points, lazily, so
 		-- they don't interfere with moving things around.
@@ -137,6 +142,7 @@ cleanInstallOnce confirmation = check (not <$> doesFileExist flagfile) $
 
 		return MadeChange
 
+	propellorbootstrapped :: Property UnixLike
 	propellorbootstrapped = property "propellor re-debootstrapped in new os" $
 		return NoChange
 		-- re-bootstrap propellor in /usr/local/propellor,
@@ -145,6 +151,7 @@ cleanInstallOnce confirmation = check (not <$> doesFileExist flagfile) $
 		--   be present in /old-os's /usr/local/propellor)
 		-- TODO
 	
+	finalized :: Property UnixLike
 	finalized = property "clean OS installed" $ do
 		liftIO $ writeFile flagfile ""
 		return MadeChange
@@ -179,7 +186,7 @@ massRename = go []
 
 data Confirmation = Confirmed HostName
 
-confirmed :: Desc -> Confirmation -> Property NoInfo
+confirmed :: Desc -> Confirmation -> Property UnixLike
 confirmed desc (Confirmed c) = property desc $ do
 	hostname <- asks hostName
 	if hostname /= c
@@ -191,25 +198,26 @@ confirmed desc (Confirmed c) = property desc $ do
 -- | </etc/network/interfaces> is configured to bring up the network 
 -- interface that currently has a default route configured, using
 -- the same (static) IP address.
-preserveNetwork :: Property NoInfo
+preserveNetwork :: Property DebianLike
 preserveNetwork = go `requires` Network.cleanInterfacesFile
   where
-	go = property "preserve network configuration" $ do
+	go :: Property DebianLike
+	go = property' "preserve network configuration" $ \w -> do
 		ls <- liftIO $ lines <$> readProcess "ip"
 			["route", "list", "scope", "global"]
 		case words <$> headMaybe ls of
 			Just ("default":"via":_:"dev":iface:_) ->
-				ensureProperty $ Network.static iface
+				ensureProperty w $ Network.static iface
 			_ -> do
 				warningMessage "did not find any default ipv4 route"
 				return FailedChange 
 
 -- | </etc/resolv.conf> is copied from the old OS
-preserveResolvConf :: Property NoInfo
+preserveResolvConf :: Property Linux
 preserveResolvConf = check (fileExist oldloc) $
-	property (newloc ++ " copied from old OS") $ do
+	property' (newloc ++ " copied from old OS") $ \w -> do
 		ls <- liftIO $ lines <$> readFile oldloc
-		ensureProperty $ newloc `File.hasContent` ls
+		ensureProperty w $ newloc `File.hasContent` ls
   where
 	newloc = "/etc/resolv.conf"
 	oldloc = oldOSDir ++ newloc
@@ -217,20 +225,23 @@ preserveResolvConf = check (fileExist oldloc) $
 -- | </root/.ssh/authorized_keys> has added to it any ssh keys that
 -- were authorized in the old OS. Any other contents of the file are
 -- retained.
-preserveRootSshAuthorized :: Property NoInfo
+preserveRootSshAuthorized :: Property UnixLike
 preserveRootSshAuthorized = check (fileExist oldloc) $
-	property (newloc ++ " copied from old OS") $ do
+	property' desc $ \w -> do
 		ks <- liftIO $ lines <$> readFile oldloc
-		ensureProperties (map (setupRevertableProperty . Ssh.authorizedKey (User "root")) ks)
+		ensureProperty w $ combineProperties desc $
+			toProps $ map (setupRevertableProperty . Ssh.authorizedKey (User "root")) ks
   where
+	desc = newloc ++ " copied from old OS"
 	newloc = "/root/.ssh/authorized_keys"
 	oldloc = oldOSDir ++ newloc
 
 -- Removes the old OS's backup from </old-os>
-oldOSRemoved :: Confirmation -> Property NoInfo
+oldOSRemoved :: Confirmation -> Property UnixLike
 oldOSRemoved confirmation = check (doesDirectoryExist oldOSDir) $
 	go `requires` confirmed "old OS backup removal confirmed" confirmation
   where
+	go :: Property UnixLike
 	go = property "old OS backup removed" $ do
 		liftIO $ removeDirectoryRecursive oldOSDir
 		return MadeChange
diff --git a/src/Propellor/Property/OpenId.hs b/src/Propellor/Property/OpenId.hs
index 0f73bfb6..0abf38a6 100644
--- a/src/Propellor/Property/OpenId.hs
+++ b/src/Propellor/Property/OpenId.hs
@@ -16,7 +16,7 @@ import Data.List
 --
 -- It's probably a good idea to put this property inside a docker or
 -- systemd-nspawn container.
-providerFor :: [User] -> HostName -> Maybe Port -> Property HasInfo
+providerFor :: [User] -> HostName -> Maybe Port -> Property (HasInfo + DebianLike)
 providerFor users hn mp = propertyList desc $ props
 	& Apt.serviceInstalledRunning "apache2"
 	& apacheconfigured
@@ -24,7 +24,7 @@ providerFor users hn mp = propertyList desc $ props
 		`onChange` Apache.restarted
 	& File.fileProperty (desc ++ " configured")
 		(map setbaseurl) "/etc/simpleid/config.inc"
-	& propertyList desc (map identfile users)
+	& propertyList desc (toProps $ map identfile users)
   where
 	baseurl = hn ++ case mp of
 		Nothing -> ""
@@ -37,7 +37,7 @@ providerFor users hn mp = propertyList desc $ props
 		| otherwise = l
 
 	apacheconfigured = case mp of
-		Nothing -> toProp $
+		Nothing -> setupRevertableProperty $
 			Apache.virtualHost hn (Port 80) "/var/www/html"
 		Just p -> propertyList desc $ props
 			& Apache.listenPorts [p]
diff --git a/src/Propellor/Property/Reboot.hs b/src/Propellor/Property/Reboot.hs
index 26b85840..5b854fa3 100644
--- a/src/Propellor/Property/Reboot.hs
+++ b/src/Propellor/Property/Reboot.hs
@@ -2,8 +2,8 @@ module Propellor.Property.Reboot where
 
 import Propellor.Base
 
-now :: Property NoInfo
-now = cmdProperty "reboot" []
+now :: Property Linux
+now = tightenTargets $ cmdProperty "reboot" []
 	`assume` MadeChange
 	`describe` "reboot now"
 
@@ -14,7 +14,7 @@ now = cmdProperty "reboot" []
 --
 -- The reboot can be forced to run, which bypasses the init system. Useful
 -- if the init system might not be running for some reason.
-atEnd :: Bool -> (Result -> Bool) -> Property NoInfo
+atEnd :: Bool -> (Result -> Bool) -> Property Linux
 atEnd force resultok = property "scheduled reboot at end of propellor run" $ do
 	endAction "rebooting" atend
 	return NoChange