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: Petr Pudlak <pudlak@google.com>
Reviewed-by: Klaus Aehlig <aehlig@google.com>

src/Ganeti/Luxi.hs

@@ -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

src/Ganeti/UDSServer.hs

@@ -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)