1 {-| Implementation of the RAPI client interface.
9 import Network.Curl.Types ()
10 import Network.Curl.Code
15 import Text.Printf (printf)
19 {-- Our cheap monad-like stuff.
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
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
30 ensureList :: [Either String a] -> Either String [a]
35 (_, Left x) -> Left x -- should never happen
36 (Right e, Right a) -> Right (e:a)
40 listHead :: Either String [a] -> Either String a
44 Right (x:_) -> Right x
45 Right [] -> Left "List empty"
47 loadJSArray :: String -> Either String [JSObject JSValue]
48 loadJSArray s = resultToEither $ decodeStrict s
50 getStringElement :: String -> JSObject JSValue -> Either String String
51 getStringElement key o =
52 resultToEither $ valFromObj key o
54 getIntElement :: String -> JSObject JSValue -> Either String String
56 let tmp = resultToEither $ ((valFromObj key o)::Result Int)
59 Right x -> Right $ show x
61 getListElement :: String -> JSObject JSValue
62 -> Either String [JSValue]
63 getListElement key o =
64 let tmp = resultToEither $ ((valFromObj key o)::Result [JSValue])
67 readString :: JSValue -> Either String String
70 JSString s -> Right $ fromJSString s
71 _ -> Left "Wrong JSON type"
80 Right y -> Right (x ++ "|" ++ y)
82 getUrl :: String -> IO (Either String String)
84 (code, body) <- curlGetString url [CurlSSLVerifyPeer False,
88 _ -> Left $ printf "url:%s, error: %s" url (show code))
90 getInstances :: String -> IO (Either String String)
92 let url = printf "https://%s:5080/2/instances?bulk=1" master
95 let inst = body `combine` loadJSArray `combine` (parseList parseInstance)
98 getNodes :: String -> IO (Either String String)
100 let url = printf "https://%s:5080/2/nodes?bulk=1" master
103 let inst = body `combine` loadJSArray `combine` (parseList parseNode)
106 parseList :: (JSObject JSValue -> Either String String)
107 -> [JSObject JSValue]
108 ->Either String String
110 let ml = ensureList $ map fn idata
111 in ml `combine` (Right . unlines)
113 parseInstance :: JSObject JSValue -> Either String String
115 let name = getStringElement "name" a
116 disk = case getIntElement "disk_usage" a of
117 Left _ -> getIntElement "sda_size" a
119 bep = (resultToEither $ valFromObj "beparams" a)
120 pnode = getStringElement "pnode" a
121 snode = (listHead $ getListElement "snodes" a) `combine` readString
125 Right x -> let mem = getIntElement "memory" x
126 in concatElems name $ concatElems mem $
127 concatElems disk $ concatElems pnode snode
129 parseNode :: JSObject JSValue -> Either String String
131 let name = getStringElement "name" a
132 mtotal = getIntElement "mtotal" a
133 mfree = getIntElement "mfree" a
134 dtotal = getIntElement "dtotal" a
135 dfree = getIntElement "dfree" a
136 in concatElems name $ concatElems mtotal $ concatElems mfree $
137 concatElems dtotal dfree