module Propellor.Info where
import Propellor.Types
import Propellor.Types.Info
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
pureInfoProperty :: (IsInfo v) => Desc -> v -> Property HasInfo
pureInfoProperty desc v = pureInfoProperty' desc (addInfo mempty v)
pureInfoProperty' :: Desc -> Info -> Property HasInfo
pureInfoProperty' desc i = infoProperty ("has " ++ desc) (return NoChange) i mempty
askInfo :: (IsInfo v) => Propellor v
askInfo = asks (getInfo . hostInfo)
os :: System -> Property HasInfo
os system = pureInfoProperty ("Operating " ++ show system) (InfoVal system)
getOS :: Propellor (Maybe System)
getOS = fromInfoVal <$> askInfo
ipv4 :: String -> Property HasInfo
ipv4 = addDNS . Address . IPv4
ipv6 :: String -> Property HasInfo
ipv6 = addDNS . Address . IPv6
alias :: Domain -> Property HasInfo
alias d = pureInfoProperty' ("alias " ++ d) $ mempty
`addInfo` toAliasesInfo [d]
`addInfo` (toDnsInfo $ S.singleton $ CNAME $ AbsDomain d)
addDNS :: Record -> Property HasInfo
addDNS r = pureInfoProperty (rdesc r) (toDnsInfo (S.singleton r))
where
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]
rdesc (SSHFP x y s) = unwords ["SSHFP", show x, show y, s]
rdesc (INCLUDE f) = unwords ["$INCLUDE", f]
rdesc (PTR x) = unwords ["PTR", x]
ddesc (AbsDomain domain) = domain
ddesc (RelDomain domain) = domain
ddesc RootDomain = "@"
hostMap :: [Host] -> M.Map HostName Host
hostMap l = M.fromList $ zip (map hostName l) l
aliasMap :: [Host] -> M.Map HostName Host
aliasMap = M.fromList . concat .
map (\h -> map (\aka -> (aka, h)) $ fromAliasesInfo $ getInfo $ hostInfo h)
findHost :: [Host] -> HostName -> Maybe Host
findHost l hn = (findHostNoAlias l hn) <|> (findAlias l hn)
findHostNoAlias :: [Host] -> HostName -> Maybe Host
findHostNoAlias l hn = M.lookup hn (hostMap l)
findAlias :: [Host] -> HostName -> Maybe Host
findAlias l hn = M.lookup hn (aliasMap l)
getAddresses :: Info -> [IPAddr]
getAddresses = mapMaybe getIPAddr . S.toList . fromDnsInfo . getInfo
hostAddresses :: HostName -> [Host] -> [IPAddr]
hostAddresses hn hosts = maybe [] (getAddresses . hostInfo) (findHost hosts hn)