Commit 5183e8be authored by Iustin Pop's avatar Iustin Pop
Browse files

Convert query path from string errors to GanetiException



This patch converts all the call paths from 'Result' (which contains
just string errors) to 'ErrorResult', which holds
GanetiException-encoded errors. We can now return proper
OpPrereq/OpExec errors to the clients of the luxi/query socket.

The patch touches many files as we had to convert the entire call
chains in a single round. But it should be pretty straightforward
otherwise:

- change 'Result' into 'ErrorResult'
- add error annotations: change "Bad msg" into "Bad (XXXEror msg)"
- add a helper function for confd, where we don't send to client
  formatted exceptions, to convert back from ErrorResult into Result
- change tests similarly, where needed
Signed-off-by: default avatarIustin Pop <iustin@google.com>
Reviewed-by: default avatarMichael Hanselmann <hansmi@google.com>
parent f56fc1a6
......@@ -43,6 +43,7 @@ import Test.Ganeti.TestCommon
import Test.Ganeti.Objects (genEmptyCluster)
import Ganeti.BasicTypes
import Ganeti.Errors
import Ganeti.Query.Group
import Ganeti.Query.Language
import Ganeti.Query.Node
......@@ -147,7 +148,8 @@ prop_queryNode_types =
case_queryNode_allfields :: Assertion
case_queryNode_allfields = do
fdefs <- case queryFields (QueryFields QRNode []) of
Bad msg -> fail $ "Error in query all fields: " ++ msg
Bad msg -> fail $ "Error in query all fields: " ++
formatError msg
Ok (QueryFieldsResult v) -> return v
let field_sort = compare `on` fdefName
assertEqual "Mismatch in all fields list"
......@@ -215,7 +217,8 @@ prop_queryGroup_types =
case_queryGroup_allfields :: Assertion
case_queryGroup_allfields = do
fdefs <- case queryFields (QueryFields QRGroup []) of
Bad msg -> fail $ "Error in query all fields: " ++ msg
Bad msg -> fail $ "Error in query all fields: " ++
formatError msg
Ok (QueryFieldsResult v) -> return v
let field_sort = compare `on` fdefName
assertEqual "Mismatch in all fields list"
......
......@@ -45,6 +45,7 @@ import qualified Text.JSON as J
import System.INotify
import Ganeti.BasicTypes
import Ganeti.Errors
import Ganeti.Daemon
import Ganeti.JSON
import Ganeti.Objects
......@@ -130,6 +131,11 @@ getCurrentTime = do
TOD ctime _ <- getClockTime
return ctime
-- | Converter from specific error to a string format.
gntErrorToResult :: ErrorResult a -> Result a
gntErrorToResult (Bad err) = Bad (show err)
gntErrorToResult (Ok x) = Ok x
-- * Confd base functionality
-- | Computes the node role.
......@@ -170,12 +176,12 @@ buildResponse cdata req@(ConfdRequest { confdRqType = ReqClusterMaster }) =
EmptyQuery -> return (ReplyStatusOk, J.showJSON master_name)
PlainQuery _ -> return queryArgumentError
DictQuery reqq -> do
mnode <- getNode cfg master_name
let fvals =map (\field -> case field of
ReqFieldName -> master_name
ReqFieldIp -> clusterMasterIp cluster
ReqFieldMNodePip -> nodePrimaryIp mnode
) (confdReqQFields reqq)
mnode <- gntErrorToResult $ getNode cfg master_name
let fvals = map (\field -> case field of
ReqFieldName -> master_name
ReqFieldIp -> clusterMasterIp cluster
ReqFieldMNodePip -> nodePrimaryIp mnode
) (confdReqQFields reqq)
return (ReplyStatusOk, J.showJSON fvals)
where master_name = clusterMasterNode cluster
cluster = configCluster cfg
......@@ -231,7 +237,7 @@ buildResponse cdata req@(ConfdRequest { confdRqType = ReqNodeDrbd }) = do
node_name <- case confdRqQuery req of
PlainQuery str -> return str
_ -> fail $ "Invalid query type " ++ show (confdRqQuery req)
node <- getNode cfg node_name
node <- gntErrorToResult $ getNode cfg node_name
let minors = concatMap (getInstMinorsForNode (nodeName node)) .
M.elems . fromContainer . configInstances $ cfg
encoded = [J.JSArray [J.showJSON a, J.showJSON b, J.showJSON c,
......
......@@ -54,10 +54,10 @@ import qualified Data.Map as M
import qualified Data.Set as S
import qualified Text.JSON as J
import Ganeti.JSON
import Ganeti.BasicTypes
import qualified Ganeti.Constants as C
import Ganeti.Errors
import Ganeti.JSON
import Ganeti.Objects
-- | Type alias for the link and ip map.
......@@ -145,10 +145,11 @@ getInstancesIpByLink linkipmap link =
-- | Generic lookup function that converts from a possible abbreviated
-- name to a full name.
getItem :: String -> String -> M.Map String a -> Result a
getItem :: String -> String -> M.Map String a -> ErrorResult a
getItem kind name allitems = do
let lresult = lookupName (M.keys allitems) name
err msg = Bad $ kind ++ " name " ++ name ++ " " ++ msg
err msg = Bad $ OpPrereqError (kind ++ " name " ++ name ++ " " ++ msg)
ECodeNoEnt
fullname <- case lrMatchPriority lresult of
PartialMatch -> Ok $ lrContent lresult
ExactMatch -> Ok $ lrContent lresult
......@@ -158,17 +159,17 @@ getItem kind name allitems = do
M.lookup fullname allitems
-- | Looks up a node.
getNode :: ConfigData -> String -> Result Node
getNode :: ConfigData -> String -> ErrorResult Node
getNode cfg name = getItem "Node" name (fromContainer $ configNodes cfg)
-- | Looks up an instance.
getInstance :: ConfigData -> String -> Result Instance
getInstance :: ConfigData -> String -> ErrorResult Instance
getInstance cfg name =
getItem "Instance" name (fromContainer $ configInstances cfg)
-- | Looks up a node group. This is more tricky than for
-- node/instances since the groups map is indexed by uuid, not name.
getGroup :: ConfigData -> String -> Result NodeGroup
getGroup :: ConfigData -> String -> ErrorResult NodeGroup
getGroup cfg name =
let groups = fromContainer (configNodegroups cfg)
in case getItem "NodeGroup" name groups of
......@@ -209,7 +210,7 @@ getGroupInstances cfg gname =
(concatMap fst ginsts, concatMap snd ginsts)
-- | Looks up an instance's primary node.
getInstPrimaryNode :: ConfigData -> String -> Result Node
getInstPrimaryNode :: ConfigData -> String -> ErrorResult Node
getInstPrimaryNode cfg name =
liftM instPrimaryNode (getInstance cfg name) >>= getNode cfg
......
......@@ -60,6 +60,7 @@ import Text.JSON.Pretty (pp_value)
import qualified Text.Regex.PCRE as PCRE
import Ganeti.BasicTypes
import Ganeti.Errors
import Ganeti.Objects
import Ganeti.Query.Language
import Ganeti.Query.Types
......@@ -68,9 +69,11 @@ import Ganeti.JSON
-- | Compiles a filter based on field names to one based on getters.
compileFilter :: FieldMap a b
-> Filter FilterField
-> Result (Filter (FieldGetter a b))
-> ErrorResult (Filter (FieldGetter a b))
compileFilter fm =
traverse (\field -> maybe (Bad $ "Can't find field named '" ++ field ++ "'")
traverse (\field -> maybe
(Bad . ParameterError $ "Can't find field named '" ++
field ++ "'")
(Ok . snd) (field `Map.lookup` fm))
-- | Wraps a getter, filter pair. If the getter is 'FieldRuntime' but
......@@ -80,8 +83,8 @@ wrapGetter :: ConfigData
-> Maybe b
-> a
-> FieldGetter a b
-> (JSValue -> Result Bool)
-> Result Bool
-> (JSValue -> ErrorResult Bool)
-> ErrorResult Bool
wrapGetter cfg b a getter faction =
case tryGetter cfg b a getter of
Nothing -> Ok True -- runtime missing, accepting the value
......@@ -89,14 +92,16 @@ wrapGetter cfg b a getter faction =
case v of
ResultEntry RSNormal (Just fval) -> faction fval
ResultEntry RSNormal Nothing ->
Bad "Internal error: Getter returned RSNormal/Nothing"
Bad $ ProgrammerError
"Internal error: Getter returned RSNormal/Nothing"
_ -> Ok True -- filter has no data to work, accepting it
-- | Helper to evaluate a filter getter (and the value it generates) in
-- a boolean context.
trueFilter :: JSValue -> Result Bool
trueFilter :: JSValue -> ErrorResult Bool
trueFilter (JSBool x) = Ok x
trueFilter v = Bad $ "Unexpected value '" ++ show (pp_value v) ++
trueFilter v = Bad . ParameterError $
"Unexpected value '" ++ show (pp_value v) ++
"' in boolean context"
-- | A type synonim for a rank-2 comparator function. This is used so
......@@ -108,25 +113,25 @@ type Comparator = (Eq a, Ord a) => a -> a -> Bool
-- in a boolean context. Note the order of arguments is reversed from
-- the filter definitions (due to the call chain), make sure to
-- compare in the reverse order too!.
binOpFilter :: Comparator -> FilterValue -> JSValue -> Result Bool
binOpFilter :: Comparator -> FilterValue -> JSValue -> ErrorResult Bool
binOpFilter comp (QuotedString y) (JSString x) =
Ok $ fromJSString x `comp` y
binOpFilter comp (NumericValue y) (JSRational _ x) =
Ok $ x `comp` fromIntegral y
binOpFilter _ expr actual =
Bad $ "Invalid types in comparison, trying to compare " ++
Bad . ParameterError $ "Invalid types in comparison, trying to compare " ++
show (pp_value actual) ++ " with '" ++ show expr ++ "'"
-- | Implements the 'RegexpFilter' matching.
regexpFilter :: FilterRegex -> JSValue -> Result Bool
regexpFilter :: FilterRegex -> JSValue -> ErrorResult Bool
regexpFilter re (JSString val) =
Ok $ PCRE.match (compiledRegex re) (fromJSString val)
regexpFilter _ x =
Bad $ "Invalid field value used in regexp matching,\
Bad . ParameterError $ "Invalid field value used in regexp matching,\
\ expecting string but got '" ++ show (pp_value x) ++ "'"
-- | Implements the 'ContainsFilter' matching.
containsFilter :: FilterValue -> JSValue -> Result Bool
containsFilter :: FilterValue -> JSValue -> ErrorResult Bool
-- note: the next two implementations are the same, but we have to
-- repeat them due to the encapsulation done by FilterValue
containsFilter (QuotedString val) lst = do
......@@ -141,7 +146,7 @@ containsFilter (NumericValue val) lst = do
-- this as passing the filter.
evaluateFilter :: ConfigData -> Maybe b -> a
-> Filter (FieldGetter a b)
-> Result Bool
-> ErrorResult Bool
evaluateFilter _ _ _ EmptyFilter = Ok True
evaluateFilter c mb a (AndFilter flts) =
all id <$> mapM (evaluateFilter c mb a) flts
......
......@@ -60,6 +60,7 @@ import qualified Data.Map as Map
import qualified Text.JSON as J
import Ganeti.BasicTypes
import Ganeti.Errors
import Ganeti.Config
import Ganeti.JSON
import Ganeti.Rpc
......@@ -146,7 +147,7 @@ getRequestedNames qry =
query :: ConfigData -- ^ The current configuration
-> Bool -- ^ Whether to collect live data
-> Query -- ^ The query (item, fields, filter)
-> IO (Result QueryResult) -- ^ Result
-> IO (ErrorResult QueryResult) -- ^ Result
query cfg live qry = queryInner cfg live qry $ getRequestedNames qry
-- | Inner query execution function.
......@@ -154,7 +155,7 @@ queryInner :: ConfigData -- ^ The current configuration
-> Bool -- ^ Whether to collect live data
-> Query -- ^ The query (item, fields, filter)
-> [String] -- ^ Requested names
-> IO (Result QueryResult) -- ^ Result
-> IO (ErrorResult QueryResult) -- ^ Result
queryInner cfg live (Query QRNode fields qfilter) wanted = runResultT $ do
cfilter <- resultT $ compileFilter nodeFieldsMap qfilter
......@@ -167,7 +168,8 @@ queryInner cfg live (Query QRNode fields qfilter) wanted = runResultT $ do
_ -> mapM (getNode cfg) wanted
-- runs first pass of the filter, without a runtime context; this
-- will limit the nodes that we'll contact for runtime data
fnodes <- resultT $ filterM (\n -> evaluateFilter cfg Nothing n cfilter) nodes
fnodes <- resultT $ filterM (\n -> evaluateFilter cfg Nothing n cfilter)
nodes
-- here we would run the runtime data gathering, then filter again
-- the nodes, based on existing runtime data
nruntimes <- lift $ maybeCollectLiveData live' cfg fnodes
......@@ -190,7 +192,7 @@ queryInner cfg _ (Query QRGroup fields qfilter) wanted = return $ do
return QueryResult {qresFields = fdefs, qresData = fdata }
queryInner _ _ (Query qkind _ _) _ =
return . Bad $ "Query '" ++ show qkind ++ "' not supported"
return . Bad . GenericError $ "Query '" ++ show qkind ++ "' not supported"
-- | Helper for 'queryFields'.
fieldsExtractor :: FieldMap a b -> [FilterField] -> QueryFieldsResult
......@@ -201,7 +203,7 @@ fieldsExtractor fieldsMap fields =
in QueryFieldsResult (map fst selected)
-- | Query fields call.
queryFields :: QueryFields -> Result QueryFieldsResult
queryFields :: QueryFields -> ErrorResult QueryFieldsResult
queryFields (QueryFields QRNode fields) =
Ok $ fieldsExtractor nodeFieldsMap fields
......@@ -209,13 +211,13 @@ queryFields (QueryFields QRGroup fields) =
Ok $ fieldsExtractor groupFieldsMap fields
queryFields (QueryFields qkind _) =
Bad $ "QueryFields '" ++ show qkind ++ "' not supported"
Bad . GenericError $ "QueryFields '" ++ show qkind ++ "' not supported"
-- | Classic query converter. It gets a standard query result on input
-- and computes the classic style results.
queryCompat :: QueryResult -> Result [[J.JSValue]]
queryCompat :: QueryResult -> ErrorResult [[J.JSValue]]
queryCompat (QueryResult fields qrdata) =
case map fdefName $ filter ((== QFTUnknown) . fdefKind) fields of
[] -> Ok $ map (map (maybe J.JSNull J.showJSON . rentryValue)) qrdata
unknown -> Bad $ "Unknown output fields selected: " ++
intercalate ", " unknown
unknown -> Bad $ OpPrereqError ("Unknown output fields selected: " ++
intercalate ", " unknown) ECodeInval
......@@ -42,6 +42,7 @@ import Text.JSON.Pretty (pp_value)
import System.Info (arch)
import qualified Ganeti.Constants as C
import Ganeti.Errors
import qualified Ganeti.Path as Path
import Ganeti.Daemon
import Ganeti.Objects
......@@ -63,22 +64,24 @@ handleClassicQuery :: ConfigData -- ^ Cluster config
-> [String] -- ^ Requested names (empty means all)
-> [String] -- ^ Requested fields
-> Bool -- ^ Whether to do sync queries or not
-> IO (Result JSValue)
handleClassicQuery _ _ _ _ True = return . Bad $ "Sync queries are not allowed"
-> IO (GenericResult GanetiException JSValue)
handleClassicQuery _ _ _ _ True =
return . Bad $ OpPrereqError "Sync queries are not allowed" ECodeInval
handleClassicQuery cfg qkind names fields _ = do
let flt = makeSimpleFilter (nameField qkind) names
qr <- query cfg True (Qlang.Query qkind fields flt)
return $ showJSON <$> (qr >>= queryCompat)
-- | Minimal wrapper to handle the missing config case.
handleCallWrapper :: Result ConfigData -> LuxiOp -> IO (Result JSValue)
handleCallWrapper :: Result ConfigData -> LuxiOp -> IO (ErrorResult JSValue)
handleCallWrapper (Bad msg) _ =
return . Bad $ "I do not have access to a valid configuration, cannot\
\ process queries: " ++ msg
return . Bad . ConfigurationError $
"I do not have access to a valid configuration, cannot\
\ process queries: " ++ msg
handleCallWrapper (Ok config) op = handleCall config op
-- | Actual luxi operation handler.
handleCall :: ConfigData -> LuxiOp -> IO (Result JSValue)
handleCall :: ConfigData -> LuxiOp -> IO (ErrorResult JSValue)
handleCall cdata QueryClusterInfo =
let cluster = configCluster cdata
hypervisors = clusterEnabledHypervisors cluster
......@@ -157,7 +160,8 @@ handleCall cfg (QueryGroups names fields lock) =
handleClassicQuery cfg Qlang.QRGroup names fields lock
handleCall _ op =
return . Bad $ "Luxi call '" ++ strOfOp op ++ "' not implemented"
return . Bad $
GenericError ("Luxi call '" ++ strOfOp op ++ "' not implemented")
-- | Given a decoded luxi request, executes it and sends the luxi
......@@ -170,9 +174,8 @@ handleClientMsg client creader args = do
(!status, !rval) <-
case call_result of
Bad err -> do
let errmsg = "Failed to execute request: " ++ err
logWarning errmsg
return (False, showJSON errmsg)
logWarning $ "Failed to execute request: " ++ show err
return (False, showJSON err)
Ok result -> do
logDebug $ "Result " ++ show (pp_value result)
return (True, result)
......
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