root / src / Ganeti / Query / Instance.hs @ 178ad717
History | View | Annotate | Download (34.2 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 | efa0d4fd | Hrvoje Ribicic | , getInstanceInfo |
31 | 3fd38382 | Hrvoje Ribicic | , instanceFields |
32 | 3fd38382 | Hrvoje Ribicic | , instanceAliases |
33 | df583eaf | Hrvoje Ribicic | ) where |
34 | 1df0266e | Hrvoje Ribicic | |
35 | df583eaf | Hrvoje Ribicic | import Control.Applicative |
36 | b9666288 | Hrvoje Ribicic | import Data.Either |
37 | df583eaf | Hrvoje Ribicic | import Data.List |
38 | df583eaf | Hrvoje Ribicic | import Data.Maybe |
39 | df583eaf | Hrvoje Ribicic | import Data.Monoid |
40 | 1df0266e | Hrvoje Ribicic | import qualified Data.Map as Map |
41 | b9666288 | Hrvoje Ribicic | import Data.Ord (comparing) |
42 | df583eaf | Hrvoje Ribicic | import qualified Text.JSON as J |
43 | 88b58ed6 | Hrvoje Ribicic | import Text.Printf |
44 | 1df0266e | Hrvoje Ribicic | |
45 | df583eaf | Hrvoje Ribicic | import Ganeti.BasicTypes |
46 | df583eaf | Hrvoje Ribicic | import Ganeti.Common |
47 | df583eaf | Hrvoje Ribicic | import Ganeti.Config |
48 | 4e6f1cde | Hrvoje Ribicic | import qualified Ganeti.Constants as C |
49 | 4e6f1cde | Hrvoje Ribicic | import qualified Ganeti.ConstantUtils as C |
50 | 9491766c | Hrvoje Ribicic | import Ganeti.Errors |
51 | 4e6f1cde | Hrvoje Ribicic | import Ganeti.JSON |
52 | 1df0266e | Hrvoje Ribicic | import Ganeti.Objects |
53 | 1df0266e | Hrvoje Ribicic | import Ganeti.Query.Common |
54 | 1df0266e | Hrvoje Ribicic | import Ganeti.Query.Language |
55 | 1df0266e | Hrvoje Ribicic | import Ganeti.Query.Types |
56 | df583eaf | Hrvoje Ribicic | import Ganeti.Rpc |
57 | df583eaf | Hrvoje Ribicic | import Ganeti.Storage.Utils |
58 | df583eaf | Hrvoje Ribicic | import Ganeti.Types |
59 | 88b58ed6 | Hrvoje Ribicic | import Ganeti.Utils (formatOrdinal) |
60 | 1df0266e | Hrvoje Ribicic | |
61 | b9666288 | Hrvoje Ribicic | -- | The LiveInfo consists of two entries whose presence is independent. |
62 | b9666288 | Hrvoje Ribicic | -- The 'InstanceInfo' is the live instance information, accompanied by a bool |
63 | b9666288 | Hrvoje Ribicic | -- signifying if it was found on its designated primary node or not. |
64 | b9666288 | Hrvoje Ribicic | -- The 'InstanceConsoleInfo' describes how to connect to an instance. |
65 | b9666288 | Hrvoje Ribicic | -- Any combination of these may or may not be present, depending on node and |
66 | b9666288 | Hrvoje Ribicic | -- instance availability. |
67 | b9666288 | Hrvoje Ribicic | type LiveInfo = (Maybe (InstanceInfo, Bool), Maybe InstanceConsoleInfo) |
68 | df583eaf | Hrvoje Ribicic | |
69 | b9666288 | Hrvoje Ribicic | -- | Runtime containing the 'LiveInfo'. See the genericQuery function in |
70 | b9666288 | Hrvoje Ribicic | -- the Query.hs file for an explanation of the terms used. |
71 | b9666288 | Hrvoje Ribicic | type Runtime = Either RpcError LiveInfo |
72 | df583eaf | Hrvoje Ribicic | |
73 | df583eaf | Hrvoje Ribicic | -- | The instance fields map. |
74 | df583eaf | Hrvoje Ribicic | fieldsMap :: FieldMap Instance Runtime |
75 | 3fd38382 | Hrvoje Ribicic | fieldsMap = Map.fromList [(fdefName f, v) | v@(f, _, _) <- aliasedFields] |
76 | df583eaf | Hrvoje Ribicic | |
77 | 3fd38382 | Hrvoje Ribicic | -- | The instance aliases. |
78 | 3fd38382 | Hrvoje Ribicic | instanceAliases :: [(FieldName, FieldName)] |
79 | 3fd38382 | Hrvoje Ribicic | instanceAliases = |
80 | 3fd38382 | Hrvoje Ribicic | [ ("vcpus", "be/vcpus") |
81 | 3fd38382 | Hrvoje Ribicic | , ("be/memory", "be/maxmem") |
82 | 3fd38382 | Hrvoje Ribicic | , ("sda_size", "disk.size/0") |
83 | 3fd38382 | Hrvoje Ribicic | , ("sdb_size", "disk.size/1") |
84 | 3fd38382 | Hrvoje Ribicic | , ("ip", "nic.ip/0") |
85 | 3fd38382 | Hrvoje Ribicic | , ("mac", "nic.mac/0") |
86 | 3fd38382 | Hrvoje Ribicic | , ("bridge", "nic.bridge/0") |
87 | 3fd38382 | Hrvoje Ribicic | , ("nic_mode", "nic.mode/0") |
88 | 3fd38382 | Hrvoje Ribicic | , ("nic_link", "nic.link/0") |
89 | 3fd38382 | Hrvoje Ribicic | , ("nic_network", "nic.network/0") |
90 | 3fd38382 | Hrvoje Ribicic | ] |
91 | 3fd38382 | Hrvoje Ribicic | |
92 | 3fd38382 | Hrvoje Ribicic | -- | The aliased instance fields. |
93 | 3fd38382 | Hrvoje Ribicic | aliasedFields :: FieldList Instance Runtime |
94 | 3fd38382 | Hrvoje Ribicic | aliasedFields = aliasFields instanceAliases instanceFields |
95 | 3fd38382 | Hrvoje Ribicic | |
96 | 3fd38382 | Hrvoje Ribicic | -- | The instance fields. |
97 | df583eaf | Hrvoje Ribicic | instanceFields :: FieldList Instance Runtime |
98 | 1df0266e | Hrvoje Ribicic | instanceFields = |
99 | df583eaf | Hrvoje Ribicic | -- Simple fields |
100 | 9491766c | Hrvoje Ribicic | [ (FieldDefinition "admin_state" "InstanceState" QFTText |
101 | 9491766c | Hrvoje Ribicic | "Desired state of instance", |
102 | 9491766c | Hrvoje Ribicic | FieldSimple (rsNormal . adminStateToRaw . instAdminState), QffNormal) |
103 | 9491766c | Hrvoje Ribicic | , (FieldDefinition "admin_up" "Autostart" QFTBool |
104 | 9491766c | Hrvoje Ribicic | "Desired state of instance", |
105 | 9491766c | Hrvoje Ribicic | FieldSimple (rsNormal . (== AdminUp) . instAdminState), QffNormal) |
106 | 9491766c | Hrvoje Ribicic | , (FieldDefinition "disk_template" "Disk_template" QFTText |
107 | df583eaf | Hrvoje Ribicic | "Instance disk template", |
108 | 1df0266e | Hrvoje Ribicic | FieldSimple (rsNormal . instDiskTemplate), QffNormal) |
109 | 9491766c | Hrvoje Ribicic | , (FieldDefinition "disks_active" "DisksActive" QFTBool |
110 | 9491766c | Hrvoje Ribicic | "Desired state of instance disks", |
111 | 9491766c | Hrvoje Ribicic | FieldSimple (rsNormal . instDisksActive), QffNormal) |
112 | 1df0266e | Hrvoje Ribicic | , (FieldDefinition "name" "Instance" QFTText |
113 | 1df0266e | Hrvoje Ribicic | "Instance name", |
114 | 1df0266e | Hrvoje Ribicic | FieldSimple (rsNormal . instName), QffHostname) |
115 | 1df0266e | Hrvoje Ribicic | , (FieldDefinition "hypervisor" "Hypervisor" QFTText |
116 | 1df0266e | Hrvoje Ribicic | "Hypervisor name", |
117 | 1df0266e | Hrvoje Ribicic | FieldSimple (rsNormal . instHypervisor), QffNormal) |
118 | 1df0266e | Hrvoje Ribicic | , (FieldDefinition "network_port" "Network_port" QFTOther |
119 | 1df0266e | Hrvoje Ribicic | "Instance network port if available (e.g. for VNC console)", |
120 | df583eaf | Hrvoje Ribicic | FieldSimple (rsMaybeUnavail . instNetworkPort), QffNormal) |
121 | 1df0266e | Hrvoje Ribicic | , (FieldDefinition "os" "OS" QFTText |
122 | 1df0266e | Hrvoje Ribicic | "Operating system", |
123 | 1df0266e | Hrvoje Ribicic | FieldSimple (rsNormal . instOs), QffNormal) |
124 | 9491766c | Hrvoje Ribicic | , (FieldDefinition "pnode" "Primary_node" QFTText |
125 | 9491766c | Hrvoje Ribicic | "Primary node", |
126 | 9491766c | Hrvoje Ribicic | FieldConfig getPrimaryNodeName, QffHostname) |
127 | 9491766c | Hrvoje Ribicic | , (FieldDefinition "pnode.group" "PrimaryNodeGroup" QFTText |
128 | 9491766c | Hrvoje Ribicic | "Primary node's group", |
129 | 1d3d454f | Hrvoje Ribicic | FieldConfig getPrimaryNodeGroupName, QffNormal) |
130 | 1d3d454f | Hrvoje Ribicic | , (FieldDefinition "pnode.group.uuid" "PrimaryNodeGroupUUID" QFTText |
131 | 1d3d454f | Hrvoje Ribicic | "Primary node's group UUID", |
132 | 1d3d454f | Hrvoje Ribicic | FieldConfig getPrimaryNodeGroupUuid, QffNormal) |
133 | 9491766c | Hrvoje Ribicic | , (FieldDefinition "snodes" "Secondary_Nodes" QFTOther |
134 | 9491766c | Hrvoje Ribicic | "Secondary nodes; usually this will just be one node", |
135 | 9491766c | Hrvoje Ribicic | FieldConfig (getSecondaryNodeAttribute nodeName), QffNormal) |
136 | 9491766c | Hrvoje Ribicic | , (FieldDefinition "snodes.group" "SecondaryNodesGroups" QFTOther |
137 | 9491766c | Hrvoje Ribicic | "Node groups of secondary nodes", |
138 | 9491766c | Hrvoje Ribicic | FieldConfig (getSecondaryNodeGroupAttribute groupName), QffNormal) |
139 | 9491766c | Hrvoje Ribicic | , (FieldDefinition "snodes.group.uuid" "SecondaryNodesGroupsUUID" QFTOther |
140 | 9491766c | Hrvoje Ribicic | "Node group UUIDs of secondary nodes", |
141 | 9491766c | Hrvoje Ribicic | FieldConfig (getSecondaryNodeGroupAttribute groupUuid), QffNormal) |
142 | 1df0266e | Hrvoje Ribicic | ] ++ |
143 | df583eaf | Hrvoje Ribicic | |
144 | 4e6f1cde | Hrvoje Ribicic | -- Instance parameter fields, whole |
145 | 4e6f1cde | Hrvoje Ribicic | [ (FieldDefinition "hvparams" "HypervisorParameters" QFTOther |
146 | 4e6f1cde | Hrvoje Ribicic | "Hypervisor parameters (merged)", |
147 | b9666288 | Hrvoje Ribicic | FieldConfig |
148 | b9666288 | Hrvoje Ribicic | ((rsNormal .) . getFilledInstHvParams (C.toList C.hvcGlobals)), |
149 | b9666288 | Hrvoje Ribicic | QffNormal), |
150 | b9666288 | Hrvoje Ribicic | |
151 | b9666288 | Hrvoje Ribicic | (FieldDefinition "beparams" "BackendParameters" QFTOther |
152 | 4e6f1cde | Hrvoje Ribicic | "Backend parameters (merged)", |
153 | 4e6f1cde | Hrvoje Ribicic | FieldConfig ((rsErrorNoData .) . getFilledInstBeParams), QffNormal) |
154 | 4e6f1cde | Hrvoje Ribicic | , (FieldDefinition "osparams" "OpSysParameters" QFTOther |
155 | 4e6f1cde | Hrvoje Ribicic | "Operating system parameters (merged)", |
156 | 4e6f1cde | Hrvoje Ribicic | FieldConfig ((rsNormal .) . getFilledInstOsParams), QffNormal) |
157 | 4e6f1cde | Hrvoje Ribicic | , (FieldDefinition "custom_hvparams" "CustomHypervisorParameters" QFTOther |
158 | 4e6f1cde | Hrvoje Ribicic | "Custom hypervisor parameters", |
159 | 4e6f1cde | Hrvoje Ribicic | FieldSimple (rsNormal . instHvparams), QffNormal) |
160 | 4e6f1cde | Hrvoje Ribicic | , (FieldDefinition "custom_beparams" "CustomBackendParameters" QFTOther |
161 | 4e6f1cde | Hrvoje Ribicic | "Custom backend parameters", |
162 | 4e6f1cde | Hrvoje Ribicic | FieldSimple (rsNormal . instBeparams), QffNormal) |
163 | 4e6f1cde | Hrvoje Ribicic | , (FieldDefinition "custom_osparams" "CustomOpSysParameters" QFTOther |
164 | 4e6f1cde | Hrvoje Ribicic | "Custom operating system parameters", |
165 | 4e6f1cde | Hrvoje Ribicic | FieldSimple (rsNormal . instOsparams), QffNormal) |
166 | 1d3d454f | Hrvoje Ribicic | , (FieldDefinition "custom_nicparams" "CustomNicParameters" QFTOther |
167 | 1d3d454f | Hrvoje Ribicic | "Custom network interface parameters", |
168 | 1d3d454f | Hrvoje Ribicic | FieldSimple (rsNormal . map nicNicparams . instNics), QffNormal) |
169 | 4e6f1cde | Hrvoje Ribicic | ] ++ |
170 | 4e6f1cde | Hrvoje Ribicic | |
171 | 4e6f1cde | Hrvoje Ribicic | -- Instance parameter fields, generated |
172 | 4e6f1cde | Hrvoje Ribicic | map (buildBeParamField beParamGetter) allBeParamFields ++ |
173 | 5c47a2a6 | Klaus Aehlig | map (buildHvParamField hvParamGetter) |
174 | 5c47a2a6 | Klaus Aehlig | (C.toList C.hvsParameters \\ C.toList C.hvcGlobals) ++ |
175 | 4e6f1cde | Hrvoje Ribicic | |
176 | 88b58ed6 | Hrvoje Ribicic | -- Aggregate disk parameter fields |
177 | 88b58ed6 | Hrvoje Ribicic | [ (FieldDefinition "disk_usage" "DiskUsage" QFTUnit |
178 | 88b58ed6 | Hrvoje Ribicic | "Total disk space used by instance on each of its nodes; this is not the\ |
179 | 88b58ed6 | Hrvoje Ribicic | \ disk size visible to the instance, but the usage on the node", |
180 | a861d322 | Hrvoje Ribicic | FieldSimple (rsNormal . getDiskSizeRequirements), QffNormal) |
181 | a861d322 | Hrvoje Ribicic | , (FieldDefinition "disk.count" "Disks" QFTNumber |
182 | 88b58ed6 | Hrvoje Ribicic | "Number of disks", |
183 | a861d322 | Hrvoje Ribicic | FieldSimple (rsNormal . length . instDisks), QffNormal) |
184 | a861d322 | Hrvoje Ribicic | , (FieldDefinition "disk.sizes" "Disk_sizes" QFTOther |
185 | 88b58ed6 | Hrvoje Ribicic | "List of disk sizes", |
186 | a861d322 | Hrvoje Ribicic | FieldSimple (rsNormal . map diskSize . instDisks), QffNormal) |
187 | a861d322 | Hrvoje Ribicic | , (FieldDefinition "disk.spindles" "Disk_spindles" QFTOther |
188 | 88b58ed6 | Hrvoje Ribicic | "List of disk spindles", |
189 | 88b58ed6 | Hrvoje Ribicic | FieldSimple (rsNormal . map (MaybeForJSON . diskSpindles) . |
190 | 88b58ed6 | Hrvoje Ribicic | instDisks), |
191 | a861d322 | Hrvoje Ribicic | QffNormal) |
192 | a861d322 | Hrvoje Ribicic | , (FieldDefinition "disk.names" "Disk_names" QFTOther |
193 | 88b58ed6 | Hrvoje Ribicic | "List of disk names", |
194 | 88b58ed6 | Hrvoje Ribicic | FieldSimple (rsNormal . map (MaybeForJSON . diskName) . |
195 | 88b58ed6 | Hrvoje Ribicic | instDisks), |
196 | a861d322 | Hrvoje Ribicic | QffNormal) |
197 | a861d322 | Hrvoje Ribicic | , (FieldDefinition "disk.uuids" "Disk_UUIDs" QFTOther |
198 | 88b58ed6 | Hrvoje Ribicic | "List of disk UUIDs", |
199 | 88b58ed6 | Hrvoje Ribicic | FieldSimple (rsNormal . map diskUuid . instDisks), QffNormal) |
200 | 88b58ed6 | Hrvoje Ribicic | ] ++ |
201 | 88b58ed6 | Hrvoje Ribicic | |
202 | 88b58ed6 | Hrvoje Ribicic | -- Per-disk parameter fields |
203 | 3b89cb1b | Hrvoje Ribicic | instantiateIndexedFields C.maxDisks |
204 | 88b58ed6 | Hrvoje Ribicic | [ (fieldDefinitionCompleter "disk.size/%d" "Disk/%d" QFTUnit |
205 | 88b58ed6 | Hrvoje Ribicic | "Disk size of %s disk", |
206 | 3b89cb1b | Hrvoje Ribicic | getIndexedField instDisks diskSize, QffNormal) |
207 | a861d322 | Hrvoje Ribicic | , (fieldDefinitionCompleter "disk.spindles/%d" "DiskSpindles/%d" QFTNumber |
208 | 88b58ed6 | Hrvoje Ribicic | "Spindles of %s disk", |
209 | 3b89cb1b | Hrvoje Ribicic | getIndexedOptionalField instDisks diskSpindles, QffNormal) |
210 | a861d322 | Hrvoje Ribicic | , (fieldDefinitionCompleter "disk.name/%d" "DiskName/%d" QFTText |
211 | 88b58ed6 | Hrvoje Ribicic | "Name of %s disk", |
212 | 3b89cb1b | Hrvoje Ribicic | getIndexedOptionalField instDisks diskName, QffNormal) |
213 | a861d322 | Hrvoje Ribicic | , (fieldDefinitionCompleter "disk.uuid/%d" "DiskUUID/%d" QFTText |
214 | 88b58ed6 | Hrvoje Ribicic | "UUID of %s disk", |
215 | 3b89cb1b | Hrvoje Ribicic | getIndexedField instDisks diskUuid, QffNormal) |
216 | 88b58ed6 | Hrvoje Ribicic | ] ++ |
217 | 88b58ed6 | Hrvoje Ribicic | |
218 | a861d322 | Hrvoje Ribicic | -- Aggregate nic parameter fields |
219 | a861d322 | Hrvoje Ribicic | [ (FieldDefinition "nic.count" "NICs" QFTNumber |
220 | a861d322 | Hrvoje Ribicic | "Number of network interfaces", |
221 | a861d322 | Hrvoje Ribicic | FieldSimple (rsNormal . length . instNics), QffNormal) |
222 | a861d322 | Hrvoje Ribicic | , (FieldDefinition "nic.macs" "NIC_MACs" QFTOther |
223 | a861d322 | Hrvoje Ribicic | (nicAggDescPrefix ++ "MAC address"), |
224 | a861d322 | Hrvoje Ribicic | FieldSimple (rsNormal . map nicMac . instNics), QffNormal) |
225 | a861d322 | Hrvoje Ribicic | , (FieldDefinition "nic.ips" "NIC_IPs" QFTOther |
226 | a861d322 | Hrvoje Ribicic | (nicAggDescPrefix ++ "IP address"), |
227 | a861d322 | Hrvoje Ribicic | FieldSimple (rsNormal . map (MaybeForJSON . nicIp) . instNics), |
228 | a861d322 | Hrvoje Ribicic | QffNormal) |
229 | a861d322 | Hrvoje Ribicic | , (FieldDefinition "nic.names" "NIC_Names" QFTOther |
230 | a861d322 | Hrvoje Ribicic | (nicAggDescPrefix ++ "name"), |
231 | a861d322 | Hrvoje Ribicic | FieldSimple (rsNormal . map (MaybeForJSON . nicName) . instNics), |
232 | a861d322 | Hrvoje Ribicic | QffNormal) |
233 | a861d322 | Hrvoje Ribicic | , (FieldDefinition "nic.uuids" "NIC_UUIDs" QFTOther |
234 | a861d322 | Hrvoje Ribicic | (nicAggDescPrefix ++ "UUID"), |
235 | a861d322 | Hrvoje Ribicic | FieldSimple (rsNormal . map nicUuid . instNics), QffNormal) |
236 | a861d322 | Hrvoje Ribicic | , (FieldDefinition "nic.modes" "NIC_modes" QFTOther |
237 | a861d322 | Hrvoje Ribicic | (nicAggDescPrefix ++ "mode"), |
238 | a861d322 | Hrvoje Ribicic | FieldConfig (\cfg -> rsNormal . map |
239 | a861d322 | Hrvoje Ribicic | (nicpMode . fillNicParamsFromConfig cfg . nicNicparams) |
240 | a861d322 | Hrvoje Ribicic | . instNics), |
241 | a861d322 | Hrvoje Ribicic | QffNormal) |
242 | 32933325 | Hrvoje Ribicic | , (FieldDefinition "nic.vlans" "NIC_VLANs" QFTOther |
243 | 32933325 | Hrvoje Ribicic | (nicAggDescPrefix ++ "VLAN"), |
244 | 32933325 | Hrvoje Ribicic | FieldConfig (\cfg -> rsNormal . map (MaybeForJSON . getNicVlan . |
245 | 32933325 | Hrvoje Ribicic | fillNicParamsFromConfig cfg . nicNicparams) . instNics), |
246 | 32933325 | Hrvoje Ribicic | QffNormal) |
247 | a861d322 | Hrvoje Ribicic | , (FieldDefinition "nic.bridges" "NIC_bridges" QFTOther |
248 | a861d322 | Hrvoje Ribicic | (nicAggDescPrefix ++ "bridge"), |
249 | a861d322 | Hrvoje Ribicic | FieldConfig (\cfg -> rsNormal . map (MaybeForJSON . getNicBridge . |
250 | a861d322 | Hrvoje Ribicic | fillNicParamsFromConfig cfg . nicNicparams) . instNics), |
251 | a861d322 | Hrvoje Ribicic | QffNormal) |
252 | a861d322 | Hrvoje Ribicic | , (FieldDefinition "nic.links" "NIC_links" QFTOther |
253 | a861d322 | Hrvoje Ribicic | (nicAggDescPrefix ++ "link"), |
254 | a861d322 | Hrvoje Ribicic | FieldConfig (\cfg -> rsNormal . map |
255 | a861d322 | Hrvoje Ribicic | (nicpLink . fillNicParamsFromConfig cfg . nicNicparams) |
256 | a861d322 | Hrvoje Ribicic | . instNics), |
257 | a861d322 | Hrvoje Ribicic | QffNormal) |
258 | a861d322 | Hrvoje Ribicic | , (FieldDefinition "nic.networks" "NIC_networks" QFTOther |
259 | a861d322 | Hrvoje Ribicic | "List containing each interface's network", |
260 | a861d322 | Hrvoje Ribicic | FieldSimple (rsNormal . map (MaybeForJSON . nicNetwork) . instNics), |
261 | a861d322 | Hrvoje Ribicic | QffNormal) |
262 | a861d322 | Hrvoje Ribicic | , (FieldDefinition "nic.networks.names" "NIC_networks_names" QFTOther |
263 | a861d322 | Hrvoje Ribicic | "List containing the name of each interface's network", |
264 | a861d322 | Hrvoje Ribicic | FieldConfig (\cfg -> rsNormal . map |
265 | a861d322 | Hrvoje Ribicic | (\x -> MaybeForJSON (getNetworkName cfg <$> nicNetwork x)) |
266 | a861d322 | Hrvoje Ribicic | . instNics), |
267 | a861d322 | Hrvoje Ribicic | QffNormal) |
268 | a861d322 | Hrvoje Ribicic | ] ++ |
269 | a861d322 | Hrvoje Ribicic | |
270 | a861d322 | Hrvoje Ribicic | -- Per-nic parameter fields |
271 | 3b89cb1b | Hrvoje Ribicic | instantiateIndexedFields C.maxNics |
272 | a861d322 | Hrvoje Ribicic | [ (fieldDefinitionCompleter "nic.ip/%d" "NicIP/%d" QFTText |
273 | a861d322 | Hrvoje Ribicic | ("IP address" ++ nicDescSuffix), |
274 | 3b89cb1b | Hrvoje Ribicic | getIndexedOptionalField instNics nicIp, QffNormal) |
275 | a861d322 | Hrvoje Ribicic | , (fieldDefinitionCompleter "nic.uuid/%d" "NicUUID/%d" QFTText |
276 | a861d322 | Hrvoje Ribicic | ("UUID address" ++ nicDescSuffix), |
277 | 3b89cb1b | Hrvoje Ribicic | getIndexedField instNics nicUuid, QffNormal) |
278 | a861d322 | Hrvoje Ribicic | , (fieldDefinitionCompleter "nic.mac/%d" "NicMAC/%d" QFTText |
279 | a861d322 | Hrvoje Ribicic | ("MAC address" ++ nicDescSuffix), |
280 | 3b89cb1b | Hrvoje Ribicic | getIndexedField instNics nicMac, QffNormal) |
281 | a861d322 | Hrvoje Ribicic | , (fieldDefinitionCompleter "nic.name/%d" "NicName/%d" QFTText |
282 | a861d322 | Hrvoje Ribicic | ("Name address" ++ nicDescSuffix), |
283 | 3b89cb1b | Hrvoje Ribicic | getIndexedOptionalField instNics nicName, QffNormal) |
284 | a861d322 | Hrvoje Ribicic | , (fieldDefinitionCompleter "nic.network/%d" "NicNetwork/%d" QFTText |
285 | a861d322 | Hrvoje Ribicic | ("Network" ++ nicDescSuffix), |
286 | 3b89cb1b | Hrvoje Ribicic | getIndexedOptionalField instNics nicNetwork, QffNormal) |
287 | a861d322 | Hrvoje Ribicic | , (fieldDefinitionCompleter "nic.mode/%d" "NicMode/%d" QFTText |
288 | a861d322 | Hrvoje Ribicic | ("Mode" ++ nicDescSuffix), |
289 | 3b89cb1b | Hrvoje Ribicic | getIndexedNicField nicpMode, QffNormal) |
290 | a861d322 | Hrvoje Ribicic | , (fieldDefinitionCompleter "nic.link/%d" "NicLink/%d" QFTText |
291 | a861d322 | Hrvoje Ribicic | ("Link" ++ nicDescSuffix), |
292 | 3b89cb1b | Hrvoje Ribicic | getIndexedNicField nicpLink, QffNormal) |
293 | 63f4bce5 | Hrvoje Ribicic | , (fieldDefinitionCompleter "nic.vlan/%d" "NicVLAN/%d" QFTText |
294 | 63f4bce5 | Hrvoje Ribicic | ("VLAN" ++ nicDescSuffix), |
295 | 63f4bce5 | Hrvoje Ribicic | getOptionalIndexedNicField getNicVlan, QffNormal) |
296 | a861d322 | Hrvoje Ribicic | , (fieldDefinitionCompleter "nic.network.name/%d" "NicNetworkName/%d" QFTText |
297 | a861d322 | Hrvoje Ribicic | ("Network name" ++ nicDescSuffix), |
298 | 3b89cb1b | Hrvoje Ribicic | getIndexedNicNetworkNameField, QffNormal) |
299 | a861d322 | Hrvoje Ribicic | , (fieldDefinitionCompleter "nic.bridge/%d" "NicBridge/%d" QFTText |
300 | a861d322 | Hrvoje Ribicic | ("Bridge" ++ nicDescSuffix), |
301 | 3b89cb1b | Hrvoje Ribicic | getOptionalIndexedNicField getNicBridge, QffNormal) |
302 | a861d322 | Hrvoje Ribicic | ] ++ |
303 | a861d322 | Hrvoje Ribicic | |
304 | df583eaf | Hrvoje Ribicic | -- Live fields using special getters |
305 | df583eaf | Hrvoje Ribicic | [ (FieldDefinition "status" "Status" QFTText |
306 | df583eaf | Hrvoje Ribicic | statusDocText, |
307 | df583eaf | Hrvoje Ribicic | FieldConfigRuntime statusExtract, QffNormal) |
308 | df583eaf | Hrvoje Ribicic | , (FieldDefinition "oper_state" "Running" QFTBool |
309 | df583eaf | Hrvoje Ribicic | "Actual state of instance", |
310 | b9666288 | Hrvoje Ribicic | FieldRuntime operStatusExtract, QffNormal), |
311 | b9666288 | Hrvoje Ribicic | |
312 | b9666288 | Hrvoje Ribicic | (FieldDefinition "console" "Console" QFTOther |
313 | b9666288 | Hrvoje Ribicic | "Instance console information", |
314 | b9666288 | Hrvoje Ribicic | FieldRuntime consoleExtract, QffNormal) |
315 | df583eaf | Hrvoje Ribicic | ] ++ |
316 | df583eaf | Hrvoje Ribicic | |
317 | df583eaf | Hrvoje Ribicic | -- Simple live fields |
318 | df583eaf | Hrvoje Ribicic | map instanceLiveFieldBuilder instanceLiveFieldsDefs ++ |
319 | df583eaf | Hrvoje Ribicic | |
320 | 1d3d454f | Hrvoje Ribicic | -- Common fields |
321 | 1d3d454f | Hrvoje Ribicic | timeStampFields ++ |
322 | 1df0266e | Hrvoje Ribicic | serialFields "Instance" ++ |
323 | df583eaf | Hrvoje Ribicic | uuidFields "Instance" ++ |
324 | df583eaf | Hrvoje Ribicic | tagsFields |
325 | df583eaf | Hrvoje Ribicic | |
326 | 9491766c | Hrvoje Ribicic | -- * Helper functions for node property retrieval |
327 | 9491766c | Hrvoje Ribicic | |
328 | a861d322 | Hrvoje Ribicic | -- | Constant suffix of network interface field descriptions. |
329 | a861d322 | Hrvoje Ribicic | nicDescSuffix ::String |
330 | a861d322 | Hrvoje Ribicic | nicDescSuffix = " of %s network interface" |
331 | a861d322 | Hrvoje Ribicic | |
332 | a861d322 | Hrvoje Ribicic | -- | Almost-constant suffix of aggregate network interface field descriptions. |
333 | a861d322 | Hrvoje Ribicic | nicAggDescPrefix ::String |
334 | a861d322 | Hrvoje Ribicic | nicAggDescPrefix = "List containing each network interface's " |
335 | a861d322 | Hrvoje Ribicic | |
336 | a861d322 | Hrvoje Ribicic | -- | Given a network name id, returns the network's name. |
337 | a861d322 | Hrvoje Ribicic | getNetworkName :: ConfigData -> String -> NonEmptyString |
338 | a861d322 | Hrvoje Ribicic | getNetworkName cfg = networkName . (Map.!) (fromContainer $ configNetworks cfg) |
339 | a861d322 | Hrvoje Ribicic | |
340 | a861d322 | Hrvoje Ribicic | -- | Gets the bridge of a NIC. |
341 | a861d322 | Hrvoje Ribicic | getNicBridge :: FilledNicParams -> Maybe String |
342 | a861d322 | Hrvoje Ribicic | getNicBridge nicParams |
343 | a861d322 | Hrvoje Ribicic | | nicpMode nicParams == NMBridged = Just $ nicpLink nicParams |
344 | a861d322 | Hrvoje Ribicic | | otherwise = Nothing |
345 | a861d322 | Hrvoje Ribicic | |
346 | 63f4bce5 | Hrvoje Ribicic | -- | Gets the VLAN of a NIC. |
347 | 63f4bce5 | Hrvoje Ribicic | getNicVlan :: FilledNicParams -> Maybe String |
348 | 63f4bce5 | Hrvoje Ribicic | getNicVlan params |
349 | 63f4bce5 | Hrvoje Ribicic | | nicpMode params == NMOvs = Just $ nicpVlan params |
350 | 63f4bce5 | Hrvoje Ribicic | | otherwise = Nothing |
351 | 63f4bce5 | Hrvoje Ribicic | |
352 | a861d322 | Hrvoje Ribicic | -- | Fill partial NIC params by using the defaults from the configuration. |
353 | a861d322 | Hrvoje Ribicic | fillNicParamsFromConfig :: ConfigData -> PartialNicParams -> FilledNicParams |
354 | a861d322 | Hrvoje Ribicic | fillNicParamsFromConfig cfg = fillNicParams (getDefaultNicParams cfg) |
355 | a861d322 | Hrvoje Ribicic | |
356 | a861d322 | Hrvoje Ribicic | -- | Retrieves the default network interface parameters. |
357 | a861d322 | Hrvoje Ribicic | getDefaultNicParams :: ConfigData -> FilledNicParams |
358 | a861d322 | Hrvoje Ribicic | getDefaultNicParams cfg = |
359 | a861d322 | Hrvoje Ribicic | (Map.!) (fromContainer . clusterNicparams . configCluster $ cfg) C.ppDefault |
360 | a861d322 | Hrvoje Ribicic | |
361 | a861d322 | Hrvoje Ribicic | -- | Returns a field that retrieves a given NIC's network name. |
362 | 3b89cb1b | Hrvoje Ribicic | getIndexedNicNetworkNameField :: Int -> FieldGetter Instance Runtime |
363 | 3b89cb1b | Hrvoje Ribicic | getIndexedNicNetworkNameField index = |
364 | a861d322 | Hrvoje Ribicic | FieldConfig (\cfg inst -> rsMaybeUnavail $ do |
365 | a861d322 | Hrvoje Ribicic | nicObj <- maybeAt index $ instNics inst |
366 | a861d322 | Hrvoje Ribicic | nicNetworkId <- nicNetwork nicObj |
367 | a861d322 | Hrvoje Ribicic | return $ getNetworkName cfg nicNetworkId) |
368 | a861d322 | Hrvoje Ribicic | |
369 | a861d322 | Hrvoje Ribicic | -- | Gets a fillable NIC field. |
370 | 3b89cb1b | Hrvoje Ribicic | getIndexedNicField :: (J.JSON a) |
371 | 3b89cb1b | Hrvoje Ribicic | => (FilledNicParams -> a) |
372 | 3b89cb1b | Hrvoje Ribicic | -> Int |
373 | 3b89cb1b | Hrvoje Ribicic | -> FieldGetter Instance Runtime |
374 | 3b89cb1b | Hrvoje Ribicic | getIndexedNicField getter = |
375 | 3b89cb1b | Hrvoje Ribicic | getOptionalIndexedNicField (\x -> Just . getter $ x) |
376 | a861d322 | Hrvoje Ribicic | |
377 | a861d322 | Hrvoje Ribicic | -- | Gets an optional fillable NIC field. |
378 | 3b89cb1b | Hrvoje Ribicic | getOptionalIndexedNicField :: (J.JSON a) |
379 | 3b89cb1b | Hrvoje Ribicic | => (FilledNicParams -> Maybe a) |
380 | 3b89cb1b | Hrvoje Ribicic | -> Int |
381 | 3b89cb1b | Hrvoje Ribicic | -> FieldGetter Instance Runtime |
382 | 3b89cb1b | Hrvoje Ribicic | getOptionalIndexedNicField = |
383 | 3b89cb1b | Hrvoje Ribicic | getIndexedFieldWithDefault |
384 | a861d322 | Hrvoje Ribicic | (map nicNicparams . instNics) (\x _ -> getDefaultNicParams x) fillNicParams |
385 | a861d322 | Hrvoje Ribicic | |
386 | a861d322 | Hrvoje Ribicic | -- | Creates a function which produces a 'FieldGetter' when fed an index. Works |
387 | a861d322 | Hrvoje Ribicic | -- for fields that should be filled out through the use of a default. |
388 | 3b89cb1b | Hrvoje Ribicic | getIndexedFieldWithDefault :: (J.JSON c) |
389 | a861d322 | Hrvoje Ribicic | => (Instance -> [a]) -- ^ Extracts a list of incomplete objects |
390 | a861d322 | Hrvoje Ribicic | -> (ConfigData -> Instance -> b) -- ^ Extracts the default object |
391 | a861d322 | Hrvoje Ribicic | -> (b -> a -> b) -- ^ Fills the default object |
392 | a861d322 | Hrvoje Ribicic | -> (b -> Maybe c) -- ^ Extracts an obj property |
393 | a861d322 | Hrvoje Ribicic | -> Int -- ^ Index in list to use |
394 | a861d322 | Hrvoje Ribicic | -> FieldGetter Instance Runtime -- ^ Result |
395 | 3b89cb1b | Hrvoje Ribicic | getIndexedFieldWithDefault |
396 | a861d322 | Hrvoje Ribicic | listGetter defaultGetter fillFn propertyGetter index = |
397 | a861d322 | Hrvoje Ribicic | FieldConfig (\cfg inst -> rsMaybeUnavail $ do |
398 | a861d322 | Hrvoje Ribicic | incompleteObj <- maybeAt index $ listGetter inst |
399 | a861d322 | Hrvoje Ribicic | let defaultObj = defaultGetter cfg inst |
400 | a861d322 | Hrvoje Ribicic | completeObj = fillFn defaultObj incompleteObj |
401 | a861d322 | Hrvoje Ribicic | propertyGetter completeObj) |
402 | a861d322 | Hrvoje Ribicic | |
403 | a861d322 | Hrvoje Ribicic | -- | Creates a function which produces a 'FieldGetter' when fed an index. Works |
404 | 88b58ed6 | Hrvoje Ribicic | -- for fields that may not return a value, expressed through the Maybe monad. |
405 | 3b89cb1b | Hrvoje Ribicic | getIndexedOptionalField :: (J.JSON b) |
406 | 3b89cb1b | Hrvoje Ribicic | => (Instance -> [a]) -- ^ Extracts a list of objects |
407 | 3b89cb1b | Hrvoje Ribicic | -> (a -> Maybe b) -- ^ Possibly gets a property |
408 | 3b89cb1b | Hrvoje Ribicic | -- from an object |
409 | 3b89cb1b | Hrvoje Ribicic | -> Int -- ^ Index in list to use |
410 | 3b89cb1b | Hrvoje Ribicic | -> FieldGetter Instance Runtime -- ^ Result |
411 | 3b89cb1b | Hrvoje Ribicic | getIndexedOptionalField extractor optPropertyGetter index = |
412 | 88b58ed6 | Hrvoje Ribicic | FieldSimple(\inst -> rsMaybeUnavail $ do |
413 | 88b58ed6 | Hrvoje Ribicic | obj <- maybeAt index $ extractor inst |
414 | 88b58ed6 | Hrvoje Ribicic | optPropertyGetter obj) |
415 | 88b58ed6 | Hrvoje Ribicic | |
416 | a861d322 | Hrvoje Ribicic | -- | Creates a function which produces a 'FieldGetter' when fed an index. |
417 | 88b58ed6 | Hrvoje Ribicic | -- Works only for fields that surely return a value. |
418 | 3b89cb1b | Hrvoje Ribicic | getIndexedField :: (J.JSON b) |
419 | 3b89cb1b | Hrvoje Ribicic | => (Instance -> [a]) -- ^ Extracts a list of objects |
420 | 3b89cb1b | Hrvoje Ribicic | -> (a -> b) -- ^ Gets a property from an object |
421 | 3b89cb1b | Hrvoje Ribicic | -> Int -- ^ Index in list to use |
422 | 3b89cb1b | Hrvoje Ribicic | -> FieldGetter Instance Runtime -- ^ Result |
423 | 3b89cb1b | Hrvoje Ribicic | getIndexedField extractor propertyGetter index = |
424 | 88b58ed6 | Hrvoje Ribicic | let optPropertyGetter = Just . propertyGetter |
425 | 3b89cb1b | Hrvoje Ribicic | in getIndexedOptionalField extractor optPropertyGetter index |
426 | 88b58ed6 | Hrvoje Ribicic | |
427 | 88b58ed6 | Hrvoje Ribicic | -- | Retrieves a value from an array at an index, using the Maybe monad to |
428 | 88b58ed6 | Hrvoje Ribicic | -- indicate failure. |
429 | 88b58ed6 | Hrvoje Ribicic | maybeAt :: Int -> [a] -> Maybe a |
430 | 88b58ed6 | Hrvoje Ribicic | maybeAt index list |
431 | 88b58ed6 | Hrvoje Ribicic | | index >= length list = Nothing |
432 | 88b58ed6 | Hrvoje Ribicic | | otherwise = Just $ list !! index |
433 | 88b58ed6 | Hrvoje Ribicic | |
434 | 88b58ed6 | Hrvoje Ribicic | -- | Primed with format strings for everything but the type, it consumes two |
435 | 88b58ed6 | Hrvoje Ribicic | -- values and uses them to complete the FieldDefinition. |
436 | 88b58ed6 | Hrvoje Ribicic | -- Warning: a bit unsafe as it uses printf. Handle with care. |
437 | 88b58ed6 | Hrvoje Ribicic | fieldDefinitionCompleter :: (PrintfArg t1) => (PrintfArg t2) |
438 | 88b58ed6 | Hrvoje Ribicic | => FieldName |
439 | 88b58ed6 | Hrvoje Ribicic | -> FieldTitle |
440 | 88b58ed6 | Hrvoje Ribicic | -> FieldType |
441 | 88b58ed6 | Hrvoje Ribicic | -> FieldDoc |
442 | 88b58ed6 | Hrvoje Ribicic | -> t1 |
443 | 88b58ed6 | Hrvoje Ribicic | -> t2 |
444 | 88b58ed6 | Hrvoje Ribicic | -> FieldDefinition |
445 | 88b58ed6 | Hrvoje Ribicic | fieldDefinitionCompleter fName fTitle fType fDoc firstVal secondVal = |
446 | 88b58ed6 | Hrvoje Ribicic | FieldDefinition (printf fName firstVal) |
447 | 88b58ed6 | Hrvoje Ribicic | (printf fTitle firstVal) |
448 | 88b58ed6 | Hrvoje Ribicic | fType |
449 | 88b58ed6 | Hrvoje Ribicic | (printf fDoc secondVal) |
450 | 88b58ed6 | Hrvoje Ribicic | |
451 | 88b58ed6 | Hrvoje Ribicic | -- | Given an incomplete field definition and values that can complete it, |
452 | 88b58ed6 | Hrvoje Ribicic | -- return a fully functional FieldData. Cannot work for all cases, should be |
453 | 88b58ed6 | Hrvoje Ribicic | -- extended as necessary. |
454 | 88b58ed6 | Hrvoje Ribicic | fillIncompleteFields :: (t1 -> t2 -> FieldDefinition, |
455 | 88b58ed6 | Hrvoje Ribicic | t1 -> FieldGetter a b, |
456 | 88b58ed6 | Hrvoje Ribicic | QffMode) |
457 | 88b58ed6 | Hrvoje Ribicic | -> t1 |
458 | 88b58ed6 | Hrvoje Ribicic | -> t2 |
459 | 88b58ed6 | Hrvoje Ribicic | -> FieldData a b |
460 | 88b58ed6 | Hrvoje Ribicic | fillIncompleteFields (iDef, iGet, mode) firstVal secondVal = |
461 | 88b58ed6 | Hrvoje Ribicic | (iDef firstVal secondVal, iGet firstVal, mode) |
462 | 88b58ed6 | Hrvoje Ribicic | |
463 | 3b89cb1b | Hrvoje Ribicic | -- | Given indexed fields that describe lists, complete / instantiate them for |
464 | 3b89cb1b | Hrvoje Ribicic | -- a given list size. |
465 | 3b89cb1b | Hrvoje Ribicic | instantiateIndexedFields :: (Show t1, Integral t1) |
466 | 3b89cb1b | Hrvoje Ribicic | => Int -- ^ The size of the list |
467 | 3b89cb1b | Hrvoje Ribicic | -> [(t1 -> String -> FieldDefinition, |
468 | 3b89cb1b | Hrvoje Ribicic | t1 -> FieldGetter a b, |
469 | 3b89cb1b | Hrvoje Ribicic | QffMode)] -- ^ The indexed fields |
470 | 3b89cb1b | Hrvoje Ribicic | -> FieldList a b -- ^ A list of complete fields |
471 | 3b89cb1b | Hrvoje Ribicic | instantiateIndexedFields listSize fields = do |
472 | 3b89cb1b | Hrvoje Ribicic | index <- take listSize [0..] |
473 | 3b89cb1b | Hrvoje Ribicic | field <- fields |
474 | 88b58ed6 | Hrvoje Ribicic | return . fillIncompleteFields field index . formatOrdinal $ index + 1 |
475 | 88b58ed6 | Hrvoje Ribicic | |
476 | 88b58ed6 | Hrvoje Ribicic | -- * Various helper functions for property retrieval |
477 | 88b58ed6 | Hrvoje Ribicic | |
478 | 9491766c | Hrvoje Ribicic | -- | Helper function for primary node retrieval |
479 | 9491766c | Hrvoje Ribicic | getPrimaryNode :: ConfigData -> Instance -> ErrorResult Node |
480 | 9491766c | Hrvoje Ribicic | getPrimaryNode cfg = getInstPrimaryNode cfg . instName |
481 | 9491766c | Hrvoje Ribicic | |
482 | 9491766c | Hrvoje Ribicic | -- | Get primary node hostname |
483 | 9491766c | Hrvoje Ribicic | getPrimaryNodeName :: ConfigData -> Instance -> ResultEntry |
484 | 9491766c | Hrvoje Ribicic | getPrimaryNodeName cfg inst = |
485 | 4e6f1cde | Hrvoje Ribicic | rsErrorNoData $ nodeName <$> getPrimaryNode cfg inst |
486 | 9491766c | Hrvoje Ribicic | |
487 | 1d3d454f | Hrvoje Ribicic | -- | Get primary node group |
488 | 1d3d454f | Hrvoje Ribicic | getPrimaryNodeGroup :: ConfigData -> Instance -> ErrorResult NodeGroup |
489 | 1d3d454f | Hrvoje Ribicic | getPrimaryNodeGroup cfg inst = do |
490 | 1d3d454f | Hrvoje Ribicic | pNode <- getPrimaryNode cfg inst |
491 | 1d3d454f | Hrvoje Ribicic | maybeToError "Configuration missing" $ getGroupOfNode cfg pNode |
492 | 1d3d454f | Hrvoje Ribicic | |
493 | 1d3d454f | Hrvoje Ribicic | -- | Get primary node group name |
494 | 1d3d454f | Hrvoje Ribicic | getPrimaryNodeGroupName :: ConfigData -> Instance -> ResultEntry |
495 | 1d3d454f | Hrvoje Ribicic | getPrimaryNodeGroupName cfg inst = |
496 | 1d3d454f | Hrvoje Ribicic | rsErrorNoData $ groupName <$> getPrimaryNodeGroup cfg inst |
497 | 1d3d454f | Hrvoje Ribicic | |
498 | 1d3d454f | Hrvoje Ribicic | -- | Get primary node group uuid |
499 | 1d3d454f | Hrvoje Ribicic | getPrimaryNodeGroupUuid :: ConfigData -> Instance -> ResultEntry |
500 | 1d3d454f | Hrvoje Ribicic | getPrimaryNodeGroupUuid cfg inst = |
501 | 1d3d454f | Hrvoje Ribicic | rsErrorNoData $ groupUuid <$> getPrimaryNodeGroup cfg inst |
502 | 9491766c | Hrvoje Ribicic | |
503 | 9491766c | Hrvoje Ribicic | -- | Get secondary nodes - the configuration objects themselves |
504 | 9491766c | Hrvoje Ribicic | getSecondaryNodes :: ConfigData -> Instance -> ErrorResult [Node] |
505 | 9491766c | Hrvoje Ribicic | getSecondaryNodes cfg inst = do |
506 | 9491766c | Hrvoje Ribicic | pNode <- getPrimaryNode cfg inst |
507 | 9491766c | Hrvoje Ribicic | allNodes <- getInstAllNodes cfg $ instName inst |
508 | 9491766c | Hrvoje Ribicic | return $ delete pNode allNodes |
509 | 9491766c | Hrvoje Ribicic | |
510 | 9491766c | Hrvoje Ribicic | -- | Get attributes of the secondary nodes |
511 | 9491766c | Hrvoje Ribicic | getSecondaryNodeAttribute :: (J.JSON a) |
512 | 9491766c | Hrvoje Ribicic | => (Node -> a) |
513 | 9491766c | Hrvoje Ribicic | -> ConfigData |
514 | 9491766c | Hrvoje Ribicic | -> Instance |
515 | 9491766c | Hrvoje Ribicic | -> ResultEntry |
516 | 9491766c | Hrvoje Ribicic | getSecondaryNodeAttribute getter cfg inst = |
517 | 9491766c | Hrvoje Ribicic | rsErrorNoData $ map (J.showJSON . getter) <$> getSecondaryNodes cfg inst |
518 | 9491766c | Hrvoje Ribicic | |
519 | 9491766c | Hrvoje Ribicic | -- | Get secondary node groups |
520 | 9491766c | Hrvoje Ribicic | getSecondaryNodeGroups :: ConfigData -> Instance -> ErrorResult [NodeGroup] |
521 | 9491766c | Hrvoje Ribicic | getSecondaryNodeGroups cfg inst = do |
522 | 9491766c | Hrvoje Ribicic | sNodes <- getSecondaryNodes cfg inst |
523 | 9491766c | Hrvoje Ribicic | return . catMaybes $ map (getGroupOfNode cfg) sNodes |
524 | 9491766c | Hrvoje Ribicic | |
525 | 9491766c | Hrvoje Ribicic | -- | Get attributes of secondary node groups |
526 | 9491766c | Hrvoje Ribicic | getSecondaryNodeGroupAttribute :: (J.JSON a) |
527 | 9491766c | Hrvoje Ribicic | => (NodeGroup -> a) |
528 | 9491766c | Hrvoje Ribicic | -> ConfigData |
529 | 9491766c | Hrvoje Ribicic | -> Instance |
530 | 9491766c | Hrvoje Ribicic | -> ResultEntry |
531 | 9491766c | Hrvoje Ribicic | getSecondaryNodeGroupAttribute getter cfg inst = |
532 | 9491766c | Hrvoje Ribicic | rsErrorNoData $ map (J.showJSON . getter) <$> getSecondaryNodeGroups cfg inst |
533 | 9491766c | Hrvoje Ribicic | |
534 | 4e6f1cde | Hrvoje Ribicic | -- | Beparam getter builder: given a field, it returns a FieldConfig |
535 | 4e6f1cde | Hrvoje Ribicic | -- getter, that is a function that takes the config and the object and |
536 | 4e6f1cde | Hrvoje Ribicic | -- returns the Beparam field specified when the getter was built. |
537 | 4e6f1cde | Hrvoje Ribicic | beParamGetter :: String -- ^ The field we are building the getter for |
538 | 4e6f1cde | Hrvoje Ribicic | -> ConfigData -- ^ The configuration object |
539 | 4e6f1cde | Hrvoje Ribicic | -> Instance -- ^ The instance configuration object |
540 | 4e6f1cde | Hrvoje Ribicic | -> ResultEntry -- ^ The result |
541 | 4e6f1cde | Hrvoje Ribicic | beParamGetter field config inst = |
542 | 4e6f1cde | Hrvoje Ribicic | case getFilledInstBeParams config inst of |
543 | 4e6f1cde | Hrvoje Ribicic | Ok beParams -> dictFieldGetter field $ Just beParams |
544 | 4e6f1cde | Hrvoje Ribicic | Bad _ -> rsNoData |
545 | 4e6f1cde | Hrvoje Ribicic | |
546 | 4e6f1cde | Hrvoje Ribicic | -- | Hvparam getter builder: given a field, it returns a FieldConfig |
547 | 4e6f1cde | Hrvoje Ribicic | -- getter, that is a function that takes the config and the object and |
548 | 4e6f1cde | Hrvoje Ribicic | -- returns the Hvparam field specified when the getter was built. |
549 | 4e6f1cde | Hrvoje Ribicic | hvParamGetter :: String -- ^ The field we're building the getter for |
550 | 4e6f1cde | Hrvoje Ribicic | -> ConfigData -> Instance -> ResultEntry |
551 | 4e6f1cde | Hrvoje Ribicic | hvParamGetter field cfg inst = |
552 | 4e6f1cde | Hrvoje Ribicic | rsMaybeUnavail . Map.lookup field . fromContainer $ |
553 | b9666288 | Hrvoje Ribicic | getFilledInstHvParams (C.toList C.hvcGlobals) cfg inst |
554 | 4e6f1cde | Hrvoje Ribicic | |
555 | df583eaf | Hrvoje Ribicic | -- * Live fields functionality |
556 | df583eaf | Hrvoje Ribicic | |
557 | df583eaf | Hrvoje Ribicic | -- | List of node live fields. |
558 | df583eaf | Hrvoje Ribicic | instanceLiveFieldsDefs :: [(FieldName, FieldTitle, FieldType, String, FieldDoc)] |
559 | df583eaf | Hrvoje Ribicic | instanceLiveFieldsDefs = |
560 | df583eaf | Hrvoje Ribicic | [ ("oper_ram", "Memory", QFTUnit, "oper_ram", |
561 | df583eaf | Hrvoje Ribicic | "Actual memory usage as seen by hypervisor") |
562 | df583eaf | Hrvoje Ribicic | , ("oper_vcpus", "VCPUs", QFTNumber, "oper_vcpus", |
563 | df583eaf | Hrvoje Ribicic | "Actual number of VCPUs as seen by hypervisor") |
564 | df583eaf | Hrvoje Ribicic | ] |
565 | df583eaf | Hrvoje Ribicic | |
566 | df583eaf | Hrvoje Ribicic | -- | Map each name to a function that extracts that value from the RPC result. |
567 | df583eaf | Hrvoje Ribicic | instanceLiveFieldExtract :: FieldName -> InstanceInfo -> Instance -> J.JSValue |
568 | df583eaf | Hrvoje Ribicic | instanceLiveFieldExtract "oper_ram" info _ = J.showJSON $ instInfoMemory info |
569 | df583eaf | Hrvoje Ribicic | instanceLiveFieldExtract "oper_vcpus" info _ = J.showJSON $ instInfoVcpus info |
570 | df583eaf | Hrvoje Ribicic | instanceLiveFieldExtract n _ _ = J.showJSON $ |
571 | df583eaf | Hrvoje Ribicic | "The field " ++ n ++ " is not an expected or extractable live field!" |
572 | df583eaf | Hrvoje Ribicic | |
573 | b9666288 | Hrvoje Ribicic | -- | Helper for extracting an instance live field from the RPC results. |
574 | df583eaf | Hrvoje Ribicic | instanceLiveRpcCall :: FieldName -> Runtime -> Instance -> ResultEntry |
575 | b9666288 | Hrvoje Ribicic | instanceLiveRpcCall fname (Right (Just (res, _), _)) inst = |
576 | df583eaf | Hrvoje Ribicic | case instanceLiveFieldExtract fname res inst of |
577 | df583eaf | Hrvoje Ribicic | J.JSNull -> rsNoData |
578 | df583eaf | Hrvoje Ribicic | x -> rsNormal x |
579 | b9666288 | Hrvoje Ribicic | instanceLiveRpcCall _ (Right (Nothing, _)) _ = rsUnavail |
580 | df583eaf | Hrvoje Ribicic | instanceLiveRpcCall _ (Left err) _ = |
581 | df583eaf | Hrvoje Ribicic | ResultEntry (rpcErrorToStatus err) Nothing |
582 | df583eaf | Hrvoje Ribicic | |
583 | df583eaf | Hrvoje Ribicic | -- | Builder for node live fields. |
584 | df583eaf | Hrvoje Ribicic | instanceLiveFieldBuilder :: (FieldName, FieldTitle, FieldType, String, FieldDoc) |
585 | 9491766c | Hrvoje Ribicic | -> FieldData Instance Runtime |
586 | df583eaf | Hrvoje Ribicic | instanceLiveFieldBuilder (fname, ftitle, ftype, _, fdoc) = |
587 | df583eaf | Hrvoje Ribicic | ( FieldDefinition fname ftitle ftype fdoc |
588 | df583eaf | Hrvoje Ribicic | , FieldRuntime $ instanceLiveRpcCall fname |
589 | df583eaf | Hrvoje Ribicic | , QffNormal) |
590 | df583eaf | Hrvoje Ribicic | |
591 | 9491766c | Hrvoje Ribicic | -- * Functionality related to status and operational status extraction |
592 | df583eaf | Hrvoje Ribicic | |
593 | df583eaf | Hrvoje Ribicic | -- | The documentation text for the instance status field |
594 | df583eaf | Hrvoje Ribicic | statusDocText :: String |
595 | df583eaf | Hrvoje Ribicic | statusDocText = |
596 | df583eaf | Hrvoje Ribicic | let si = show . instanceStatusToRaw :: InstanceStatus -> String |
597 | 9491766c | Hrvoje Ribicic | in "Instance status; " ++ |
598 | 9491766c | Hrvoje Ribicic | si Running ++ |
599 | 9491766c | Hrvoje Ribicic | " if instance is set to be running and actually is, " ++ |
600 | 9491766c | Hrvoje Ribicic | si StatusDown ++ |
601 | 9491766c | Hrvoje Ribicic | " if instance is stopped and is not running, " ++ |
602 | 9491766c | Hrvoje Ribicic | si WrongNode ++ |
603 | 9491766c | Hrvoje Ribicic | " if instance running, but not on its designated primary node, " ++ |
604 | 9491766c | Hrvoje Ribicic | si ErrorUp ++ |
605 | 9491766c | Hrvoje Ribicic | " if instance should be stopped, but is actually running, " ++ |
606 | 9491766c | Hrvoje Ribicic | si ErrorDown ++ |
607 | 9491766c | Hrvoje Ribicic | " if instance should run, but doesn't, " ++ |
608 | 9491766c | Hrvoje Ribicic | si NodeDown ++ |
609 | 9491766c | Hrvoje Ribicic | " if instance's primary node is down, " ++ |
610 | 9491766c | Hrvoje Ribicic | si NodeOffline ++ |
611 | 9491766c | Hrvoje Ribicic | " if instance's primary node is marked offline, " ++ |
612 | 9491766c | Hrvoje Ribicic | si StatusOffline ++ |
613 | 9491766c | Hrvoje Ribicic | " if instance is offline and does not use dynamic resources" |
614 | df583eaf | Hrvoje Ribicic | |
615 | df583eaf | Hrvoje Ribicic | -- | Checks if the primary node of an instance is offline |
616 | df583eaf | Hrvoje Ribicic | isPrimaryOffline :: ConfigData -> Instance -> Bool |
617 | df583eaf | Hrvoje Ribicic | isPrimaryOffline cfg inst = |
618 | 9491766c | Hrvoje Ribicic | let pNodeResult = getNode cfg $ instPrimaryNode inst |
619 | 9491766c | Hrvoje Ribicic | in case pNodeResult of |
620 | 9491766c | Hrvoje Ribicic | Ok pNode -> nodeOffline pNode |
621 | 9491766c | Hrvoje Ribicic | Bad _ -> error "Programmer error - result assumed to be OK is Bad!" |
622 | df583eaf | Hrvoje Ribicic | |
623 | df583eaf | Hrvoje Ribicic | -- | Determines the status of a live instance |
624 | b9666288 | Hrvoje Ribicic | liveInstanceStatus :: (InstanceInfo, Bool) -> Instance -> InstanceStatus |
625 | 55c87175 | Jose A. Lopes | liveInstanceStatus (instInfo, foundOnPrimary) inst |
626 | 55c87175 | Jose A. Lopes | | not foundOnPrimary = WrongNode |
627 | 55c87175 | Jose A. Lopes | | otherwise = |
628 | 55c87175 | Jose A. Lopes | case instanceState of |
629 | 55c87175 | Jose A. Lopes | InstanceStateRunning | adminState == AdminUp -> Running |
630 | 55c87175 | Jose A. Lopes | | otherwise -> ErrorUp |
631 | afa0fca4 | Jose A. Lopes | InstanceStateShutdown | adminState == AdminUp && allowDown -> UserDown |
632 | 55c87175 | Jose A. Lopes | | otherwise -> StatusDown |
633 | df583eaf | Hrvoje Ribicic | where adminState = instAdminState inst |
634 | 55c87175 | Jose A. Lopes | instanceState = instInfoState instInfo |
635 | df583eaf | Hrvoje Ribicic | |
636 | afa0fca4 | Jose A. Lopes | hvparams = fromContainer $ instHvparams inst |
637 | afa0fca4 | Jose A. Lopes | |
638 | afa0fca4 | Jose A. Lopes | allowDown = |
639 | afa0fca4 | Jose A. Lopes | instHypervisor inst /= Kvm || |
640 | afa0fca4 | Jose A. Lopes | (Map.member C.hvKvmUserShutdown hvparams && |
641 | afa0fca4 | Jose A. Lopes | hvparams Map.! C.hvKvmUserShutdown == J.JSBool True) |
642 | afa0fca4 | Jose A. Lopes | |
643 | df583eaf | Hrvoje Ribicic | -- | Determines the status of a dead instance. |
644 | df583eaf | Hrvoje Ribicic | deadInstanceStatus :: Instance -> InstanceStatus |
645 | df583eaf | Hrvoje Ribicic | deadInstanceStatus inst = |
646 | df583eaf | Hrvoje Ribicic | case instAdminState inst of |
647 | df583eaf | Hrvoje Ribicic | AdminUp -> ErrorDown |
648 | df583eaf | Hrvoje Ribicic | AdminDown -> StatusDown |
649 | df583eaf | Hrvoje Ribicic | AdminOffline -> StatusOffline |
650 | df583eaf | Hrvoje Ribicic | |
651 | df583eaf | Hrvoje Ribicic | -- | Determines the status of the instance, depending on whether it is possible |
652 | 9491766c | Hrvoje Ribicic | -- to communicate with its primary node, on which node it is, and its |
653 | 9491766c | Hrvoje Ribicic | -- configuration. |
654 | 9491766c | Hrvoje Ribicic | determineInstanceStatus :: ConfigData -- ^ The configuration data |
655 | 9491766c | Hrvoje Ribicic | -> Runtime -- ^ All the data from the live call |
656 | 9491766c | Hrvoje Ribicic | -> Instance -- ^ Static instance configuration |
657 | 9491766c | Hrvoje Ribicic | -> InstanceStatus -- ^ Result |
658 | 9491766c | Hrvoje Ribicic | determineInstanceStatus cfg res inst |
659 | 9491766c | Hrvoje Ribicic | | isPrimaryOffline cfg inst = NodeOffline |
660 | 9491766c | Hrvoje Ribicic | | otherwise = case res of |
661 | b9666288 | Hrvoje Ribicic | Left _ -> NodeDown |
662 | b9666288 | Hrvoje Ribicic | Right (Just liveData, _) -> liveInstanceStatus liveData inst |
663 | b9666288 | Hrvoje Ribicic | Right (Nothing, _) -> deadInstanceStatus inst |
664 | 9491766c | Hrvoje Ribicic | |
665 | 9491766c | Hrvoje Ribicic | -- | Extracts the instance status, retrieving it using the functions above and |
666 | 9491766c | Hrvoje Ribicic | -- transforming it into a 'ResultEntry'. |
667 | df583eaf | Hrvoje Ribicic | statusExtract :: ConfigData -> Runtime -> Instance -> ResultEntry |
668 | df583eaf | Hrvoje Ribicic | statusExtract cfg res inst = |
669 | df583eaf | Hrvoje Ribicic | rsNormal . J.showJSON . instanceStatusToRaw $ |
670 | df583eaf | Hrvoje Ribicic | determineInstanceStatus cfg res inst |
671 | df583eaf | Hrvoje Ribicic | |
672 | 9491766c | Hrvoje Ribicic | -- | Extracts the operational status of the instance. |
673 | df583eaf | Hrvoje Ribicic | operStatusExtract :: Runtime -> Instance -> ResultEntry |
674 | df583eaf | Hrvoje Ribicic | operStatusExtract res _ = |
675 | 9491766c | Hrvoje Ribicic | rsMaybeNoData $ J.showJSON <$> |
676 | 9491766c | Hrvoje Ribicic | case res of |
677 | b9666288 | Hrvoje Ribicic | Left _ -> Nothing |
678 | b9666288 | Hrvoje Ribicic | Right (x, _) -> Just $ isJust x |
679 | b9666288 | Hrvoje Ribicic | |
680 | b9666288 | Hrvoje Ribicic | -- | Extracts the console connection information |
681 | b9666288 | Hrvoje Ribicic | consoleExtract :: Runtime -> Instance -> ResultEntry |
682 | b9666288 | Hrvoje Ribicic | consoleExtract (Left err) _ = ResultEntry (rpcErrorToStatus err) Nothing |
683 | b9666288 | Hrvoje Ribicic | consoleExtract (Right (_, val)) _ = rsMaybeNoData val |
684 | df583eaf | Hrvoje Ribicic | |
685 | 9491766c | Hrvoje Ribicic | -- * Helper functions extracting information as necessary for the generic query |
686 | df583eaf | Hrvoje Ribicic | -- interfaces |
687 | df583eaf | Hrvoje Ribicic | |
688 | b9666288 | Hrvoje Ribicic | -- | This function checks if a node with a given uuid has experienced an error |
689 | b9666288 | Hrvoje Ribicic | -- or not. |
690 | b9666288 | Hrvoje Ribicic | checkForNodeError :: [(String, ERpcError a)] |
691 | b9666288 | Hrvoje Ribicic | -> String |
692 | b9666288 | Hrvoje Ribicic | -> Maybe RpcError |
693 | b9666288 | Hrvoje Ribicic | checkForNodeError uuidList uuid = |
694 | b9666288 | Hrvoje Ribicic | case snd <$> pickPairUnique uuid uuidList of |
695 | b9666288 | Hrvoje Ribicic | Just (Left err) -> Just err |
696 | b9666288 | Hrvoje Ribicic | Just (Right _) -> Nothing |
697 | b9666288 | Hrvoje Ribicic | Nothing -> Just . RpcResultError $ |
698 | b9666288 | Hrvoje Ribicic | "Node response not present" |
699 | b9666288 | Hrvoje Ribicic | |
700 | df583eaf | Hrvoje Ribicic | -- | Finds information about the instance in the info delivered by a node |
701 | b9666288 | Hrvoje Ribicic | findInfoInNodeResult :: Instance |
702 | b9666288 | Hrvoje Ribicic | -> ERpcError RpcResultAllInstancesInfo |
703 | b9666288 | Hrvoje Ribicic | -> Maybe InstanceInfo |
704 | b9666288 | Hrvoje Ribicic | findInfoInNodeResult inst nodeResponse = |
705 | df583eaf | Hrvoje Ribicic | case nodeResponse of |
706 | df583eaf | Hrvoje Ribicic | Left _err -> Nothing |
707 | df583eaf | Hrvoje Ribicic | Right allInfo -> |
708 | df583eaf | Hrvoje Ribicic | let instances = rpcResAllInstInfoInstances allInfo |
709 | df583eaf | Hrvoje Ribicic | maybeMatch = pickPairUnique (instName inst) instances |
710 | df583eaf | Hrvoje Ribicic | in snd <$> maybeMatch |
711 | df583eaf | Hrvoje Ribicic | |
712 | df583eaf | Hrvoje Ribicic | -- | Retrieves the instance information if it is present anywhere in the all |
713 | df583eaf | Hrvoje Ribicic | -- instances RPC result. Notes if it originates from the primary node. |
714 | b9666288 | Hrvoje Ribicic | -- An error is delivered if there is no result, and the primary node is down. |
715 | b9666288 | Hrvoje Ribicic | getInstanceInfo :: [(String, ERpcError RpcResultAllInstancesInfo)] |
716 | b9666288 | Hrvoje Ribicic | -> Instance |
717 | b9666288 | Hrvoje Ribicic | -> ERpcError (Maybe (InstanceInfo, Bool)) |
718 | b9666288 | Hrvoje Ribicic | getInstanceInfo uuidList inst = |
719 | b9666288 | Hrvoje Ribicic | let pNodeUuid = instPrimaryNode inst |
720 | b9666288 | Hrvoje Ribicic | primarySearchResult = |
721 | b9666288 | Hrvoje Ribicic | pickPairUnique pNodeUuid uuidList >>= findInfoInNodeResult inst . snd |
722 | df583eaf | Hrvoje Ribicic | in case primarySearchResult of |
723 | b9666288 | Hrvoje Ribicic | Just instInfo -> Right . Just $ (instInfo, True) |
724 | df583eaf | Hrvoje Ribicic | Nothing -> |
725 | df583eaf | Hrvoje Ribicic | let allSearchResult = |
726 | df583eaf | Hrvoje Ribicic | getFirst . mconcat $ map |
727 | b9666288 | Hrvoje Ribicic | (First . findInfoInNodeResult inst . snd) uuidList |
728 | df583eaf | Hrvoje Ribicic | in case allSearchResult of |
729 | b9666288 | Hrvoje Ribicic | Just instInfo -> Right . Just $ (instInfo, False) |
730 | b9666288 | Hrvoje Ribicic | Nothing -> |
731 | b9666288 | Hrvoje Ribicic | case checkForNodeError uuidList pNodeUuid of |
732 | b9666288 | Hrvoje Ribicic | Just err -> Left err |
733 | b9666288 | Hrvoje Ribicic | Nothing -> Right Nothing |
734 | b9666288 | Hrvoje Ribicic | |
735 | b9666288 | Hrvoje Ribicic | -- | Retrieves the console information if present anywhere in the given results |
736 | b9666288 | Hrvoje Ribicic | getConsoleInfo :: [(String, ERpcError RpcResultInstanceConsoleInfo)] |
737 | b9666288 | Hrvoje Ribicic | -> Instance |
738 | b9666288 | Hrvoje Ribicic | -> Maybe InstanceConsoleInfo |
739 | b9666288 | Hrvoje Ribicic | getConsoleInfo uuidList inst = |
740 | b9666288 | Hrvoje Ribicic | let allValidResults = concatMap rpcResInstConsInfoInstancesInfo . |
741 | b9666288 | Hrvoje Ribicic | rights . map snd $ uuidList |
742 | b9666288 | Hrvoje Ribicic | in snd <$> pickPairUnique (instName inst) allValidResults |
743 | b9666288 | Hrvoje Ribicic | |
744 | b9666288 | Hrvoje Ribicic | -- | Extracts all the live information that can be extracted. |
745 | b9666288 | Hrvoje Ribicic | extractLiveInfo :: [(Node, ERpcError RpcResultAllInstancesInfo)] |
746 | b9666288 | Hrvoje Ribicic | -> [(Node, ERpcError RpcResultInstanceConsoleInfo)] |
747 | b9666288 | Hrvoje Ribicic | -> Instance |
748 | b9666288 | Hrvoje Ribicic | -> Runtime |
749 | b9666288 | Hrvoje Ribicic | extractLiveInfo nodeResultList nodeConsoleList inst = |
750 | b9666288 | Hrvoje Ribicic | let uuidConvert = map (\(x, y) -> (nodeUuid x, y)) |
751 | b9666288 | Hrvoje Ribicic | uuidResultList = uuidConvert nodeResultList |
752 | b9666288 | Hrvoje Ribicic | uuidConsoleList = uuidConvert nodeConsoleList |
753 | b9666288 | Hrvoje Ribicic | in case getInstanceInfo uuidResultList inst of |
754 | b9666288 | Hrvoje Ribicic | -- If we can't get the instance info, we can't get the console info either. |
755 | b9666288 | Hrvoje Ribicic | -- Best to propagate the error further. |
756 | b9666288 | Hrvoje Ribicic | Left err -> Left err |
757 | b9666288 | Hrvoje Ribicic | Right res -> Right (res, getConsoleInfo uuidConsoleList inst) |
758 | b9666288 | Hrvoje Ribicic | |
759 | b9666288 | Hrvoje Ribicic | -- | Retrieves all the parameters for the console calls. |
760 | b9666288 | Hrvoje Ribicic | getAllConsoleParams :: ConfigData |
761 | b9666288 | Hrvoje Ribicic | -> [Instance] |
762 | b9666288 | Hrvoje Ribicic | -> ErrorResult [InstanceConsoleInfoParams] |
763 | 46cc1ab4 | Hrvoje Ribicic | getAllConsoleParams cfg = mapM $ \i -> |
764 | 46cc1ab4 | Hrvoje Ribicic | InstanceConsoleInfoParams i |
765 | 46cc1ab4 | Hrvoje Ribicic | <$> getPrimaryNode cfg i |
766 | 0808e9d5 | Petr Pudlak | <*> getPrimaryNodeGroup cfg i |
767 | 46cc1ab4 | Hrvoje Ribicic | <*> pure (getFilledInstHvParams [] cfg i) |
768 | 46cc1ab4 | Hrvoje Ribicic | <*> getFilledInstBeParams cfg i |
769 | b9666288 | Hrvoje Ribicic | |
770 | b9666288 | Hrvoje Ribicic | -- | Compares two params according to their node, needed for grouping. |
771 | b9666288 | Hrvoje Ribicic | compareParamsByNode :: InstanceConsoleInfoParams |
772 | b9666288 | Hrvoje Ribicic | -> InstanceConsoleInfoParams |
773 | b9666288 | Hrvoje Ribicic | -> Bool |
774 | b9666288 | Hrvoje Ribicic | compareParamsByNode x y = instConsInfoParamsNode x == instConsInfoParamsNode y |
775 | b9666288 | Hrvoje Ribicic | |
776 | b9666288 | Hrvoje Ribicic | -- | Groups instance information calls heading out to the same nodes. |
777 | b9666288 | Hrvoje Ribicic | consoleParamsToCalls :: [InstanceConsoleInfoParams] |
778 | b9666288 | Hrvoje Ribicic | -> [(Node, RpcCallInstanceConsoleInfo)] |
779 | b9666288 | Hrvoje Ribicic | consoleParamsToCalls params = |
780 | b9666288 | Hrvoje Ribicic | let sortedParams = sortBy |
781 | b9666288 | Hrvoje Ribicic | (comparing (instPrimaryNode . instConsInfoParamsInstance)) params |
782 | b9666288 | Hrvoje Ribicic | groupedParams = groupBy compareParamsByNode sortedParams |
783 | b9666288 | Hrvoje Ribicic | in map (\x -> case x of |
784 | b9666288 | Hrvoje Ribicic | [] -> error "Programmer error: group must have one or more members" |
785 | b9666288 | Hrvoje Ribicic | paramGroup@(y:_) -> |
786 | b9666288 | Hrvoje Ribicic | let node = instConsInfoParamsNode y |
787 | b9666288 | Hrvoje Ribicic | packer z = (instName $ instConsInfoParamsInstance z, z) |
788 | b9666288 | Hrvoje Ribicic | in (node, RpcCallInstanceConsoleInfo . map packer $ paramGroup) |
789 | b9666288 | Hrvoje Ribicic | ) groupedParams |
790 | b9666288 | Hrvoje Ribicic | |
791 | b9666288 | Hrvoje Ribicic | -- | Retrieves a list of all the hypervisors and params used by the given |
792 | b9666288 | Hrvoje Ribicic | -- instances. |
793 | b9666288 | Hrvoje Ribicic | getHypervisorSpecs :: ConfigData -> [Instance] -> [(Hypervisor, HvParams)] |
794 | b9666288 | Hrvoje Ribicic | getHypervisorSpecs cfg instances = |
795 | b9666288 | Hrvoje Ribicic | let hvs = nub . map instHypervisor $ instances |
796 | b9666288 | Hrvoje Ribicic | hvParamMap = (fromContainer . clusterHvparams . configCluster $ cfg) |
797 | b9666288 | Hrvoje Ribicic | in zip hvs . map ((Map.!) hvParamMap . hypervisorToRaw) $ hvs |
798 | 1df0266e | Hrvoje Ribicic | |
799 | df583eaf | Hrvoje Ribicic | -- | Collect live data from RPC query if enabled. |
800 | ee8bb326 | Hrvoje Ribicic | collectLiveData :: Bool -- ^ Live queries allowed |
801 | ee8bb326 | Hrvoje Ribicic | -> ConfigData -- ^ The cluster config |
802 | ee8bb326 | Hrvoje Ribicic | -> [String] -- ^ The requested fields |
803 | ee8bb326 | Hrvoje Ribicic | -> [Instance] -- ^ The instance objects |
804 | ee8bb326 | Hrvoje Ribicic | -> IO [(Instance, Runtime)] |
805 | ee8bb326 | Hrvoje Ribicic | collectLiveData liveDataEnabled cfg fields instances |
806 | df583eaf | Hrvoje Ribicic | | not liveDataEnabled = return . zip instances . repeat . Left . |
807 | df583eaf | Hrvoje Ribicic | RpcResultError $ "Live data disabled" |
808 | df583eaf | Hrvoje Ribicic | | otherwise = do |
809 | b9666288 | Hrvoje Ribicic | let hvSpecs = getHypervisorSpecs cfg instances |
810 | b9666288 | Hrvoje Ribicic | instanceNodes = nub . justOk $ |
811 | b9666288 | Hrvoje Ribicic | map (getNode cfg . instPrimaryNode) instances |
812 | b9666288 | Hrvoje Ribicic | goodNodes = nodesWithValidConfig cfg instanceNodes |
813 | b9666288 | Hrvoje Ribicic | instInfoRes <- executeRpcCall goodNodes (RpcCallAllInstancesInfo hvSpecs) |
814 | ee8bb326 | Hrvoje Ribicic | consInfoRes <- |
815 | ee8bb326 | Hrvoje Ribicic | if "console" `elem` fields |
816 | ee8bb326 | Hrvoje Ribicic | then case getAllConsoleParams cfg instances of |
817 | ee8bb326 | Hrvoje Ribicic | Ok p -> executeRpcCalls $ consoleParamsToCalls p |
818 | ee8bb326 | Hrvoje Ribicic | Bad _ -> return . zip goodNodes . repeat . Left $ |
819 | ee8bb326 | Hrvoje Ribicic | RpcResultError "Cannot construct parameters for console info call" |
820 | ee8bb326 | Hrvoje Ribicic | else return [] -- The information is not necessary |
821 | b9666288 | Hrvoje Ribicic | return . zip instances . |
822 | b9666288 | Hrvoje Ribicic | map (extractLiveInfo instInfoRes consInfoRes) $ instances |