Commit 262f3e6c authored by Iustin Pop's avatar Iustin Pop
Browse files

Change the Utils.fromObj signature

Currently the fromObj function takes a JSON object which is then
converted into a list of (String, JSValue) in which we make a lookup.
However, most of the callers of this function call it repeatedly on the
same object, which means we do the object→list conversion repeatedly.

This patch converts it to take directly the list, and converts its
callers to do the conversion themselves (and only once).

While this is not in the hot-path today, it would be if we ever were to
process much data over Luxi (or RAPI), and is a good cleanup in any
case.
parent a160c28e
......@@ -46,7 +46,7 @@ import Ganeti.HTools.Types
-- 'Allocate' request share some common properties, which are read by
-- this function.
parseBaseInstance :: String
-> JSObject JSValue
-> [(String, JSValue)]
-> Result (String, Instance.Instance)
parseBaseInstance n a = do
disk <- fromObj "disk_space_total" a
......@@ -55,10 +55,10 @@ parseBaseInstance n a = do
let running = "running"
return (n, Instance.create n mem disk vcpus running 0 0)
-- | Parses an instance as found in the cluster instance list.
-- | Parses an instance as found in the cluster instance listg.
parseInstance :: NameAssoc -- ^ The node name-to-index association list
-> String -- ^ The name of the instance
-> JSObject JSValue -- ^ The JSON object
-> [(String, JSValue)] -- ^ The JSON object
-> Result (String, Instance.Instance)
parseInstance ktn n a = do
base <- parseBaseInstance n a
......@@ -72,14 +72,13 @@ parseInstance ktn n a = do
-- | Parses a node as found in the cluster node list.
parseNode :: String -- ^ The node's name
-> JSObject JSValue -- ^ The JSON object
-> [(String, JSValue)] -- ^ The JSON object
-> Result (String, Node.Node)
parseNode n a = do
let name = n
offline <- fromObj "offline" a
drained <- fromObj "drained" a
node <- (if offline || drained
then return $ Node.create name 0 0 0 0 0 0 True
then return $ Node.create n 0 0 0 0 0 0 True
else do
mtotal <- fromObj "total_memory" a
mnode <- fromObj "reserved_memory" a
......@@ -89,26 +88,26 @@ parseNode n a = do
ctotal <- fromObj "total_cpus" a
return $ Node.create n mtotal mnode mfree
dtotal dfree ctotal False)
return (name, node)
return (n, node)
-- | Top-level parser.
parseData :: String -- ^ The JSON message as received from Ganeti
-> Result Request -- ^ A (possible valid) request
parseData body = do
decoded <- fromJResult $ decodeStrict body
let obj = decoded
let obj = fromJSObject decoded
-- request parser
request <- fromObj "request" obj
request <- liftM fromJSObject (fromObj "request" obj)
rname <- fromObj "name" request
-- existing node parsing
nlist <- fromObj "nodes" obj
let ndata = fromJSObject nlist
nobj <- mapM (\(x,y) -> asJSObject y >>= parseNode x) ndata
nlist <- liftM fromJSObject (fromObj "nodes" obj)
nobj <- mapM (\(x,y) -> asJSObject y >>= parseNode x . fromJSObject) nlist
let (ktn, nl) = assignIndices nobj
-- existing instance parsing
ilist <- fromObj "instances" obj
let idata = fromJSObject ilist
iobj <- mapM (\(x,y) -> asJSObject y >>= parseInstance ktn x) idata
iobj <- mapM (\(x,y) ->
asJSObject y >>= parseInstance ktn x . fromJSObject) idata
let (kti, il) = assignIndices iobj
(map_n, map_i, csf) <- mergeData [] (nl, il)
req_nodes <- fromObj "required_nodes" request
......
......@@ -33,7 +33,7 @@ import Network.Curl.Types ()
import Network.Curl.Code
import Data.List
import Control.Monad
import Text.JSON (JSObject, JSValue)
import Text.JSON (JSObject, JSValue, fromJSObject)
import Text.Printf (printf)
import Ganeti.HTools.Utils
......@@ -65,21 +65,22 @@ formatHost master =
getInstances :: NameAssoc
-> String
-> Result [(String, Instance.Instance)]
getInstances ktn body = loadJSArray body >>= mapM (parseInstance ktn)
getInstances ktn body =
loadJSArray body >>= mapM (parseInstance ktn . fromJSObject)
-- | Parse a node list in JSON format.
getNodes :: String -> Result [(String, Node.Node)]
getNodes body = loadJSArray body >>= mapM parseNode
getNodes body = loadJSArray body >>= mapM (parseNode . fromJSObject)
-- | Construct an instance from a JSON object.
parseInstance :: [(String, Ndx)]
-> JSObject JSValue
-> [(String, JSValue)]
-> Result (String, Instance.Instance)
parseInstance ktn a = do
name <- fromObj "name" a
disk <- fromObj "disk_usage" a
mem <- fromObj "beparams" a >>= fromObj "memory"
vcpus <- fromObj "beparams" a >>= fromObj "vcpus"
mem <- fromObj "beparams" a >>= fromObj "memory" . fromJSObject
vcpus <- fromObj "beparams" a >>= fromObj "vcpus" . fromJSObject
pnode <- fromObj "pnode" a >>= lookupNode ktn name
snodes <- fromObj "snodes" a
snode <- (if null snodes then return Node.noSecondary
......@@ -89,7 +90,7 @@ parseInstance ktn a = do
return (name, inst)
-- | Construct a node from a JSON object.
parseNode :: JSObject JSValue -> Result (String, Node.Node)
parseNode :: [(String, JSValue)] -> Result (String, Node.Node)
parseNode a = do
name <- fromObj "name" a
offline <- fromObj "offline" a
......
......@@ -113,9 +113,9 @@ loadJSArray :: (Monad m) => String -> m [J.JSObject J.JSValue]
loadJSArray = fromJResult . J.decodeStrict
-- | Reads a the value of a key in a JSON object.
fromObj :: (J.JSON a, Monad m) => String -> J.JSObject J.JSValue -> m a
fromObj :: (J.JSON a, Monad m) => String -> [(String, J.JSValue)] -> m a
fromObj k o =
case lookup k (J.fromJSObject o) of
case lookup k o of
Nothing -> fail $ printf "key '%s' not found in %s" k (show o)
Just val -> fromJResult $ J.readJSON val
......
......@@ -149,7 +149,8 @@ buildCall msg args =
-- call was successful.
validateResult :: String -> Result JSValue
validateResult s = do
arr <- fromJResult $ decodeStrict s::Result (JSObject JSValue)
oarr <- fromJResult $ decodeStrict s::Result (JSObject JSValue)
let arr = J.fromJSObject oarr
status <- fromObj (strOfKey Success) arr::Result Bool
let rkey = strOfKey Result
(if status
......
......@@ -72,7 +72,7 @@ opID (OpMigrateInstance _ _ _) = "OP_INSTANCE_MIGRATE"
loadOpCode :: JSValue -> J.Result OpCode
loadOpCode v = do
o <- readJSON v::J.Result (JSObject JSValue)
o <- liftM J.fromJSObject (readJSON v)
op_id <- fromObj "OP_ID" o
case op_id of
"OP_TEST_DELAY" -> do
......
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