Attr is renamed to Info.

This commit is contained in:
Joey Hess 2014-06-09 01:45:58 -04:00
parent 582be8ebe0
commit fc49d75e4f
14 changed files with 97 additions and 96 deletions

1
debian/changelog vendored
View File

@ -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

View File

@ -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.

View File

@ -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)

View File

@ -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)

View File

@ -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

View File

@ -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

View File

@ -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

View File

@ -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

View File

@ -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

View File

@ -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

View File

@ -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

View File

@ -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

View File

@ -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

View File

@ -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))