Commit 1283cc38 authored by Iustin Pop's avatar Iustin Pop
Browse files

Split 'Query.Language.ItemType' in two sub-types



The QR_VIA_OP/QR_VIA_LUXI types in Python are using yet another
validation mode: QR_VIA_OP is the base type, and QR_VIA_LUXI extends
it (when doing luxi queries). But on the wire they have the same
representation.

To accommodate this properly, we split the ItemType in two: a
QueryTypeOp and a QueryTypeLuxi, joining them back together in
ItemType itself. This requires custom serialisation/deserialisation,
but allows us to express correctly that at opcode level, we only
accept a QueryTypeOp, but at Luxi query level, we accept either of
them.
Signed-off-by: default avatarIustin Pop <iustin@google.com>
Reviewed-by: default avatarGuido Trotter <ultrotter@google.com>
parent 22381768
......@@ -59,7 +59,7 @@ checkQueryResults cfg qr descr expected = monadicIO $ do
-- | Makes a node name query, given a filter.
makeNodeQuery :: Filter FilterField -> Query
makeNodeQuery = Query QRNode ["name"]
makeNodeQuery = Query (ItemTypeOpCode QRNode) ["name"]
-- | Checks if a given operation failed.
expectBadQuery :: ConfigData -> Query -> String -> Property
......
......@@ -74,6 +74,10 @@ genFilter' n =
n'' = max n' 2 -- but we don't want empty or 1-element lists,
-- so use this for and/or filter list length
$(genArbitrary ''QueryTypeOp)
$(genArbitrary ''QueryTypeLuxi)
$(genArbitrary ''ItemType)
instance Arbitrary FilterRegex where
......@@ -148,6 +152,10 @@ prop_fieldsresult_serialisation :: Property
prop_fieldsresult_serialisation =
forAll (resize 20 arbitrary::Gen QueryFieldsResult) testSerialisation
-- | Tests 'ItemType' serialisation.
prop_itemtype_serialisation :: ItemType -> Property
prop_itemtype_serialisation = testSerialisation
testSuite "Query/Language"
[ 'prop_filter_serialisation
, 'prop_filterregex_instances
......@@ -156,4 +164,5 @@ testSuite "Query/Language"
, 'prop_fielddef_serialisation
, 'prop_resultentry_serialisation
, 'prop_fieldsresult_serialisation
, 'prop_itemtype_serialisation
]
......@@ -66,9 +66,10 @@ prop_queryNode_noUnknown =
forAll (choose (0, maxNodes) >>= genEmptyCluster) $ \cluster ->
forAll (elements (Map.keys nodeFieldsMap)) $ \field -> monadicIO $ do
QueryResult fdefs fdata <-
run (query cluster False (Query QRNode [field] EmptyFilter)) >>= resultProp
run (query cluster False (Query (ItemTypeOpCode QRNode)
[field] EmptyFilter)) >>= resultProp
QueryFieldsResult fdefs' <-
resultProp $ queryFields (QueryFields QRNode [field])
resultProp $ queryFields (QueryFields (ItemTypeOpCode QRNode) [field])
stop $ conjoin
[ printTestCase ("Got unknown fields via query (" ++
show fdefs ++ ")") (hasUnknownFields fdefs)
......@@ -86,9 +87,10 @@ prop_queryNode_Unknown =
forAll (arbitrary `suchThat` (`notElem` Map.keys nodeFieldsMap))
$ \field -> monadicIO $ do
QueryResult fdefs fdata <-
run (query cluster False (Query QRNode [field] EmptyFilter)) >>= resultProp
run (query cluster False (Query (ItemTypeOpCode QRNode)
[field] EmptyFilter)) >>= resultProp
QueryFieldsResult fdefs' <-
resultProp $ queryFields (QueryFields QRNode [field])
resultProp $ queryFields (QueryFields (ItemTypeOpCode QRNode) [field])
stop $ conjoin
[ printTestCase ("Got known fields via query (" ++ show fdefs ++ ")")
(not $ hasUnknownFields fdefs)
......@@ -132,7 +134,8 @@ prop_queryNode_types =
forAll (genEmptyCluster numnodes) $ \cfg ->
forAll (elements (Map.keys nodeFieldsMap)) $ \field -> monadicIO $ do
QueryResult fdefs fdata <-
run (query cfg False (Query QRNode [field] EmptyFilter)) >>= resultProp
run (query cfg False (Query (ItemTypeOpCode QRNode)
[field] EmptyFilter)) >>= resultProp
stop $ conjoin
[ printTestCase ("Inconsistent result entries (" ++ show fdata ++ ")")
(conjoin $ map (conjoin . zipWith checkResultType fdefs) fdata)
......@@ -147,7 +150,7 @@ prop_queryNode_types =
-- | Test that queryFields with empty fields list returns all node fields.
case_queryNode_allfields :: Assertion
case_queryNode_allfields = do
fdefs <- case queryFields (QueryFields QRNode []) of
fdefs <- case queryFields (QueryFields (ItemTypeOpCode QRNode) []) of
Bad msg -> fail $ "Error in query all fields: " ++
formatError msg
Ok (QueryFieldsResult v) -> return v
......@@ -163,10 +166,11 @@ prop_queryGroup_noUnknown =
forAll (choose (0, maxNodes) >>= genEmptyCluster) $ \cluster ->
forAll (elements (Map.keys groupFieldsMap)) $ \field -> monadicIO $ do
QueryResult fdefs fdata <-
run (query cluster False (Query QRGroup [field] EmptyFilter)) >>=
run (query cluster False (Query (ItemTypeOpCode QRGroup)
[field] EmptyFilter)) >>=
resultProp
QueryFieldsResult fdefs' <-
resultProp $ queryFields (QueryFields QRGroup [field])
resultProp $ queryFields (QueryFields (ItemTypeOpCode QRGroup) [field])
stop $ conjoin
[ printTestCase ("Got unknown fields via query (" ++ show fdefs ++ ")")
(hasUnknownFields fdefs)
......@@ -183,9 +187,10 @@ prop_queryGroup_Unknown =
forAll (arbitrary `suchThat` (`notElem` Map.keys groupFieldsMap))
$ \field -> monadicIO $ do
QueryResult fdefs fdata <-
run (query cluster False (Query QRGroup [field] EmptyFilter)) >>= resultProp
run (query cluster False (Query (ItemTypeOpCode QRGroup)
[field] EmptyFilter)) >>= resultProp
QueryFieldsResult fdefs' <-
resultProp $ queryFields (QueryFields QRGroup [field])
resultProp $ queryFields (QueryFields (ItemTypeOpCode QRGroup) [field])
stop $ conjoin
[ printTestCase ("Got known fields via query (" ++ show fdefs ++ ")")
(not $ hasUnknownFields fdefs)
......@@ -205,7 +210,8 @@ prop_queryGroup_types =
forAll (genEmptyCluster numnodes) $ \cfg ->
forAll (elements (Map.keys groupFieldsMap)) $ \field -> monadicIO $ do
QueryResult fdefs fdata <-
run (query cfg False (Query QRGroup [field] EmptyFilter)) >>= resultProp
run (query cfg False (Query (ItemTypeOpCode QRGroup)
[field] EmptyFilter)) >>= resultProp
stop $ conjoin
[ printTestCase ("Inconsistent result entries (" ++ show fdata ++ ")")
(conjoin $ map (conjoin . zipWith checkResultType fdefs) fdata)
......@@ -216,7 +222,7 @@ prop_queryGroup_types =
case_queryGroup_allfields :: Assertion
case_queryGroup_allfields = do
fdefs <- case queryFields (QueryFields QRGroup []) of
fdefs <- case queryFields (QueryFields (ItemTypeOpCode QRGroup) []) of
Bad msg -> fail $ "Error in query all fields: " ++
formatError msg
Ok (QueryFieldsResult v) -> return v
......@@ -230,7 +236,7 @@ case_queryGroup_allfields = do
prop_getRequestedNames :: Property
prop_getRequestedNames =
forAll getName $ \node1 ->
let chk = getRequestedNames . Query QRNode []
let chk = getRequestedNames . Query (ItemTypeOpCode QRNode) []
q_node1 = QuotedString node1
eq_name = EQFilter "name"
eq_node1 = eq_name q_node1
......
......@@ -101,17 +101,19 @@ genericConvert otype oname oattr =
-- | The input data for node query.
queryNodesMsg :: L.LuxiOp
queryNodesMsg =
L.Query Qlang.QRNode ["name", "mtotal", "mnode", "mfree", "dtotal", "dfree",
"ctotal", "offline", "drained", "vm_capable",
"ndp/spindle_count", "group.uuid"] Qlang.EmptyFilter
L.Query (Qlang.ItemTypeOpCode Qlang.QRNode)
["name", "mtotal", "mnode", "mfree", "dtotal", "dfree",
"ctotal", "offline", "drained", "vm_capable",
"ndp/spindle_count", "group.uuid"] Qlang.EmptyFilter
-- | The input data for instance query.
queryInstancesMsg :: L.LuxiOp
queryInstancesMsg =
L.Query Qlang.QRInstance ["name", "disk_usage", "be/memory", "be/vcpus",
"status", "pnode", "snodes", "tags", "oper_ram",
"be/auto_balance", "disk_template",
"be/spindle_use"] Qlang.EmptyFilter
L.Query (Qlang.ItemTypeOpCode Qlang.QRInstance)
["name", "disk_usage", "be/memory", "be/vcpus",
"status", "pnode", "snodes", "tags", "oper_ram",
"be/auto_balance", "disk_template",
"be/spindle_use"] Qlang.EmptyFilter
-- | The input data for cluster query.
queryClusterInfoMsg :: L.LuxiOp
......@@ -120,8 +122,9 @@ queryClusterInfoMsg = L.QueryClusterInfo
-- | The input data for node group query.
queryGroupsMsg :: L.LuxiOp
queryGroupsMsg =
L.Query Qlang.QRGroup ["uuid", "name", "alloc_policy", "ipolicy", "tags"]
Qlang.EmptyFilter
L.Query (Qlang.ItemTypeOpCode Qlang.QRGroup)
["uuid", "name", "alloc_policy", "ipolicy", "tags"]
Qlang.EmptyFilter
-- | Wraper over 'callMethod' doing node query.
queryNodes :: L.Client -> IO (Result JSValue)
......
......@@ -47,6 +47,8 @@ module Ganeti.Query.Language
, ResultStatus(..)
, ResultValue
, ItemType(..)
, QueryTypeOp(..)
, QueryTypeLuxi(..)
, checkRS
) where
......@@ -98,17 +100,49 @@ $(declareSADT "FieldType"
$(makeJSONInstance ''FieldType)
-- | Supported items on which Qlang works.
$(declareSADT "ItemType"
$(declareSADT "QueryTypeOp"
[ ("QRCluster", 'C.qrCluster )
, ("QRInstance", 'C.qrInstance )
, ("QRNode", 'C.qrNode )
, ("QRLock", 'C.qrLock )
, ("QRGroup", 'C.qrGroup )
, ("QROs", 'C.qrOs )
, ("QRJob", 'C.qrJob )
, ("QRExport", 'C.qrExport )
])
$(makeJSONInstance ''ItemType)
$(makeJSONInstance ''QueryTypeOp)
-- | Supported items on which Qlang works.
$(declareSADT "QueryTypeLuxi"
[ ("QRLock", 'C.qrLock )
, ("QRJob", 'C.qrJob )
])
$(makeJSONInstance ''QueryTypeLuxi)
-- | Overall query type.
data ItemType = ItemTypeLuxi QueryTypeLuxi
| ItemTypeOpCode QueryTypeOp
deriving (Show, Read, Eq)
-- | Custom JSON decoder for 'ItemType'.
decodeItemType :: (Monad m) => JSValue -> m ItemType
decodeItemType (JSString s) =
case queryTypeOpFromRaw s' of
Just v -> return $ ItemTypeOpCode v
Nothing ->
case queryTypeLuxiFromRaw s' of
Just v -> return $ ItemTypeLuxi v
Nothing ->
fail $ "Can't parse value '" ++ s' ++ "' as neither"
++ "QueryTypeLuxi nor QueryTypeOp"
where s' = fromJSString s
decodeItemType v = fail $ "Invalid value '" ++ show (pp_value v) ++
"for query type"
-- | Custom JSON instance for 'ItemType' since its encoding is not
-- consistent with the data type itself.
instance JSON ItemType where
showJSON (ItemTypeLuxi x) = showJSON x
showJSON (ItemTypeOpCode y) = showJSON y
readJSON = decodeItemType
-- * Sub data types for query2 queries and responses.
......
......@@ -124,8 +124,8 @@ needsNames (Query kind _ qfilter) = requestedNames (nameField kind) qfilter
-- | Computes the name field for different query types.
nameField :: ItemType -> FilterField
nameField QRJob = "id"
nameField _ = "name"
nameField (ItemTypeLuxi QRJob) = "id"
nameField _ = "name"
-- | Extracts all quoted strings from a list, ignoring the
-- 'NumericValue' entries.
......@@ -157,7 +157,8 @@ queryInner :: ConfigData -- ^ The current configuration
-> [String] -- ^ Requested names
-> IO (ErrorResult QueryResult) -- ^ Result
queryInner cfg live (Query QRNode fields qfilter) wanted = runResultT $ do
queryInner cfg live (Query (ItemTypeOpCode QRNode) fields qfilter) wanted =
runResultT $ do
cfilter <- resultT $ compileFilter nodeFieldsMap qfilter
let selected = getSelectedFields nodeFieldsMap fields
(fdefs, fgetters) = unzip selected
......@@ -177,7 +178,8 @@ queryInner cfg live (Query QRNode fields qfilter) wanted = runResultT $ do
nruntimes
return QueryResult { qresFields = fdefs, qresData = fdata }
queryInner cfg _ (Query QRGroup fields qfilter) wanted = return $ do
queryInner cfg _ (Query (ItemTypeOpCode QRGroup) fields qfilter) wanted =
return $ do
cfilter <- compileFilter groupFieldsMap qfilter
let selected = getSelectedFields groupFieldsMap fields
(fdefs, fgetters) = unzip selected
......@@ -204,10 +206,10 @@ fieldsExtractor fieldsMap fields =
-- | Query fields call.
queryFields :: QueryFields -> ErrorResult QueryFieldsResult
queryFields (QueryFields QRNode fields) =
queryFields (QueryFields (ItemTypeOpCode QRNode) fields) =
Ok $ fieldsExtractor nodeFieldsMap fields
queryFields (QueryFields QRGroup fields) =
queryFields (QueryFields (ItemTypeOpCode QRGroup) fields) =
Ok $ fieldsExtractor groupFieldsMap fields
queryFields (QueryFields qkind _) =
......
......@@ -156,10 +156,10 @@ handleCall _ (QueryFields qkind qfields) = do
return $ J.showJSON <$> result
handleCall cfg (QueryNodes names fields lock) =
handleClassicQuery cfg Qlang.QRNode names fields lock
handleClassicQuery cfg (Qlang.ItemTypeOpCode Qlang.QRNode) names fields lock
handleCall cfg (QueryGroups names fields lock) =
handleClassicQuery cfg Qlang.QRGroup names fields lock
handleClassicQuery cfg (Qlang.ItemTypeOpCode Qlang.QRGroup) names fields lock
handleCall _ op =
return . Bad $
......
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