module Propellor.Types.Dns where
import Propellor.Types.OS (HostName)
import Propellor.Types.Empty
import Propellor.Types.Info
import Propellor.Types.ConfigurableValue
import Data.Word
import qualified Data.Map as M
import qualified Data.Set as S
import Data.List
import Data.String.Utils (split, replace)
import Data.Monoid
import Prelude
type Domain = String
data IPAddr = IPv4 String | IPv6 String
deriving (Read, Show, Eq, Ord)
instance ConfigurableValue IPAddr where
val (IPv4 addr) = addr
val (IPv6 addr) = addr
newtype AliasesInfo = AliasesInfo (S.Set HostName)
deriving (Show, Eq, Ord, Monoid, Typeable)
instance IsInfo AliasesInfo where
propagateInfo _ = PropagateInfo False
toAliasesInfo :: [HostName] -> AliasesInfo
toAliasesInfo l = AliasesInfo (S.fromList l)
fromAliasesInfo :: AliasesInfo -> [HostName]
fromAliasesInfo (AliasesInfo s) = S.toList s
newtype DnsInfo = DnsInfo { fromDnsInfo :: S.Set Record }
deriving (Show, Eq, Ord, Monoid, Typeable)
toDnsInfo :: S.Set Record -> DnsInfo
toDnsInfo = DnsInfo
instance IsInfo DnsInfo where
propagateInfo _ = PropagateInfo True
data NamedConf = NamedConf
{ confDomain :: Domain
, confDnsServerType :: DnsServerType
, confFile :: FilePath
, confMasters :: [IPAddr]
, confAllowTransfer :: [IPAddr]
, confLines :: [String]
}
deriving (Show, Eq, Ord)
data DnsServerType = Master | Secondary
deriving (Show, Eq, Ord)
data Zone = Zone
{ zDomain :: Domain
, zSOA :: SOA
, zHosts :: [(BindDomain, Record)]
}
deriving (Read, Show, Eq)
data SOA = SOA
{ sDomain :: BindDomain
, sSerial :: SerialNumber
, sRefresh :: Integer
, sRetry :: Integer
, sExpire :: Integer
, sNegativeCacheTTL :: Integer
}
deriving (Read, Show, Eq)
data Record
= Address IPAddr
| CNAME BindDomain
| MX Int BindDomain
| NS BindDomain
| TXT String
| SRV Word16 Word16 Word16 BindDomain
| SSHFP Int Int String
| INCLUDE FilePath
| PTR ReverseIP
deriving (Read, Show, Eq, Ord, Typeable)
type ReverseIP = String
reverseIP :: IPAddr -> ReverseIP
reverseIP (IPv4 addr) = intercalate "." (reverse $ split "." addr) ++ ".in-addr.arpa"
reverseIP addr@(IPv6 _) = reverse (intersperse '.' $ replace ":" "" $ val $ canonicalIP addr) ++ ".ip6.arpa"
canonicalIP :: IPAddr -> IPAddr
canonicalIP (IPv4 addr) = IPv4 addr
canonicalIP (IPv6 addr) = IPv6 $ intercalate ":" $ map canonicalGroup $ split ":" $ replaceImplicitGroups addr
where
canonicalGroup g
| l <= 4 = replicate (4 l) '0' ++ g
| otherwise = error $ "IPv6 group " ++ g ++ "as more than 4 hex digits"
where
l = length g
emptyGroups n = iterate (++ ":") "" !! n
numberOfImplicitGroups a = 8 length (split ":" $ replace "::" "" a)
replaceImplicitGroups a = concat $ aux $ split "::" a
where
aux [] = []
aux (x : xs) = x : emptyGroups (numberOfImplicitGroups a) : xs
getIPAddr :: Record -> Maybe IPAddr
getIPAddr (Address addr) = Just addr
getIPAddr _ = Nothing
getCNAME :: Record -> Maybe BindDomain
getCNAME (CNAME d) = Just d
getCNAME _ = Nothing
getNS :: Record -> Maybe BindDomain
getNS (NS d) = Just d
getNS _ = Nothing
type SerialNumber = Word32
data BindDomain = RelDomain Domain | AbsDomain Domain | RootDomain
deriving (Read, Show, Eq, Ord)
domainHostName :: BindDomain -> Maybe HostName
domainHostName (RelDomain d) = Just d
domainHostName (AbsDomain d) = Just d
domainHostName RootDomain = Nothing
newtype NamedConfMap = NamedConfMap (M.Map Domain NamedConf)
deriving (Eq, Ord, Show, Typeable)
instance IsInfo NamedConfMap where
propagateInfo _ = PropagateInfo False
instance Monoid NamedConfMap where
mempty = NamedConfMap M.empty
mappend (NamedConfMap old) (NamedConfMap new) = NamedConfMap $
M.unionWith combiner new old
where
combiner n o = case (confDnsServerType n, confDnsServerType o) of
(Secondary, Master) -> o
_ -> n
instance Empty NamedConfMap where
isEmpty (NamedConfMap m) = isEmpty m
fromNamedConfMap :: NamedConfMap -> M.Map Domain NamedConf
fromNamedConfMap (NamedConfMap m) = m