-- | Maintainer: Nicolas Schodet <nico@ni.fr.eu.org>
--
-- Support for LVM logical volumes.

module Propellor.Property.Lvm (
	lvFormatted,
	installed,
	Eep(..),
	VolumeGroup(..),
	LogicalVolume(..),
) where

import Propellor
import Propellor.Base
import Utility.DataUnits
import qualified Propellor.Property.Apt as Apt
import qualified Propellor.Property.Mount as Mount
import qualified Propellor.Property.Partition as Partition

data Eep = YesReallyFormatLogicalVolume

type DataSize = String

newtype VolumeGroup = VolumeGroup String
data LogicalVolume = LogicalVolume String VolumeGroup

-- | Create or resize a logical volume, and make sure it is formatted.  When
-- reverted, remove the logical volume.
--
-- Example use:
--
-- > import qualified Propellor.Property.Lvm as Lvm
-- > import qualified Propellor.Property.Partition as Partition
-- > Lvm.lvFormatted Lvm.YesReallyFormatLogicalVolume
-- >         (Lvm.LogicalVolume "test" (Lvm.VolumeGroup "vg0")) "16m"
-- >         Partition.EXT4
--
-- If size and filesystem match, nothing is done.
--
-- Volume group must have been created already.
lvFormatted
	:: Eep
	-> LogicalVolume
	-> DataSize
	-> Partition.Fs
	-> RevertableProperty DebianLike UnixLike
lvFormatted :: Eep
-> LogicalVolume
-> DataSize
-> Fs
-> RevertableProperty DebianLike UnixLike
lvFormatted Eep
YesReallyFormatLogicalVolume LogicalVolume
lv DataSize
sz Fs
fs =
	Property DebianLike
setup Property DebianLike
-> Property UnixLike -> RevertableProperty DebianLike UnixLike
forall setupmetatypes undometatypes.
Property setupmetatypes
-> Property undometatypes
-> RevertableProperty setupmetatypes undometatypes
<!> Property UnixLike
cleanup
  where
	setup :: Property DebianLike
	setup :: Property DebianLike
setup = DataSize
-> (OuterMetaTypesWitness
      '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish]
    -> Propellor Result)
-> Property DebianLike
forall k (metatypes :: k).
SingI metatypes =>
DataSize
-> (OuterMetaTypesWitness metatypes -> Propellor Result)
-> Property (MetaTypes metatypes)
property' (DataSize
"formatted logical volume " DataSize -> DataSize -> DataSize
forall a. [a] -> [a] -> [a]
++ (LogicalVolume -> DataSize
vglv LogicalVolume
lv)) ((OuterMetaTypesWitness
    '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish]
  -> Propellor Result)
 -> Property DebianLike)
-> (OuterMetaTypesWitness
      '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish]
    -> Propellor Result)
-> Property DebianLike
forall a b. (a -> b) -> a -> b
$ \OuterMetaTypesWitness
  '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish]
w -> do
		Maybe Integer
es <- IO (Maybe Integer) -> Propellor (Maybe Integer)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Integer) -> Propellor (Maybe Integer))
-> IO (Maybe Integer) -> Propellor (Maybe Integer)
forall a b. (a -> b) -> a -> b
$ VolumeGroup -> IO (Maybe Integer)
vgExtentSize VolumeGroup
vg
		case Maybe Integer
es of
			Maybe Integer
Nothing -> DataSize -> Propellor Result
forall (m :: * -> *) a. MonadIO m => DataSize -> m a
errorMessage (DataSize -> Propellor Result) -> DataSize -> Propellor Result
forall a b. (a -> b) -> a -> b
$
				DataSize
"can not get extent size, does volume group "
				DataSize -> DataSize -> DataSize
forall a. [a] -> [a] -> [a]
++ DataSize
vgname DataSize -> DataSize -> DataSize
forall a. [a] -> [a] -> [a]
++ DataSize
" exist?"
			Just Integer
extentSize -> do
				case Maybe Integer
parseSize of
					Maybe Integer
Nothing -> DataSize -> Propellor Result
forall (m :: * -> *) a. MonadIO m => DataSize -> m a
errorMessage 
						DataSize
"can not parse volume group size"
					Just Integer
size -> do
						Maybe LvState
state <- IO (Maybe LvState) -> Propellor (Maybe LvState)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe LvState) -> Propellor (Maybe LvState))
-> IO (Maybe LvState) -> Propellor (Maybe LvState)
forall a b. (a -> b) -> a -> b
$ LogicalVolume -> IO (Maybe LvState)
lvState LogicalVolume
lv
						let rsize :: Integer
rsize = Integer -> Integer -> Integer
roundSize Integer
extentSize Integer
size
						OuterMetaTypesWitness
  '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish]
-> Property DebianLike -> Propellor Result
forall (inner :: [MetaType]) (outer :: [MetaType]).
EnsurePropertyAllowed inner outer =>
OuterMetaTypesWitness outer
-> Property (MetaTypes inner) -> Propellor Result
ensureProperty OuterMetaTypesWitness
  '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish]
w (Property DebianLike -> Propellor Result)
-> Property DebianLike -> Propellor Result
forall a b. (a -> b) -> a -> b
$
							Integer -> Maybe LvState -> Property DebianLike
setupprop Integer
rsize Maybe LvState
state

	cleanup :: Property UnixLike
	cleanup :: Property UnixLike
cleanup = DataSize
-> (OuterMetaTypesWitness
      '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
         'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD]
    -> Propellor Result)
-> Property UnixLike
forall k (metatypes :: k).
SingI metatypes =>
DataSize
-> (OuterMetaTypesWitness metatypes -> Propellor Result)
-> Property (MetaTypes metatypes)
property' (DataSize
"removed logical volume " DataSize -> DataSize -> DataSize
forall a. [a] -> [a] -> [a]
++ (LogicalVolume -> DataSize
vglv LogicalVolume
lv)) ((OuterMetaTypesWitness
    '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
       'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD]
  -> Propellor Result)
 -> Property UnixLike)
-> (OuterMetaTypesWitness
      '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
         'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD]
    -> Propellor Result)
-> Property UnixLike
forall a b. (a -> b) -> a -> b
$ \OuterMetaTypesWitness
  '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
     'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD]
w -> do
		Bool
exists <- IO Bool -> Propellor Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> Propellor Bool) -> IO Bool -> Propellor Bool
forall a b. (a -> b) -> a -> b
$ LogicalVolume -> IO Bool
lvExists LogicalVolume
lv
		OuterMetaTypesWitness
  '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
     'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD]
-> Property UnixLike -> Propellor Result
forall (inner :: [MetaType]) (outer :: [MetaType]).
EnsurePropertyAllowed inner outer =>
OuterMetaTypesWitness outer
-> Property (MetaTypes inner) -> Propellor Result
ensureProperty OuterMetaTypesWitness
  '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
     'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD]
w (Property UnixLike -> Propellor Result)
-> Property UnixLike -> Propellor Result
forall a b. (a -> b) -> a -> b
$ if Bool
exists
			then Property UnixLike
removedprop
			else Property UnixLike
forall k (t :: k). SingI t => Property (MetaTypes t)
doNothing

	-- Parse size.
	parseSize :: Maybe Integer
	parseSize :: Maybe Integer
parseSize = [Unit] -> DataSize -> Maybe Integer
readSize [Unit]
dataUnits DataSize
sz

	-- Round size to next extent size multiple.
	roundSize :: Integer -> Integer -> Integer
	roundSize :: Integer -> Integer -> Integer
roundSize Integer
extentSize Integer
s =
		(Integer
s Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
extentSize Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
1) Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`div` Integer
extentSize Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
extentSize

	-- Dispatch to the right props.
	setupprop :: Integer -> (Maybe LvState) -> Property DebianLike
	setupprop :: Integer -> Maybe LvState -> Property DebianLike
setupprop Integer
size Maybe LvState
Nothing = Integer -> Property UnixLike
createdprop Integer
size Property UnixLike
-> Property DebianLike
-> CombinedType (Property UnixLike) (Property DebianLike)
forall x y. Combines x y => x -> y -> CombinedType x y
`before` Property DebianLike
formatprop
	setupprop Integer
size (Just (LvState Integer
csize Maybe Fs
cfs))
		| Integer
size Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
csize Bool -> Bool -> Bool
&& Fs -> Maybe Fs -> Bool
fsMatch Fs
fs Maybe Fs
cfs = Property DebianLike
forall k (t :: k). SingI t => Property (MetaTypes t)
doNothing
		| Integer
size Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
csize = Property DebianLike
formatprop
		| Fs -> Maybe Fs -> Bool
fsMatch Fs
fs Maybe Fs
cfs = Property UnixLike -> Property DebianLike
forall (p :: * -> *) (untightened :: [MetaType])
       (tightened :: [MetaType]).
(TightenTargets p, TightenTargetsAllowed untightened tightened,
 SingI tightened) =>
p (MetaTypes untightened) -> p (MetaTypes tightened)
tightenTargets (Property UnixLike -> Property DebianLike)
-> Property UnixLike -> Property DebianLike
forall a b. (a -> b) -> a -> b
$ Integer -> Bool -> Property UnixLike
resizedprop Integer
size Bool
True
		| Bool
otherwise = Integer -> Bool -> Property UnixLike
resizedprop Integer
size Bool
False Property UnixLike
-> Property DebianLike
-> CombinedType (Property UnixLike) (Property DebianLike)
forall x y. Combines x y => x -> y -> CombinedType x y
`before` Property DebianLike
formatprop

	createdprop :: Integer -> Property UnixLike
	createdprop :: Integer -> Property UnixLike
createdprop Integer
size =
		DataSize -> [DataSize] -> UncheckedProperty UnixLike
cmdProperty DataSize
"lvcreate"
			(Integer -> [DataSize] -> [DataSize]
forall a. Show a => a -> [DataSize] -> [DataSize]
bytes Integer
size ([DataSize] -> [DataSize]) -> [DataSize] -> [DataSize]
forall a b. (a -> b) -> a -> b
$ [ DataSize
"-n", DataSize
lvname, DataSize
"--yes", DataSize
vgname ])
			UncheckedProperty UnixLike -> Result -> Property UnixLike
forall (p :: * -> *) i.
Checkable p i =>
p i -> Result -> Property i
`assume` Result
MadeChange

	resizedprop :: Integer -> Bool -> Property UnixLike
	resizedprop :: Integer -> Bool -> Property UnixLike
resizedprop Integer
size Bool
rfs =
		DataSize -> [DataSize] -> UncheckedProperty UnixLike
cmdProperty DataSize
"lvresize"
			(Bool -> [DataSize] -> [DataSize]
resizeFs Bool
rfs ([DataSize] -> [DataSize]) -> [DataSize] -> [DataSize]
forall a b. (a -> b) -> a -> b
$ Integer -> [DataSize] -> [DataSize]
forall a. Show a => a -> [DataSize] -> [DataSize]
bytes Integer
size ([DataSize] -> [DataSize]) -> [DataSize] -> [DataSize]
forall a b. (a -> b) -> a -> b
$ [ LogicalVolume -> DataSize
vglv LogicalVolume
lv ])
			UncheckedProperty UnixLike -> Result -> Property UnixLike
forall (p :: * -> *) i.
Checkable p i =>
p i -> Result -> Property i
`assume` Result
MadeChange
	  where
		resizeFs :: Bool -> [DataSize] -> [DataSize]
resizeFs Bool
True [DataSize]
l = DataSize
"-r" DataSize -> [DataSize] -> [DataSize]
forall a. a -> [a] -> [a]
: [DataSize]
l
		resizeFs Bool
False [DataSize]
l = [DataSize]
l

	removedprop :: Property UnixLike
	removedprop :: Property UnixLike
removedprop = DataSize -> [DataSize] -> UncheckedProperty UnixLike
cmdProperty DataSize
"lvremove" [ DataSize
"-f", LogicalVolume -> DataSize
vglv LogicalVolume
lv ]
		UncheckedProperty UnixLike -> Result -> Property UnixLike
forall (p :: * -> *) i.
Checkable p i =>
p i -> Result -> Property i
`assume` Result
MadeChange

	formatprop :: Property DebianLike
	formatprop :: Property DebianLike
formatprop = Eep -> Fs -> DataSize -> Property DebianLike
Partition.formatted Eep
Partition.YesReallyFormatPartition
		Fs
fs (LogicalVolume -> DataSize
path LogicalVolume
lv)

	fsMatch :: Partition.Fs -> Maybe Partition.Fs -> Bool
	fsMatch :: Fs -> Maybe Fs -> Bool
fsMatch Fs
a (Just Fs
b) = Fs
a Fs -> Fs -> Bool
forall a. Eq a => a -> a -> Bool
== Fs
b
	fsMatch Fs
_ Maybe Fs
_ = Bool
False

	bytes :: a -> [DataSize] -> [DataSize]
bytes a
size [DataSize]
l = DataSize
"-L" DataSize -> [DataSize] -> [DataSize]
forall a. a -> [a] -> [a]
: ((a -> DataSize
forall a. Show a => a -> DataSize
show a
size) DataSize -> DataSize -> DataSize
forall a. [a] -> [a] -> [a]
++ DataSize
"b") DataSize -> [DataSize] -> [DataSize]
forall a. a -> [a] -> [a]
: [DataSize]
l

	(LogicalVolume DataSize
lvname vg :: VolumeGroup
vg@(VolumeGroup DataSize
vgname)) = LogicalVolume
lv

-- | Make sure needed tools are installed.
installed :: RevertableProperty DebianLike DebianLike
installed :: RevertableProperty DebianLike DebianLike
installed = Property DebianLike
install Property DebianLike
-> Property DebianLike -> RevertableProperty DebianLike DebianLike
forall setupmetatypes undometatypes.
Property setupmetatypes
-> Property undometatypes
-> RevertableProperty setupmetatypes undometatypes
<!> Property DebianLike
remove
  where
	install :: Property DebianLike
install = [DataSize] -> Property DebianLike
Apt.installed [DataSize
"lvm2"]
	remove :: Property DebianLike
remove = [DataSize] -> Property DebianLike
Apt.removed [DataSize
"lvm2"]

data LvState = LvState Integer (Maybe Partition.Fs)

-- Check for logical volume existance.
lvExists :: LogicalVolume -> IO Bool
lvExists :: LogicalVolume -> IO Bool
lvExists LogicalVolume
lv = DataSize -> IO Bool
doesFileExist (LogicalVolume -> DataSize
path LogicalVolume
lv)

-- Return Nothing if logical volume does not exists (or error), else return
-- its size and maybe file system.
lvState :: LogicalVolume -> IO (Maybe LvState)
lvState :: LogicalVolume -> IO (Maybe LvState)
lvState LogicalVolume
lv = do
	Bool
exists <- LogicalVolume -> IO Bool
lvExists LogicalVolume
lv
	if Bool -> Bool
not Bool
exists
		then Maybe LvState -> IO (Maybe LvState)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe LvState
forall a. Maybe a
Nothing
		else do
			Maybe Integer
s <- IO (Maybe Integer)
readLvSize
			Maybe Fs
fs <- Maybe Fs -> (DataSize -> Maybe Fs) -> Maybe DataSize -> Maybe Fs
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Maybe Fs
forall a. Maybe a
Nothing DataSize -> Maybe Fs
Partition.parseFs (Maybe DataSize -> Maybe Fs)
-> IO (Maybe DataSize) -> IO (Maybe Fs)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO (Maybe DataSize)
readFs
			Maybe LvState -> IO (Maybe LvState)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe LvState -> IO (Maybe LvState))
-> Maybe LvState -> IO (Maybe LvState)
forall a b. (a -> b) -> a -> b
$ do
				Integer
size <- Maybe Integer
s
				LvState -> Maybe LvState
forall (m :: * -> *) a. Monad m => a -> m a
return (LvState -> Maybe LvState) -> LvState -> Maybe LvState
forall a b. (a -> b) -> a -> b
$ Integer -> Maybe Fs -> LvState
LvState Integer
size Maybe Fs
fs
  where
	readLvSize :: IO (Maybe Integer)
readLvSize = Maybe Integer -> IO (Maybe Integer) -> IO (Maybe Integer)
forall (m :: * -> *) a. MonadCatch m => a -> m a -> m a
catchDefaultIO Maybe Integer
forall a. Maybe a
Nothing (IO (Maybe Integer) -> IO (Maybe Integer))
-> IO (Maybe Integer) -> IO (Maybe Integer)
forall a b. (a -> b) -> a -> b
$ DataSize -> Maybe Integer
forall a. Read a => DataSize -> Maybe a
readish
		(DataSize -> Maybe Integer) -> IO DataSize -> IO (Maybe Integer)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> DataSize -> [DataSize] -> IO DataSize
readProcess DataSize
"lvs" [ DataSize
"-o", DataSize
"size", DataSize
"--noheadings",
			DataSize
"--nosuffix", DataSize
"--units", DataSize
"b", LogicalVolume -> DataSize
vglv LogicalVolume
lv ]
	readFs :: IO (Maybe DataSize)
readFs = DataSize -> DataSize -> IO (Maybe DataSize)
Mount.blkidTag DataSize
"TYPE" (LogicalVolume -> DataSize
path LogicalVolume
lv)

-- Read extent size (or Nothing on error).
vgExtentSize :: VolumeGroup -> IO (Maybe Integer)
vgExtentSize :: VolumeGroup -> IO (Maybe Integer)
vgExtentSize (VolumeGroup DataSize
vgname) =
	Maybe Integer -> IO (Maybe Integer) -> IO (Maybe Integer)
forall (m :: * -> *) a. MonadCatch m => a -> m a -> m a
catchDefaultIO Maybe Integer
forall a. Maybe a
Nothing (IO (Maybe Integer) -> IO (Maybe Integer))
-> IO (Maybe Integer) -> IO (Maybe Integer)
forall a b. (a -> b) -> a -> b
$ DataSize -> Maybe Integer
forall a. Read a => DataSize -> Maybe a
readish
		(DataSize -> Maybe Integer) -> IO DataSize -> IO (Maybe Integer)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> DataSize -> [DataSize] -> IO DataSize
readProcess DataSize
"vgs" [ DataSize
"-o", DataSize
"vg_extent_size",
			DataSize
"--noheadings", DataSize
"--nosuffix", DataSize
"--units", DataSize
"b", DataSize
vgname ]

-- Give "vgname/lvname" for a LogicalVolume.
vglv :: LogicalVolume -> String
vglv :: LogicalVolume -> DataSize
vglv LogicalVolume
lv =
	DataSize
vgname DataSize -> DataSize -> DataSize
</> DataSize
lvname
  where
	(LogicalVolume DataSize
lvname (VolumeGroup DataSize
vgname)) = LogicalVolume
lv

-- Give device path.
path :: LogicalVolume -> FilePath
path :: LogicalVolume -> DataSize
path LogicalVolume
lv = DataSize
"/dev" DataSize -> DataSize -> DataSize
</> (LogicalVolume -> DataSize
vglv LogicalVolume
lv)