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 import qualified Text.JSON as J
  35
  36 import Ganeti.Config
  37 import Ganeti.Objects
  38 import Ganeti.JSON
  39 import Ganeti.Rpc
  40 import Ganeti.Query.Language
  41 import Ganeti.Query.Common
  42 import Ganeti.Query.Types
  43
  44 -- | NodeRuntime is the resulting type for NodeInfo call.
  45 type NodeRuntime = Either RpcError RpcResultNodeInfo
  46
  47 -- | List of node live fields.
  48 nodeLiveFieldsDefs :: [(FieldName, FieldTitle, FieldType, String, FieldDoc)]
  49 nodeLiveFieldsDefs =
  50   [ ("bootid", "BootID", QFTText, "bootid",
  51      "Random UUID renewed for each system reboot, can be used\
  52      \ for detecting reboots by tracking changes")
  53   , ("cnodes", "CNodes", QFTNumber, "cpu_nodes",
  54      "Number of NUMA domains on node (if exported by hypervisor)")
  55   , ("csockets", "CSockets", QFTNumber, "cpu_sockets",
  56      "Number of physical CPU sockets (if exported by hypervisor)")
  57   , ("ctotal", "CTotal", QFTNumber, "cpu_total",
  58      "Number of logical processors")
  59   , ("dfree", "DFree", QFTUnit, "vg_free",
  60      "Available disk space in volume group")
  61   , ("dtotal", "DTotal", QFTUnit, "vg_size",
  62      "Total disk space in volume group used for instance disk allocation")
  63   , ("mfree", "MFree", QFTUnit, "memory_free",
  64      "Memory available for instance allocations")
  65   , ("mnode", "MNode", QFTUnit, "memory_dom0",
  66      "Amount of memory used by node (dom0 for Xen)")
  67   , ("mtotal", "MTotal", QFTUnit, "memory_total",
  68      "Total amount of memory of physical machine")
  69   ]
  70
  71 -- | Map each name to a function that extracts that value from
  72 -- the RPC result.
  73 nodeLiveFieldExtract :: String -> RpcResultNodeInfo -> J.JSValue
  74 nodeLiveFieldExtract "bootid" res =
  75     J.showJSON $ rpcResNodeInfoBootId res
  76 nodeLiveFieldExtract "cpu_nodes" res =
  77     jsonHead (rpcResNodeInfoHvInfo res) hvInfoCpuNodes
  78 nodeLiveFieldExtract "cpu_sockets" res =
  79     jsonHead (rpcResNodeInfoHvInfo res) hvInfoCpuSockets
  80 nodeLiveFieldExtract "cpu_total" res =
  81     jsonHead (rpcResNodeInfoHvInfo res) hvInfoCpuTotal
  82 nodeLiveFieldExtract "vg_free" res =
  83     jsonHead (rpcResNodeInfoVgInfo res) vgInfoVgFree
  84 nodeLiveFieldExtract "vg_size" res =
  85     jsonHead (rpcResNodeInfoVgInfo res) vgInfoVgSize
  86 nodeLiveFieldExtract "memory_free" res =
  87     jsonHead (rpcResNodeInfoHvInfo res) hvInfoMemoryFree
  88 nodeLiveFieldExtract "memory_dom0" res =
  89     jsonHead (rpcResNodeInfoHvInfo res) hvInfoMemoryDom0
  90 nodeLiveFieldExtract "memory_total" res =
  91     jsonHead (rpcResNodeInfoHvInfo res) hvInfoMemoryTotal
  92 nodeLiveFieldExtract _ _ = J.JSNull
  93
  94 -- | Helper for extracting field from RPC result.
  95 nodeLiveRpcCall :: FieldName -> NodeRuntime -> Node -> ResultEntry
  96 nodeLiveRpcCall fname (Right res) _ =
  97     rsNormal (nodeLiveFieldExtract fname res)
  98 nodeLiveRpcCall _ (Left err) _ =
  99     ResultEntry (rpcErrorToStatus err) Nothing
 100
 101 -- | Builder for node live fields.
 102 nodeLiveFieldBuilder :: (FieldName, FieldTitle, FieldType, String, FieldDoc)
 103                      -> FieldData Node NodeRuntime
 104 nodeLiveFieldBuilder (fname, ftitle, ftype, _, fdoc) =
 105   ( FieldDefinition fname ftitle ftype fdoc
 106   , FieldRuntime $ nodeLiveRpcCall fname)
 107
 108 -- | The docstring for the node role. Note that we use 'reverse in
 109 -- order to keep the same order as Python.
 110 nodeRoleDoc :: String
 111 nodeRoleDoc =
 112   "Node role; " ++
 113   intercalate ", "
 114    (map (\role ->
 115           "\"" ++ nodeRoleToRaw role ++ "\" for " ++ roleDescription role)
 116    (reverse [minBound..maxBound]))
 117
 118 -- | List of all node fields.
 119 nodeFields :: FieldList Node NodeRuntime
 120 nodeFields =
 121   [ (FieldDefinition "drained" "Drained" QFTBool "Whether node is drained",
 122      FieldSimple (rsNormal . nodeDrained))
 123   , (FieldDefinition "master_candidate" "MasterC" QFTBool
 124        "Whether node is a master candidate",
 125      FieldSimple (rsNormal . nodeMasterCandidate))
 126   , (FieldDefinition "master_capable" "MasterCapable" QFTBool
 127        "Whether node can become a master candidate",
 128      FieldSimple (rsNormal . nodeMasterCapable))
 129   , (FieldDefinition "name" "Node" QFTText "Node name",
 130      FieldSimple (rsNormal . nodeName))
 131   , (FieldDefinition "offline" "Offline" QFTBool
 132        "Whether node is marked offline",
 133      FieldSimple (rsNormal . nodeOffline))
 134   , (FieldDefinition "vm_capable" "VMCapable" QFTBool
 135        "Whether node can host instances",
 136      FieldSimple (rsNormal . nodeVmCapable))
 137   , (FieldDefinition "pip" "PrimaryIP" QFTText "Primary IP address",
 138      FieldSimple (rsNormal . nodePrimaryIp))
 139   , (FieldDefinition "sip" "SecondaryIP" QFTText "Secondary IP address",
 140      FieldSimple (rsNormal . nodeSecondaryIp))
 141   , (FieldDefinition "master" "IsMaster" QFTBool "Whether node is master",
 142      FieldConfig (\cfg node ->
 143                     rsNormal (nodeName node ==
 144                               clusterMasterNode (configCluster cfg))))
 145   , (FieldDefinition "group" "Group" QFTText "Node group",
 146      FieldConfig (\cfg node ->
 147                     rsMaybe (groupName <$> getGroupOfNode cfg node)))
 148   , (FieldDefinition "group.uuid" "GroupUUID" QFTText "UUID of node group",
 149      FieldSimple (rsNormal . nodeGroup))
 150   ,  (FieldDefinition "ndparams" "NodeParameters" QFTOther
 151         "Merged node parameters",
 152       FieldConfig ((rsMaybe .) . getNodeNdParams))
 153   , (FieldDefinition "custom_ndparams" "CustomNodeParameters" QFTOther
 154                        "Custom node parameters",
 155      FieldSimple (rsNormal . nodeNdparams))
 156   -- FIXME: the below could be generalised a bit, like in Python
 157   , (FieldDefinition "pinst_cnt" "Pinst" QFTNumber
 158        "Number of instances with this node as primary",
 159      FieldConfig (\cfg ->
 160                     rsNormal . length . fst . getNodeInstances cfg . nodeName))
 161   , (FieldDefinition "sinst_cnt" "Sinst" QFTNumber
 162        "Number of instances with this node as secondary",
 163      FieldConfig (\cfg ->
 164                     rsNormal . length . snd . getNodeInstances cfg . nodeName))
 165   , (FieldDefinition "pinst_list" "PriInstances" QFTOther
 166        "List of instances with this node as primary",
 167      FieldConfig (\cfg -> rsNormal . map instName . fst .
 168                           getNodeInstances cfg . nodeName))
 169   , (FieldDefinition "sinst_list" "SecInstances" QFTOther
 170        "List of instances with this node as secondary",
 171      FieldConfig (\cfg -> rsNormal . map instName . snd .
 172                           getNodeInstances cfg . nodeName))
 173   , (FieldDefinition "role" "Role" QFTText nodeRoleDoc,
 174      FieldConfig ((rsNormal .) . getNodeRole))
 175   -- FIXME: the powered state is special (has an different context,
 176   -- not runtime) in Python
 177   , (FieldDefinition "powered" "Powered" QFTBool
 178        "Whether node is thought to be powered on",
 179      missingRuntime)
 180   -- FIXME: the two fields below are incomplete in Python, part of the
 181   -- non-implemented node resource model; they are declared just for
 182   -- parity, but are not functional
 183   , (FieldDefinition "hv_state" "HypervisorState" QFTOther "Hypervisor state",
 184      missingRuntime)
 185   , (FieldDefinition "disk_state" "DiskState" QFTOther "Disk state",
 186      missingRuntime)
 187   ] ++
 188   map nodeLiveFieldBuilder nodeLiveFieldsDefs ++
 189   map buildNdParamField allNDParamFields ++
 190   timeStampFields ++
 191   uuidFields "Node" ++
 192   serialFields "Node" ++
 193   tagsFields
 194
 195 -- | The node fields map.
 196 nodeFieldsMap :: FieldMap Node NodeRuntime
 197 nodeFieldsMap = Map.fromList $ map (\v -> (fdefName (fst v), v)) nodeFields