root / src / Rapi.hs @ 01f6a5d2
History | View | Annotate | Download (3.4 kB)
1 |
{-| Implementation of the RAPI client interface. |
---|---|
2 |
|
3 |
-} |
4 |
|
5 |
module Rapi |
6 |
where |
7 |
|
8 |
import Network.Curl |
9 |
import Network.Curl.Types |
10 |
import Network.Curl.Code |
11 |
import Data.Either (either) |
12 |
import Data.Maybe |
13 |
import Control.Monad |
14 |
import Text.JSON |
15 |
import Text.Printf (printf) |
16 |
import Utils |
17 |
|
18 |
|
19 |
{-- Our cheap monad-like stuff. |
20 |
|
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 |
23 |
entire thing. |
24 |
|
25 |
-} |
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 |
29 |
|
30 |
ensureList :: [Either String a] -> Either String [a] |
31 |
ensureList lst = |
32 |
foldr (\elem accu -> |
33 |
case (elem, accu) of |
34 |
(Left x, _) -> Left x |
35 |
(_, Left x) -> Left x -- should never happen |
36 |
(Right e, Right a) -> Right (e:a) |
37 |
) |
38 |
(Right []) lst |
39 |
|
40 |
loadJSArray :: String -> Either String [JSObject JSValue] |
41 |
loadJSArray s = resultToEither $ decodeStrict s |
42 |
|
43 |
getStringElement :: String -> JSObject JSValue -> Either String String |
44 |
getStringElement key o = |
45 |
resultToEither $ valFromObj key o |
46 |
|
47 |
getIntElement :: String -> JSObject JSValue -> Either String String |
48 |
getIntElement key o = |
49 |
let tmp = resultToEither $ ((valFromObj key o)::Result Int) |
50 |
in case tmp of |
51 |
Left x -> Left x |
52 |
Right x -> Right $ show x |
53 |
|
54 |
concatElems a b = |
55 |
case a of |
56 |
Left _ -> a |
57 |
Right [] -> b |
58 |
Right x -> |
59 |
case b of |
60 |
Left _ -> b |
61 |
Right y -> Right (x ++ "|" ++ y) |
62 |
|
63 |
getUrl :: String -> IO (Either String String) |
64 |
getUrl url = do |
65 |
(code, body) <- curlGetString url [CurlSSLVerifyPeer False, |
66 |
CurlSSLVerifyHost 0] |
67 |
return (case code of |
68 |
CurlOK -> Right body |
69 |
_ -> Left $ printf "url:%s, error: %s" url (show code)) |
70 |
|
71 |
getInstances :: String -> IO (Either String String) |
72 |
getInstances master = |
73 |
let url = printf "https://%s:5080/2/instances?bulk=1" master |
74 |
in do |
75 |
body <- getUrl url |
76 |
let inst = body `combine` loadJSArray `combine` (parseList parseInstance) |
77 |
return inst |
78 |
|
79 |
getNodes :: String -> IO (Either String String) |
80 |
getNodes master = |
81 |
let url = printf "https://%s:5080/2/nodes?bulk=1" master |
82 |
in do |
83 |
body <- getUrl url |
84 |
let inst = body `combine` loadJSArray `combine` (parseList parseNode) |
85 |
return inst |
86 |
|
87 |
parseList :: (JSObject JSValue -> Either String String) |
88 |
-> [JSObject JSValue] |
89 |
->Either String String |
90 |
parseList fn idata = |
91 |
let ml = ensureList $ map fn idata |
92 |
in ml `combine` (Right . unlines) |
93 |
|
94 |
parseInstance :: JSObject JSValue -> Either String String |
95 |
parseInstance a = |
96 |
let name = getStringElement "name" a |
97 |
disk = case getIntElement "disk_usage" a of |
98 |
Left _ -> getIntElement "sda_size" a |
99 |
Right x -> Right x |
100 |
bep = (resultToEither $ valFromObj "beparams" a) |
101 |
in |
102 |
case bep of |
103 |
Left x -> Left x |
104 |
Right x -> let mem = getIntElement "memory" x |
105 |
in concatElems name $ concatElems mem disk |
106 |
|
107 |
parseNode :: JSObject JSValue -> Either String String |
108 |
parseNode a = |
109 |
let name = getStringElement "name" a |
110 |
mtotal = getIntElement "mtotal" a |
111 |
mfree = getIntElement "mfree" a |
112 |
dtotal = getIntElement "dtotal" a |
113 |
dfree = getIntElement "dfree" a |
114 |
in concatElems name $ concatElems mtotal $ concatElems mfree $ |
115 |
concatElems dtotal dfree |