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