Make shrinkByType aware of individual disks

When shrinking an instances, you can't just get smaller disk footprint
while leaving the individual disks as they are. Make the shrink
heuristic aware of that fact, and decrease all individual disks as
well. Fixes issue 484.

Signed-off-by: Klaus Aehlig <aehlig@google.com>
Reviewed-by: Thomas Thrainer <thomasth@google.com>

diff --git a/src/Ganeti/HTools/Instance.hs b/src/Ganeti/HTools/Instance.hs
index cfda115..172d6a3 100644 (file)
--- a/src/Ganeti/HTools/Instance.hs
+++ b/src/Ganeti/HTools/Instance.hs
@@ -246,10 +246,12 @@ shrinkByType inst T.FailMem = let v = mem inst - T.unitMem
                               in if v < T.unitMem
                                  then Bad "out of memory"
                                  else Ok inst { mem = v }
-shrinkByType inst T.FailDisk = let v = dsk inst - T.unitDsk
-                               in if v < T.unitDsk
-                                  then Bad "out of disk"
-                                  else Ok inst { dsk = v }
+shrinkByType inst T.FailDisk =
+  let newdisks = map (flip (-) T.unitDsk) $ disks inst
+      v = dsk inst - (length . disks $ inst) * T.unitDsk
+  in if any (< T.unitDsk) newdisks
+     then Bad "out of disk"
+     else Ok inst { dsk = v, disks = newdisks }
 shrinkByType inst T.FailCPU = let v = vcpus inst - T.unitCpu
                               in if v < T.unitCpu
                                  then Bad "out of vcpus"

diff --git a/test/hs/Test/Ganeti/HTools/Instance.hs b/test/hs/Test/Ganeti/HTools/Instance.hs
index ca8f682..54ce529 100644 (file)
--- a/test/hs/Test/Ganeti/HTools/Instance.hs
+++ b/test/hs/Test/Ganeti/HTools/Instance.hs
@@ -178,7 +178,7 @@ prop_shrinkDG inst =
 prop_shrinkDF :: Instance.Instance -> Property
 prop_shrinkDF inst =
   forAll (choose (0, 2 * Types.unitDsk - 1)) $ \dsk ->
-    let inst' = inst { Instance.dsk = dsk }
+    let inst' = inst { Instance.dsk = dsk, Instance.disks = [dsk] }
     in isBad $ Instance.shrinkByType inst' Types.FailDisk
 
 prop_setMovable :: Instance.Instance -> Bool -> Property