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
  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 (Either String String)
  28 getUrl url = do
  29   (code, body) <- curlGetString url [CurlSSLVerifyPeer False,
  30                                      CurlSSLVerifyHost 0]
  31   return (case code of
  32             CurlOK -> Right body
  33             _ -> Left $ printf "Curl error for '%s', error %s"
  34                  url (show code))
  35
  36 getInstances :: String -> IO (Either String String)
  37 getInstances master = do
  38   let url2 = printf "https://%s:5080/2/instances?bulk=1" master
  39   body <- getUrl url2
  40   let inst = body `combineEithers`
  41              loadJSArray `combineEithers`
  42              (parseEitherList parseInstance)
  43   return inst
  44
  45 getNodes :: String -> IO (Either String String)
  46 getNodes master = do
  47   let url2 = printf "https://%s:5080/2/nodes?bulk=1" master
  48   body <- getUrl url2
  49   let inst = body `combineEithers`
  50              loadJSArray `combineEithers`
  51              (parseEitherList parseNode)
  52   return inst
  53
  54 parseInstance :: JSObject JSValue -> Either String String
  55 parseInstance a =
  56     let name = getStringElement "name" a
  57         disk = case getIntElement "disk_usage" a of
  58                  Left _ -> let log_sz = applyEither2 (+)
  59                                         (getIntElement "sda_size" a)
  60                                         (getIntElement "sdb_size" a)
  61                            in applyEither2 (+) log_sz
  62                                   (Right $ drbdOverhead * 2)
  63                  Right x -> Right x
  64         bep = fromObj "beparams" a
  65         pnode = getStringElement "pnode" a
  66         snode = (eitherListHead $ getListElement "snodes" a)
  67                 `combineEithers` readEitherString
  68         mem = case bep of
  69                 Left _ -> getIntElement "admin_ram" a
  70                 Right o -> getIntElement "memory" o
  71         running = getStringElement "status" a
  72     in
  73       concatEitherElems name $
  74                   concatEitherElems (show `applyEither1` mem) $
  75                   concatEitherElems (show `applyEither1` disk) $
  76                   concatEitherElems running $
  77                   concatEitherElems pnode snode
  78
  79 boolToYN :: Bool -> Either String String
  80 boolToYN True = Right "Y"
  81 boolToYN _ = Right "N"
  82
  83 parseNode :: JSObject JSValue -> Either String String
  84 parseNode a =
  85     let name = getStringElement "name" a
  86         offline = getBoolElement "offline" a
  87         drained = getBoolElement "drained" a
  88         mtotal = getIntElement "mtotal" a
  89         mnode = getIntElement "mnode" a
  90         mfree = getIntElement "mfree" a
  91         dtotal = getIntElement "dtotal" a
  92         dfree = getIntElement "dfree" a
  93     in concatEitherElems name $
  94        (case offline of
  95           Right True -> Right "0|0|0|0|0|Y"
  96           _ ->
  97               concatEitherElems (show `applyEither1` mtotal) $
  98               concatEitherElems (show `applyEither1` mnode) $
  99               concatEitherElems (show `applyEither1` mfree) $
 100               concatEitherElems (show `applyEither1` dtotal) $
 101               concatEitherElems (show `applyEither1` dfree)
 102               ((applyEither2 (||) offline drained) `combineEithers` boolToYN)
 103        )