code.grnet.gr Git - ganeti-local/blob - htools/Ganeti/Query/Node.hs

   1 {-| Implementation of the Ganeti Query2 node queries.
   2
   3  -}
   4
   5 {-
   6
   7 Copyright (C) 2012 Google Inc.
   8
   9 This program is free software; you can redistribute it and/or modify
  10 it under the terms of the GNU General Public License as published by
  11 the Free Software Foundation; either version 2 of the License, or
  12 (at your option) any later version.
  13
  14 This program is distributed in the hope that it will be useful, but
  15 WITHOUT ANY WARRANTY; without even the implied warranty of
  16 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  17 General Public License for more details.
  18
  19 You should have received a copy of the GNU General Public License
  20 along with this program; if not, write to the Free Software
  21 Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
  22 02110-1301, USA.
  23
  24 -}
  25
  26 module Ganeti.Query.Node
  27   ( NodeRuntime(..)
  28   , nodeFieldsMap
  29   ) where
  30
  31 import Control.Applicative
  32 import Data.List
  33 import qualified Data.Map as Map
  34
  35 import Ganeti.Config
  36 import Ganeti.Objects
  37 import Ganeti.Qlang
  38 import Ganeti.Query.Common
  39 import Ganeti.Query.Types
  40
  41 -- | Stub data type until we integrate the RPC.
  42 data NodeRuntime = NodeRuntime
  43
  44 -- | List of node live fields, all ignored for now (no RPC).
  45 nodeLiveFieldsDefs :: [(FieldName, FieldTitle, FieldType, String, FieldDoc)]
  46 nodeLiveFieldsDefs =
  47   [ ("bootid", "BootID", QFTText, "bootid",
  48      "Random UUID renewed for each system reboot, can be used\
  49      \ for detecting reboots by tracking changes")
  50   , ("cnodes", "CNodes", QFTNumber, "cpu_nodes",
  51      "Number of NUMA domains on node (if exported by hypervisor)")
  52   , ("csockets", "CSockets", QFTNumber, "cpu_sockets",
  53      "Number of physical CPU sockets (if exported by hypervisor)")
  54   , ("ctotal", "CTotal", QFTNumber, "cpu_total",
  55      "Number of logical processors")
  56   , ("dfree", "DFree", QFTUnit, "vg_free",
  57      "Available disk space in volume group")
  58   , ("dtotal", "DTotal", QFTUnit, "vg_size",
  59      "Total disk space in volume group used for instance disk allocation")
  60   , ("mfree", "MFree", QFTUnit, "memory_free",
  61      "Memory available for instance allocations")
  62   , ("mnode", "MNode", QFTUnit, "memory_dom0",
  63      "Amount of memory used by node (dom0 for Xen)")
  64   , ("mtotal", "MTotal", QFTUnit, "memory_total",
  65      "Total amount of memory of physical machine")
  66   ]
  67
  68 -- | Builder for node live fields.
  69 nodeLiveFieldBuilder :: (FieldName, FieldTitle, FieldType, String, FieldDoc)
  70                      -> FieldData Node NodeRuntime
  71 nodeLiveFieldBuilder (fname, ftitle, ftype, _, fdoc) =
  72   (FieldDefinition fname ftitle ftype fdoc, missingRuntime)
  73
  74 -- | The docstring for the node role. Note that we use 'reverse in
  75 -- order to keep the same order as Python.
  76 nodeRoleDoc :: String
  77 nodeRoleDoc =
  78   "Node role; " ++
  79   (intercalate ", " $
  80    map (\role ->
  81           "\"" ++ nodeRoleToRaw role ++ "\" for " ++ roleDescription role)
  82    (reverse [minBound..maxBound]))
  83
  84 -- | List of all node fields.
  85 nodeFields :: FieldList Node NodeRuntime
  86 nodeFields =
  87   [ (FieldDefinition "drained" "Drained" QFTBool "Whether node is drained",
  88      FieldSimple (rsNormal . nodeDrained))
  89   , (FieldDefinition "master_candidate" "MasterC" QFTBool
  90        "Whether node is a master candidate",
  91      FieldSimple (rsNormal . nodeMasterCandidate))
  92   , (FieldDefinition "master_capable" "MasterCapable" QFTBool
  93        "Whether node can become a master candidate",
  94      FieldSimple (rsNormal . nodeMasterCapable))
  95   , (FieldDefinition "name" "Node" QFTText "Node name",
  96      FieldSimple (rsNormal . nodeName))
  97   , (FieldDefinition "offline" "Offline" QFTBool
  98        "Whether node is marked offline",
  99      FieldSimple (rsNormal . nodeOffline))
 100   , (FieldDefinition "vm_capable" "VMCapable" QFTBool
 101        "Whether node can host instances",
 102      FieldSimple (rsNormal . nodeVmCapable))
 103   , (FieldDefinition "pip" "PrimaryIP" QFTText "Primary IP address",
 104      FieldSimple (rsNormal . nodePrimaryIp))
 105   , (FieldDefinition "sip" "SecondaryIP" QFTText "Secondary IP address",
 106      FieldSimple (rsNormal . nodeSecondaryIp))
 107   , (FieldDefinition "master" "IsMaster" QFTBool "Whether node is master",
 108      FieldConfig (\cfg node ->
 109                     rsNormal (nodeName node ==
 110                               clusterMasterNode (configCluster cfg))))
 111   , (FieldDefinition "group" "Group" QFTText "Node group",
 112      FieldConfig (\cfg node ->
 113                     rsMaybe (groupName <$> getGroupOfNode cfg node)))
 114   , (FieldDefinition "group.uuid" "GroupUUID" QFTText "UUID of node group",
 115      FieldSimple (rsNormal . nodeGroup))
 116   ,  (FieldDefinition "ndparams" "NodeParameters" QFTOther
 117         "Merged node parameters",
 118       FieldConfig ((rsMaybe .) . getNodeNdParams))
 119   , (FieldDefinition "custom_ndparams" "CustomNodeParameters" QFTOther
 120                        "Custom node parameters",
 121      FieldSimple (rsNormal . nodeNdparams))
 122   -- FIXME: the below could be generalised a bit, like in Python
 123   , (FieldDefinition "pinst_cnt" "Pinst" QFTNumber
 124        "Number of instances with this node as primary",
 125      FieldConfig (\cfg ->
 126                     rsNormal . length . fst . getNodeInstances cfg . nodeName))
 127   , (FieldDefinition "sinst_cnt" "Sinst" QFTNumber
 128        "Number of instances with this node as secondary",
 129      FieldConfig (\cfg ->
 130                     rsNormal . length . snd . getNodeInstances cfg . nodeName))
 131   , (FieldDefinition "pinst_list" "PriInstances" QFTNumber
 132        "List of instances with this node as primary",
 133      FieldConfig (\cfg -> rsNormal . map instName . fst .
 134                           getNodeInstances cfg . nodeName))
 135   , (FieldDefinition "sinst_list" "SecInstances" QFTNumber
 136        "List of instances with this node as secondary",
 137      FieldConfig (\cfg -> rsNormal . map instName . snd .
 138                           getNodeInstances cfg . nodeName))
 139   , (FieldDefinition "role" "Role" QFTText nodeRoleDoc,
 140      FieldConfig ((rsNormal .) . getNodeRole))
 141   -- FIXME: the powered state is special (has an different context,
 142   -- not runtime) in Python
 143   , (FieldDefinition "powered" "Powered" QFTBool
 144        "Whether node is thought to be powered on",
 145      missingRuntime)
 146   -- FIXME: the two fields below are incomplete in Python, part of the
 147   -- non-implemented node resource model; they are declared just for
 148   -- parity, but are not functional
 149   , (FieldDefinition "hv_state" "HypervisorState" QFTOther "Hypervisor state",
 150      missingRuntime)
 151   , (FieldDefinition "disk_state" "DiskState" QFTOther "Disk state",
 152      missingRuntime)
 153   ] ++
 154   map nodeLiveFieldBuilder nodeLiveFieldsDefs ++
 155   map buildNdParamField allNDParamFields ++
 156   timeStampFields ++
 157   uuidFields "Node" ++
 158   serialFields "Node" ++
 159   tagsFields
 160
 161 -- | The node fields map.
 162 nodeFieldsMap :: FieldMap Node NodeRuntime
 163 nodeFieldsMap = Map.fromList $ map (\v -> (fdefName (fst v), v)) nodeFields