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

   1 {-| Implementation of the RAPI client interface.
   2
   3 -}
   4
   5 module Ganeti.HTools.Rapi
   6     (
   7       loadData
   8     ) where
   9
  10 import Network.Curl
  11 import Network.Curl.Types ()
  12 import Network.Curl.Code
  13 import Data.List
  14 import Control.Monad
  15 import Text.JSON (JSObject, JSValue)
  16 import Text.Printf (printf)
  17
  18 import Ganeti.HTools.Utils
  19 import Ganeti.HTools.Loader
  20 import Ganeti.HTools.Types
  21 import qualified Ganeti.HTools.Node as Node
  22 import qualified Ganeti.HTools.Instance as Instance
  23
  24 -- | Read an URL via curl and return the body if successful
  25 getUrl :: (Monad m) => String -> IO (m String)
  26 getUrl url = do
  27   (code, body) <- curlGetString url [CurlSSLVerifyPeer False,
  28                                      CurlSSLVerifyHost 0]
  29   return (case code of
  30             CurlOK -> return body
  31             _ -> fail $ printf "Curl error for '%s', error %s"
  32                  url (show code))
  33
  34 -- | Append the default port if not passed in
  35 formatHost :: String -> String
  36 formatHost master =
  37     if elem ':' master then  master
  38     else "https://" ++ master ++ ":5080"
  39
  40 getInstances :: NameAssoc
  41              -> String
  42              -> Result [(String, Instance.Instance)]
  43 getInstances ktn body = do
  44   arr <- loadJSArray body
  45   ilist <- mapM (parseInstance ktn) arr
  46   return ilist
  47
  48 getNodes :: String -> Result [(String, Node.Node)]
  49 getNodes body = do
  50   arr <- loadJSArray body
  51   nlist <- mapM parseNode arr
  52   return nlist
  53
  54 parseInstance :: [(String, Int)]
  55               -> JSObject JSValue
  56               -> Result (String, Instance.Instance)
  57 parseInstance ktn a = do
  58   name <- fromObj "name" a
  59   disk <- fromObj "disk_usage" a
  60   mem <- fromObj "beparams" a >>= fromObj "memory"
  61   pnode <- fromObj "pnode" a >>= lookupNode ktn name
  62   snodes <- fromObj "snodes" a
  63   snode <- (if null snodes then return Node.noSecondary
  64             else readEitherString (head snodes) >>= lookupNode ktn name)
  65   running <- fromObj "status" a
  66   let inst = Instance.create name mem disk running pnode snode
  67   return (name, inst)
  68
  69 parseNode :: JSObject JSValue -> Result (String, Node.Node)
  70 parseNode a = do
  71     name <- fromObj "name" a
  72     offline <- fromObj "offline" a
  73     node <- (case offline of
  74                True -> return $ Node.create name 0 0 0 0 0 True
  75                _ -> do
  76                  drained <- fromObj "drained" a
  77                  mtotal <- fromObj "mtotal" a
  78                  mnode <- fromObj "mnode" a
  79                  mfree <- fromObj "mfree" a
  80                  dtotal <- fromObj "dtotal" a
  81                  dfree <- fromObj "dfree" a
  82                  return $ Node.create name mtotal mnode mfree
  83                         dtotal dfree (offline || drained))
  84     return (name, node)
  85
  86 loadData :: String -- ^ Cluster/URL to use as source
  87          -> IO (Result (NameAssoc, Node.AssocList,
  88                         NameAssoc, Instance.AssocList))
  89 loadData master = do -- IO monad
  90   let url = formatHost master
  91   node_body <- getUrl $ printf "%s/2/nodes?bulk=1" url
  92   inst_body <- getUrl $ printf "%s/2/instances?bulk=1" url
  93   return $ do -- Result monad
  94     node_data <- node_body >>= getNodes
  95     let (node_names, node_idx) = assignIndices node_data
  96     inst_data <- inst_body >>= getInstances node_names
  97     let (inst_names, inst_idx) = assignIndices inst_data
  98     return (node_names, node_idx, inst_names, inst_idx)