-- | Maintainer: 2016 Evan Cofsky <evan@theunixman.com>
-- 
-- Functions defining zfs Properties.

module Propellor.Property.ZFS.Properties (
	ZFSOS,
	zfsExists,
	zfsSetProperties
) where

import Propellor.Base
import Data.List (intercalate)
import qualified Propellor.Property.ZFS.Process as ZP

-- | OS's that support ZFS
type ZFSOS = Linux + FreeBSD

-- | Will ensure that a ZFS volume exists with the specified mount point.
-- This requires the pool to exist as well, but we don't create pools yet.
zfsExists :: ZFS -> Property ZFSOS
zfsExists :: ZFS -> Property ZFSOS
zfsExists ZFS
z = IO Bool -> UncheckedProperty UnixLike -> Property UnixLike
forall (p :: * -> *) i (m :: * -> *).
(Checkable p i, LiftPropellor m) =>
m Bool -> p i -> Property i
check (Bool -> Bool
not (Bool -> Bool) -> IO Bool -> IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ZFS -> IO Bool
ZP.zfsExists ZFS
z) UncheckedProperty UnixLike
create
	Property UnixLike -> Desc -> Property UnixLike
forall p. IsProp p => p -> Desc -> p
`describe` [Desc] -> Desc
unwords [Desc
"Creating", ZFS -> Desc
zfsName ZFS
z]
  where
	(Desc
p, [Desc]
a) = Desc -> [Maybe Desc] -> ZFS -> (Desc, [Desc])
ZP.zfsCommand Desc
"create" [Maybe Desc
forall a. Maybe a
Nothing] ZFS
z
	create :: UncheckedProperty UnixLike
create = Desc -> [Desc] -> UncheckedProperty UnixLike
cmdProperty Desc
p [Desc]
a

-- | Sets the given properties. Returns True if all were successfully changed, False if not.
zfsSetProperties :: ZFS -> ZFSProperties -> Property ZFSOS
zfsSetProperties :: ZFS -> ZFSProperties -> Property ZFSOS
zfsSetProperties ZFS
z ZFSProperties
setProperties = Property UnixLike
setall
	Property UnixLike
-> Property UnixLike
-> CombinedType (Property UnixLike) (Property UnixLike)
forall x y. Combines x y => x -> y -> CombinedType x y
`requires` ZFS -> Property ZFSOS
zfsExists ZFS
z
  where
	spcmd :: String -> String -> (String, [String])
	spcmd :: Desc -> Desc -> (Desc, [Desc])
spcmd Desc
p Desc
v = Desc -> [Maybe Desc] -> ZFS -> (Desc, [Desc])
ZP.zfsCommand Desc
"set" [Desc -> Maybe Desc
forall a. a -> Maybe a
Just (Desc -> [Desc] -> Desc
forall a. [a] -> [[a]] -> [a]
intercalate Desc
"=" [Desc
p, Desc
v]), Maybe Desc
forall a. Maybe a
Nothing] ZFS
z

	setprop :: (String, String) -> Property ZFSOS
	setprop :: (Desc, Desc) -> Property ZFSOS
setprop (Desc
p, Desc
v) = IO Bool -> UncheckedProperty UnixLike -> Property UnixLike
forall (p :: * -> *) i (m :: * -> *).
(Checkable p i, LiftPropellor m) =>
m Bool -> p i -> Property i
check (ZFS -> IO Bool
ZP.zfsExists ZFS
z) (UncheckedProperty UnixLike -> Property UnixLike)
-> UncheckedProperty UnixLike -> Property UnixLike
forall a b. (a -> b) -> a -> b
$
		Desc -> [Desc] -> UncheckedProperty UnixLike
cmdProperty ((Desc, [Desc]) -> Desc
forall a b. (a, b) -> a
fst (Desc -> Desc -> (Desc, [Desc])
spcmd Desc
p Desc
v)) ((Desc, [Desc]) -> [Desc]
forall a b. (a, b) -> b
snd (Desc -> Desc -> (Desc, [Desc])
spcmd Desc
p Desc
v))

	setall :: Property UnixLike
setall = Desc -> Props UnixLike -> Property UnixLike
forall k (metatypes :: k).
SingI metatypes =>
Desc
-> Props (MetaTypes metatypes) -> Property (MetaTypes metatypes)
combineProperties ([Desc] -> Desc
unwords [Desc
"Setting properties on", ZFS -> Desc
zfsName ZFS
z]) (Props UnixLike -> Property UnixLike)
-> Props UnixLike -> Property UnixLike
forall a b. (a -> b) -> a -> b
$
		[Property UnixLike] -> Props UnixLike
forall k (metatypes :: k).
[Property (MetaTypes metatypes)] -> Props (MetaTypes metatypes)
toProps ([Property UnixLike] -> Props UnixLike)
-> [Property UnixLike] -> Props UnixLike
forall a b. (a -> b) -> a -> b
$ ((Desc, Desc) -> Property UnixLike)
-> [(Desc, Desc)] -> [Property UnixLike]
forall a b. (a -> b) -> [a] -> [b]
map (Desc, Desc) -> Property UnixLike
(Desc, Desc) -> Property ZFSOS
setprop ([(Desc, Desc)] -> [Property UnixLike])
-> [(Desc, Desc)] -> [Property UnixLike]
forall a b. (a -> b) -> a -> b
$ ZFSProperties -> [(Desc, Desc)]
toPropertyList ZFSProperties
setProperties