summaryrefslogtreecommitdiff
path: root/src/Propellor/Property
diff options
context:
space:
mode:
authorJoey Hess2016-03-26 17:33:43 -0400
committerJoey Hess2016-03-26 17:33:43 -0400
commitc85c462c617fe31c3fe8c97d85db4bcae838a8b2 (patch)
treeee4bba7bfafcec2e0cff92597d2e7b86db8f7ad0 /src/Propellor/Property
parente4ac94860bcc4511370e878e14ef9d45b60aeb2a (diff)
more ported
Diffstat (limited to 'src/Propellor/Property')
-rw-r--r--src/Propellor/Property/FreeBSD/Poudriere.hs21
-rw-r--r--src/Propellor/Property/HostingProvider/DigitalOcean.hs11
-rw-r--r--src/Propellor/Property/HostingProvider/Linode.hs9
-rw-r--r--src/Propellor/Property/Postfix.hs35
-rw-r--r--src/Propellor/Property/PropellorRepo.hs2
-rw-r--r--src/Propellor/Property/Prosody.hs12
-rw-r--r--src/Propellor/Property/SiteSpecific/GitHome.hs11
-rw-r--r--src/Propellor/Property/Sudo.hs9
-rw-r--r--src/Propellor/Property/Tor.hs44
-rw-r--r--src/Propellor/Property/Unbound.hs8
-rw-r--r--src/Propellor/Property/Uwsgi.hs12
-rw-r--r--src/Propellor/Property/ZFS/Properties.hs12
12 files changed, 99 insertions, 87 deletions
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