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