summaryrefslogtreecommitdiff
path: root/src/Propellor/Types
diff options
context:
space:
mode:
authorJoey Hess2014-05-14 19:41:05 -0400
committerJoey Hess2014-05-14 19:41:05 -0400
commit7115d1ec162b4059b3e8e8f84bd8d5898c1db025 (patch)
tree42c1cce54e890e1d56484794ab33129132d8fee2 /src/Propellor/Types
parentffe371a9d42cded461236e972a24a142419d7fc4 (diff)
moved source code to src
This is to work around OSX's brain-damange regarding filename case insensitivity. Avoided moving config.hs, because it's a config file. Put in a symlink to make build work.
Diffstat (limited to 'src/Propellor/Types')
-rw-r--r--src/Propellor/Types/Attr.hs48
-rw-r--r--src/Propellor/Types/Dns.hs92
-rw-r--r--src/Propellor/Types/OS.hs27
3 files changed, 167 insertions, 0 deletions
diff --git a/src/Propellor/Types/Attr.hs b/src/Propellor/Types/Attr.hs
new file mode 100644
index 00000000..8b7d3b09
--- /dev/null
+++ b/src/Propellor/Types/Attr.hs
@@ -0,0 +1,48 @@
+module Propellor.Types.Attr where
+
+import Propellor.Types.OS
+import qualified Propellor.Types.Dns as Dns
+
+import qualified Data.Set as S
+import qualified Data.Map as M
+
+-- | The attributes of a host. For example, its hostname.
+data Attr = Attr
+ { _hostname :: HostName
+ , _os :: Maybe System
+ , _sshPubKey :: Maybe String
+ , _dns :: S.Set Dns.Record
+ , _namedconf :: M.Map Dns.Domain Dns.NamedConf
+
+ , _dockerImage :: Maybe String
+ , _dockerRunParams :: [HostName -> String]
+ }
+
+instance Eq Attr where
+ x == y = and
+ [ _hostname x == _hostname y
+ , _os x == _os y
+ , _dns x == _dns y
+ , _namedconf x == _namedconf y
+ , _sshPubKey x == _sshPubKey y
+
+ , _dockerImage x == _dockerImage y
+ , let simpl v = map (\a -> a "") (_dockerRunParams v)
+ in simpl x == simpl y
+ ]
+
+instance Show Attr where
+ show a = unlines
+ [ "hostname " ++ _hostname a
+ , "OS " ++ show (_os a)
+ , "sshPubKey " ++ show (_sshPubKey a)
+ , "dns " ++ show (_dns a)
+ , "namedconf " ++ show (_namedconf a)
+ , "docker image " ++ show (_dockerImage a)
+ , "docker run params " ++ show (map (\mk -> mk "") (_dockerRunParams a))
+ ]
+
+newAttr :: HostName -> Attr
+newAttr hn = Attr hn Nothing Nothing S.empty M.empty Nothing []
+
+type SetAttr = Attr -> Attr
diff --git a/src/Propellor/Types/Dns.hs b/src/Propellor/Types/Dns.hs
new file mode 100644
index 00000000..ba6a92dd
--- /dev/null
+++ b/src/Propellor/Types/Dns.hs
@@ -0,0 +1,92 @@
+module Propellor.Types.Dns where
+
+import Propellor.Types.OS (HostName)
+
+import Data.Word
+
+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
+ , confDnsServerType :: DnsServerType
+ , confFile :: FilePath
+ , confMasters :: [IPAddr]
+ , confAllowTransfer :: [IPAddr]
+ , confLines :: [String]
+ }
+ deriving (Show, Eq, Ord)
+
+data DnsServerType = Master | Secondary
+ deriving (Show, Eq, Ord)
+
+-- | Represents a bind 9 zone file.
+data Zone = Zone
+ { zDomain :: Domain
+ , zSOA :: SOA
+ , zHosts :: [(BindDomain, 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
+ , sNegativeCacheTTL :: Integer
+ }
+ 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
+ | SRV Word16 Word16 Word16 BindDomain
+ deriving (Read, Show, Eq, Ord)
+
+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
+
+-- | Bind serial numbers are unsigned, 32 bit integers.
+type SerialNumber = Word32
+
+-- | 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 RootDomain refers to the top level of the domain, so can be used
+-- to add nameservers, MX's, etc to a domain.
+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
diff --git a/src/Propellor/Types/OS.hs b/src/Propellor/Types/OS.hs
new file mode 100644
index 00000000..23cc8a29
--- /dev/null
+++ b/src/Propellor/Types/OS.hs
@@ -0,0 +1,27 @@
+module Propellor.Types.OS where
+
+type HostName = String
+type UserName = String
+type GroupName = String
+
+-- | High level descritption of a operating system.
+data System = System Distribution Architecture
+ deriving (Show, Eq)
+
+data Distribution
+ = Debian DebianSuite
+ | Ubuntu Release
+ deriving (Show, Eq)
+
+data DebianSuite = Experimental | Unstable | Testing | Stable | DebianRelease Release
+ deriving (Show, Eq)
+
+-- | The release that currently corresponds to stable.
+stableRelease :: DebianSuite
+stableRelease = DebianRelease "wheezy"
+
+isStable :: DebianSuite -> Bool
+isStable s = s == Stable || s == stableRelease
+
+type Release = String
+type Architecture = String