1 {-| Implementation of the RAPI client interface.
5 module Ganeti.HTools.Rapi
12 import Network.Curl.Types ()
13 import Network.Curl.Code
18 import Text.Printf (printf)
19 import Ganeti.HTools.Utils ()
24 -- | The fixed drbd overhead per disk (only used with 1.2's sdx_size)
27 {-- Our cheap monad-like stuff.
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
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
38 ensureList :: [Either String a] -> Either String [a]
43 (_, Left x) -> Left x -- should never happen
44 (Right e, Right a) -> Right (e:a)
48 listHead :: Either String [a] -> Either String a
52 Right (x:_) -> Right x
53 Right [] -> Left "List empty"
55 loadJSArray :: String -> Either String [JSObject JSValue]
56 loadJSArray s = resultToEither $ decodeStrict s
58 fromObj :: JSON a => String -> JSObject JSValue -> Either String a
60 case lookup k (fromJSObject o) of
61 Nothing -> Left $ printf "key '%s' not found" k
62 Just val -> resultToEither $ readJSON val
64 getStringElement :: String -> JSObject JSValue -> Either String String
65 getStringElement = fromObj
67 getIntElement :: String -> JSObject JSValue -> Either String Int
68 getIntElement = fromObj
70 getListElement :: String -> JSObject JSValue
71 -> Either String [JSValue]
72 getListElement = fromObj
74 readString :: JSValue -> Either String String
77 JSString s -> Right $ fromJSString s
78 _ -> Left "Wrong JSON type"
80 concatElems :: Either String String
81 -> Either String String
82 -> Either String String
83 concatElems = apply2 (\x y -> x ++ "|" ++ y)
85 apply1 :: (a -> b) -> Either String a -> Either String b
89 Right y -> Right $ fn y
91 apply2 :: (a -> b -> c)
97 (Right x, Right y) -> Right $ fn x y
101 getUrl :: String -> IO (Either String String)
103 (code, body) <- curlGetString url [CurlSSLVerifyPeer False,
107 _ -> Left $ printf "Curl error for '%s', error %s"
110 tryRapi :: String -> String -> IO (Either String String)
115 Left _ -> getUrl url2
116 Right _ -> return body1)
118 getInstances :: String -> IO (Either String String)
119 getInstances master =
121 url2 = printf "https://%s:5080/2/instances?bulk=1" master
122 url1 = printf "http://%s:5080/instances?bulk=1" master
124 body <- tryRapi url1 url2
125 let inst = body `combine` loadJSArray `combine` (parseList parseInstance)
128 getNodes :: String -> IO (Either String String)
131 url2 = printf "https://%s:5080/2/nodes?bulk=1" master
132 url1 = printf "http://%s:5080/nodes?bulk=1" master
134 body <- tryRapi url1 url2
135 let inst = body `combine` loadJSArray `combine` (parseList parseNode)
138 parseList :: (JSObject JSValue -> Either String String)
139 -> [JSObject JSValue]
140 ->Either String String
142 let ml = ensureList $ map fn idata
143 in ml `combine` (Right . unlines)
145 parseInstance :: JSObject JSValue -> Either String String
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)
154 bep = fromObj "beparams" a
155 pnode = getStringElement "pnode" a
156 snode = (listHead $ getListElement "snodes" a) `combine` readString
158 Left _ -> getIntElement "admin_ram" a
159 Right o -> getIntElement "memory" o
160 running = getStringElement "status" a
163 concatElems (show `apply1` mem) $
164 concatElems (show `apply1` disk) $
165 concatElems running $
166 concatElems pnode snode
168 parseNode :: JSObject JSValue -> Either String String
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)