htools: update the node-evac/change-group result

… per the new design changes. This also requires changes to
updateEvacSolution, as passing in the original instance is not
helpful; we just pass the instance index now and look up the actual
instance in the modified instance map.

Signed-off-by: Iustin Pop <iustin@google.com>
Reviewed-by: Guido Trotter <ultrotter@google.com>

htools/Ganeti/HTools/Cluster.hs

@@ -110,8 +110,8 @@ data AllocSolution = AllocSolution
 -- type consists of actual opcodes (a restricted subset) that are
 -- transmitted back to Ganeti.
 data EvacSolution = EvacSolution
-    { esMoved   :: [String]             -- ^ Instance moved successfully
-    , esFailed  :: [String]             -- ^ Instance which were not
+    { esMoved   :: [(Idx, Gdx, [Ndx])]  -- ^ Instances moved successfully
+    , esFailed  :: [(Idx, String)]      -- ^ Instances which were not
                                         -- relocated
     , esOpCodes :: [[[OpCodes.OpCode]]] -- ^ List of lists of jobs
     }
@@ -1063,14 +1063,18 @@ availableGroupNodes group_nodes excl_ndx gdx = do
 -- | Updates the evac solution with the results of an instance
 -- evacuation.
 updateEvacSolution :: (Node.List, Instance.List, EvacSolution)
-                   -> Instance.Instance
+                   -> Idx
                    -> Result (Node.List, Instance.List, [OpCodes.OpCode])
                    -> (Node.List, Instance.List, EvacSolution)
-updateEvacSolution (nl, il, es) inst (Bad msg) =
-    (nl, il, es { esFailed = (Instance.name inst ++ ": " ++ msg):esFailed es})
-updateEvacSolution (_, _, es) inst (Ok (nl, il, opcodes)) =
-    (nl, il, es { esMoved = Instance.name inst:esMoved es
+updateEvacSolution (nl, il, es) idx (Bad msg) =
+    (nl, il, es { esFailed = (idx, msg):esFailed es})
+updateEvacSolution (_, _, es) idx (Ok (nl, il, opcodes)) =
+    (nl, il, es { esMoved = new_elem:esMoved es
                 , esOpCodes = [opcodes]:esOpCodes es })
+     where inst = Container.find idx il
+           new_elem = (idx,
+                       instancePriGroup nl inst,
+                       Instance.allNodes inst)
 
 -- | Node-evacuation IAllocator mode main function.
 tryNodeEvac :: Group.List    -- ^ The cluster groups
@@ -1088,7 +1092,7 @@ tryNodeEvac _ ini_nl ini_il mode idxs =
                       splitCluster ini_nl ini_il
         (_, _, esol) =
             foldl' (\state@(nl, il, _) inst ->
-                        updateEvacSolution state inst $
+                        updateEvacSolution state (Instance.idx inst) $
                         availableGroupNodes group_ndx
                           excl_ndx (instancePriGroup nl inst) >>=
                         nodeEvacInstance nl il mode inst
@@ -1144,13 +1148,13 @@ tryChangeGroup gl ini_nl ini_il gdxs idxs =
                               av_nodes <- availableGroupNodes group_ndx
                                           excl_ndx gdx
                               nodeEvacInstance nl il ChangeAll inst av_nodes
-                        in updateEvacSolution state inst solution
+                        in updateEvacSolution state
+                               (Instance.idx inst) solution
                    )
             (ini_nl, ini_il, emptyEvacSolution)
             (map (`Container.find` ini_il) idxs)
     in return $ reverseEvacSolution esol
 
-
 -- | Recursively place instances on the cluster until we're out of space.
 iterateAlloc :: Node.List
              -> Instance.List

htools/Ganeti/HTools/IAlloc.hs

@@ -241,10 +241,18 @@ formatAllocate as = do
     _ -> fail "Internal error: multiple allocation solutions"
 
 -- | Convert a node-evacuation/change group result.
-formatNodeEvac :: Cluster.EvacSolution -> Result IAllocResult
-formatNodeEvac es =
-    let fes = Cluster.esFailed es
-        mes = Cluster.esMoved es
+formatNodeEvac :: Group.List
+               -> Node.List
+               -> Instance.List
+               -> Cluster.EvacSolution
+               -> Result IAllocResult
+formatNodeEvac gl nl il es =
+    let iname = Instance.name . flip Container.find il
+        nname = Node.name . flip Container.find nl
+        gname = Group.name . flip Container.find gl
+        fes = map (\(idx, msg) -> (iname idx, msg)) $ Cluster.esFailed es
+        mes = map (\(idx, gdx, ndxs) -> (iname idx, gname gdx, map nname ndxs))
+              $ Cluster.esMoved es
         failed = length fes
         moved  = length mes
         info = show failed ++ " instances failed to move and " ++ show moved ++
@@ -263,9 +271,11 @@ processRequest request =
        Evacuate exnodes ->
            Cluster.tryMGEvac gl nl il exnodes >>= formatEvacuate
        ChangeGroup gdxs idxs ->
-           Cluster.tryChangeGroup gl nl il idxs gdxs >>= formatNodeEvac
+           Cluster.tryChangeGroup gl nl il idxs gdxs >>=
+                  formatNodeEvac gl nl il
        NodeEvacuate xi mode ->
-           Cluster.tryNodeEvac gl nl il mode xi >>= formatNodeEvac
+           Cluster.tryNodeEvac gl nl il mode xi >>=
+                  formatNodeEvac gl nl il
 
 -- | Reads the request from the data file(s)
 readRequest :: Options -> [String] -> IO Request