Commit 3fd38382 authored by Hrvoje Ribicic's avatar Hrvoje Ribicic

Add aliases of existing instance fields

For legacy reasons, some instance fields are aliased. The aliases have
the same definition but appear under different names. Support for such
fields has been added to Query/Common.hs
As aliases can cause somewhat harder to find bugs, a new test was
added as well.
Signed-off-by: default avatarHrvoje Ribicic <riba@google.com>
Reviewed-by: default avatarJose A. Lopes <jabolopes@google.com>
parent 3b89cb1b
......@@ -756,6 +756,7 @@ HS_TEST_SRCS = \
test/hs/Test/Ganeti/Network.hs \
test/hs/Test/Ganeti/Objects.hs \
test/hs/Test/Ganeti/OpCodes.hs \
test/hs/Test/Ganeti/Query/Aliases.hs \
test/hs/Test/Ganeti/Query/Filter.hs \
test/hs/Test/Ganeti/Query/Language.hs \
test/hs/Test/Ganeti/Query/Network.hs \
......
......@@ -44,8 +44,10 @@ module Ganeti.Query.Common
, buildHvParamField
, getDefaultHypervisorSpec
, getHvParamsFromCluster
, aliasFields
) where
import Control.Monad (guard)
import qualified Data.Map as Map
import Data.Maybe (fromMaybe)
import Text.JSON (JSON, showJSON)
......@@ -238,3 +240,13 @@ getHvParamsFromCluster cfg hv =
fromMaybe (GenericContainer Map.empty) .
Map.lookup (hypervisorToRaw hv) .
fromContainer . clusterHvparams $ configCluster cfg
-- | Given an alias list and a field list, copies field definitions under a
-- new field name. Aliases should be tested - see the test module
-- 'Test.Ganeti.Query.Aliases'!
aliasFields :: [(FieldName, FieldName)] -> FieldList a b -> FieldList a b
aliasFields aliases fieldList = fieldList ++ do
alias <- aliases
(FieldDefinition name d1 d2 d3, v1, v2) <- fieldList
guard (snd alias == name)
return (FieldDefinition (fst alias) d1 d2 d3, v1, v2)
......@@ -27,6 +27,8 @@ module Ganeti.Query.Instance
( Runtime
, fieldsMap
, collectLiveData
, instanceFields
, instanceAliases
) where
import Control.Applicative
......@@ -64,9 +66,28 @@ type Runtime = Either RpcError (Maybe LiveInfo)
-- | The instance fields map.
fieldsMap :: FieldMap Instance Runtime
fieldsMap = Map.fromList [(fdefName f, v) | v@(f, _, _) <- instanceFields]
fieldsMap = Map.fromList [(fdefName f, v) | v@(f, _, _) <- aliasedFields]
-- | The instance aliases.
instanceAliases :: [(FieldName, FieldName)]
instanceAliases =
[ ("vcpus", "be/vcpus")
, ("be/memory", "be/maxmem")
, ("sda_size", "disk.size/0")
, ("sdb_size", "disk.size/1")
, ("ip", "nic.ip/0")
, ("mac", "nic.mac/0")
, ("bridge", "nic.bridge/0")
, ("nic_mode", "nic.mode/0")
, ("nic_link", "nic.link/0")
, ("nic_network", "nic.network/0")
]
-- | The aliased instance fields.
aliasedFields :: FieldList Instance Runtime
aliasedFields = aliasFields instanceAliases instanceFields
-- | The instance fields
-- | The instance fields.
instanceFields :: FieldList Instance Runtime
instanceFields =
-- Simple fields
......
{-# LANGUAGE TemplateHaskell #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
{-| Unittests for query aliases.
-}
{-
Copyright (C) 2013 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 Test.Ganeti.Query.Aliases
( testQuery_Aliases
) where
import Data.List
import Test.Ganeti.TestHelper
import Test.HUnit
import Ganeti.Query.Common ()
import qualified Ganeti.Query.Instance as I
import Ganeti.Query.Language
import Ganeti.Query.Types
{-# ANN module "HLint: ignore Use camelCase" #-}
-- | Converts field list to field name list
toFieldNameList :: FieldList a b -> [FieldName]
toFieldNameList = map (\(x,_,_) -> fdefName x)
-- | Converts alias list to alias name list
toAliasNameList :: [(FieldName, FieldName)] -> [FieldName]
toAliasNameList = map fst
-- | Converts alias list to alias target list
toAliasTargetList :: [(FieldName, FieldName)] -> [FieldName]
toAliasTargetList = map snd
-- | Checks for shadowing
checkShadowing :: String
-> FieldList a b
-> [(FieldName, FieldName)]
-> Assertion
checkShadowing name fields aliases =
assertBool (name ++ " aliases do not shadow fields") .
null $ toFieldNameList fields `intersect` toAliasNameList aliases
-- | Checks for target existence
checkTargets :: String
-> FieldList a b
-> [(FieldName, FieldName)]
-> Assertion
checkTargets name fields aliases =
assertBool (name ++ " alias targets exist") .
null $ toAliasTargetList aliases \\ toFieldNameList fields
-- | Check that instance aliases do not shadow existing fields
case_instanceAliasesNoShadowing :: Assertion
case_instanceAliasesNoShadowing =
checkShadowing "Instance" I.instanceFields I.instanceAliases
-- | Check that instance alias targets exist
case_instanceAliasesTargetsExist :: Assertion
case_instanceAliasesTargetsExist =
checkTargets "Instance" I.instanceFields I.instanceAliases
testSuite "Query/Aliases"
[ 'case_instanceAliasesNoShadowing,
'case_instanceAliasesTargetsExist
]
......@@ -59,6 +59,7 @@ import Test.Ganeti.Luxi
import Test.Ganeti.Network
import Test.Ganeti.Objects
import Test.Ganeti.OpCodes
import Test.Ganeti.Query.Aliases
import Test.Ganeti.Query.Filter
import Test.Ganeti.Query.Language
import Test.Ganeti.Query.Network
......@@ -120,6 +121,7 @@ allTests =
, testNetwork
, testObjects
, testOpCodes
, testQuery_Aliases
, testQuery_Filter
, testQuery_Language
, testQuery_Network
......
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