Prefer the UuidObject type class over specific functions
[ganeti-github.git] / src / Ganeti / Query / Node.hs
1 {-| Implementation of the Ganeti Query2 node queries.
2
3 -}
4
5 {-
6
7 Copyright (C) 2012, 2013 Google Inc.
8 All rights reserved.
9
10 Redistribution and use in source and binary forms, with or without
11 modification, are permitted provided that the following conditions are
12 met:
13
14 1. Redistributions of source code must retain the above copyright notice,
15 this list of conditions and the following disclaimer.
16
17 2. Redistributions in binary form must reproduce the above copyright
18 notice, this list of conditions and the following disclaimer in the
19 documentation and/or other materials provided with the distribution.
20
21 THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
22 IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
23 TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
24 PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR
25 CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
26 EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
27 PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
28 PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
29 LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
30 NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
31 SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
32
33 -}
34
35 module Ganeti.Query.Node
36 ( Runtime
37 , fieldsMap
38 , collectLiveData
39 ) where
40
41 import Control.Applicative
42 import Data.List
43 import Data.Maybe
44 import qualified Data.Map as Map
45 import qualified Text.JSON as J
46
47 import Ganeti.Config
48 import Ganeti.Common
49 import Ganeti.Objects
50 import Ganeti.JSON
51 import Ganeti.Rpc
52 import Ganeti.Types
53 import Ganeti.Query.Language
54 import Ganeti.Query.Common
55 import Ganeti.Query.Types
56 import Ganeti.Storage.Utils
57 import Ganeti.Utils (niceSort)
58
59 -- | Runtime is the resulting type for NodeInfo call.
60 type Runtime = Either RpcError RpcResultNodeInfo
61
62 -- | List of node live fields.
63 nodeLiveFieldsDefs :: [(FieldName, FieldTitle, FieldType, String, FieldDoc)]
64 nodeLiveFieldsDefs =
65 [ ("bootid", "BootID", QFTText, "bootid",
66 "Random UUID renewed for each system reboot, can be used\
67 \ for detecting reboots by tracking changes")
68 , ("cnodes", "CNodes", QFTNumber, "cpu_nodes",
69 "Number of NUMA domains on node (if exported by hypervisor)")
70 , ("cnos", "CNOs", QFTNumber, "cpu_dom0",
71 "Number of logical processors used by the node OS (dom0 for Xen)")
72 , ("csockets", "CSockets", QFTNumber, "cpu_sockets",
73 "Number of physical CPU sockets (if exported by hypervisor)")
74 , ("ctotal", "CTotal", QFTNumber, "cpu_total",
75 "Number of logical processors")
76 , ("dfree", "DFree", QFTUnit, "storage_free",
77 "Available storage space on storage unit")
78 , ("dtotal", "DTotal", QFTUnit, "storage_size",
79 "Total storage space on storage unit for instance disk allocation")
80 , ("spfree", "SpFree", QFTNumber, "spindles_free",
81 "Available spindles in volume group (exclusive storage only)")
82 , ("sptotal", "SpTotal", QFTNumber, "spindles_total",
83 "Total spindles in volume group (exclusive storage only)")
84 , ("mfree", "MFree", QFTUnit, "memory_free",
85 "Memory available for instance allocations")
86 , ("mnode", "MNode", QFTUnit, "memory_dom0",
87 "Amount of memory used by node (dom0 for Xen)")
88 , ("mtotal", "MTotal", QFTUnit, "memory_total",
89 "Total amount of memory of physical machine")
90 ]
91
92 -- | Helper function to extract an attribute from a maybe StorageType
93 getAttrFromStorageInfo :: (J.JSON a) => (StorageInfo -> Maybe a)
94 -> Maybe StorageInfo -> J.JSValue
95 getAttrFromStorageInfo attr_fn (Just info) =
96 case attr_fn info of
97 Just val -> J.showJSON val
98 Nothing -> J.JSNull
99 getAttrFromStorageInfo _ Nothing = J.JSNull
100
101 -- | Check whether the given storage info fits to the given storage type
102 isStorageInfoOfType :: StorageType -> StorageInfo -> Bool
103 isStorageInfoOfType stype sinfo = storageInfoType sinfo ==
104 storageTypeToRaw stype
105
106 -- | Get storage info for the default storage unit
107 getStorageInfoForDefault :: [StorageInfo] -> Maybe StorageInfo
108 getStorageInfoForDefault sinfos = listToMaybe $ filter
109 (not . isStorageInfoOfType StorageLvmPv) sinfos
110
111 -- | Gets the storage info for a storage type
112 -- FIXME: This needs to be extended when storage pools are implemented,
113 -- because storage types are not necessarily unique then
114 getStorageInfoForType :: [StorageInfo] -> StorageType -> Maybe StorageInfo
115 getStorageInfoForType sinfos stype = listToMaybe $ filter
116 (isStorageInfoOfType stype) sinfos
117
118 -- | Map each name to a function that extracts that value from
119 -- the RPC result.
120 nodeLiveFieldExtract :: FieldName -> RpcResultNodeInfo -> J.JSValue
121 nodeLiveFieldExtract "bootid" res =
122 J.showJSON $ rpcResNodeInfoBootId res
123 nodeLiveFieldExtract "cnodes" res =
124 jsonHead (rpcResNodeInfoHvInfo res) hvInfoCpuNodes
125 nodeLiveFieldExtract "cnos" res =
126 jsonHead (rpcResNodeInfoHvInfo res) hvInfoCpuDom0
127 nodeLiveFieldExtract "csockets" res =
128 jsonHead (rpcResNodeInfoHvInfo res) hvInfoCpuSockets
129 nodeLiveFieldExtract "ctotal" res =
130 jsonHead (rpcResNodeInfoHvInfo res) hvInfoCpuTotal
131 nodeLiveFieldExtract "dfree" res =
132 getAttrFromStorageInfo storageInfoStorageFree (getStorageInfoForDefault
133 (rpcResNodeInfoStorageInfo res))
134 nodeLiveFieldExtract "dtotal" res =
135 getAttrFromStorageInfo storageInfoStorageSize (getStorageInfoForDefault
136 (rpcResNodeInfoStorageInfo res))
137 nodeLiveFieldExtract "spfree" res =
138 getAttrFromStorageInfo storageInfoStorageFree (getStorageInfoForType
139 (rpcResNodeInfoStorageInfo res) StorageLvmPv)
140 nodeLiveFieldExtract "sptotal" res =
141 getAttrFromStorageInfo storageInfoStorageSize (getStorageInfoForType
142 (rpcResNodeInfoStorageInfo res) StorageLvmPv)
143 nodeLiveFieldExtract "mfree" res =
144 jsonHead (rpcResNodeInfoHvInfo res) hvInfoMemoryFree
145 nodeLiveFieldExtract "mnode" res =
146 jsonHead (rpcResNodeInfoHvInfo res) hvInfoMemoryDom0
147 nodeLiveFieldExtract "mtotal" res =
148 jsonHead (rpcResNodeInfoHvInfo res) hvInfoMemoryTotal
149 nodeLiveFieldExtract _ _ = J.JSNull
150
151 -- | Helper for extracting field from RPC result.
152 nodeLiveRpcCall :: FieldName -> Runtime -> Node -> ResultEntry
153 nodeLiveRpcCall fname (Right res) _ =
154 case nodeLiveFieldExtract fname res of
155 J.JSNull -> rsNoData
156 x -> rsNormal x
157 nodeLiveRpcCall _ (Left err) _ =
158 ResultEntry (rpcErrorToStatus err) Nothing
159
160 -- | Builder for node live fields.
161 nodeLiveFieldBuilder :: (FieldName, FieldTitle, FieldType, String, FieldDoc)
162 -> FieldData Node Runtime
163 nodeLiveFieldBuilder (fname, ftitle, ftype, _, fdoc) =
164 ( FieldDefinition fname ftitle ftype fdoc
165 , FieldRuntime $ nodeLiveRpcCall fname
166 , QffNormal)
167
168 -- | The docstring for the node role. Note that we use 'reverse' in
169 -- order to keep the same order as Python.
170 nodeRoleDoc :: String
171 nodeRoleDoc =
172 "Node role; " ++
173 intercalate ", "
174 (map (\role ->
175 "\"" ++ nodeRoleToRaw role ++ "\" for " ++ roleDescription role)
176 (reverse [minBound..maxBound]))
177
178 -- | Get node powered status.
179 getNodePower :: ConfigData -> Node -> ResultEntry
180 getNodePower cfg node =
181 case getNodeNdParams cfg node of
182 Nothing -> rsNoData
183 Just ndp -> if null (ndpOobProgram ndp)
184 then rsUnavail
185 else rsNormal (nodePowered node)
186
187 -- | List of all node fields.
188 nodeFields :: FieldList Node Runtime
189 nodeFields =
190 [ (FieldDefinition "drained" "Drained" QFTBool "Whether node is drained",
191 FieldSimple (rsNormal . nodeDrained), QffNormal)
192 , (FieldDefinition "master_candidate" "MasterC" QFTBool
193 "Whether node is a master candidate",
194 FieldSimple (rsNormal . nodeMasterCandidate), QffNormal)
195 , (FieldDefinition "master_capable" "MasterCapable" QFTBool
196 "Whether node can become a master candidate",
197 FieldSimple (rsNormal . nodeMasterCapable), QffNormal)
198 , (FieldDefinition "name" "Node" QFTText "Node name",
199 FieldSimple (rsNormal . nodeName), QffHostname)
200 , (FieldDefinition "offline" "Offline" QFTBool
201 "Whether node is marked offline",
202 FieldSimple (rsNormal . nodeOffline), QffNormal)
203 , (FieldDefinition "vm_capable" "VMCapable" QFTBool
204 "Whether node can host instances",
205 FieldSimple (rsNormal . nodeVmCapable), QffNormal)
206 , (FieldDefinition "pip" "PrimaryIP" QFTText "Primary IP address",
207 FieldSimple (rsNormal . nodePrimaryIp), QffNormal)
208 , (FieldDefinition "sip" "SecondaryIP" QFTText "Secondary IP address",
209 FieldSimple (rsNormal . nodeSecondaryIp), QffNormal)
210 , (FieldDefinition "master" "IsMaster" QFTBool "Whether node is master",
211 FieldConfig (\cfg node ->
212 rsNormal (uuidOf node ==
213 clusterMasterNode (configCluster cfg))),
214 QffNormal)
215 , (FieldDefinition "group" "Group" QFTText "Node group",
216 FieldConfig (\cfg node ->
217 rsMaybeNoData (groupName <$> getGroupOfNode cfg node)),
218 QffNormal)
219 , (FieldDefinition "group.uuid" "GroupUUID" QFTText "UUID of node group",
220 FieldSimple (rsNormal . nodeGroup), QffNormal)
221 , (FieldDefinition "ndparams" "NodeParameters" QFTOther
222 "Merged node parameters",
223 FieldConfig ((rsMaybeNoData .) . getNodeNdParams), QffNormal)
224 , (FieldDefinition "custom_ndparams" "CustomNodeParameters" QFTOther
225 "Custom node parameters",
226 FieldSimple (rsNormal . nodeNdparams), QffNormal)
227 -- FIXME: the below could be generalised a bit, like in Python
228 , (FieldDefinition "pinst_cnt" "Pinst" QFTNumber
229 "Number of instances with this node as primary",
230 FieldConfig (\cfg -> rsNormal . getNumInstances fst cfg), QffNormal)
231 , (FieldDefinition "sinst_cnt" "Sinst" QFTNumber
232 "Number of instances with this node as secondary",
233 FieldConfig (\cfg -> rsNormal . getNumInstances snd cfg), QffNormal)
234 , (FieldDefinition "pinst_list" "PriInstances" QFTOther
235 "List of instances with this node as primary",
236 FieldConfig (\cfg -> rsNormal . niceSort . mapMaybe instName . fst .
237 getNodeInstances cfg . uuidOf), QffNormal)
238 , (FieldDefinition "sinst_list" "SecInstances" QFTOther
239 "List of instances with this node as secondary",
240 FieldConfig (\cfg -> rsNormal . niceSort . mapMaybe instName . snd .
241 getNodeInstances cfg . uuidOf), QffNormal)
242 , (FieldDefinition "role" "Role" QFTText nodeRoleDoc,
243 FieldConfig ((rsNormal .) . getNodeRole), QffNormal)
244 , (FieldDefinition "powered" "Powered" QFTBool
245 "Whether node is thought to be powered on",
246 FieldConfig getNodePower, QffNormal)
247 -- FIXME: the two fields below are incomplete in Python, part of the
248 -- non-implemented node resource model; they are declared just for
249 -- parity, but are not functional
250 , (FieldDefinition "hv_state" "HypervisorState" QFTOther "Hypervisor state",
251 FieldSimple (const rsUnavail), QffNormal)
252 , (FieldDefinition "disk_state" "DiskState" QFTOther "Disk state",
253 FieldSimple (const rsUnavail), QffNormal)
254 ] ++
255 map nodeLiveFieldBuilder nodeLiveFieldsDefs ++
256 map buildNdParamField allNDParamFields ++
257 timeStampFields ++
258 uuidFields "Node" ++
259 serialFields "Node" ++
260 tagsFields
261
262 -- | Helper function to retrieve the number of (primary or secondary) instances
263 getNumInstances :: (([Instance], [Instance]) -> [Instance])
264 -> ConfigData -> Node -> Int
265 getNumInstances get_fn cfg = length . get_fn . getNodeInstances cfg . uuidOf
266
267 -- | The node fields map.
268 fieldsMap :: FieldMap Node Runtime
269 fieldsMap = fieldListToFieldMap nodeFields
270
271 -- | Create an RPC result for a broken node
272 rpcResultNodeBroken :: Node -> (Node, Runtime)
273 rpcResultNodeBroken node = (node, Left (RpcResultError "Broken configuration"))
274
275 -- | Storage-related query fields
276 storageFields :: [String]
277 storageFields = ["dtotal", "dfree", "spfree", "sptotal"]
278
279 -- | Hypervisor-related query fields
280 hypervisorFields :: [String]
281 hypervisorFields = ["mnode", "mfree", "mtotal",
282 "cnodes", "csockets", "cnos", "ctotal"]
283
284 -- | Check if it is required to include domain-specific entities (for example
285 -- storage units for storage info, hypervisor specs for hypervisor info)
286 -- in the node_info call
287 queryDomainRequired :: -- domain-specific fields to look for (storage, hv)
288 [String]
289 -- list of requested fields
290 -> [String]
291 -> Bool
292 queryDomainRequired domain_fields fields = any (`elem` fields) domain_fields
293
294 -- | Collect live data from RPC query if enabled.
295 collectLiveData :: Bool
296 -> ConfigData
297 -> [String]
298 -> [Node]
299 -> IO [(Node, Runtime)]
300 collectLiveData False _ _ nodes =
301 return $ zip nodes (repeat $ Left (RpcResultError "Live data disabled"))
302 collectLiveData True cfg fields nodes = do
303 let hvs = [getDefaultHypervisorSpec cfg |
304 queryDomainRequired hypervisorFields fields]
305 good_nodes = nodesWithValidConfig cfg nodes
306 storage_units = if queryDomainRequired storageFields fields
307 then getStorageUnitsOfNodes cfg good_nodes
308 else Map.fromList
309 (map (\n -> (uuidOf n, [])) good_nodes)
310 rpcres <- executeRpcCall good_nodes (RpcCallNodeInfo storage_units hvs)
311 return $ fillUpList (fillPairFromMaybe rpcResultNodeBroken pickPairUnique)
312 nodes rpcres