From 3218e344d117701066ced6c13927318ea2938ad4 Mon Sep 17 00:00:00 2001
From: Joey Hess <joeyh@joeyh.name>
Date: Sat, 26 Mar 2016 14:28:38 -0400
Subject: more porting

---
 src/Propellor/Property/FreeBSD/Pkg.hs | 17 ++++++++++-------
 1 file changed, 10 insertions(+), 7 deletions(-)

(limited to 'src/Propellor/Property/FreeBSD')

diff --git a/src/Propellor/Property/FreeBSD/Pkg.hs b/src/Propellor/Property/FreeBSD/Pkg.hs
index 6bbd2570..6c775b94 100644
--- a/src/Propellor/Property/FreeBSD/Pkg.hs
+++ b/src/Propellor/Property/FreeBSD/Pkg.hs
@@ -22,8 +22,8 @@ runPkg cmd args =
 	in
 		lines <$> readProcess p a
 
-pkgCmdProperty :: String -> [String] -> UncheckedProperty NoInfo
-pkgCmdProperty cmd args =
+pkgCmdProperty :: String -> [String] -> UncheckedProperty FreeBSD
+pkgCmdProperty cmd args = tightenTargets $ 
 	let
 		(p, a) = pkgCommand cmd args
 	in
@@ -44,13 +44,14 @@ instance IsInfo PkgUpdate where
 pkgUpdated :: PkgUpdate -> Bool
 pkgUpdated (PkgUpdate _) = True
 
-update :: Property HasInfo
+update :: Property (HasInfo + FreeBSD)
 update =
 	let
 		upd = pkgCmd "update" []
 		go = ifM (pkgUpdated <$> askInfo) ((noChange), (liftIO upd >> return MadeChange))
 	in
-		infoProperty "pkg update has run" go (addInfo mempty (PkgUpdate "")) []
+		(property "pkg update has run" go :: Property FreeBSD)
+			`addInfoProperty` (toInfo (PkgUpdate ""))
 
 newtype PkgUpgrade = PkgUpgrade String
 	deriving (Typeable, Monoid, Show)
@@ -60,17 +61,19 @@ instance IsInfo PkgUpgrade where
 pkgUpgraded :: PkgUpgrade -> Bool
 pkgUpgraded (PkgUpgrade _) = True
 
-upgrade :: Property HasInfo
+upgrade :: Property (HasInfo + FreeBSD)
 upgrade =
 	let
 		upd = pkgCmd "upgrade" []
 		go = ifM (pkgUpgraded <$> askInfo) ((noChange), (liftIO upd >> return MadeChange))
 	in
-		infoProperty "pkg upgrade has run" go (addInfo mempty (PkgUpgrade "")) [] `requires` update
+		(property "pkg upgrade has run" go :: Property FreeBSD)
+			`addInfoProperty` (toInfo (PkgUpdate ""))
+			`requires` update
 
 type Package = String
 
-installed :: Package -> Property NoInfo
+installed :: Package -> Property FreeBSD
 installed pkg = check (isInstallable pkg) $ pkgCmdProperty "install" [pkg]
 
 isInstallable :: Package -> IO Bool
-- 
cgit v1.3-2-g0d8e


From c85c462c617fe31c3fe8c97d85db4bcae838a8b2 Mon Sep 17 00:00:00 2001
From: Joey Hess <joeyh@joeyh.name>
Date: Sat, 26 Mar 2016 17:33:43 -0400
Subject: more ported

---
 src/Propellor/Property/FreeBSD/Poudriere.hs        | 21 ++++++-----
 .../Property/HostingProvider/DigitalOcean.hs       | 11 +++---
 src/Propellor/Property/HostingProvider/Linode.hs   |  9 +++--
 src/Propellor/Property/Postfix.hs                  | 35 ++++++++---------
 src/Propellor/Property/PropellorRepo.hs            |  2 +-
 src/Propellor/Property/Prosody.hs                  | 12 +++---
 src/Propellor/Property/SiteSpecific/GitHome.hs     | 11 +++---
 src/Propellor/Property/Sudo.hs                     |  9 +++--
 src/Propellor/Property/Tor.hs                      | 44 +++++++++++-----------
 src/Propellor/Property/Unbound.hs                  |  8 ++--
 src/Propellor/Property/Uwsgi.hs                    | 12 +++---
 src/Propellor/Property/ZFS/Properties.hs           | 12 ++++--
 12 files changed, 99 insertions(+), 87 deletions(-)

(limited to 'src/Propellor/Property/FreeBSD')

diff --git a/src/Propellor/Property/FreeBSD/Poudriere.hs b/src/Propellor/Property/FreeBSD/Poudriere.hs
index 5467c668..fcad9e87 100644
--- a/src/Propellor/Property/FreeBSD/Poudriere.hs
+++ b/src/Propellor/Property/FreeBSD/Poudriere.hs
@@ -26,20 +26,23 @@ instance IsInfo PoudriereConfigured where
 poudriereConfigured :: PoudriereConfigured -> Bool
 poudriereConfigured (PoudriereConfigured _) = True
 
-setConfigured :: Property HasInfo
-setConfigured = pureInfoProperty "Poudriere Configured" (PoudriereConfigured "")
+setConfigured :: Property (HasInfo + FreeBSD)
+setConfigured = tightenTargets $ 
+	pureInfoProperty "Poudriere Configured" (PoudriereConfigured "")
 
-poudriere :: Poudriere -> Property HasInfo
+poudriere :: Poudriere -> Property (HasInfo + FreeBSD)
 poudriere conf@(Poudriere _ _ _ _ _ _ zfs) = prop
 	`requires` Pkg.installed "poudriere"
 	`before` setConfigured
   where
-	confProp = File.containsLines poudriereConfigPath (toLines conf)
+	confProp :: Property FreeBSD
+	confProp = tightenTargets $
+		File.containsLines poudriereConfigPath (toLines conf)
 	setZfs (PoudriereZFS z p) = ZFS.zfsSetProperties z p `describe` "Configuring Poudriere with ZFS"
-	prop :: CombinedType (Property NoInfo) (Property NoInfo)
+	prop :: Property FreeBSD
 	prop
 		| isJust zfs = ((setZfs $ fromJust zfs) `before` confProp)
-		| otherwise = propertyList "Configuring Poudriere without ZFS" [confProp]
+		| otherwise = confProp `describe` "Configuring Poudriere without ZFS"
 
 poudriereCommand :: String -> [String] -> (String, [String])
 poudriereCommand cmd args = ("poudriere", cmd:args)
@@ -58,8 +61,8 @@ listJails = mapMaybe (headMaybe . take 1 . words)
 jailExists :: Jail -> IO Bool
 jailExists (Jail name _ _) = isInfixOf [name] <$> listJails
 
-jail :: Jail -> Property NoInfo
-jail j@(Jail name version arch) =
+jail :: Jail -> Property FreeBSD
+jail j@(Jail name version arch) = tightenTargets $
 	let
 		chk = do
 			c <- poudriereConfigured <$> askInfo
@@ -70,7 +73,7 @@ jail j@(Jail name version arch) =
 		createJail = cmdProperty cmd args
 	in
 		check chk createJail
-		`describe` unwords ["Create poudriere jail", name]
+			`describe` unwords ["Create poudriere jail", name]
 
 data JailInfo = JailInfo String
 
diff --git a/src/Propellor/Property/HostingProvider/DigitalOcean.hs b/src/Propellor/Property/HostingProvider/DigitalOcean.hs
index f49b86b3..c1e0ffc9 100644
--- a/src/Propellor/Property/HostingProvider/DigitalOcean.hs
+++ b/src/Propellor/Property/HostingProvider/DigitalOcean.hs
@@ -18,16 +18,15 @@ import Data.List
 -- If the power is cycled, the non-distro kernel still boots up.
 -- So, this property also checks if the running kernel is present in /boot,
 -- and if not, reboots immediately into a distro kernel.
-distroKernel :: Property NoInfo
-distroKernel = propertyList "digital ocean distro kernel hack"
-	[ Apt.installed ["grub-pc", "kexec-tools", "file"]
-	, "/etc/default/kexec" `File.containsLines`
+distroKernel :: Property DebianLike
+distroKernel = propertyList "digital ocean distro kernel hack" $ props
+	& Apt.installed ["grub-pc", "kexec-tools", "file"]
+	& "/etc/default/kexec" `File.containsLines`
 		[ "LOAD_KEXEC=true"
 		, "USE_GRUB_CONFIG=true"
 		] `describe` "kexec configured"
-	, check (not <$> runningInstalledKernel) Reboot.now
+	& check (not <$> runningInstalledKernel) Reboot.now
 		`describe` "running installed kernel"
-	]
 
 runningInstalledKernel :: IO Bool
 runningInstalledKernel = do
diff --git a/src/Propellor/Property/HostingProvider/Linode.hs b/src/Propellor/Property/HostingProvider/Linode.hs
index 274412a0..71719d87 100644
--- a/src/Propellor/Property/HostingProvider/Linode.hs
+++ b/src/Propellor/Property/HostingProvider/Linode.hs
@@ -8,12 +8,13 @@ import Utility.FileMode
 -- | Linode's pv-grub-x86_64 does not currently support booting recent
 -- Debian kernels compressed with xz. This sets up pv-grub chaining to enable
 -- it.
-chainPVGrub :: Grub.TimeoutSecs -> Property NoInfo
+chainPVGrub :: Grub.TimeoutSecs -> Property DebianLike
 chainPVGrub = Grub.chainPVGrub "hd0" "xen/xvda"
 
 -- | Linode disables mlocate's cron job's execute permissions,
 -- presumably to avoid disk IO. This ensures it's executable.
-mlocateEnabled :: Property NoInfo
-mlocateEnabled = "/etc/cron.daily/mlocate"
-	`File.mode` combineModes (readModes ++ executeModes)
+mlocateEnabled :: Property DebianLike
+mlocateEnabled = tightenTargets $
+	"/etc/cron.daily/mlocate"
+		`File.mode` combineModes (readModes ++ executeModes)
 
diff --git a/src/Propellor/Property/Postfix.hs b/src/Propellor/Property/Postfix.hs
index df244061..7d9e7068 100644
--- a/src/Propellor/Property/Postfix.hs
+++ b/src/Propellor/Property/Postfix.hs
@@ -12,13 +12,13 @@ import qualified Data.Map as M
 import Data.List
 import Data.Char
 
-installed :: Property NoInfo
+installed :: Property DebianLike
 installed = Apt.serviceInstalledRunning "postfix"
 
-restarted :: Property NoInfo
+restarted :: Property DebianLike
 restarted = Service.restarted "postfix"
 
-reloaded :: Property NoInfo
+reloaded :: Property DebianLike
 reloaded = Service.reloaded "postfix"
 
 -- | Configures postfix as a satellite system, which 
@@ -28,38 +28,39 @@ reloaded = Service.reloaded "postfix"
 -- The smarthost may refuse to relay mail on to other domains, without
 -- further configuration/keys. But this should be enough to get cron job
 -- mail flowing to a place where it will be seen.
-satellite :: Property NoInfo
+satellite :: Property DebianLike
 satellite = check (not <$> mainCfIsSet "relayhost") setup
 	`requires` installed
   where
-	setup = property "postfix satellite system" $ do
+	desc = "postfix satellite system"
+	setup :: Property DebianLike
+	setup = property' desc $ \w -> do
 		hn <- asks hostName
 		let (_, domain) = separate (== '.') hn
-		ensureProperties
-			[ Apt.reConfigure "postfix"
+		ensureProperty w $ combineProperties desc $ props
+			& Apt.reConfigure "postfix"
 				[ ("postfix/main_mailer_type", "select", "Satellite system")
 				, ("postfix/root_address", "string", "root")
 				, ("postfix/destinations", "string", "localhost")
 				, ("postfix/mailname", "string", hn)
 				]
-			, mainCf ("relayhost", "smtp." ++ domain)
+			& mainCf ("relayhost", "smtp." ++ domain)
 				`onChange` reloaded
-			]
 
 -- | Sets up a file by running a property (which the filename is passed
 -- to). If the setup property makes a change, postmap will be run on the
 -- file, and postfix will be reloaded.
 mappedFile
-	:: Combines (Property x) (Property NoInfo)
+	:: Combines (Property x) (Property UnixLike)
 	=> FilePath
 	-> (FilePath -> Property x)
-	-> Property (CInfo x NoInfo)
+	-> CombinedType (Property x) (Property UnixLike)
 mappedFile f setup = setup f
 	`onChange` (cmdProperty "postmap" [f] `assume` MadeChange)
 
 -- | Run newaliases command, which should be done after changing
 -- @/etc/aliases@.
-newaliases :: Property NoInfo
+newaliases :: Property UnixLike
 newaliases = check ("/etc/aliases" `isNewerThan` "/etc/aliases.db")
 	(cmdProperty "newaliases" [])
 
@@ -68,9 +69,9 @@ mainCfFile :: FilePath
 mainCfFile = "/etc/postfix/main.cf"
 
 -- | Sets a main.cf @name=value@ pair. Does not reload postfix immediately.
-mainCf :: (String, String) -> Property NoInfo
+mainCf :: (String, String) -> Property UnixLike
 mainCf (name, value) = check notset set
-		`describe` ("postfix main.cf " ++ setting)
+	`describe` ("postfix main.cf " ++ setting)
   where
 	setting = name ++ "=" ++ value
 	notset = (/= Just value) <$> getMainCf name
@@ -105,7 +106,7 @@ mainCfIsSet name = do
 --
 -- Note that multiline configurations that continue onto the next line
 -- are not currently supported.
-dedupMainCf :: Property NoInfo
+dedupMainCf :: Property UnixLike
 dedupMainCf = File.fileProperty "postfix main.cf dedupped" dedupCf mainCfFile
 
 dedupCf :: [String] -> [String]
@@ -252,7 +253,7 @@ parseServiceLine l = Service
 	nws = length ws
 
 -- | Enables a `Service` in postfix's `masterCfFile`.
-service :: Service -> RevertableProperty NoInfo
+service :: Service -> RevertableProperty DebianLike DebianLike
 service s = (enable <!> disable)
 	`describe` desc
   where
@@ -276,7 +277,7 @@ service s = (enable <!> disable)
 -- It would be wise to enable fail2ban, for example:
 --
 -- > Fail2Ban.jailEnabled "postfix-sasl"
-saslAuthdInstalled :: Property NoInfo
+saslAuthdInstalled :: Property DebianLike
 saslAuthdInstalled = setupdaemon
 	`requires` Service.running "saslauthd"
 	`requires` postfixgroup
diff --git a/src/Propellor/Property/PropellorRepo.hs b/src/Propellor/Property/PropellorRepo.hs
index d4fc089a..e60e7848 100644
--- a/src/Propellor/Property/PropellorRepo.hs
+++ b/src/Propellor/Property/PropellorRepo.hs
@@ -11,7 +11,7 @@ import Propellor.Git.Config
 --
 -- This property is useful when hosts are being updated without using
 -- --spin, eg when using the `Propellor.Property.Cron.runPropellor` cron job.
-hasOriginUrl :: String -> Property NoInfo
+hasOriginUrl :: String -> Property UnixLike
 hasOriginUrl u = property ("propellor repo url " ++ u) $ do
 	curru <- liftIO getRepoUrl
 	if curru == Just u
diff --git a/src/Propellor/Property/Prosody.hs b/src/Propellor/Property/Prosody.hs
index 47095504..8017be4a 100644
--- a/src/Propellor/Property/Prosody.hs
+++ b/src/Propellor/Property/Prosody.hs
@@ -11,7 +11,7 @@ type ConfigFile = [String]
 
 type Conf = String
 
-confEnabled :: Conf -> ConfigFile -> RevertableProperty NoInfo
+confEnabled :: Conf -> ConfigFile -> RevertableProperty DebianLike DebianLike
 confEnabled conf cf = enable <!> disable
   where
 	enable = dir `File.isSymlinkedTo` target
@@ -29,9 +29,9 @@ confEnabled conf cf = enable <!> disable
 		`requires` installed
 		`onChange` reloaded
 
-confAvailable :: Conf -> ConfigFile -> Property NoInfo
+confAvailable :: Conf -> ConfigFile -> Property DebianLike
 confAvailable conf cf = ("prosody conf available " ++ conf) ==>
-	confAvailPath conf `File.hasContent` (comment : cf)
+	tightenTargets (confAvailPath conf `File.hasContent` (comment : cf))
   where
 	comment = "-- deployed with propellor, do not modify"
 
@@ -41,11 +41,11 @@ confAvailPath conf = "/etc/prosody/conf.avail" </> conf <.> "cfg.lua"
 confValPath :: Conf -> FilePath
 confValPath conf = "/etc/prosody/conf.d" </> conf <.> "cfg.lua"
 
-installed :: Property NoInfo
+installed :: Property DebianLike
 installed = Apt.installed ["prosody"]
 
-restarted :: Property NoInfo
+restarted :: Property DebianLike
 restarted = Service.restarted "prosody"
 
-reloaded :: Property NoInfo
+reloaded :: Property DebianLike
 reloaded = Service.reloaded "prosody"
diff --git a/src/Propellor/Property/SiteSpecific/GitHome.hs b/src/Propellor/Property/SiteSpecific/GitHome.hs
index 83a1a16a..f14b5f12 100644
--- a/src/Propellor/Property/SiteSpecific/GitHome.hs
+++ b/src/Propellor/Property/SiteSpecific/GitHome.hs
@@ -5,14 +5,15 @@ import qualified Propellor.Property.Apt as Apt
 import Propellor.Property.User
 
 -- | Clones Joey Hess's git home directory, and runs its fixups script.
-installedFor :: User -> Property NoInfo
+installedFor :: User -> Property DebianLike
 installedFor user@(User u) = check (not <$> hasGitDir user) $ 
-	property ("githome " ++ u) (go =<< liftIO (homedir user))
-		`requires` Apt.installed ["git"]
+	go `requires` Apt.installed ["git"]
   where
-	go home = do
+	go :: Property DebianLike
+	go = property' ("githome " ++ u) $ \w -> do
+		home <- liftIO (homedir user)
 		let tmpdir = home </> "githome"
-		ensureProperty $ combineProperties "githome setup"
+		ensureProperty w $ combineProperties "githome setup" $ toProps
 			[ userScriptProperty user ["git clone " ++ url ++ " " ++ tmpdir]
 				`assume` MadeChange
 			, property "moveout" $ makeChange $ void $
diff --git a/src/Propellor/Property/Sudo.hs b/src/Propellor/Property/Sudo.hs
index ed6ba2d5..45ab8af2 100644
--- a/src/Propellor/Property/Sudo.hs
+++ b/src/Propellor/Property/Sudo.hs
@@ -9,12 +9,13 @@ import Propellor.Property.User
 
 -- | Allows a user to sudo. If the user has a password, sudo is configured
 -- to require it. If not, NOPASSWORD is enabled for the user.
-enabledFor :: User -> Property NoInfo
-enabledFor user@(User u) = property desc go `requires` Apt.installed ["sudo"]
+enabledFor :: User -> Property DebianLike
+enabledFor user@(User u) = go `requires` Apt.installed ["sudo"]
   where
-	go = do
+	go :: Property UnixLike
+	go = property' desc $ \w -> do
 		locked <- liftIO $ isLockedPassword user
-		ensureProperty $
+		ensureProperty w $
 			fileProperty desc
 				(modify locked . filter (wanted locked))
 				"/etc/sudoers"
diff --git a/src/Propellor/Property/Tor.hs b/src/Propellor/Property/Tor.hs
index 0c040f95..92dbd507 100644
--- a/src/Propellor/Property/Tor.hs
+++ b/src/Propellor/Property/Tor.hs
@@ -1,3 +1,5 @@
+{-# LANGUAGE TypeFamilies #-}
+
 module Propellor.Property.Tor where
 
 import Propellor.Base
@@ -19,7 +21,7 @@ type NodeName = String
 -- | Sets up a tor bridge. (Not a relay or exit node.)
 --
 -- Uses port 443
-isBridge :: Property NoInfo
+isBridge :: Property DebianLike
 isBridge = configured
 	[ ("BridgeRelay", "1")
 	, ("Exitpolicy", "reject *:*")
@@ -31,7 +33,7 @@ isBridge = configured
 -- | Sets up a tor relay.
 --
 -- Uses port 443
-isRelay :: Property NoInfo
+isRelay :: Property DebianLike
 isRelay = configured
 	[ ("BridgeRelay", "0")
 	, ("Exitpolicy", "reject *:*")
@@ -44,21 +46,21 @@ isRelay = configured
 --
 -- This can be moved to a different IP without needing to wait to
 -- accumulate trust.
-named :: NodeName -> Property HasInfo
+named :: NodeName -> Property (HasInfo + DebianLike)
 named n = configured [("Nickname", n')]
 	`describe` ("tor node named " ++ n')
 	`requires` torPrivKey (Context ("tor " ++ n))
   where
 	n' = saneNickname n
 
-torPrivKey :: Context -> Property HasInfo
+torPrivKey :: Context -> Property (HasInfo + DebianLike)
 torPrivKey context = f `File.hasPrivContent` context
 	`onChange` File.ownerGroup f user (userGroup user)
 	`requires` torPrivKeyDirExists
   where
 	f = torPrivKeyDir </> "secret_id_key"
 
-torPrivKeyDirExists :: Property NoInfo
+torPrivKeyDirExists :: Property DebianLike
 torPrivKeyDirExists = File.dirExists torPrivKeyDir
 	`onChange` setperms
 	`requires` installed
@@ -71,20 +73,20 @@ torPrivKeyDir = "/var/lib/tor/keys"
 
 -- | A tor server (bridge, relay, or exit)
 -- Don't use if you just want to run tor for personal use.
-server :: Property NoInfo
+server :: Property DebianLike
 server = configured [("SocksPort", "0")]
 	`requires` installed
 	`requires` Apt.installed ["ntp"]
 	`describe` "tor server"
 
-installed :: Property NoInfo
+installed :: Property DebianLike
 installed = Apt.installed ["tor"]
 
 -- | Specifies configuration settings. Any lines in the config file
 -- that set other values for the specified settings will be removed,
 -- while other settings are left as-is. Tor is restarted when
 -- configuration is changed.
-configured :: [(String, String)] -> Property NoInfo
+configured :: [(String, String)] -> Property DebianLike
 configured settings = File.fileProperty "tor configured" go mainConfig
 	`onChange` restarted
   where
@@ -105,19 +107,19 @@ data BwLimit
 --
 -- For example, PerSecond "30 kibibytes" is the minimum limit
 -- for a useful relay.
-bandwidthRate :: BwLimit -> Property NoInfo
+bandwidthRate :: BwLimit -> Property DebianLike
 bandwidthRate (PerSecond s) = bandwidthRate' s 1
 bandwidthRate (PerDay s) = bandwidthRate' s (24*60*60)
 bandwidthRate (PerMonth s) = bandwidthRate' s (31*24*60*60)
 
-bandwidthRate' :: String -> Integer -> Property NoInfo
+bandwidthRate' :: String -> Integer -> Property DebianLike
 bandwidthRate' s divby = case readSize dataUnits s of
 	Just sz -> let v = show (sz `div` divby) ++ " bytes"
 		in configured [("BandwidthRate", v)]
 			`describe` ("tor BandwidthRate " ++ v)
 	Nothing -> property ("unable to parse " ++ s) noChange
 
-hiddenServiceAvailable :: HiddenServiceName -> Int -> Property NoInfo
+hiddenServiceAvailable :: HiddenServiceName -> Int -> Property DebianLike
 hiddenServiceAvailable hn port = hiddenServiceHostName $ hiddenService hn port
   where
 	hiddenServiceHostName p =  adjustPropertySatisfy p $ \satisfy -> do
@@ -126,7 +128,7 @@ hiddenServiceAvailable hn port = hiddenServiceHostName $ hiddenService hn port
 		warningMessage $ unwords ["hidden service hostname:", h]
 		return r
 
-hiddenService :: HiddenServiceName -> Int -> Property NoInfo
+hiddenService :: HiddenServiceName -> Int -> Property DebianLike
 hiddenService hn port = ConfFile.adjustSection
 	(unwords ["hidden service", hn, "available on port", show port])
 	(== oniondir)
@@ -139,18 +141,18 @@ hiddenService hn port = ConfFile.adjustSection
 	oniondir = unwords ["HiddenServiceDir", varLib </> hn]
 	onionport = unwords ["HiddenServicePort", show port, "127.0.0.1:" ++ show port]
 
-hiddenServiceData :: IsContext c => HiddenServiceName -> c -> Property HasInfo
-hiddenServiceData hn context = combineProperties desc
-	[ installonion "hostname"
-	, installonion "private_key"
-	]
+hiddenServiceData :: IsContext c => HiddenServiceName -> c -> Property (HasInfo + DebianLike)
+hiddenServiceData hn context = combineProperties desc $ props
+	& installonion "hostname"
+	& installonion "private_key"
   where
 	desc = unwords ["hidden service data available in", varLib </> hn]
+	installonion :: FilePath -> Property (HasInfo + DebianLike)
 	installonion f = withPrivData (PrivFile $ varLib </> hn </> f) context $ \getcontent ->
-		property desc $ getcontent $ install $ varLib </> hn </> f
-	install f privcontent = ifM (liftIO $ doesFileExist f)
+		property' desc $ \w -> getcontent $ install w $ varLib </> hn </> f
+	install w f privcontent = ifM (liftIO $ doesFileExist f)
 		( noChange
-		, ensureProperties
+		, ensureProperty w $ propertyList desc $ toProps
 			[ property desc $ makeChange $ do
 				createDirectoryIfMissing True (takeDirectory f)
 				writeFileProtected f (unlines (privDataLines privcontent))
@@ -161,7 +163,7 @@ hiddenServiceData hn context = combineProperties desc
 			]
 		)
 
-restarted :: Property NoInfo
+restarted :: Property DebianLike
 restarted = Service.restarted "tor"
 
 mainConfig :: FilePath
diff --git a/src/Propellor/Property/Unbound.hs b/src/Propellor/Property/Unbound.hs
index f1280b0e..23a5b30d 100644
--- a/src/Propellor/Property/Unbound.hs
+++ b/src/Propellor/Property/Unbound.hs
@@ -41,13 +41,13 @@ type UnboundValue = String
 
 type ZoneType = String
 
-installed :: Property NoInfo
+installed :: Property DebianLike
 installed = Apt.installed ["unbound"]
 
-restarted :: Property NoInfo
+restarted :: Property DebianLike
 restarted = Service.restarted "unbound"
 
-reloaded :: Property NoInfo
+reloaded :: Property DebianLike
 reloaded = Service.reloaded "unbound"
 
 dValue :: BindDomain -> String
@@ -90,7 +90,7 @@ config = "/etc/unbound/unbound.conf.d/propellor.conf"
 -- >      , (AbsDomain "myrouter.example.com", PTR $ reverseIP $ IPv4 "192.168.1.1")
 -- >      , (AbsDomain "mylaptop.example.com", PTR $ reverseIP $ IPv4 "192.168.1.2")
 -- >      ]
-cachingDnsServer :: [UnboundSection] -> [UnboundZone] -> [UnboundHost] -> Property NoInfo
+cachingDnsServer :: [UnboundSection] -> [UnboundZone] -> [UnboundHost] -> Property DebianLike
 cachingDnsServer sections zones hosts =
 	config `hasContent` (comment : otherSections ++ serverSection)
 	`onChange` restarted
diff --git a/src/Propellor/Property/Uwsgi.hs b/src/Propellor/Property/Uwsgi.hs
index 8b531c3f..491c77d1 100644
--- a/src/Propellor/Property/Uwsgi.hs
+++ b/src/Propellor/Property/Uwsgi.hs
@@ -11,7 +11,7 @@ type ConfigFile = [String]
 
 type AppName = String
 
-appEnabled :: AppName -> ConfigFile -> RevertableProperty NoInfo
+appEnabled :: AppName -> ConfigFile -> RevertableProperty DebianLike DebianLike
 appEnabled an cf = enable <!> disable
   where
 	enable = appVal an `File.isSymlinkedTo` appValRelativeCfg an
@@ -24,9 +24,9 @@ appEnabled an cf = enable <!> disable
 		`requires` installed
 		`onChange` reloaded
 
-appAvailable :: AppName -> ConfigFile -> Property NoInfo
+appAvailable :: AppName -> ConfigFile -> Property DebianLike
 appAvailable an cf = ("uwsgi app available " ++ an) ==>
-	appCfg an `File.hasContent` (comment : cf)
+	tightenTargets (appCfg an `File.hasContent` (comment : cf))
   where
 	comment = "# deployed with propellor, do not modify"
 
@@ -39,11 +39,11 @@ appVal an = "/etc/uwsgi/apps-enabled/" ++ an
 appValRelativeCfg :: AppName -> File.LinkTarget
 appValRelativeCfg an = File.LinkTarget $ "../apps-available/" ++ an
 
-installed :: Property NoInfo
+installed :: Property DebianLike
 installed = Apt.installed ["uwsgi"]
 
-restarted :: Property NoInfo
+restarted :: Property DebianLike
 restarted = Service.restarted "uwsgi"
 
-reloaded :: Property NoInfo
+reloaded :: Property DebianLike
 reloaded = Service.reloaded "uwsgi"
diff --git a/src/Propellor/Property/ZFS/Properties.hs b/src/Propellor/Property/ZFS/Properties.hs
index 5ceaf9ba..47d5a9d1 100644
--- a/src/Propellor/Property/ZFS/Properties.hs
+++ b/src/Propellor/Property/ZFS/Properties.hs
@@ -3,6 +3,7 @@
 -- Functions defining zfs Properties.
 
 module Propellor.Property.ZFS.Properties (
+	ZFSOS,
 	zfsExists,
 	zfsSetProperties
 ) where
@@ -11,9 +12,12 @@ import Propellor.Base
 import Data.List (intercalate)
 import qualified Propellor.Property.ZFS.Process as ZP
 
+-- | OS's that support ZFS
+type ZFSOS = Linux + FreeBSD
+
 -- | Will ensure that a ZFS volume exists with the specified mount point.
 -- This requires the pool to exist as well, but we don't create pools yet.
-zfsExists :: ZFS -> Property NoInfo
+zfsExists :: ZFS -> Property ZFSOS
 zfsExists z = check (not <$> ZP.zfsExists z) create
 	`describe` unwords ["Creating", zfsName z]
   where
@@ -21,16 +25,16 @@ zfsExists z = check (not <$> ZP.zfsExists z) create
 	create = cmdProperty p a
 
 -- | Sets the given properties. Returns True if all were successfully changed, False if not.
-zfsSetProperties :: ZFS -> ZFSProperties -> Property NoInfo
+zfsSetProperties :: ZFS -> ZFSProperties -> Property ZFSOS
 zfsSetProperties z setProperties = setall
 	`requires` zfsExists z
   where
 	spcmd :: String -> String -> (String, [String])
 	spcmd p v = ZP.zfsCommand "set" [Just (intercalate "=" [p, v]), Nothing] z
 
-	setprop :: (String, String) -> Property NoInfo
+	setprop :: (String, String) -> Property ZFSOS
 	setprop (p, v) = check (ZP.zfsExists z) $
 		cmdProperty (fst (spcmd p v)) (snd (spcmd p v))
 
 	setall = combineProperties (unwords ["Setting properties on", zfsName z]) $
-		map setprop $ toPropertyList setProperties
+		toProps $ map setprop $ toPropertyList setProperties
-- 
cgit v1.3-2-g0d8e


From 9d6dc29555b8499d8ae6c73c891b0b5dc19f83e5 Mon Sep 17 00:00:00 2001
From: Joey Hess <joeyh@joeyh.name>
Date: Sun, 27 Mar 2016 19:59:20 -0400
Subject: improve haddocks and move code around to make them more clear

---
 propellor.cabal                       |   1 +
 src/Propellor/Container.hs            |   4 +-
 src/Propellor/Engine.hs               |   4 +-
 src/Propellor/EnsureProperty.hs       |   1 +
 src/Propellor/Info.hs                 |  28 +++++-
 src/Propellor/PrivData.hs             |   2 +-
 src/Propellor/PropAccum.hs            |   5 +-
 src/Propellor/Property.hs             |   1 +
 src/Propellor/Property/Chroot.hs      |   3 +-
 src/Propellor/Property/Concurrent.hs  |   2 +
 src/Propellor/Property/Conductor.hs   |  13 +--
 src/Propellor/Property/Dns.hs         |   2 +-
 src/Propellor/Property/Docker.hs      |   3 +-
 src/Propellor/Property/FreeBSD/Pkg.hs |   4 +-
 src/Propellor/Property/List.hs        |   2 +
 src/Propellor/Property/Partition.hs   |   1 +
 src/Propellor/Property/Scheduled.hs   |   1 +
 src/Propellor/Types.hs                | 168 ++++++----------------------------
 src/Propellor/Types/Core.hs           | 106 +++++++++++++++++++++
 src/Propellor/Types/Info.hs           |   5 +
 20 files changed, 196 insertions(+), 160 deletions(-)
 create mode 100644 src/Propellor/Types/Core.hs

(limited to 'src/Propellor/Property/FreeBSD')

diff --git a/propellor.cabal b/propellor.cabal
index f11d2afe..e946f697 100644
--- a/propellor.cabal
+++ b/propellor.cabal
@@ -150,6 +150,7 @@ Library
     Propellor.EnsureProperty
     Propellor.Exception
     Propellor.Types
+    Propellor.Types.Core
     Propellor.Types.Chroot
     Propellor.Types.CmdLine
     Propellor.Types.Container
diff --git a/src/Propellor/Container.hs b/src/Propellor/Container.hs
index 4cd46ae5..c4d6f864 100644
--- a/src/Propellor/Container.hs
+++ b/src/Propellor/Container.hs
@@ -3,8 +3,10 @@
 module Propellor.Container where
 
 import Propellor.Types
+import Propellor.Types.Core
 import Propellor.Types.MetaTypes
 import Propellor.Types.Info
+import Propellor.Info
 import Propellor.PrivData
 import Propellor.PropAccum
 
@@ -54,7 +56,7 @@ propagateContainer containername c prop = prop
 	convert p = 
 		let n = property (getDesc p) (getSatisfy p) :: Property UnixLike
 		    n' = n
-		    	`addInfoProperty` mapInfo (forceHostContext containername)
+		    	`setInfoProperty` mapInfo (forceHostContext containername)
 				(propagatableInfo (getInfo p))
 		   	`addChildren` map convert (getChildren p)
 		in toChildProperty n'
diff --git a/src/Propellor/Engine.hs b/src/Propellor/Engine.hs
index 4c37e704..f0035c40 100644
--- a/src/Propellor/Engine.hs
+++ b/src/Propellor/Engine.hs
@@ -4,7 +4,6 @@
 module Propellor.Engine (
 	mainProperties,
 	runPropellor,
-	ensureProperty,
 	ensureChildProperties,
 	fromHost,
 	fromHost',
@@ -23,10 +22,11 @@ import Control.Applicative
 import Prelude
 
 import Propellor.Types
+import Propellor.Types.MetaTypes
+import Propellor.Types.Core
 import Propellor.Message
 import Propellor.Exception
 import Propellor.Info
-import Propellor.Property
 import Utility.Exception
 
 -- | Gets the Properties of a Host, and ensures them all,
diff --git a/src/Propellor/EnsureProperty.hs b/src/Propellor/EnsureProperty.hs
index f9094c5b..ce01d436 100644
--- a/src/Propellor/EnsureProperty.hs
+++ b/src/Propellor/EnsureProperty.hs
@@ -11,6 +11,7 @@ module Propellor.EnsureProperty
 	) where
 
 import Propellor.Types
+import Propellor.Types.Core
 import Propellor.Types.MetaTypes
 import Propellor.Exception
 
diff --git a/src/Propellor/Info.hs b/src/Propellor/Info.hs
index ff0b3b5e..b87369c3 100644
--- a/src/Propellor/Info.hs
+++ b/src/Propellor/Info.hs
@@ -1,9 +1,11 @@
-{-# LANGUAGE PackageImports #-}
+{-# LANGUAGE PackageImports, TypeFamilies, DataKinds, PolyKinds #-}
 
 module Propellor.Info (
 	osDebian,
 	osBuntish,
 	osFreeBSD,
+	setInfoProperty,
+	addInfoProperty,
 	pureInfoProperty,
 	pureInfoProperty',
 	askInfo,
@@ -22,6 +24,7 @@ module Propellor.Info (
 
 import Propellor.Types
 import Propellor.Types.Info
+import Propellor.Types.MetaTypes
 
 import "mtl" Control.Monad.Reader
 import qualified Data.Set as S
@@ -31,11 +34,32 @@ import Data.Monoid
 import Control.Applicative
 import Prelude
 
+-- | Adds info to a Property.
+--
+-- The new Property will include HasInfo in its metatypes.
+setInfoProperty
+	:: (MetaTypes metatypes' ~ (+) HasInfo metatypes, SingI metatypes')
+	=> Property metatypes
+	-> Info
+	-> Property (MetaTypes metatypes')
+setInfoProperty (Property _ d a oldi c) newi =
+	Property sing d a (oldi <> newi) c
+
+-- | Adds more info to a Property that already HasInfo.
+addInfoProperty
+	:: (IncludesInfo metatypes ~ 'True)
+	=> Property metatypes
+	-> Info
+	-> Property metatypes
+addInfoProperty (Property t d a oldi c) newi =
+	Property t d a (oldi <> newi) c
+
+-- | Makes a property that does nothing but set some `Info`.
 pureInfoProperty :: (IsInfo v) => Desc -> v -> Property (HasInfo + UnixLike)
 pureInfoProperty desc v = pureInfoProperty' desc (toInfo v)
 
 pureInfoProperty' :: Desc -> Info -> Property (HasInfo + UnixLike)
-pureInfoProperty' desc i = addInfoProperty p i
+pureInfoProperty' desc i = setInfoProperty p i
   where
 	p :: Property UnixLike
 	p = property ("has " ++ desc) (return NoChange)
diff --git a/src/Propellor/PrivData.hs b/src/Propellor/PrivData.hs
index 0bc0c100..d3bb3a6d 100644
--- a/src/Propellor/PrivData.hs
+++ b/src/Propellor/PrivData.hs
@@ -127,7 +127,7 @@ withPrivData' feed srclist c mkprop = addinfo $ mkprop $ \a ->
 			"Fix this by running:" :
 			showSet (map (\s -> (privDataField s, Context cname, describePrivDataSource s)) srclist)
 		return FailedChange
-	addinfo p = p `addInfoProperty'` (toInfo privset)
+	addinfo p = p `addInfoProperty` (toInfo privset)
 	privset = PrivInfo $ S.fromList $
 		map (\s -> (privDataField s, describePrivDataSource s, hc)) srclist
 	fieldnames = map show fieldlist
diff --git a/src/Propellor/PropAccum.hs b/src/Propellor/PropAccum.hs
index 856f2e8e..d9fa8ec7 100644
--- a/src/Propellor/PropAccum.hs
+++ b/src/Propellor/PropAccum.hs
@@ -16,6 +16,7 @@ module Propellor.PropAccum
 
 import Propellor.Types
 import Propellor.Types.MetaTypes
+import Propellor.Types.Core
 import Propellor.Property
 
 import Data.Monoid
@@ -30,10 +31,6 @@ import Prelude
 host :: HostName -> Props metatypes -> Host
 host hn (Props ps) = Host hn ps (mconcat (map getInfoRecursive ps))
 
--- | Props is a combination of a list of properties, with their combined 
--- metatypes.
-data Props metatypes = Props [ChildProperty]
-
 -- | Start accumulating a list of properties.
 --
 -- Properties can be added to it using `(&)` etc.
diff --git a/src/Propellor/Property.hs b/src/Propellor/Property.hs
index 70583edc..29a8ec0f 100644
--- a/src/Propellor/Property.hs
+++ b/src/Propellor/Property.hs
@@ -53,6 +53,7 @@ import Control.Applicative
 import Prelude
 
 import Propellor.Types
+import Propellor.Types.Core
 import Propellor.Types.ResultCheck
 import Propellor.Types.MetaTypes
 import Propellor.Info
diff --git a/src/Propellor/Property/Chroot.hs b/src/Propellor/Property/Chroot.hs
index 811b5baa..09047ce5 100644
--- a/src/Propellor/Property/Chroot.hs
+++ b/src/Propellor/Property/Chroot.hs
@@ -23,6 +23,7 @@ import Propellor.Container
 import Propellor.Types.CmdLine
 import Propellor.Types.Chroot
 import Propellor.Types.Info
+import Propellor.Types.Core
 import Propellor.Property.Chroot.Util
 import qualified Propellor.Property.Debootstrap as Debootstrap
 import qualified Propellor.Property.Systemd.Core as Systemd
@@ -151,7 +152,7 @@ provisioned' propigator c@(Chroot loc bootstrapper _) systemdonly =
 
 propagateChrootInfo :: Chroot -> Property Linux -> Property (HasInfo + Linux)
 propagateChrootInfo c@(Chroot location _ _) p = propagateContainer location c $
-	p `addInfoProperty` chrootInfo c
+	p `setInfoProperty` chrootInfo c
 
 chrootInfo :: Chroot -> Info
 chrootInfo (Chroot loc _ h) = mempty `addInfo`
diff --git a/src/Propellor/Property/Concurrent.hs b/src/Propellor/Property/Concurrent.hs
index ace85a3c..e69dc17d 100644
--- a/src/Propellor/Property/Concurrent.hs
+++ b/src/Propellor/Property/Concurrent.hs
@@ -37,6 +37,8 @@ module Propellor.Property.Concurrent (
 ) where
 
 import Propellor.Base
+import Propellor.Types.Core
+import Propellor.Types.MetaTypes
 
 import Control.Concurrent
 import qualified Control.Concurrent.Async as A
diff --git a/src/Propellor/Property/Conductor.hs b/src/Propellor/Property/Conductor.hs
index ab747acc..8aa18d20 100644
--- a/src/Propellor/Property/Conductor.hs
+++ b/src/Propellor/Property/Conductor.hs
@@ -83,16 +83,17 @@ import qualified Propellor.Property.Ssh as Ssh
 import qualified Data.Set as S
 
 -- | Class of things that can be conducted.
+--
+-- There are instances for single hosts, and for lists of hosts.
+-- With a list, each listed host will be conducted in turn. Failure to conduct
+-- one host does not prevent conducting subsequent hosts in the list, but
+-- will be propagated as an overall failure of the property.
 class Conductable c where
 	conducts :: c -> RevertableProperty (HasInfo + UnixLike) (HasInfo + UnixLike)
 
 instance Conductable Host where
-	-- | Conduct the specified host.
 	conducts h = conductorFor h <!> notConductorFor h
 
--- | Each host in the list will be conducted in turn. Failure to conduct
--- one host does not prevent conducting subsequent hosts in the list, but
--- will be propagated as an overall failure of the property.
 instance Conductable [Host] where
 	conducts hs = 
 		propertyList desc (toProps $ map (setupRevertableProperty . conducts) hs)
@@ -246,7 +247,7 @@ orchestrate' h (Conductor c l)
 -- to have any effect.
 conductorFor :: Host -> Property (HasInfo + UnixLike)
 conductorFor h = go
-	`addInfoProperty` (toInfo (ConductorFor [h]))
+	`setInfoProperty` (toInfo (ConductorFor [h]))
 	`requires` setupRevertableProperty (conductorKnownHost h)
 	`requires` Ssh.installed
   where
@@ -270,7 +271,7 @@ conductorFor h = go
 -- Reverts conductorFor.
 notConductorFor :: Host -> Property (HasInfo + UnixLike)
 notConductorFor h = (doNothing :: Property UnixLike)
-	`addInfoProperty` (toInfo (NotConductorFor [h]))
+	`setInfoProperty` (toInfo (NotConductorFor [h]))
 	`describe` desc
 	`requires` undoRevertableProperty (conductorKnownHost h)
   where
diff --git a/src/Propellor/Property/Dns.hs b/src/Propellor/Property/Dns.hs
index 2b5596bd..2e2710a6 100644
--- a/src/Propellor/Property/Dns.hs
+++ b/src/Propellor/Property/Dns.hs
@@ -81,7 +81,7 @@ setupPrimary zonefile mknamedconffile hosts domain soa rs =
 
 	(partialzone, zonewarnings) = genZone indomain hostmap domain soa
 	baseprop = primaryprop
-		`addInfoProperty` (toInfo (addNamedConf conf))
+		`setInfoProperty` (toInfo (addNamedConf conf))
 	primaryprop :: Property DebianLike
 	primaryprop = property ("dns primary for " ++ domain) $ do
 		sshfps <- concat <$> mapM (genSSHFP domain) (M.elems hostmap)
diff --git a/src/Propellor/Property/Docker.hs b/src/Propellor/Property/Docker.hs
index ddefef15..2ef97438 100644
--- a/src/Propellor/Property/Docker.hs
+++ b/src/Propellor/Property/Docker.hs
@@ -48,6 +48,7 @@ module Propellor.Property.Docker (
 import Propellor.Base hiding (init)
 import Propellor.Types.Docker
 import Propellor.Types.Container
+import Propellor.Types.Core
 import Propellor.Types.CmdLine
 import Propellor.Types.Info
 import Propellor.Container
@@ -183,7 +184,7 @@ imagePulled ctr = pulled `describe` msg
 
 propagateContainerInfo :: Container -> Property (HasInfo + Linux) -> Property (HasInfo + Linux)
 propagateContainerInfo ctr@(Container _ h) p = propagateContainer cn ctr $
-	p `addInfoProperty'` dockerinfo
+	p `addInfoProperty` dockerinfo
   where
 	dockerinfo = dockerInfo $
 		mempty { _dockerContainers = M.singleton cn h }
diff --git a/src/Propellor/Property/FreeBSD/Pkg.hs b/src/Propellor/Property/FreeBSD/Pkg.hs
index 6c775b94..704c1db9 100644
--- a/src/Propellor/Property/FreeBSD/Pkg.hs
+++ b/src/Propellor/Property/FreeBSD/Pkg.hs
@@ -51,7 +51,7 @@ update =
 		go = ifM (pkgUpdated <$> askInfo) ((noChange), (liftIO upd >> return MadeChange))
 	in
 		(property "pkg update has run" go :: Property FreeBSD)
-			`addInfoProperty` (toInfo (PkgUpdate ""))
+			`setInfoProperty` (toInfo (PkgUpdate ""))
 
 newtype PkgUpgrade = PkgUpgrade String
 	deriving (Typeable, Monoid, Show)
@@ -68,7 +68,7 @@ upgrade =
 		go = ifM (pkgUpgraded <$> askInfo) ((noChange), (liftIO upd >> return MadeChange))
 	in
 		(property "pkg upgrade has run" go :: Property FreeBSD)
-			`addInfoProperty` (toInfo (PkgUpdate ""))
+			`setInfoProperty` (toInfo (PkgUpdate ""))
 			`requires` update
 
 type Package = String
diff --git a/src/Propellor/Property/List.hs b/src/Propellor/Property/List.hs
index a8b8347a..0eec04c7 100644
--- a/src/Propellor/Property/List.hs
+++ b/src/Propellor/Property/List.hs
@@ -13,6 +13,8 @@ module Propellor.Property.List (
 ) where
 
 import Propellor.Types
+import Propellor.Types.Core
+import Propellor.Types.MetaTypes
 import Propellor.PropAccum
 import Propellor.Engine
 import Propellor.Exception
diff --git a/src/Propellor/Property/Partition.hs b/src/Propellor/Property/Partition.hs
index 291d4168..2bf5b927 100644
--- a/src/Propellor/Property/Partition.hs
+++ b/src/Propellor/Property/Partition.hs
@@ -3,6 +3,7 @@
 module Propellor.Property.Partition where
 
 import Propellor.Base
+import Propellor.Types.Core
 import qualified Propellor.Property.Apt as Apt
 import Utility.Applicative
 
diff --git a/src/Propellor/Property/Scheduled.hs b/src/Propellor/Property/Scheduled.hs
index 95e4e362..729a3749 100644
--- a/src/Propellor/Property/Scheduled.hs
+++ b/src/Propellor/Property/Scheduled.hs
@@ -10,6 +10,7 @@ module Propellor.Property.Scheduled
 	) where
 
 import Propellor.Base
+import Propellor.Types.Core
 import Utility.Scheduled
 
 import Data.Time.Clock
diff --git a/src/Propellor/Types.hs b/src/Propellor/Types.hs
index d5959cbb..6d6b14ea 100644
--- a/src/Propellor/Types.hs
+++ b/src/Propellor/Types.hs
@@ -1,4 +1,3 @@
-{-# LANGUAGE PackageImports #-}
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
 {-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE FlexibleContexts #-}
@@ -8,15 +7,18 @@
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE DeriveDataTypeable #-}
 
-module Propellor.Types
-	( Host(..)
+module Propellor.Types (
+	-- * Core data types
+	  Host(..)
 	, Property(..)
 	, property
-	, Info
 	, Desc
-	, MetaType(..)
-	, MetaTypes
-	, TargetOS(..)
+	, RevertableProperty(..)
+	, (<!>)
+	, Propellor(..)
+	, LiftPropellor(..)
+	, Info
+	-- * Types of properties
 	, UnixLike
 	, Linux
 	, DebianLike
@@ -25,34 +27,22 @@ module Propellor.Types
 	, FreeBSD
 	, HasInfo
 	, type (+)
-	, addInfoProperty
-	, addInfoProperty'
-	, adjustPropertySatisfy
-	, RevertableProperty(..)
-	, (<!>)
-	, ChildProperty
-	, IsProp(..)
+	, TightenTargets(..)
+	-- * Combining and modifying properties
 	, Combines(..)
 	, CombinedType
 	, ResultCombiner
-	, Propellor(..)
-	, LiftPropellor(..)
-	, EndAction(..)
+	, adjustPropertySatisfy
+	-- * Other included types
 	, module Propellor.Types.OS
 	, module Propellor.Types.Dns
 	, module Propellor.Types.Result
 	, module Propellor.Types.ZFS
-	, TightenTargets(..)
-	, SingI
 	) where
 
 import Data.Monoid
-import "mtl" Control.Monad.RWS.Strict
-import Control.Monad.Catch
-import Data.Typeable
-import Control.Applicative
-import Prelude
 
+import Propellor.Types.Core
 import Propellor.Types.Info
 import Propellor.Types.OS
 import Propellor.Types.Dns
@@ -60,89 +50,38 @@ import Propellor.Types.Result
 import Propellor.Types.MetaTypes
 import Propellor.Types.ZFS
 
--- | Everything Propellor knows about a system: Its hostname,
--- properties and their collected info.
-data Host = Host
-	{ hostName :: HostName
-	, hostProperties :: [ChildProperty]
-	, hostInfo :: Info
-	}
-	deriving (Show, Typeable)
-
--- | Propellor's monad provides read-only access to info about the host
--- it's running on, and a writer to accumulate EndActions.
-newtype Propellor p = Propellor { runWithHost :: RWST Host [EndAction] () IO p }
-	deriving
-		( Monad
-		, Functor
-		, Applicative
-		, MonadReader Host
-		, MonadWriter [EndAction]
-		, MonadIO
-		, MonadCatch
-		, MonadThrow
-		, MonadMask
-		)
-
-class LiftPropellor m where
-	liftPropellor :: m a -> Propellor a
-
-instance LiftPropellor Propellor where
-	liftPropellor = id
-
-instance LiftPropellor IO where
-	liftPropellor = liftIO
-
-instance Monoid (Propellor Result) where
-	mempty = return NoChange
-	-- | The second action is only run if the first action does not fail.
-	mappend x y = do
-		rx <- x
-		case rx of
-			FailedChange -> return FailedChange
-			_ -> do
-				ry <- y
-				return (rx <> ry)
-
--- | An action that Propellor runs at the end, after trying to satisfy all
--- properties. It's passed the combined Result of the entire Propellor run.
-data EndAction = EndAction Desc (Result -> Propellor Result)
-
-type Desc = String
-
 -- | The core data type of Propellor, this represents a property
--- that the system should have, with a descrition, an action to ensure
--- it has the property, and perhaps some Info that can be added to Hosts
+-- that the system should have, with a descrition, and an action to ensure
+-- it has the property.
 -- that have the property.
 --
--- A property has a list of `[MetaType]`, which is part of its type.
+-- There are different types of properties that target different OS's,
+-- and so have different metatypes. 
+-- For example: "Property DebianLike" and "Property FreeBSD".
 --
--- There are many instances and type families, which are mostly used
+-- Also, some properties have associated `Info`, which is indicated in
+-- their type: "Property (HasInfo + DebianLike)"
+--
+-- There are many associated type families, which are mostly used
 -- internally, so you needn't worry about them.
 data Property metatypes = Property metatypes Desc (Propellor Result) Info [ChildProperty]
 
 instance Show (Property metatypes) where
 	show p = "property " ++ show (getDesc p)
 
--- | Since there are many different types of Properties, they cannot be put
--- into a list. The simplified ChildProperty can be put into a list.
-data ChildProperty = ChildProperty Desc (Propellor Result) Info [ChildProperty]
-
-instance Show ChildProperty where
-	show = getDesc
-
 -- | Constructs a Property, from a description and an action to run to
 -- ensure the Property is met.
 --
--- You can specify any metatypes that make sense to indicate what OS
--- the property targets, etc.
+-- Due to the polymorphic return type of this function, most uses will need
+-- to specify a type signature. This lets you specify what OS the property
+-- targets, etc.
 --
 -- For example:
 --
 -- > foo :: Property Debian
--- > foo = mkProperty "foo" (...)
---
--- Note that using this needs LANGUAGE PolyKinds.
+-- > foo = property "foo" $ do
+-- >	...
+-- > 	return MadeChange
 property
 	:: SingI metatypes
 	=> Desc
@@ -150,26 +89,6 @@ property
 	-> Property (MetaTypes metatypes)
 property d a = Property sing d a mempty mempty
 
--- | Adds info to a Property.
---
--- The new Property will include HasInfo in its metatypes.
-addInfoProperty
-	:: (MetaTypes metatypes' ~ (+) HasInfo metatypes, SingI metatypes')
-	=> Property metatypes
-	-> Info
-	-> Property (MetaTypes metatypes')
-addInfoProperty (Property _ d a oldi c) newi =
-	Property sing d a (oldi <> newi) c
-
--- | Adds more info to a Property that already HasInfo.
-addInfoProperty'
-	:: (IncludesInfo metatypes ~ 'True)
-	=> Property metatypes
-	-> Info
-	-> Property metatypes
-addInfoProperty' (Property t d a oldi c) newi =
-	Property t d a (oldi <> newi) c
-
 -- | Changes the action that is performed to satisfy a property.
 adjustPropertySatisfy :: Property metatypes -> (Propellor Result -> Propellor Result) -> Property metatypes
 adjustPropertySatisfy (Property t d s i c) f = Property t d (f s) i c
@@ -191,24 +110,6 @@ instance Show (RevertableProperty setupmetatypes undometatypes) where
 	-> RevertableProperty setupmetatypes undometatypes
 setup <!> undo = RevertableProperty setup undo
 
-class IsProp p where
-	setDesc :: p -> Desc -> p
-	getDesc :: p -> Desc
-	getChildren :: p -> [ChildProperty]
-	addChildren :: p -> [ChildProperty] -> p
-	-- | Gets the info of the property, combined with all info
-	-- of all children properties.
-	getInfoRecursive :: p -> Info
-	-- | Info, not including info from children.
-	getInfo :: p -> Info
-	-- | Gets a ChildProperty representing the Property.
-	-- You should not normally need to use this.
-	toChildProperty :: p -> ChildProperty
-	-- | Gets the action that can be run to satisfy a Property.
-	-- You should never run this action directly. Use
-	-- 'Propellor.EnsureProperty.ensureProperty` instead.
-	getSatisfy :: p -> Propellor Result
-
 instance IsProp (Property metatypes) where
 	setDesc (Property t _ a i c) d = Property t d a i c
 	getDesc (Property _ d _ _ _) = d
@@ -220,17 +121,6 @@ instance IsProp (Property metatypes) where
 	toChildProperty (Property _ d a i c) = ChildProperty d a i c
 	getSatisfy (Property _ _ a _ _) = a
 
-instance IsProp ChildProperty where
-	setDesc (ChildProperty _ a i c) d = ChildProperty d a i c
-	getDesc (ChildProperty d _ _ _) = d
-	getChildren (ChildProperty _ _ _ c) = c
-	addChildren (ChildProperty d a i c) c' = ChildProperty d a i (c ++ c')
-	getInfoRecursive (ChildProperty _ _ i c) =
-		i <> mconcat (map getInfoRecursive c)
-	getInfo (ChildProperty _ _ i _) = i
-	toChildProperty = id
-	getSatisfy (ChildProperty _ a _ _) = a
-
 instance IsProp (RevertableProperty setupmetatypes undometatypes) where
 	-- | Sets the description of both sides.
 	setDesc (RevertableProperty p1 p2) d =
diff --git a/src/Propellor/Types/Core.hs b/src/Propellor/Types/Core.hs
new file mode 100644
index 00000000..fa939d2b
--- /dev/null
+++ b/src/Propellor/Types/Core.hs
@@ -0,0 +1,106 @@
+{-# LANGUAGE PackageImports #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE DeriveDataTypeable #-}
+{-# LANGUAGE FlexibleInstances #-}
+
+module Propellor.Types.Core where
+
+import Propellor.Types.Info
+import Propellor.Types.OS
+import Propellor.Types.Result
+
+import Data.Monoid
+import "mtl" Control.Monad.RWS.Strict
+import Control.Monad.Catch
+import Control.Applicative
+import Prelude
+
+-- | Everything Propellor knows about a system: Its hostname,
+-- properties and their collected info.
+data Host = Host
+	{ hostName :: HostName
+	, hostProperties :: [ChildProperty]
+	, hostInfo :: Info
+	}
+	deriving (Show, Typeable)
+
+-- | Propellor's monad provides read-only access to info about the host
+-- it's running on, and a writer to accumulate EndActions.
+newtype Propellor p = Propellor { runWithHost :: RWST Host [EndAction] () IO p }
+	deriving
+		( Monad
+		, Functor
+		, Applicative
+		, MonadReader Host
+		, MonadWriter [EndAction]
+		, MonadIO
+		, MonadCatch
+		, MonadThrow
+		, MonadMask
+		)
+
+class LiftPropellor m where
+	liftPropellor :: m a -> Propellor a
+
+instance LiftPropellor Propellor where
+	liftPropellor = id
+
+instance LiftPropellor IO where
+	liftPropellor = liftIO
+
+instance Monoid (Propellor Result) where
+	mempty = return NoChange
+	-- | The second action is only run if the first action does not fail.
+	mappend x y = do
+		rx <- x
+		case rx of
+			FailedChange -> return FailedChange
+			_ -> do
+				ry <- y
+				return (rx <> ry)
+
+-- | An action that Propellor runs at the end, after trying to satisfy all
+-- properties. It's passed the combined Result of the entire Propellor run.
+data EndAction = EndAction Desc (Result -> Propellor Result)
+
+type Desc = String
+
+-- | Props is a combination of a list of properties, with their combined 
+-- metatypes.
+data Props metatypes = Props [ChildProperty]
+
+-- | Since there are many different types of Properties, they cannot be put
+-- into a list. The simplified ChildProperty can be put into a list.
+data ChildProperty = ChildProperty Desc (Propellor Result) Info [ChildProperty]
+  
+instance Show ChildProperty where
+	show = getDesc
+
+class IsProp p where
+	setDesc :: p -> Desc -> p
+	getDesc :: p -> Desc
+	getChildren :: p -> [ChildProperty]
+	addChildren :: p -> [ChildProperty] -> p
+	-- | Gets the info of the property, combined with all info
+	-- of all children properties.
+	getInfoRecursive :: p -> Info
+	-- | Info, not including info from children.
+	getInfo :: p -> Info
+	-- | Gets a ChildProperty representing the Property.
+	-- You should not normally need to use this.
+	toChildProperty :: p -> ChildProperty
+	-- | Gets the action that can be run to satisfy a Property.
+	-- You should never run this action directly. Use
+	-- 'Propellor.EnsureProperty.ensureProperty` instead.
+	getSatisfy :: p -> Propellor Result
+
+instance IsProp ChildProperty where
+	setDesc (ChildProperty _ a i c) d = ChildProperty d a i c
+	getDesc (ChildProperty d _ _ _) = d
+	getChildren (ChildProperty _ _ _ c) = c
+	addChildren (ChildProperty d a i c) c' = ChildProperty d a i (c ++ c')
+	getInfoRecursive (ChildProperty _ _ i c) =
+		i <> mconcat (map getInfoRecursive c)
+	getInfo (ChildProperty _ _ i _) = i
+	toChildProperty = id
+	getSatisfy (ChildProperty _ a _ _) = a
diff --git a/src/Propellor/Types/Info.hs b/src/Propellor/Types/Info.hs
index c7f6b82f..2e188ae5 100644
--- a/src/Propellor/Types/Info.hs
+++ b/src/Propellor/Types/Info.hs
@@ -19,6 +19,9 @@ import Data.Monoid
 import Prelude
 
 -- | Information about a Host, which can be provided by its properties.
+--
+-- Many different types of data can be contained in the same Info value
+-- at the same time. See `toInfo` and `fromInfo`.
 newtype Info = Info [InfoEntry]
 	deriving (Monoid, Show)
 
@@ -47,6 +50,8 @@ class (Typeable v, Monoid v, Show v) => IsInfo v where
 addInfo :: IsInfo v => Info -> v -> Info
 addInfo (Info l) v = Info (InfoEntry v:l)
 
+-- | Converts any value in the `IsInfo` type class into an Info,
+-- which is otherwise empty.
 toInfo :: IsInfo v => v -> Info
 toInfo = addInfo mempty
 
-- 
cgit v1.3-2-g0d8e