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 fromObj :: JSON a => String -> JSObject JSValue -> Either String a
  51 fromObj k o =
  52     case lookup k (fromJSObject o) of
  53       Nothing -> Left $ printf "key '%s' not found" k
  54       Just val -> resultToEither $ readJSON val
  55
  56 getStringElement :: String -> JSObject JSValue -> Either String String
  57 getStringElement key o = fromObj key o
  58
  59 getIntElement :: String -> JSObject JSValue -> Either String String
  60 getIntElement key o =
  61     let tmp = (fromObj key o)::Either String Int
  62     in case tmp of
  63          Left x -> Left x
  64          Right x -> Right $ show x
  65
  66 getListElement :: String -> JSObject JSValue
  67                -> Either String [JSValue]
  68 getListElement key o = fromObj key o
  69
  70 readString :: JSValue -> Either String String
  71 readString v =
  72     case v of
  73       JSString s -> Right $ fromJSString s
  74       _ -> Left "Wrong JSON type"
  75
  76 concatElems :: Either String String
  77             -> Either String String
  78             -> Either String String
  79 concatElems = apply2 (\x y -> x ++ "|" ++ y)
  80
  81 apply2 :: (a -> b -> c)
  82        -> Either String a
  83        -> Either String b
  84        -> Either String c
  85 apply2 fn a b =
  86     case (a, b) of
  87       (Right x, Right y) -> Right $ fn x y
  88       (Left x, _) -> Left x
  89       (_, Left y) -> Left y
  90
  91 getUrl :: String -> IO (Either String String)
  92 getUrl url = do
  93   (code, body) <- curlGetString url [CurlSSLVerifyPeer False,
  94                                      CurlSSLVerifyHost 0]
  95   return (case code of
  96             CurlOK -> Right body
  97             _ -> Left $ printf "Curl error for '%s', error %s"
  98                  url (show code))
  99
 100 tryRapi :: String -> String -> IO (Either String String)
 101 tryRapi url1 url2 =
 102     do
 103       body1 <- getUrl url1
 104       body2 <- getUrl url2
 105       return (case body1 of
 106                 Left _ -> body2
 107                 Right _ -> body1)
 108
 109 getInstances :: String -> IO (Either String String)
 110 getInstances master =
 111     let
 112         url2 = printf "https://%s:5080/2/instances?bulk=1" master
 113         url1 = printf "http://%s:5080/instances?bulk=1" master
 114     in do
 115       body <- tryRapi url1 url2
 116       let inst = body `combine` loadJSArray `combine` (parseList parseInstance)
 117       return inst
 118
 119 getNodes :: String -> IO (Either String String)
 120 getNodes master =
 121     let
 122         url2 = printf "https://%s:5080/2/nodes?bulk=1" master
 123         url1 = printf "http://%s:5080/nodes?bulk=1" master
 124     in do
 125       body <- tryRapi url1 url2
 126       let inst = body `combine` loadJSArray `combine` (parseList parseNode)
 127       return inst
 128
 129 parseList :: (JSObject JSValue -> Either String String)
 130           -> [JSObject JSValue]
 131           ->Either String String
 132 parseList fn idata =
 133     let ml = ensureList $ map fn idata
 134     in ml `combine` (Right . unlines)
 135
 136 parseInstance :: JSObject JSValue -> Either String String
 137 parseInstance a =
 138     let name = getStringElement "name" a
 139         disk = case getIntElement "disk_usage" a of
 140                  Left _ -> apply2 (\x y -> show $ ((read x)::Int) + ((read y)::Int))
 141                            (getIntElement "sda_size" a)
 142                            (getIntElement "sdb_size" a)
 143                  Right x -> Right x
 144         bep = fromObj "beparams" a
 145         pnode = getStringElement "pnode" a
 146         snode = (listHead $ getListElement "snodes" a) `combine` readString
 147         mem = case bep of
 148                 Left _ -> getIntElement "admin_ram" a
 149                 Right _ -> bep
 150     in
 151       concatElems name $ concatElems mem $
 152                   concatElems disk $ concatElems pnode snode
 153
 154 parseNode :: JSObject JSValue -> Either String String
 155 parseNode a =
 156     let name = getStringElement "name" a
 157         mtotal = getIntElement "mtotal" a
 158         mfree = getIntElement "mfree" a
 159         dtotal = getIntElement "dtotal" a
 160         dfree = getIntElement "dfree" a
 161     in concatElems name $ concatElems mtotal $ concatElems mfree $
 162        concatElems dtotal dfree