Commit f94a9680 authored by Iustin Pop's avatar Iustin Pop
Browse files

Implement support for QFF_SPLIT_TIMESTAMP



I am very very unhappy with this patch. We have to do this, in order
to be compatible with the Python code and behaviour, but there's lots
of duplication; both the Python and the Haskell code will need to be
cleaned up and simplified (we don't need QFF_* at all).

For now though, this implements QffTimestamp and associated code.
Signed-off-by: default avatarIustin Pop <iustin@google.com>
Reviewed-by: default avatarGuido Trotter <ultrotter@google.com>
parent 0ea11dcb
......@@ -156,7 +156,7 @@ case_queryNode_allfields = do
Ok (QueryFieldsResult v) -> return v
let field_sort = compare `on` fdefName
assertEqual "Mismatch in all fields list"
(sortBy field_sort . map fst $ Map.elems nodeFieldsMap)
(sortBy field_sort . map (\(f, _, _) -> f) $ Map.elems nodeFieldsMap)
(sortBy field_sort fdefs)
-- * Same as above, but for group
......@@ -228,7 +228,7 @@ case_queryGroup_allfields = do
Ok (QueryFieldsResult v) -> return v
let field_sort = compare `on` fdefName
assertEqual "Mismatch in all fields list"
(sortBy field_sort . map fst $ Map.elems groupFieldsMap)
(sortBy field_sort . map (\(f, _, _) -> f) $ Map.elems groupFieldsMap)
(sortBy field_sort fdefs)
......
......@@ -104,29 +104,29 @@ rpcErrorToStatus _ = RSNoData
timeStampFields :: (TimeStampObject a) => FieldList a b
timeStampFields =
[ (FieldDefinition "ctime" "CTime" QFTTimestamp "Creation timestamp",
FieldSimple (rsNormal . cTimeOf))
FieldSimple (rsNormal . cTimeOf), QffNormal)
, (FieldDefinition "mtime" "MTime" QFTTimestamp "Modification timestamp",
FieldSimple (rsNormal . mTimeOf))
FieldSimple (rsNormal . mTimeOf), QffNormal)
]
-- | The list of UUID fields.
uuidFields :: (UuidObject a) => String -> FieldList a b
uuidFields name =
[ (FieldDefinition "uuid" "UUID" QFTText (name ++ " UUID"),
FieldSimple (rsNormal . uuidOf)) ]
FieldSimple (rsNormal . uuidOf), QffNormal) ]
-- | The list of serial number fields.
serialFields :: (SerialNoObject a) => String -> FieldList a b
serialFields name =
[ (FieldDefinition "serial_no" "SerialNo" QFTNumber
(name ++ " object serial number, incremented on each modification"),
FieldSimple (rsNormal . serialOf)) ]
FieldSimple (rsNormal . serialOf), QffNormal) ]
-- | The list of tag fields.
tagsFields :: (TagsObject a) => FieldList a b
tagsFields =
[ (FieldDefinition "tags" "Tags" QFTOther "Tags",
FieldSimple (rsNormal . tagsOf)) ]
FieldSimple (rsNormal . tagsOf), QffNormal) ]
-- * Generic parameter functions
......@@ -169,4 +169,4 @@ buildNdParamField field =
qft = fromMaybe QFTOther $ field `Map.lookup` ndParamTypes
desc = "The \"" ++ field ++ "\" node parameter"
in (FieldDefinition full_name title qft desc,
FieldConfig (ndParamGetter field))
FieldConfig (ndParamGetter field), QffNormal)
......@@ -69,12 +69,21 @@ import Ganeti.JSON
-- | Compiles a filter based on field names to one based on getters.
compileFilter :: FieldMap a b
-> Filter FilterField
-> ErrorResult (Filter (FieldGetter a b))
-> ErrorResult (Filter (FieldGetter a b, QffMode))
compileFilter fm =
traverse (\field -> maybe
(Bad . ParameterError $ "Can't find field named '" ++
field ++ "'")
(Ok . snd) (field `Map.lookup` fm))
(\(_, g, q) -> Ok (g, q)) (field `Map.lookup` fm))
-- | Processes a field value given a QffMode.
qffField :: QffMode -> JSValue -> ErrorResult JSValue
qffField QffNormal v = Ok v
qffField QffTimestamp v =
case v of
JSArray [secs@(JSRational _ _), JSRational _ _] -> return secs
_ -> Bad $ ProgrammerError
"Internal error: Getter returned non-timestamp for QffTimestamp"
-- | Wraps a getter, filter pair. If the getter is 'FieldRuntime' but
-- we don't have a runtime context, we skip the filtering, returning
......@@ -82,15 +91,15 @@ compileFilter fm =
wrapGetter :: ConfigData
-> Maybe b
-> a
-> FieldGetter a b
-> (FieldGetter a b, QffMode)
-> (JSValue -> ErrorResult Bool)
-> ErrorResult Bool
wrapGetter cfg b a getter faction =
wrapGetter cfg b a (getter, qff) faction =
case tryGetter cfg b a getter of
Nothing -> Ok True -- runtime missing, accepting the value
Just v ->
case v of
ResultEntry RSNormal (Just fval) -> faction fval
ResultEntry RSNormal (Just fval) -> qffField qff fval >>= faction
ResultEntry RSNormal Nothing ->
Bad $ ProgrammerError
"Internal error: Getter returned RSNormal/Nothing"
......@@ -149,7 +158,7 @@ containsFilter (NumericValue val) lst = do
-- 'any' and 'all' do not play nice with monadic values, resulting in
-- either too much memory use or in too many thunks being created.
evaluateFilter :: ConfigData -> Maybe b -> a
-> Filter (FieldGetter a b)
-> Filter (FieldGetter a b, QffMode)
-> ErrorResult Bool
evaluateFilter _ _ _ EmptyFilter = Ok True
evaluateFilter c mb a (AndFilter flts) = helper flts
......
......@@ -43,39 +43,41 @@ groupFields :: FieldList NodeGroup GroupRuntime
groupFields =
[ (FieldDefinition "alloc_policy" "AllocPolicy" QFTText
"Allocation policy for group",
FieldSimple (rsNormal . groupAllocPolicy))
FieldSimple (rsNormal . groupAllocPolicy), QffNormal)
, (FieldDefinition "custom_diskparams" "CustomDiskParameters" QFTOther
"Custom disk parameters",
FieldSimple (rsNormal . groupDiskparams))
FieldSimple (rsNormal . groupDiskparams), QffNormal)
, (FieldDefinition "custom_ipolicy" "CustomInstancePolicy" QFTOther
"Custom instance policy limitations",
FieldSimple (rsNormal . groupIpolicy))
FieldSimple (rsNormal . groupIpolicy), QffNormal)
, (FieldDefinition "custom_ndparams" "CustomNDParams" QFTOther
"Custom node parameters",
FieldSimple (rsNormal . groupNdparams))
FieldSimple (rsNormal . groupNdparams), QffNormal)
, (FieldDefinition "diskparams" "DiskParameters" QFTOther
"Disk parameters (merged)",
FieldConfig (\cfg -> rsNormal . getGroupDiskParams cfg))
FieldConfig (\cfg -> rsNormal . getGroupDiskParams cfg), QffNormal)
, (FieldDefinition "ipolicy" "InstancePolicy" QFTOther
"Instance policy limitations (merged)",
FieldConfig (\cfg ng -> rsNormal (getGroupIpolicy cfg ng)))
FieldConfig (\cfg ng -> rsNormal (getGroupIpolicy cfg ng)), QffNormal)
, (FieldDefinition "name" "Group" QFTText "Group name",
FieldSimple (rsNormal . groupName))
FieldSimple (rsNormal . groupName), QffNormal)
, (FieldDefinition "ndparams" "NDParams" QFTOther "Node parameters",
FieldConfig (\cfg ng -> rsNormal (getGroupNdParams cfg ng)))
FieldConfig (\cfg ng -> rsNormal (getGroupNdParams cfg ng)), QffNormal)
, (FieldDefinition "node_cnt" "Nodes" QFTNumber "Number of nodes",
FieldConfig (\cfg -> rsNormal . length . getGroupNodes cfg . groupName))
FieldConfig (\cfg -> rsNormal . length . getGroupNodes cfg . groupName),
QffNormal)
, (FieldDefinition "node_list" "NodeList" QFTOther "List of nodes",
FieldConfig (\cfg -> rsNormal . map nodeName .
getGroupNodes cfg . groupName))
getGroupNodes cfg . groupName), QffNormal)
, (FieldDefinition "pinst_cnt" "Instances" QFTNumber
"Number of primary instances",
FieldConfig
(\cfg -> rsNormal . length . fst . getGroupInstances cfg . groupName))
(\cfg -> rsNormal . length . fst . getGroupInstances cfg . groupName),
QffNormal)
, (FieldDefinition "pinst_list" "InstanceList" QFTOther
"List of primary instances",
FieldConfig (\cfg -> rsNormal . map instName . fst .
getGroupInstances cfg . groupName))
getGroupInstances cfg . groupName), QffNormal)
] ++
map buildNdParamField allNDParamFields ++
timeStampFields ++
......@@ -85,4 +87,5 @@ groupFields =
-- | The group fields map.
groupFieldsMap :: FieldMap NodeGroup GroupRuntime
groupFieldsMap = Map.fromList $ map (\v -> (fdefName (fst v), v)) groupFields
groupFieldsMap =
Map.fromList $ map (\v@(f, _, _) -> (fdefName f, v)) groupFields
......@@ -105,7 +105,8 @@ nodeLiveFieldBuilder :: (FieldName, FieldTitle, FieldType, String, FieldDoc)
-> FieldData Node NodeRuntime
nodeLiveFieldBuilder (fname, ftitle, ftype, _, fdoc) =
( FieldDefinition fname ftitle ftype fdoc
, FieldRuntime $ nodeLiveRpcCall fname)
, FieldRuntime $ nodeLiveRpcCall fname
, QffNormal)
-- | The docstring for the node role. Note that we use 'reverse in
-- order to keep the same order as Python.
......@@ -130,69 +131,73 @@ getNodePower cfg node =
nodeFields :: FieldList Node NodeRuntime
nodeFields =
[ (FieldDefinition "drained" "Drained" QFTBool "Whether node is drained",
FieldSimple (rsNormal . nodeDrained))
FieldSimple (rsNormal . nodeDrained), QffNormal)
, (FieldDefinition "master_candidate" "MasterC" QFTBool
"Whether node is a master candidate",
FieldSimple (rsNormal . nodeMasterCandidate))
FieldSimple (rsNormal . nodeMasterCandidate), QffNormal)
, (FieldDefinition "master_capable" "MasterCapable" QFTBool
"Whether node can become a master candidate",
FieldSimple (rsNormal . nodeMasterCapable))
FieldSimple (rsNormal . nodeMasterCapable), QffNormal)
, (FieldDefinition "name" "Node" QFTText "Node name",
FieldSimple (rsNormal . nodeName))
FieldSimple (rsNormal . nodeName), QffNormal)
, (FieldDefinition "offline" "Offline" QFTBool
"Whether node is marked offline",
FieldSimple (rsNormal . nodeOffline))
FieldSimple (rsNormal . nodeOffline), QffNormal)
, (FieldDefinition "vm_capable" "VMCapable" QFTBool
"Whether node can host instances",
FieldSimple (rsNormal . nodeVmCapable))
FieldSimple (rsNormal . nodeVmCapable), QffNormal)
, (FieldDefinition "pip" "PrimaryIP" QFTText "Primary IP address",
FieldSimple (rsNormal . nodePrimaryIp))
FieldSimple (rsNormal . nodePrimaryIp), QffNormal)
, (FieldDefinition "sip" "SecondaryIP" QFTText "Secondary IP address",
FieldSimple (rsNormal . nodeSecondaryIp))
FieldSimple (rsNormal . nodeSecondaryIp), QffNormal)
, (FieldDefinition "master" "IsMaster" QFTBool "Whether node is master",
FieldConfig (\cfg node ->
rsNormal (nodeName node ==
clusterMasterNode (configCluster cfg))))
clusterMasterNode (configCluster cfg))),
QffNormal)
, (FieldDefinition "group" "Group" QFTText "Node group",
FieldConfig (\cfg node ->
rsMaybe (groupName <$> getGroupOfNode cfg node)))
rsMaybe (groupName <$> getGroupOfNode cfg node)),
QffNormal)
, (FieldDefinition "group.uuid" "GroupUUID" QFTText "UUID of node group",
FieldSimple (rsNormal . nodeGroup))
FieldSimple (rsNormal . nodeGroup), QffNormal)
, (FieldDefinition "ndparams" "NodeParameters" QFTOther
"Merged node parameters",
FieldConfig ((rsMaybe .) . getNodeNdParams))
FieldConfig ((rsMaybe .) . getNodeNdParams), QffNormal)
, (FieldDefinition "custom_ndparams" "CustomNodeParameters" QFTOther
"Custom node parameters",
FieldSimple (rsNormal . nodeNdparams))
FieldSimple (rsNormal . nodeNdparams), QffNormal)
-- FIXME: the below could be generalised a bit, like in Python
, (FieldDefinition "pinst_cnt" "Pinst" QFTNumber
"Number of instances with this node as primary",
FieldConfig (\cfg ->
rsNormal . length . fst . getNodeInstances cfg . nodeName))
rsNormal . length . fst . getNodeInstances cfg . nodeName),
QffNormal)
, (FieldDefinition "sinst_cnt" "Sinst" QFTNumber
"Number of instances with this node as secondary",
FieldConfig (\cfg ->
rsNormal . length . snd . getNodeInstances cfg . nodeName))
rsNormal . length . snd . getNodeInstances cfg . nodeName),
QffNormal)
, (FieldDefinition "pinst_list" "PriInstances" QFTOther
"List of instances with this node as primary",
FieldConfig (\cfg -> rsNormal . map instName . fst .
getNodeInstances cfg . nodeName))
getNodeInstances cfg . nodeName), QffNormal)
, (FieldDefinition "sinst_list" "SecInstances" QFTOther
"List of instances with this node as secondary",
FieldConfig (\cfg -> rsNormal . map instName . snd .
getNodeInstances cfg . nodeName))
getNodeInstances cfg . nodeName), QffNormal)
, (FieldDefinition "role" "Role" QFTText nodeRoleDoc,
FieldConfig ((rsNormal .) . getNodeRole))
FieldConfig ((rsNormal .) . getNodeRole), QffNormal)
, (FieldDefinition "powered" "Powered" QFTBool
"Whether node is thought to be powered on",
FieldConfig getNodePower)
FieldConfig getNodePower, QffNormal)
-- FIXME: the two fields below are incomplete in Python, part of the
-- non-implemented node resource model; they are declared just for
-- parity, but are not functional
, (FieldDefinition "hv_state" "HypervisorState" QFTOther "Hypervisor state",
missingRuntime)
missingRuntime, QffNormal)
, (FieldDefinition "disk_state" "DiskState" QFTOther "Disk state",
missingRuntime)
missingRuntime, QffNormal)
] ++
map nodeLiveFieldBuilder nodeLiveFieldsDefs ++
map buildNdParamField allNDParamFields ++
......@@ -203,4 +208,5 @@ nodeFields =
-- | The node fields map.
nodeFieldsMap :: FieldMap Node NodeRuntime
nodeFieldsMap = Map.fromList $ map (\v -> (fdefName (fst v), v)) nodeFields
nodeFieldsMap =
Map.fromList $ map (\v@(f, _, _) -> (fdefName f, v)) nodeFields
......@@ -79,7 +79,8 @@ import Ganeti.Utils
mkUnknownFDef :: String -> FieldData a b
mkUnknownFDef name =
( FieldDefinition name name QFTUnknown ("Unknown field '" ++ name ++ "'")
, FieldUnknown )
, FieldUnknown
, QffNormal )
-- | Runs a field getter on the existing contexts.
execGetter :: ConfigData -> b -> a -> FieldGetter a b -> ResultEntry
......@@ -161,7 +162,7 @@ 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
(fdefs, fgetters, _) = unzip3 selected
live' = live && needsLiveData fgetters
nodes <- resultT $ case wanted of
[] -> Ok . niceSortKey nodeName .
......@@ -182,7 +183,7 @@ queryInner cfg _ (Query (ItemTypeOpCode QRGroup) fields qfilter) wanted =
return $ do
cfilter <- compileFilter groupFieldsMap qfilter
let selected = getSelectedFields groupFieldsMap fields
(fdefs, fgetters) = unzip selected
(fdefs, fgetters, _) = unzip3 selected
groups <- case wanted of
[] -> Ok . niceSortKey groupName .
Map.elems . fromContainer $ configNodegroups cfg
......@@ -202,7 +203,7 @@ fieldsExtractor fieldsMap fields =
let selected = if null fields
then map snd $ Map.toAscList fieldsMap
else getSelectedFields fieldsMap fields
in QueryFieldsResult (map fst selected)
in QueryFieldsResult (map (\(defs, _, _) -> defs) selected)
-- | Query fields call.
queryFields :: QueryFields -> ErrorResult QueryFieldsResult
......
......@@ -28,6 +28,7 @@ Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
module Ganeti.Query.Types
( FieldGetter(..)
, QffMode(..)
, FieldData
, FieldList
, FieldMap
......@@ -50,8 +51,16 @@ data FieldGetter a b = FieldSimple (a -> ResultEntry)
| FieldConfig (ConfigData -> a -> ResultEntry)
| FieldUnknown
-- | Type defining how the value of a field is used in filtering. This
-- implements the equivalent to Python's QFF_ flags, except that we
-- don't use OR-able values.
data QffMode = QffNormal -- ^ Value is used as-is in filters
| QffTimestamp -- ^ Value is a timestamp tuple, convert to float
deriving (Show, Eq)
-- | Alias for a field data (definition and getter).
type FieldData a b = (FieldDefinition, FieldGetter a b)
type FieldData a b = (FieldDefinition, FieldGetter a b, QffMode)
-- | Alias for a field data list.
type FieldList a b = [FieldData a b]
......
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