summaryrefslogtreecommitdiff
path: root/src/Propellor/Types
diff options
context:
space:
mode:
Diffstat (limited to 'src/Propellor/Types')
-rw-r--r--src/Propellor/Types/OS.hs22
-rw-r--r--src/Propellor/Types/ZFS.hs133
2 files changed, 155 insertions, 0 deletions
diff --git a/src/Propellor/Types/OS.hs b/src/Propellor/Types/OS.hs
index c302d11d..5b425f71 100644
--- a/src/Propellor/Types/OS.hs
+++ b/src/Propellor/Types/OS.hs
@@ -4,6 +4,8 @@ module Propellor.Types.OS (
System(..),
Distribution(..),
DebianSuite(..),
+ FreeBSDRelease(..),
+ FBSDVersion(..),
isStable,
Release,
Architecture,
@@ -17,6 +19,7 @@ module Propellor.Types.OS (
import Network.BSD (HostName)
import Data.Typeable
+import Data.String
-- | High level description of a operating system.
data System = System Distribution Architecture
@@ -25,6 +28,7 @@ data System = System Distribution Architecture
data Distribution
= Debian DebianSuite
| Buntish Release -- ^ A well-known Debian derivative founded by a space tourist. The actual name of this distribution is not used in Propellor per <http://joeyh.name/blog/entry/trademark_nonsense/>)
+ | FreeBSD FreeBSDRelease
deriving (Show, Eq)
-- | Debian has several rolling suites, and a number of stable releases,
@@ -32,6 +36,24 @@ data Distribution
data DebianSuite = Experimental | Unstable | Testing | Stable Release
deriving (Show, Eq)
+-- | FreeBSD breaks their releases into "Production" and "Legacy".
+data FreeBSDRelease = FBSDProduction FBSDVersion | FBSDLegacy FBSDVersion
+ deriving (Show, Eq)
+
+data FBSDVersion = FBSD101 | FBSD102 | FBSD093
+ deriving (Eq)
+
+instance IsString FBSDVersion where
+ fromString "10.1-RELEASE" = FBSD101
+ fromString "10.2-RELEASE" = FBSD102
+ fromString "9.3-RELEASE" = FBSD093
+ fromString _ = error "Invalid FreeBSD release"
+
+instance Show FBSDVersion where
+ show FBSD101 = "10.1-RELEASE"
+ show FBSD102 = "10.2-RELEASE"
+ show FBSD093 = "9.3-RELEASE"
+
isStable :: DebianSuite -> Bool
isStable (Stable _) = True
isStable _ = False
diff --git a/src/Propellor/Types/ZFS.hs b/src/Propellor/Types/ZFS.hs
new file mode 100644
index 00000000..8784c641
--- /dev/null
+++ b/src/Propellor/Types/ZFS.hs
@@ -0,0 +1,133 @@
+-- | Types for ZFS Properties.
+--
+-- Copyright 2016 Evan Cofsky <evan@theunixman.com>
+-- License: BSD 2-clause
+
+module Propellor.Types.ZFS where
+
+import Data.String
+import qualified Data.Set as Set
+import qualified Data.String.Utils as SU
+import Data.List
+
+-- | A single ZFS filesystem.
+data ZFS = ZFS ZPool ZDataset deriving (Show, Eq, Ord)
+
+-- | Represents a zpool.
+data ZPool = ZPool String deriving (Show, Eq, Ord)
+
+-- | Represents a dataset in a zpool.
+--
+-- Can be constructed from a / separated string.
+data ZDataset = ZDataset [String] deriving (Eq, Ord)
+
+type ZFSProperties = Set.Set ZFSProperty
+
+fromList :: [ZFSProperty] -> ZFSProperties
+fromList = Set.fromList
+
+toPropertyList :: ZFSProperties -> [(String, String)]
+toPropertyList = Set.foldr (\p l -> l ++ [toPair p]) []
+
+fromPropertyList :: [(String, String)] -> ZFSProperties
+fromPropertyList props =
+ Set.fromList $ map fromPair props
+
+zfsName :: ZFS -> String
+zfsName (ZFS (ZPool pool) dataset) = intercalate "/" [pool, show dataset]
+
+instance Show ZDataset where
+ show (ZDataset paths) = intercalate "/" paths
+
+instance IsString ZDataset where
+ fromString s = ZDataset $ SU.split "/" s
+
+instance IsString ZPool where
+ fromString p = ZPool p
+
+class Value a where
+ 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)
+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"
+
+instance Value ZFSOnOff where
+ toValue (ZFSOnOff True) = "on"
+ toValue (ZFSOnOff False) = "off"
+
+instance Value ZFSSize where
+ toValue (ZFSSize s) = show s
+
+instance Value ZFSString where
+ toValue (ZFSString s) = s
+
+instance IsString ZFSString where
+ fromString = ZFSString
+
+instance IsString ZFSYesNo where
+ 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"
+
+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"
+
+instance Value ZFSACLInherit where
+ 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"
+
+instance Value ZFSACLMode where
+ toValue AMDiscard = "discard"
+ toValue AMGroupmask = "groupmask"
+ toValue AMPassthrough = "passthrough"
+
+data ZFSProperty = Mounted ZFSYesNo
+ | Mountpoint ZFSString
+ | ReadOnly ZFSYesNo
+ | ACLInherit ZFSACLInherit
+ | ACLMode ZFSACLMode
+ | StringProperty String ZFSString
+ deriving (Show, Eq, Ord)
+
+toPair :: ZFSProperty -> (String, String)
+toPair (Mounted v) = ("mounted", toValue v)
+toPair (Mountpoint v) = ("mountpoint", toValue v)
+toPair (ReadOnly v) = ("readonly", toValue v)
+toPair (ACLInherit v) = ("aclinherit", toValue v)
+toPair (ACLMode v) = ("aclmode", toValue v)
+toPair (StringProperty s v) = (s, toValue v)
+
+fromPair :: (String, String) -> ZFSProperty
+fromPair ("mounted", v) = Mounted (fromString v)
+fromPair ("mountpoint", v) = Mountpoint (fromString v)
+fromPair ("readonly", v) = ReadOnly (fromString v)
+fromPair ("aclinherit", v) = ACLInherit (fromString v)
+fromPair ("aclmode", v) = ACLMode (fromString v)
+fromPair (s, v) = StringProperty s (fromString v)