Revision 88b58ed6 src/Ganeti/Query/Instance.hs
b/src/Ganeti/Query/Instance.hs | ||
---|---|---|
35 | 35 |
import Data.Monoid |
36 | 36 |
import qualified Data.Map as Map |
37 | 37 |
import qualified Text.JSON as J |
38 |
import Text.Printf |
|
38 | 39 |
|
39 | 40 |
import Ganeti.BasicTypes |
40 | 41 |
import Ganeti.Common |
... | ... | |
50 | 51 |
import Ganeti.Rpc |
51 | 52 |
import Ganeti.Storage.Utils |
52 | 53 |
import Ganeti.Types |
54 |
import Ganeti.Utils (formatOrdinal) |
|
53 | 55 |
|
54 | 56 |
-- | The LiveInfo structure packs additional information beside the |
55 | 57 |
-- 'InstanceInfo'. We also need to know whether the instance information was |
... | ... | |
134 | 136 |
map (buildBeParamField beParamGetter) allBeParamFields ++ |
135 | 137 |
map (buildHvParamField hvParamGetter) (C.toList C.hvsParameters) ++ |
136 | 138 |
|
139 |
-- Aggregate disk parameter fields |
|
140 |
[ (FieldDefinition "disk_usage" "DiskUsage" QFTUnit |
|
141 |
"Total disk space used by instance on each of its nodes; this is not the\ |
|
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 |
|
146 |
"Number of disks", |
|
147 |
FieldSimple (rsNormal . length . instDisks), QffNormal), |
|
148 |
|
|
149 |
(FieldDefinition "disk.sizes" "Disk_sizes" QFTOther |
|
150 |
"List of disk sizes", |
|
151 |
FieldSimple (rsNormal . map diskSize . instDisks), QffNormal), |
|
152 |
|
|
153 |
(FieldDefinition "disk.spindles" "Disk_spindles" QFTOther |
|
154 |
"List of disk spindles", |
|
155 |
FieldSimple (rsNormal . map (MaybeForJSON . diskSpindles) . |
|
156 |
instDisks), |
|
157 |
QffNormal), |
|
158 |
|
|
159 |
(FieldDefinition "disk.names" "Disk_names" QFTOther |
|
160 |
"List of disk names", |
|
161 |
FieldSimple (rsNormal . map (MaybeForJSON . diskName) . |
|
162 |
instDisks), |
|
163 |
QffNormal), |
|
164 |
|
|
165 |
(FieldDefinition "disk.uuids" "Disk_UUIDs" QFTOther |
|
166 |
"List of disk UUIDs", |
|
167 |
FieldSimple (rsNormal . map diskUuid . instDisks), QffNormal) |
|
168 |
] ++ |
|
169 |
|
|
170 |
-- Per-disk parameter fields |
|
171 |
fillNumberFields C.maxDisks |
|
172 |
[ (fieldDefinitionCompleter "disk.size/%d" "Disk/%d" QFTUnit |
|
173 |
"Disk size of %s disk", |
|
174 |
getFillableField instDisks diskSize, QffNormal), |
|
175 |
|
|
176 |
(fieldDefinitionCompleter "disk.spindles/%d" "DiskSpindles/%d" QFTNumber |
|
177 |
"Spindles of %s disk", |
|
178 |
getFillableOptionalField instDisks diskSpindles, QffNormal), |
|
179 |
|
|
180 |
(fieldDefinitionCompleter "disk.name/%d" "DiskName/%d" QFTText |
|
181 |
"Name of %s disk", |
|
182 |
getFillableOptionalField instDisks diskName, QffNormal), |
|
183 |
|
|
184 |
(fieldDefinitionCompleter "disk.uuid/%d" "DiskUUID/%d" QFTText |
|
185 |
"UUID of %s disk", |
|
186 |
getFillableField instDisks diskUuid, QffNormal) |
|
187 |
] ++ |
|
188 |
|
|
137 | 189 |
-- Live fields using special getters |
138 | 190 |
[ (FieldDefinition "status" "Status" QFTText |
139 | 191 |
statusDocText, |
... | ... | |
153 | 205 |
|
154 | 206 |
-- * Helper functions for node property retrieval |
155 | 207 |
|
208 |
-- | Creates a function which produces a FieldGetter when fed an index. Works |
|
209 |
-- for fields that may not return a value, expressed through the Maybe monad. |
|
210 |
getFillableOptionalField :: (J.JSON b) |
|
211 |
=> (Instance -> [a]) -- ^ Extracts a list of objects |
|
212 |
-> (a -> Maybe b) -- ^ Possibly gets a property |
|
213 |
-- from an object |
|
214 |
-> Int -- ^ Index in list to use |
|
215 |
-> FieldGetter Instance Runtime -- ^ Result |
|
216 |
getFillableOptionalField extractor optPropertyGetter index = |
|
217 |
FieldSimple(\inst -> rsMaybeUnavail $ do |
|
218 |
obj <- maybeAt index $ extractor inst |
|
219 |
optPropertyGetter obj) |
|
220 |
|
|
221 |
-- | Creates a function which produces a FieldGetter when fed an index. |
|
222 |
-- Works only for fields that surely return a value. |
|
223 |
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 |
|
228 |
getFillableField extractor propertyGetter index = |
|
229 |
let optPropertyGetter = Just . propertyGetter |
|
230 |
in getFillableOptionalField extractor optPropertyGetter index |
|
231 |
|
|
232 |
-- | Retrieves a value from an array at an index, using the Maybe monad to |
|
233 |
-- indicate failure. |
|
234 |
maybeAt :: Int -> [a] -> Maybe a |
|
235 |
maybeAt index list |
|
236 |
| index >= length list = Nothing |
|
237 |
| otherwise = Just $ list !! index |
|
238 |
|
|
239 |
-- | Primed with format strings for everything but the type, it consumes two |
|
240 |
-- values and uses them to complete the FieldDefinition. |
|
241 |
-- Warning: a bit unsafe as it uses printf. Handle with care. |
|
242 |
fieldDefinitionCompleter :: (PrintfArg t1) => (PrintfArg t2) |
|
243 |
=> FieldName |
|
244 |
-> FieldTitle |
|
245 |
-> FieldType |
|
246 |
-> FieldDoc |
|
247 |
-> t1 |
|
248 |
-> t2 |
|
249 |
-> FieldDefinition |
|
250 |
fieldDefinitionCompleter fName fTitle fType fDoc firstVal secondVal = |
|
251 |
FieldDefinition (printf fName firstVal) |
|
252 |
(printf fTitle firstVal) |
|
253 |
fType |
|
254 |
(printf fDoc secondVal) |
|
255 |
|
|
256 |
-- | Given an incomplete field definition and values that can complete it, |
|
257 |
-- return a fully functional FieldData. Cannot work for all cases, should be |
|
258 |
-- extended as necessary. |
|
259 |
fillIncompleteFields :: (t1 -> t2 -> FieldDefinition, |
|
260 |
t1 -> FieldGetter a b, |
|
261 |
QffMode) |
|
262 |
-> t1 |
|
263 |
-> t2 |
|
264 |
-> FieldData a b |
|
265 |
fillIncompleteFields (iDef, iGet, mode) firstVal secondVal = |
|
266 |
(iDef firstVal secondVal, iGet firstVal, mode) |
|
267 |
|
|
268 |
-- | Given fields that describe lists, fill their definitions with appropriate |
|
269 |
-- index representations. |
|
270 |
fillNumberFields :: (Integral t1) |
|
271 |
=> Int |
|
272 |
-> [(t1 -> String -> FieldDefinition, |
|
273 |
t1 -> FieldGetter a b, |
|
274 |
QffMode)] |
|
275 |
-> FieldList a b |
|
276 |
fillNumberFields numFills fieldsToFill = do |
|
277 |
index <- take numFills [0..] |
|
278 |
field <- fieldsToFill |
|
279 |
return . fillIncompleteFields field index . formatOrdinal $ index + 1 |
|
280 |
|
|
281 |
-- * Various helper functions for property retrieval |
|
282 |
|
|
156 | 283 |
-- | Helper function for primary node retrieval |
157 | 284 |
getPrimaryNode :: ConfigData -> Instance -> ErrorResult Node |
158 | 285 |
getPrimaryNode cfg = getInstPrimaryNode cfg . instName |
Also available in: Unified diff