code.grnet.gr Git - ganeti-local/blob - src/Ganeti/HTools/Node.hs

   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   , setMdsk
  44   , setMcpu
  45   , setPolicy
  46   -- * Tag maps
  47   , addTags
  48   , delTags
  49   , rejectAddTags
  50   -- * Instance (re)location
  51   , removePri
  52   , removeSec
  53   , addPri
  54   , addPriEx
  55   , addSec
  56   , addSecEx
  57   -- * Stats
  58   , availDisk
  59   , availMem
  60   , availCpu
  61   , iMem
  62   , iDsk
  63   , conflictingPrimaries
  64   -- * Formatting
  65   , defaultFields
  66   , showHeader
  67   , showField
  68   , list
  69   -- * Misc stuff
  70   , AssocList
  71   , AllocElement
  72   , noSecondary
  73   , computeGroups
  74   , mkNodeGraph
  75   ) where
  76
  77 import Control.Monad (liftM, liftM2)
  78 import qualified Data.Foldable as Foldable
  79 import Data.Function (on)
  80 import qualified Data.Graph as Graph
  81 import qualified Data.IntMap as IntMap
  82 import Data.List hiding (group)
  83 import qualified Data.Map as Map
  84 import Data.Ord (comparing)
  85 import Text.Printf (printf)
  86
  87 import qualified Ganeti.HTools.Container as Container
  88 import qualified Ganeti.HTools.Instance as Instance
  89 import qualified Ganeti.HTools.PeerMap as P
  90
  91 import Ganeti.BasicTypes
  92 import qualified Ganeti.HTools.Types as T
  93
  94 -- * Type declarations
  95
  96 -- | The tag map type.
  97 type TagMap = Map.Map String Int
  98
  99 -- | The node type.
 100 data Node = Node
 101   { name     :: String    -- ^ The node name
 102   , alias    :: String    -- ^ The shortened name (for display purposes)
 103   , tMem     :: Double    -- ^ Total memory (MiB)
 104   , nMem     :: Int       -- ^ Node memory (MiB)
 105   , fMem     :: Int       -- ^ Free memory (MiB)
 106   , xMem     :: Int       -- ^ Unaccounted memory (MiB)
 107   , tDsk     :: Double    -- ^ Total disk space (MiB)
 108   , fDsk     :: Int       -- ^ Free disk space (MiB)
 109   , tCpu     :: Double    -- ^ Total CPU count
 110   , uCpu     :: Int       -- ^ Used VCPU count
 111   , spindleCount :: Int   -- ^ Node spindles (spindle_count node parameter)
 112   , pList    :: [T.Idx]   -- ^ List of primary instance indices
 113   , sList    :: [T.Idx]   -- ^ List of secondary instance indices
 114   , idx      :: T.Ndx     -- ^ Internal index for book-keeping
 115   , peers    :: P.PeerMap -- ^ Pnode to instance mapping
 116   , failN1   :: Bool      -- ^ Whether the node has failed n1
 117   , rMem     :: Int       -- ^ Maximum memory needed for failover by
 118                           -- primaries of this node
 119   , pMem     :: Double    -- ^ Percent of free memory
 120   , pDsk     :: Double    -- ^ Percent of free disk
 121   , pRem     :: Double    -- ^ Percent of reserved memory
 122   , pCpu     :: Double    -- ^ Ratio of virtual to physical CPUs
 123   , mDsk     :: Double    -- ^ Minimum free disk ratio
 124   , loDsk    :: Int       -- ^ Autocomputed from mDsk low disk
 125                           -- threshold
 126   , hiCpu    :: Int       -- ^ Autocomputed from mCpu high cpu
 127                           -- threshold
 128   , hiSpindles :: Double  -- ^ Auto-computed from policy spindle_ratio
 129                           -- and the node spindle count
 130   , instSpindles :: Double -- ^ Spindles used by instances
 131   , offline  :: Bool      -- ^ Whether the node should not be used for
 132                           -- allocations and skipped from score
 133                           -- computations
 134   , isMaster :: Bool      -- ^ Whether the node is the master node
 135   , utilPool :: T.DynUtil -- ^ Total utilisation capacity
 136   , utilLoad :: T.DynUtil -- ^ Sum of instance utilisation
 137   , pTags    :: TagMap    -- ^ Primary instance exclusion tags and their count
 138   , group    :: T.Gdx     -- ^ The node's group (index)
 139   , iPolicy  :: T.IPolicy -- ^ The instance policy (of the node's group)
 140   } deriving (Show, Eq)
 141
 142 instance T.Element Node where
 143   nameOf = name
 144   idxOf = idx
 145   setAlias = setAlias
 146   setIdx = setIdx
 147   allNames n = [name n, alias n]
 148
 149 -- | A simple name for the int, node association list.
 150 type AssocList = [(T.Ndx, Node)]
 151
 152 -- | A simple name for a node map.
 153 type List = Container.Container Node
 154
 155 -- | A simple name for an allocation element (here just for logistic
 156 -- reasons).
 157 type AllocElement = (List, Instance.Instance, [Node], T.Score)
 158
 159 -- | Constant node index for a non-moveable instance.
 160 noSecondary :: T.Ndx
 161 noSecondary = -1
 162
 163 -- * Helper functions
 164
 165 -- | Add a tag to a tagmap.
 166 addTag :: TagMap -> String -> TagMap
 167 addTag t s = Map.insertWith (+) s 1 t
 168
 169 -- | Add multiple tags.
 170 addTags :: TagMap -> [String] -> TagMap
 171 addTags = foldl' addTag
 172
 173 -- | Adjust or delete a tag from a tagmap.
 174 delTag :: TagMap -> String -> TagMap
 175 delTag t s = Map.update (\v -> if v > 1
 176                                  then Just (v-1)
 177                                  else Nothing)
 178              s t
 179
 180 -- | Remove multiple tags.
 181 delTags :: TagMap -> [String] -> TagMap
 182 delTags = foldl' delTag
 183
 184 -- | Check if we can add a list of tags to a tagmap.
 185 rejectAddTags :: TagMap -> [String] -> Bool
 186 rejectAddTags t = any (`Map.member` t)
 187
 188 -- | Check how many primary instances have conflicting tags. The
 189 -- algorithm to compute this is to sum the count of all tags, then
 190 -- subtract the size of the tag map (since each tag has at least one,
 191 -- non-conflicting instance); this is equivalent to summing the
 192 -- values in the tag map minus one.
 193 conflictingPrimaries :: Node -> Int
 194 conflictingPrimaries (Node { pTags = t }) = Foldable.sum t - Map.size t
 195
 196 -- | Helper function to increment a base value depending on the passed
 197 -- boolean argument.
 198 incIf :: (Num a) => Bool -> a -> a -> a
 199 incIf True  base delta = base + delta
 200 incIf False base _     = base
 201
 202 -- | Helper function to decrement a base value depending on the passed
 203 -- boolean argument.
 204 decIf :: (Num a) => Bool -> a -> a -> a
 205 decIf True  base delta = base - delta
 206 decIf False base _     = base
 207
 208 -- * Initialization functions
 209
 210 -- | Create a new node.
 211 --
 212 -- The index and the peers maps are empty, and will be need to be
 213 -- update later via the 'setIdx' and 'buildPeers' functions.
 214 create :: String -> Double -> Int -> Int -> Double
 215        -> Int -> Double -> Bool -> Int -> T.Gdx -> Node
 216 create name_init mem_t_init mem_n_init mem_f_init
 217        dsk_t_init dsk_f_init cpu_t_init offline_init spindles_init
 218        group_init =
 219   Node { name = name_init
 220        , alias = name_init
 221        , tMem = mem_t_init
 222        , nMem = mem_n_init
 223        , fMem = mem_f_init
 224        , tDsk = dsk_t_init
 225        , fDsk = dsk_f_init
 226        , tCpu = cpu_t_init
 227        , spindleCount = spindles_init
 228        , uCpu = 0
 229        , pList = []
 230        , sList = []
 231        , failN1 = True
 232        , idx = -1
 233        , peers = P.empty
 234        , rMem = 0
 235        , pMem = fromIntegral mem_f_init / mem_t_init
 236        , pDsk = computePDsk dsk_f_init dsk_t_init
 237        , pRem = 0
 238        , pCpu = 0
 239        , offline = offline_init
 240        , isMaster = False
 241        , xMem = 0
 242        , mDsk = T.defReservedDiskRatio
 243        , loDsk = mDskToloDsk T.defReservedDiskRatio dsk_t_init
 244        , hiCpu = mCpuTohiCpu (T.iPolicyVcpuRatio T.defIPolicy) cpu_t_init
 245        , hiSpindles = computeHiSpindles (T.iPolicySpindleRatio T.defIPolicy)
 246                       spindles_init
 247        , instSpindles = 0
 248        , utilPool = T.baseUtil
 249        , utilLoad = T.zeroUtil
 250        , pTags = Map.empty
 251        , group = group_init
 252        , iPolicy = T.defIPolicy
 253        }
 254
 255 -- | Conversion formula from mDsk\/tDsk to loDsk.
 256 mDskToloDsk :: Double -> Double -> Int
 257 mDskToloDsk mval = floor . (mval *)
 258
 259 -- | Conversion formula from mCpu\/tCpu to hiCpu.
 260 mCpuTohiCpu :: Double -> Double -> Int
 261 mCpuTohiCpu mval = floor . (mval *)
 262
 263 -- | Conversiojn formula from spindles and spindle ratio to hiSpindles.
 264 computeHiSpindles :: Double -> Int -> Double
 265 computeHiSpindles spindle_ratio = (spindle_ratio *) . fromIntegral
 266
 267 -- | Changes the index.
 268 --
 269 -- This is used only during the building of the data structures.
 270 setIdx :: Node -> T.Ndx -> Node
 271 setIdx t i = t {idx = i}
 272
 273 -- | Changes the alias.
 274 --
 275 -- This is used only during the building of the data structures.
 276 setAlias :: Node -> String -> Node
 277 setAlias t s = t { alias = s }
 278
 279 -- | Sets the offline attribute.
 280 setOffline :: Node -> Bool -> Node
 281 setOffline t val = t { offline = val }
 282
 283 -- | Sets the master attribute
 284 setMaster :: Node -> Bool -> Node
 285 setMaster t val = t { isMaster = val }
 286
 287 -- | Sets the unnaccounted memory.
 288 setXmem :: Node -> Int -> Node
 289 setXmem t val = t { xMem = val }
 290
 291 -- | Sets the max disk usage ratio.
 292 setMdsk :: Node -> Double -> Node
 293 setMdsk t val = t { mDsk = val, loDsk = mDskToloDsk val (tDsk t) }
 294
 295 -- | Sets the max cpu usage ratio. This will update the node's
 296 -- ipolicy, losing sharing (but it should be a seldomly done operation).
 297 setMcpu :: Node -> Double -> Node
 298 setMcpu t val =
 299   let new_ipol = (iPolicy t) { T.iPolicyVcpuRatio = val }
 300   in t { hiCpu = mCpuTohiCpu val (tCpu t), iPolicy = new_ipol }
 301
 302 -- | Sets the policy.
 303 setPolicy :: T.IPolicy -> Node -> Node
 304 setPolicy pol node =
 305   node { iPolicy = pol
 306        , hiCpu = mCpuTohiCpu (T.iPolicyVcpuRatio pol) (tCpu node)
 307        , hiSpindles = computeHiSpindles (T.iPolicySpindleRatio pol)
 308                       (spindleCount node)
 309        }
 310
 311 -- | Computes the maximum reserved memory for peers from a peer map.
 312 computeMaxRes :: P.PeerMap -> P.Elem
 313 computeMaxRes = P.maxElem
 314
 315 -- | Builds the peer map for a given node.
 316 buildPeers :: Node -> Instance.List -> Node
 317 buildPeers t il =
 318   let mdata = map
 319               (\i_idx -> let inst = Container.find i_idx il
 320                              mem = if Instance.usesSecMem inst
 321                                      then Instance.mem inst
 322                                      else 0
 323                          in (Instance.pNode inst, mem))
 324               (sList t)
 325       pmap = P.accumArray (+) mdata
 326       new_rmem = computeMaxRes pmap
 327       new_failN1 = fMem t <= new_rmem
 328       new_prem = fromIntegral new_rmem / tMem t
 329   in t {peers=pmap, failN1 = new_failN1, rMem = new_rmem, pRem = new_prem}
 330
 331 -- | Calculate the new spindle usage
 332 calcSpindleUse :: Node -> Instance.Instance -> Double
 333 calcSpindleUse n i = incIf (Instance.usesLocalStorage i) (instSpindles n)
 334                        (fromIntegral $ Instance.spindleUse i)
 335
 336 -- | Assigns an instance to a node as primary and update the used VCPU
 337 -- count, utilisation data and tags map.
 338 setPri :: Node -> Instance.Instance -> Node
 339 setPri t inst = t { pList = Instance.idx inst:pList t
 340                   , uCpu = new_count
 341                   , pCpu = fromIntegral new_count / tCpu t
 342                   , utilLoad = utilLoad t `T.addUtil` Instance.util inst
 343                   , pTags = addTags (pTags t) (Instance.exclTags inst)
 344                   , instSpindles = calcSpindleUse t inst
 345                   }
 346   where new_count = Instance.applyIfOnline inst (+ Instance.vcpus inst)
 347                     (uCpu t )
 348
 349 -- | Assigns an instance to a node as secondary without other updates.
 350 setSec :: Node -> Instance.Instance -> Node
 351 setSec t inst = t { sList = Instance.idx inst:sList t
 352                   , utilLoad = old_load { T.dskWeight = T.dskWeight old_load +
 353                                           T.dskWeight (Instance.util inst) }
 354                   , instSpindles = calcSpindleUse t inst
 355                   }
 356   where old_load = utilLoad t
 357
 358 -- | Computes the new 'pDsk' value, handling nodes without local disk
 359 -- storage (we consider all their disk used).
 360 computePDsk :: Int -> Double -> Double
 361 computePDsk _    0     = 1
 362 computePDsk used total = fromIntegral used / total
 363
 364 -- * Update functions
 365
 366 -- | Sets the free memory.
 367 setFmem :: Node -> Int -> Node
 368 setFmem t new_mem =
 369   let new_n1 = new_mem < rMem t
 370       new_mp = fromIntegral new_mem / tMem t
 371   in t { fMem = new_mem, failN1 = new_n1, pMem = new_mp }
 372
 373 -- | Removes a primary instance.
 374 removePri :: Node -> Instance.Instance -> Node
 375 removePri t inst =
 376   let iname = Instance.idx inst
 377       i_online = Instance.notOffline inst
 378       uses_disk = Instance.usesLocalStorage inst
 379       new_plist = delete iname (pList t)
 380       new_mem = incIf i_online (fMem t) (Instance.mem inst)
 381       new_dsk = incIf uses_disk (fDsk t) (Instance.dsk inst)
 382       new_spindles = decIf uses_disk (instSpindles t) 1
 383       new_mp = fromIntegral new_mem / tMem t
 384       new_dp = computePDsk new_dsk (tDsk t)
 385       new_failn1 = new_mem <= rMem t
 386       new_ucpu = decIf i_online (uCpu t) (Instance.vcpus inst)
 387       new_rcpu = fromIntegral new_ucpu / tCpu t
 388       new_load = utilLoad t `T.subUtil` Instance.util inst
 389   in t { pList = new_plist, fMem = new_mem, fDsk = new_dsk
 390        , failN1 = new_failn1, pMem = new_mp, pDsk = new_dp
 391        , uCpu = new_ucpu, pCpu = new_rcpu, utilLoad = new_load
 392        , pTags = delTags (pTags t) (Instance.exclTags inst)
 393        , instSpindles = new_spindles
 394        }
 395
 396 -- | Removes a secondary instance.
 397 removeSec :: Node -> Instance.Instance -> Node
 398 removeSec t inst =
 399   let iname = Instance.idx inst
 400       uses_disk = Instance.usesLocalStorage inst
 401       cur_dsk = fDsk t
 402       pnode = Instance.pNode inst
 403       new_slist = delete iname (sList t)
 404       new_dsk = incIf uses_disk cur_dsk (Instance.dsk inst)
 405       new_spindles = decIf uses_disk (instSpindles t) 1
 406       old_peers = peers t
 407       old_peem = P.find pnode old_peers
 408       new_peem = decIf (Instance.usesSecMem inst) old_peem (Instance.mem inst)
 409       new_peers = if new_peem > 0
 410                     then P.add pnode new_peem old_peers
 411                     else P.remove pnode old_peers
 412       old_rmem = rMem t
 413       new_rmem = if old_peem < old_rmem
 414                    then old_rmem
 415                    else computeMaxRes new_peers
 416       new_prem = fromIntegral new_rmem / tMem t
 417       new_failn1 = fMem t <= new_rmem
 418       new_dp = computePDsk new_dsk (tDsk t)
 419       old_load = utilLoad t
 420       new_load = old_load { T.dskWeight = T.dskWeight old_load -
 421                                           T.dskWeight (Instance.util inst) }
 422   in t { sList = new_slist, fDsk = new_dsk, peers = new_peers
 423        , failN1 = new_failn1, rMem = new_rmem, pDsk = new_dp
 424        , pRem = new_prem, utilLoad = new_load
 425        , instSpindles = new_spindles
 426        }
 427
 428 -- | Adds a primary instance (basic version).
 429 addPri :: Node -> Instance.Instance -> T.OpResult Node
 430 addPri = addPriEx False
 431
 432 -- | Adds a primary instance (extended version).
 433 addPriEx :: Bool               -- ^ Whether to override the N+1 and
 434                                -- other /soft/ checks, useful if we
 435                                -- come from a worse status
 436                                -- (e.g. offline)
 437          -> Node               -- ^ The target node
 438          -> Instance.Instance  -- ^ The instance to add
 439          -> T.OpResult Node    -- ^ The result of the operation,
 440                                -- either the new version of the node
 441                                -- or a failure mode
 442 addPriEx force t inst =
 443   let iname = Instance.idx inst
 444       i_online = Instance.notOffline inst
 445       uses_disk = Instance.usesLocalStorage inst
 446       cur_dsk = fDsk t
 447       new_mem = decIf i_online (fMem t) (Instance.mem inst)
 448       new_dsk = decIf uses_disk cur_dsk (Instance.dsk inst)
 449       new_spindles = incIf uses_disk (instSpindles t) 1
 450       new_failn1 = new_mem <= rMem t
 451       new_ucpu = incIf i_online (uCpu t) (Instance.vcpus inst)
 452       new_pcpu = fromIntegral new_ucpu / tCpu t
 453       new_dp = computePDsk new_dsk (tDsk t)
 454       l_cpu = T.iPolicyVcpuRatio $ iPolicy t
 455       new_load = utilLoad t `T.addUtil` Instance.util inst
 456       inst_tags = Instance.exclTags inst
 457       old_tags = pTags t
 458       strict = not force
 459   in case () of
 460        _ | new_mem <= 0 -> Bad T.FailMem
 461          | uses_disk && new_dsk <= 0 -> Bad T.FailDisk
 462          | uses_disk && mDsk t > new_dp && strict -> Bad T.FailDisk
 463          | uses_disk && new_spindles > hiSpindles t
 464              && strict -> Bad T.FailDisk
 465          | new_failn1 && not (failN1 t) && strict -> Bad T.FailMem
 466          | l_cpu >= 0 && l_cpu < new_pcpu && strict -> Bad T.FailCPU
 467          | rejectAddTags old_tags inst_tags -> Bad T.FailTags
 468          | otherwise ->
 469            let new_plist = iname:pList t
 470                new_mp = fromIntegral new_mem / tMem t
 471                r = t { pList = new_plist, fMem = new_mem, fDsk = new_dsk
 472                      , failN1 = new_failn1, pMem = new_mp, pDsk = new_dp
 473                      , uCpu = new_ucpu, pCpu = new_pcpu
 474                      , utilLoad = new_load
 475                      , pTags = addTags old_tags inst_tags
 476                      , instSpindles = new_spindles
 477                      }
 478            in Ok r
 479
 480 -- | Adds a secondary instance (basic version).
 481 addSec :: Node -> Instance.Instance -> T.Ndx -> T.OpResult Node
 482 addSec = addSecEx False
 483
 484 -- | Adds a secondary instance (extended version).
 485 addSecEx :: Bool -> Node -> Instance.Instance -> T.Ndx -> T.OpResult Node
 486 addSecEx force t inst pdx =
 487   let iname = Instance.idx inst
 488       old_peers = peers t
 489       old_mem = fMem t
 490       new_dsk = fDsk t - Instance.dsk inst
 491       new_spindles = instSpindles t + 1
 492       secondary_needed_mem = if Instance.usesSecMem inst
 493                                then Instance.mem inst
 494                                else 0
 495       new_peem = P.find pdx old_peers + secondary_needed_mem
 496       new_peers = P.add pdx new_peem old_peers
 497       new_rmem = max (rMem t) new_peem
 498       new_prem = fromIntegral new_rmem / tMem t
 499       new_failn1 = old_mem <= new_rmem
 500       new_dp = computePDsk new_dsk (tDsk t)
 501       old_load = utilLoad t
 502       new_load = old_load { T.dskWeight = T.dskWeight old_load +
 503                                           T.dskWeight (Instance.util inst) }
 504       strict = not force
 505   in case () of
 506        _ | not (Instance.hasSecondary inst) -> Bad T.FailDisk
 507          | new_dsk <= 0 -> Bad T.FailDisk
 508          | mDsk t > new_dp && strict -> Bad T.FailDisk
 509          | new_spindles > hiSpindles t && strict -> Bad T.FailDisk
 510          | secondary_needed_mem >= old_mem && strict -> Bad T.FailMem
 511          | new_failn1 && not (failN1 t) && strict -> Bad T.FailMem
 512          | otherwise ->
 513            let new_slist = iname:sList t
 514                r = t { sList = new_slist, fDsk = new_dsk
 515                      , peers = new_peers, failN1 = new_failn1
 516                      , rMem = new_rmem, pDsk = new_dp
 517                      , pRem = new_prem, utilLoad = new_load
 518                      , instSpindles = new_spindles
 519                      }
 520            in Ok r
 521
 522 -- * Stats functions
 523
 524 -- | Computes the amount of available disk on a given node.
 525 availDisk :: Node -> Int
 526 availDisk t =
 527   let _f = fDsk t
 528       _l = loDsk t
 529   in if _f < _l
 530        then 0
 531        else _f - _l
 532
 533 -- | Computes the amount of used disk on a given node.
 534 iDsk :: Node -> Int
 535 iDsk t = truncate (tDsk t) - fDsk t
 536
 537 -- | Computes the amount of available memory on a given node.
 538 availMem :: Node -> Int
 539 availMem t =
 540   let _f = fMem t
 541       _l = rMem t
 542   in if _f < _l
 543        then 0
 544        else _f - _l
 545
 546 -- | Computes the amount of available memory on a given node.
 547 availCpu :: Node -> Int
 548 availCpu t =
 549   let _u = uCpu t
 550       _l = hiCpu t
 551   in if _l >= _u
 552        then _l - _u
 553        else 0
 554
 555 -- | The memory used by instances on a given node.
 556 iMem :: Node -> Int
 557 iMem t = truncate (tMem t) - nMem t - xMem t - fMem t
 558
 559 -- * Node graph functions
 560 -- These functions do the transformations needed so that nodes can be
 561 -- represented as a graph connected by the instances that are replicated
 562 -- on them.
 563
 564 -- * Making of a Graph from a node/instance list
 565
 566 -- | Transform an instance into a list of edges on the node graph
 567 instanceToEdges :: Instance.Instance -> [Graph.Edge]
 568 instanceToEdges i
 569   | Instance.hasSecondary i = [(pnode,snode), (snode,pnode)]
 570   | otherwise = []
 571     where pnode = Instance.pNode i
 572           snode = Instance.sNode i
 573
 574 -- | Transform the list of instances into list of destination edges
 575 instancesToEdges :: Instance.List -> [Graph.Edge]
 576 instancesToEdges = concatMap instanceToEdges . Container.elems
 577
 578 -- | Transform the list of nodes into vertices bounds.
 579 -- Returns Nothing is the list is empty.
 580 nodesToBounds :: List -> Maybe Graph.Bounds
 581 nodesToBounds nl = liftM2 (,) nmin nmax
 582     where nmin = fmap (fst . fst) (IntMap.minViewWithKey nl)
 583           nmax = fmap (fst . fst) (IntMap.maxViewWithKey nl)
 584
 585 -- | Transform a Node + Instance list into a NodeGraph type.
 586 -- Returns Nothing if the node list is empty.
 587 mkNodeGraph :: List -> Instance.List -> Maybe Graph.Graph
 588 mkNodeGraph nl il =
 589   liftM (`Graph.buildG` instancesToEdges il) (nodesToBounds nl)
 590
 591 -- * Display functions
 592
 593 -- | Return a field for a given node.
 594 showField :: Node   -- ^ Node which we're querying
 595           -> String -- ^ Field name
 596           -> String -- ^ Field value as string
 597 showField t field =
 598   case field of
 599     "idx"  -> printf "%4d" $ idx t
 600     "name" -> alias t
 601     "fqdn" -> name t
 602     "status" -> case () of
 603                   _ | offline t -> "-"
 604                     | failN1 t -> "*"
 605                     | otherwise -> " "
 606     "tmem" -> printf "%5.0f" $ tMem t
 607     "nmem" -> printf "%5d" $ nMem t
 608     "xmem" -> printf "%5d" $ xMem t
 609     "fmem" -> printf "%5d" $ fMem t
 610     "imem" -> printf "%5d" $ iMem t
 611     "rmem" -> printf "%5d" $ rMem t
 612     "amem" -> printf "%5d" $ fMem t - rMem t
 613     "tdsk" -> printf "%5.0f" $ tDsk t / 1024
 614     "fdsk" -> printf "%5d" $ fDsk t `div` 1024
 615     "tcpu" -> printf "%4.0f" $ tCpu t
 616     "ucpu" -> printf "%4d" $ uCpu t
 617     "pcnt" -> printf "%3d" $ length (pList t)
 618     "scnt" -> printf "%3d" $ length (sList t)
 619     "plist" -> show $ pList t
 620     "slist" -> show $ sList t
 621     "pfmem" -> printf "%6.4f" $ pMem t
 622     "pfdsk" -> printf "%6.4f" $ pDsk t
 623     "rcpu"  -> printf "%5.2f" $ pCpu t
 624     "cload" -> printf "%5.3f" uC
 625     "mload" -> printf "%5.3f" uM
 626     "dload" -> printf "%5.3f" uD
 627     "nload" -> printf "%5.3f" uN
 628     "ptags" -> intercalate "," . map (uncurry (printf "%s=%d")) .
 629                Map.toList $ pTags t
 630     "peermap" -> show $ peers t
 631     "spindle_count" -> show $ spindleCount t
 632     "hi_spindles" -> show $ hiSpindles t
 633     "inst_spindles" -> show $ instSpindles t
 634     _ -> T.unknownField
 635   where
 636     T.DynUtil { T.cpuWeight = uC, T.memWeight = uM,
 637                 T.dskWeight = uD, T.netWeight = uN } = utilLoad t
 638
 639 -- | Returns the header and numeric propery of a field.
 640 showHeader :: String -> (String, Bool)
 641 showHeader field =
 642   case field of
 643     "idx" -> ("Index", True)
 644     "name" -> ("Name", False)
 645     "fqdn" -> ("Name", False)
 646     "status" -> ("F", False)
 647     "tmem" -> ("t_mem", True)
 648     "nmem" -> ("n_mem", True)
 649     "xmem" -> ("x_mem", True)
 650     "fmem" -> ("f_mem", True)
 651     "imem" -> ("i_mem", True)
 652     "rmem" -> ("r_mem", True)
 653     "amem" -> ("a_mem", True)
 654     "tdsk" -> ("t_dsk", True)
 655     "fdsk" -> ("f_dsk", True)
 656     "tcpu" -> ("pcpu", True)
 657     "ucpu" -> ("vcpu", True)
 658     "pcnt" -> ("pcnt", True)
 659     "scnt" -> ("scnt", True)
 660     "plist" -> ("primaries", True)
 661     "slist" -> ("secondaries", True)
 662     "pfmem" -> ("p_fmem", True)
 663     "pfdsk" -> ("p_fdsk", True)
 664     "rcpu"  -> ("r_cpu", True)
 665     "cload" -> ("lCpu", True)
 666     "mload" -> ("lMem", True)
 667     "dload" -> ("lDsk", True)
 668     "nload" -> ("lNet", True)
 669     "ptags" -> ("PrimaryTags", False)
 670     "peermap" -> ("PeerMap", False)
 671     "spindle_count" -> ("NodeSpindles", True)
 672     "hi_spindles" -> ("MaxSpindles", True)
 673     "inst_spindles" -> ("InstSpindles", True)
 674     -- TODO: add node fields (group.uuid, group)
 675     _ -> (T.unknownField, False)
 676
 677 -- | String converter for the node list functionality.
 678 list :: [String] -> Node -> [String]
 679 list fields t = map (showField t) fields
 680
 681 -- | Constant holding the fields we're displaying by default.
 682 defaultFields :: [String]
 683 defaultFields =
 684   [ "status", "name", "tmem", "nmem", "imem", "xmem", "fmem"
 685   , "rmem", "tdsk", "fdsk", "tcpu", "ucpu", "pcnt", "scnt"
 686   , "pfmem", "pfdsk", "rcpu"
 687   , "cload", "mload", "dload", "nload" ]
 688
 689 {-# ANN computeGroups "HLint: ignore Use alternative" #-}
 690 -- | Split a list of nodes into a list of (node group UUID, list of
 691 -- associated nodes).
 692 computeGroups :: [Node] -> [(T.Gdx, [Node])]
 693 computeGroups nodes =
 694   let nodes' = sortBy (comparing group) nodes
 695       nodes'' = groupBy ((==) `on` group) nodes'
 696   -- use of head here is OK, since groupBy returns non-empty lists; if
 697   -- you remove groupBy, also remove use of head
 698   in map (\nl -> (group (head nl), nl)) nodes''