root / Ganeti / HTools / Rapi.hs @ e0eb63f0
History | View | Annotate | Download (5.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 | 669d7e3d | Iustin Pop | module Ganeti.HTools.Rapi |
6 | dd4c56ed | Iustin Pop | ( |
7 | dd4c56ed | Iustin Pop | getNodes |
8 | dd4c56ed | Iustin Pop | , getInstances |
9 | dd4c56ed | Iustin Pop | ) where |
10 | a7654563 | Iustin Pop | |
11 | a7654563 | Iustin Pop | import Network.Curl |
12 | b8b9a53c | Iustin Pop | import Network.Curl.Types () |
13 | a7654563 | Iustin Pop | import Network.Curl.Code |
14 | b8b9a53c | Iustin Pop | import Data.Either () |
15 | aab26f2d | Iustin Pop | import Data.Maybe |
16 | a7654563 | Iustin Pop | import Control.Monad |
17 | a7654563 | Iustin Pop | import Text.JSON |
18 | a7654563 | Iustin Pop | import Text.Printf (printf) |
19 | 669d7e3d | Iustin Pop | import Ganeti.HTools.Utils () |
20 | a7654563 | Iustin Pop | |
21 | a7654563 | Iustin Pop | |
22 | 190ce47c | Iustin Pop | -- Some constants |
23 | 190ce47c | Iustin Pop | |
24 | 190ce47c | Iustin Pop | -- | The fixed drbd overhead per disk (only used with 1.2's sdx_size) |
25 | 190ce47c | Iustin Pop | drbdOverhead = 128 |
26 | 190ce47c | Iustin Pop | |
27 | a7654563 | Iustin Pop | {-- Our cheap monad-like stuff. |
28 | a7654563 | Iustin Pop | |
29 | a7654563 | Iustin Pop | Thi is needed since Either e a is already a monad instance somewhere |
30 | a7654563 | Iustin Pop | in the standard libraries (Control.Monad.Error) and we don't need that |
31 | a7654563 | Iustin Pop | entire thing. |
32 | a7654563 | Iustin Pop | |
33 | a7654563 | Iustin Pop | -} |
34 | a7654563 | Iustin Pop | combine :: (Either String a) -> (a -> Either String b) -> (Either String b) |
35 | a7654563 | Iustin Pop | combine (Left s) _ = Left s |
36 | a7654563 | Iustin Pop | combine (Right s) f = f s |
37 | a7654563 | Iustin Pop | |
38 | a7654563 | Iustin Pop | ensureList :: [Either String a] -> Either String [a] |
39 | a7654563 | Iustin Pop | ensureList lst = |
40 | a7654563 | Iustin Pop | foldr (\elem accu -> |
41 | a7654563 | Iustin Pop | case (elem, accu) of |
42 | a7654563 | Iustin Pop | (Left x, _) -> Left x |
43 | a7654563 | Iustin Pop | (_, Left x) -> Left x -- should never happen |
44 | a7654563 | Iustin Pop | (Right e, Right a) -> Right (e:a) |
45 | a7654563 | Iustin Pop | ) |
46 | a7654563 | Iustin Pop | (Right []) lst |
47 | a7654563 | Iustin Pop | |
48 | b8b9a53c | Iustin Pop | listHead :: Either String [a] -> Either String a |
49 | b8b9a53c | Iustin Pop | listHead lst = |
50 | b8b9a53c | Iustin Pop | case lst of |
51 | b8b9a53c | Iustin Pop | Left x -> Left x |
52 | b8b9a53c | Iustin Pop | Right (x:_) -> Right x |
53 | b8b9a53c | Iustin Pop | Right [] -> Left "List empty" |
54 | b8b9a53c | Iustin Pop | |
55 | a7654563 | Iustin Pop | loadJSArray :: String -> Either String [JSObject JSValue] |
56 | a7654563 | Iustin Pop | loadJSArray s = resultToEither $ decodeStrict s |
57 | a7654563 | Iustin Pop | |
58 | aab26f2d | Iustin Pop | fromObj :: JSON a => String -> JSObject JSValue -> Either String a |
59 | aab26f2d | Iustin Pop | fromObj k o = |
60 | aab26f2d | Iustin Pop | case lookup k (fromJSObject o) of |
61 | aab26f2d | Iustin Pop | Nothing -> Left $ printf "key '%s' not found" k |
62 | aab26f2d | Iustin Pop | Just val -> resultToEither $ readJSON val |
63 | aab26f2d | Iustin Pop | |
64 | a7654563 | Iustin Pop | getStringElement :: String -> JSObject JSValue -> Either String String |
65 | d7cf83bf | Iustin Pop | getStringElement = fromObj |
66 | a7654563 | Iustin Pop | |
67 | d7cf83bf | Iustin Pop | getIntElement :: String -> JSObject JSValue -> Either String Int |
68 | d7cf83bf | Iustin Pop | getIntElement = fromObj |
69 | a7654563 | Iustin Pop | |
70 | b8b9a53c | Iustin Pop | getListElement :: String -> JSObject JSValue |
71 | b8b9a53c | Iustin Pop | -> Either String [JSValue] |
72 | d7cf83bf | Iustin Pop | getListElement = fromObj |
73 | b8b9a53c | Iustin Pop | |
74 | b8b9a53c | Iustin Pop | readString :: JSValue -> Either String String |
75 | b8b9a53c | Iustin Pop | readString v = |
76 | b8b9a53c | Iustin Pop | case v of |
77 | b8b9a53c | Iustin Pop | JSString s -> Right $ fromJSString s |
78 | b8b9a53c | Iustin Pop | _ -> Left "Wrong JSON type" |
79 | b8b9a53c | Iustin Pop | |
80 | aab26f2d | Iustin Pop | concatElems :: Either String String |
81 | aab26f2d | Iustin Pop | -> Either String String |
82 | aab26f2d | Iustin Pop | -> Either String String |
83 | aab26f2d | Iustin Pop | concatElems = apply2 (\x y -> x ++ "|" ++ y) |
84 | aab26f2d | Iustin Pop | |
85 | d7cf83bf | Iustin Pop | apply1 :: (a -> b) -> Either String a -> Either String b |
86 | d7cf83bf | Iustin Pop | apply1 fn a = |
87 | d7cf83bf | Iustin Pop | case a of |
88 | d7cf83bf | Iustin Pop | Left x -> Left x |
89 | d7cf83bf | Iustin Pop | Right y -> Right $ fn y |
90 | d7cf83bf | Iustin Pop | |
91 | aab26f2d | Iustin Pop | apply2 :: (a -> b -> c) |
92 | aab26f2d | Iustin Pop | -> Either String a |
93 | aab26f2d | Iustin Pop | -> Either String b |
94 | aab26f2d | Iustin Pop | -> Either String c |
95 | aab26f2d | Iustin Pop | apply2 fn a b = |
96 | aab26f2d | Iustin Pop | case (a, b) of |
97 | aab26f2d | Iustin Pop | (Right x, Right y) -> Right $ fn x y |
98 | aab26f2d | Iustin Pop | (Left x, _) -> Left x |
99 | aab26f2d | Iustin Pop | (_, Left y) -> Left y |
100 | a7654563 | Iustin Pop | |
101 | a7654563 | Iustin Pop | getUrl :: String -> IO (Either String String) |
102 | a7654563 | Iustin Pop | getUrl url = do |
103 | a7654563 | Iustin Pop | (code, body) <- curlGetString url [CurlSSLVerifyPeer False, |
104 | a7654563 | Iustin Pop | CurlSSLVerifyHost 0] |
105 | a7654563 | Iustin Pop | return (case code of |
106 | a7654563 | Iustin Pop | CurlOK -> Right body |
107 | aab26f2d | Iustin Pop | _ -> Left $ printf "Curl error for '%s', error %s" |
108 | aab26f2d | Iustin Pop | url (show code)) |
109 | aab26f2d | Iustin Pop | |
110 | aab26f2d | Iustin Pop | tryRapi :: String -> String -> IO (Either String String) |
111 | aab26f2d | Iustin Pop | tryRapi url1 url2 = |
112 | aab26f2d | Iustin Pop | do |
113 | aab26f2d | Iustin Pop | body1 <- getUrl url1 |
114 | 9b9a5931 | Iustin Pop | (case body1 of |
115 | 9b9a5931 | Iustin Pop | Left _ -> getUrl url2 |
116 | 9b9a5931 | Iustin Pop | Right _ -> return body1) |
117 | a7654563 | Iustin Pop | |
118 | a7654563 | Iustin Pop | getInstances :: String -> IO (Either String String) |
119 | a7654563 | Iustin Pop | getInstances master = |
120 | aab26f2d | Iustin Pop | let |
121 | aab26f2d | Iustin Pop | url2 = printf "https://%s:5080/2/instances?bulk=1" master |
122 | aab26f2d | Iustin Pop | url1 = printf "http://%s:5080/instances?bulk=1" master |
123 | a7654563 | Iustin Pop | in do |
124 | aab26f2d | Iustin Pop | body <- tryRapi url1 url2 |
125 | a7654563 | Iustin Pop | let inst = body `combine` loadJSArray `combine` (parseList parseInstance) |
126 | a7654563 | Iustin Pop | return inst |
127 | a7654563 | Iustin Pop | |
128 | a7654563 | Iustin Pop | getNodes :: String -> IO (Either String String) |
129 | a7654563 | Iustin Pop | getNodes master = |
130 | aab26f2d | Iustin Pop | let |
131 | aab26f2d | Iustin Pop | url2 = printf "https://%s:5080/2/nodes?bulk=1" master |
132 | aab26f2d | Iustin Pop | url1 = printf "http://%s:5080/nodes?bulk=1" master |
133 | a7654563 | Iustin Pop | in do |
134 | aab26f2d | Iustin Pop | body <- tryRapi url1 url2 |
135 | a7654563 | Iustin Pop | let inst = body `combine` loadJSArray `combine` (parseList parseNode) |
136 | a7654563 | Iustin Pop | return inst |
137 | a7654563 | Iustin Pop | |
138 | a7654563 | Iustin Pop | parseList :: (JSObject JSValue -> Either String String) |
139 | a7654563 | Iustin Pop | -> [JSObject JSValue] |
140 | a7654563 | Iustin Pop | ->Either String String |
141 | a7654563 | Iustin Pop | parseList fn idata = |
142 | a7654563 | Iustin Pop | let ml = ensureList $ map fn idata |
143 | a7654563 | Iustin Pop | in ml `combine` (Right . unlines) |
144 | a7654563 | Iustin Pop | |
145 | a7654563 | Iustin Pop | parseInstance :: JSObject JSValue -> Either String String |
146 | a7654563 | Iustin Pop | parseInstance a = |
147 | a7654563 | Iustin Pop | let name = getStringElement "name" a |
148 | a7654563 | Iustin Pop | disk = case getIntElement "disk_usage" a of |
149 | 190ce47c | Iustin Pop | Left _ -> let log_sz = apply2 (+) |
150 | 190ce47c | Iustin Pop | (getIntElement "sda_size" a) |
151 | 190ce47c | Iustin Pop | (getIntElement "sdb_size" a) |
152 | 190ce47c | Iustin Pop | in apply2 (+) log_sz (Right $ drbdOverhead * 2) |
153 | a7654563 | Iustin Pop | Right x -> Right x |
154 | aab26f2d | Iustin Pop | bep = fromObj "beparams" a |
155 | b8b9a53c | Iustin Pop | pnode = getStringElement "pnode" a |
156 | b8b9a53c | Iustin Pop | snode = (listHead $ getListElement "snodes" a) `combine` readString |
157 | aab26f2d | Iustin Pop | mem = case bep of |
158 | aab26f2d | Iustin Pop | Left _ -> getIntElement "admin_ram" a |
159 | d7cf83bf | Iustin Pop | Right o -> getIntElement "memory" o |
160 | f82f1f39 | Iustin Pop | running = getStringElement "status" a |
161 | a7654563 | Iustin Pop | in |
162 | d7cf83bf | Iustin Pop | concatElems name $ |
163 | d7cf83bf | Iustin Pop | concatElems (show `apply1` mem) $ |
164 | d7cf83bf | Iustin Pop | concatElems (show `apply1` disk) $ |
165 | f82f1f39 | Iustin Pop | concatElems running $ |
166 | d7cf83bf | Iustin Pop | concatElems pnode snode |
167 | a7654563 | Iustin Pop | |
168 | a7654563 | Iustin Pop | parseNode :: JSObject JSValue -> Either String String |
169 | a7654563 | Iustin Pop | parseNode a = |
170 | a7654563 | Iustin Pop | let name = getStringElement "name" a |
171 | a7654563 | Iustin Pop | mtotal = getIntElement "mtotal" a |
172 | 04be800a | Iustin Pop | mnode = getIntElement "mnode" a |
173 | a7654563 | Iustin Pop | mfree = getIntElement "mfree" a |
174 | a7654563 | Iustin Pop | dtotal = getIntElement "dtotal" a |
175 | a7654563 | Iustin Pop | dfree = getIntElement "dfree" a |
176 | d7cf83bf | Iustin Pop | in concatElems name $ |
177 | d7cf83bf | Iustin Pop | concatElems (show `apply1` mtotal) $ |
178 | 04be800a | Iustin Pop | concatElems (show `apply1` mnode) $ |
179 | d7cf83bf | Iustin Pop | concatElems (show `apply1` mfree) $ |
180 | d7cf83bf | Iustin Pop | concatElems (show `apply1` dtotal) (show `apply1` dfree) |