Statistics
| Branch: | Tag: | Revision:

root / src / Ganeti / HTools / Node.hs @ c324da14

History | View | Annotate | Download (26.1 kB)

1
{-| Module describing a node.
2

    
3
    All updates are functional (copy-based) and return a new node with
4
    updated value.
5
-}
6

    
7
{-
8

    
9
Copyright (C) 2009, 2010, 2011, 2012, 2013 Google Inc.
10

    
11
This program is free software; you can redistribute it and/or modify
12
it under the terms of the GNU General Public License as published by
13
the Free Software Foundation; either version 2 of the License, or
14
(at your option) any later version.
15

    
16
This program is distributed in the hope that it will be useful, but
17
WITHOUT ANY WARRANTY; without even the implied warranty of
18
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
19
General Public License for more details.
20

    
21
You should have received a copy of the GNU General Public License
22
along with this program; if not, write to the Free Software
23
Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
24
02110-1301, USA.
25

    
26
-}
27

    
28
module Ganeti.HTools.Node
29
  ( Node(..)
30
  , List
31
  -- * Constructor
32
  , create
33
  -- ** Finalization after data loading
34
  , buildPeers
35
  , setIdx
36
  , setAlias
37
  , setOffline
38
  , setXmem
39
  , setFmem
40
  , setPri
41
  , setSec
42
  , setMaster
43
  , setNodeTags
44
  , setMdsk
45
  , setMcpu
46
  , setPolicy
47
  -- * Tag maps
48
  , addTags
49
  , delTags
50
  , rejectAddTags
51
  -- * Instance (re)location
52
  , removePri
53
  , removeSec
54
  , addPri
55
  , addPriEx
56
  , addSec
57
  , addSecEx
58
  -- * Stats
59
  , availDisk
60
  , availMem
61
  , availCpu
62
  , iMem
63
  , iDsk
64
  , conflictingPrimaries
65
  -- * Formatting
66
  , defaultFields
67
  , showHeader
68
  , showField
69
  , list
70
  -- * Misc stuff
71
  , AssocList
72
  , AllocElement
73
  , noSecondary
74
  , computeGroups
75
  , mkNodeGraph
76
  , mkRebootNodeGraph
77
  ) where
78

    
79
import Control.Monad (liftM, liftM2)
80
import Control.Applicative ((<$>), (<*>))
81
import qualified Data.Foldable as Foldable
82
import Data.Function (on)
83
import qualified Data.Graph as Graph
84
import qualified Data.IntMap as IntMap
85
import Data.List hiding (group)
86
import qualified Data.Map as Map
87
import Data.Ord (comparing)
88
import Text.Printf (printf)
89

    
90
import qualified Ganeti.HTools.Container as Container
91
import qualified Ganeti.HTools.Instance as Instance
92
import qualified Ganeti.HTools.PeerMap as P
93

    
94
import Ganeti.BasicTypes
95
import qualified Ganeti.HTools.Types as T
96

    
97
-- * Type declarations
98

    
99
-- | The tag map type.
100
type TagMap = Map.Map String Int
101

    
102
-- | The node type.
103
data Node = Node
104
  { name     :: String    -- ^ The node name
105
  , alias    :: String    -- ^ The shortened name (for display purposes)
106
  , tMem     :: Double    -- ^ Total memory (MiB)
107
  , nMem     :: Int       -- ^ Node memory (MiB)
108
  , fMem     :: Int       -- ^ Free memory (MiB)
109
  , xMem     :: Int       -- ^ Unaccounted memory (MiB)
110
  , tDsk     :: Double    -- ^ Total disk space (MiB)
111
  , fDsk     :: Int       -- ^ Free disk space (MiB)
112
  , tCpu     :: Double    -- ^ Total CPU count
113
  , uCpu     :: Int       -- ^ Used VCPU count
114
  , spindleCount :: Int   -- ^ Node spindles (spindle_count node parameter)
115
  , pList    :: [T.Idx]   -- ^ List of primary instance indices
116
  , sList    :: [T.Idx]   -- ^ List of secondary instance indices
117
  , idx      :: T.Ndx     -- ^ Internal index for book-keeping
118
  , peers    :: P.PeerMap -- ^ Pnode to instance mapping
119
  , failN1   :: Bool      -- ^ Whether the node has failed n1
120
  , rMem     :: Int       -- ^ Maximum memory needed for failover by
121
                          -- primaries of this node
122
  , pMem     :: Double    -- ^ Percent of free memory
123
  , pDsk     :: Double    -- ^ Percent of free disk
124
  , pRem     :: Double    -- ^ Percent of reserved memory
125
  , pCpu     :: Double    -- ^ Ratio of virtual to physical CPUs
126
  , mDsk     :: Double    -- ^ Minimum free disk ratio
127
  , loDsk    :: Int       -- ^ Autocomputed from mDsk low disk
128
                          -- threshold
129
  , hiCpu    :: Int       -- ^ Autocomputed from mCpu high cpu
130
                          -- threshold
131
  , hiSpindles :: Double  -- ^ Auto-computed from policy spindle_ratio
132
                          -- and the node spindle count
133
  , instSpindles :: Double -- ^ Spindles used by instances
134
  , offline  :: Bool      -- ^ Whether the node should not be used for
135
                          -- allocations and skipped from score
136
                          -- computations
137
  , isMaster :: Bool      -- ^ Whether the node is the master node
138
  , nTags    :: [String]  -- ^ The node tags for this node
139
  , utilPool :: T.DynUtil -- ^ Total utilisation capacity
140
  , utilLoad :: T.DynUtil -- ^ Sum of instance utilisation
141
  , pTags    :: TagMap    -- ^ Primary instance exclusion tags and their count
142
  , group    :: T.Gdx     -- ^ The node's group (index)
143
  , iPolicy  :: T.IPolicy -- ^ The instance policy (of the node's group)
144
  , exclStorage :: Bool   -- ^ Effective value of exclusive_storage
145
  } deriving (Show, Eq)
146

    
147
instance T.Element Node where
148
  nameOf = name
149
  idxOf = idx
150
  setAlias = setAlias
151
  setIdx = setIdx
152
  allNames n = [name n, alias n]
153

    
154
-- | A simple name for the int, node association list.
155
type AssocList = [(T.Ndx, Node)]
156

    
157
-- | A simple name for a node map.
158
type List = Container.Container Node
159

    
160
-- | A simple name for an allocation element (here just for logistic
161
-- reasons).
162
type AllocElement = (List, Instance.Instance, [Node], T.Score)
163

    
164
-- | Constant node index for a non-moveable instance.
165
noSecondary :: T.Ndx
166
noSecondary = -1
167

    
168
-- * Helper functions
169

    
170
-- | Add a tag to a tagmap.
171
addTag :: TagMap -> String -> TagMap
172
addTag t s = Map.insertWith (+) s 1 t
173

    
174
-- | Add multiple tags.
175
addTags :: TagMap -> [String] -> TagMap
176
addTags = foldl' addTag
177

    
178
-- | Adjust or delete a tag from a tagmap.
179
delTag :: TagMap -> String -> TagMap
180
delTag t s = Map.update (\v -> if v > 1
181
                                 then Just (v-1)
182
                                 else Nothing)
183
             s t
184

    
185
-- | Remove multiple tags.
186
delTags :: TagMap -> [String] -> TagMap
187
delTags = foldl' delTag
188

    
189
-- | Check if we can add a list of tags to a tagmap.
190
rejectAddTags :: TagMap -> [String] -> Bool
191
rejectAddTags t = any (`Map.member` t)
192

    
193
-- | Check how many primary instances have conflicting tags. The
194
-- algorithm to compute this is to sum the count of all tags, then
195
-- subtract the size of the tag map (since each tag has at least one,
196
-- non-conflicting instance); this is equivalent to summing the
197
-- values in the tag map minus one.
198
conflictingPrimaries :: Node -> Int
199
conflictingPrimaries (Node { pTags = t }) = Foldable.sum t - Map.size t
200

    
201
-- | Helper function to increment a base value depending on the passed
202
-- boolean argument.
203
incIf :: (Num a) => Bool -> a -> a -> a
204
incIf True  base delta = base + delta
205
incIf False base _     = base
206

    
207
-- | Helper function to decrement a base value depending on the passed
208
-- boolean argument.
209
decIf :: (Num a) => Bool -> a -> a -> a
210
decIf True  base delta = base - delta
211
decIf False base _     = base
212

    
213
-- * Initialization functions
214

    
215
-- | Create a new node.
216
--
217
-- The index and the peers maps are empty, and will be need to be
218
-- update later via the 'setIdx' and 'buildPeers' functions.
219
create :: String -> Double -> Int -> Int -> Double
220
       -> Int -> Double -> Bool -> Int -> T.Gdx -> Bool -> Node
221
create name_init mem_t_init mem_n_init mem_f_init
222
       dsk_t_init dsk_f_init cpu_t_init offline_init spindles_init
223
       group_init excl_stor =
224
  Node { name = name_init
225
       , alias = name_init
226
       , tMem = mem_t_init
227
       , nMem = mem_n_init
228
       , fMem = mem_f_init
229
       , tDsk = dsk_t_init
230
       , fDsk = dsk_f_init
231
       , tCpu = cpu_t_init
232
       , spindleCount = spindles_init
233
       , uCpu = 0
234
       , pList = []
235
       , sList = []
236
       , failN1 = True
237
       , idx = -1
238
       , peers = P.empty
239
       , rMem = 0
240
       , pMem = fromIntegral mem_f_init / mem_t_init
241
       , pDsk = computePDsk dsk_f_init dsk_t_init
242
       , pRem = 0
243
       , pCpu = 0
244
       , offline = offline_init
245
       , isMaster = False
246
       , nTags = []
247
       , xMem = 0
248
       , mDsk = T.defReservedDiskRatio
249
       , loDsk = mDskToloDsk T.defReservedDiskRatio dsk_t_init
250
       , hiCpu = mCpuTohiCpu (T.iPolicyVcpuRatio T.defIPolicy) cpu_t_init
251
       , hiSpindles = computeHiSpindles (T.iPolicySpindleRatio T.defIPolicy)
252
                      spindles_init
253
       , instSpindles = 0
254
       , utilPool = T.baseUtil
255
       , utilLoad = T.zeroUtil
256
       , pTags = Map.empty
257
       , group = group_init
258
       , iPolicy = T.defIPolicy
259
       , exclStorage = excl_stor
260
       }
261

    
262
-- | Conversion formula from mDsk\/tDsk to loDsk.
263
mDskToloDsk :: Double -> Double -> Int
264
mDskToloDsk mval = floor . (mval *)
265

    
266
-- | Conversion formula from mCpu\/tCpu to hiCpu.
267
mCpuTohiCpu :: Double -> Double -> Int
268
mCpuTohiCpu mval = floor . (mval *)
269

    
270
-- | Conversiojn formula from spindles and spindle ratio to hiSpindles.
271
computeHiSpindles :: Double -> Int -> Double
272
computeHiSpindles spindle_ratio = (spindle_ratio *) . fromIntegral
273

    
274
-- | Changes the index.
275
--
276
-- This is used only during the building of the data structures.
277
setIdx :: Node -> T.Ndx -> Node
278
setIdx t i = t {idx = i}
279

    
280
-- | Changes the alias.
281
--
282
-- This is used only during the building of the data structures.
283
setAlias :: Node -> String -> Node
284
setAlias t s = t { alias = s }
285

    
286
-- | Sets the offline attribute.
287
setOffline :: Node -> Bool -> Node
288
setOffline t val = t { offline = val }
289

    
290
-- | Sets the master attribute
291
setMaster :: Node -> Bool -> Node
292
setMaster t val = t { isMaster = val }
293

    
294
-- | Sets the node tags attribute
295
setNodeTags :: Node -> [String] -> Node
296
setNodeTags t val = t { nTags = val }
297

    
298
-- | Sets the unnaccounted memory.
299
setXmem :: Node -> Int -> Node
300
setXmem t val = t { xMem = val }
301

    
302
-- | Sets the max disk usage ratio.
303
setMdsk :: Node -> Double -> Node
304
setMdsk t val = t { mDsk = val, loDsk = mDskToloDsk val (tDsk t) }
305

    
306
-- | Sets the max cpu usage ratio. This will update the node's
307
-- ipolicy, losing sharing (but it should be a seldomly done operation).
308
setMcpu :: Node -> Double -> Node
309
setMcpu t val =
310
  let new_ipol = (iPolicy t) { T.iPolicyVcpuRatio = val }
311
  in t { hiCpu = mCpuTohiCpu val (tCpu t), iPolicy = new_ipol }
312

    
313
-- | Sets the policy.
314
setPolicy :: T.IPolicy -> Node -> Node
315
setPolicy pol node =
316
  node { iPolicy = pol
317
       , hiCpu = mCpuTohiCpu (T.iPolicyVcpuRatio pol) (tCpu node)
318
       , hiSpindles = computeHiSpindles (T.iPolicySpindleRatio pol)
319
                      (spindleCount node)
320
       }
321

    
322
-- | Computes the maximum reserved memory for peers from a peer map.
323
computeMaxRes :: P.PeerMap -> P.Elem
324
computeMaxRes = P.maxElem
325

    
326
-- | Builds the peer map for a given node.
327
buildPeers :: Node -> Instance.List -> Node
328
buildPeers t il =
329
  let mdata = map
330
              (\i_idx -> let inst = Container.find i_idx il
331
                             mem = if Instance.usesSecMem inst
332
                                     then Instance.mem inst
333
                                     else 0
334
                         in (Instance.pNode inst, mem))
335
              (sList t)
336
      pmap = P.accumArray (+) mdata
337
      new_rmem = computeMaxRes pmap
338
      new_failN1 = fMem t <= new_rmem
339
      new_prem = fromIntegral new_rmem / tMem t
340
  in t {peers=pmap, failN1 = new_failN1, rMem = new_rmem, pRem = new_prem}
341

    
342
-- | Calculate the new spindle usage
343
calcSpindleUse :: Node -> Instance.Instance -> Double
344
calcSpindleUse n i = incIf (Instance.usesLocalStorage i) (instSpindles n)
345
                       (fromIntegral $ Instance.spindleUse i)
346

    
347
-- | Assigns an instance to a node as primary and update the used VCPU
348
-- count, utilisation data and tags map.
349
setPri :: Node -> Instance.Instance -> Node
350
setPri t inst = t { pList = Instance.idx inst:pList t
351
                  , uCpu = new_count
352
                  , pCpu = fromIntegral new_count / tCpu t
353
                  , utilLoad = utilLoad t `T.addUtil` Instance.util inst
354
                  , pTags = addTags (pTags t) (Instance.exclTags inst)
355
                  , instSpindles = calcSpindleUse t inst
356
                  }
357
  where new_count = Instance.applyIfOnline inst (+ Instance.vcpus inst)
358
                    (uCpu t )
359

    
360
-- | Assigns an instance to a node as secondary without other updates.
361
setSec :: Node -> Instance.Instance -> Node
362
setSec t inst = t { sList = Instance.idx inst:sList t
363
                  , utilLoad = old_load { T.dskWeight = T.dskWeight old_load +
364
                                          T.dskWeight (Instance.util inst) }
365
                  , instSpindles = calcSpindleUse t inst
366
                  }
367
  where old_load = utilLoad t
368

    
369
-- | Computes the new 'pDsk' value, handling nodes without local disk
370
-- storage (we consider all their disk used).
371
computePDsk :: Int -> Double -> Double
372
computePDsk _    0     = 1
373
computePDsk used total = fromIntegral used / total
374

    
375
-- * Update functions
376

    
377
-- | Sets the free memory.
378
setFmem :: Node -> Int -> Node
379
setFmem t new_mem =
380
  let new_n1 = new_mem < rMem t
381
      new_mp = fromIntegral new_mem / tMem t
382
  in t { fMem = new_mem, failN1 = new_n1, pMem = new_mp }
383

    
384
-- | Removes a primary instance.
385
removePri :: Node -> Instance.Instance -> Node
386
removePri t inst =
387
  let iname = Instance.idx inst
388
      i_online = Instance.notOffline inst
389
      uses_disk = Instance.usesLocalStorage inst
390
      new_plist = delete iname (pList t)
391
      new_mem = incIf i_online (fMem t) (Instance.mem inst)
392
      new_dsk = incIf uses_disk (fDsk t) (Instance.dsk inst)
393
      new_spindles = decIf uses_disk (instSpindles t) 1
394
      new_mp = fromIntegral new_mem / tMem t
395
      new_dp = computePDsk new_dsk (tDsk t)
396
      new_failn1 = new_mem <= rMem t
397
      new_ucpu = decIf i_online (uCpu t) (Instance.vcpus inst)
398
      new_rcpu = fromIntegral new_ucpu / tCpu t
399
      new_load = utilLoad t `T.subUtil` Instance.util inst
400
  in t { pList = new_plist, fMem = new_mem, fDsk = new_dsk
401
       , failN1 = new_failn1, pMem = new_mp, pDsk = new_dp
402
       , uCpu = new_ucpu, pCpu = new_rcpu, utilLoad = new_load
403
       , pTags = delTags (pTags t) (Instance.exclTags inst)
404
       , instSpindles = new_spindles
405
       }
406

    
407
-- | Removes a secondary instance.
408
removeSec :: Node -> Instance.Instance -> Node
409
removeSec t inst =
410
  let iname = Instance.idx inst
411
      uses_disk = Instance.usesLocalStorage inst
412
      cur_dsk = fDsk t
413
      pnode = Instance.pNode inst
414
      new_slist = delete iname (sList t)
415
      new_dsk = incIf uses_disk cur_dsk (Instance.dsk inst)
416
      new_spindles = decIf uses_disk (instSpindles t) 1
417
      old_peers = peers t
418
      old_peem = P.find pnode old_peers
419
      new_peem = decIf (Instance.usesSecMem inst) old_peem (Instance.mem inst)
420
      new_peers = if new_peem > 0
421
                    then P.add pnode new_peem old_peers
422
                    else P.remove pnode old_peers
423
      old_rmem = rMem t
424
      new_rmem = if old_peem < old_rmem
425
                   then old_rmem
426
                   else computeMaxRes new_peers
427
      new_prem = fromIntegral new_rmem / tMem t
428
      new_failn1 = fMem t <= new_rmem
429
      new_dp = computePDsk new_dsk (tDsk t)
430
      old_load = utilLoad t
431
      new_load = old_load { T.dskWeight = T.dskWeight old_load -
432
                                          T.dskWeight (Instance.util inst) }
433
  in t { sList = new_slist, fDsk = new_dsk, peers = new_peers
434
       , failN1 = new_failn1, rMem = new_rmem, pDsk = new_dp
435
       , pRem = new_prem, utilLoad = new_load
436
       , instSpindles = new_spindles
437
       }
438

    
439
-- | Adds a primary instance (basic version).
440
addPri :: Node -> Instance.Instance -> T.OpResult Node
441
addPri = addPriEx False
442

    
443
-- | Adds a primary instance (extended version).
444
addPriEx :: Bool               -- ^ Whether to override the N+1 and
445
                               -- other /soft/ checks, useful if we
446
                               -- come from a worse status
447
                               -- (e.g. offline)
448
         -> Node               -- ^ The target node
449
         -> Instance.Instance  -- ^ The instance to add
450
         -> T.OpResult Node    -- ^ The result of the operation,
451
                               -- either the new version of the node
452
                               -- or a failure mode
453
addPriEx force t inst =
454
  let iname = Instance.idx inst
455
      i_online = Instance.notOffline inst
456
      uses_disk = Instance.usesLocalStorage inst
457
      cur_dsk = fDsk t
458
      new_mem = decIf i_online (fMem t) (Instance.mem inst)
459
      new_dsk = decIf uses_disk cur_dsk (Instance.dsk inst)
460
      new_spindles = incIf uses_disk (instSpindles t) 1
461
      new_failn1 = new_mem <= rMem t
462
      new_ucpu = incIf i_online (uCpu t) (Instance.vcpus inst)
463
      new_pcpu = fromIntegral new_ucpu / tCpu t
464
      new_dp = computePDsk new_dsk (tDsk t)
465
      l_cpu = T.iPolicyVcpuRatio $ iPolicy t
466
      new_load = utilLoad t `T.addUtil` Instance.util inst
467
      inst_tags = Instance.exclTags inst
468
      old_tags = pTags t
469
      strict = not force
470
  in case () of
471
       _ | new_mem <= 0 -> Bad T.FailMem
472
         | uses_disk && new_dsk <= 0 -> Bad T.FailDisk
473
         | uses_disk && mDsk t > new_dp && strict -> Bad T.FailDisk
474
         | uses_disk && new_spindles > hiSpindles t
475
             && strict -> Bad T.FailDisk
476
         | new_failn1 && not (failN1 t) && strict -> Bad T.FailMem
477
         | l_cpu >= 0 && l_cpu < new_pcpu && strict -> Bad T.FailCPU
478
         | rejectAddTags old_tags inst_tags -> Bad T.FailTags
479
         | otherwise ->
480
           let new_plist = iname:pList t
481
               new_mp = fromIntegral new_mem / tMem t
482
               r = t { pList = new_plist, fMem = new_mem, fDsk = new_dsk
483
                     , failN1 = new_failn1, pMem = new_mp, pDsk = new_dp
484
                     , uCpu = new_ucpu, pCpu = new_pcpu
485
                     , utilLoad = new_load
486
                     , pTags = addTags old_tags inst_tags
487
                     , instSpindles = new_spindles
488
                     }
489
           in Ok r
490

    
491
-- | Adds a secondary instance (basic version).
492
addSec :: Node -> Instance.Instance -> T.Ndx -> T.OpResult Node
493
addSec = addSecEx False
494

    
495
-- | Adds a secondary instance (extended version).
496
addSecEx :: Bool -> Node -> Instance.Instance -> T.Ndx -> T.OpResult Node
497
addSecEx force t inst pdx =
498
  let iname = Instance.idx inst
499
      old_peers = peers t
500
      old_mem = fMem t
501
      new_dsk = fDsk t - Instance.dsk inst
502
      new_spindles = instSpindles t + 1
503
      secondary_needed_mem = if Instance.usesSecMem inst
504
                               then Instance.mem inst
505
                               else 0
506
      new_peem = P.find pdx old_peers + secondary_needed_mem
507
      new_peers = P.add pdx new_peem old_peers
508
      new_rmem = max (rMem t) new_peem
509
      new_prem = fromIntegral new_rmem / tMem t
510
      new_failn1 = old_mem <= new_rmem
511
      new_dp = computePDsk new_dsk (tDsk t)
512
      old_load = utilLoad t
513
      new_load = old_load { T.dskWeight = T.dskWeight old_load +
514
                                          T.dskWeight (Instance.util inst) }
515
      strict = not force
516
  in case () of
517
       _ | not (Instance.hasSecondary inst) -> Bad T.FailDisk
518
         | new_dsk <= 0 -> Bad T.FailDisk
519
         | mDsk t > new_dp && strict -> Bad T.FailDisk
520
         | new_spindles > hiSpindles t && strict -> Bad T.FailDisk
521
         | secondary_needed_mem >= old_mem && strict -> Bad T.FailMem
522
         | new_failn1 && not (failN1 t) && strict -> Bad T.FailMem
523
         | otherwise ->
524
           let new_slist = iname:sList t
525
               r = t { sList = new_slist, fDsk = new_dsk
526
                     , peers = new_peers, failN1 = new_failn1
527
                     , rMem = new_rmem, pDsk = new_dp
528
                     , pRem = new_prem, utilLoad = new_load
529
                     , instSpindles = new_spindles
530
                     }
531
           in Ok r
532

    
533
-- * Stats functions
534

    
535
-- | Computes the amount of available disk on a given node.
536
availDisk :: Node -> Int
537
availDisk t =
538
  let _f = fDsk t
539
      _l = loDsk t
540
  in if _f < _l
541
       then 0
542
       else _f - _l
543

    
544
-- | Computes the amount of used disk on a given node.
545
iDsk :: Node -> Int
546
iDsk t = truncate (tDsk t) - fDsk t
547

    
548
-- | Computes the amount of available memory on a given node.
549
availMem :: Node -> Int
550
availMem t =
551
  let _f = fMem t
552
      _l = rMem t
553
  in if _f < _l
554
       then 0
555
       else _f - _l
556

    
557
-- | Computes the amount of available memory on a given node.
558
availCpu :: Node -> Int
559
availCpu t =
560
  let _u = uCpu t
561
      _l = hiCpu t
562
  in if _l >= _u
563
       then _l - _u
564
       else 0
565

    
566
-- | The memory used by instances on a given node.
567
iMem :: Node -> Int
568
iMem t = truncate (tMem t) - nMem t - xMem t - fMem t
569

    
570
-- * Node graph functions
571
-- These functions do the transformations needed so that nodes can be
572
-- represented as a graph connected by the instances that are replicated
573
-- on them.
574

    
575
-- * Making of a Graph from a node/instance list
576

    
577
-- | Transform an instance into a list of edges on the node graph
578
instanceToEdges :: Instance.Instance -> [Graph.Edge]
579
instanceToEdges i
580
  | Instance.hasSecondary i = [(pnode,snode), (snode,pnode)]
581
  | otherwise = []
582
    where pnode = Instance.pNode i
583
          snode = Instance.sNode i
584

    
585
-- | Transform the list of instances into list of destination edges
586
instancesToEdges :: Instance.List -> [Graph.Edge]
587
instancesToEdges = concatMap instanceToEdges . Container.elems
588

    
589
-- | Transform the list of nodes into vertices bounds.
590
-- Returns Nothing is the list is empty.
591
nodesToBounds :: List -> Maybe Graph.Bounds
592
nodesToBounds nl = liftM2 (,) nmin nmax
593
    where nmin = fmap (fst . fst) (IntMap.minViewWithKey nl)
594
          nmax = fmap (fst . fst) (IntMap.maxViewWithKey nl)
595

    
596
-- | The clique of the primary nodes of the instances with a given secondary.
597
-- Return the full graph of those nodes that are primary node of at least one
598
-- instance that has the given node as secondary.
599
nodeToSharedSecondaryEdge :: Instance.List -> Node -> [Graph.Edge]
600
nodeToSharedSecondaryEdge il n = (,) <$> primaries <*> primaries
601
  where primaries = map (Instance.pNode . flip Container.find il) $ sList n
602

    
603

    
604
-- | Predicate of an edge having both vertices in a set of nodes.
605
filterValid :: List -> [Graph.Edge] -> [Graph.Edge]
606
filterValid nl  =  filter $ \(x,y) -> IntMap.member x nl && IntMap.member y nl
607

    
608
-- | Transform a Node + Instance list into a NodeGraph type.
609
-- Returns Nothing if the node list is empty.
610
mkNodeGraph :: List -> Instance.List -> Maybe Graph.Graph
611
mkNodeGraph nl il =
612
  liftM (`Graph.buildG` (filterValid nl . instancesToEdges $ il))
613
  (nodesToBounds nl)
614

    
615
-- | Transform a Nodes + Instances into a NodeGraph with all reboot exclusions.
616
-- This includes edges between nodes that are the primary nodes of instances
617
-- that have the same secondary node. Nodes not in the node list will not be
618
-- part of the graph, but they are still considered for the edges arising from
619
-- two instances having the same secondary node.
620
-- Return Nothing if the node list is empty.
621
mkRebootNodeGraph :: List -> List -> Instance.List -> Maybe Graph.Graph
622
mkRebootNodeGraph allnodes nl il =
623
  liftM (`Graph.buildG` filterValid nl edges) (nodesToBounds nl)
624
  where
625
    edges = instancesToEdges il `union`
626
            (Container.elems allnodes >>= nodeToSharedSecondaryEdge il) 
627

    
628
-- * Display functions
629

    
630
-- | Return a field for a given node.
631
showField :: Node   -- ^ Node which we're querying
632
          -> String -- ^ Field name
633
          -> String -- ^ Field value as string
634
showField t field =
635
  case field of
636
    "idx"  -> printf "%4d" $ idx t
637
    "name" -> alias t
638
    "fqdn" -> name t
639
    "status" -> case () of
640
                  _ | offline t -> "-"
641
                    | failN1 t -> "*"
642
                    | otherwise -> " "
643
    "tmem" -> printf "%5.0f" $ tMem t
644
    "nmem" -> printf "%5d" $ nMem t
645
    "xmem" -> printf "%5d" $ xMem t
646
    "fmem" -> printf "%5d" $ fMem t
647
    "imem" -> printf "%5d" $ iMem t
648
    "rmem" -> printf "%5d" $ rMem t
649
    "amem" -> printf "%5d" $ fMem t - rMem t
650
    "tdsk" -> printf "%5.0f" $ tDsk t / 1024
651
    "fdsk" -> printf "%5d" $ fDsk t `div` 1024
652
    "tcpu" -> printf "%4.0f" $ tCpu t
653
    "ucpu" -> printf "%4d" $ uCpu t
654
    "pcnt" -> printf "%3d" $ length (pList t)
655
    "scnt" -> printf "%3d" $ length (sList t)
656
    "plist" -> show $ pList t
657
    "slist" -> show $ sList t
658
    "pfmem" -> printf "%6.4f" $ pMem t
659
    "pfdsk" -> printf "%6.4f" $ pDsk t
660
    "rcpu"  -> printf "%5.2f" $ pCpu t
661
    "cload" -> printf "%5.3f" uC
662
    "mload" -> printf "%5.3f" uM
663
    "dload" -> printf "%5.3f" uD
664
    "nload" -> printf "%5.3f" uN
665
    "ptags" -> intercalate "," . map (uncurry (printf "%s=%d")) .
666
               Map.toList $ pTags t
667
    "peermap" -> show $ peers t
668
    "spindle_count" -> show $ spindleCount t
669
    "hi_spindles" -> show $ hiSpindles t
670
    "inst_spindles" -> show $ instSpindles t
671
    _ -> T.unknownField
672
  where
673
    T.DynUtil { T.cpuWeight = uC, T.memWeight = uM,
674
                T.dskWeight = uD, T.netWeight = uN } = utilLoad t
675

    
676
-- | Returns the header and numeric propery of a field.
677
showHeader :: String -> (String, Bool)
678
showHeader field =
679
  case field of
680
    "idx" -> ("Index", True)
681
    "name" -> ("Name", False)
682
    "fqdn" -> ("Name", False)
683
    "status" -> ("F", False)
684
    "tmem" -> ("t_mem", True)
685
    "nmem" -> ("n_mem", True)
686
    "xmem" -> ("x_mem", True)
687
    "fmem" -> ("f_mem", True)
688
    "imem" -> ("i_mem", True)
689
    "rmem" -> ("r_mem", True)
690
    "amem" -> ("a_mem", True)
691
    "tdsk" -> ("t_dsk", True)
692
    "fdsk" -> ("f_dsk", True)
693
    "tcpu" -> ("pcpu", True)
694
    "ucpu" -> ("vcpu", True)
695
    "pcnt" -> ("pcnt", True)
696
    "scnt" -> ("scnt", True)
697
    "plist" -> ("primaries", True)
698
    "slist" -> ("secondaries", True)
699
    "pfmem" -> ("p_fmem", True)
700
    "pfdsk" -> ("p_fdsk", True)
701
    "rcpu"  -> ("r_cpu", True)
702
    "cload" -> ("lCpu", True)
703
    "mload" -> ("lMem", True)
704
    "dload" -> ("lDsk", True)
705
    "nload" -> ("lNet", True)
706
    "ptags" -> ("PrimaryTags", False)
707
    "peermap" -> ("PeerMap", False)
708
    "spindle_count" -> ("NodeSpindles", True)
709
    "hi_spindles" -> ("MaxSpindles", True)
710
    "inst_spindles" -> ("InstSpindles", True)
711
    -- TODO: add node fields (group.uuid, group)
712
    _ -> (T.unknownField, False)
713

    
714
-- | String converter for the node list functionality.
715
list :: [String] -> Node -> [String]
716
list fields t = map (showField t) fields
717

    
718
-- | Constant holding the fields we're displaying by default.
719
defaultFields :: [String]
720
defaultFields =
721
  [ "status", "name", "tmem", "nmem", "imem", "xmem", "fmem"
722
  , "rmem", "tdsk", "fdsk", "tcpu", "ucpu", "pcnt", "scnt"
723
  , "pfmem", "pfdsk", "rcpu"
724
  , "cload", "mload", "dload", "nload" ]
725

    
726
{-# ANN computeGroups "HLint: ignore Use alternative" #-}
727
-- | Split a list of nodes into a list of (node group UUID, list of
728
-- associated nodes).
729
computeGroups :: [Node] -> [(T.Gdx, [Node])]
730
computeGroups nodes =
731
  let nodes' = sortBy (comparing group) nodes
732
      nodes'' = groupBy ((==) `on` group) nodes'
733
  -- use of head here is OK, since groupBy returns non-empty lists; if
734
  -- you remove groupBy, also remove use of head
735
  in map (\nl -> (group (head nl), nl)) nodes''