diff options
| author | Joey Hess <joey@kitenet.net> | 2014-05-31 20:39:56 -0400 |
|---|---|---|
| committer | Joey Hess <joey@kitenet.net> | 2014-05-31 20:43:23 -0400 |
| commit | 4f70fceb3a79f2c2b746407768faf363d11c11a4 (patch) | |
| tree | 3f0c05ed545b761bbe3f07576d1ef0259a48c4af /src/Propellor/Attr.hs | |
| parent | 6b835c5eeb352718a11e707a0e10d2bc5092782b (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.hs | 28 |
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 |
