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. > 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. > +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. > + > -- | 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. > +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) > + > +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. > + 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
