On Wed, Oct 26, 2011 at 10:17 AM, Iustin Pop <[email protected]> wrote:
> On Tue, Oct 25, 2011 at 04:54:06PM +0200, Agata Murawska wrote:
>> The status field in response to a generic query is now supported, with
>> error status used to provide user with more information.
>>
>> Note:
>> The code in THH.hs is temporary, as generalization of declareIADT and
>> declareSADT is in the next patch.
>>
>> Signed-off-by: Agata Murawska <[email protected]>
>> ---
>> htools/Ganeti/HTools/Luxi.hs | 51 +++++++++++++++-----------
>> htools/Ganeti/Luxi.hs | 19 ++++++++++
>> htools/Ganeti/THH.hs | 81
>> ++++++++++++++++++++++++++++++++++++++++++
>> 3 files changed, 130 insertions(+), 21 deletions(-)
>>
>> diff --git a/htools/Ganeti/HTools/Luxi.hs b/htools/Ganeti/HTools/Luxi.hs
>> index 1249e22..8ed4761 100644
>> --- a/htools/Ganeti/HTools/Luxi.hs
>> +++ b/htools/Ganeti/HTools/Luxi.hs
>> @@ -69,22 +69,28 @@ parseQueryResult o =
>> fail $ "Invalid query result, expected array but got " ++ show o
>>
>> -- | Prepare resulting output as parsers expect it.
>> -extractArray :: (Monad m) => JSValue -> m [JSValue]
>> +extractArray :: (Monad m) => JSValue -> m [[(JSValue, JSValue)]]
>> extractArray v =
>> - getData v >>= parseQueryResult >>= (return . map (JSArray . map snd))
>> + getData v >>= parseQueryResult
>> +
>> +-- | Testing responce status for more verbose error message.
> typo responce → response
Ack
>
>> +fromJValWithStatus :: (Text.JSON.JSON a, Monad m) => JSValue -> JSValue ->
>> m a
>> +fromJValWithStatus st v = do
>> + st' <- fromJVal st
>> + L.checkRS st' v >>= fromJVal
>
> It seems that later on you're always calling from JValWithStatus via
> uncurry. Maybe define it directly curried?
Ack, corrected.
>
>> -- | Annotate errors when converting values with owner/attribute for
>> -- better debugging.
>> genericConvert :: (Text.JSON.JSON a) =>
>> - String -- ^ The object type
>> - -> String -- ^ The object name
>> - -> String -- ^ The attribute we're trying to convert
>> - -> JSValue -- ^ The value we try to convert
>> - -> Result a -- ^ The annotated result
>> + String -- ^ The object type
>> + -> String -- ^ The object name
>> + -> String -- ^ The attribute we're trying to
>> convert
>> + -> (JSValue, JSValue) -- ^ The value we're trying to convert
>> + -> Result a -- ^ The annotated result
>> genericConvert otype oname oattr =
>> annotateResult (otype ++ " '" ++ oname ++
>> "', error while reading attribute '" ++
>> - oattr ++ "'") . fromJVal
>> + oattr ++ "'") . uncurry fromJValWithStatus
>>
>> -- * Data querying functionality
>>
>> @@ -135,16 +141,17 @@ getInstances ktn arr = extractArray arr >>= mapM
>> (parseInstance ktn)
>>
>> -- | Construct an instance from a JSON object.
>> parseInstance :: NameAssoc
>> - -> JSValue
>> + -> [(JSValue, JSValue)]
>> -> Result (String, Instance.Instance)
>
> Side-note: I wonder how will this fail if we don't get an JSArray…
JSArray where? The second argument is no longer JSArray... The case
when it fails is the one with wrong number of element, but then it
just fails like this:
Invalid instance query result: [(JSRational False (0 % 1),JSString
(JSONString {fromJSString =
"xcinstall-1.corp.google.com"})),(JSRational False (0 % 1),JSRational
False (0 % 1)),(JSRational False (0 % 1),JSRational False (128 %
1)),(JSRational False (0 % 1),JSRational False (1 % 1)),(JSRational
False (0 % 1),JSString (JSONString {fromJSString =
"ERROR_down"})),(JSRational False (0 % 1),JSString (JSONString
{fromJSString = "mpc12.fra.corp.google.com"})),(JSRational False (0 %
1),JSArray []),(JSRational False (0 % 1),JSArray []),(JSRational False
(3 % 1),JSNull),(JSRational False (0 % 1),JSBool True),(JSRational
False (0 % 1),JSString (JSONString {fromJSString = "diskless"}))]
>
>> -parseInstance ktn (JSArray [ name, disk, mem, vcpus
>> - , status, pnode, snodes, tags, oram
>> - , auto_balance, disk_template ]) = do
>> - xname <- annotateResult "Parsing new instance" (fromJVal name)
>> +parseInstance ktn [ name, disk, mem, vcpus
>> + , status, pnode, snodes, tags, oram
>> + , auto_balance, disk_template ] = do
>> + xname <- annotateResult "Parsing new instance"
>> + (uncurry fromJValWithStatus name)
>> let convert a = genericConvert "Instance" xname a
>> xdisk <- convert "disk_usage" disk
>> xmem <- (case oram of
>> - JSRational _ _ -> convert "oper_ram" oram
>> + (_, JSRational _ _) -> convert "oper_ram" oram
>
> Hmm, this will need to be fixed: the case above was checking if we got a
> rational or a null, but now we know if we have data or not based on
> whether the status field is RS_OK or RS_NODATA (or UNAVAIL, etc.). Could
> you add a fixme to remove the "guessing"?
Sure
>
>> _ -> convert "be/memory" mem)
>> xvcpus <- convert "be/vcpus" vcpus
>> xpnode <- convert "pnode" pnode >>= lookupNode ktn xname
>> @@ -166,11 +173,12 @@ getNodes :: NameAssoc -> JSValue -> Result [(String,
>> Node.Node)]
>> getNodes ktg arr = extractArray arr >>= mapM (parseNode ktg)
>>
>> -- | Construct a node from a JSON object.
>> -parseNode :: NameAssoc -> JSValue -> Result (String, Node.Node)
>> -parseNode ktg (JSArray [ name, mtotal, mnode, mfree, dtotal, dfree
>> - , ctotal, offline, drained, vm_capable, g_uuid ])
>> +parseNode :: NameAssoc -> [(JSValue, JSValue)] -> Result (String, Node.Node)
>> +parseNode ktg [ name, mtotal, mnode, mfree, dtotal, dfree
>> + , ctotal, offline, drained, vm_capable, g_uuid ]
>> = do
>> - xname <- annotateResult "Parsing new node" (fromJVal name)
>> + xname <- annotateResult "Parsing new node"
>> + (uncurry fromJValWithStatus name)
>> let convert a = genericConvert "Node" xname a
>> xoffline <- convert "offline" offline
>> xdrained <- convert "drained" drained
>> @@ -203,9 +211,10 @@ getGroups :: JSValue -> Result [(String, Group.Group)]
>> getGroups jsv = extractArray jsv >>= mapM parseGroup
>>
>> -- | Parses a given group information.
>> -parseGroup :: JSValue -> Result (String, Group.Group)
>> -parseGroup (JSArray [uuid, name, apol]) = do
>> - xname <- annotateResult "Parsing new group" (fromJVal name)
>> +parseGroup :: [(JSValue, JSValue)] -> Result (String, Group.Group)
>> +parseGroup [uuid, name, apol] = do
>> + xname <- annotateResult "Parsing new group"
>> + (uncurry fromJValWithStatus name)
>> let convert a = genericConvert "Group" xname a
>> xuuid <- convert "uuid" uuid
>> xapol <- convert "alloc_policy" apol
>> diff --git a/htools/Ganeti/Luxi.hs b/htools/Ganeti/Luxi.hs
>> index 20c0b14..7456a35 100644
>> --- a/htools/Ganeti/Luxi.hs
>> +++ b/htools/Ganeti/Luxi.hs
>> @@ -28,7 +28,9 @@ Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston,
>> MA
>> module Ganeti.Luxi
>> ( LuxiOp(..)
>> , QrViaLuxi(..)
>> + , ResponseStatus(..)
>> , Client
>> + , checkRS
>> , getClient
>> , closeClient
>> , callMethod
>> @@ -145,6 +147,23 @@ $(genLuxiOp "LuxiOp"
>> -- | The serialisation of LuxiOps into strings in messages.
>> $(genStrOfOp ''LuxiOp "strOfOp")
>>
>> +$(declareIADT "ResponseStatus"
>
> FYI, this is in Python "result status", not "response status".
I changed the name in THH, thanks!
>
>> + [ ("RSNormal", 'rsNormal)
>> + , ("RSUnknown", 'rsUnknown)
>> + , ("RSNoData", 'rsNodata)
>> + , ("RSUnavailable", 'rsUnavail)
>> + , ("RSOffline", 'rsOffline)
>> + ])
>> +$(makeJSONInstanceInt ''ResponseStatus)
>> +
>> +-- | Check that ResponseStatus is success or fail with descriptive message.
>> +checkRS :: (Monad m) => ResponseStatus -> a -> m a
>> +checkRS RSNormal val = return val
>> +checkRS RSUnknown _ = fail "Unknown field"
>> +checkRS RSNoData _ = fail "No data for a field"
>> +checkRS RSUnavailable _ = fail "Ganeti reports unavailable data"
>> +checkRS RSOffline _ = fail "Ganeti reports resource as offline"
>> +
>> -- | The end-of-message separator.
>> eOM :: Char
>> eOM = '\3'
>> diff --git a/htools/Ganeti/THH.hs b/htools/Ganeti/THH.hs
>> index 6bb377e..e3c1110 100644
>> --- a/htools/Ganeti/THH.hs
>> +++ b/htools/Ganeti/THH.hs
>> @@ -30,7 +30,9 @@ Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston,
>> MA
>> -}
>
> All the changes to THH.hs could have been a separate patch (Introduce
> declareIADT), by the way, since they are not functionally related to the
> result status parsing. Just FYI.
>
> LGTM, thanks.
>
> iustin
>
Thanks for the review! The interdiff is:
index 8ed4761..95f839b 100644
--- a/htools/Ganeti/HTools/Luxi.hs
+++ b/htools/Ganeti/HTools/Luxi.hs
@@ -73,11 +73,11 @@ extractArray :: (Monad m) => JSValue -> m
[[(JSValue, JSValue)]]
extractArray v =
getData v >>= parseQueryResult
--- | Testing responce status for more verbose error message.
-fromJValWithStatus :: (Text.JSON.JSON a, Monad m) => JSValue -> JSValue -> m a
-fromJValWithStatus st v = do
- st' <- fromJVal st
- L.checkRS st' v >>= fromJVal
+-- | Testing result status for more verbose error message.
+fromJValWithStatus :: (Text.JSON.JSON a, Monad m) => (JSValue, JSValue) -> m a
+fromJValWithStatus v = do
+ st <- fromJVal $ fst v
+ L.checkRS st (snd v) >>= fromJVal
-- | Annotate errors when converting values with owner/attribute for
-- better debugging.
@@ -90,7 +90,7 @@ genericConvert :: (Text.JSON.JSON a) =>
genericConvert otype oname oattr =
annotateResult (otype ++ " '" ++ oname ++
"', error while reading attribute '" ++
- oattr ++ "'") . uncurry fromJValWithStatus
+ oattr ++ "'") . fromJValWithStatus
-- * Data querying functionality
@@ -146,11 +146,10 @@ parseInstance :: NameAssoc
parseInstance ktn [ name, disk, mem, vcpus
, status, pnode, snodes, tags, oram
, auto_balance, disk_template ] = do
- xname <- annotateResult "Parsing new instance"
- (uncurry fromJValWithStatus name)
+ xname <- annotateResult "Parsing new instance" (fromJValWithStatus name)
let convert a = genericConvert "Instance" xname a
xdisk <- convert "disk_usage" disk
- xmem <- (case oram of
+ xmem <- (case oram of -- FIXME: remove the "guessing"
(_, JSRational _ _) -> convert "oper_ram" oram
_ -> convert "be/memory" mem)
xvcpus <- convert "be/vcpus" vcpus
@@ -177,8 +176,7 @@ parseNode :: NameAssoc -> [(JSValue, JSValue)] ->
Result (String, Node.Node)
parseNode ktg [ name, mtotal, mnode, mfree, dtotal, dfree
, ctotal, offline, drained, vm_capable, g_uuid ]
= do
- xname <- annotateResult "Parsing new node"
- (uncurry fromJValWithStatus name)
+ xname <- annotateResult "Parsing new node" (fromJValWithStatus name)
let convert a = genericConvert "Node" xname a
xoffline <- convert "offline" offline
xdrained <- convert "drained" drained
@@ -213,8 +211,7 @@ getGroups jsv = extractArray jsv >>= mapM parseGroup
-- | Parses a given group information.
parseGroup :: [(JSValue, JSValue)] -> Result (String, Group.Group)
parseGroup [uuid, name, apol] = do
- xname <- annotateResult "Parsing new group"
- (uncurry fromJValWithStatus name)
+ xname <- annotateResult "Parsing new group" (fromJValWithStatus name)
let convert a = genericConvert "Group" xname a
xuuid <- convert "uuid" uuid
xapol <- convert "alloc_policy" apol
diff --git a/htools/Ganeti/Luxi.hs b/htools/Ganeti/Luxi.hs
index 7456a35..ade6c22 100644
--- a/htools/Ganeti/Luxi.hs
+++ b/htools/Ganeti/Luxi.hs
@@ -28,7 +28,7 @@ Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
module Ganeti.Luxi
( LuxiOp(..)
, QrViaLuxi(..)
- , ResponseStatus(..)
+ , ResultStatus(..)
, Client
, checkRS
, getClient
@@ -147,17 +147,17 @@ $(genLuxiOp "LuxiOp"
-- | The serialisation of LuxiOps into strings in messages.
$(genStrOfOp ''LuxiOp "strOfOp")
-$(declareIADT "ResponseStatus"
+$(declareIADT "ResultStatus"
[ ("RSNormal", 'rsNormal)
, ("RSUnknown", 'rsUnknown)
, ("RSNoData", 'rsNodata)
, ("RSUnavailable", 'rsUnavail)
, ("RSOffline", 'rsOffline)
])
-$(makeJSONInstanceInt ''ResponseStatus)
+$(makeJSONInstanceInt ''ResultStatus)
--- | Check that ResponseStatus is success or fail with descriptive message.
-checkRS :: (Monad m) => ResponseStatus -> a -> m a
+-- | Check that ResultStatus is success or fail with descriptive message.
+checkRS :: (Monad m) => ResultStatus -> a -> m a
checkRS RSNormal val = return val
checkRS RSUnknown _ = fail "Unknown field"
checkRS RSNoData _ = fail "No data for a field"
