    -- | 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
    		es <- IO (Maybe Integer) -> Propellor (Maybe Integer)
    forall a. IO a -> Propellor a
    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 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
    						state <- IO (Maybe LvState) -> Propellor (Maybe LvState)
    forall a. IO a -> Propellor a
    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 -> Integer -> Integer
    roundSize Integer
    extentSize Integer
    size
    						ensureProperty w $
    							setupprop rsize 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
    		exists <- IO Bool -> Propellor Bool
    forall a. IO a -> Propellor a
    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
    		ensureProperty w $ if exists
    			then removedprop
    			else 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 (untightened :: [MetaType]) (tightened :: [MetaType]).
    (TightenTargetsAllowed untightened tightened, SingI tightened) =>
    Property (MetaTypes untightened) -> Property (MetaTypes tightened)
    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
    	exists <- LogicalVolume -> IO Bool
    lvExists LogicalVolume
    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 :: 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)