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       getNodes
   8     , getInstances
   9     ) where
  10
  11 import Network.Curl
  12 import Network.Curl.Types ()
  13 import Network.Curl.Code
  14 import Data.Either ()
  15 import Data.Maybe
  16 import Control.Monad
  17 import Text.JSON (JSObject, JSValue)
  18 import Text.Printf (printf)
  19 import Ganeti.HTools.Utils
  20
  21 -- | Read an URL via curl and return the body if successful
  22 getUrl :: (Monad m) => String -> IO (m String)
  23 getUrl url = do
  24   (code, body) <- curlGetString url [CurlSSLVerifyPeer False,
  25                                      CurlSSLVerifyHost 0]
  26   return (case code of
  27             CurlOK -> return body
  28             _ -> fail $ printf "Curl error for '%s', error %s"
  29                  url (show code))
  30
  31 getInstances :: String -> IO (Result String)
  32 getInstances master = do
  33   let url2 = printf "https://%s:5080/2/instances?bulk=1" master
  34   body <- getUrl url2
  35   return $ (body >>= \x -> do
  36               arr <- loadJSArray x
  37               ilist <- mapM parseInstance arr
  38               return $ unlines ilist)
  39
  40 getNodes :: String -> IO (Result String)
  41 getNodes master = do
  42   let url2 = printf "https://%s:5080/2/nodes?bulk=1" master
  43   body <- getUrl url2
  44   return $ (body >>= \x -> do
  45              arr <- loadJSArray x
  46              nlist <- mapM parseNode arr
  47              return $ unlines nlist)
  48
  49 parseInstance :: JSObject JSValue -> Result String
  50 parseInstance a =
  51     let name = getStringElement "name" a
  52         disk = getIntElement "disk_usage" a
  53         mem = getObjectElement "beparams" a >>= getIntElement "memory"
  54         pnode = getStringElement "pnode" a
  55         snode = (liftM head $ getListElement "snodes" a) >>= readEitherString
  56         running = getStringElement "status" a
  57     in
  58       name |+ (show `liftM` mem) |+
  59               (show `liftM` disk) |+
  60               running |+ pnode |+ snode
  61
  62 boolToYN :: (Monad m) => Bool -> m String
  63 boolToYN True = return "Y"
  64 boolToYN _ = return "N"
  65
  66 parseNode :: JSObject JSValue -> Result String
  67 parseNode a =
  68     let name = getStringElement "name" a
  69         offline = getBoolElement "offline" a
  70         drained = getBoolElement "drained" a
  71         mtotal = getIntElement "mtotal" a
  72         mnode = getIntElement "mnode" a
  73         mfree = getIntElement "mfree" a
  74         dtotal = getIntElement "dtotal" a
  75         dfree = getIntElement "dfree" a
  76     in name |+
  77        (case offline of
  78           Ok True -> Ok "0|0|0|0|0|Y"
  79           _ ->
  80               (show `liftM` mtotal) |+ (show `liftM` mnode) |+
  81               (show `liftM` mfree) |+ (show `liftM` dtotal) |+
  82               (show `liftM` dfree) |+
  83               ((liftM2 (||) offline drained) >>= boolToYN)
  84        )