Cluster.hs 25.4 KB
Newer Older
Iustin Pop's avatar
Iustin Pop committed
1
2
3
{-| Implementation of cluster-wide logic.

This module holds all pure cluster-logic; I\/O related functionality
Iustin Pop's avatar
Iustin Pop committed
4
goes into the "Main" module for the individual binaries.
Iustin Pop's avatar
Iustin Pop committed
5
6
7

-}

8
module Ganeti.HTools.Cluster
Iustin Pop's avatar
Iustin Pop committed
9
10
    (
     -- * Types
Iustin Pop's avatar
Iustin Pop committed
11
      Placement
Iustin Pop's avatar
Iustin Pop committed
12
13
14
    , Solution(..)
    , Table(..)
    , Removal
Iustin Pop's avatar
Iustin Pop committed
15
    , Score
16
    , IMove(..)
Iustin Pop's avatar
Iustin Pop committed
17
18
19
20
21
22
23
24
    -- * Generic functions
    , totalResources
    -- * First phase functions
    , computeBadItems
    -- * Second phase functions
    , computeSolution
    , applySolution
    , printSolution
25
    , printSolutionLine
26
    , formatCmds
Iustin Pop's avatar
Iustin Pop committed
27
28
    , printNodes
    -- * Balacing functions
29
    , applyMove
Iustin Pop's avatar
Iustin Pop committed
30
31
32
    , checkMove
    , compCV
    , printStats
33
    -- * IAllocator functions
34
35
    , allocateOnSingle
    , allocateOnPair
Iustin Pop's avatar
Iustin Pop committed
36
37
38
39
40
41
    ) where

import Data.List
import Data.Maybe (isNothing, fromJust)
import Text.Printf (printf)
import Data.Function
42
import Control.Monad
Iustin Pop's avatar
Iustin Pop committed
43

44
45
46
import qualified Ganeti.HTools.Container as Container
import qualified Ganeti.HTools.Instance as Instance
import qualified Ganeti.HTools.Node as Node
Iustin Pop's avatar
Iustin Pop committed
47
import Ganeti.HTools.Types
48
import Ganeti.HTools.Utils
Iustin Pop's avatar
Iustin Pop committed
49

Iustin Pop's avatar
Iustin Pop committed
50
-- | A separate name for the cluster score type
Iustin Pop's avatar
Iustin Pop committed
51
52
53
type Score = Double

-- | The description of an instance placement.
54
type Placement = (Idx, Ndx, Ndx, Score)
Iustin Pop's avatar
Iustin Pop committed
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69

{- | A cluster solution described as the solution delta and the list
of placements.

-}
data Solution = Solution Int [Placement]
                deriving (Eq, Ord, Show)

-- | Returns the delta of a solution or -1 for Nothing
solutionDelta :: Maybe Solution -> Int
solutionDelta sol = case sol of
                      Just (Solution d _) -> d
                      _ -> -1

-- | A removal set.
70
data Removal = Removal Node.List [Instance.Instance]
Iustin Pop's avatar
Iustin Pop committed
71
72

-- | An instance move definition
Iustin Pop's avatar
Iustin Pop committed
73
data IMove = Failover                -- ^ Failover the instance (f)
74
75
76
77
           | ReplacePrimary Ndx      -- ^ Replace primary (f, r:np, f)
           | ReplaceSecondary Ndx    -- ^ Replace secondary (r:ns)
           | ReplaceAndFailover Ndx  -- ^ Replace secondary, failover (r:np, f)
           | FailoverAndReplace Ndx  -- ^ Failover, replace secondary (f, r:ns)
Iustin Pop's avatar
Iustin Pop committed
78
79
80
             deriving (Show)

-- | The complete state for the balancing solution
81
data Table = Table Node.List Instance.List Score [Placement]
Iustin Pop's avatar
Iustin Pop committed
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
             deriving (Show)

-- General functions

-- | Cap the removal list if needed.
capRemovals :: [a] -> Int -> [a]
capRemovals removals max_removals =
    if max_removals > 0 then
        take max_removals removals
    else
        removals

-- | Check if the given node list fails the N+1 check.
verifyN1Check :: [Node.Node] -> Bool
verifyN1Check nl = any Node.failN1 nl

-- | Verifies the N+1 status and return the affected nodes.
verifyN1 :: [Node.Node] -> [Node.Node]
verifyN1 nl = filter Node.failN1 nl

{-| Add an instance and return the new node and instance maps. -}
103
104
addInstance :: Node.List -> Instance.Instance ->
               Node.Node -> Node.Node -> Maybe Node.List
Iustin Pop's avatar
Iustin Pop committed
105
106
107
108
109
110
111
112
113
114
115
addInstance nl idata pri sec =
  let pdx = Node.idx pri
      sdx = Node.idx sec
  in do
      pnode <- Node.addPri pri idata
      snode <- Node.addSec sec idata pdx
      new_nl <- return $ Container.addTwo sdx snode
                         pdx pnode nl
      return new_nl

-- | Remove an instance and return the new node and instance maps.
116
removeInstance :: Node.List -> Instance.Instance -> Node.List
Iustin Pop's avatar
Iustin Pop committed
117
118
119
120
121
122
123
124
125
126
127
removeInstance nl idata =
  let pnode = Instance.pnode idata
      snode = Instance.snode idata
      pn = Container.find pnode nl
      sn = Container.find snode nl
      new_nl = Container.addTwo
               pnode (Node.removePri pn idata)
               snode (Node.removeSec sn idata) nl in
  new_nl

-- | Remove an instance and return the new node map.
128
removeInstances :: Node.List -> [Instance.Instance] -> Node.List
Iustin Pop's avatar
Iustin Pop committed
129
130
131
132
133
134
removeInstances = foldl' removeInstance

-- | Compute the total free disk and memory in the cluster.
totalResources :: Container.Container Node.Node -> (Int, Int)
totalResources nl =
    foldl'
Iustin Pop's avatar
Iustin Pop committed
135
136
    (\ (mem, dsk) node -> (mem + (Node.f_mem node),
                           dsk + (Node.f_dsk node)))
Iustin Pop's avatar
Iustin Pop committed
137
138
139
140
141
142
143
144
145
146
147
    (0, 0) (Container.elems nl)

{- | Compute a new version of a cluster given a solution.

This is not used for computing the solutions, but for applying a
(known-good) solution to the original cluster for final display.

It first removes the relocated instances after which it places them on
their new nodes.

 -}
148
applySolution :: Node.List -> Instance.List -> [Placement] -> Node.List
Iustin Pop's avatar
Iustin Pop committed
149
applySolution nl il sol =
150
151
152
    let odxes = map (\ (a, b, c, _) -> (Container.find a il,
                                        Node.idx (Container.find b nl),
                                        Node.idx (Container.find c nl))
Iustin Pop's avatar
Iustin Pop committed
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
                    ) sol
        idxes = (\ (x, _, _) -> x) (unzip3 odxes)
        nc = removeInstances nl idxes
    in
      foldl' (\ nz (a, b, c) ->
                 let new_p = Container.find b nz
                     new_s = Container.find c nz in
                 fromJust (addInstance nz a new_p new_s)
           ) nc odxes


-- First phase functions

{- | Given a list 1,2,3..n build a list of pairs [(1, [2..n]), (2,
    [3..n]), ...]

-}
genParts :: [a] -> Int -> [(a, [a])]
genParts l count =
    case l of
      [] -> []
      x:xs ->
          if length l < count then
              []
          else
              (x, xs) : (genParts xs count)

-- | Generates combinations of count items from the names list.
genNames :: Int -> [b] -> [[b]]
genNames count1 names1 =
  let aux_fn count names current =
          case count of
            0 -> [current]
            _ ->
                concatMap
                (\ (x, xs) -> aux_fn (count - 1) xs (x:current))
                (genParts names count)
  in
    aux_fn count1 names1 []

{- | Computes the pair of bad nodes and instances.

The bad node list is computed via a simple 'verifyN1' check, and the
bad instance list is the list of primary and secondary instances of
those nodes.

-}
200
computeBadItems :: Node.List -> Instance.List ->
Iustin Pop's avatar
Iustin Pop committed
201
202
                   ([Node.Node], [Instance.Instance])
computeBadItems nl il =
203
  let bad_nodes = verifyN1 $ filter (not . Node.offline) $ Container.elems nl
Iustin Pop's avatar
Iustin Pop committed
204
205
206
207
208
209
210
211
212
213
214
215
216
217
      bad_instances = map (\idx -> Container.find idx il) $
                      sort $ nub $ concat $
                      map (\ n -> (Node.slist n) ++ (Node.plist n)) bad_nodes
  in
    (bad_nodes, bad_instances)


{- | Checks if removal of instances results in N+1 pass.

Note: the check removal cannot optimize by scanning only the affected
nodes, since the cluster is known to be not healthy; only the check
placement can make this shortcut.

-}
218
checkRemoval :: Node.List -> [Instance.Instance] -> Maybe Removal
Iustin Pop's avatar
Iustin Pop committed
219
220
221
222
223
224
225
226
227
228
229
checkRemoval nl victims =
  let nx = removeInstances nl victims
      failN1 = verifyN1Check (Container.elems nx)
  in
    if failN1 then
      Nothing
    else
      Just $ Removal nx victims


-- | Computes the removals list for a given depth
230
computeRemovals :: Node.List
Iustin Pop's avatar
Iustin Pop committed
231
232
                 -> [Instance.Instance]
                 -> Int
233
                 -> [Maybe Removal]
Iustin Pop's avatar
Iustin Pop committed
234
235
236
237
238
239
computeRemovals nl bad_instances depth =
    map (checkRemoval nl) $ genNames depth bad_instances

-- Second phase functions

-- | Single-node relocation cost
240
nodeDelta :: Ndx -> Ndx -> Ndx -> Int
Iustin Pop's avatar
Iustin Pop committed
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
nodeDelta i p s =
    if i == p || i == s then
        0
    else
        1

{-| Compute best solution.

    This function compares two solutions, choosing the minimum valid
    solution.
-}
compareSolutions :: Maybe Solution -> Maybe Solution -> Maybe Solution
compareSolutions a b = case (a, b) of
  (Nothing, x) -> x
  (x, Nothing) -> x
  (x, y) -> min x y

-- | Compute best table. Note that the ordering of the arguments is important.
compareTables :: Table -> Table -> Table
compareTables a@(Table _ _ a_cv _) b@(Table _ _ b_cv _ ) =
    if a_cv > b_cv then b else a

-- | Check if a given delta is worse then an existing solution.
tooHighDelta :: Maybe Solution -> Int -> Int -> Bool
tooHighDelta sol new_delta max_delta =
    if new_delta > max_delta && max_delta >=0 then
        True
    else
        case sol of
          Nothing -> False
          Just (Solution old_delta _) -> old_delta <= new_delta

{-| Check if placement of instances still keeps the cluster N+1 compliant.

    This is the workhorse of the allocation algorithm: given the
    current node and instance maps, the list of instances to be
    placed, and the current solution, this will return all possible
    solution by recursing until all target instances are placed.

-}
281
checkPlacement :: Node.List            -- ^ The current node list
Iustin Pop's avatar
Iustin Pop committed
282
283
284
285
286
287
288
289
290
291
292
293
294
               -> [Instance.Instance] -- ^ List of instances still to place
               -> [Placement]         -- ^ Partial solution until now
               -> Int                 -- ^ The delta of the partial solution
               -> Maybe Solution      -- ^ The previous solution
               -> Int                 -- ^ Abort if the we go above this delta
               -> Maybe Solution      -- ^ The new solution
checkPlacement nl victims current current_delta prev_sol max_delta =
  let target = head victims
      opdx = Instance.pnode target
      osdx = Instance.snode target
      vtail = tail victims
      have_tail = (length vtail) > 0
      nodes = Container.elems nl
295
      iidx = Instance.idx target
Iustin Pop's avatar
Iustin Pop committed
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
  in
    foldl'
    (\ accu_p pri ->
         let
             pri_idx = Node.idx pri
             upri_delta = current_delta + nodeDelta pri_idx opdx osdx
             new_pri = Node.addPri pri target
             fail_delta1 = tooHighDelta accu_p upri_delta max_delta
         in
           if fail_delta1 || isNothing(new_pri) then accu_p
           else let pri_nl = Container.add pri_idx (fromJust new_pri) nl in
                foldl'
                (\ accu sec ->
                     let
                         sec_idx = Node.idx sec
                         upd_delta = upri_delta +
                                     nodeDelta sec_idx opdx osdx
                         fail_delta2 = tooHighDelta accu upd_delta max_delta
                         new_sec = Node.addSec sec target pri_idx
                     in
                       if sec_idx == pri_idx || fail_delta2 ||
                          isNothing new_sec then accu
                       else let
                           nx = Container.add sec_idx (fromJust new_sec) pri_nl
320
321
                           upd_cv = compCV nx
                           plc = (iidx, pri_idx, sec_idx, upd_cv)
Iustin Pop's avatar
Iustin Pop committed
322
323
324
325
326
327
328
329
330
331
332
333
                           c2 = plc:current
                           result =
                               if have_tail then
                                   checkPlacement nx vtail c2 upd_delta
                                                  accu max_delta
                               else
                                   Just (Solution upd_delta c2)
                      in compareSolutions accu result
                ) accu_p nodes
    ) prev_sol nodes

-- | Apply a move
334
applyMove :: Node.List -> Instance.Instance
335
          -> IMove -> (Maybe Node.List, Instance.Instance, Ndx, Ndx)
Iustin Pop's avatar
Iustin Pop committed
336
-- Failover (f)
Iustin Pop's avatar
Iustin Pop committed
337
338
339
340
341
342
343
applyMove nl inst Failover =
    let old_pdx = Instance.pnode inst
        old_sdx = Instance.snode inst
        old_p = Container.find old_pdx nl
        old_s = Container.find old_sdx nl
        int_p = Node.removePri old_p inst
        int_s = Node.removeSec old_s inst
344
345
346
347
        new_nl = do -- Maybe monad
          new_p <- Node.addPri int_s inst
          new_s <- Node.addSec int_p inst old_sdx
          return $ Container.addTwo old_pdx new_s old_sdx new_p nl
Iustin Pop's avatar
Iustin Pop committed
348
349
    in (new_nl, Instance.setBoth inst old_sdx old_pdx, old_sdx, old_pdx)

Iustin Pop's avatar
Iustin Pop committed
350
-- Replace the primary (f:, r:np, f)
Iustin Pop's avatar
Iustin Pop committed
351
352
353
354
355
356
357
358
applyMove nl inst (ReplacePrimary new_pdx) =
    let old_pdx = Instance.pnode inst
        old_sdx = Instance.snode inst
        old_p = Container.find old_pdx nl
        old_s = Container.find old_sdx nl
        tgt_n = Container.find new_pdx nl
        int_p = Node.removePri old_p inst
        int_s = Node.removeSec old_s inst
359
360
361
362
363
        new_nl = do -- Maybe monad
          new_p <- Node.addPri tgt_n inst
          new_s <- Node.addSec int_s inst new_pdx
          return $ Container.add new_pdx new_p $
                 Container.addTwo old_pdx int_p old_sdx new_s nl
Iustin Pop's avatar
Iustin Pop committed
364
365
    in (new_nl, Instance.setPri inst new_pdx, new_pdx, old_sdx)

Iustin Pop's avatar
Iustin Pop committed
366
-- Replace the secondary (r:ns)
Iustin Pop's avatar
Iustin Pop committed
367
368
369
370
371
372
applyMove nl inst (ReplaceSecondary new_sdx) =
    let old_pdx = Instance.pnode inst
        old_sdx = Instance.snode inst
        old_s = Container.find old_sdx nl
        tgt_n = Container.find new_sdx nl
        int_s = Node.removeSec old_s inst
373
374
375
        new_nl = Node.addSec tgt_n inst old_pdx >>=
                 \new_s -> return $ Container.addTwo new_sdx
                           new_s old_sdx int_s nl
Iustin Pop's avatar
Iustin Pop committed
376
377
    in (new_nl, Instance.setSec inst new_sdx, old_pdx, new_sdx)

Iustin Pop's avatar
Iustin Pop committed
378
-- Replace the secondary and failover (r:np, f)
Iustin Pop's avatar
Iustin Pop committed
379
380
381
382
383
384
385
386
applyMove nl inst (ReplaceAndFailover new_pdx) =
    let old_pdx = Instance.pnode inst
        old_sdx = Instance.snode inst
        old_p = Container.find old_pdx nl
        old_s = Container.find old_sdx nl
        tgt_n = Container.find new_pdx nl
        int_p = Node.removePri old_p inst
        int_s = Node.removeSec old_s inst
387
388
389
390
391
        new_nl = do -- Maybe monad
          new_p <- Node.addPri tgt_n inst
          new_s <- Node.addSec int_p inst new_pdx
          return $ Container.add new_pdx new_p $
                 Container.addTwo old_pdx new_s old_sdx int_s nl
Iustin Pop's avatar
Iustin Pop committed
392
393
    in (new_nl, Instance.setBoth inst new_pdx old_pdx, new_pdx, old_pdx)

Iustin Pop's avatar
Iustin Pop committed
394
395
396
397
398
399
400
401
402
-- Failver and replace the secondary (f, r:ns)
applyMove nl inst (FailoverAndReplace new_sdx) =
    let old_pdx = Instance.pnode inst
        old_sdx = Instance.snode inst
        old_p = Container.find old_pdx nl
        old_s = Container.find old_sdx nl
        tgt_n = Container.find new_sdx nl
        int_p = Node.removePri old_p inst
        int_s = Node.removeSec old_s inst
403
404
405
406
407
        new_nl = do -- Maybe monad
          new_p <- Node.addPri int_s inst
          new_s <- Node.addSec tgt_n inst old_sdx
          return $ Container.add new_sdx new_s $
                 Container.addTwo old_sdx new_p old_pdx int_p nl
Iustin Pop's avatar
Iustin Pop committed
408
409
    in (new_nl, Instance.setBoth inst old_sdx new_sdx, old_sdx, new_sdx)

410
411
allocateOnSingle :: Node.List -> Instance.Instance -> Node.Node
                 -> (Maybe Node.List, Instance.Instance)
412
413
414
415
416
417
allocateOnSingle nl inst p =
    let new_pdx = Node.idx p
        new_nl = Node.addPri p inst >>= \new_p ->
                 return $ Container.add new_pdx new_p nl
    in (new_nl, Instance.setBoth inst new_pdx Node.noSecondary)

418
419
allocateOnPair :: Node.List -> Instance.Instance -> Node.Node -> Node.Node
               -> (Maybe Node.List, Instance.Instance)
420
421
422
allocateOnPair nl inst tgt_p tgt_s =
    let new_pdx = Node.idx tgt_p
        new_sdx = Node.idx tgt_s
423
424
425
426
427
428
        new_nl = do -- Maybe monad
          new_p <- Node.addPri tgt_p inst
          new_s <- Node.addSec tgt_s inst new_pdx
          return $ Container.addTwo new_pdx new_p new_sdx new_s nl
    in (new_nl, Instance.setBoth inst new_pdx new_sdx)

Iustin Pop's avatar
Iustin Pop committed
429
430
431
432
433
434
435
436
checkSingleStep :: Table -- ^ The original table
                -> Instance.Instance -- ^ The instance to move
                -> Table -- ^ The current best table
                -> IMove -- ^ The move to apply
                -> Table -- ^ The final best table
checkSingleStep ini_tbl target cur_tbl move =
    let
        Table ini_nl ini_il _ ini_plc = ini_tbl
437
        (tmp_nl, new_inst, pri_idx, sec_idx) = applyMove ini_nl target move
Iustin Pop's avatar
Iustin Pop committed
438
439
440
441
442
443
444
    in
      if isNothing tmp_nl then cur_tbl
      else
          let tgt_idx = Instance.idx target
              upd_nl = fromJust tmp_nl
              upd_cvar = compCV upd_nl
              upd_il = Container.add tgt_idx new_inst ini_il
445
              upd_plc = (tgt_idx, pri_idx, sec_idx, upd_cvar):ini_plc
Iustin Pop's avatar
Iustin Pop committed
446
447
448
449
              upd_tbl = Table upd_nl upd_il upd_cvar upd_plc
          in
            compareTables cur_tbl upd_tbl

450
451
452
-- | Given the status of the current secondary as a valid new node
-- and the current candidate target node,
-- generate the possible moves for a instance.
453
possibleMoves :: Bool -> Ndx -> [IMove]
454
455
456
457
458
459
460
461
462
463
464
possibleMoves True tdx =
    [ReplaceSecondary tdx,
     ReplaceAndFailover tdx,
     ReplacePrimary tdx,
     FailoverAndReplace tdx]

possibleMoves False tdx =
    [ReplaceSecondary tdx,
     ReplaceAndFailover tdx]

-- | Compute the best move for a given instance.
465
checkInstanceMove :: [Ndx]             -- Allowed target node indices
466
467
468
469
                  -> Table             -- Original table
                  -> Instance.Instance -- Instance to move
                  -> Table             -- Best new table for this instance
checkInstanceMove nodes_idx ini_tbl target =
Iustin Pop's avatar
Iustin Pop committed
470
471
472
    let
        opdx = Instance.pnode target
        osdx = Instance.snode target
473
        nodes = filter (\idx -> idx /= opdx && idx /= osdx) nodes_idx
474
475
476
477
478
        use_secondary = elem osdx nodes_idx
        aft_failover = if use_secondary -- if allowed to failover
                       then checkSingleStep ini_tbl target ini_tbl Failover
                       else ini_tbl
        all_moves = concatMap (possibleMoves use_secondary) nodes
Iustin Pop's avatar
Iustin Pop committed
479
480
    in
      -- iterate over the possible nodes for this instance
481
      foldl' (checkSingleStep ini_tbl target) aft_failover all_moves
Iustin Pop's avatar
Iustin Pop committed
482

Iustin Pop's avatar
Iustin Pop committed
483
-- | Compute the best next move.
484
checkMove :: [Ndx]               -- ^ Allowed target node indices
485
          -> Table               -- ^ The current solution
Iustin Pop's avatar
Iustin Pop committed
486
          -> [Instance.Instance] -- ^ List of instances still to move
487
488
          -> Table               -- ^ The new solution
checkMove nodes_idx ini_tbl victims =
Iustin Pop's avatar
Iustin Pop committed
489
490
    let Table _ _ _ ini_plc = ini_tbl
        -- iterate over all instances, computing the best move
491
492
        best_tbl =
            foldl'
493
            (\ step_tbl elem ->
Iustin Pop's avatar
Iustin Pop committed
494
                 if Instance.snode elem == Node.noSecondary then step_tbl
495
496
                    else compareTables step_tbl $
                         checkInstanceMove nodes_idx ini_tbl elem)
497
            ini_tbl victims
Iustin Pop's avatar
Iustin Pop committed
498
        Table _ _ _ best_plc = best_tbl
499
500
501
502
    in
      if length best_plc == length ini_plc then -- no advancement
          ini_tbl
      else
503
          best_tbl
Iustin Pop's avatar
Iustin Pop committed
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542

{- | Auxiliary function for solution computation.

We write this in an explicit recursive fashion in order to control
early-abort in case we have met the min delta. We can't use foldr
instead of explicit recursion since we need the accumulator for the
abort decision.

-}
advanceSolution :: [Maybe Removal] -- ^ The removal to process
                -> Int             -- ^ Minimum delta parameter
                -> Int             -- ^ Maximum delta parameter
                -> Maybe Solution  -- ^ Current best solution
                -> Maybe Solution  -- ^ New best solution
advanceSolution [] _ _ sol = sol
advanceSolution (Nothing:xs) m n sol = advanceSolution xs m n sol
advanceSolution ((Just (Removal nx removed)):xs) min_d max_d prev_sol =
    let new_sol = checkPlacement nx removed [] 0 prev_sol max_d
        new_delta = solutionDelta $! new_sol
    in
      if new_delta >= 0 && new_delta <= min_d then
          new_sol
      else
          advanceSolution xs min_d max_d new_sol

-- | Computes the placement solution.
solutionFromRemovals :: [Maybe Removal] -- ^ The list of (possible) removals
                     -> Int             -- ^ Minimum delta parameter
                     -> Int             -- ^ Maximum delta parameter
                     -> Maybe Solution  -- ^ The best solution found
solutionFromRemovals removals min_delta max_delta =
    advanceSolution removals min_delta max_delta Nothing

{- | Computes the solution at the given depth.

This is a wrapper over both computeRemovals and
solutionFromRemovals. In case we have no solution, we return Nothing.

-}
543
computeSolution :: Node.List        -- ^ The original node data
Iustin Pop's avatar
Iustin Pop committed
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
                -> [Instance.Instance] -- ^ The list of /bad/ instances
                -> Int             -- ^ The /depth/ of removals
                -> Int             -- ^ Maximum number of removals to process
                -> Int             -- ^ Minimum delta parameter
                -> Int             -- ^ Maximum delta parameter
                -> Maybe Solution  -- ^ The best solution found (or Nothing)
computeSolution nl bad_instances depth max_removals min_delta max_delta =
  let
      removals = computeRemovals nl bad_instances depth
      removals' = capRemovals removals max_removals
  in
    solutionFromRemovals removals' min_delta max_delta

-- Solution display functions (pure)

-- | Given the original and final nodes, computes the relocation description.
computeMoves :: String -- ^ The instance name
             -> String -- ^ Original primary
             -> String -- ^ Original secondary
             -> String -- ^ New primary
             -> String -- ^ New secondary
             -> (String, [String])
                -- ^ Tuple of moves and commands list; moves is containing
                -- either @/f/@ for failover or @/r:name/@ for replace
                -- secondary, while the command list holds gnt-instance
                -- commands (without that prefix), e.g \"@failover instance1@\"
computeMoves i a b c d =
    if c == a then {- Same primary -}
        if d == b then {- Same sec??! -}
            ("-", [])
        else {- Change of secondary -}
            (printf "r:%s" d,
             [printf "replace-disks -n %s %s" d i])
    else
        if c == b then {- Failover and ... -}
            if d == a then {- that's all -}
580
                ("f", [printf "migrate -f %s" i])
Iustin Pop's avatar
Iustin Pop committed
581
582
            else
                (printf "f r:%s" d,
583
                 [printf "migrate -f %s" i,
Iustin Pop's avatar
Iustin Pop committed
584
585
586
587
588
                  printf "replace-disks -n %s %s" d i])
        else
            if d == a then {- ... and keep primary as secondary -}
                (printf "r:%s f" c,
                 [printf "replace-disks -n %s %s" c i,
589
                  printf "migrate -f %s" i])
Iustin Pop's avatar
Iustin Pop committed
590
591
592
            else
                if d == b then {- ... keep same secondary -}
                    (printf "f r:%s f" c,
593
                     [printf "migrate -f %s" i,
Iustin Pop's avatar
Iustin Pop committed
594
                      printf "replace-disks -n %s %s" c i,
595
                      printf "migrate -f %s" i])
Iustin Pop's avatar
Iustin Pop committed
596
597
598
599

                else {- Nothing in common -}
                    (printf "r:%s f r:%s" c d,
                     [printf "replace-disks -n %s %s" c i,
600
                      printf "migrate -f %s" i,
Iustin Pop's avatar
Iustin Pop committed
601
602
                      printf "replace-disks -n %s %s" d i])

603
{-| Converts a placement to string format -}
604
605
printSolutionLine :: Node.List
                  -> Instance.List
Iustin Pop's avatar
Iustin Pop committed
606
607
608
609
610
611
                  -> Int
                  -> Int
                  -> Placement
                  -> Int
                  -> (String, [String])
printSolutionLine nl il nmlen imlen plc pos =
612
613
614
615
    let
        pmlen = (2*nmlen + 1)
        (i, p, s, c) = plc
        inst = Container.find i il
616
        inam = Instance.name inst
617
618
619
620
        npri = Container.nameOf nl p
        nsec = Container.nameOf nl s
        opri = Container.nameOf nl $ Instance.pnode inst
        osec = Container.nameOf nl $ Instance.snode inst
621
622
623
624
        (moves, cmds) =  computeMoves inam opri osec npri nsec
        ostr = (printf "%s:%s" opri osec)::String
        nstr = (printf "%s:%s" npri nsec)::String
    in
625
626
      (printf "  %3d. %-*s %-*s => %-*s %.8f a=%s"
       pos imlen inam pmlen ostr
627
628
629
       pmlen nstr c moves,
       cmds)

630
631
formatCmds :: [[String]] -> String
formatCmds cmd_strs =
632
    unlines $
633
    concat $ map (\(a, b) ->
634
635
636
        (printf "echo step %d" (a::Int)):
        (printf "check"):
        (map ("gnt-instance " ++) b)) $
637
638
        zip [1..] cmd_strs

Iustin Pop's avatar
Iustin Pop committed
639
{-| Converts a solution to string format -}
640
641
printSolution :: Node.List
              -> Instance.List
Iustin Pop's avatar
Iustin Pop committed
642
643
              -> [Placement]
              -> ([String], [[String]])
Iustin Pop's avatar
Iustin Pop committed
644
printSolution nl il sol =
Iustin Pop's avatar
Iustin Pop committed
645
    let
646
647
        nmlen = Container.maxNameLen nl
        imlen = Container.maxNameLen il
Iustin Pop's avatar
Iustin Pop committed
648
    in
Iustin Pop's avatar
Iustin Pop committed
649
      unzip $ map (uncurry $ printSolutionLine nl il nmlen imlen) $
650
            zip sol [1..]
Iustin Pop's avatar
Iustin Pop committed
651
652

-- | Print the node list.
653
printNodes :: Node.List -> String
654
printNodes nl =
Iustin Pop's avatar
Iustin Pop committed
655
    let snl = sortBy (compare `on` Node.idx) (Container.elems nl)
656
        m_name = maximum . map (length . Node.name) $ snl
Iustin Pop's avatar
Iustin Pop committed
657
        helper = Node.list m_name
Iustin Pop's avatar
Iustin Pop committed
658
659
660
661
        header = printf
                 "%2s %-*s %5s %5s %5s %5s %5s %5s %5s %5s %3s %3s %7s %7s"
                 " F" m_name "Name"
                 "t_mem" "n_mem" "i_mem" "x_mem" "f_mem" "r_mem"
662
663
                 "t_dsk" "f_dsk"
                 "pri" "sec" "p_fmem" "p_fdsk"
664
    in unlines $ (header:map helper snl)
Iustin Pop's avatar
Iustin Pop committed
665
666

-- | Compute the mem and disk covariance.
667
compDetailedCV :: Node.List -> (Double, Double, Double, Double, Double)
Iustin Pop's avatar
Iustin Pop committed
668
compDetailedCV nl =
669
    let
670
671
        all_nodes = Container.elems nl
        (offline, nodes) = partition Node.offline all_nodes
672
673
        mem_l = map Node.p_mem nodes
        dsk_l = map Node.p_dsk nodes
Iustin Pop's avatar
Iustin Pop committed
674
675
        mem_cv = varianceCoeff mem_l
        dsk_cv = varianceCoeff dsk_l
676
677
        n1_l = length $ filter Node.failN1 nodes
        n1_score = (fromIntegral n1_l) / (fromIntegral $ length nodes)
678
679
        res_l = map Node.p_rem nodes
        res_cv = varianceCoeff res_l
680
681
682
683
684
685
686
        offline_inst = sum . map (\n -> (length . Node.plist $ n) +
                                        (length . Node.slist $ n)) $ offline
        online_inst = sum . map (\n -> (length . Node.plist $ n) +
                                       (length . Node.slist $ n)) $ nodes
        off_score = (fromIntegral offline_inst) /
                    (fromIntegral $ online_inst + offline_inst)
    in (mem_cv, dsk_cv, n1_score, res_cv, off_score)
Iustin Pop's avatar
Iustin Pop committed
687
688

-- | Compute the 'total' variance.
689
compCV :: Node.List -> Double
Iustin Pop's avatar
Iustin Pop committed
690
compCV nl =
691
692
    let (mem_cv, dsk_cv, n1_score, res_cv, off_score) = compDetailedCV nl
    in mem_cv + dsk_cv + n1_score + res_cv + off_score
Iustin Pop's avatar
Iustin Pop committed
693

694
printStats :: Node.List -> String
Iustin Pop's avatar
Iustin Pop committed
695
printStats nl =
696
697
698
    let (mem_cv, dsk_cv, n1_score, res_cv, off_score) = compDetailedCV nl
    in printf "f_mem=%.8f, r_mem=%.8f, f_dsk=%.8f, n1=%.3f, uf=%.3f"
       mem_cv res_cv dsk_cv n1_score off_score