summaryrefslogtreecommitdiff
path: root/src/Propellor/Types/Dns.hs
diff options
context:
space:
mode:
authorJoey Hess2015-09-06 08:19:02 -0700
committerJoey Hess2015-09-06 16:13:54 -0400
commitdef53b64cc17b95eb5729dd97a800dfe1257b352 (patch)
tree03f63e5bcb6486b00639e1ea78c21d8928c3b8ca /src/Propellor/Types/Dns.hs
parent6f4024f5307a81f26f5e6bf86b84c7363219cb3d (diff)
Added Propellor.Property.Rsync. WIP; untested
Convert Info to use Data.Dynamic, so properties can export and consume info of any type that is Typeable and a Monoid, including data types private to a module. (API change) Thanks to Joachim Breitner for the idea.
Diffstat (limited to 'src/Propellor/Types/Dns.hs')
-rw-r--r--src/Propellor/Types/Dns.hs34
1 files changed, 32 insertions, 2 deletions
diff --git a/src/Propellor/Types/Dns.hs b/src/Propellor/Types/Dns.hs
index 50297f57..d78c78fd 100644
--- a/src/Propellor/Types/Dns.hs
+++ b/src/Propellor/Types/Dns.hs
@@ -1,11 +1,15 @@
+{-# LANGUAGE DeriveDataTypeable, GeneralizedNewtypeDeriving #-}
+
module Propellor.Types.Dns where
import Propellor.Types.OS (HostName)
import Propellor.Types.Empty
+import Propellor.Types.Info
import Data.Word
import Data.Monoid
import qualified Data.Map as M
+import qualified Data.Set as S
type Domain = String
@@ -16,6 +20,29 @@ fromIPAddr :: IPAddr -> String
fromIPAddr (IPv4 addr) = addr
fromIPAddr (IPv6 addr) = addr
+newtype AliasesInfo = AliasesInfo (S.Set HostName)
+ deriving (Show, Eq, Ord, Monoid, Typeable)
+
+instance IsInfo AliasesInfo where
+ propigateInfo _ = 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
+
+-- | DNS Info is propigated, so that eg, aliases of a container
+-- are reflected in the dns for the host where it runs.
+instance IsInfo DnsInfo where
+ propigateInfo _ = True
+
-- | Represents a bind 9 named.conf file.
data NamedConf = NamedConf
{ confDomain :: Domain
@@ -64,7 +91,7 @@ data Record
| SRV Word16 Word16 Word16 BindDomain
| SSHFP Int Int String
| INCLUDE FilePath
- deriving (Read, Show, Eq, Ord)
+ deriving (Read, Show, Eq, Ord, Typeable)
getIPAddr :: Record -> Maybe IPAddr
getIPAddr (Address addr) = Just addr
@@ -97,7 +124,10 @@ domainHostName (AbsDomain d) = Just d
domainHostName RootDomain = Nothing
newtype NamedConfMap = NamedConfMap (M.Map Domain NamedConf)
- deriving (Eq, Ord, Show)
+ deriving (Eq, Ord, Show, Typeable)
+
+instance IsInfo NamedConfMap where
+ propigateInfo _ = False
-- | Adding a Master NamedConf stanza for a particulr domain always
-- overrides an existing Secondary stanza for that domain, while a