summaryrefslogtreecommitdiff
path: root/src/Propellor/Property
diff options
context:
space:
mode:
authorJoey Hess2014-05-31 20:39:56 -0400
committerJoey Hess2014-05-31 20:43:23 -0400
commit4f70fceb3a79f2c2b746407768faf363d11c11a4 (patch)
tree3f0c05ed545b761bbe3f07576d1ef0259a48c4af /src/Propellor/Property
parent6b835c5eeb352718a11e707a0e10d2bc5092782b (diff)
got rid of the Attr -> Attr SetAttr hack, and use monoids for Attr
The SetAttr hack used to be needed because the hostname was part of the Attr, and was required to be present. Now that it's moved to Host, let's get rid of that, since it tended to waste CPU.
Diffstat (limited to 'src/Propellor/Property')
-rw-r--r--src/Propellor/Property/Dns.hs9
-rw-r--r--src/Propellor/Property/Docker.hs16
2 files changed, 15 insertions, 10 deletions
diff --git a/src/Propellor/Property/Dns.hs b/src/Propellor/Property/Dns.hs
index f82d5494..44378491 100644
--- a/src/Propellor/Property/Dns.hs
+++ b/src/Propellor/Property/Dns.hs
@@ -131,7 +131,7 @@ otherServers :: DnsServerType -> [Host] -> Domain -> [HostName]
otherServers wantedtype hosts domain =
M.keys $ M.filter wanted $ hostMap hosts
where
- wanted h = case M.lookup domain (_namedconf $ hostAttr h) of
+ wanted h = case M.lookup domain (fromNamedConfMap $ _namedconf $ hostAttr h) of
Nothing -> False
Just conf -> confDnsServerType conf == wantedtype
&& confDomain conf == domain
@@ -406,3 +406,10 @@ domainHost base (AbsDomain d)
where
dotbase = '.':base
+addNamedConf :: NamedConf -> Attr
+addNamedConf conf = mempty { _namedconf = NamedConfMap (M.singleton domain conf) }
+ where
+ domain = confDomain conf
+
+getNamedConf :: Propellor (M.Map Domain NamedConf)
+getNamedConf = asks $ fromNamedConfMap . _namedconf . hostAttr
diff --git a/src/Propellor/Property/Docker.hs b/src/Propellor/Property/Docker.hs
index 34a9deb7..3e925bb6 100644
--- a/src/Propellor/Property/Docker.hs
+++ b/src/Propellor/Property/Docker.hs
@@ -46,9 +46,9 @@ type ContainerName = String
-- > & Apt.installed {"apache2"]
-- > & ...
container :: ContainerName -> Image -> Host
-container cn image = Host hn [] (\_ -> attr)
+container cn image = Host hn [] attr
where
- attr = newAttr { _dockerImage = Just image }
+ attr = mempty { _dockerImage = Just image }
hn = cn2hn cn
cn2hn :: ContainerName -> HostName
@@ -97,9 +97,7 @@ docked hosts cn = RevertableProperty
exposeDnsAttrs :: Host -> Property -> Property
exposeDnsAttrs (Host _ _ containerattr) p = combineProperties (propertyDesc p) $
- p : map addDNS (S.toList containerdns)
- where
- containerdns = _dns $ containerattr newAttr
+ p : map addDNS (S.toList $ _dns containerattr)
findContainer
:: Maybe Host
@@ -422,14 +420,14 @@ listImages :: IO [Image]
listImages = lines <$> readProcess dockercmd ["images", "--all", "--quiet"]
runProp :: String -> RunParam -> Property
-runProp field val = pureAttrProperty (param) $ \attr ->
- attr { _dockerRunParams = _dockerRunParams attr ++ [\_ -> "--"++param] }
+runProp field val = pureAttrProperty (param) $
+ mempty { _dockerRunParams = [\_ -> "--"++param] }
where
param = field++"="++val
genProp :: String -> (HostName -> RunParam) -> Property
-genProp field mkval = pureAttrProperty field $ \attr ->
- attr { _dockerRunParams = _dockerRunParams attr ++ [\hn -> "--"++field++"=" ++ mkval hn] }
+genProp field mkval = pureAttrProperty field $
+ mempty { _dockerRunParams = [\hn -> "--"++field++"=" ++ mkval hn] }
-- | The ContainerIdent of a container is written to
-- /.propellor-ident inside it. This can be checked to see if