First part of Network Queries in Haskell

This is the beginning of the implementation of network
queries. This includes establishing all infrastructure
to run the network queries and implement querying of
some simpler fields and the node group listing.

Signed-off-by: Helga Velroyen <helgav@google.com>
Reviewed-by: Iustin Pop <iustin@google.com>

diff --git a/Makefile.am b/Makefile.am
index 3a168e8..49e2b7a 100644 (file)
--- a/Makefile.am
+++ b/Makefile.am
@@ -529,6 +529,7 @@ HS_LIB_SRCS = \
        src/Ganeti/Query/Group.hs \
        src/Ganeti/Query/Job.hs \
        src/Ganeti/Query/Language.hs \
+       src/Ganeti/Query/Network.hs \
        src/Ganeti/Query/Node.hs \
        src/Ganeti/Query/Query.hs \
        src/Ganeti/Query/Server.hs \

diff --git a/src/Ganeti/Config.hs b/src/Ganeti/Config.hs
index 2561cb0..359c2d4 100644 (file)
--- a/src/Ganeti/Config.hs
+++ b/src/Ganeti/Config.hs
@@ -42,14 +42,17 @@ module Ganeti.Config
     , getGroupNodes
     , getGroupInstances
     , getGroupOfNode
+    , getGroupConnections
     , getInstPrimaryNode
     , getInstMinorsForNode
+    , getNetwork
     , buildLinkIpInstnameMap
     , instNodes
     ) where
 
 import Control.Monad (liftM)
 import Data.List (foldl')
+import Data.Maybe (fromMaybe, mapMaybe)
 import qualified Data.Map as M
 import qualified Data.Set as S
 import qualified Text.JSON as J
@@ -210,6 +213,48 @@ getGroupInstances cfg gname =
       ginsts = map (getNodeInstances cfg) gnodes in
   (concatMap fst ginsts, concatMap snd ginsts)
 
+-- | Looks up a network. If looking up by uuid fails, we look up
+-- by name.
+getNetwork :: ConfigData -> String -> ErrorResult Network
+getNetwork cfg name =
+  let networks = fromContainer (configNetworks cfg)
+  in case getItem "Network" name networks of
+       Ok net -> Ok net
+       Bad _ -> let by_name = M.mapKeys
+                              (fromNonEmpty . networkName . (M.!) networks)
+                              networks
+                in getItem "Network" name by_name
+
+-- | Given a network's UUID, this function lists all connections from
+-- the network to nodegroups including the respective mode and links.
+getGroupConnections :: ConfigData -> String -> [(String, String, String)]
+getGroupConnections cfg network_uuid =
+  mapMaybe (getGroupConnection network_uuid)
+  ((M.elems . fromContainer . configNodegroups) cfg)
+
+-- | Given a network's UUID and a node group, this function assembles
+-- a tuple of the group's name, the mode and the link by which the
+-- network is connected to the group. Returns 'Nothing' if the network
+-- is not connected to the group.
+getGroupConnection :: String -> NodeGroup -> Maybe (String, String, String)
+getGroupConnection network_uuid group =
+  let networks = fromContainer . groupNetworks $ group
+  in case M.lookup network_uuid networks of
+    Nothing -> Nothing
+    Just network ->
+      Just (groupName group, getNicMode network, getNicLink network)
+
+-- | Retrieves the network's mode and formats it human-readable,
+-- also in case it is not available.
+getNicMode :: PartialNicParams -> String
+getNicMode nic_params =
+  maybe "-" nICModeToRaw $ nicpModeP nic_params
+
+-- | Retrieves the network's link and formats it human-readable, also in
+-- case it it not available.
+getNicLink :: PartialNicParams -> String
+getNicLink nic_params = fromMaybe "-" (nicpLinkP nic_params)
+
 -- | Looks up an instance's primary node.
 getInstPrimaryNode :: ConfigData -> String -> ErrorResult Node
 getInstPrimaryNode cfg name =

diff --git a/src/Ganeti/Query/Language.hs b/src/Ganeti/Query/Language.hs
index ae88dfd..7cc52db 100644 (file)
--- a/src/Ganeti/Query/Language.hs
+++ b/src/Ganeti/Query/Language.hs
@@ -113,6 +113,7 @@ $(declareSADT "QueryTypeOp"
   , ("QRGroup",    'C.qrGroup )
   , ("QROs",       'C.qrOs )
   , ("QRExport",   'C.qrExport )
+  , ("QRNetwork",  'C.qrNetwork )
   ])
 $(makeJSONInstance ''QueryTypeOp)
 

diff --git a/src/Ganeti/Query/Network.hs b/src/Ganeti/Query/Network.hs
new file mode 100644 (file)
index 0000000..0724155
--- /dev/null
+++ b/src/Ganeti/Query/Network.hs
@@ -0,0 +1,72 @@
+{-| Implementation of the Ganeti Query2 node group queries.
+
+ -}
+
+{-
+
+Copyright (C) 2012 Google Inc.
+
+This program is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 2 of the License, or
+(at your option) any later version.
+
+This program is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with this program; if not, write to the Free Software
+Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+02110-1301, USA.
+
+-}
+
+module Ganeti.Query.Network
+  ( NetworkRuntime(..)
+  , networkFieldsMap
+  ) where
+
+import qualified Data.Map as Map
+
+import Ganeti.Config
+import Ganeti.Objects
+import Ganeti.Query.Language
+import Ganeti.Query.Common
+import Ganeti.Query.Types
+
+data NetworkRuntime = NetworkRuntime
+
+networkFields :: FieldList Network NetworkRuntime
+networkFields =
+  [ (FieldDefinition "name" "Name" QFTText "Network name",
+     FieldSimple (rsNormal . networkName), QffNormal)
+  , (FieldDefinition "network" "Subnet" QFTText "IPv4 subnet",
+     FieldSimple (rsNormal . networkNetwork), QffNormal)
+  , (FieldDefinition "gateway" "Gateway" QFTOther "IPv4 gateway",
+     FieldSimple (rsMaybeUnavail . networkGateway), QffNormal)
+  , (FieldDefinition "network6" "IPv6Subnet" QFTOther "IPv6 subnet",
+     FieldSimple (rsMaybeUnavail . networkNetwork6), QffNormal)
+  , (FieldDefinition "gateway6" "IPv6Gateway" QFTOther "IPv6 gateway",
+     FieldSimple (rsMaybeUnavail . networkGateway6), QffNormal)
+  , (FieldDefinition "mac_prefix" "MacPrefix" QFTOther "MAC address prefix",
+     FieldSimple (rsMaybeUnavail . networkMacPrefix), QffNormal)
+  , (FieldDefinition "network_type" "NetworkType" QFTOther "Network type",
+     FieldSimple (rsMaybeUnavail . networkNetworkType), QffNormal)
+  , (FieldDefinition "group_list" "GroupList" QFTOther "List of node groups",
+     FieldConfig (\cfg -> rsNormal . getGroupConnections cfg . networkUuid),
+       QffNormal)
+  ] ++
+  uuidFields "Network" ++
+  serialFields "Network" ++
+  tagsFields
+
+-- | The group fields map.
+networkFieldsMap :: FieldMap Network NetworkRuntime
+networkFieldsMap =
+  Map.fromList $ map (\v@(f, _, _) -> (fdefName f, v)) networkFields
+
+-- TODO: the following fields are not implemented yet: external_reservations,
+-- free_count, group_cnt, inst_cnt, inst_list, map, reserved_count, serial_no,
+-- tags, uuid

diff --git a/src/Ganeti/Query/Query.hs b/src/Ganeti/Query/Query.hs
index ffdebf8..515d6d4 100644 (file)
--- a/src/Ganeti/Query/Query.hs
+++ b/src/Ganeti/Query/Query.hs
@@ -71,6 +71,7 @@ import Ganeti.Query.Filter
 import qualified Ganeti.Query.Job as Query.Job
 import Ganeti.Query.Group
 import Ganeti.Query.Language
+import Ganeti.Query.Network
 import Ganeti.Query.Node
 import Ganeti.Query.Types
 import Ganeti.Path
@@ -197,7 +198,22 @@ queryInner cfg _ (Query (ItemTypeOpCode QRGroup) fields qfilter) wanted =
   fgroups <- filterM (\n -> evaluateFilter cfg Nothing n cfilter) groups
   let fdata = map (\node ->
                        map (execGetter cfg GroupRuntime node) fgetters) fgroups
-  return QueryResult {qresFields = fdefs, qresData = fdata }
+  return QueryResult { qresFields = fdefs, qresData = fdata }
+
+queryInner cfg _ (Query (ItemTypeOpCode QRNetwork) fields qfilter) wanted =
+  return $ do
+  cfilter <- compileFilter networkFieldsMap qfilter
+  let selected = getSelectedFields networkFieldsMap fields
+      (fdefs, fgetters, _) = unzip3 selected
+  networks <- case wanted of
+                [] -> Ok . niceSortKey (fromNonEmpty . networkName) .
+                      Map.elems . fromContainer $ configNetworks cfg
+                _  -> mapM (getNetwork cfg) wanted
+  fnetworks <- filterM (\n -> evaluateFilter cfg Nothing n cfilter) networks
+  let fdata = map (\network ->
+                   map (execGetter cfg NetworkRuntime network) fgetters)
+                   fnetworks
+  return QueryResult { qresFields = fdefs, qresData = fdata }
 
 queryInner _ _ (Query qkind _ _) _ =
   return . Bad . GenericError $ "Query '" ++ show qkind ++ "' not supported"