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 ()
22 {-- Our cheap monad-like stuff.
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
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
33 ensureList :: [Either String a] -> Either String [a]
38 (_, Left x) -> Left x -- should never happen
39 (Right e, Right a) -> Right (e:a)
43 listHead :: Either String [a] -> Either String a
47 Right (x:_) -> Right x
48 Right [] -> Left "List empty"
50 loadJSArray :: String -> Either String [JSObject JSValue]
51 loadJSArray s = resultToEither $ decodeStrict s
53 fromObj :: JSON a => String -> JSObject JSValue -> Either String a
55 case lookup k (fromJSObject o) of
56 Nothing -> Left $ printf "key '%s' not found" k
57 Just val -> resultToEither $ readJSON val
59 getStringElement :: String -> JSObject JSValue -> Either String String
60 getStringElement = fromObj
62 getIntElement :: String -> JSObject JSValue -> Either String Int
63 getIntElement = fromObj
65 getListElement :: String -> JSObject JSValue
66 -> Either String [JSValue]
67 getListElement = fromObj
69 readString :: JSValue -> Either String String
72 JSString s -> Right $ fromJSString s
73 _ -> Left "Wrong JSON type"
75 concatElems :: Either String String
76 -> Either String String
77 -> Either String String
78 concatElems = apply2 (\x y -> x ++ "|" ++ y)
80 apply1 :: (a -> b) -> Either String a -> Either String b
84 Right y -> Right $ fn y
86 apply2 :: (a -> b -> c)
92 (Right x, Right y) -> Right $ fn x y
96 getUrl :: String -> IO (Either String String)
98 (code, body) <- curlGetString url [CurlSSLVerifyPeer False,
102 _ -> Left $ printf "Curl error for '%s', error %s"
105 tryRapi :: String -> String -> IO (Either String String)
110 Left _ -> getUrl url2
111 Right _ -> return body1)
113 getInstances :: String -> IO (Either String String)
114 getInstances master =
116 url2 = printf "https://%s:5080/2/instances?bulk=1" master
117 url1 = printf "http://%s:5080/instances?bulk=1" master
119 body <- tryRapi url1 url2
120 let inst = body `combine` loadJSArray `combine` (parseList parseInstance)
123 getNodes :: String -> IO (Either String String)
126 url2 = printf "https://%s:5080/2/nodes?bulk=1" master
127 url1 = printf "http://%s:5080/nodes?bulk=1" master
129 body <- tryRapi url1 url2
130 let inst = body `combine` loadJSArray `combine` (parseList parseNode)
133 parseList :: (JSObject JSValue -> Either String String)
134 -> [JSObject JSValue]
135 ->Either String String
137 let ml = ensureList $ map fn idata
138 in ml `combine` (Right . unlines)
140 parseInstance :: JSObject JSValue -> Either String String
142 let name = getStringElement "name" a
143 disk = case getIntElement "disk_usage" a of
145 (getIntElement "sda_size" a)
146 (getIntElement "sdb_size" a)
148 bep = fromObj "beparams" a
149 pnode = getStringElement "pnode" a
150 snode = (listHead $ getListElement "snodes" a) `combine` readString
152 Left _ -> getIntElement "admin_ram" a
153 Right o -> getIntElement "memory" o
154 running = getStringElement "status" a
157 concatElems (show `apply1` mem) $
158 concatElems (show `apply1` disk) $
159 concatElems running $
160 concatElems pnode snode
162 parseNode :: JSObject JSValue -> Either String String
164 let name = getStringElement "name" a
165 mtotal = getIntElement "mtotal" a
166 mnode = getIntElement "mnode" a
167 mfree = getIntElement "mfree" a
168 dtotal = getIntElement "dtotal" a
169 dfree = getIntElement "dfree" a
170 in concatElems name $
171 concatElems (show `apply1` mtotal) $
172 concatElems (show `apply1` mnode) $
173 concatElems (show `apply1` mfree) $
174 concatElems (show `apply1` dtotal) (show `apply1` dfree)