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