Revision a861d322 src/Ganeti/Query/Instance.hs

b/src/Ganeti/Query/Instance.hs
140 140
  [ (FieldDefinition "disk_usage" "DiskUsage" QFTUnit
141 141
     "Total disk space used by instance on each of its nodes; this is not the\
142 142
     \ disk size visible to the instance, but the usage on the node",
143
     FieldSimple (rsNormal . getDiskSizeRequirements), QffNormal),
144

  
145
    (FieldDefinition "disk.count" "Disks" QFTNumber
143
     FieldSimple (rsNormal . getDiskSizeRequirements), QffNormal)
144
  , (FieldDefinition "disk.count" "Disks" QFTNumber
146 145
     "Number of disks",
147
     FieldSimple (rsNormal . length . instDisks), QffNormal),
148

  
149
    (FieldDefinition "disk.sizes" "Disk_sizes" QFTOther
146
     FieldSimple (rsNormal . length . instDisks), QffNormal)
147
  , (FieldDefinition "disk.sizes" "Disk_sizes" QFTOther
150 148
     "List of disk sizes",
151
     FieldSimple (rsNormal . map diskSize . instDisks), QffNormal),
152

  
153
    (FieldDefinition "disk.spindles" "Disk_spindles" QFTOther
149
     FieldSimple (rsNormal . map diskSize . instDisks), QffNormal)
150
  , (FieldDefinition "disk.spindles" "Disk_spindles" QFTOther
154 151
     "List of disk spindles",
155 152
     FieldSimple (rsNormal . map (MaybeForJSON . diskSpindles) .
156 153
                  instDisks),
157
     QffNormal),
158

  
159
    (FieldDefinition "disk.names" "Disk_names" QFTOther
154
     QffNormal)
155
  , (FieldDefinition "disk.names" "Disk_names" QFTOther
160 156
     "List of disk names",
161 157
     FieldSimple (rsNormal . map (MaybeForJSON . diskName) .
162 158
                  instDisks),
163
     QffNormal),
164

  
165
    (FieldDefinition "disk.uuids" "Disk_UUIDs" QFTOther
159
     QffNormal)
160
  , (FieldDefinition "disk.uuids" "Disk_UUIDs" QFTOther
166 161
     "List of disk UUIDs",
167 162
     FieldSimple (rsNormal . map diskUuid . instDisks), QffNormal)
168 163
  ] ++
......
171 166
  fillNumberFields C.maxDisks
172 167
  [ (fieldDefinitionCompleter "disk.size/%d" "Disk/%d" QFTUnit
173 168
     "Disk size of %s disk",
174
     getFillableField instDisks diskSize, QffNormal),
175

  
176
    (fieldDefinitionCompleter "disk.spindles/%d" "DiskSpindles/%d" QFTNumber
169
     getFillableField instDisks diskSize, QffNormal)
170
  , (fieldDefinitionCompleter "disk.spindles/%d" "DiskSpindles/%d" QFTNumber
177 171
     "Spindles of %s disk",
178
     getFillableOptionalField instDisks diskSpindles, QffNormal),
179

  
180
    (fieldDefinitionCompleter "disk.name/%d" "DiskName/%d" QFTText
172
     getFillableOptionalField instDisks diskSpindles, QffNormal)
173
  , (fieldDefinitionCompleter "disk.name/%d" "DiskName/%d" QFTText
181 174
     "Name of %s disk",
182
     getFillableOptionalField instDisks diskName, QffNormal),
183

  
184
    (fieldDefinitionCompleter "disk.uuid/%d" "DiskUUID/%d" QFTText
175
     getFillableOptionalField instDisks diskName, QffNormal)
176
  , (fieldDefinitionCompleter "disk.uuid/%d" "DiskUUID/%d" QFTText
185 177
     "UUID of %s disk",
186 178
     getFillableField instDisks diskUuid, QffNormal)
187 179
  ] ++
188 180

  
181
  -- Aggregate nic parameter fields
182
  [ (FieldDefinition "nic.count" "NICs" QFTNumber
183
     "Number of network interfaces",
184
     FieldSimple (rsNormal . length . instNics), QffNormal)
185
  , (FieldDefinition "nic.macs" "NIC_MACs" QFTOther
186
     (nicAggDescPrefix ++ "MAC address"),
187
     FieldSimple (rsNormal . map nicMac . instNics), QffNormal)
188
  , (FieldDefinition "nic.ips" "NIC_IPs" QFTOther
189
     (nicAggDescPrefix ++ "IP address"),
190
     FieldSimple (rsNormal . map (MaybeForJSON . nicIp) . instNics),
191
     QffNormal)
192
  , (FieldDefinition "nic.names" "NIC_Names" QFTOther
193
     (nicAggDescPrefix ++ "name"),
194
     FieldSimple (rsNormal . map (MaybeForJSON . nicName) . instNics),
195
     QffNormal)
196
  , (FieldDefinition "nic.uuids" "NIC_UUIDs" QFTOther
197
     (nicAggDescPrefix ++ "UUID"),
198
     FieldSimple (rsNormal . map nicUuid . instNics), QffNormal)
199
  , (FieldDefinition "nic.modes" "NIC_modes" QFTOther
200
     (nicAggDescPrefix ++ "mode"),
201
     FieldConfig (\cfg -> rsNormal . map
202
       (nicpMode . fillNicParamsFromConfig cfg . nicNicparams)
203
       . instNics),
204
     QffNormal)
205
  , (FieldDefinition "nic.bridges" "NIC_bridges" QFTOther
206
     (nicAggDescPrefix ++ "bridge"),
207
     FieldConfig (\cfg -> rsNormal . map (MaybeForJSON . getNicBridge .
208
       fillNicParamsFromConfig cfg . nicNicparams) . instNics),
209
     QffNormal)
210
  , (FieldDefinition "nic.links" "NIC_links" QFTOther
211
     (nicAggDescPrefix ++ "link"),
212
     FieldConfig (\cfg -> rsNormal . map
213
       (nicpLink . fillNicParamsFromConfig cfg . nicNicparams)
214
       . instNics),
215
     QffNormal)
216
  , (FieldDefinition "nic.networks" "NIC_networks" QFTOther
217
     "List containing each interface's network",
218
     FieldSimple (rsNormal . map (MaybeForJSON . nicNetwork) . instNics),
219
     QffNormal)
220
  , (FieldDefinition "nic.networks.names" "NIC_networks_names" QFTOther
221
     "List containing the name of each interface's network",
222
     FieldConfig (\cfg -> rsNormal . map
223
       (\x -> MaybeForJSON (getNetworkName cfg <$> nicNetwork x))
224
       . instNics),
225
     QffNormal)
226
  ] ++
227

  
228
  -- Per-nic parameter fields
229
  fillNumberFields C.maxNics
230
  [ (fieldDefinitionCompleter "nic.ip/%d" "NicIP/%d" QFTText
231
     ("IP address" ++ nicDescSuffix),
232
     getFillableOptionalField instNics nicIp, QffNormal)
233
  , (fieldDefinitionCompleter "nic.uuid/%d" "NicUUID/%d" QFTText
234
     ("UUID address" ++ nicDescSuffix),
235
     getFillableField instNics nicUuid, QffNormal)
236
  , (fieldDefinitionCompleter "nic.mac/%d" "NicMAC/%d" QFTText
237
     ("MAC address" ++ nicDescSuffix),
238
     getFillableField instNics nicMac, QffNormal)
239
  , (fieldDefinitionCompleter "nic.name/%d" "NicName/%d" QFTText
240
     ("Name address" ++ nicDescSuffix),
241
     getFillableOptionalField instNics nicName, QffNormal)
242
  , (fieldDefinitionCompleter "nic.network/%d" "NicNetwork/%d" QFTText
243
     ("Network" ++ nicDescSuffix),
244
     getFillableOptionalField instNics nicNetwork, QffNormal)
245
  , (fieldDefinitionCompleter "nic.mode/%d" "NicMode/%d" QFTText
246
     ("Mode" ++ nicDescSuffix),
247
     getFillableNicField nicpMode, QffNormal)
248
  , (fieldDefinitionCompleter "nic.link/%d" "NicLink/%d" QFTText
249
     ("Link" ++ nicDescSuffix),
250
     getFillableNicField nicpLink, QffNormal)
251
  , (fieldDefinitionCompleter "nic.network.name/%d" "NicNetworkName/%d" QFTText
252
     ("Network name" ++ nicDescSuffix),
253
     getFillableNicNetworkNameField, QffNormal)
254
  , (fieldDefinitionCompleter "nic.bridge/%d" "NicBridge/%d" QFTText
255
     ("Bridge" ++ nicDescSuffix),
256
     getOptionalFillableNicField getNicBridge, QffNormal)
257
  ] ++
258

  
189 259
  -- Live fields using special getters
190 260
  [ (FieldDefinition "status" "Status" QFTText
191 261
     statusDocText,
......
205 275

  
206 276
-- * Helper functions for node property retrieval
207 277

  
208
-- | Creates a function which produces a FieldGetter when fed an index. Works
278
-- | Constant suffix of network interface field descriptions.
279
nicDescSuffix ::String
280
nicDescSuffix = " of %s network interface"
281

  
282
-- | Almost-constant suffix of aggregate network interface field descriptions.
283
nicAggDescPrefix ::String
284
nicAggDescPrefix = "List containing each network interface's "
285

  
286
-- | Given a network name id, returns the network's name.
287
getNetworkName :: ConfigData -> String -> NonEmptyString
288
getNetworkName cfg = networkName . (Map.!) (fromContainer $ configNetworks cfg)
289

  
290
-- | Gets the bridge of a NIC.
291
getNicBridge :: FilledNicParams -> Maybe String
292
getNicBridge nicParams
293
  | nicpMode nicParams == NMBridged = Just $ nicpLink nicParams
294
  | otherwise                       = Nothing
295

  
296
-- | Fill partial NIC params by using the defaults from the configuration.
297
fillNicParamsFromConfig :: ConfigData -> PartialNicParams -> FilledNicParams
298
fillNicParamsFromConfig cfg = fillNicParams (getDefaultNicParams cfg)
299

  
300
-- | Retrieves the default network interface parameters.
301
getDefaultNicParams :: ConfigData -> FilledNicParams
302
getDefaultNicParams cfg =
303
  (Map.!) (fromContainer . clusterNicparams . configCluster $ cfg) C.ppDefault
304

  
305
-- | Returns a field that retrieves a given NIC's network name.
306
getFillableNicNetworkNameField :: Int -> FieldGetter Instance Runtime
307
getFillableNicNetworkNameField index =
308
  FieldConfig (\cfg inst -> rsMaybeUnavail $ do
309
    nicObj <- maybeAt index $ instNics inst
310
    nicNetworkId <- nicNetwork nicObj
311
    return $ getNetworkName cfg nicNetworkId)
312

  
313
-- | Gets a fillable NIC field.
314
getFillableNicField :: (J.JSON a)
315
                    => (FilledNicParams -> a)
316
                    -> Int
317
                    -> FieldGetter Instance Runtime
318
getFillableNicField getter =
319
  getOptionalFillableNicField (\x -> Just . getter $ x)
320

  
321
-- | Gets an optional fillable NIC field.
322
getOptionalFillableNicField :: (J.JSON a)
323
                            => (FilledNicParams -> Maybe a)
324
                            -> Int
325
                            -> FieldGetter Instance Runtime
326
getOptionalFillableNicField =
327
  getFillableFieldWithDefault
328
    (map nicNicparams . instNics) (\x _ -> getDefaultNicParams x) fillNicParams
329

  
330
-- | Creates a function which produces a 'FieldGetter' when fed an index. Works
331
-- for fields that should be filled out through the use of a default.
332
getFillableFieldWithDefault :: (J.JSON c)
333
  => (Instance -> [a])             -- ^ Extracts a list of incomplete objects
334
  -> (ConfigData -> Instance -> b) -- ^ Extracts the default object
335
  -> (b -> a -> b)                 -- ^ Fills the default object
336
  -> (b -> Maybe c)                -- ^ Extracts an obj property
337
  -> Int                           -- ^ Index in list to use
338
  -> FieldGetter Instance Runtime  -- ^ Result
339
getFillableFieldWithDefault
340
  listGetter defaultGetter fillFn propertyGetter index =
341
  FieldConfig (\cfg inst -> rsMaybeUnavail $ do
342
                              incompleteObj <- maybeAt index $ listGetter inst
343
                              let defaultObj = defaultGetter cfg inst
344
                                  completeObj = fillFn defaultObj incompleteObj
345
                              propertyGetter completeObj)
346

  
347
-- | Creates a function which produces a 'FieldGetter' when fed an index. Works
209 348
-- for fields that may not return a value, expressed through the Maybe monad.
210 349
getFillableOptionalField :: (J.JSON b)
211 350
                         => (Instance -> [a]) -- ^ Extracts a list of objects
......
218 357
                         obj <- maybeAt index $ extractor inst
219 358
                         optPropertyGetter obj)
220 359

  
221
-- | Creates a function which produces a FieldGetter when fed an index.
360
-- | Creates a function which produces a 'FieldGetter' when fed an index.
222 361
-- Works only for fields that surely return a value.
223 362
getFillableField :: (J.JSON b)
224
                    => (Instance -> [a]) -- ^ Extracts a list of objects
225
                    -> (a -> b)          -- ^ Gets a property from an object
226
                    -> Int               -- ^ Index in list to use
227
                    -> FieldGetter Instance Runtime -- ^ Result
363
                 => (Instance -> [a]) -- ^ Extracts a list of objects
364
                 -> (a -> b)          -- ^ Gets a property from an object
365
                 -> Int               -- ^ Index in list to use
366
                 -> FieldGetter Instance Runtime -- ^ Result
228 367
getFillableField extractor propertyGetter index =
229 368
  let optPropertyGetter = Just . propertyGetter
230 369
  in getFillableOptionalField extractor optPropertyGetter index

Also available in: Unified diff