code.grnet.gr Git - ganeti-local/blob - Ganeti/HTools/Rapi.hs

   1 {-| Implementation of the RAPI client interface.
   2
   3 -}
   4
   5 {-
   6
   7 Copyright (C) 2009 Google Inc.
   8
   9 This program is free software; you can redistribute it and/or modify
  10 it under the terms of the GNU General Public License as published by
  11 the Free Software Foundation; either version 2 of the License, or
  12 (at your option) any later version.
  13
  14 This program is distributed in the hope that it will be useful, but
  15 WITHOUT ANY WARRANTY; without even the implied warranty of
  16 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  17 General Public License for more details.
  18
  19 You should have received a copy of the GNU General Public License
  20 along with this program; if not, write to the Free Software
  21 Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
  22 02110-1301, USA.
  23
  24 -}
  25
  26 module Ganeti.HTools.Rapi
  27     (
  28       loadData
  29     , parseData
  30     ) where
  31
  32 import Network.Curl
  33 import Network.Curl.Types ()
  34 import Control.Monad
  35 import Text.JSON (JSObject, JSValue, fromJSObject, decodeStrict)
  36 import Text.JSON.Types (JSValue(..))
  37 import Text.Printf (printf)
  38
  39 import Ganeti.HTools.Utils
  40 import Ganeti.HTools.Loader
  41 import Ganeti.HTools.Types
  42 import qualified Ganeti.HTools.Node as Node
  43 import qualified Ganeti.HTools.Instance as Instance
  44
  45 -- | Read an URL via curl and return the body if successful.
  46 getUrl :: (Monad m) => String -> IO (m String)
  47 getUrl url = do
  48   (code, body) <- curlGetString url [CurlSSLVerifyPeer False,
  49                                      CurlSSLVerifyHost 0,
  50                                      CurlTimeout (fromIntegral queryTimeout),
  51                                      CurlConnectTimeout
  52                                      (fromIntegral connTimeout)]
  53   return (case code of
  54             CurlOK -> return body
  55             _ -> fail $ printf "Curl error for '%s', error %s"
  56                  url (show code))
  57
  58 -- | Append the default port if not passed in.
  59 formatHost :: String -> String
  60 formatHost master =
  61     if ':' `elem` master then  master
  62     else "https://" ++ master ++ ":5080"
  63
  64 -- | Parse a instance list in JSON format.
  65 getInstances :: NameAssoc
  66              -> String
  67              -> Result [(String, Instance.Instance)]
  68 getInstances ktn body =
  69     loadJSArray "Parsing instance data" body >>=
  70     mapM (parseInstance ktn . fromJSObject)
  71
  72 -- | Parse a node list in JSON format.
  73 getNodes :: String -> Result [(String, Node.Node)]
  74 getNodes body = loadJSArray "Parsing node data" body >>=
  75                 mapM (parseNode . fromJSObject)
  76
  77 -- | Construct an instance from a JSON object.
  78 parseInstance :: [(String, Ndx)]
  79               -> [(String, JSValue)]
  80               -> Result (String, Instance.Instance)
  81 parseInstance ktn a = do
  82   name <- tryFromObj "Parsing new instance" a "name"
  83   let owner_name = "Instance '" ++ name ++ "'"
  84   let extract s x = tryFromObj owner_name x s
  85   disk <- extract "disk_usage" a
  86   beparams <- liftM fromJSObject (extract "beparams" a)
  87   omem <- extract "oper_ram" a
  88   mem <- (case omem of
  89             JSRational _ _ -> annotateResult owner_name (fromJVal omem)
  90             _ -> extract "memory" beparams)
  91   vcpus <- extract "vcpus" beparams
  92   pnode <- extract "pnode" a >>= lookupNode ktn name
  93   snodes <- extract "snodes" a
  94   snode <- (if null snodes then return Node.noSecondary
  95             else readEitherString (head snodes) >>= lookupNode ktn name)
  96   running <- extract "status" a
  97   tags <- extract "tags" a
  98   let inst = Instance.create name mem disk vcpus running tags pnode snode
  99   return (name, inst)
 100
 101 -- | Construct a node from a JSON object.
 102 parseNode :: [(String, JSValue)] -> Result (String, Node.Node)
 103 parseNode a = do
 104   name <- tryFromObj "Parsing new node" a "name"
 105   let extract s = tryFromObj ("Node '" ++ name ++ "'") a s
 106   offline <- extract "offline"
 107   drained <- extract "drained"
 108   guuid   <- extract "group.uuid"
 109   node <- (if offline || drained
 110            then return $ Node.create name 0 0 0 0 0 0 True guuid
 111            else do
 112              mtotal  <- extract "mtotal"
 113              mnode   <- extract "mnode"
 114              mfree   <- extract "mfree"
 115              dtotal  <- extract "dtotal"
 116              dfree   <- extract "dfree"
 117              ctotal  <- extract "ctotal"
 118              return $ Node.create name mtotal mnode mfree
 119                     dtotal dfree ctotal False guuid)
 120   return (name, node)
 121
 122 -- | Loads the raw cluster data from an URL.
 123 readData :: String -- ^ Cluster or URL to use as source
 124          -> IO (Result String, Result String, Result String)
 125 readData master = do
 126   let url = formatHost master
 127   node_body <- getUrl $ printf "%s/2/nodes?bulk=1" url
 128   inst_body <- getUrl $ printf "%s/2/instances?bulk=1" url
 129   tags_body <- getUrl $ printf "%s/2/tags" url
 130   return (node_body, inst_body, tags_body)
 131
 132 -- | Builds the cluster data from the raw Rapi content
 133 parseData :: (Result String, Result String, Result String)
 134           -> Result (Node.AssocList, Instance.AssocList, [String])
 135 parseData (node_body, inst_body, tags_body) = do
 136   node_data <- node_body >>= getNodes
 137   let (node_names, node_idx) = assignIndices node_data
 138   inst_data <- inst_body >>= getInstances node_names
 139   let (_, inst_idx) = assignIndices inst_data
 140   tags_data <- tags_body >>= (fromJResult "Parsing tags data" . decodeStrict)
 141   return (node_idx, inst_idx, tags_data)
 142
 143 -- | Top level function for data loading
 144 loadData :: String -- ^ Cluster or URL to use as source
 145             -> IO (Result (Node.AssocList, Instance.AssocList, [String]))
 146 loadData master = readData master >>= return . parseData