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