summaryrefslogtreecommitdiff
path: root/src/Propellor/Types
diff options
context:
space:
mode:
Diffstat (limited to 'src/Propellor/Types')
-rw-r--r--src/Propellor/Types/ConfigurableValue.hs44
-rw-r--r--src/Propellor/Types/Dns.hs9
-rw-r--r--src/Propellor/Types/OS.hs22
-rw-r--r--src/Propellor/Types/ZFS.hs77
4 files changed, 106 insertions, 46 deletions
diff --git a/src/Propellor/Types/ConfigurableValue.hs b/src/Propellor/Types/ConfigurableValue.hs
new file mode 100644
index 00000000..1414be5f
--- /dev/null
+++ b/src/Propellor/Types/ConfigurableValue.hs
@@ -0,0 +1,44 @@
+{-# LANGUAGE TypeSynonymInstances, FlexibleInstances #-}
+
+module Propellor.Types.ConfigurableValue where
+
+import Data.Word
+
+-- | A value that can be used in a configuration file, or otherwise used to
+-- configure a program.
+--
+-- Unlike Show, there should only be instances of this type class for
+-- values that have a standard serialization that is understood outside of
+-- Haskell code.
+--
+-- When converting a type alias such as "type Foo = String" or "type Foo = Int"
+-- to a newtype, it's unsafe to derive a Show instance, because there may
+-- be code that shows the type to configure a value. Instead, define a
+-- ConfigurableValue instance.
+class ConfigurableValue t where
+ val :: t -> String
+
+-- | val String does not do any quoting, unlike show String
+instance ConfigurableValue String where
+ val = id
+
+instance ConfigurableValue Int where
+ val = show
+
+instance ConfigurableValue Integer where
+ val = show
+
+instance ConfigurableValue Float where
+ val = show
+
+instance ConfigurableValue Double where
+ val = show
+
+instance ConfigurableValue Word8 where
+ val = show
+
+instance ConfigurableValue Word16 where
+ val = show
+
+instance ConfigurableValue Word32 where
+ val = show
diff --git a/src/Propellor/Types/Dns.hs b/src/Propellor/Types/Dns.hs
index 8f15d156..4cb8b111 100644
--- a/src/Propellor/Types/Dns.hs
+++ b/src/Propellor/Types/Dns.hs
@@ -5,6 +5,7 @@ module Propellor.Types.Dns where
import Propellor.Types.OS (HostName)
import Propellor.Types.Empty
import Propellor.Types.Info
+import Propellor.Types.ConfigurableValue
import Data.Word
import qualified Data.Map as M
@@ -19,9 +20,9 @@ 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
+instance ConfigurableValue IPAddr where
+ val (IPv4 addr) = addr
+ val (IPv6 addr) = addr
newtype AliasesInfo = AliasesInfo (S.Set HostName)
deriving (Show, Eq, Ord, Monoid, Typeable)
@@ -102,7 +103,7 @@ type ReverseIP = String
reverseIP :: IPAddr -> ReverseIP
reverseIP (IPv4 addr) = intercalate "." (reverse $ split "." addr) ++ ".in-addr.arpa"
-reverseIP addr@(IPv6 _) = reverse (intersperse '.' $ replace ":" "" $ fromIPAddr $ canonicalIP addr) ++ ".ip6.arpa"
+reverseIP addr@(IPv6 _) = reverse (intersperse '.' $ replace ":" "" $ val $ canonicalIP addr) ++ ".ip6.arpa"
-- | Converts an IP address (particularly IPv6) to canonical, fully
-- expanded form.
diff --git a/src/Propellor/Types/OS.hs b/src/Propellor/Types/OS.hs
index 696c36b0..41f839f1 100644
--- a/src/Propellor/Types/OS.hs
+++ b/src/Propellor/Types/OS.hs
@@ -18,10 +18,11 @@ module Propellor.Types.OS (
Group(..),
userGroup,
Port(..),
- fromPort,
systemToTargetOS,
) where
+import Propellor.Types.ConfigurableValue
+
import Network.BSD (HostName)
import Data.Typeable
import Data.String
@@ -75,10 +76,13 @@ instance IsString FBSDVersion where
fromString "9.3-RELEASE" = FBSD093
fromString _ = error "Invalid FreeBSD release"
+instance ConfigurableValue FBSDVersion where
+ val FBSD101 = "10.1-RELEASE"
+ val FBSD102 = "10.2-RELEASE"
+ val FBSD093 = "9.3-RELEASE"
+
instance Show FBSDVersion where
- show FBSD101 = "10.1-RELEASE"
- show FBSD102 = "10.2-RELEASE"
- show FBSD093 = "9.3-RELEASE"
+ show = val
isStable :: DebianSuite -> Bool
isStable (Stable _) = True
@@ -138,9 +142,15 @@ type UserName = String
newtype User = User UserName
deriving (Eq, Ord, Show)
+instance ConfigurableValue User where
+ val (User n) = n
+
newtype Group = Group String
deriving (Eq, Ord, Show)
+instance ConfigurableValue Group where
+ val (Group n) = n
+
-- | Makes a Group with the same name as the User.
userGroup :: User -> Group
userGroup (User u) = Group u
@@ -148,5 +158,5 @@ userGroup (User u) = Group u
newtype Port = Port Int
deriving (Eq, Ord, Show)
-fromPort :: Port -> String
-fromPort (Port p) = show p
+instance ConfigurableValue Port where
+ val (Port p) = show p
diff --git a/src/Propellor/Types/ZFS.hs b/src/Propellor/Types/ZFS.hs
index 3ce4b22c..22b848fa 100644
--- a/src/Propellor/Types/ZFS.hs
+++ b/src/Propellor/Types/ZFS.hs
@@ -6,6 +6,8 @@
module Propellor.Types.ZFS where
+import Propellor.Types.ConfigurableValue
+
import Data.String
import qualified Data.Set as Set
import qualified Data.String.Utils as SU
@@ -32,24 +34,27 @@ toPropertyList = Set.foldr (\p l -> l ++ [toPair p]) []
fromPropertyList :: [(String, String)] -> ZFSProperties
fromPropertyList props =
- Set.fromList $ map fromPair props
+ Set.fromList $ map fromPair props
zfsName :: ZFS -> String
zfsName (ZFS (ZPool pool) dataset) = intercalate "/" [pool, show dataset]
+instance ConfigurableValue ZDataset where
+ val (ZDataset paths) = intercalate "/" paths
+
instance Show ZDataset where
- show (ZDataset paths) = intercalate "/" paths
+ show = val
instance IsString ZDataset where
- fromString s = ZDataset $ SU.split "/" s
+ fromString s = ZDataset $ SU.split "/" s
instance IsString ZPool where
- fromString p = ZPool p
+ fromString p = ZPool p
class Value a where
- toValue :: a -> String
- fromValue :: (IsString a) => String -> a
- fromValue = fromString
+ toValue :: a -> String
+ fromValue :: (IsString a) => String -> a
+ fromValue = fromString
data ZFSYesNo = ZFSYesNo Bool deriving (Show, Eq, Ord)
data ZFSOnOff = ZFSOnOff Bool deriving (Show, Eq, Ord)
@@ -57,57 +62,57 @@ data ZFSSize = ZFSSize Integer deriving (Show, Eq, Ord)
data ZFSString = ZFSString String deriving (Show, Eq, Ord)
instance Value ZFSYesNo where
- toValue (ZFSYesNo True) = "yes"
- toValue (ZFSYesNo False) = "no"
+ toValue (ZFSYesNo True) = "yes"
+ toValue (ZFSYesNo False) = "no"
instance Value ZFSOnOff where
- toValue (ZFSOnOff True) = "on"
- toValue (ZFSOnOff False) = "off"
+ toValue (ZFSOnOff True) = "on"
+ toValue (ZFSOnOff False) = "off"
instance Value ZFSSize where
- toValue (ZFSSize s) = show s
+ toValue (ZFSSize s) = show s
instance Value ZFSString where
- toValue (ZFSString s) = s
+ toValue (ZFSString s) = s
instance IsString ZFSString where
- fromString = ZFSString
+ fromString = ZFSString
instance IsString ZFSYesNo where
- fromString "yes" = ZFSYesNo True
- fromString "no" = ZFSYesNo False
- fromString _ = error "Not yes or no"
+ fromString "yes" = ZFSYesNo True
+ fromString "no" = ZFSYesNo False
+ fromString _ = error "Not yes or no"
instance IsString ZFSOnOff where
- fromString "on" = ZFSOnOff True
- fromString "off" = ZFSOnOff False
- fromString _ = error "Not on or off"
+ fromString "on" = ZFSOnOff True
+ fromString "off" = ZFSOnOff False
+ fromString _ = error "Not on or off"
data ZFSACLInherit = AIDiscard | AINoAllow | AISecure | AIPassthrough deriving (Show, Eq, Ord)
instance IsString ZFSACLInherit where
- fromString "discard" = AIDiscard
- fromString "noallow" = AINoAllow
- fromString "secure" = AISecure
- fromString "passthrough" = AIPassthrough
- fromString _ = error "Not valid aclpassthrough value"
+ fromString "discard" = AIDiscard
+ fromString "noallow" = AINoAllow
+ fromString "secure" = AISecure
+ fromString "passthrough" = AIPassthrough
+ fromString _ = error "Not valid aclpassthrough value"
instance Value ZFSACLInherit where
- toValue AIDiscard = "discard"
- toValue AINoAllow = "noallow"
- toValue AISecure = "secure"
- toValue AIPassthrough = "passthrough"
+ toValue AIDiscard = "discard"
+ toValue AINoAllow = "noallow"
+ toValue AISecure = "secure"
+ toValue AIPassthrough = "passthrough"
data ZFSACLMode = AMDiscard | AMGroupmask | AMPassthrough deriving (Show, Eq, Ord)
instance IsString ZFSACLMode where
- fromString "discard" = AMDiscard
- fromString "groupmask" = AMGroupmask
- fromString "passthrough" = AMPassthrough
- fromString _ = error "Invalid zfsaclmode"
+ fromString "discard" = AMDiscard
+ fromString "groupmask" = AMGroupmask
+ fromString "passthrough" = AMPassthrough
+ fromString _ = error "Invalid zfsaclmode"
instance Value ZFSACLMode where
- toValue AMDiscard = "discard"
- toValue AMGroupmask = "groupmask"
- toValue AMPassthrough = "passthrough"
+ toValue AMDiscard = "discard"
+ toValue AMGroupmask = "groupmask"
+ toValue AMPassthrough = "passthrough"
data ZFSProperty = Mounted ZFSYesNo
| Mountpoint ZFSString