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
  22 -- Some constants
  23
  24 -- | The fixed drbd overhead per disk (only used with 1.2's sdx_size)
  25 drbdOverhead = 128
  26
  27 getUrl :: String -> IO (Result String)
  28 getUrl url = do
  29   (code, body) <- curlGetString url [CurlSSLVerifyPeer False,
  30                                      CurlSSLVerifyHost 0]
  31   return (case code of
  32             CurlOK -> Ok body
  33             _ -> Bad $ printf "Curl error for '%s', error %s"
  34                  url (show code))
  35
  36 getInstances :: String -> IO (Result String)
  37 getInstances master = do
  38   let url2 = printf "https://%s:5080/2/instances?bulk=1" master
  39   body <- getUrl url2
  40   return $ (body >>= \x -> do
  41               arr <- loadJSArray x
  42               ilist <- mapM parseInstance arr
  43               return $ unlines ilist)
  44
  45 getNodes :: String -> IO (Result String)
  46 getNodes master = do
  47   let url2 = printf "https://%s:5080/2/nodes?bulk=1" master
  48   body <- getUrl url2
  49   return $ (body >>= \x -> do
  50              arr <- loadJSArray x
  51              nlist <- mapM parseNode arr
  52              return $ unlines nlist)
  53
  54 parseInstance :: JSObject JSValue -> Result String
  55 parseInstance a =
  56     let name = getStringElement "name" a
  57         disk = case getIntElement "disk_usage" a of
  58                  Bad _ -> let log_sz = liftM2 (+)
  59                                        (getIntElement "sda_size" a)
  60                                        (getIntElement "sdb_size" a)
  61                           in liftM2 (+) log_sz (Ok $ drbdOverhead * 2)
  62                  x@(Ok _) -> x
  63         bep = fromObj "beparams" a
  64         pnode = getStringElement "pnode" a
  65         snode = (liftM head $ getListElement "snodes" a)
  66                 >>= readEitherString
  67         mem = case bep of
  68                 Bad _ -> getIntElement "admin_ram" a
  69                 Ok o -> getIntElement "memory" o
  70         running = getStringElement "status" a
  71     in
  72       name |+ (show `liftM` mem) |+
  73               (show `liftM` disk) |+
  74               running |+ pnode |+ snode
  75
  76 boolToYN :: (Monad m) => Bool -> m String
  77 boolToYN True = return "Y"
  78 boolToYN _ = return "N"
  79
  80 parseNode :: JSObject JSValue -> Result String
  81 parseNode a =
  82     let name = getStringElement "name" a
  83         offline = getBoolElement "offline" a
  84         drained = getBoolElement "drained" a
  85         mtotal = getIntElement "mtotal" a
  86         mnode = getIntElement "mnode" a
  87         mfree = getIntElement "mfree" a
  88         dtotal = getIntElement "dtotal" a
  89         dfree = getIntElement "dfree" a
  90     in name |+
  91        (case offline of
  92           Ok True -> Ok "0|0|0|0|0|Y"
  93           _ ->
  94               (show `liftM` mtotal) |+ (show `liftM` mnode) |+
  95               (show `liftM` mfree) |+ (show `liftM` dtotal) |+
  96               (show `liftM` dfree) |+
  97               ((liftM2 (||) offline drained) >>= boolToYN)
  98        )