Fix gnt-network list-tags
authorDimitris Aragiorgis <dimara@grnet.gr>
Thu, 12 Dec 2013 13:04:11 +0000 (15:04 +0200)
committerHrvoje Ribicic <riba@google.com>
Mon, 16 Dec 2013 15:31:07 +0000 (16:31 +0100)
Define network tags in haskell part.

This fixes issue 641.

Signed-off-by: Dimitris Aragiorgis <dimara@grnet.gr>
Reviewed-by: Hrvoje Ribicic <riba@google.com>

src/Ganeti/OpParams.hs
src/Ganeti/Query/Server.hs

index a1e445c..b448e53 100644 (file)
@@ -311,6 +311,7 @@ $(declareSADT "TagType"
   , ("TagTypeNode",     'C.tagNode)
   , ("TagTypeGroup",    'C.tagNodegroup)
   , ("TagTypeCluster",  'C.tagCluster)
+  , ("TagTypeNetwork",  'C.tagNetwork)
   ])
 $(makeJSONInstance ''TagType)
 
@@ -318,6 +319,7 @@ $(makeJSONInstance ''TagType)
 data TagObject = TagInstance String
                | TagNode     String
                | TagGroup    String
+               | TagNetwork  String
                | TagCluster
                deriving (Show, Eq)
 
@@ -327,12 +329,14 @@ tagTypeOf (TagInstance {}) = TagTypeInstance
 tagTypeOf (TagNode     {}) = TagTypeNode
 tagTypeOf (TagGroup    {}) = TagTypeGroup
 tagTypeOf (TagCluster  {}) = TagTypeCluster
+tagTypeOf (TagNetwork  {}) = TagTypeNetwork
 
 -- | Gets the potential tag object name.
 tagNameOf :: TagObject -> Maybe String
 tagNameOf (TagInstance s) = Just s
 tagNameOf (TagNode     s) = Just s
 tagNameOf (TagGroup    s) = Just s
+tagNameOf (TagNetwork  s) = Just s
 tagNameOf  TagCluster     = Nothing
 
 -- | Builds a 'TagObject' from a tag type and name.
@@ -341,6 +345,8 @@ tagObjectFrom TagTypeInstance (JSString s) =
   return . TagInstance $ fromJSString s
 tagObjectFrom TagTypeNode     (JSString s) = return . TagNode $ fromJSString s
 tagObjectFrom TagTypeGroup    (JSString s) = return . TagGroup $ fromJSString s
+tagObjectFrom TagTypeNetwork  (JSString s) =
+  return . TagNetwork $ fromJSString s
 tagObjectFrom TagTypeCluster   JSNull      = return TagCluster
 tagObjectFrom t v =
   fail $ "Invalid tag type/name combination: " ++ show t ++ "/" ++
index ef2f6b5..d4a19b7 100644 (file)
@@ -150,6 +150,7 @@ handleCall cfg (QueryTags kind) =
                TagGroup    name -> groupTags <$> Config.getGroup    cfg name
                TagNode     name -> nodeTags  <$> Config.getNode     cfg name
                TagInstance name -> instTags  <$> Config.getInstance cfg name
+               TagNetwork  name -> networkTags  <$> Config.getNetwork cfg name
   in return (J.showJSON <$> tags)
 
 handleCall cfg (Query qkind qfields qfilter) = do