add dns records to Attr

Propellor/Attr.hs

@@ -4,6 +4,7 @@ module Propellor.Attr where
 
 import Propellor.Types
 import Propellor.Types.Attr
+import Propellor.Types.Dns
 
 import "mtl" Control.Monad.Reader
 import qualified Data.Set as S
@@ -28,15 +29,16 @@ getOS :: Propellor (Maybe System)
 getOS = asks _os
 
 cname :: Domain -> Property
-cname domain = pureAttrProperty ("cname " ++ domain) (addCName domain)
+cname domain = pureAttrProperty ("cname " ++ domain)
+	(addDNS $ CNAME $ AbsDomain domain)
 
 cnameFor :: Domain -> (Domain -> Property) -> Property
 cnameFor domain mkp =
 	let p = mkp domain
-	in p { propertyAttr = propertyAttr p . addCName domain }
+	in p { propertyAttr = propertyAttr p . addDNS (CNAME $ AbsDomain domain) }
 
-addCName :: HostName -> SetAttr
+addDNS :: Record -> SetAttr
-addCName domain d = d { _cnames = S.insert domain (_cnames d) }
+addDNS record d = d { _dns = S.insert record (_dns d) }
 
 sshPubKey :: String -> Property
 sshPubKey k = pureAttrProperty ("ssh pubkey known") $

Propellor/Property/Dns.hs

@@ -1,6 +1,18 @@
-module Propellor.Property.Dns where
+module Propellor.Property.Dns (
+	module Propellor.Types.Dns,
+	secondary,
+	servingZones,
+	mkSOA,
+	nextSerialNumber,
+	incrSerialNumber,
+	currentSerialNumber,
+	writeZoneFile,
+	genZoneFile,
+	genSOA,
+) where
 
 import Propellor
+import Propellor.Types.Dns
 import Propellor.Property.File
 import qualified Propellor.Property.Apt as Apt
 import qualified Propellor.Property.Service as Service
@@ -8,48 +20,31 @@ import Utility.Applicative
 
 import Data.List
 import Data.Time.Clock.POSIX
-import Data.Time.Format
-import Foreign.C.Types
 
 namedconf :: FilePath
 namedconf = "/etc/bind/named.conf.local"
 
-data NamedConf = NamedConf
-	{ zdomain :: Domain
-	, ztype :: Type
-	, zfile :: FilePath
-	, zmasters :: [IPAddr]
-	, zconfiglines :: [String]
-	}
-
 zoneDesc :: NamedConf -> String
-zoneDesc z = zdomain z ++ " (" ++ show (ztype z) ++ ")"
+zoneDesc z = confDomain z ++ " (" ++ show (confType z) ++ ")"
-
-type IPAddr = String
-
-type Domain = String
-
-data Type = Master | Secondary
-	deriving (Show, Eq)
 
 secondary :: Domain -> [IPAddr] -> NamedConf
 secondary domain masters = NamedConf
-	{ zdomain = domain
+	{ confDomain = domain
-	, ztype = Secondary
+	, confType = Secondary
-	, zfile = "db." ++ domain
+	, confFile = "db." ++ domain
-	, zmasters = masters
+	, confMasters = masters
-	, zconfiglines = ["allow-transfer { }"]
+	, confLines = ["allow-transfer { }"]
 	}
 
-zoneStanza :: NamedConf -> [Line]
+confStanza :: NamedConf -> [Line]
-zoneStanza z =
+confStanza c =
 	[ "// automatically generated by propellor"
-	, "zone \"" ++ zdomain z ++ "\" {"
+	, "zone \"" ++ confDomain c ++ "\" {"
-	, cfgline "type" (if ztype z == Master then "master" else "slave")
+	, cfgline "type" (if confType c == Master then "master" else "slave")
-	, cfgline "file" ("\"" ++ zfile z ++ "\"")
+	, cfgline "file" ("\"" ++ confFile c ++ "\"")
 	] ++
-	(if null (zmasters z) then [] else mastersblock) ++
+	(if null (confMasters c) then [] else mastersblock) ++
-	(map (\l -> "\t" ++ l ++ ";") (zconfiglines z)) ++
+	(map (\l -> "\t" ++ l ++ ";") (confLines c)) ++
 	[ "};"
 	, ""
 	]
@@ -57,40 +52,17 @@ zoneStanza z =
 	cfgline f v = "\t" ++ f ++ " " ++ v ++ ";"
 	mastersblock =
 		[ "\tmasters {" ] ++
-		(map (\ip -> "\t\t" ++ ip ++ ";") (zmasters z)) ++
+		(map (\ip -> "\t\t" ++ fromIPAddr ip ++ ";") (confMasters c)) ++
 		[ "\t};" ]
 
 -- | Rewrites the whole named.conf.local file to serve the specificed
 -- zones.
-zones :: [NamedConf] -> Property
+servingZones :: [NamedConf] -> Property
-zones zs = hasContent namedconf (concatMap zoneStanza zs)
+servingZones zs = hasContent namedconf (concatMap confStanza zs)
 	`describe` ("dns server for zones: " ++ unwords (map zoneDesc zs))
 	`requires` Apt.serviceInstalledRunning "bind9"
 	`onChange` Service.reloaded "bind9"
 
--- | 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)
-
 -- |  Generates a SOA with some fairly sane numbers in it.
 mkSOA :: Domain -> [Record] -> SOA
 mkSOA d rs = SOA
@@ -105,49 +77,22 @@ mkSOA d rs = SOA
   where
 	hours n = n * 60 * 60
 
--- | Types of DNS records.
---
--- This is not a complete list, more can be added.
-data Record
-	= A Ipv4
-	| AAAA Ipv6
-	| CNAME BindDomain
-	| MX Int BindDomain
-	| NS BindDomain
-	| TXT String
-	deriving (Read, Show, Eq)
-
-type Ipv4 = String
-type Ipv6 = String
-
--- | 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)
-
 dValue :: BindDomain -> String
 dValue (RelDomain d) = d
 dValue (AbsDomain d) = d ++ "."
 dValue (SOADomain) = "@"
 
 rField :: Record -> String
-rField (A _) = "A"
+rField (Address (IPv4 _)) = "A"
-rField (AAAA _) = "AAAA"
+rField (Address (IPv6 _)) = "AAAA"
 rField (CNAME _) = "CNAME"
 rField (MX _ _) = "MX"
 rField (NS _) = "NS"
 rField (TXT _) = "TXT"
 
 rValue :: Record -> String
-rValue (A addr) = addr
+rValue (Address (IPv4 addr)) = addr
-rValue (AAAA addr) = addr
+rValue (Address (IPv6 addr)) = addr
 rValue (CNAME d) = dValue d
 rValue (MX pri d) = show pri ++ " " ++ dValue d
 rValue (NS d) = dValue d

Propellor/Types.hs

@@ -5,7 +5,6 @@
 module Propellor.Types
 	( Host(..)
 	, Attr
-	, HostName
 	, Propellor(..)
 	, Property(..)
 	, RevertableProperty(..)

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 []
+newAttr hn = Attr hn Nothing S.empty Nothing Nothing []
-
-type HostName = String
-type Domain = String
 
 type SetAttr = Attr -> Attr

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)

Propellor/Types/OS.hs

@@ -1,5 +1,6 @@
 module Propellor.Types.OS where
 
+type HostName = String
 type UserName = String
 type GroupName = String
 

config-joey.hs

@@ -82,7 +82,7 @@ hosts =               --                  (o)  `
 		& Ssh.hostKey SshEcdsa
 		& Apt.unattendedUpgrades
 		& Apt.serviceInstalledRunning "ntp"
-		& Dns.zones myDnsSecondary
+		& Dns.servingZones myDnsSecondary
 		& Postfix.satellite
 	
 		& Apt.serviceInstalledRunning "apache2"
@@ -234,8 +234,8 @@ myDnsSecondary =
 	, Dns.secondary "branchable.com" branchablemaster
 	]
   where
-	master = ["80.68.85.49", "2001:41c8:125:49::10"] -- wren
+	master = [Dns.IPv4 "80.68.85.49", Dns.IPv6 "2001:41c8:125:49::10"] -- wren
-	branchablemaster = ["66.228.46.55", "2600:3c03::f03c:91ff:fedf:c0e5"]
+	branchablemaster = [Dns.IPv4 "66.228.46.55", Dns.IPv6 "2600:3c03::f03c:91ff:fedf:c0e5"]
 
 main :: IO ()
 main = defaultMain hosts

propellor.cabal

@@ -99,6 +99,7 @@ Library
     Propellor.Exception
     Propellor.Types
     Propellor.Types.OS
+    Propellor.Types.Dns
   Other-Modules:
     Propellor.Types.Attr
     Propellor.CmdLine