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
> +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?
> -- | 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…
> -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"?
> _ -> 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".
> + [ ("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
