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

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