    -- | 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)