Attr is renamed to Info.
This commit is contained in:
parent
582be8ebe0
commit
fc49d75e4f
|
@ -3,6 +3,7 @@ propellor (0.7.0) UNRELEASED; urgency=medium
|
||||||
* combineProperties no longer stops when a property fails; now it continues
|
* combineProperties no longer stops when a property fails; now it continues
|
||||||
trying to satisfy all properties on the list before propigating the
|
trying to satisfy all properties on the list before propigating the
|
||||||
failure.
|
failure.
|
||||||
|
* Attr is renamed to Info.
|
||||||
|
|
||||||
-- Joey Hess <joeyh@debian.org> Sat, 07 Jun 2014 00:12:44 -0400
|
-- Joey Hess <joeyh@debian.org> Sat, 07 Jun 2014 00:12:44 -0400
|
||||||
|
|
||||||
|
|
|
@ -1,5 +1,5 @@
|
||||||
* Should be possible to generate a metapackage of all packages that
|
* Should be possible to generate a metapackage of all packages that
|
||||||
properties direct apt to install. Then any other packages can be
|
properties direct apt to install. Then any other packages can be
|
||||||
auto-removed. This would just be a matter of storing the apt-installed
|
auto-removed. This would just be a matter of storing the apt-installed
|
||||||
packages in an Attr. Although not removing essential and base packages
|
packages in to Info or somewhere. Although not removing essential and base packages
|
||||||
could be problimatic.
|
could be problimatic.
|
||||||
|
|
|
@ -1,7 +0,0 @@
|
||||||
* Either `Ssh.hostKey` should set the sshPubKey attr
|
|
||||||
(which seems hard, as attrs need to be able to be calculated without
|
|
||||||
running any IO code, and here IO is needed along with decrypting the
|
|
||||||
PrivData..), or the public key should not be stored in
|
|
||||||
the PrivData, and instead configured using the attr.
|
|
||||||
Getting the ssh host key into the attr will allow automatically
|
|
||||||
exporting it via DNS (SSHFP record)
|
|
|
@ -0,0 +1,7 @@
|
||||||
|
* Either `Ssh.hostKey` should set the sshPubKey info
|
||||||
|
(which seems hard, as info needs to be able to be calculated without
|
||||||
|
running any IO code, and here IO is needed along with decrypting the
|
||||||
|
PrivData..), or the public key should not be stored in
|
||||||
|
the PrivData, and instead configured using the info.
|
||||||
|
Getting the ssh host key into the info will allow automatically
|
||||||
|
exporting it via DNS (SSHFP record)
|
|
@ -97,7 +97,7 @@ Library
|
||||||
Propellor.Property.SiteSpecific.GitHome
|
Propellor.Property.SiteSpecific.GitHome
|
||||||
Propellor.Property.SiteSpecific.JoeySites
|
Propellor.Property.SiteSpecific.JoeySites
|
||||||
Propellor.Property.SiteSpecific.GitAnnexBuilder
|
Propellor.Property.SiteSpecific.GitAnnexBuilder
|
||||||
Propellor.Attr
|
Propellor.Info
|
||||||
Propellor.Message
|
Propellor.Message
|
||||||
Propellor.PrivData
|
Propellor.PrivData
|
||||||
Propellor.Engine
|
Propellor.Engine
|
||||||
|
@ -106,7 +106,7 @@ Library
|
||||||
Propellor.Types.OS
|
Propellor.Types.OS
|
||||||
Propellor.Types.Dns
|
Propellor.Types.Dns
|
||||||
Other-Modules:
|
Other-Modules:
|
||||||
Propellor.Types.Attr
|
Propellor.Types.Info
|
||||||
Propellor.CmdLine
|
Propellor.CmdLine
|
||||||
Propellor.SimpleSh
|
Propellor.SimpleSh
|
||||||
Propellor.Property.Docker.Shim
|
Propellor.Property.Docker.Shim
|
||||||
|
|
|
@ -33,7 +33,7 @@ module Propellor (
|
||||||
module Propellor.Types
|
module Propellor.Types
|
||||||
, module Propellor.Property
|
, module Propellor.Property
|
||||||
, module Propellor.Property.Cmd
|
, module Propellor.Property.Cmd
|
||||||
, module Propellor.Attr
|
, module Propellor.Info
|
||||||
, module Propellor.PrivData
|
, module Propellor.PrivData
|
||||||
, module Propellor.Engine
|
, module Propellor.Engine
|
||||||
, module Propellor.Exception
|
, module Propellor.Exception
|
||||||
|
@ -50,7 +50,7 @@ import Propellor.Property.Cmd
|
||||||
import Propellor.PrivData
|
import Propellor.PrivData
|
||||||
import Propellor.Message
|
import Propellor.Message
|
||||||
import Propellor.Exception
|
import Propellor.Exception
|
||||||
import Propellor.Attr
|
import Propellor.Info
|
||||||
|
|
||||||
import Utility.PartialPrelude as X
|
import Utility.PartialPrelude as X
|
||||||
import Utility.Process as X
|
import Utility.Process as X
|
||||||
|
|
|
@ -12,7 +12,7 @@ import "mtl" Control.Monad.Reader
|
||||||
import Propellor.Types
|
import Propellor.Types
|
||||||
import Propellor.Message
|
import Propellor.Message
|
||||||
import Propellor.Exception
|
import Propellor.Exception
|
||||||
import Propellor.Attr
|
import Propellor.Info
|
||||||
|
|
||||||
runPropellor :: Host -> Propellor a -> IO a
|
runPropellor :: Host -> Propellor a -> IO a
|
||||||
runPropellor host a = runReaderT (runWithHost a) host
|
runPropellor host a = runReaderT (runWithHost a) host
|
||||||
|
|
|
@ -1,9 +1,9 @@
|
||||||
{-# LANGUAGE PackageImports #-}
|
{-# LANGUAGE PackageImports #-}
|
||||||
|
|
||||||
module Propellor.Attr where
|
module Propellor.Info where
|
||||||
|
|
||||||
import Propellor.Types
|
import Propellor.Types
|
||||||
import Propellor.Types.Attr
|
import Propellor.Types.Info
|
||||||
|
|
||||||
import "mtl" Control.Monad.Reader
|
import "mtl" Control.Monad.Reader
|
||||||
import qualified Data.Set as S
|
import qualified Data.Set as S
|
||||||
|
@ -12,18 +12,18 @@ import Data.Maybe
|
||||||
import Data.Monoid
|
import Data.Monoid
|
||||||
import Control.Applicative
|
import Control.Applicative
|
||||||
|
|
||||||
pureAttrProperty :: Desc -> Attr -> Property
|
pureInfoProperty :: Desc -> Info -> Property
|
||||||
pureAttrProperty desc = Property ("has " ++ desc) (return NoChange)
|
pureInfoProperty desc = Property ("has " ++ desc) (return NoChange)
|
||||||
|
|
||||||
askAttr :: (Attr -> Val a) -> Propellor (Maybe a)
|
askInfo :: (Info -> Val a) -> Propellor (Maybe a)
|
||||||
askAttr f = asks (fromVal . f . hostAttr)
|
askInfo f = asks (fromVal . f . hostInfo)
|
||||||
|
|
||||||
os :: System -> Property
|
os :: System -> Property
|
||||||
os system = pureAttrProperty ("Operating " ++ show system) $
|
os system = pureInfoProperty ("Operating " ++ show system) $
|
||||||
mempty { _os = Val system }
|
mempty { _os = Val system }
|
||||||
|
|
||||||
getOS :: Propellor (Maybe System)
|
getOS :: Propellor (Maybe System)
|
||||||
getOS = askAttr _os
|
getOS = askInfo _os
|
||||||
|
|
||||||
-- | Indidate that a host has an A record in the DNS.
|
-- | Indidate that a host has an A record in the DNS.
|
||||||
--
|
--
|
||||||
|
@ -46,7 +46,7 @@ alias :: Domain -> Property
|
||||||
alias = addDNS . CNAME . AbsDomain
|
alias = addDNS . CNAME . AbsDomain
|
||||||
|
|
||||||
addDNS :: Record -> Property
|
addDNS :: Record -> Property
|
||||||
addDNS r = pureAttrProperty (rdesc r) $
|
addDNS r = pureInfoProperty (rdesc r) $
|
||||||
mempty { _dns = S.singleton r }
|
mempty { _dns = S.singleton r }
|
||||||
where
|
where
|
||||||
rdesc (CNAME d) = unwords ["alias", ddesc d]
|
rdesc (CNAME d) = unwords ["alias", ddesc d]
|
||||||
|
@ -62,11 +62,11 @@ addDNS r = pureAttrProperty (rdesc r) $
|
||||||
ddesc RootDomain = "@"
|
ddesc RootDomain = "@"
|
||||||
|
|
||||||
sshPubKey :: String -> Property
|
sshPubKey :: String -> Property
|
||||||
sshPubKey k = pureAttrProperty ("ssh pubkey known") $
|
sshPubKey k = pureInfoProperty ("ssh pubkey known") $
|
||||||
mempty { _sshPubKey = Val k }
|
mempty { _sshPubKey = Val k }
|
||||||
|
|
||||||
getSshPubKey :: Propellor (Maybe String)
|
getSshPubKey :: Propellor (Maybe String)
|
||||||
getSshPubKey = askAttr _sshPubKey
|
getSshPubKey = askInfo _sshPubKey
|
||||||
|
|
||||||
hostMap :: [Host] -> M.Map HostName Host
|
hostMap :: [Host] -> M.Map HostName Host
|
||||||
hostMap l = M.fromList $ zip (map hostName l) l
|
hostMap l = M.fromList $ zip (map hostName l) l
|
||||||
|
@ -74,10 +74,10 @@ hostMap l = M.fromList $ zip (map hostName l) l
|
||||||
findHost :: [Host] -> HostName -> Maybe Host
|
findHost :: [Host] -> HostName -> Maybe Host
|
||||||
findHost l hn = M.lookup hn (hostMap l)
|
findHost l hn = M.lookup hn (hostMap l)
|
||||||
|
|
||||||
getAddresses :: Attr -> [IPAddr]
|
getAddresses :: Info -> [IPAddr]
|
||||||
getAddresses = mapMaybe getIPAddr . S.toList . _dns
|
getAddresses = mapMaybe getIPAddr . S.toList . _dns
|
||||||
|
|
||||||
hostAddresses :: HostName -> [Host] -> [IPAddr]
|
hostAddresses :: HostName -> [Host] -> [IPAddr]
|
||||||
hostAddresses hn hosts = case hostAttr <$> findHost hosts hn of
|
hostAddresses hn hosts = case hostInfo <$> findHost hosts hn of
|
||||||
Nothing -> []
|
Nothing -> []
|
||||||
Just attr -> mapMaybe getIPAddr $ S.toList $ _dns attr
|
Just info -> mapMaybe getIPAddr $ S.toList $ _dns info
|
|
@ -9,7 +9,7 @@ import Control.Monad.IfElse
|
||||||
import "mtl" Control.Monad.Reader
|
import "mtl" Control.Monad.Reader
|
||||||
|
|
||||||
import Propellor.Types
|
import Propellor.Types
|
||||||
import Propellor.Attr
|
import Propellor.Info
|
||||||
import Propellor.Engine
|
import Propellor.Engine
|
||||||
import Utility.Monad
|
import Utility.Monad
|
||||||
import System.FilePath
|
import System.FilePath
|
||||||
|
@ -23,13 +23,13 @@ property d s = Property d s mempty
|
||||||
-- and print out the description of each as it's run. Does not stop
|
-- and print out the description of each as it's run. Does not stop
|
||||||
-- on failure; does propigate overall success/failure.
|
-- on failure; does propigate overall success/failure.
|
||||||
propertyList :: Desc -> [Property] -> Property
|
propertyList :: Desc -> [Property] -> Property
|
||||||
propertyList desc ps = Property desc (ensureProperties ps) (combineAttrs ps)
|
propertyList desc ps = Property desc (ensureProperties ps) (combineInfos ps)
|
||||||
|
|
||||||
-- | Combines a list of properties, resulting in one property that
|
-- | Combines a list of properties, resulting in one property that
|
||||||
-- ensures each in turn. Does not stop on failure; does propigate
|
-- ensures each in turn. Does not stop on failure; does propigate
|
||||||
-- overall success/failure.
|
-- overall success/failure.
|
||||||
combineProperties :: Desc -> [Property] -> Property
|
combineProperties :: Desc -> [Property] -> Property
|
||||||
combineProperties desc ps = Property desc (go ps NoChange) (combineAttrs ps)
|
combineProperties desc ps = Property desc (go ps NoChange) (combineInfos ps)
|
||||||
where
|
where
|
||||||
go [] rs = return rs
|
go [] rs = return rs
|
||||||
go (l:ls) rs = do
|
go (l:ls) rs = do
|
||||||
|
@ -68,7 +68,7 @@ flagFile' p getflagfile = adjustProperty p $ \satisfy -> do
|
||||||
--- | Whenever a change has to be made for a Property, causes a hook
|
--- | Whenever a change has to be made for a Property, causes a hook
|
||||||
-- Property to also be run, but not otherwise.
|
-- Property to also be run, but not otherwise.
|
||||||
onChange :: Property -> Property -> Property
|
onChange :: Property -> Property -> Property
|
||||||
p `onChange` hook = Property (propertyDesc p) satisfy (combineAttr p hook)
|
p `onChange` hook = Property (propertyDesc p) satisfy (combineInfo p hook)
|
||||||
where
|
where
|
||||||
satisfy = do
|
satisfy = do
|
||||||
r <- ensureProperty p
|
r <- ensureProperty p
|
||||||
|
@ -135,7 +135,7 @@ host hn = Host hn [] mempty
|
||||||
--
|
--
|
||||||
-- Can add Properties and RevertableProperties
|
-- Can add Properties and RevertableProperties
|
||||||
(&) :: IsProp p => Host -> p -> Host
|
(&) :: IsProp p => Host -> p -> Host
|
||||||
(Host hn ps as) & p = Host hn (ps ++ [toProp p]) (as <> getAttr p)
|
(Host hn ps as) & p = Host hn (ps ++ [toProp p]) (as <> getInfo p)
|
||||||
|
|
||||||
infixl 1 &
|
infixl 1 &
|
||||||
|
|
||||||
|
@ -149,12 +149,12 @@ infixl 1 !
|
||||||
adjustProperty :: Property -> (Propellor Result -> Propellor Result) -> Property
|
adjustProperty :: Property -> (Propellor Result -> Propellor Result) -> Property
|
||||||
adjustProperty p f = p { propertySatisfy = f (propertySatisfy p) }
|
adjustProperty p f = p { propertySatisfy = f (propertySatisfy p) }
|
||||||
|
|
||||||
-- Combines the Attr of two properties.
|
-- Combines the Info of two properties.
|
||||||
combineAttr :: (IsProp p, IsProp q) => p -> q -> Attr
|
combineInfo :: (IsProp p, IsProp q) => p -> q -> Info
|
||||||
combineAttr p q = getAttr p <> getAttr q
|
combineInfo p q = getInfo p <> getInfo q
|
||||||
|
|
||||||
combineAttrs :: IsProp p => [p] -> Attr
|
combineInfos :: IsProp p => [p] -> Info
|
||||||
combineAttrs = mconcat . map getAttr
|
combineInfos = mconcat . map getInfo
|
||||||
|
|
||||||
makeChange :: IO () -> Propellor Result
|
makeChange :: IO () -> Propellor Result
|
||||||
makeChange a = liftIO a >> return MadeChange
|
makeChange a = liftIO a >> return MadeChange
|
||||||
|
|
|
@ -15,7 +15,7 @@ module Propellor.Property.Dns (
|
||||||
import Propellor
|
import Propellor
|
||||||
import Propellor.Types.Dns
|
import Propellor.Types.Dns
|
||||||
import Propellor.Property.File
|
import Propellor.Property.File
|
||||||
import Propellor.Types.Attr
|
import Propellor.Types.Info
|
||||||
import qualified Propellor.Property.Apt as Apt
|
import qualified Propellor.Property.Apt as Apt
|
||||||
import qualified Propellor.Property.Service as Service
|
import qualified Propellor.Property.Service as Service
|
||||||
import Utility.Applicative
|
import Utility.Applicative
|
||||||
|
@ -113,7 +113,7 @@ secondary hosts domain = secondaryFor (otherServers Master hosts domain) hosts d
|
||||||
secondaryFor :: [HostName] -> [Host] -> Domain -> RevertableProperty
|
secondaryFor :: [HostName] -> [Host] -> Domain -> RevertableProperty
|
||||||
secondaryFor masters hosts domain = RevertableProperty setup cleanup
|
secondaryFor masters hosts domain = RevertableProperty setup cleanup
|
||||||
where
|
where
|
||||||
setup = pureAttrProperty desc (addNamedConf conf)
|
setup = pureInfoProperty desc (addNamedConf conf)
|
||||||
`requires` servingZones
|
`requires` servingZones
|
||||||
cleanup = namedConfWritten
|
cleanup = namedConfWritten
|
||||||
|
|
||||||
|
@ -131,7 +131,7 @@ otherServers :: DnsServerType -> [Host] -> Domain -> [HostName]
|
||||||
otherServers wantedtype hosts domain =
|
otherServers wantedtype hosts domain =
|
||||||
M.keys $ M.filter wanted $ hostMap hosts
|
M.keys $ M.filter wanted $ hostMap hosts
|
||||||
where
|
where
|
||||||
wanted h = case M.lookup domain (fromNamedConfMap $ _namedconf $ hostAttr h) of
|
wanted h = case M.lookup domain (fromNamedConfMap $ _namedconf $ hostInfo h) of
|
||||||
Nothing -> False
|
Nothing -> False
|
||||||
Just conf -> confDnsServerType conf == wantedtype
|
Just conf -> confDnsServerType conf == wantedtype
|
||||||
&& confDomain conf == domain
|
&& confDomain conf == domain
|
||||||
|
@ -346,7 +346,7 @@ genZone hosts zdomain soa =
|
||||||
inzdomain = M.elems $ M.filterWithKey (\hn _ -> inDomain zdomain $ AbsDomain $ hn) m
|
inzdomain = M.elems $ M.filterWithKey (\hn _ -> inDomain zdomain $ AbsDomain $ hn) m
|
||||||
|
|
||||||
-- Each host with a hostname located in the zdomain
|
-- Each host with a hostname located in the zdomain
|
||||||
-- should have 1 or more IPAddrs in its Attr.
|
-- should have 1 or more IPAddrs in its Info.
|
||||||
--
|
--
|
||||||
-- If a host lacks any IPAddr, it's probably a misconfiguration,
|
-- If a host lacks any IPAddr, it's probably a misconfiguration,
|
||||||
-- so warn.
|
-- so warn.
|
||||||
|
@ -355,9 +355,9 @@ genZone hosts zdomain soa =
|
||||||
| null l = [Left $ "no IP address defined for host " ++ hostName h]
|
| null l = [Left $ "no IP address defined for host " ++ hostName h]
|
||||||
| otherwise = map Right l
|
| otherwise = map Right l
|
||||||
where
|
where
|
||||||
attr = hostAttr h
|
info = hostInfo h
|
||||||
l = zip (repeat $ AbsDomain $ hostName h)
|
l = zip (repeat $ AbsDomain $ hostName h)
|
||||||
(map Address $ getAddresses attr)
|
(map Address $ getAddresses info)
|
||||||
|
|
||||||
-- Any host, whether its hostname is in the zdomain or not,
|
-- Any host, whether its hostname is in the zdomain or not,
|
||||||
-- may have cnames which are in the zdomain. The cname may even be
|
-- may have cnames which are in the zdomain. The cname may even be
|
||||||
|
@ -373,10 +373,10 @@ genZone hosts zdomain soa =
|
||||||
-- So we can just use the IPAddrs.
|
-- So we can just use the IPAddrs.
|
||||||
addcnames :: Host -> [Either WarningMessage (BindDomain, Record)]
|
addcnames :: Host -> [Either WarningMessage (BindDomain, Record)]
|
||||||
addcnames h = concatMap gen $ filter (inDomain zdomain) $
|
addcnames h = concatMap gen $ filter (inDomain zdomain) $
|
||||||
mapMaybe getCNAME $ S.toList (_dns attr)
|
mapMaybe getCNAME $ S.toList (_dns info)
|
||||||
where
|
where
|
||||||
attr = hostAttr h
|
info = hostInfo h
|
||||||
gen c = case getAddresses attr of
|
gen c = case getAddresses info of
|
||||||
[] -> [ret (CNAME c)]
|
[] -> [ret (CNAME c)]
|
||||||
l -> map (ret . Address) l
|
l -> map (ret . Address) l
|
||||||
where
|
where
|
||||||
|
@ -386,9 +386,9 @@ genZone hosts zdomain soa =
|
||||||
hostrecords :: Host -> [Either WarningMessage (BindDomain, Record)]
|
hostrecords :: Host -> [Either WarningMessage (BindDomain, Record)]
|
||||||
hostrecords h = map Right l
|
hostrecords h = map Right l
|
||||||
where
|
where
|
||||||
attr = hostAttr h
|
info = hostInfo h
|
||||||
l = zip (repeat $ AbsDomain $ hostName h)
|
l = zip (repeat $ AbsDomain $ hostName h)
|
||||||
(S.toList $ S.filter (\r -> isNothing (getIPAddr r) && isNothing (getCNAME r)) (_dns attr))
|
(S.toList $ S.filter (\r -> isNothing (getIPAddr r) && isNothing (getCNAME r)) (_dns info))
|
||||||
|
|
||||||
-- Simplifies the list of hosts. Remove duplicate entries.
|
-- Simplifies the list of hosts. Remove duplicate entries.
|
||||||
-- Also, filter out any CHAMES where the same domain has an
|
-- Also, filter out any CHAMES where the same domain has an
|
||||||
|
@ -417,10 +417,10 @@ domainHost base (AbsDomain d)
|
||||||
where
|
where
|
||||||
dotbase = '.':base
|
dotbase = '.':base
|
||||||
|
|
||||||
addNamedConf :: NamedConf -> Attr
|
addNamedConf :: NamedConf -> Info
|
||||||
addNamedConf conf = mempty { _namedconf = NamedConfMap (M.singleton domain conf) }
|
addNamedConf conf = mempty { _namedconf = NamedConfMap (M.singleton domain conf) }
|
||||||
where
|
where
|
||||||
domain = confDomain conf
|
domain = confDomain conf
|
||||||
|
|
||||||
getNamedConf :: Propellor (M.Map Domain NamedConf)
|
getNamedConf :: Propellor (M.Map Domain NamedConf)
|
||||||
getNamedConf = asks $ fromNamedConfMap . _namedconf . hostAttr
|
getNamedConf = asks $ fromNamedConfMap . _namedconf . hostInfo
|
||||||
|
|
|
@ -35,7 +35,7 @@ module Propellor.Property.Docker (
|
||||||
|
|
||||||
import Propellor
|
import Propellor
|
||||||
import Propellor.SimpleSh
|
import Propellor.SimpleSh
|
||||||
import Propellor.Types.Attr
|
import Propellor.Types.Info
|
||||||
import qualified Propellor.Property.File as File
|
import qualified Propellor.Property.File as File
|
||||||
import qualified Propellor.Property.Apt as Apt
|
import qualified Propellor.Property.Apt as Apt
|
||||||
import qualified Propellor.Property.Docker.Shim as Shim
|
import qualified Propellor.Property.Docker.Shim as Shim
|
||||||
|
@ -72,9 +72,9 @@ type ContainerName = String
|
||||||
-- > & Apt.installed {"apache2"]
|
-- > & Apt.installed {"apache2"]
|
||||||
-- > & ...
|
-- > & ...
|
||||||
container :: ContainerName -> Image -> Host
|
container :: ContainerName -> Image -> Host
|
||||||
container cn image = Host hn [] attr
|
container cn image = Host hn [] info
|
||||||
where
|
where
|
||||||
attr = dockerAttr $ mempty { _dockerImage = Val image }
|
info = dockerInfo $ mempty { _dockerImage = Val image }
|
||||||
hn = cn2hn cn
|
hn = cn2hn cn
|
||||||
|
|
||||||
cn2hn :: ContainerName -> HostName
|
cn2hn :: ContainerName -> HostName
|
||||||
|
@ -86,8 +86,8 @@ cn2hn cn = cn ++ ".docker"
|
||||||
-- The container has its own Properties which are handled by running
|
-- The container has its own Properties which are handled by running
|
||||||
-- propellor inside the container.
|
-- propellor inside the container.
|
||||||
--
|
--
|
||||||
-- Additionally, the container can have DNS attributes, such as a CNAME.
|
-- Additionally, the container can have DNS info, such as a CNAME.
|
||||||
-- These become attributes of the host(s) it's docked in.
|
-- These become info of the host(s) it's docked in.
|
||||||
--
|
--
|
||||||
-- Reverting this property ensures that the container is stopped and
|
-- Reverting this property ensures that the container is stopped and
|
||||||
-- removed.
|
-- removed.
|
||||||
|
@ -96,7 +96,7 @@ docked
|
||||||
-> ContainerName
|
-> ContainerName
|
||||||
-> RevertableProperty
|
-> RevertableProperty
|
||||||
docked hosts cn = RevertableProperty
|
docked hosts cn = RevertableProperty
|
||||||
((maybe id exposeDnsAttrs mhost) (go "docked" setup))
|
((maybe id exposeDnsInfos mhost) (go "docked" setup))
|
||||||
(go "undocked" teardown)
|
(go "undocked" teardown)
|
||||||
where
|
where
|
||||||
go desc a = property (desc ++ " " ++ cn) $ do
|
go desc a = property (desc ++ " " ++ cn) $ do
|
||||||
|
@ -123,9 +123,9 @@ docked hosts cn = RevertableProperty
|
||||||
]
|
]
|
||||||
]
|
]
|
||||||
|
|
||||||
exposeDnsAttrs :: Host -> Property -> Property
|
exposeDnsInfos :: Host -> Property -> Property
|
||||||
exposeDnsAttrs (Host _ _ containerattr) p = combineProperties (propertyDesc p) $
|
exposeDnsInfos (Host _ _ containerinfo) p = combineProperties (propertyDesc p) $
|
||||||
p : map addDNS (S.toList $ _dns containerattr)
|
p : map addDNS (S.toList $ _dns containerinfo)
|
||||||
|
|
||||||
findContainer
|
findContainer
|
||||||
:: Maybe Host
|
:: Maybe Host
|
||||||
|
@ -144,10 +144,10 @@ findContainer mhost cid cn mk = case mhost of
|
||||||
|
|
||||||
mkContainer :: ContainerId -> Host -> Maybe Container
|
mkContainer :: ContainerId -> Host -> Maybe Container
|
||||||
mkContainer cid@(ContainerId hn _cn) h = Container
|
mkContainer cid@(ContainerId hn _cn) h = Container
|
||||||
<$> fromVal (_dockerImage attr)
|
<$> fromVal (_dockerImage info)
|
||||||
<*> pure (map (\a -> a hn) (_dockerRunParams attr))
|
<*> pure (map (\a -> a hn) (_dockerRunParams info))
|
||||||
where
|
where
|
||||||
attr = _dockerattr $ hostAttr h'
|
info = _dockerinfo $ hostInfo h'
|
||||||
h' = h
|
h' = h
|
||||||
-- expose propellor directory inside the container
|
-- expose propellor directory inside the container
|
||||||
& volume (localdir++":"++localdir)
|
& volume (localdir++":"++localdir)
|
||||||
|
@ -469,17 +469,17 @@ listImages :: IO [Image]
|
||||||
listImages = lines <$> readProcess dockercmd ["images", "--all", "--quiet"]
|
listImages = lines <$> readProcess dockercmd ["images", "--all", "--quiet"]
|
||||||
|
|
||||||
runProp :: String -> RunParam -> Property
|
runProp :: String -> RunParam -> Property
|
||||||
runProp field val = pureAttrProperty (param) $ dockerAttr $
|
runProp field val = pureInfoProperty (param) $ dockerInfo $
|
||||||
mempty { _dockerRunParams = [\_ -> "--"++param] }
|
mempty { _dockerRunParams = [\_ -> "--"++param] }
|
||||||
where
|
where
|
||||||
param = field++"="++val
|
param = field++"="++val
|
||||||
|
|
||||||
genProp :: String -> (HostName -> RunParam) -> Property
|
genProp :: String -> (HostName -> RunParam) -> Property
|
||||||
genProp field mkval = pureAttrProperty field $ dockerAttr $
|
genProp field mkval = pureInfoProperty field $ dockerInfo $
|
||||||
mempty { _dockerRunParams = [\hn -> "--"++field++"=" ++ mkval hn] }
|
mempty { _dockerRunParams = [\hn -> "--"++field++"=" ++ mkval hn] }
|
||||||
|
|
||||||
dockerAttr :: DockerAttr -> Attr
|
dockerInfo :: DockerInfo -> Info
|
||||||
dockerAttr a = mempty { _dockerattr = a }
|
dockerInfo i = mempty { _dockerinfo = i }
|
||||||
|
|
||||||
-- | The ContainerIdent of a container is written to
|
-- | The ContainerIdent of a container is written to
|
||||||
-- /.propellor-ident inside it. This can be checked to see if
|
-- /.propellor-ident inside it. This can be checked to see if
|
||||||
|
|
|
@ -3,7 +3,7 @@ module Propellor.Property.Hostname where
|
||||||
import Propellor
|
import Propellor
|
||||||
import qualified Propellor.Property.File as File
|
import qualified Propellor.Property.File as File
|
||||||
|
|
||||||
-- | Ensures that the hostname is set to the HostAttr value.
|
-- | Ensures that the hostname is set to the HostInfo value.
|
||||||
-- Configures /etc/hostname and the current hostname.
|
-- Configures /etc/hostname and the current hostname.
|
||||||
--
|
--
|
||||||
-- A FQDN also configures /etc/hosts, with an entry for 127.0.1.1, which is
|
-- A FQDN also configures /etc/hosts, with an entry for 127.0.1.1, which is
|
||||||
|
|
|
@ -3,8 +3,8 @@
|
||||||
|
|
||||||
module Propellor.Types
|
module Propellor.Types
|
||||||
( Host(..)
|
( Host(..)
|
||||||
, Attr
|
, Info
|
||||||
, getAttr
|
, getInfo
|
||||||
, Propellor(..)
|
, Propellor(..)
|
||||||
, Property(..)
|
, Property(..)
|
||||||
, RevertableProperty(..)
|
, RevertableProperty(..)
|
||||||
|
@ -29,21 +29,21 @@ import System.Console.ANSI
|
||||||
import "mtl" Control.Monad.Reader
|
import "mtl" Control.Monad.Reader
|
||||||
import "MonadCatchIO-transformers" Control.Monad.CatchIO
|
import "MonadCatchIO-transformers" Control.Monad.CatchIO
|
||||||
|
|
||||||
import Propellor.Types.Attr
|
import Propellor.Types.Info
|
||||||
import Propellor.Types.OS
|
import Propellor.Types.OS
|
||||||
import Propellor.Types.Dns
|
import Propellor.Types.Dns
|
||||||
|
|
||||||
-- | Everything Propellor knows about a system: Its hostname,
|
-- | Everything Propellor knows about a system: Its hostname,
|
||||||
-- properties and attributes.
|
-- properties and other info.
|
||||||
data Host = Host
|
data Host = Host
|
||||||
{ hostName :: HostName
|
{ hostName :: HostName
|
||||||
, hostProperties :: [Property]
|
, hostProperties :: [Property]
|
||||||
, hostAttr :: Attr
|
, hostInfo :: Info
|
||||||
}
|
}
|
||||||
deriving (Show)
|
deriving (Show)
|
||||||
|
|
||||||
-- | Propellor's monad provides read-only access to the host it's running
|
-- | Propellor's monad provides read-only access to info about the host
|
||||||
-- on, including its attributes.
|
-- it's running on.
|
||||||
newtype Propellor p = Propellor { runWithHost :: ReaderT Host IO p }
|
newtype Propellor p = Propellor { runWithHost :: ReaderT Host IO p }
|
||||||
deriving
|
deriving
|
||||||
( Monad
|
( Monad
|
||||||
|
@ -61,8 +61,8 @@ data Property = Property
|
||||||
{ propertyDesc :: Desc
|
{ propertyDesc :: Desc
|
||||||
, propertySatisfy :: Propellor Result
|
, propertySatisfy :: Propellor Result
|
||||||
-- ^ must be idempotent; may run repeatedly
|
-- ^ must be idempotent; may run repeatedly
|
||||||
, propertyAttr :: Attr
|
, propertyInfo :: Info
|
||||||
-- ^ a property can set an attribute of the host that has the property.
|
-- ^ a property can add info to the host.
|
||||||
}
|
}
|
||||||
|
|
||||||
instance Show Property where
|
instance Show Property where
|
||||||
|
@ -78,15 +78,15 @@ class IsProp p where
|
||||||
-- | Indicates that the first property can only be satisfied
|
-- | Indicates that the first property can only be satisfied
|
||||||
-- once the second one is.
|
-- once the second one is.
|
||||||
requires :: p -> Property -> p
|
requires :: p -> Property -> p
|
||||||
getAttr :: p -> Attr
|
getInfo :: p -> Info
|
||||||
|
|
||||||
instance IsProp Property where
|
instance IsProp Property where
|
||||||
describe p d = p { propertyDesc = d }
|
describe p d = p { propertyDesc = d }
|
||||||
toProp p = p
|
toProp p = p
|
||||||
getAttr = propertyAttr
|
getInfo = propertyInfo
|
||||||
x `requires` y = Property (propertyDesc x) satisfy attr
|
x `requires` y = Property (propertyDesc x) satisfy info
|
||||||
where
|
where
|
||||||
attr = getAttr y <> getAttr x
|
info = getInfo y <> getInfo x
|
||||||
satisfy = do
|
satisfy = do
|
||||||
r <- propertySatisfy y
|
r <- propertySatisfy y
|
||||||
case r of
|
case r of
|
||||||
|
@ -101,8 +101,8 @@ instance IsProp RevertableProperty where
|
||||||
toProp (RevertableProperty p1 _) = p1
|
toProp (RevertableProperty p1 _) = p1
|
||||||
(RevertableProperty p1 p2) `requires` y =
|
(RevertableProperty p1 p2) `requires` y =
|
||||||
RevertableProperty (p1 `requires` y) p2
|
RevertableProperty (p1 `requires` y) p2
|
||||||
-- | Return the Attr of the currently active side.
|
-- | Return the Info of the currently active side.
|
||||||
getAttr (RevertableProperty p1 _p2) = getAttr p1
|
getInfo (RevertableProperty p1 _p2) = getInfo p1
|
||||||
|
|
||||||
type Desc = String
|
type Desc = String
|
||||||
|
|
||||||
|
|
|
@ -1,4 +1,4 @@
|
||||||
module Propellor.Types.Attr where
|
module Propellor.Types.Info where
|
||||||
|
|
||||||
import Propellor.Types.OS
|
import Propellor.Types.OS
|
||||||
import qualified Propellor.Types.Dns as Dns
|
import qualified Propellor.Types.Dns as Dns
|
||||||
|
@ -6,24 +6,24 @@ import qualified Propellor.Types.Dns as Dns
|
||||||
import qualified Data.Set as S
|
import qualified Data.Set as S
|
||||||
import Data.Monoid
|
import Data.Monoid
|
||||||
|
|
||||||
-- | The attributes of a host.
|
-- | Information about a host.
|
||||||
data Attr = Attr
|
data Info = Info
|
||||||
{ _os :: Val System
|
{ _os :: Val System
|
||||||
, _sshPubKey :: Val String
|
, _sshPubKey :: Val String
|
||||||
, _dns :: S.Set Dns.Record
|
, _dns :: S.Set Dns.Record
|
||||||
, _namedconf :: Dns.NamedConfMap
|
, _namedconf :: Dns.NamedConfMap
|
||||||
, _dockerattr :: DockerAttr
|
, _dockerinfo :: DockerInfo
|
||||||
}
|
}
|
||||||
deriving (Eq, Show)
|
deriving (Eq, Show)
|
||||||
|
|
||||||
instance Monoid Attr where
|
instance Monoid Info where
|
||||||
mempty = Attr mempty mempty mempty mempty mempty
|
mempty = Info mempty mempty mempty mempty mempty
|
||||||
mappend old new = Attr
|
mappend old new = Info
|
||||||
{ _os = _os old <> _os new
|
{ _os = _os old <> _os new
|
||||||
, _sshPubKey = _sshPubKey old <> _sshPubKey new
|
, _sshPubKey = _sshPubKey old <> _sshPubKey new
|
||||||
, _dns = _dns old <> _dns new
|
, _dns = _dns old <> _dns new
|
||||||
, _namedconf = _namedconf old <> _namedconf new
|
, _namedconf = _namedconf old <> _namedconf new
|
||||||
, _dockerattr = _dockerattr old <> _dockerattr new
|
, _dockerinfo = _dockerinfo old <> _dockerinfo new
|
||||||
}
|
}
|
||||||
|
|
||||||
data Val a = Val a | NoVal
|
data Val a = Val a | NoVal
|
||||||
|
@ -39,26 +39,26 @@ fromVal :: Val a -> Maybe a
|
||||||
fromVal (Val a) = Just a
|
fromVal (Val a) = Just a
|
||||||
fromVal NoVal = Nothing
|
fromVal NoVal = Nothing
|
||||||
|
|
||||||
data DockerAttr = DockerAttr
|
data DockerInfo = DockerInfo
|
||||||
{ _dockerImage :: Val String
|
{ _dockerImage :: Val String
|
||||||
, _dockerRunParams :: [HostName -> String]
|
, _dockerRunParams :: [HostName -> String]
|
||||||
}
|
}
|
||||||
|
|
||||||
instance Eq DockerAttr where
|
instance Eq DockerInfo where
|
||||||
x == y = and
|
x == y = and
|
||||||
[ _dockerImage x == _dockerImage y
|
[ _dockerImage x == _dockerImage y
|
||||||
, let simpl v = map (\a -> a "") (_dockerRunParams v)
|
, let simpl v = map (\a -> a "") (_dockerRunParams v)
|
||||||
in simpl x == simpl y
|
in simpl x == simpl y
|
||||||
]
|
]
|
||||||
|
|
||||||
instance Monoid DockerAttr where
|
instance Monoid DockerInfo where
|
||||||
mempty = DockerAttr mempty mempty
|
mempty = DockerInfo mempty mempty
|
||||||
mappend old new = DockerAttr
|
mappend old new = DockerInfo
|
||||||
{ _dockerImage = _dockerImage old <> _dockerImage new
|
{ _dockerImage = _dockerImage old <> _dockerImage new
|
||||||
, _dockerRunParams = _dockerRunParams old <> _dockerRunParams new
|
, _dockerRunParams = _dockerRunParams old <> _dockerRunParams new
|
||||||
}
|
}
|
||||||
|
|
||||||
instance Show DockerAttr where
|
instance Show DockerInfo where
|
||||||
show a = unlines
|
show a = unlines
|
||||||
[ "docker image " ++ show (_dockerImage a)
|
[ "docker image " ++ show (_dockerImage a)
|
||||||
, "docker run params " ++ show (map (\mk -> mk "") (_dockerRunParams a))
|
, "docker run params " ++ show (map (\mk -> mk "") (_dockerRunParams a))
|
Loading…
Reference in New Issue