-- | 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 YesReallyFormatLogicalVolume lv sz fs =
        setup <!> cleanup
  where
        setup :: Property DebianLike
        setup = property' ("formatted logical volume " ++ (vglv lv)) $ \w -> do
                es <- liftIO $ vgExtentSize vg
                case es of
                        Nothing -> errorMessage $
                                "can not get extent size, does volume group "
                                ++ vgname ++ " exist?"
                        Just extentSize -> do
                                case parseSize of
                                        Nothing -> errorMessage
                                                "can not parse volume group size"
                                        Just size -> do
                                                state <- liftIO $ lvState lv
                                                let rsize = roundSize extentSize size
                                                ensureProperty w $
                                                        setupprop rsize state

        cleanup :: Property UnixLike
        cleanup = property' ("removed logical volume " ++ (vglv lv)) $ \w -> do
                exists <- liftIO $ lvExists lv
                ensureProperty w $ if exists
                        then removedprop
                        else doNothing

        -- Parse size.
        parseSize :: Maybe Integer
        parseSize = readSize dataUnits sz

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

        -- Dispatch to the right props.
        setupprop :: Integer -> (Maybe LvState) -> Property DebianLike
        setupprop size Nothing = createdprop size `before` formatprop
        setupprop size (Just (LvState csize cfs))
                | size == csize && fsMatch fs cfs = doNothing
                | size == csize = formatprop
                | fsMatch fs cfs = tightenTargets $ resizedprop size True
                | otherwise = resizedprop size False `before` formatprop

        createdprop :: Integer -> Property UnixLike
        createdprop size =
                cmdProperty "lvcreate"
                        (bytes size $ [ "-n", lvname, "--yes", vgname ])
                        `assume` MadeChange

        resizedprop :: Integer -> Bool -> Property UnixLike
        resizedprop size rfs =
                cmdProperty "lvresize"
                        (resizeFs rfs $ bytes size $ [ vglv lv ])
                        `assume` MadeChange
          where
                resizeFs True l = "-r" : l
                resizeFs False l = l

        removedprop :: Property UnixLike
        removedprop = cmdProperty "lvremove" [ "-f", vglv lv ]
                `assume` MadeChange

        formatprop :: Property DebianLike
        formatprop = Partition.formatted Partition.YesReallyFormatPartition
                fs (path lv)

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

        bytes size l = "-L" : ((show size) ++ "b") : l

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

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

data LvState = LvState Integer (Maybe Partition.Fs)

-- Check for logical volume existance.
lvExists :: LogicalVolume -> IO Bool
lvExists lv = doesFileExist (path 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 lv = do
        exists <- lvExists lv
        if not exists
                then return Nothing
                else do
                        s <- readLvSize
                        fs <- maybe Nothing Partition.parseFs <$> readFs
                        return $ do
                                size <- s
                                return $ LvState size fs
  where
        readLvSize = catchDefaultIO Nothing $ readish
                <$> readProcess "lvs" [ "-o", "size", "--noheadings",
                        "--nosuffix", "--units", "b", vglv lv ]
        readFs = Mount.blkidTag "TYPE" (path lv)

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

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

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