summaryrefslogtreecommitdiff
path: root/src/Propellor/Attr.hs
diff options
context:
space:
mode:
Diffstat (limited to 'src/Propellor/Attr.hs')
-rw-r--r--src/Propellor/Attr.hs84
1 files changed, 24 insertions, 60 deletions
diff --git a/src/Propellor/Attr.hs b/src/Propellor/Attr.hs
index 98cfc64d..29d7a01e 100644
--- a/src/Propellor/Attr.hs
+++ b/src/Propellor/Attr.hs
@@ -9,86 +9,59 @@ 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)
-hostname :: HostName -> Property
-hostname name = pureAttrProperty ("hostname " ++ name) $
- \d -> d { _hostname = name }
-
-getHostName :: Propellor HostName
-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
+getOS = asks (_os . hostAttr)
-- | Indidate that a host has an A record in the DNS.
--
-- TODO check at run time if the host really has this address.
-- (Can't change the host's address, but as a sanity check.)
ipv4 :: String -> Property
-ipv4 addr = pureAttrProperty ("ipv4 " ++ addr)
- (addDNS $ Address $ IPv4 addr)
+ipv4 = addDNS . Address . IPv4
-- | Indidate that a host has an AAAA record in the DNS.
ipv6 :: String -> Property
-ipv6 addr = pureAttrProperty ("ipv6 " ++ addr)
- (addDNS $ Address $ IPv6 addr)
+ipv6 = addDNS . Address . IPv6
-- | Indicates another name for the host in the DNS.
alias :: Domain -> Property
-alias domain = pureAttrProperty ("alias " ++ domain)
- (addDNS $ CNAME $ AbsDomain domain)
-
-addDNS :: Record -> SetAttr
-addDNS record d = d { _dns = S.insert record (_dns d) }
+alias = addDNS . CNAME . AbsDomain
--- | 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 }
+addDNS :: Record -> Property
+addDNS r = pureAttrProperty (rdesc r) $
+ mempty { _dns = S.singleton r }
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
+ rdesc (CNAME d) = unwords ["alias", ddesc d]
+ rdesc (Address (IPv4 addr)) = unwords ["ipv4", addr]
+ rdesc (Address (IPv6 addr)) = unwords ["ipv6", addr]
+ rdesc (MX n d) = unwords ["MX", show n, ddesc d]
+ rdesc (NS d) = unwords ["NS", ddesc d]
+ rdesc (TXT s) = unwords ["TXT", s]
+ rdesc (SRV x y z d) = unwords ["SRV", show x, show y, show z, ddesc d]
+
+ ddesc (AbsDomain domain) = domain
+ ddesc (RelDomain domain) = domain
+ ddesc RootDomain = "@"
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
-
-hostnameless :: Attr
-hostnameless = newAttr (error "hostname Attr not specified")
-
-hostAttr :: Host -> Attr
-hostAttr (Host _ mkattrs) = mkattrs hostnameless
-
-hostProperties :: Host -> [Property]
-hostProperties (Host ps _) = ps
+getSshPubKey = asks (_sshPubKey . hostAttr)
hostMap :: [Host] -> M.Map HostName Host
-hostMap l = M.fromList $ zip (map (_hostname . hostAttr) l) l
-
-hostAttrMap :: [Host] -> M.Map HostName Attr
-hostAttrMap l = M.fromList $ zip (map _hostname attrs) attrs
- where
- attrs = map hostAttr l
+hostMap l = M.fromList $ zip (map hostName l) l
findHost :: [Host] -> HostName -> Maybe Host
findHost l hn = M.lookup hn (hostMap l)
@@ -100,12 +73,3 @@ hostAddresses :: HostName -> [Host] -> [IPAddr]
hostAddresses hn hosts = case hostAttr <$> findHost hosts hn of
Nothing -> []
Just attr -> mapMaybe getIPAddr $ S.toList $ _dns attr
-
--- | Lifts an action into a different host.
---
--- For example, `fromHost hosts "otherhost" getSshPubKey`
-fromHost :: [Host] -> HostName -> Propellor a -> Propellor (Maybe a)
-fromHost l hn getter = case findHost l hn of
- Nothing -> return Nothing
- Just h -> liftIO $ Just <$>
- runReaderT (runWithAttr getter) (hostAttr h)