Commit 3fc9410e authored by Petr Pudlak's avatar Petr Pudlak
Browse files

Move buildCall and validateResult from Luxi to UDSServer



.. to that they're available for other Luxi-like RPC clients as well.

While at it, rename validateResult to parseResponse to be consistent
with the names of the other functions.
Signed-off-by: default avatarPetr Pudlak <pudlak@google.com>
Reviewed-by: default avatarKlaus Aehlig <aehlig@google.com>
parent 735cdaa5
......@@ -54,8 +54,6 @@ module Ganeti.Luxi
import Control.Applicative (optional)
import Control.Monad
import qualified Data.ByteString.UTF8 as UTF8
import Text.JSON (encodeStrict, decodeStrict)
import qualified Text.JSON as J
import Text.JSON.Pretty (pp_value)
import Text.JSON.Types
......@@ -186,16 +184,6 @@ getLuxiClient = connectClient luxiConnectConfig luxiDefCtmo
getLuxiServer :: Bool -> FilePath -> IO Server
getLuxiServer = connectServer luxiConnectConfig
-- | Serialize a request to String.
buildCall :: LuxiOp -- ^ The method
-> String -- ^ The serialized form
buildCall lo =
let ja = [ (strOfKey Method, J.showJSON $ strOfOp lo)
, (strOfKey Args, opToArgs lo)
]
jo = toJSObject ja
in encodeStrict jo
-- | Converts Luxi call arguments into a 'LuxiOp' data structure.
-- This is used for building a Luxi 'Handler'.
......@@ -295,36 +283,12 @@ decodeLuxiCall method args = do
liftM unTimeAsDoubleJSON $ fromJVal x
return $ SetWatcherPause duration
-- | Check that luxi responses contain the required keys and that the
-- call was successful.
validateResult :: String -> ErrorResult JSValue
validateResult s = do
when (UTF8.replacement_char `elem` s) $
fail "Failed to decode UTF-8, detected replacement char after decoding"
oarr <- fromJResult "Parsing LUXI response" (decodeStrict s)
let arr = J.fromJSObject oarr
status <- fromObj arr (strOfKey Success)
result <- fromObj arr (strOfKey Result)
if status
then return result
else decodeError result
-- | Try to decode an error from the server response. This function
-- will always fail, since it's called only on the error path (when
-- status is False).
decodeError :: JSValue -> ErrorResult JSValue
decodeError val =
case fromJVal val of
Ok e -> Bad e
Bad msg -> Bad $ GenericError msg
-- | Generic luxi method call.
-- | Generic luxi method call
callMethod :: LuxiOp -> Client -> IO (ErrorResult JSValue)
callMethod method s = do
sendMsg s $ buildCall method
sendMsg s $ buildCall (strOfOp method) (opToArgs method)
result <- recvMsg s
let rval = validateResult result
return rval
return $ parseResponse result
-- | Parse job submission result.
parseSubmitJobResult :: JSValue -> ErrorResult JobId
......
......@@ -46,6 +46,8 @@ module Ganeti.UDSServer
, closeClient
, closeServer
, buildResponse
, parseResponse
, buildCall
, parseCall
, recvMsg
, recvMsgExt
......@@ -79,7 +81,7 @@ import qualified Text.JSON as J
import Text.JSON.Types
import Ganeti.BasicTypes
import Ganeti.Errors (GanetiException)
import Ganeti.Errors (GanetiException(..), ErrorResult)
import Ganeti.JSON
import Ganeti.Logging
import Ganeti.Runtime (GanetiDaemon(..), MiscGroup(..), GanetiGroup(..))
......@@ -265,6 +267,16 @@ recvMsgExt s =
else RecvError (show e)
-- | Serialize a request to String.
buildCall :: (J.JSON mth, J.JSON args)
=> mth -- ^ The method
-> args -- ^ The arguments
-> String -- ^ The serialized form
buildCall mth args =
let keyToObj :: (J.JSON a) => MsgKeys -> a -> (String, J.JSValue)
keyToObj k v = (strOfKey k, J.showJSON v)
in encodeStrict $ toJSObject [ keyToObj Method mth, keyToObj Args args ]
-- | Parse the required keys out of a call.
parseCall :: (J.JSON mth, J.JSON args) => String -> Result (mth, args)
parseCall s = do
......@@ -285,6 +297,30 @@ buildResponse success args =
jo = toJSObject ja
in encodeStrict jo
-- | Try to decode an error from the server response. This function
-- will always fail, since it's called only on the error path (when
-- status is False).
decodeError :: JSValue -> ErrorResult JSValue
decodeError val =
case fromJVal val of
Ok e -> Bad e
Bad msg -> Bad $ GenericError msg
-- | Check that luxi responses contain the required keys and that the
-- call was successful.
parseResponse :: String -> ErrorResult JSValue
parseResponse s = do
when (UTF8.replacement_char `elem` s) $
failError "Failed to decode UTF-8,\
\ detected replacement char after decoding"
oarr <- fromJResultE "Parsing LUXI response" (decodeStrict s)
let arr = J.fromJSObject oarr
status <- fromObj arr (strOfKey Success)
result <- fromObj arr (strOfKey Result)
if status
then return result
else decodeError result
-- | Logs an outgoing message.
logMsg
:: (Show e, J.JSON e, MonadLog m)
......
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