summaryrefslogtreecommitdiff
path: root/src/Propellor/Info.hs
diff options
context:
space:
mode:
authorJoey Hess2016-03-28 05:53:38 -0400
committerJoey Hess2016-03-28 05:55:48 -0400
commita1655d24bbb1db9caccdf93eae8110d746389ae2 (patch)
tree66b6890d852c19daec2306920fecf9108e055273 /src/Propellor/Info.hs
parentebf30061d8f8a251330070e69c2710fe4a8fd9da (diff)
type safe targets for properties
* Property types have been improved to indicate what systems they target. This prevents using eg, Property FreeBSD on a Debian system. Transition guide for this sweeping API change: - Change "host name & foo & bar" to "host name $ props & foo & bar" - Similarly, `propertyList` and `combineProperties` need `props` to be used to combine together properties; they no longer accept lists of properties. (If you have such a list, use `toProps`.) - And similarly, Chroot, Docker, and Systemd container need `props` to be used to combine together the properies used inside them. - The `os` property is removed. Instead use `osDebian`, `osBuntish`, or `osFreeBSD`. These tell the type checker the target OS of a host. - Change "Property NoInfo" to "Property UnixLike" - Change "Property HasInfo" to "Property (HasInfo + UnixLike)" - Change "RevertableProperty NoInfo" to "RevertableProperty UnixLike UnixLike" - Change "RevertableProperty HasInfo" to "RevertableProperty (HasInfo + UnixLike) UnixLike" - GHC needs {-# LANGUAGE TypeOperators #-} to use these fancy types. This is enabled by default for all modules in propellor.cabal. But if you are using propellor as a library, you may need to enable it manually. - If you know a property only works on a particular OS, like Debian or FreeBSD, use that instead of "UnixLike". For example: "Property Debian" - It's also possible make a property support a set of OS's, for example: "Property (Debian + FreeBSD)" - Removed `infoProperty` and `simpleProperty` constructors, instead use `property` to construct a Property. - Due to the polymorphic type returned by `property`, additional type signatures tend to be needed when using it. For example, this will fail to type check, because the type checker cannot guess what type you intend the intermediate property "go" to have: foo :: Property UnixLike foo = go `requires` bar where go = property "foo" (return NoChange) To fix, specify the type of go: go :: Property UnixLike - `ensureProperty` now needs to be passed a witness to the type of the property it's used in. change this: foo = property desc $ ... ensureProperty bar to this: foo = property' desc $ \w -> ... ensureProperty w 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 type to only the OS that your more specific property works on. For example: upgraded :: Property Debian upgraded = tightenTargets (cmdProperty "apt-get" ["upgrade"]) - Several utility functions have been renamed: getInfo to fromInfo propertyInfo to getInfo propertyDesc to getDesc propertyChildren to getChildren * The new `pickOS` property combinator can be used to combine different properties, supporting different OS's, into one Property that chooses which to use based on the Host's OS. * Re-enabled -O0 in propellor.cabal to reign in ghc's memory use handling these complex new types. * Added dependency on concurrent-output; removed embedded copy.
Diffstat (limited to 'src/Propellor/Info.hs')
-rw-r--r--src/Propellor/Info.hs108
1 files changed, 86 insertions, 22 deletions
diff --git a/src/Propellor/Info.hs b/src/Propellor/Info.hs
index 7eb7d4a8..b87369c3 100644
--- a/src/Propellor/Info.hs
+++ b/src/Propellor/Info.hs
@@ -1,9 +1,30 @@
-{-# LANGUAGE PackageImports #-}
-
-module Propellor.Info where
+{-# LANGUAGE PackageImports, TypeFamilies, DataKinds, PolyKinds #-}
+
+module Propellor.Info (
+ osDebian,
+ osBuntish,
+ osFreeBSD,
+ setInfoProperty,
+ addInfoProperty,
+ pureInfoProperty,
+ pureInfoProperty',
+ askInfo,
+ getOS,
+ ipv4,
+ ipv6,
+ alias,
+ addDNS,
+ hostMap,
+ aliasMap,
+ findHost,
+ findHostNoAlias,
+ getAddresses,
+ hostAddresses,
+) where
import Propellor.Types
import Propellor.Types.Info
+import Propellor.Types.MetaTypes
import "mtl" Control.Monad.Reader
import qualified Data.Set as S
@@ -13,21 +34,67 @@ import Data.Monoid
import Control.Applicative
import Prelude
-pureInfoProperty :: (IsInfo v) => Desc -> v -> Property HasInfo
-pureInfoProperty desc v = pureInfoProperty' desc (addInfo mempty v)
-
-pureInfoProperty' :: Desc -> Info -> Property HasInfo
-pureInfoProperty' desc i = infoProperty ("has " ++ desc) (return NoChange) i mempty
+-- | 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 = setInfoProperty p i
+ where
+ p :: Property UnixLike
+ p = property ("has " ++ desc) (return NoChange)
-- | Gets a value from the host's Info.
askInfo :: (IsInfo v) => Propellor v
-askInfo = asks (getInfo . hostInfo)
+askInfo = asks (fromInfo . hostInfo)
+
+-- | Specifies that a host's operating system is Debian,
+-- and further indicates the suite and architecture.
+--
+-- This provides info for other Properties, so they can act
+-- conditionally on the details of the OS.
+--
+-- It also lets the type checker know that all the properties of the
+-- host must support Debian.
+--
+-- > & osDebian (Stable "jessie") "amd64"
+osDebian :: DebianSuite -> Architecture -> Property (HasInfo + Debian)
+osDebian suite arch = tightenTargets $ os (System (Debian suite) arch)
--- | Specifies the operating system of a host.
+-- | Specifies that a host's operating system is a well-known Debian
+-- derivative founded by a space tourist.
--
--- This only provides info for other Properties, so they can act
--- conditionally on the os.
-os :: System -> Property HasInfo
+-- (The actual name of this distribution is not used in Propellor per
+-- <http://joeyh.name/blog/entry/trademark_nonsense/>)
+osBuntish :: Release -> Architecture -> Property (HasInfo + Buntish)
+osBuntish release arch = tightenTargets $ os (System (Buntish release) arch)
+
+-- | Specifies that a host's operating system is FreeBSD
+-- and further indicates the release and architecture.
+osFreeBSD :: FreeBSDRelease -> Architecture -> Property (HasInfo + FreeBSD)
+osFreeBSD release arch = tightenTargets $ os (System (FreeBSD release) arch)
+
+os :: System -> Property (HasInfo + UnixLike)
os system = pureInfoProperty ("Operating " ++ show system) (InfoVal system)
-- Gets the operating system of a host, if it has been specified.
@@ -43,11 +110,11 @@ getOS = fromInfoVal <$> askInfo
-- When propellor --spin is used to deploy a host, it checks
-- if the host's IP Property matches the DNS. If the DNS is missing or
-- out of date, the host will instead be contacted directly by IP address.
-ipv4 :: String -> Property HasInfo
+ipv4 :: String -> Property (HasInfo + UnixLike)
ipv4 = addDNS . Address . IPv4
-- | Indicate that a host has an AAAA record in the DNS.
-ipv6 :: String -> Property HasInfo
+ipv6 :: String -> Property (HasInfo + UnixLike)
ipv6 = addDNS . Address . IPv6
-- | Indicates another name for the host in the DNS.
@@ -56,14 +123,14 @@ ipv6 = addDNS . Address . IPv6
-- to use their address, rather than using a CNAME. This avoids various
-- problems with CNAMEs, and also means that when multiple hosts have the
-- same alias, a DNS round-robin is automatically set up.
-alias :: Domain -> Property HasInfo
+alias :: Domain -> Property (HasInfo + UnixLike)
alias d = pureInfoProperty' ("alias " ++ d) $ mempty
`addInfo` toAliasesInfo [d]
-- A CNAME is added here, but the DNS setup code converts it to an
-- IP address when that makes sense.
`addInfo` (toDnsInfo $ S.singleton $ CNAME $ AbsDomain d)
-addDNS :: Record -> Property HasInfo
+addDNS :: Record -> Property (HasInfo + UnixLike)
addDNS r = pureInfoProperty (rdesc r) (toDnsInfo (S.singleton r))
where
rdesc (CNAME d) = unwords ["alias", ddesc d]
@@ -86,7 +153,7 @@ hostMap l = M.fromList $ zip (map hostName l) l
aliasMap :: [Host] -> M.Map HostName Host
aliasMap = M.fromList . concat .
- map (\h -> map (\aka -> (aka, h)) $ fromAliasesInfo $ getInfo $ hostInfo h)
+ map (\h -> map (\aka -> (aka, h)) $ fromAliasesInfo $ fromInfo $ hostInfo h)
findHost :: [Host] -> HostName -> Maybe Host
findHost l hn = (findHostNoAlias l hn) <|> (findAlias l hn)
@@ -98,10 +165,7 @@ findAlias :: [Host] -> HostName -> Maybe Host
findAlias l hn = M.lookup hn (aliasMap l)
getAddresses :: Info -> [IPAddr]
-getAddresses = mapMaybe getIPAddr . S.toList . fromDnsInfo . getInfo
+getAddresses = mapMaybe getIPAddr . S.toList . fromDnsInfo . fromInfo
hostAddresses :: HostName -> [Host] -> [IPAddr]
hostAddresses hn hosts = maybe [] (getAddresses . hostInfo) (findHost hosts hn)
-
-addHostInfo ::IsInfo v => Host -> v -> Host
-addHostInfo h v = h { hostInfo = addInfo (hostInfo h) v }