{-# LANGUAGE ConstrainedClassMethods #-} -- | Types for ZFS Properties. -- -- Copyright 2016 Evan Cofsky -- License: BSD 2-clause module Propellor.Types.ZFS where import Propellor.Types.ConfigurableValue import Utility.Split import Data.String import qualified Data.Set as Set 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 ConfigurableValue ZDataset where val (ZDataset paths) = intercalate "/" paths instance Show ZDataset where show = val instance IsString ZDataset where fromString s = ZDataset $ splitc '/' 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)