Fixed! I will send the complete patch in response to this mail.
On Tue, Aug 12, 2014 at 11:11 AM, Michele Tartara <[email protected]> wrote: > > Il 11/ago/2014 09:28 "'Aaron Karper' via ganeti-devel" < > [email protected]> ha scritto: > > > > > The ConfdRequestType is ReqConfigQuery with a plain query of the RFC6901 > > path. This responds with the complete JSON object at that location. > > > > You might want to specify here the number of the issue on the big tracker > it closes. > Done. > > Signed-off-by: Aaron Karper <[email protected]> > > --- > > src/Ganeti/Confd/Server.hs | 12 +++++++++++ > > src/Ganeti/Confd/Types.hs | 21 +++++++++--------- > > src/Ganeti/Confd/Utils.hs | 53 > ++++++++++++++++++++++++++++++++++++++++++++++ > > src/Ganeti/Constants.hs | 3 +++ > > 4 files changed, 79 insertions(+), 10 deletions(-) > > > > diff --git a/src/Ganeti/Confd/Server.hs b/src/Ganeti/Confd/Server.hs > > index 795681d..855d1fc 100644 > > --- a/src/Ganeti/Confd/Server.hs > > +++ b/src/Ganeti/Confd/Server.hs > > @@ -232,6 +232,18 @@ buildResponse cdata req@(ConfdRequest { > confdRqType = ReqInstanceDisks }) = do > > Ok disks -> return (ReplyStatusOk, J.showJSON disks) > > Bad e -> fail $ "Could not retrieve disks: " ++ show e > > > > +-- | Return arbitrary configuration value given by a path. > > Arbitrary has a very specific meaning in the Haskell world (QuickCheck). > Even if here we are not dealing with testing, I'd still avoid that word to > avoid confusion. > --- | Use a Pointer to access an arbitrary value nested in a JSON object. +-- | Use a Pointer to access any value nested in a JSON object. > > +buildResponse cdata req@(ConfdRequest { confdRqType = ReqConfigQuery, > confdRqQuery = pathQ }) = do > > Does this line fit in the 80 chars limit? > > > + let cfg = fst cdata > > + path <- > > + case pathQ of > > + PlainQuery path -> return path > > + _ -> fail $ "Invalid query type " ++ show (confdRqQuery req) > > + let configValue = extractJSONPath path cfg > > + case configValue of > > + J.Ok jsvalue -> return (ReplyStatusOk, jsvalue) > > + J.Error e -> fail $ "Couldn't retrieve value: " ++ show e > > BuildResponse cannot just fail: it needs to return a failure value. Have a > look at the code of the other queries: fail is sometimes used, but only as > a temporary value halfway through the implementation, not as the final > result of the function. Otherwise ConfD would just crash, and this is not > something we want. > - J.Error e -> fail $ "Couldn't retrieve value: " ++ show e + J.Error e -> return queryArgumentError The earlier fail should be ok, it only happens on a protocol failure (Confd doesn't crash, serializeResponse gives ReplyStatusError with a string of the error as a response). > > + > > -- | Creates a ConfdReply from a given answer. > > serializeResponse :: Result StatusAnswer -> ConfdReply > > serializeResponse r = > > diff --git a/src/Ganeti/Confd/Types.hs b/src/Ganeti/Confd/Types.hs > > index acf4b26..8eed390 100644 > > --- a/src/Ganeti/Confd/Types.hs > > +++ b/src/Ganeti/Confd/Types.hs > > @@ -54,16 +54,17 @@ import Ganeti.THH > > import Ganeti.Utils (newUUID) > > > > $(declareILADT "ConfdRequestType" > > - [ ("ReqPing", 0) > > - , ("ReqNodeRoleByName", 1) > > - , ("ReqNodePipByInstPip", 2) > > - , ("ReqClusterMaster", 3) > > - , ("ReqNodePipList", 4) > > - , ("ReqMcPipList", 5) > > - , ("ReqInstIpsList", 6) > > - , ("ReqNodeDrbd", 7) > > - , ("ReqNodeInstances", 8) > > - , ("ReqInstanceDisks", 9) > > + [ ("ReqPing", 0) > > + , ("ReqNodeRoleByName", 1) > > + , ("ReqNodePipByInstPip", 2) > > + , ("ReqClusterMaster", 3) > > + , ("ReqNodePipList", 4) > > + , ("ReqMcPipList", 5) > > + , ("ReqInstIpsList", 6) > > + , ("ReqNodeDrbd", 7) > > + , ("ReqNodeInstances", 8) > > + , ("ReqInstanceDisks", 9) > > + , ("ReqConfigQuery", 10) > > ]) > > $(makeJSONInstance ''ConfdRequestType) > > > > diff --git a/src/Ganeti/Confd/Utils.hs b/src/Ganeti/Confd/Utils.hs > > index 41454ce..b09340b 100644 > > --- a/src/Ganeti/Confd/Utils.hs > > +++ b/src/Ganeti/Confd/Utils.hs > > @@ -33,9 +33,14 @@ module Ganeti.Confd.Utils > > , parseReply > > , signMessage > > , getCurrentTime > > + , extractJSONPath > > ) where > > > > +import qualified Data.Attoparsec.Text as P > > + > > +import Control.Applicative ((*>)) > > import qualified Data.ByteString as B > > +import Data.Text (pack) > > import qualified Text.JSON as J > > > > import Ganeti.BasicTypes > > @@ -95,3 +100,51 @@ signMessage key salt msg = > > , signedMsgHmac = hmac > > } > > where hmac = computeMac key (Just salt) msg > > + > > +data Pointer = Pointer [String] > > + deriving (Show, Eq) > > Docstring is missing > > > + > > +extractJSONPath :: J.JSON a => String -> a -> J.Result J.JSValue > > Docstring is missing. Every function, no matter how small, should have it. > Please add all of them. > +-- | Extract a JSValue from an object at the position defined by the path. +-- +-- The path syntax follows RCF6901. Error is returned if the path doesn't +-- exist, Ok if the path leads to an valid value. +-- +-- JSON pointer syntax according to RFC6901: +-- "/path/0/x" => Pointer ["path", "0", "x"] +-- This accesses 1 in the following JSON: +-- { "path": { "0": { "x": 1 } } } +-- +-- or the following: +-- +-- { "path": [{"x": 1}] } extractJSONPath :: J.JSON a => String -> a -> J.Result J.JSValue +-- | Parse a fixed size Int. readInteger :: String -> J.Result Int --- | JSON pointer syntax according to RFC6901: --- "/path/0/x" => Pointer ["path", "0", "x"] --- This accesses 1 in the following JSON: --- { "path": { "0": { "x": 1 } } } --- --- or the following: --- --- { "path": [{"x": 1}] } +-- | Parse a path for a JSON structure. pointerFromString :: String -> J.Result Pointer > > +extractJSONPath path obj = do > > + pointer <- pointerFromString path > > + extractValue pointer obj > > We tend to write the functions in a C-like order: first the ones being > used, then the ones using it. Please reorder them (extractJSONPath should > be after pointerFromString, and so on) > Sorted functions in topological order. The diff is a bit unwieldy. > > + > > +readInteger :: String -> J.Result Int > > +readInteger = either J.Error J.Ok . P.parseOnly P.decimal . pack > > + > > +-- | JSON pointer syntax according to RFC6901: > > +-- "/path/0/x" => Pointer ["path", "0", "x"] > > +-- This accesses 1 in the following JSON: > > +-- { "path": { "0": { "x": 1 } } } > > +-- > > +-- or the following: > > +-- > > +-- { "path": [{"x": 1}] } > > The docstring can include details like the ones you wrote here, but first > there should be the description of the function. > > > +pointerFromString :: String -> J.Result Pointer > > +pointerFromString s = either J.Error J.Ok $ P.parseOnly parser $ pack s > > + where > > + parser = do > > + tokens <- token `P.manyTill` P.endOfInput > > + return $ Pointer tokens > > + token = do > > + P.char '/' *> (P.many' $ P.choice [escaped, P.satisfy $ > P.notInClass "~/"]) > > + escaped = P.choice [escapedSlash, escapedTilde] > > + escapedSlash = P.string (pack "~1") *> return '/' > > + escapedTilde = P.string (pack "~0") *> return '~' > > + > > +-- | Use a Pointer to access an arbitrary value nested in a JSON object. > > +extractValue :: J.JSON a => Pointer -> a -> J.Result J.JSValue > > +extractValue (Pointer l) json = getJSValue l $ J.showJSON json > > Style: newline after the equal sign, unless everything fits on that line. > -extractValue (Pointer l) json = getJSValue l $ J.showJSON json +extractValue (Pointer l) json = + getJSValue l $ J.showJSON json > > + where > > + indexWithString x (J.JSObject object) = J.valFromObj x object > > + indexWithString x (J.JSArray list) = do > > + i <- readInteger x > > + if 0 <= i && i < length list > > + then return $ list !! i > > + else J.Error ("list index " ++ show i ++ " out of bounds") > > + indexWithString _ _ = J.Error "Atomic value was indexed" > > + getJSValue :: [String] -> J.JSValue -> J.Result J.JSValue > > + getJSValue [] js = J.Ok js > > + getJSValue (x:xs) js = do > > + value <- indexWithString x js > > + getJSValue xs value > > diff --git a/src/Ganeti/Constants.hs b/src/Ganeti/Constants.hs > > index 89459f6..eb33ba8 100644 > > --- a/src/Ganeti/Constants.hs > > +++ b/src/Ganeti/Constants.hs > > @@ -4217,6 +4217,9 @@ confdReqNodeInstances = > Types.confdRequestTypeToRaw ReqNodeInstances > > confdReqInstanceDisks :: Int > > confdReqInstanceDisks = Types.confdRequestTypeToRaw ReqInstanceDisks > > > > +confdReqConfigQuery :: Int > > +confdReqConfigQuery = Types.confdRequestTypeToRaw ReqConfigQuery > > + > > confdReqs :: FrozenSet Int > > confdReqs = > > ConstantUtils.mkSet . > > -- > > 2.0.0.526.g5318336 > > > > Thanks, > Michele >
