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