summaryrefslogtreecommitdiff
path: root/Propellor/Types
diff options
context:
space:
mode:
authorJoey Hess2014-04-18 17:19:28 -0400
committerJoey Hess2014-04-18 17:19:28 -0400
commit39d697ca789c04da07bb14cc7476899e717d9413 (patch)
tree9e2c45e9f66e9a7d7e419cb6c38e37e1a9ebdd88 /Propellor/Types
parent2b9ee5b29b03a4a18fb43dafab38d6d185c653e0 (diff)
add dns records to Attr
Diffstat (limited to 'Propellor/Types')
-rw-r--r--Propellor/Types/Attr.hs12
-rw-r--r--Propellor/Types/Dns.hs73
-rw-r--r--Propellor/Types/OS.hs1
3 files changed, 79 insertions, 7 deletions
diff --git a/Propellor/Types/Attr.hs b/Propellor/Types/Attr.hs
index 00611775..cf8bdf1a 100644
--- a/Propellor/Types/Attr.hs
+++ b/Propellor/Types/Attr.hs
@@ -1,14 +1,15 @@
module Propellor.Types.Attr where
import Propellor.Types.OS
+import qualified Propellor.Types.Dns as Dns
import qualified Data.Set as S
-- | The attributes of a host. For example, its hostname.
data Attr = Attr
{ _hostname :: HostName
- , _cnames :: S.Set Domain
, _os :: Maybe System
+ , _dns :: S.Set Dns.Record
, _sshPubKey :: Maybe String
, _dockerImage :: Maybe String
@@ -18,8 +19,8 @@ data Attr = Attr
instance Eq Attr where
x == y = and
[ _hostname x == _hostname y
- , _cnames x == _cnames y
, _os x == _os y
+ , _dns x == _dns y
, _sshPubKey x == _sshPubKey y
, _dockerImage x == _dockerImage y
@@ -30,17 +31,14 @@ instance Eq Attr where
instance Show Attr where
show a = unlines
[ "hostname " ++ _hostname a
- , "cnames " ++ show (_cnames a)
, "OS " ++ show (_os a)
+ , "dns " ++ show (_dns a)
, "sshPubKey " ++ show (_sshPubKey a)
, "docker image " ++ show (_dockerImage a)
, "docker run params " ++ show (map (\mk -> mk "") (_dockerRunParams a))
]
newAttr :: HostName -> Attr
-newAttr hn = Attr hn S.empty Nothing Nothing Nothing []
-
-type HostName = String
-type Domain = String
+newAttr hn = Attr hn Nothing S.empty Nothing Nothing []
type SetAttr = Attr -> Attr
diff --git a/Propellor/Types/Dns.hs b/Propellor/Types/Dns.hs
new file mode 100644
index 00000000..4b5925c1
--- /dev/null
+++ b/Propellor/Types/Dns.hs
@@ -0,0 +1,73 @@
+module Propellor.Types.Dns where
+
+import Propellor.Types.OS (HostName)
+
+import Foreign.C.Types
+
+type Domain = String
+
+data IPAddr = IPv4 String | IPv6 String
+ deriving (Read, Show, Eq, Ord)
+
+fromIPAddr :: IPAddr -> String
+fromIPAddr (IPv4 addr) = addr
+fromIPAddr (IPv6 addr) = addr
+
+-- | Represents a bind 9 named.conf file.
+data NamedConf = NamedConf
+ { confDomain :: Domain
+ , confType :: Type
+ , confFile :: FilePath
+ , confMasters :: [IPAddr]
+ , confLines :: [String]
+ }
+ deriving (Show, Eq)
+
+data Type = Master | Secondary
+ deriving (Show, Eq)
+
+-- | Represents a bind 9 zone file.
+data Zone = Zone
+ { zSOA :: SOA
+ , zHosts :: [(HostName, Record)]
+ }
+ deriving (Read, Show, Eq)
+
+-- | Every domain has a SOA record, which is big and complicated.
+data SOA = SOA
+ { sDomain :: BindDomain
+ -- ^ Typically ns1.your.domain
+ , sSerial :: SerialNumber
+ -- ^ The most important parameter is the serial number,
+ -- which must increase after each change.
+ , sRefresh :: Integer
+ , sRetry :: Integer
+ , sExpire :: Integer
+ , sTTL :: Integer
+ , sRecord :: [Record]
+ -- ^ Records for the root of the domain. Typically NS, A, TXT
+ }
+ deriving (Read, Show, Eq)
+
+-- | Types of DNS records.
+--
+-- This is not a complete list, more can be added.
+data Record
+ = Address IPAddr
+ | CNAME BindDomain
+ | MX Int BindDomain
+ | NS BindDomain
+ | TXT String
+ deriving (Read, Show, Eq, Ord)
+
+-- | Bind serial numbers are unsigned, 32 bit integers.
+type SerialNumber = CInt
+
+-- | Domains in the zone file must end with a period if they are absolute.
+--
+-- Let's use a type to keep absolute domains straight from relative
+-- domains.
+--
+-- The SOADomain refers to the root SOA record.
+data BindDomain = RelDomain Domain | AbsDomain Domain | SOADomain
+ deriving (Read, Show, Eq, Ord)
diff --git a/Propellor/Types/OS.hs b/Propellor/Types/OS.hs
index 0635b271..23cc8a29 100644
--- a/Propellor/Types/OS.hs
+++ b/Propellor/Types/OS.hs
@@ -1,5 +1,6 @@
module Propellor.Types.OS where
+type HostName = String
type UserName = String
type GroupName = String