summaryrefslogtreecommitdiff
path: root/src/Propellor/Attr.hs
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/Attr.hs
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/Attr.hs')
-rw-r--r--src/Propellor/Attr.hs28
1 files changed, 6 insertions, 22 deletions
diff --git a/src/Propellor/Attr.hs b/src/Propellor/Attr.hs
index 5749a4bf..8f1c6b7c 100644
--- a/src/Propellor/Attr.hs
+++ b/src/Propellor/Attr.hs
@@ -9,9 +9,10 @@ import "mtl" Control.Monad.Reader
import qualified Data.Set as S
import qualified Data.Map as M
import Data.Maybe
+import Data.Monoid
import Control.Applicative
-pureAttrProperty :: Desc -> SetAttr -> Property
+pureAttrProperty :: Desc -> Attr -> Property
pureAttrProperty desc = Property ("has " ++ desc) (return NoChange)
getHostName :: Propellor HostName
@@ -19,7 +20,7 @@ getHostName = asks _hostName
os :: System -> Property
os system = pureAttrProperty ("Operating " ++ show system) $
- \d -> d { _os = Just system }
+ mempty { _os = Just system }
getOS :: Propellor (Maybe System)
getOS = asks (_os . hostAttr)
@@ -41,7 +42,7 @@ alias = addDNS . CNAME . AbsDomain
addDNS :: Record -> Property
addDNS r = pureAttrProperty (rdesc r) $
- \d -> d { _dns = S.insert r (_dns d) }
+ mempty { _dns = S.singleton r }
where
rdesc (CNAME d) = unwords ["alias", ddesc d]
rdesc (Address (IPv4 addr)) = unwords ["ipv4", addr]
@@ -55,32 +56,15 @@ addDNS r = pureAttrProperty (rdesc r) $
ddesc (RelDomain domain) = domain
ddesc RootDomain = "@"
--- | Adds a DNS NamedConf stanza.
---
--- Note that adding a Master stanza for a domain always overrides an
--- existing Secondary stanza, while a Secondary stanza is only added
--- when there is no existing Master stanza.
-addNamedConf :: NamedConf -> SetAttr
-addNamedConf conf d = d { _namedconf = new }
- where
- m = _namedconf d
- domain = confDomain conf
- new = case (confDnsServerType conf, confDnsServerType <$> M.lookup domain m) of
- (Secondary, Just Master) -> m
- _ -> M.insert domain conf m
-
-getNamedConf :: Propellor (M.Map Domain NamedConf)
-getNamedConf = asks (_namedconf . hostAttr)
-
sshPubKey :: String -> Property
sshPubKey k = pureAttrProperty ("ssh pubkey known") $
- \d -> d { _sshPubKey = Just k }
+ mempty { _sshPubKey = Just k }
getSshPubKey :: Propellor (Maybe String)
getSshPubKey = asks (_sshPubKey . hostAttr)
hostAttr :: Host -> Attr
-hostAttr (Host _ _ mkattrs) = mkattrs newAttr
+hostAttr (Host _ _ attr) = attr
hostProperties :: Host -> [Property]
hostProperties (Host _ ps _) = ps