LGTM, thanks

On Thu, Apr 3, 2014 at 4:46 PM, Jose A. Lopes <[email protected]> wrote:

> This will allow the metadata daemon to keep a more general instance
> configuration and thus serve more general requests, such as, serving
> information related to the OS scripts.
>
> Signed-off-by: Jose A. Lopes <[email protected]>
> ---
>  src/Ganeti/Metad/Config.hs    | 15 +++++++++------
>  src/Ganeti/Metad/WebServer.hs | 32 +++++++++++++++++++++++++-------
>  2 files changed, 34 insertions(+), 13 deletions(-)
>
> diff --git a/src/Ganeti/Metad/Config.hs b/src/Ganeti/Metad/Config.hs
> index 83dbdf5..c6b8257 100644
> --- a/src/Ganeti/Metad/Config.hs
> +++ b/src/Ganeti/Metad/Config.hs
> @@ -78,6 +78,14 @@ makeInstanceParams pub priv sec =
>      addVisibility param params =
>        map (second (JSArray . (:[key param]))) (JSON.fromJSObject params)
>
> +getOsParamsWithVisibility :: JSValue -> Result JSValue
> +getOsParamsWithVisibility json =
> +  do obj <- readJSON json
> +     publicOsParams <- getPublicOsParams obj
> +     privateOsParams <- getPrivateOsParams obj
> +     secretOsParams <- getSecretOsParams obj
> +     Ok $ makeInstanceParams publicOsParams privateOsParams secretOsParams
> +
>  -- | Finds the IP address of the instance communication NIC in the
>  -- instance's NICs.
>  getInstanceCommunicationIp :: JSObject JSValue -> Result String
> @@ -121,11 +129,6 @@ getInstanceParams json =
>                    Just (JSString x) -> Ok (JSON.fromJSString x)
>                    _ -> Error "Name is not a string"
>          ip <- getInstanceCommunicationIp jsonObj
> -        publicOsParams <- getPublicOsParams jsonObj
> -        privateOsParams <- getPrivateOsParams jsonObj
> -        secretOsParams <- getSecretOsParams jsonObj
> -        let instanceParams =
> -              makeInstanceParams publicOsParams privateOsParams
> secretOsParams
> -        Ok (name, Map.fromList [(ip, instanceParams)])
> +        Ok (name, Map.fromList [(ip, json)])
>        _ ->
>          Error "Expecting a dictionary"
> diff --git a/src/Ganeti/Metad/WebServer.hs b/src/Ganeti/Metad/WebServer.hs
> index 61f8b4b..0e02fda 100644
> --- a/src/Ganeti/Metad/WebServer.hs
> +++ b/src/Ganeti/Metad/WebServer.hs
> @@ -1,3 +1,4 @@
> +{-# LANGUAGE FlexibleContexts #-}
>  {-| Web server for the metadata daemon.
>
>  -}
> @@ -27,6 +28,7 @@ module Ganeti.Metad.WebServer (start) where
>
>  import Control.Applicative
>  import Control.Concurrent (MVar, readMVar)
> +import Control.Monad.Error.Class (MonadError, catchError, throwError)
>  import Control.Monad.IO.Class (liftIO)
>  import qualified Control.Monad.CatchIO as CatchIO (catch)
>  import Data.Map (Map)
> @@ -35,7 +37,7 @@ import qualified Data.ByteString.Char8 as ByteString
> (pack, unpack)
>  import Snap.Core
>  import Snap.Util.FileServe
>  import Snap.Http.Server
> -import Text.JSON (JSValue, Result(..))
> +import Text.JSON (JSValue, Result(..), JSObject)
>  import qualified Text.JSON as JSON
>
>  import Ganeti.Daemon
> @@ -44,15 +46,34 @@ import qualified Ganeti.Logging as Logging
>  import Ganeti.Runtime (GanetiDaemon(..), ExtraLogReason(..))
>  import qualified Ganeti.Runtime as Runtime
>
> +import Ganeti.Metad.Config as Config
>  import Ganeti.Metad.Types (InstanceParams)
>
>  type MetaM = Snap ()
>
> +lookupInstanceParams :: MonadError String m => String -> Map String b ->
> m b
> +lookupInstanceParams inst params =
> +  case Map.lookup inst params of
> +    Nothing -> throwError $ "Could not get instance params for " ++ show
> inst
> +    Just x -> return x
> +
>  error404 :: MetaM
>  error404 = do
>    modifyResponse . setResponseStatus 404 $ ByteString.pack "Not found"
>    writeBS $ ByteString.pack "Resource not found"
>
> +maybeResult :: MonadError String m => Result t -> (t -> m a) -> m a
> +maybeResult (Error err) _ = throwError err
> +maybeResult (Ok x) f = f x
> +
> +serveOsParams :: String -> Map String JSValue -> MetaM
> +serveOsParams inst params =
> +  do instParams <- lookupInstanceParams inst params
> +     maybeResult (Config.getOsParamsWithVisibility instParams) $
> \osParams ->
> +       writeBS .
> +       ByteString.pack .
> +       JSON.encode $ osParams
> +
>  serveOsPackage :: String -> Map String JSValue -> MetaM
>  serveOsPackage inst instParams =
>    case Map.lookup inst instParams of
> @@ -89,13 +110,10 @@ handleMetadata params GET  "ganeti" "latest"
> "os/parameters.json" =
>       instanceParams <- liftIO $ do
>         Logging.logInfo $ "OS parameters for " ++ show remoteAddr
>         readMVar params
> -     case Map.lookup remoteAddr instanceParams of
> -       Nothing ->
> +     serveOsParams remoteAddr instanceParams `catchError`
> +       \err -> do
> +         liftIO . Logging.logWarning $ "Could not serve OS parameters: "
> ++ err
>           error404
> -       Just osParams ->
> -         writeBS .
> -         ByteString.pack .
> -         JSON.encode $ osParams
>  handleMetadata _ GET  "ganeti" "latest" "read" =
>    liftIO $ Logging.logInfo "ganeti READ"
>  handleMetadata _ POST "ganeti" "latest" "write" =
> --
> 1.9.1.423.g4596e3a
>
>

Reply via email to