code.grnet.gr Git - ganeti-local/blob - src/Rapi.hs

   1 {-| Implementation of the RAPI client interface.
   2
   3 -}
   4
   5 module Rapi
   6     where
   7
   8 import Network.Curl
   9 import Network.Curl.Types ()
  10 import Network.Curl.Code
  11 import Data.Either ()
  12 import Data.Maybe ()
  13 import Control.Monad
  14 import Text.JSON
  15 import Text.Printf (printf)
  16 import Utils ()
  17
  18
  19 {-- Our cheap monad-like stuff.
  20
  21 Thi is needed since Either e a is already a monad instance somewhere
  22 in the standard libraries (Control.Monad.Error) and we don't need that
  23 entire thing.
  24
  25 -}
  26 combine :: (Either String a) -> (a -> Either String b)  -> (Either String b)
  27 combine (Left s) _ = Left s
  28 combine (Right s) f = f s
  29
  30 ensureList :: [Either String a] -> Either String [a]
  31 ensureList lst =
  32     foldr (\elem accu ->
  33                case (elem, accu) of
  34                  (Left x, _) -> Left x
  35                  (_, Left x) -> Left x -- should never happen
  36                  (Right e, Right a) -> Right (e:a)
  37           )
  38     (Right []) lst
  39
  40 listHead :: Either String [a] -> Either String a
  41 listHead lst =
  42     case lst of
  43       Left x -> Left x
  44       Right (x:_) -> Right x
  45       Right [] -> Left "List empty"
  46
  47 loadJSArray :: String -> Either String [JSObject JSValue]
  48 loadJSArray s = resultToEither $ decodeStrict s
  49
  50 getStringElement :: String -> JSObject JSValue -> Either String String
  51 getStringElement key o =
  52     resultToEither $ valFromObj key o
  53
  54 getIntElement :: String -> JSObject JSValue -> Either String String
  55 getIntElement key o =
  56     let tmp = resultToEither $ ((valFromObj key o)::Result Int)
  57     in case tmp of
  58          Left x -> Left x
  59          Right x -> Right $ show x
  60
  61 getListElement :: String -> JSObject JSValue
  62                -> Either String [JSValue]
  63 getListElement key o =
  64     let tmp = resultToEither $ ((valFromObj key o)::Result [JSValue])
  65     in tmp
  66
  67 readString :: JSValue -> Either String String
  68 readString v =
  69     case v of
  70       JSString s -> Right $ fromJSString s
  71       _ -> Left "Wrong JSON type"
  72
  73 concatElems a b =
  74     case a of
  75       Left _ -> a
  76       Right [] -> b
  77       Right x ->
  78           case b of
  79             Left _ -> b
  80             Right y ->  Right (x ++ "|" ++ y)
  81
  82 getUrl :: String -> IO (Either String String)
  83 getUrl url = do
  84   (code, body) <- curlGetString url [CurlSSLVerifyPeer False,
  85                                      CurlSSLVerifyHost 0]
  86   return (case code of
  87             CurlOK -> Right body
  88             _ -> Left $ printf "url:%s, error: %s" url (show code))
  89
  90 getInstances :: String -> IO (Either String String)
  91 getInstances master =
  92     let url = printf "https://%s:5080/2/instances?bulk=1" master
  93     in do
  94       body <- getUrl  url
  95       let inst = body `combine` loadJSArray `combine` (parseList parseInstance)
  96       return inst
  97
  98 getNodes :: String -> IO (Either String String)
  99 getNodes master =
 100     let url = printf "https://%s:5080/2/nodes?bulk=1" master
 101     in do
 102       body <- getUrl  url
 103       let inst = body `combine` loadJSArray `combine` (parseList parseNode)
 104       return inst
 105
 106 parseList :: (JSObject JSValue -> Either String String)
 107           -> [JSObject JSValue]
 108           ->Either String String
 109 parseList fn idata =
 110     let ml = ensureList $ map fn idata
 111     in ml `combine` (Right . unlines)
 112
 113 parseInstance :: JSObject JSValue -> Either String String
 114 parseInstance a =
 115     let name = getStringElement "name" a
 116         disk = case getIntElement "disk_usage" a of
 117                  Left _ -> getIntElement "sda_size" a
 118                  Right x -> Right x
 119         bep = (resultToEither $ valFromObj "beparams" a)
 120         pnode = getStringElement "pnode" a
 121         snode = (listHead $ getListElement "snodes" a) `combine` readString
 122     in
 123       case bep of
 124         Left x -> Left x
 125         Right x -> let mem = getIntElement "memory" x
 126                    in concatElems name $ concatElems mem $
 127                       concatElems disk $ concatElems pnode snode
 128
 129 parseNode :: JSObject JSValue -> Either String String
 130 parseNode a =
 131     let name = getStringElement "name" a
 132         mtotal = getIntElement "mtotal" a
 133         mfree = getIntElement "mfree" a
 134         dtotal = getIntElement "dtotal" a
 135         dfree = getIntElement "dfree" a
 136     in concatElems name $ concatElems mtotal $ concatElems mfree $
 137        concatElems dtotal dfree