Commit 05092772 authored by Helga Velroyen's avatar Helga Velroyen

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: default avatarHelga Velroyen <helgav@google.com>
Reviewed-by: default avatarIustin Pop <iustin@google.com>
parent a64cc96b
......@@ -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 \
......
......@@ -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 =
......
......@@ -113,6 +113,7 @@ $(declareSADT "QueryTypeOp"
, ("QRGroup", 'C.qrGroup )
, ("QROs", 'C.qrOs )
, ("QRExport", 'C.qrExport )
, ("QRNetwork", 'C.qrNetwork )
])
$(makeJSONInstance ''QueryTypeOp)
......
{-| 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
......@@ -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"
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment