summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--debian/changelog6
-rw-r--r--src/Propellor/Property.hs47
-rw-r--r--src/Propellor/Property/Network.hs39
3 files changed, 75 insertions, 17 deletions
diff --git a/debian/changelog b/debian/changelog
index 323394f9..ead6585e 100644
--- a/debian/changelog
+++ b/debian/changelog
@@ -23,6 +23,12 @@ propellor (3.0.0) UNRELEASED; urgency=medium
of `ensureProperty` for an example, but basically, change
this: foo = property desc $ ... ensureProperty bar
to this: foo = property' desc $ \o -> ... ensureProperty o bar
+ - General purpose properties like cmdProperty have type "Property UnixLike".
+ When using that to run a command only available on Debian, you can
+ tighten the targets to only the OS that your more specific
+ property works on. For example:
+ upgraded :: Property Debian
+ upgraded = tightenTargets (cmdProperty "apt-get" ["upgrade"])
- The new `pickOS` property combinator can be used to combine different
properties, supporting different OS's, into one Property that chooses
what to do based on the Host's OS.
diff --git a/src/Propellor/Property.hs b/src/Propellor/Property.hs
index 27d17135..cab233d0 100644
--- a/src/Propellor/Property.hs
+++ b/src/Propellor/Property.hs
@@ -1,5 +1,8 @@
{-# LANGUAGE PackageImports #-}
{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE PolyKinds #-}
module Propellor.Property (
-- * Property combinators
@@ -20,6 +23,7 @@ module Propellor.Property (
, property
, property'
, ensureProperty
+ , tightenTargets
--, withOS
, unsupportedOS
, makeChange
@@ -240,6 +244,49 @@ isNewerThan x y = do
where
mtime f = catchMaybeIO $ modificationTimeHiRes <$> getFileStatus f
+-- | Tightens the MetaType list of a Property, to contain fewer targets.
+--
+-- Anything else in the MetaType list is passed through unchanged.
+--
+-- For example, to make a property that uses apt-get, which is only
+-- available on DebianLike systems:
+--
+-- > upgraded :: Property DebianLike
+-- > upgraded = tightenTargets $ cmdProperty "apt-get" ["upgrade"]
+tightenTargets
+ ::
+ -- Note that this uses PolyKinds
+ ( (Targets old `NotSuperset` Targets new) ~ CanCombineTargets
+ , (NonTargets new `NotSuperset` NonTargets old) ~ CanCombineTargets
+ , SingI new
+ )
+ => Property (Sing old)
+ -> Property (Sing new)
+tightenTargets (Property old d a i c) = Property sing d a i c
+
+{-
+
+-- | Picks one of the two input properties to use,
+-- depending on the targeted OS.
+--
+-- If both input properties support the targeted OS, then the
+-- first will be used.
+pickOS
+ ::
+ ( combined ~ Union a b
+ , SingI combined
+ )
+ => Property (Sing a)
+ -> Property (Sing b)
+ -> Property (Sing combined)
+pickOS a@(Property ta ioa) b@(Property tb iob) = Property sing io
+ where
+ -- TODO pick with of ioa or iob to use based on final OS of
+ -- system being run on.
+ io = undefined
+
+-}
+
-- | Makes a property that is satisfied differently depending on the host's
-- operating system.
--
diff --git a/src/Propellor/Property/Network.hs b/src/Propellor/Property/Network.hs
index 382f5d9d..46f5cef3 100644
--- a/src/Propellor/Property/Network.hs
+++ b/src/Propellor/Property/Network.hs
@@ -2,13 +2,14 @@ module Propellor.Property.Network where
import Propellor.Base
import Propellor.Property.File
+import Propellor.Types.MetaTypes
import Data.Char
type Interface = String
-ifUp :: Interface -> Property NoInfo
-ifUp iface = cmdProperty "ifup" [iface]
+ifUp :: Interface -> Property DebianLike
+ifUp iface = tightenTargets $ cmdProperty "ifup" [iface]
`assume` MadeChange
-- | Resets /etc/network/interfaces to a clean and empty state,
@@ -18,8 +19,8 @@ ifUp iface = cmdProperty "ifup" [iface]
-- This can be used as a starting point to defining other interfaces.
--
-- No interfaces are brought up or down by this property.
-cleanInterfacesFile :: Property NoInfo
-cleanInterfacesFile = hasContent interfacesFile
+cleanInterfacesFile :: Property DebianLike
+cleanInterfacesFile = tightenTargets $ hasContent interfacesFile
[ "# Deployed by propellor, do not edit."
, ""
, "source-directory interfaces.d"
@@ -31,8 +32,8 @@ cleanInterfacesFile = hasContent interfacesFile
`describe` ("clean " ++ interfacesFile)
-- | Configures an interface to get its address via dhcp.
-dhcp :: Interface -> Property NoInfo
-dhcp iface = hasContent (interfaceDFile iface)
+dhcp :: Interface -> Property DebianLike
+dhcp iface = tightenTargets $ hasContent (interfaceDFile iface)
[ "auto " ++ iface
, "iface " ++ iface ++ " inet dhcp"
]
@@ -50,18 +51,20 @@ dhcp iface = hasContent (interfaceDFile iface)
--
-- (ipv6 addresses are not included because it's assumed they come up
-- automatically in most situations.)
-static :: Interface -> Property NoInfo
-static iface = check (not <$> doesFileExist f) setup
- `describe` desc
- `requires` interfacesDEnabled
+static :: Interface -> Property DebianLike
+static iface = tightenTargets $
+ check (not <$> doesFileExist f) setup
+ `describe` desc
+ `requires` interfacesDEnabled
where
f = interfaceDFile iface
desc = "static " ++ iface
- setup = property desc $ do
+ setup :: Property DebianLike
+ setup = property' desc $ \o -> do
ls <- liftIO $ lines <$> readProcess "ip"
["-o", "addr", "show", iface, "scope", "global"]
stanzas <- liftIO $ concat <$> mapM mkstanza ls
- ensureProperty $ hasContent f $ ("auto " ++ iface) : stanzas
+ ensureProperty o $ hasContent f $ ("auto " ++ iface) : stanzas
mkstanza ipline = case words ipline of
-- Note that the IP address is written CIDR style, so
-- the netmask does not need to be specified separately.
@@ -81,8 +84,8 @@ static iface = check (not <$> doesFileExist f) setup
_ -> Nothing
-- | 6to4 ipv6 connection, should work anywhere
-ipv6to4 :: Property NoInfo
-ipv6to4 = hasContent (interfaceDFile "sit0")
+ipv6to4 :: Property DebianLike
+ipv6to4 = tightenTargets $ hasContent (interfaceDFile "sit0")
[ "# Deployed by propellor, do not edit."
, "iface sit0 inet6 static"
, "\taddress 2002:5044:5531::1"
@@ -107,6 +110,8 @@ escapeInterfaceDName :: Interface -> FilePath
escapeInterfaceDName = filter (\c -> isAscii c && (isAlphaNum c || c `elem` "_-"))
-- | Ensures that files in the the interfaces.d directory are used.
-interfacesDEnabled :: Property NoInfo
-interfacesDEnabled = containsLine interfacesFile "source-directory interfaces.d"
- `describe` "interfaces.d directory enabled"
+-- interfacesDEnabled :: Property DebianLike
+interfacesDEnabled :: Property DebianLike
+interfacesDEnabled = tightenTargets $
+ containsLine interfacesFile "source-directory interfaces.d"
+ `describe` "interfaces.d directory enabled"