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
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
parseSize :: Maybe Integer
parseSize :: Maybe Integer
parseSize = [Unit] -> DataSize -> Maybe Integer
readSize [Unit]
dataUnits DataSize
sz
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
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
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)
lvExists :: LogicalVolume -> IO Bool
lvExists :: LogicalVolume -> IO Bool
lvExists LogicalVolume
lv = DataSize -> IO Bool
doesFileExist (LogicalVolume -> DataSize
path LogicalVolume
lv)
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)
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 ]
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
path :: LogicalVolume -> FilePath
path :: LogicalVolume -> DataSize
path LogicalVolume
lv = DataSize
"/dev" DataSize -> DataSize -> DataSize
</> (LogicalVolume -> DataSize
vglv LogicalVolume
lv)