root / src / Ganeti / Query / Instance.hs @ a861d322
History | View | Annotate | Download (28 kB)
1 | 1df0266e | Hrvoje Ribicic | {-| Implementation of the Ganeti Query2 instance queries. |
---|---|---|---|
2 | 1df0266e | Hrvoje Ribicic | |
3 | 1df0266e | Hrvoje Ribicic | -} |
4 | 1df0266e | Hrvoje Ribicic | |
5 | 1df0266e | Hrvoje Ribicic | {- |
6 | 1df0266e | Hrvoje Ribicic | |
7 | 1df0266e | Hrvoje Ribicic | Copyright (C) 2013 Google Inc. |
8 | 1df0266e | Hrvoje Ribicic | |
9 | 1df0266e | Hrvoje Ribicic | This program is free software; you can redistribute it and/or modify |
10 | 1df0266e | Hrvoje Ribicic | it under the terms of the GNU General Public License as published by |
11 | 1df0266e | Hrvoje Ribicic | the Free Software Foundation; either version 2 of the License, or |
12 | 1df0266e | Hrvoje Ribicic | (at your option) any later version. |
13 | 1df0266e | Hrvoje Ribicic | |
14 | 1df0266e | Hrvoje Ribicic | This program is distributed in the hope that it will be useful, but |
15 | 1df0266e | Hrvoje Ribicic | WITHOUT ANY WARRANTY; without even the implied warranty of |
16 | 1df0266e | Hrvoje Ribicic | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU |
17 | 1df0266e | Hrvoje Ribicic | General Public License for more details. |
18 | 1df0266e | Hrvoje Ribicic | |
19 | 1df0266e | Hrvoje Ribicic | You should have received a copy of the GNU General Public License |
20 | 1df0266e | Hrvoje Ribicic | along with this program; if not, write to the Free Software |
21 | 1df0266e | Hrvoje Ribicic | Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA |
22 | 1df0266e | Hrvoje Ribicic | 02110-1301, USA. |
23 | 1df0266e | Hrvoje Ribicic | |
24 | 1df0266e | Hrvoje Ribicic | -} |
25 | 1df0266e | Hrvoje Ribicic | |
26 | 1df0266e | Hrvoje Ribicic | module Ganeti.Query.Instance |
27 | df583eaf | Hrvoje Ribicic | ( Runtime |
28 | df583eaf | Hrvoje Ribicic | , fieldsMap |
29 | df583eaf | Hrvoje Ribicic | , collectLiveData |
30 | df583eaf | Hrvoje Ribicic | ) where |
31 | 1df0266e | Hrvoje Ribicic | |
32 | df583eaf | Hrvoje Ribicic | import Control.Applicative |
33 | df583eaf | Hrvoje Ribicic | import Data.List |
34 | df583eaf | Hrvoje Ribicic | import Data.Maybe |
35 | df583eaf | Hrvoje Ribicic | import Data.Monoid |
36 | 1df0266e | Hrvoje Ribicic | import qualified Data.Map as Map |
37 | df583eaf | Hrvoje Ribicic | import qualified Text.JSON as J |
38 | 88b58ed6 | Hrvoje Ribicic | import Text.Printf |
39 | 1df0266e | Hrvoje Ribicic | |
40 | df583eaf | Hrvoje Ribicic | import Ganeti.BasicTypes |
41 | df583eaf | Hrvoje Ribicic | import Ganeti.Common |
42 | df583eaf | Hrvoje Ribicic | import Ganeti.Config |
43 | 4e6f1cde | Hrvoje Ribicic | import qualified Ganeti.Constants as C |
44 | 4e6f1cde | Hrvoje Ribicic | import qualified Ganeti.ConstantUtils as C |
45 | 9491766c | Hrvoje Ribicic | import Ganeti.Errors |
46 | 4e6f1cde | Hrvoje Ribicic | import Ganeti.JSON |
47 | 1df0266e | Hrvoje Ribicic | import Ganeti.Objects |
48 | 1df0266e | Hrvoje Ribicic | import Ganeti.Query.Common |
49 | 1df0266e | Hrvoje Ribicic | import Ganeti.Query.Language |
50 | 1df0266e | Hrvoje Ribicic | import Ganeti.Query.Types |
51 | df583eaf | Hrvoje Ribicic | import Ganeti.Rpc |
52 | df583eaf | Hrvoje Ribicic | import Ganeti.Storage.Utils |
53 | df583eaf | Hrvoje Ribicic | import Ganeti.Types |
54 | 88b58ed6 | Hrvoje Ribicic | import Ganeti.Utils (formatOrdinal) |
55 | 1df0266e | Hrvoje Ribicic | |
56 | df583eaf | Hrvoje Ribicic | -- | The LiveInfo structure packs additional information beside the |
57 | df583eaf | Hrvoje Ribicic | -- 'InstanceInfo'. We also need to know whether the instance information was |
58 | df583eaf | Hrvoje Ribicic | -- found on the primary node, and encode this as a Bool. |
59 | df583eaf | Hrvoje Ribicic | type LiveInfo = (InstanceInfo, Bool) |
60 | df583eaf | Hrvoje Ribicic | |
61 | df583eaf | Hrvoje Ribicic | -- | Runtime possibly containing the 'LiveInfo'. See the genericQuery function |
62 | df583eaf | Hrvoje Ribicic | -- in the Query.hs file for an explanation of the terms used. |
63 | df583eaf | Hrvoje Ribicic | type Runtime = Either RpcError (Maybe LiveInfo) |
64 | df583eaf | Hrvoje Ribicic | |
65 | df583eaf | Hrvoje Ribicic | -- | The instance fields map. |
66 | df583eaf | Hrvoje Ribicic | fieldsMap :: FieldMap Instance Runtime |
67 | df583eaf | Hrvoje Ribicic | fieldsMap = Map.fromList [(fdefName f, v) | v@(f, _, _) <- instanceFields] |
68 | df583eaf | Hrvoje Ribicic | |
69 | df583eaf | Hrvoje Ribicic | -- | The instance fields |
70 | df583eaf | Hrvoje Ribicic | instanceFields :: FieldList Instance Runtime |
71 | 1df0266e | Hrvoje Ribicic | instanceFields = |
72 | df583eaf | Hrvoje Ribicic | -- Simple fields |
73 | 9491766c | Hrvoje Ribicic | [ (FieldDefinition "admin_state" "InstanceState" QFTText |
74 | 9491766c | Hrvoje Ribicic | "Desired state of instance", |
75 | 9491766c | Hrvoje Ribicic | FieldSimple (rsNormal . adminStateToRaw . instAdminState), QffNormal) |
76 | 9491766c | Hrvoje Ribicic | , (FieldDefinition "admin_up" "Autostart" QFTBool |
77 | 9491766c | Hrvoje Ribicic | "Desired state of instance", |
78 | 9491766c | Hrvoje Ribicic | FieldSimple (rsNormal . (== AdminUp) . instAdminState), QffNormal) |
79 | 9491766c | Hrvoje Ribicic | , (FieldDefinition "disk_template" "Disk_template" QFTText |
80 | df583eaf | Hrvoje Ribicic | "Instance disk template", |
81 | 1df0266e | Hrvoje Ribicic | FieldSimple (rsNormal . instDiskTemplate), QffNormal) |
82 | 9491766c | Hrvoje Ribicic | , (FieldDefinition "disks_active" "DisksActive" QFTBool |
83 | 9491766c | Hrvoje Ribicic | "Desired state of instance disks", |
84 | 9491766c | Hrvoje Ribicic | FieldSimple (rsNormal . instDisksActive), QffNormal) |
85 | 1df0266e | Hrvoje Ribicic | , (FieldDefinition "name" "Instance" QFTText |
86 | 1df0266e | Hrvoje Ribicic | "Instance name", |
87 | 1df0266e | Hrvoje Ribicic | FieldSimple (rsNormal . instName), QffHostname) |
88 | 1df0266e | Hrvoje Ribicic | , (FieldDefinition "hypervisor" "Hypervisor" QFTText |
89 | 1df0266e | Hrvoje Ribicic | "Hypervisor name", |
90 | 1df0266e | Hrvoje Ribicic | FieldSimple (rsNormal . instHypervisor), QffNormal) |
91 | 1df0266e | Hrvoje Ribicic | , (FieldDefinition "network_port" "Network_port" QFTOther |
92 | 1df0266e | Hrvoje Ribicic | "Instance network port if available (e.g. for VNC console)", |
93 | df583eaf | Hrvoje Ribicic | FieldSimple (rsMaybeUnavail . instNetworkPort), QffNormal) |
94 | 1df0266e | Hrvoje Ribicic | , (FieldDefinition "os" "OS" QFTText |
95 | 1df0266e | Hrvoje Ribicic | "Operating system", |
96 | 1df0266e | Hrvoje Ribicic | FieldSimple (rsNormal . instOs), QffNormal) |
97 | 9491766c | Hrvoje Ribicic | , (FieldDefinition "pnode" "Primary_node" QFTText |
98 | 9491766c | Hrvoje Ribicic | "Primary node", |
99 | 9491766c | Hrvoje Ribicic | FieldConfig getPrimaryNodeName, QffHostname) |
100 | 9491766c | Hrvoje Ribicic | , (FieldDefinition "pnode.group" "PrimaryNodeGroup" QFTText |
101 | 9491766c | Hrvoje Ribicic | "Primary node's group", |
102 | 9491766c | Hrvoje Ribicic | FieldConfig getPrimaryNodeGroup, QffNormal) |
103 | 9491766c | Hrvoje Ribicic | , (FieldDefinition "snodes" "Secondary_Nodes" QFTOther |
104 | 9491766c | Hrvoje Ribicic | "Secondary nodes; usually this will just be one node", |
105 | 9491766c | Hrvoje Ribicic | FieldConfig (getSecondaryNodeAttribute nodeName), QffNormal) |
106 | 9491766c | Hrvoje Ribicic | , (FieldDefinition "snodes.group" "SecondaryNodesGroups" QFTOther |
107 | 9491766c | Hrvoje Ribicic | "Node groups of secondary nodes", |
108 | 9491766c | Hrvoje Ribicic | FieldConfig (getSecondaryNodeGroupAttribute groupName), QffNormal) |
109 | 9491766c | Hrvoje Ribicic | , (FieldDefinition "snodes.group.uuid" "SecondaryNodesGroupsUUID" QFTOther |
110 | 9491766c | Hrvoje Ribicic | "Node group UUIDs of secondary nodes", |
111 | 9491766c | Hrvoje Ribicic | FieldConfig (getSecondaryNodeGroupAttribute groupUuid), QffNormal) |
112 | 1df0266e | Hrvoje Ribicic | ] ++ |
113 | df583eaf | Hrvoje Ribicic | |
114 | 4e6f1cde | Hrvoje Ribicic | -- Instance parameter fields, whole |
115 | 4e6f1cde | Hrvoje Ribicic | [ (FieldDefinition "hvparams" "HypervisorParameters" QFTOther |
116 | 4e6f1cde | Hrvoje Ribicic | "Hypervisor parameters (merged)", |
117 | 4e6f1cde | Hrvoje Ribicic | FieldConfig ((rsNormal .) . getFilledInstHvParams), QffNormal) |
118 | 4e6f1cde | Hrvoje Ribicic | , (FieldDefinition "beparams" "BackendParameters" QFTOther |
119 | 4e6f1cde | Hrvoje Ribicic | "Backend parameters (merged)", |
120 | 4e6f1cde | Hrvoje Ribicic | FieldConfig ((rsErrorNoData .) . getFilledInstBeParams), QffNormal) |
121 | 4e6f1cde | Hrvoje Ribicic | , (FieldDefinition "osparams" "OpSysParameters" QFTOther |
122 | 4e6f1cde | Hrvoje Ribicic | "Operating system parameters (merged)", |
123 | 4e6f1cde | Hrvoje Ribicic | FieldConfig ((rsNormal .) . getFilledInstOsParams), QffNormal) |
124 | 4e6f1cde | Hrvoje Ribicic | , (FieldDefinition "custom_hvparams" "CustomHypervisorParameters" QFTOther |
125 | 4e6f1cde | Hrvoje Ribicic | "Custom hypervisor parameters", |
126 | 4e6f1cde | Hrvoje Ribicic | FieldSimple (rsNormal . instHvparams), QffNormal) |
127 | 4e6f1cde | Hrvoje Ribicic | , (FieldDefinition "custom_beparams" "CustomBackendParameters" QFTOther |
128 | 4e6f1cde | Hrvoje Ribicic | "Custom backend parameters", |
129 | 4e6f1cde | Hrvoje Ribicic | FieldSimple (rsNormal . instBeparams), QffNormal) |
130 | 4e6f1cde | Hrvoje Ribicic | , (FieldDefinition "custom_osparams" "CustomOpSysParameters" QFTOther |
131 | 4e6f1cde | Hrvoje Ribicic | "Custom operating system parameters", |
132 | 4e6f1cde | Hrvoje Ribicic | FieldSimple (rsNormal . instOsparams), QffNormal) |
133 | 4e6f1cde | Hrvoje Ribicic | ] ++ |
134 | 4e6f1cde | Hrvoje Ribicic | |
135 | 4e6f1cde | Hrvoje Ribicic | -- Instance parameter fields, generated |
136 | 4e6f1cde | Hrvoje Ribicic | map (buildBeParamField beParamGetter) allBeParamFields ++ |
137 | 4e6f1cde | Hrvoje Ribicic | map (buildHvParamField hvParamGetter) (C.toList C.hvsParameters) ++ |
138 | 4e6f1cde | Hrvoje Ribicic | |
139 | 88b58ed6 | Hrvoje Ribicic | -- Aggregate disk parameter fields |
140 | 88b58ed6 | Hrvoje Ribicic | [ (FieldDefinition "disk_usage" "DiskUsage" QFTUnit |
141 | 88b58ed6 | Hrvoje Ribicic | "Total disk space used by instance on each of its nodes; this is not the\ |
142 | 88b58ed6 | Hrvoje Ribicic | \ disk size visible to the instance, but the usage on the node", |
143 | a861d322 | Hrvoje Ribicic | FieldSimple (rsNormal . getDiskSizeRequirements), QffNormal) |
144 | a861d322 | Hrvoje Ribicic | , (FieldDefinition "disk.count" "Disks" QFTNumber |
145 | 88b58ed6 | Hrvoje Ribicic | "Number of disks", |
146 | a861d322 | Hrvoje Ribicic | FieldSimple (rsNormal . length . instDisks), QffNormal) |
147 | a861d322 | Hrvoje Ribicic | , (FieldDefinition "disk.sizes" "Disk_sizes" QFTOther |
148 | 88b58ed6 | Hrvoje Ribicic | "List of disk sizes", |
149 | a861d322 | Hrvoje Ribicic | FieldSimple (rsNormal . map diskSize . instDisks), QffNormal) |
150 | a861d322 | Hrvoje Ribicic | , (FieldDefinition "disk.spindles" "Disk_spindles" QFTOther |
151 | 88b58ed6 | Hrvoje Ribicic | "List of disk spindles", |
152 | 88b58ed6 | Hrvoje Ribicic | FieldSimple (rsNormal . map (MaybeForJSON . diskSpindles) . |
153 | 88b58ed6 | Hrvoje Ribicic | instDisks), |
154 | a861d322 | Hrvoje Ribicic | QffNormal) |
155 | a861d322 | Hrvoje Ribicic | , (FieldDefinition "disk.names" "Disk_names" QFTOther |
156 | 88b58ed6 | Hrvoje Ribicic | "List of disk names", |
157 | 88b58ed6 | Hrvoje Ribicic | FieldSimple (rsNormal . map (MaybeForJSON . diskName) . |
158 | 88b58ed6 | Hrvoje Ribicic | instDisks), |
159 | a861d322 | Hrvoje Ribicic | QffNormal) |
160 | a861d322 | Hrvoje Ribicic | , (FieldDefinition "disk.uuids" "Disk_UUIDs" QFTOther |
161 | 88b58ed6 | Hrvoje Ribicic | "List of disk UUIDs", |
162 | 88b58ed6 | Hrvoje Ribicic | FieldSimple (rsNormal . map diskUuid . instDisks), QffNormal) |
163 | 88b58ed6 | Hrvoje Ribicic | ] ++ |
164 | 88b58ed6 | Hrvoje Ribicic | |
165 | 88b58ed6 | Hrvoje Ribicic | -- Per-disk parameter fields |
166 | 88b58ed6 | Hrvoje Ribicic | fillNumberFields C.maxDisks |
167 | 88b58ed6 | Hrvoje Ribicic | [ (fieldDefinitionCompleter "disk.size/%d" "Disk/%d" QFTUnit |
168 | 88b58ed6 | Hrvoje Ribicic | "Disk size of %s disk", |
169 | a861d322 | Hrvoje Ribicic | getFillableField instDisks diskSize, QffNormal) |
170 | a861d322 | Hrvoje Ribicic | , (fieldDefinitionCompleter "disk.spindles/%d" "DiskSpindles/%d" QFTNumber |
171 | 88b58ed6 | Hrvoje Ribicic | "Spindles of %s disk", |
172 | a861d322 | Hrvoje Ribicic | getFillableOptionalField instDisks diskSpindles, QffNormal) |
173 | a861d322 | Hrvoje Ribicic | , (fieldDefinitionCompleter "disk.name/%d" "DiskName/%d" QFTText |
174 | 88b58ed6 | Hrvoje Ribicic | "Name of %s disk", |
175 | a861d322 | Hrvoje Ribicic | getFillableOptionalField instDisks diskName, QffNormal) |
176 | a861d322 | Hrvoje Ribicic | , (fieldDefinitionCompleter "disk.uuid/%d" "DiskUUID/%d" QFTText |
177 | 88b58ed6 | Hrvoje Ribicic | "UUID of %s disk", |
178 | 88b58ed6 | Hrvoje Ribicic | getFillableField instDisks diskUuid, QffNormal) |
179 | 88b58ed6 | Hrvoje Ribicic | ] ++ |
180 | 88b58ed6 | Hrvoje Ribicic | |
181 | a861d322 | Hrvoje Ribicic | -- Aggregate nic parameter fields |
182 | a861d322 | Hrvoje Ribicic | [ (FieldDefinition "nic.count" "NICs" QFTNumber |
183 | a861d322 | Hrvoje Ribicic | "Number of network interfaces", |
184 | a861d322 | Hrvoje Ribicic | FieldSimple (rsNormal . length . instNics), QffNormal) |
185 | a861d322 | Hrvoje Ribicic | , (FieldDefinition "nic.macs" "NIC_MACs" QFTOther |
186 | a861d322 | Hrvoje Ribicic | (nicAggDescPrefix ++ "MAC address"), |
187 | a861d322 | Hrvoje Ribicic | FieldSimple (rsNormal . map nicMac . instNics), QffNormal) |
188 | a861d322 | Hrvoje Ribicic | , (FieldDefinition "nic.ips" "NIC_IPs" QFTOther |
189 | a861d322 | Hrvoje Ribicic | (nicAggDescPrefix ++ "IP address"), |
190 | a861d322 | Hrvoje Ribicic | FieldSimple (rsNormal . map (MaybeForJSON . nicIp) . instNics), |
191 | a861d322 | Hrvoje Ribicic | QffNormal) |
192 | a861d322 | Hrvoje Ribicic | , (FieldDefinition "nic.names" "NIC_Names" QFTOther |
193 | a861d322 | Hrvoje Ribicic | (nicAggDescPrefix ++ "name"), |
194 | a861d322 | Hrvoje Ribicic | FieldSimple (rsNormal . map (MaybeForJSON . nicName) . instNics), |
195 | a861d322 | Hrvoje Ribicic | QffNormal) |
196 | a861d322 | Hrvoje Ribicic | , (FieldDefinition "nic.uuids" "NIC_UUIDs" QFTOther |
197 | a861d322 | Hrvoje Ribicic | (nicAggDescPrefix ++ "UUID"), |
198 | a861d322 | Hrvoje Ribicic | FieldSimple (rsNormal . map nicUuid . instNics), QffNormal) |
199 | a861d322 | Hrvoje Ribicic | , (FieldDefinition "nic.modes" "NIC_modes" QFTOther |
200 | a861d322 | Hrvoje Ribicic | (nicAggDescPrefix ++ "mode"), |
201 | a861d322 | Hrvoje Ribicic | FieldConfig (\cfg -> rsNormal . map |
202 | a861d322 | Hrvoje Ribicic | (nicpMode . fillNicParamsFromConfig cfg . nicNicparams) |
203 | a861d322 | Hrvoje Ribicic | . instNics), |
204 | a861d322 | Hrvoje Ribicic | QffNormal) |
205 | a861d322 | Hrvoje Ribicic | , (FieldDefinition "nic.bridges" "NIC_bridges" QFTOther |
206 | a861d322 | Hrvoje Ribicic | (nicAggDescPrefix ++ "bridge"), |
207 | a861d322 | Hrvoje Ribicic | FieldConfig (\cfg -> rsNormal . map (MaybeForJSON . getNicBridge . |
208 | a861d322 | Hrvoje Ribicic | fillNicParamsFromConfig cfg . nicNicparams) . instNics), |
209 | a861d322 | Hrvoje Ribicic | QffNormal) |
210 | a861d322 | Hrvoje Ribicic | , (FieldDefinition "nic.links" "NIC_links" QFTOther |
211 | a861d322 | Hrvoje Ribicic | (nicAggDescPrefix ++ "link"), |
212 | a861d322 | Hrvoje Ribicic | FieldConfig (\cfg -> rsNormal . map |
213 | a861d322 | Hrvoje Ribicic | (nicpLink . fillNicParamsFromConfig cfg . nicNicparams) |
214 | a861d322 | Hrvoje Ribicic | . instNics), |
215 | a861d322 | Hrvoje Ribicic | QffNormal) |
216 | a861d322 | Hrvoje Ribicic | , (FieldDefinition "nic.networks" "NIC_networks" QFTOther |
217 | a861d322 | Hrvoje Ribicic | "List containing each interface's network", |
218 | a861d322 | Hrvoje Ribicic | FieldSimple (rsNormal . map (MaybeForJSON . nicNetwork) . instNics), |
219 | a861d322 | Hrvoje Ribicic | QffNormal) |
220 | a861d322 | Hrvoje Ribicic | , (FieldDefinition "nic.networks.names" "NIC_networks_names" QFTOther |
221 | a861d322 | Hrvoje Ribicic | "List containing the name of each interface's network", |
222 | a861d322 | Hrvoje Ribicic | FieldConfig (\cfg -> rsNormal . map |
223 | a861d322 | Hrvoje Ribicic | (\x -> MaybeForJSON (getNetworkName cfg <$> nicNetwork x)) |
224 | a861d322 | Hrvoje Ribicic | . instNics), |
225 | a861d322 | Hrvoje Ribicic | QffNormal) |
226 | a861d322 | Hrvoje Ribicic | ] ++ |
227 | a861d322 | Hrvoje Ribicic | |
228 | a861d322 | Hrvoje Ribicic | -- Per-nic parameter fields |
229 | a861d322 | Hrvoje Ribicic | fillNumberFields C.maxNics |
230 | a861d322 | Hrvoje Ribicic | [ (fieldDefinitionCompleter "nic.ip/%d" "NicIP/%d" QFTText |
231 | a861d322 | Hrvoje Ribicic | ("IP address" ++ nicDescSuffix), |
232 | a861d322 | Hrvoje Ribicic | getFillableOptionalField instNics nicIp, QffNormal) |
233 | a861d322 | Hrvoje Ribicic | , (fieldDefinitionCompleter "nic.uuid/%d" "NicUUID/%d" QFTText |
234 | a861d322 | Hrvoje Ribicic | ("UUID address" ++ nicDescSuffix), |
235 | a861d322 | Hrvoje Ribicic | getFillableField instNics nicUuid, QffNormal) |
236 | a861d322 | Hrvoje Ribicic | , (fieldDefinitionCompleter "nic.mac/%d" "NicMAC/%d" QFTText |
237 | a861d322 | Hrvoje Ribicic | ("MAC address" ++ nicDescSuffix), |
238 | a861d322 | Hrvoje Ribicic | getFillableField instNics nicMac, QffNormal) |
239 | a861d322 | Hrvoje Ribicic | , (fieldDefinitionCompleter "nic.name/%d" "NicName/%d" QFTText |
240 | a861d322 | Hrvoje Ribicic | ("Name address" ++ nicDescSuffix), |
241 | a861d322 | Hrvoje Ribicic | getFillableOptionalField instNics nicName, QffNormal) |
242 | a861d322 | Hrvoje Ribicic | , (fieldDefinitionCompleter "nic.network/%d" "NicNetwork/%d" QFTText |
243 | a861d322 | Hrvoje Ribicic | ("Network" ++ nicDescSuffix), |
244 | a861d322 | Hrvoje Ribicic | getFillableOptionalField instNics nicNetwork, QffNormal) |
245 | a861d322 | Hrvoje Ribicic | , (fieldDefinitionCompleter "nic.mode/%d" "NicMode/%d" QFTText |
246 | a861d322 | Hrvoje Ribicic | ("Mode" ++ nicDescSuffix), |
247 | a861d322 | Hrvoje Ribicic | getFillableNicField nicpMode, QffNormal) |
248 | a861d322 | Hrvoje Ribicic | , (fieldDefinitionCompleter "nic.link/%d" "NicLink/%d" QFTText |
249 | a861d322 | Hrvoje Ribicic | ("Link" ++ nicDescSuffix), |
250 | a861d322 | Hrvoje Ribicic | getFillableNicField nicpLink, QffNormal) |
251 | a861d322 | Hrvoje Ribicic | , (fieldDefinitionCompleter "nic.network.name/%d" "NicNetworkName/%d" QFTText |
252 | a861d322 | Hrvoje Ribicic | ("Network name" ++ nicDescSuffix), |
253 | a861d322 | Hrvoje Ribicic | getFillableNicNetworkNameField, QffNormal) |
254 | a861d322 | Hrvoje Ribicic | , (fieldDefinitionCompleter "nic.bridge/%d" "NicBridge/%d" QFTText |
255 | a861d322 | Hrvoje Ribicic | ("Bridge" ++ nicDescSuffix), |
256 | a861d322 | Hrvoje Ribicic | getOptionalFillableNicField getNicBridge, QffNormal) |
257 | a861d322 | Hrvoje Ribicic | ] ++ |
258 | a861d322 | Hrvoje Ribicic | |
259 | df583eaf | Hrvoje Ribicic | -- Live fields using special getters |
260 | df583eaf | Hrvoje Ribicic | [ (FieldDefinition "status" "Status" QFTText |
261 | df583eaf | Hrvoje Ribicic | statusDocText, |
262 | df583eaf | Hrvoje Ribicic | FieldConfigRuntime statusExtract, QffNormal) |
263 | df583eaf | Hrvoje Ribicic | , (FieldDefinition "oper_state" "Running" QFTBool |
264 | df583eaf | Hrvoje Ribicic | "Actual state of instance", |
265 | df583eaf | Hrvoje Ribicic | FieldRuntime operStatusExtract, QffNormal) |
266 | df583eaf | Hrvoje Ribicic | ] ++ |
267 | df583eaf | Hrvoje Ribicic | |
268 | df583eaf | Hrvoje Ribicic | -- Simple live fields |
269 | df583eaf | Hrvoje Ribicic | map instanceLiveFieldBuilder instanceLiveFieldsDefs ++ |
270 | df583eaf | Hrvoje Ribicic | |
271 | df583eaf | Hrvoje Ribicic | -- Generated fields |
272 | 1df0266e | Hrvoje Ribicic | serialFields "Instance" ++ |
273 | df583eaf | Hrvoje Ribicic | uuidFields "Instance" ++ |
274 | df583eaf | Hrvoje Ribicic | tagsFields |
275 | df583eaf | Hrvoje Ribicic | |
276 | 9491766c | Hrvoje Ribicic | -- * Helper functions for node property retrieval |
277 | 9491766c | Hrvoje Ribicic | |
278 | a861d322 | Hrvoje Ribicic | -- | Constant suffix of network interface field descriptions. |
279 | a861d322 | Hrvoje Ribicic | nicDescSuffix ::String |
280 | a861d322 | Hrvoje Ribicic | nicDescSuffix = " of %s network interface" |
281 | a861d322 | Hrvoje Ribicic | |
282 | a861d322 | Hrvoje Ribicic | -- | Almost-constant suffix of aggregate network interface field descriptions. |
283 | a861d322 | Hrvoje Ribicic | nicAggDescPrefix ::String |
284 | a861d322 | Hrvoje Ribicic | nicAggDescPrefix = "List containing each network interface's " |
285 | a861d322 | Hrvoje Ribicic | |
286 | a861d322 | Hrvoje Ribicic | -- | Given a network name id, returns the network's name. |
287 | a861d322 | Hrvoje Ribicic | getNetworkName :: ConfigData -> String -> NonEmptyString |
288 | a861d322 | Hrvoje Ribicic | getNetworkName cfg = networkName . (Map.!) (fromContainer $ configNetworks cfg) |
289 | a861d322 | Hrvoje Ribicic | |
290 | a861d322 | Hrvoje Ribicic | -- | Gets the bridge of a NIC. |
291 | a861d322 | Hrvoje Ribicic | getNicBridge :: FilledNicParams -> Maybe String |
292 | a861d322 | Hrvoje Ribicic | getNicBridge nicParams |
293 | a861d322 | Hrvoje Ribicic | | nicpMode nicParams == NMBridged = Just $ nicpLink nicParams |
294 | a861d322 | Hrvoje Ribicic | | otherwise = Nothing |
295 | a861d322 | Hrvoje Ribicic | |
296 | a861d322 | Hrvoje Ribicic | -- | Fill partial NIC params by using the defaults from the configuration. |
297 | a861d322 | Hrvoje Ribicic | fillNicParamsFromConfig :: ConfigData -> PartialNicParams -> FilledNicParams |
298 | a861d322 | Hrvoje Ribicic | fillNicParamsFromConfig cfg = fillNicParams (getDefaultNicParams cfg) |
299 | a861d322 | Hrvoje Ribicic | |
300 | a861d322 | Hrvoje Ribicic | -- | Retrieves the default network interface parameters. |
301 | a861d322 | Hrvoje Ribicic | getDefaultNicParams :: ConfigData -> FilledNicParams |
302 | a861d322 | Hrvoje Ribicic | getDefaultNicParams cfg = |
303 | a861d322 | Hrvoje Ribicic | (Map.!) (fromContainer . clusterNicparams . configCluster $ cfg) C.ppDefault |
304 | a861d322 | Hrvoje Ribicic | |
305 | a861d322 | Hrvoje Ribicic | -- | Returns a field that retrieves a given NIC's network name. |
306 | a861d322 | Hrvoje Ribicic | getFillableNicNetworkNameField :: Int -> FieldGetter Instance Runtime |
307 | a861d322 | Hrvoje Ribicic | getFillableNicNetworkNameField index = |
308 | a861d322 | Hrvoje Ribicic | FieldConfig (\cfg inst -> rsMaybeUnavail $ do |
309 | a861d322 | Hrvoje Ribicic | nicObj <- maybeAt index $ instNics inst |
310 | a861d322 | Hrvoje Ribicic | nicNetworkId <- nicNetwork nicObj |
311 | a861d322 | Hrvoje Ribicic | return $ getNetworkName cfg nicNetworkId) |
312 | a861d322 | Hrvoje Ribicic | |
313 | a861d322 | Hrvoje Ribicic | -- | Gets a fillable NIC field. |
314 | a861d322 | Hrvoje Ribicic | getFillableNicField :: (J.JSON a) |
315 | a861d322 | Hrvoje Ribicic | => (FilledNicParams -> a) |
316 | a861d322 | Hrvoje Ribicic | -> Int |
317 | a861d322 | Hrvoje Ribicic | -> FieldGetter Instance Runtime |
318 | a861d322 | Hrvoje Ribicic | getFillableNicField getter = |
319 | a861d322 | Hrvoje Ribicic | getOptionalFillableNicField (\x -> Just . getter $ x) |
320 | a861d322 | Hrvoje Ribicic | |
321 | a861d322 | Hrvoje Ribicic | -- | Gets an optional fillable NIC field. |
322 | a861d322 | Hrvoje Ribicic | getOptionalFillableNicField :: (J.JSON a) |
323 | a861d322 | Hrvoje Ribicic | => (FilledNicParams -> Maybe a) |
324 | a861d322 | Hrvoje Ribicic | -> Int |
325 | a861d322 | Hrvoje Ribicic | -> FieldGetter Instance Runtime |
326 | a861d322 | Hrvoje Ribicic | getOptionalFillableNicField = |
327 | a861d322 | Hrvoje Ribicic | getFillableFieldWithDefault |
328 | a861d322 | Hrvoje Ribicic | (map nicNicparams . instNics) (\x _ -> getDefaultNicParams x) fillNicParams |
329 | a861d322 | Hrvoje Ribicic | |
330 | a861d322 | Hrvoje Ribicic | -- | Creates a function which produces a 'FieldGetter' when fed an index. Works |
331 | a861d322 | Hrvoje Ribicic | -- for fields that should be filled out through the use of a default. |
332 | a861d322 | Hrvoje Ribicic | getFillableFieldWithDefault :: (J.JSON c) |
333 | a861d322 | Hrvoje Ribicic | => (Instance -> [a]) -- ^ Extracts a list of incomplete objects |
334 | a861d322 | Hrvoje Ribicic | -> (ConfigData -> Instance -> b) -- ^ Extracts the default object |
335 | a861d322 | Hrvoje Ribicic | -> (b -> a -> b) -- ^ Fills the default object |
336 | a861d322 | Hrvoje Ribicic | -> (b -> Maybe c) -- ^ Extracts an obj property |
337 | a861d322 | Hrvoje Ribicic | -> Int -- ^ Index in list to use |
338 | a861d322 | Hrvoje Ribicic | -> FieldGetter Instance Runtime -- ^ Result |
339 | a861d322 | Hrvoje Ribicic | getFillableFieldWithDefault |
340 | a861d322 | Hrvoje Ribicic | listGetter defaultGetter fillFn propertyGetter index = |
341 | a861d322 | Hrvoje Ribicic | FieldConfig (\cfg inst -> rsMaybeUnavail $ do |
342 | a861d322 | Hrvoje Ribicic | incompleteObj <- maybeAt index $ listGetter inst |
343 | a861d322 | Hrvoje Ribicic | let defaultObj = defaultGetter cfg inst |
344 | a861d322 | Hrvoje Ribicic | completeObj = fillFn defaultObj incompleteObj |
345 | a861d322 | Hrvoje Ribicic | propertyGetter completeObj) |
346 | a861d322 | Hrvoje Ribicic | |
347 | a861d322 | Hrvoje Ribicic | -- | Creates a function which produces a 'FieldGetter' when fed an index. Works |
348 | 88b58ed6 | Hrvoje Ribicic | -- for fields that may not return a value, expressed through the Maybe monad. |
349 | 88b58ed6 | Hrvoje Ribicic | getFillableOptionalField :: (J.JSON b) |
350 | 88b58ed6 | Hrvoje Ribicic | => (Instance -> [a]) -- ^ Extracts a list of objects |
351 | 88b58ed6 | Hrvoje Ribicic | -> (a -> Maybe b) -- ^ Possibly gets a property |
352 | 88b58ed6 | Hrvoje Ribicic | -- from an object |
353 | 88b58ed6 | Hrvoje Ribicic | -> Int -- ^ Index in list to use |
354 | 88b58ed6 | Hrvoje Ribicic | -> FieldGetter Instance Runtime -- ^ Result |
355 | 88b58ed6 | Hrvoje Ribicic | getFillableOptionalField extractor optPropertyGetter index = |
356 | 88b58ed6 | Hrvoje Ribicic | FieldSimple(\inst -> rsMaybeUnavail $ do |
357 | 88b58ed6 | Hrvoje Ribicic | obj <- maybeAt index $ extractor inst |
358 | 88b58ed6 | Hrvoje Ribicic | optPropertyGetter obj) |
359 | 88b58ed6 | Hrvoje Ribicic | |
360 | a861d322 | Hrvoje Ribicic | -- | Creates a function which produces a 'FieldGetter' when fed an index. |
361 | 88b58ed6 | Hrvoje Ribicic | -- Works only for fields that surely return a value. |
362 | 88b58ed6 | Hrvoje Ribicic | getFillableField :: (J.JSON b) |
363 | a861d322 | Hrvoje Ribicic | => (Instance -> [a]) -- ^ Extracts a list of objects |
364 | a861d322 | Hrvoje Ribicic | -> (a -> b) -- ^ Gets a property from an object |
365 | a861d322 | Hrvoje Ribicic | -> Int -- ^ Index in list to use |
366 | a861d322 | Hrvoje Ribicic | -> FieldGetter Instance Runtime -- ^ Result |
367 | 88b58ed6 | Hrvoje Ribicic | getFillableField extractor propertyGetter index = |
368 | 88b58ed6 | Hrvoje Ribicic | let optPropertyGetter = Just . propertyGetter |
369 | 88b58ed6 | Hrvoje Ribicic | in getFillableOptionalField extractor optPropertyGetter index |
370 | 88b58ed6 | Hrvoje Ribicic | |
371 | 88b58ed6 | Hrvoje Ribicic | -- | Retrieves a value from an array at an index, using the Maybe monad to |
372 | 88b58ed6 | Hrvoje Ribicic | -- indicate failure. |
373 | 88b58ed6 | Hrvoje Ribicic | maybeAt :: Int -> [a] -> Maybe a |
374 | 88b58ed6 | Hrvoje Ribicic | maybeAt index list |
375 | 88b58ed6 | Hrvoje Ribicic | | index >= length list = Nothing |
376 | 88b58ed6 | Hrvoje Ribicic | | otherwise = Just $ list !! index |
377 | 88b58ed6 | Hrvoje Ribicic | |
378 | 88b58ed6 | Hrvoje Ribicic | -- | Primed with format strings for everything but the type, it consumes two |
379 | 88b58ed6 | Hrvoje Ribicic | -- values and uses them to complete the FieldDefinition. |
380 | 88b58ed6 | Hrvoje Ribicic | -- Warning: a bit unsafe as it uses printf. Handle with care. |
381 | 88b58ed6 | Hrvoje Ribicic | fieldDefinitionCompleter :: (PrintfArg t1) => (PrintfArg t2) |
382 | 88b58ed6 | Hrvoje Ribicic | => FieldName |
383 | 88b58ed6 | Hrvoje Ribicic | -> FieldTitle |
384 | 88b58ed6 | Hrvoje Ribicic | -> FieldType |
385 | 88b58ed6 | Hrvoje Ribicic | -> FieldDoc |
386 | 88b58ed6 | Hrvoje Ribicic | -> t1 |
387 | 88b58ed6 | Hrvoje Ribicic | -> t2 |
388 | 88b58ed6 | Hrvoje Ribicic | -> FieldDefinition |
389 | 88b58ed6 | Hrvoje Ribicic | fieldDefinitionCompleter fName fTitle fType fDoc firstVal secondVal = |
390 | 88b58ed6 | Hrvoje Ribicic | FieldDefinition (printf fName firstVal) |
391 | 88b58ed6 | Hrvoje Ribicic | (printf fTitle firstVal) |
392 | 88b58ed6 | Hrvoje Ribicic | fType |
393 | 88b58ed6 | Hrvoje Ribicic | (printf fDoc secondVal) |
394 | 88b58ed6 | Hrvoje Ribicic | |
395 | 88b58ed6 | Hrvoje Ribicic | -- | Given an incomplete field definition and values that can complete it, |
396 | 88b58ed6 | Hrvoje Ribicic | -- return a fully functional FieldData. Cannot work for all cases, should be |
397 | 88b58ed6 | Hrvoje Ribicic | -- extended as necessary. |
398 | 88b58ed6 | Hrvoje Ribicic | fillIncompleteFields :: (t1 -> t2 -> FieldDefinition, |
399 | 88b58ed6 | Hrvoje Ribicic | t1 -> FieldGetter a b, |
400 | 88b58ed6 | Hrvoje Ribicic | QffMode) |
401 | 88b58ed6 | Hrvoje Ribicic | -> t1 |
402 | 88b58ed6 | Hrvoje Ribicic | -> t2 |
403 | 88b58ed6 | Hrvoje Ribicic | -> FieldData a b |
404 | 88b58ed6 | Hrvoje Ribicic | fillIncompleteFields (iDef, iGet, mode) firstVal secondVal = |
405 | 88b58ed6 | Hrvoje Ribicic | (iDef firstVal secondVal, iGet firstVal, mode) |
406 | 88b58ed6 | Hrvoje Ribicic | |
407 | 88b58ed6 | Hrvoje Ribicic | -- | Given fields that describe lists, fill their definitions with appropriate |
408 | 88b58ed6 | Hrvoje Ribicic | -- index representations. |
409 | 88b58ed6 | Hrvoje Ribicic | fillNumberFields :: (Integral t1) |
410 | 88b58ed6 | Hrvoje Ribicic | => Int |
411 | 88b58ed6 | Hrvoje Ribicic | -> [(t1 -> String -> FieldDefinition, |
412 | 88b58ed6 | Hrvoje Ribicic | t1 -> FieldGetter a b, |
413 | 88b58ed6 | Hrvoje Ribicic | QffMode)] |
414 | 88b58ed6 | Hrvoje Ribicic | -> FieldList a b |
415 | 88b58ed6 | Hrvoje Ribicic | fillNumberFields numFills fieldsToFill = do |
416 | 88b58ed6 | Hrvoje Ribicic | index <- take numFills [0..] |
417 | 88b58ed6 | Hrvoje Ribicic | field <- fieldsToFill |
418 | 88b58ed6 | Hrvoje Ribicic | return . fillIncompleteFields field index . formatOrdinal $ index + 1 |
419 | 88b58ed6 | Hrvoje Ribicic | |
420 | 88b58ed6 | Hrvoje Ribicic | -- * Various helper functions for property retrieval |
421 | 88b58ed6 | Hrvoje Ribicic | |
422 | 9491766c | Hrvoje Ribicic | -- | Helper function for primary node retrieval |
423 | 9491766c | Hrvoje Ribicic | getPrimaryNode :: ConfigData -> Instance -> ErrorResult Node |
424 | 9491766c | Hrvoje Ribicic | getPrimaryNode cfg = getInstPrimaryNode cfg . instName |
425 | 9491766c | Hrvoje Ribicic | |
426 | 9491766c | Hrvoje Ribicic | -- | Get primary node hostname |
427 | 9491766c | Hrvoje Ribicic | getPrimaryNodeName :: ConfigData -> Instance -> ResultEntry |
428 | 9491766c | Hrvoje Ribicic | getPrimaryNodeName cfg inst = |
429 | 4e6f1cde | Hrvoje Ribicic | rsErrorNoData $ nodeName <$> getPrimaryNode cfg inst |
430 | 9491766c | Hrvoje Ribicic | |
431 | 9491766c | Hrvoje Ribicic | -- | Get primary node hostname |
432 | 9491766c | Hrvoje Ribicic | getPrimaryNodeGroup :: ConfigData -> Instance -> ResultEntry |
433 | 9491766c | Hrvoje Ribicic | getPrimaryNodeGroup cfg inst = |
434 | 9491766c | Hrvoje Ribicic | rsErrorNoData $ (J.showJSON . groupName) <$> |
435 | 9491766c | Hrvoje Ribicic | (getPrimaryNode cfg inst >>= |
436 | 9491766c | Hrvoje Ribicic | maybeToError "Configuration missing" . getGroupOfNode cfg) |
437 | 9491766c | Hrvoje Ribicic | |
438 | 9491766c | Hrvoje Ribicic | -- | Get secondary nodes - the configuration objects themselves |
439 | 9491766c | Hrvoje Ribicic | getSecondaryNodes :: ConfigData -> Instance -> ErrorResult [Node] |
440 | 9491766c | Hrvoje Ribicic | getSecondaryNodes cfg inst = do |
441 | 9491766c | Hrvoje Ribicic | pNode <- getPrimaryNode cfg inst |
442 | 9491766c | Hrvoje Ribicic | allNodes <- getInstAllNodes cfg $ instName inst |
443 | 9491766c | Hrvoje Ribicic | return $ delete pNode allNodes |
444 | 9491766c | Hrvoje Ribicic | |
445 | 9491766c | Hrvoje Ribicic | -- | Get attributes of the secondary nodes |
446 | 9491766c | Hrvoje Ribicic | getSecondaryNodeAttribute :: (J.JSON a) |
447 | 9491766c | Hrvoje Ribicic | => (Node -> a) |
448 | 9491766c | Hrvoje Ribicic | -> ConfigData |
449 | 9491766c | Hrvoje Ribicic | -> Instance |
450 | 9491766c | Hrvoje Ribicic | -> ResultEntry |
451 | 9491766c | Hrvoje Ribicic | getSecondaryNodeAttribute getter cfg inst = |
452 | 9491766c | Hrvoje Ribicic | rsErrorNoData $ map (J.showJSON . getter) <$> getSecondaryNodes cfg inst |
453 | 9491766c | Hrvoje Ribicic | |
454 | 9491766c | Hrvoje Ribicic | -- | Get secondary node groups |
455 | 9491766c | Hrvoje Ribicic | getSecondaryNodeGroups :: ConfigData -> Instance -> ErrorResult [NodeGroup] |
456 | 9491766c | Hrvoje Ribicic | getSecondaryNodeGroups cfg inst = do |
457 | 9491766c | Hrvoje Ribicic | sNodes <- getSecondaryNodes cfg inst |
458 | 9491766c | Hrvoje Ribicic | return . catMaybes $ map (getGroupOfNode cfg) sNodes |
459 | 9491766c | Hrvoje Ribicic | |
460 | 9491766c | Hrvoje Ribicic | -- | Get attributes of secondary node groups |
461 | 9491766c | Hrvoje Ribicic | getSecondaryNodeGroupAttribute :: (J.JSON a) |
462 | 9491766c | Hrvoje Ribicic | => (NodeGroup -> a) |
463 | 9491766c | Hrvoje Ribicic | -> ConfigData |
464 | 9491766c | Hrvoje Ribicic | -> Instance |
465 | 9491766c | Hrvoje Ribicic | -> ResultEntry |
466 | 9491766c | Hrvoje Ribicic | getSecondaryNodeGroupAttribute getter cfg inst = |
467 | 9491766c | Hrvoje Ribicic | rsErrorNoData $ map (J.showJSON . getter) <$> getSecondaryNodeGroups cfg inst |
468 | 9491766c | Hrvoje Ribicic | |
469 | 4e6f1cde | Hrvoje Ribicic | -- | Beparam getter builder: given a field, it returns a FieldConfig |
470 | 4e6f1cde | Hrvoje Ribicic | -- getter, that is a function that takes the config and the object and |
471 | 4e6f1cde | Hrvoje Ribicic | -- returns the Beparam field specified when the getter was built. |
472 | 4e6f1cde | Hrvoje Ribicic | beParamGetter :: String -- ^ The field we are building the getter for |
473 | 4e6f1cde | Hrvoje Ribicic | -> ConfigData -- ^ The configuration object |
474 | 4e6f1cde | Hrvoje Ribicic | -> Instance -- ^ The instance configuration object |
475 | 4e6f1cde | Hrvoje Ribicic | -> ResultEntry -- ^ The result |
476 | 4e6f1cde | Hrvoje Ribicic | beParamGetter field config inst = |
477 | 4e6f1cde | Hrvoje Ribicic | case getFilledInstBeParams config inst of |
478 | 4e6f1cde | Hrvoje Ribicic | Ok beParams -> dictFieldGetter field $ Just beParams |
479 | 4e6f1cde | Hrvoje Ribicic | Bad _ -> rsNoData |
480 | 4e6f1cde | Hrvoje Ribicic | |
481 | 4e6f1cde | Hrvoje Ribicic | -- | Hvparam getter builder: given a field, it returns a FieldConfig |
482 | 4e6f1cde | Hrvoje Ribicic | -- getter, that is a function that takes the config and the object and |
483 | 4e6f1cde | Hrvoje Ribicic | -- returns the Hvparam field specified when the getter was built. |
484 | 4e6f1cde | Hrvoje Ribicic | hvParamGetter :: String -- ^ The field we're building the getter for |
485 | 4e6f1cde | Hrvoje Ribicic | -> ConfigData -> Instance -> ResultEntry |
486 | 4e6f1cde | Hrvoje Ribicic | hvParamGetter field cfg inst = |
487 | 4e6f1cde | Hrvoje Ribicic | rsMaybeUnavail . Map.lookup field . fromContainer $ |
488 | 4e6f1cde | Hrvoje Ribicic | getFilledInstHvParams cfg inst |
489 | 4e6f1cde | Hrvoje Ribicic | |
490 | df583eaf | Hrvoje Ribicic | -- * Live fields functionality |
491 | df583eaf | Hrvoje Ribicic | |
492 | df583eaf | Hrvoje Ribicic | -- | List of node live fields. |
493 | df583eaf | Hrvoje Ribicic | instanceLiveFieldsDefs :: [(FieldName, FieldTitle, FieldType, String, FieldDoc)] |
494 | df583eaf | Hrvoje Ribicic | instanceLiveFieldsDefs = |
495 | df583eaf | Hrvoje Ribicic | [ ("oper_ram", "Memory", QFTUnit, "oper_ram", |
496 | df583eaf | Hrvoje Ribicic | "Actual memory usage as seen by hypervisor") |
497 | df583eaf | Hrvoje Ribicic | , ("oper_vcpus", "VCPUs", QFTNumber, "oper_vcpus", |
498 | df583eaf | Hrvoje Ribicic | "Actual number of VCPUs as seen by hypervisor") |
499 | df583eaf | Hrvoje Ribicic | ] |
500 | df583eaf | Hrvoje Ribicic | |
501 | df583eaf | Hrvoje Ribicic | -- | Map each name to a function that extracts that value from the RPC result. |
502 | df583eaf | Hrvoje Ribicic | instanceLiveFieldExtract :: FieldName -> InstanceInfo -> Instance -> J.JSValue |
503 | df583eaf | Hrvoje Ribicic | instanceLiveFieldExtract "oper_ram" info _ = J.showJSON $ instInfoMemory info |
504 | df583eaf | Hrvoje Ribicic | instanceLiveFieldExtract "oper_vcpus" info _ = J.showJSON $ instInfoVcpus info |
505 | df583eaf | Hrvoje Ribicic | instanceLiveFieldExtract n _ _ = J.showJSON $ |
506 | df583eaf | Hrvoje Ribicic | "The field " ++ n ++ " is not an expected or extractable live field!" |
507 | df583eaf | Hrvoje Ribicic | |
508 | df583eaf | Hrvoje Ribicic | -- | Helper for extracting field from RPC result. |
509 | df583eaf | Hrvoje Ribicic | instanceLiveRpcCall :: FieldName -> Runtime -> Instance -> ResultEntry |
510 | df583eaf | Hrvoje Ribicic | instanceLiveRpcCall fname (Right (Just (res, _))) inst = |
511 | df583eaf | Hrvoje Ribicic | case instanceLiveFieldExtract fname res inst of |
512 | df583eaf | Hrvoje Ribicic | J.JSNull -> rsNoData |
513 | df583eaf | Hrvoje Ribicic | x -> rsNormal x |
514 | df583eaf | Hrvoje Ribicic | instanceLiveRpcCall _ (Right Nothing) _ = rsUnavail |
515 | df583eaf | Hrvoje Ribicic | instanceLiveRpcCall _ (Left err) _ = |
516 | df583eaf | Hrvoje Ribicic | ResultEntry (rpcErrorToStatus err) Nothing |
517 | df583eaf | Hrvoje Ribicic | |
518 | df583eaf | Hrvoje Ribicic | -- | Builder for node live fields. |
519 | df583eaf | Hrvoje Ribicic | instanceLiveFieldBuilder :: (FieldName, FieldTitle, FieldType, String, FieldDoc) |
520 | 9491766c | Hrvoje Ribicic | -> FieldData Instance Runtime |
521 | df583eaf | Hrvoje Ribicic | instanceLiveFieldBuilder (fname, ftitle, ftype, _, fdoc) = |
522 | df583eaf | Hrvoje Ribicic | ( FieldDefinition fname ftitle ftype fdoc |
523 | df583eaf | Hrvoje Ribicic | , FieldRuntime $ instanceLiveRpcCall fname |
524 | df583eaf | Hrvoje Ribicic | , QffNormal) |
525 | df583eaf | Hrvoje Ribicic | |
526 | 9491766c | Hrvoje Ribicic | -- * Functionality related to status and operational status extraction |
527 | df583eaf | Hrvoje Ribicic | |
528 | df583eaf | Hrvoje Ribicic | -- | The documentation text for the instance status field |
529 | df583eaf | Hrvoje Ribicic | statusDocText :: String |
530 | df583eaf | Hrvoje Ribicic | statusDocText = |
531 | df583eaf | Hrvoje Ribicic | let si = show . instanceStatusToRaw :: InstanceStatus -> String |
532 | 9491766c | Hrvoje Ribicic | in "Instance status; " ++ |
533 | 9491766c | Hrvoje Ribicic | si Running ++ |
534 | 9491766c | Hrvoje Ribicic | " if instance is set to be running and actually is, " ++ |
535 | 9491766c | Hrvoje Ribicic | si StatusDown ++ |
536 | 9491766c | Hrvoje Ribicic | " if instance is stopped and is not running, " ++ |
537 | 9491766c | Hrvoje Ribicic | si WrongNode ++ |
538 | 9491766c | Hrvoje Ribicic | " if instance running, but not on its designated primary node, " ++ |
539 | 9491766c | Hrvoje Ribicic | si ErrorUp ++ |
540 | 9491766c | Hrvoje Ribicic | " if instance should be stopped, but is actually running, " ++ |
541 | 9491766c | Hrvoje Ribicic | si ErrorDown ++ |
542 | 9491766c | Hrvoje Ribicic | " if instance should run, but doesn't, " ++ |
543 | 9491766c | Hrvoje Ribicic | si NodeDown ++ |
544 | 9491766c | Hrvoje Ribicic | " if instance's primary node is down, " ++ |
545 | 9491766c | Hrvoje Ribicic | si NodeOffline ++ |
546 | 9491766c | Hrvoje Ribicic | " if instance's primary node is marked offline, " ++ |
547 | 9491766c | Hrvoje Ribicic | si StatusOffline ++ |
548 | 9491766c | Hrvoje Ribicic | " if instance is offline and does not use dynamic resources" |
549 | df583eaf | Hrvoje Ribicic | |
550 | df583eaf | Hrvoje Ribicic | -- | Checks if the primary node of an instance is offline |
551 | df583eaf | Hrvoje Ribicic | isPrimaryOffline :: ConfigData -> Instance -> Bool |
552 | df583eaf | Hrvoje Ribicic | isPrimaryOffline cfg inst = |
553 | 9491766c | Hrvoje Ribicic | let pNodeResult = getNode cfg $ instPrimaryNode inst |
554 | 9491766c | Hrvoje Ribicic | in case pNodeResult of |
555 | 9491766c | Hrvoje Ribicic | Ok pNode -> nodeOffline pNode |
556 | 9491766c | Hrvoje Ribicic | Bad _ -> error "Programmer error - result assumed to be OK is Bad!" |
557 | df583eaf | Hrvoje Ribicic | |
558 | df583eaf | Hrvoje Ribicic | -- | Determines the status of a live instance |
559 | df583eaf | Hrvoje Ribicic | liveInstanceStatus :: LiveInfo -> Instance -> InstanceStatus |
560 | df583eaf | Hrvoje Ribicic | liveInstanceStatus (_, foundOnPrimary) inst |
561 | df583eaf | Hrvoje Ribicic | | not foundOnPrimary = WrongNode |
562 | df583eaf | Hrvoje Ribicic | | adminState == AdminUp = Running |
563 | df583eaf | Hrvoje Ribicic | | otherwise = ErrorUp |
564 | df583eaf | Hrvoje Ribicic | where adminState = instAdminState inst |
565 | df583eaf | Hrvoje Ribicic | |
566 | df583eaf | Hrvoje Ribicic | -- | Determines the status of a dead instance. |
567 | df583eaf | Hrvoje Ribicic | deadInstanceStatus :: Instance -> InstanceStatus |
568 | df583eaf | Hrvoje Ribicic | deadInstanceStatus inst = |
569 | df583eaf | Hrvoje Ribicic | case instAdminState inst of |
570 | df583eaf | Hrvoje Ribicic | AdminUp -> ErrorDown |
571 | df583eaf | Hrvoje Ribicic | AdminDown -> StatusDown |
572 | df583eaf | Hrvoje Ribicic | AdminOffline -> StatusOffline |
573 | df583eaf | Hrvoje Ribicic | |
574 | df583eaf | Hrvoje Ribicic | -- | Determines the status of the instance, depending on whether it is possible |
575 | 9491766c | Hrvoje Ribicic | -- to communicate with its primary node, on which node it is, and its |
576 | 9491766c | Hrvoje Ribicic | -- configuration. |
577 | 9491766c | Hrvoje Ribicic | determineInstanceStatus :: ConfigData -- ^ The configuration data |
578 | 9491766c | Hrvoje Ribicic | -> Runtime -- ^ All the data from the live call |
579 | 9491766c | Hrvoje Ribicic | -> Instance -- ^ Static instance configuration |
580 | 9491766c | Hrvoje Ribicic | -> InstanceStatus -- ^ Result |
581 | 9491766c | Hrvoje Ribicic | determineInstanceStatus cfg res inst |
582 | 9491766c | Hrvoje Ribicic | | isPrimaryOffline cfg inst = NodeOffline |
583 | 9491766c | Hrvoje Ribicic | | otherwise = case res of |
584 | 9491766c | Hrvoje Ribicic | Left _ -> NodeDown |
585 | 9491766c | Hrvoje Ribicic | Right (Just liveData) -> liveInstanceStatus liveData inst |
586 | 9491766c | Hrvoje Ribicic | Right Nothing -> deadInstanceStatus inst |
587 | 9491766c | Hrvoje Ribicic | |
588 | 9491766c | Hrvoje Ribicic | -- | Extracts the instance status, retrieving it using the functions above and |
589 | 9491766c | Hrvoje Ribicic | -- transforming it into a 'ResultEntry'. |
590 | df583eaf | Hrvoje Ribicic | statusExtract :: ConfigData -> Runtime -> Instance -> ResultEntry |
591 | df583eaf | Hrvoje Ribicic | statusExtract cfg res inst = |
592 | df583eaf | Hrvoje Ribicic | rsNormal . J.showJSON . instanceStatusToRaw $ |
593 | df583eaf | Hrvoje Ribicic | determineInstanceStatus cfg res inst |
594 | df583eaf | Hrvoje Ribicic | |
595 | 9491766c | Hrvoje Ribicic | -- | Extracts the operational status of the instance. |
596 | df583eaf | Hrvoje Ribicic | operStatusExtract :: Runtime -> Instance -> ResultEntry |
597 | df583eaf | Hrvoje Ribicic | operStatusExtract res _ = |
598 | 9491766c | Hrvoje Ribicic | rsMaybeNoData $ J.showJSON <$> |
599 | 9491766c | Hrvoje Ribicic | case res of |
600 | 9491766c | Hrvoje Ribicic | Left _ -> Nothing |
601 | 9491766c | Hrvoje Ribicic | Right x -> Just $ isJust x |
602 | df583eaf | Hrvoje Ribicic | |
603 | 9491766c | Hrvoje Ribicic | -- * Helper functions extracting information as necessary for the generic query |
604 | df583eaf | Hrvoje Ribicic | -- interfaces |
605 | df583eaf | Hrvoje Ribicic | |
606 | df583eaf | Hrvoje Ribicic | -- | Finds information about the instance in the info delivered by a node |
607 | df583eaf | Hrvoje Ribicic | findInstanceInfo :: Instance |
608 | df583eaf | Hrvoje Ribicic | -> ERpcError RpcResultAllInstancesInfo |
609 | df583eaf | Hrvoje Ribicic | -> Maybe InstanceInfo |
610 | df583eaf | Hrvoje Ribicic | findInstanceInfo inst nodeResponse = |
611 | df583eaf | Hrvoje Ribicic | case nodeResponse of |
612 | df583eaf | Hrvoje Ribicic | Left _err -> Nothing |
613 | df583eaf | Hrvoje Ribicic | Right allInfo -> |
614 | df583eaf | Hrvoje Ribicic | let instances = rpcResAllInstInfoInstances allInfo |
615 | df583eaf | Hrvoje Ribicic | maybeMatch = pickPairUnique (instName inst) instances |
616 | df583eaf | Hrvoje Ribicic | in snd <$> maybeMatch |
617 | df583eaf | Hrvoje Ribicic | |
618 | df583eaf | Hrvoje Ribicic | -- | Finds the node information ('RPCResultError') or the instance information |
619 | df583eaf | Hrvoje Ribicic | -- (Maybe 'LiveInfo'). |
620 | df583eaf | Hrvoje Ribicic | extractLiveInfo :: [(Node, ERpcError RpcResultAllInstancesInfo)] |
621 | df583eaf | Hrvoje Ribicic | -> Instance |
622 | df583eaf | Hrvoje Ribicic | -> Runtime |
623 | df583eaf | Hrvoje Ribicic | extractLiveInfo nodeResultList inst = |
624 | df583eaf | Hrvoje Ribicic | let uuidResultList = [(nodeUuid x, y) | (x, y) <- nodeResultList] |
625 | df583eaf | Hrvoje Ribicic | pNodeUuid = instPrimaryNode inst |
626 | df583eaf | Hrvoje Ribicic | maybeRPCError = getNodeStatus uuidResultList pNodeUuid |
627 | df583eaf | Hrvoje Ribicic | in case maybeRPCError of |
628 | df583eaf | Hrvoje Ribicic | Just err -> Left err |
629 | df583eaf | Hrvoje Ribicic | Nothing -> Right $ getInstanceStatus uuidResultList pNodeUuid inst |
630 | df583eaf | Hrvoje Ribicic | |
631 | df583eaf | Hrvoje Ribicic | -- | Tries to find out if the node given by the uuid is bad - unreachable or |
632 | df583eaf | Hrvoje Ribicic | -- returning errors, does not mather for the purpose of this call. |
633 | df583eaf | Hrvoje Ribicic | getNodeStatus :: [(String, ERpcError RpcResultAllInstancesInfo)] |
634 | df583eaf | Hrvoje Ribicic | -> String |
635 | df583eaf | Hrvoje Ribicic | -> Maybe RpcError |
636 | df583eaf | Hrvoje Ribicic | getNodeStatus uuidList uuid = |
637 | df583eaf | Hrvoje Ribicic | case snd <$> pickPairUnique uuid uuidList of |
638 | df583eaf | Hrvoje Ribicic | Just (Left err) -> Just err |
639 | df583eaf | Hrvoje Ribicic | Just (Right _) -> Nothing |
640 | df583eaf | Hrvoje Ribicic | Nothing -> Just . RpcResultError $ |
641 | df583eaf | Hrvoje Ribicic | "Primary node response not present" |
642 | df583eaf | Hrvoje Ribicic | |
643 | df583eaf | Hrvoje Ribicic | -- | Retrieves the instance information if it is present anywhere in the all |
644 | df583eaf | Hrvoje Ribicic | -- instances RPC result. Notes if it originates from the primary node. |
645 | df583eaf | Hrvoje Ribicic | -- All nodes are represented as UUID's for ease of use. |
646 | df583eaf | Hrvoje Ribicic | getInstanceStatus :: [(String, ERpcError RpcResultAllInstancesInfo)] |
647 | df583eaf | Hrvoje Ribicic | -> String |
648 | df583eaf | Hrvoje Ribicic | -> Instance |
649 | df583eaf | Hrvoje Ribicic | -> Maybe LiveInfo |
650 | df583eaf | Hrvoje Ribicic | getInstanceStatus uuidList pNodeUuid inst = |
651 | df583eaf | Hrvoje Ribicic | let primarySearchResult = |
652 | df583eaf | Hrvoje Ribicic | snd <$> pickPairUnique pNodeUuid uuidList >>= findInstanceInfo inst |
653 | df583eaf | Hrvoje Ribicic | in case primarySearchResult of |
654 | df583eaf | Hrvoje Ribicic | Just instInfo -> Just (instInfo, True) |
655 | df583eaf | Hrvoje Ribicic | Nothing -> |
656 | df583eaf | Hrvoje Ribicic | let allSearchResult = |
657 | df583eaf | Hrvoje Ribicic | getFirst . mconcat $ map |
658 | df583eaf | Hrvoje Ribicic | (First . findInstanceInfo inst . snd) uuidList |
659 | df583eaf | Hrvoje Ribicic | in case allSearchResult of |
660 | df583eaf | Hrvoje Ribicic | Just liveInfo -> Just (liveInfo, False) |
661 | df583eaf | Hrvoje Ribicic | Nothing -> Nothing |
662 | 1df0266e | Hrvoje Ribicic | |
663 | df583eaf | Hrvoje Ribicic | -- | Collect live data from RPC query if enabled. |
664 | df583eaf | Hrvoje Ribicic | collectLiveData :: Bool -> ConfigData -> [Instance] -> IO [(Instance, Runtime)] |
665 | df583eaf | Hrvoje Ribicic | collectLiveData liveDataEnabled cfg instances |
666 | df583eaf | Hrvoje Ribicic | | not liveDataEnabled = return . zip instances . repeat . Left . |
667 | df583eaf | Hrvoje Ribicic | RpcResultError $ "Live data disabled" |
668 | df583eaf | Hrvoje Ribicic | | otherwise = do |
669 | df583eaf | Hrvoje Ribicic | let hvSpec = getDefaultHypervisorSpec cfg |
670 | 9491766c | Hrvoje Ribicic | instance_nodes = nub . justOk $ |
671 | df583eaf | Hrvoje Ribicic | map (getNode cfg . instPrimaryNode) instances |
672 | df583eaf | Hrvoje Ribicic | good_nodes = nodesWithValidConfig cfg instance_nodes |
673 | df583eaf | Hrvoje Ribicic | rpcres <- executeRpcCall good_nodes $ RpcCallAllInstancesInfo [hvSpec] |
674 | df583eaf | Hrvoje Ribicic | return . zip instances . map (extractLiveInfo rpcres) $ instances |