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 {-- Our cheap monad-like stuff.
  28
  29 Thi is needed since Either e a is already a monad instance somewhere
  30 in the standard libraries (Control.Monad.Error) and we don't need that
  31 entire thing.
  32
  33 -}
  34 combine :: (Either String a) -> (a -> Either String b)  -> (Either String b)
  35 combine (Left s) _ = Left s
  36 combine (Right s) f = f s
  37
  38 ensureList :: [Either String a] -> Either String [a]
  39 ensureList lst =
  40     foldr (\elem accu ->
  41                case (elem, accu) of
  42                  (Left x, _) -> Left x
  43                  (_, Left x) -> Left x -- should never happen
  44                  (Right e, Right a) -> Right (e:a)
  45           )
  46     (Right []) lst
  47
  48 listHead :: Either String [a] -> Either String a
  49 listHead lst =
  50     case lst of
  51       Left x -> Left x
  52       Right (x:_) -> Right x
  53       Right [] -> Left "List empty"
  54
  55 loadJSArray :: String -> Either String [JSObject JSValue]
  56 loadJSArray s = resultToEither $ decodeStrict s
  57
  58 fromObj :: JSON a => String -> JSObject JSValue -> Either String a
  59 fromObj k o =
  60     case lookup k (fromJSObject o) of
  61       Nothing -> Left $ printf "key '%s' not found" k
  62       Just val -> resultToEither $ readJSON val
  63
  64 getStringElement :: String -> JSObject JSValue -> Either String String
  65 getStringElement = fromObj
  66
  67 getIntElement :: String -> JSObject JSValue -> Either String Int
  68 getIntElement = fromObj
  69
  70 getListElement :: String -> JSObject JSValue
  71                -> Either String [JSValue]
  72 getListElement = fromObj
  73
  74 readString :: JSValue -> Either String String
  75 readString v =
  76     case v of
  77       JSString s -> Right $ fromJSString s
  78       _ -> Left "Wrong JSON type"
  79
  80 concatElems :: Either String String
  81             -> Either String String
  82             -> Either String String
  83 concatElems = apply2 (\x y -> x ++ "|" ++ y)
  84
  85 apply1 :: (a -> b) -> Either String a -> Either String b
  86 apply1 fn a =
  87     case a of
  88       Left x -> Left x
  89       Right y -> Right $ fn y
  90
  91 apply2 :: (a -> b -> c)
  92        -> Either String a
  93        -> Either String b
  94        -> Either String c
  95 apply2 fn a b =
  96     case (a, b) of
  97       (Right x, Right y) -> Right $ fn x y
  98       (Left x, _) -> Left x
  99       (_, Left y) -> Left y
 100
 101 getUrl :: String -> IO (Either String String)
 102 getUrl url = do
 103   (code, body) <- curlGetString url [CurlSSLVerifyPeer False,
 104                                      CurlSSLVerifyHost 0]
 105   return (case code of
 106             CurlOK -> Right body
 107             _ -> Left $ printf "Curl error for '%s', error %s"
 108                  url (show code))
 109
 110 tryRapi :: String -> String -> IO (Either String String)
 111 tryRapi url1 url2 =
 112     do
 113       body1 <- getUrl url1
 114       (case body1 of
 115          Left _ -> getUrl url2
 116          Right _ -> return body1)
 117
 118 getInstances :: String -> IO (Either String String)
 119 getInstances master =
 120     let
 121         url2 = printf "https://%s:5080/2/instances?bulk=1" master
 122         url1 = printf "http://%s:5080/instances?bulk=1" master
 123     in do
 124       body <- tryRapi url1 url2
 125       let inst = body `combine` loadJSArray `combine` (parseList parseInstance)
 126       return inst
 127
 128 getNodes :: String -> IO (Either String String)
 129 getNodes master =
 130     let
 131         url2 = printf "https://%s:5080/2/nodes?bulk=1" master
 132         url1 = printf "http://%s:5080/nodes?bulk=1" master
 133     in do
 134       body <- tryRapi url1 url2
 135       let inst = body `combine` loadJSArray `combine` (parseList parseNode)
 136       return inst
 137
 138 parseList :: (JSObject JSValue -> Either String String)
 139           -> [JSObject JSValue]
 140           ->Either String String
 141 parseList fn idata =
 142     let ml = ensureList $ map fn idata
 143     in ml `combine` (Right . unlines)
 144
 145 parseInstance :: JSObject JSValue -> Either String String
 146 parseInstance a =
 147     let name = getStringElement "name" a
 148         disk = case getIntElement "disk_usage" a of
 149                  Left _ -> let log_sz = apply2 (+)
 150                                         (getIntElement "sda_size" a)
 151                                         (getIntElement "sdb_size" a)
 152                            in apply2 (+) log_sz (Right $ drbdOverhead * 2)
 153                  Right x -> Right x
 154         bep = fromObj "beparams" a
 155         pnode = getStringElement "pnode" a
 156         snode = (listHead $ getListElement "snodes" a) `combine` readString
 157         mem = case bep of
 158                 Left _ -> getIntElement "admin_ram" a
 159                 Right o -> getIntElement "memory" o
 160         running = getStringElement "status" a
 161     in
 162       concatElems name $
 163                   concatElems (show `apply1` mem) $
 164                   concatElems (show `apply1` disk) $
 165                   concatElems running $
 166                   concatElems pnode snode
 167
 168 parseNode :: JSObject JSValue -> Either String String
 169 parseNode a =
 170     let name = getStringElement "name" a
 171         mtotal = getIntElement "mtotal" a
 172         mnode = getIntElement "mnode" a
 173         mfree = getIntElement "mfree" a
 174         dtotal = getIntElement "dtotal" a
 175         dfree = getIntElement "dfree" a
 176     in concatElems name $
 177        concatElems (show `apply1` mtotal) $
 178        concatElems (show `apply1` mnode) $
 179        concatElems (show `apply1` mfree) $
 180        concatElems (show `apply1` dtotal) (show `apply1` dfree)