33 |
33 |
|
34 |
34 |
module Ganeti.OpParams
|
35 |
35 |
( TagType(..)
|
36 |
|
, TagObject(..)
|
37 |
|
, tagObjectFrom
|
38 |
|
, tagNameOf
|
39 |
|
, decodeTagObject
|
40 |
|
, encodeTagObject
|
41 |
36 |
, ReplaceDisksMode(..)
|
42 |
37 |
, DiskIndex
|
43 |
38 |
, mkDiskIndex
|
... | ... | |
317 |
312 |
])
|
318 |
313 |
$(makeJSONInstance ''TagType)
|
319 |
314 |
|
320 |
|
-- | Data type holding a tag object (type and object name).
|
321 |
|
data TagObject = TagInstance String
|
322 |
|
| TagNode String
|
323 |
|
| TagGroup String
|
324 |
|
| TagCluster
|
325 |
|
deriving (Show, Eq)
|
326 |
|
|
327 |
|
-- | Tag type for a given tag object.
|
328 |
|
tagTypeOf :: TagObject -> TagType
|
329 |
|
tagTypeOf (TagInstance {}) = TagTypeInstance
|
330 |
|
tagTypeOf (TagNode {}) = TagTypeNode
|
331 |
|
tagTypeOf (TagGroup {}) = TagTypeGroup
|
332 |
|
tagTypeOf (TagCluster {}) = TagTypeCluster
|
333 |
|
|
334 |
|
-- | Gets the potential tag object name.
|
335 |
|
tagNameOf :: TagObject -> Maybe String
|
336 |
|
tagNameOf (TagInstance s) = Just s
|
337 |
|
tagNameOf (TagNode s) = Just s
|
338 |
|
tagNameOf (TagGroup s) = Just s
|
339 |
|
tagNameOf TagCluster = Nothing
|
340 |
|
|
341 |
|
-- | Builds a 'TagObject' from a tag type and name.
|
342 |
|
tagObjectFrom :: (Monad m) => TagType -> JSValue -> m TagObject
|
343 |
|
tagObjectFrom TagTypeInstance (JSString s) =
|
344 |
|
return . TagInstance $ fromJSString s
|
345 |
|
tagObjectFrom TagTypeNode (JSString s) = return . TagNode $ fromJSString s
|
346 |
|
tagObjectFrom TagTypeGroup (JSString s) = return . TagGroup $ fromJSString s
|
347 |
|
tagObjectFrom TagTypeCluster JSNull = return TagCluster
|
348 |
|
tagObjectFrom t v =
|
349 |
|
fail $ "Invalid tag type/name combination: " ++ show t ++ "/" ++
|
350 |
|
show (pp_value v)
|
351 |
|
|
352 |
|
-- | Name of the tag \"name\" field.
|
353 |
|
tagNameField :: String
|
354 |
|
tagNameField = "name"
|
355 |
|
|
356 |
|
-- | Custom encoder for 'TagObject' as represented in an opcode.
|
357 |
|
encodeTagObject :: TagObject -> (JSValue, [(String, JSValue)])
|
358 |
|
encodeTagObject t = ( showJSON (tagTypeOf t)
|
359 |
|
, [(tagNameField, maybe JSNull showJSON (tagNameOf t))] )
|
360 |
|
|
361 |
|
-- | Custom decoder for 'TagObject' as represented in an opcode.
|
362 |
|
decodeTagObject :: (Monad m) => [(String, JSValue)] -> JSValue -> m TagObject
|
363 |
|
decodeTagObject obj kind = do
|
364 |
|
ttype <- fromJVal kind
|
365 |
|
tname <- fromObj obj tagNameField
|
366 |
|
tagObjectFrom ttype tname
|
367 |
|
|
368 |
315 |
-- ** Disks
|
369 |
316 |
|
370 |
317 |
-- | Replace disks type.
|