summaryrefslogtreecommitdiff
path: root/Propellor/Types
diff options
context:
space:
mode:
Diffstat (limited to 'Propellor/Types')
-rw-r--r--Propellor/Types/Attr.hs48
-rw-r--r--Propellor/Types/Dns.hs92
-rw-r--r--Propellor/Types/OS.hs27
3 files changed, 0 insertions, 167 deletions
diff --git a/Propellor/Types/Attr.hs b/Propellor/Types/Attr.hs
deleted file mode 100644
index 8b7d3b09..00000000
--- a/Propellor/Types/Attr.hs
+++ /dev/null
@@ -1,48 +0,0 @@
-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/Propellor/Types/Dns.hs b/Propellor/Types/Dns.hs
deleted file mode 100644
index ba6a92dd..00000000
--- a/Propellor/Types/Dns.hs
+++ /dev/null
@@ -1,92 +0,0 @@
-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/Propellor/Types/OS.hs b/Propellor/Types/OS.hs
deleted file mode 100644
index 23cc8a29..00000000
--- a/Propellor/Types/OS.hs
+++ /dev/null
@@ -1,27 +0,0 @@
-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