root / Ganeti / HTools / Rapi.hs @ 5aa48dbe
History | View | Annotate | Download (3 kB)
1 |
{-| Implementation of the RAPI client interface. |
---|---|
2 |
|
3 |
-} |
4 |
|
5 |
module Ganeti.HTools.Rapi |
6 |
( |
7 |
getNodes |
8 |
, getInstances |
9 |
) where |
10 |
|
11 |
import Network.Curl |
12 |
import Network.Curl.Types () |
13 |
import Network.Curl.Code |
14 |
import Data.Either () |
15 |
import Data.Maybe |
16 |
import Control.Monad |
17 |
import Text.JSON (JSObject, JSValue) |
18 |
import Text.Printf (printf) |
19 |
import Ganeti.HTools.Utils |
20 |
|
21 |
|
22 |
-- Some constants |
23 |
|
24 |
-- | The fixed drbd overhead per disk (only used with 1.2's sdx_size) |
25 |
drbdOverhead = 128 |
26 |
|
27 |
getUrl :: String -> IO (Result String) |
28 |
getUrl url = do |
29 |
(code, body) <- curlGetString url [CurlSSLVerifyPeer False, |
30 |
CurlSSLVerifyHost 0] |
31 |
return (case code of |
32 |
CurlOK -> Ok body |
33 |
_ -> Bad $ printf "Curl error for '%s', error %s" |
34 |
url (show code)) |
35 |
|
36 |
getInstances :: String -> IO (Result String) |
37 |
getInstances master = do |
38 |
let url2 = printf "https://%s:5080/2/instances?bulk=1" master |
39 |
body <- getUrl url2 |
40 |
return $ (body >>= \x -> do |
41 |
arr <- loadJSArray x |
42 |
ilist <- mapM parseInstance arr |
43 |
return $ unlines ilist) |
44 |
|
45 |
getNodes :: String -> IO (Result String) |
46 |
getNodes master = do |
47 |
let url2 = printf "https://%s:5080/2/nodes?bulk=1" master |
48 |
body <- getUrl url2 |
49 |
return $ (body >>= \x -> do |
50 |
arr <- loadJSArray x |
51 |
nlist <- mapM parseNode arr |
52 |
return $ unlines nlist) |
53 |
|
54 |
parseInstance :: JSObject JSValue -> Result String |
55 |
parseInstance a = |
56 |
let name = getStringElement "name" a |
57 |
disk = case getIntElement "disk_usage" a of |
58 |
Bad _ -> let log_sz = liftM2 (+) |
59 |
(getIntElement "sda_size" a) |
60 |
(getIntElement "sdb_size" a) |
61 |
in liftM2 (+) log_sz (Ok $ drbdOverhead * 2) |
62 |
x@(Ok _) -> x |
63 |
bep = fromObj "beparams" a |
64 |
pnode = getStringElement "pnode" a |
65 |
snode = (liftM head $ getListElement "snodes" a) |
66 |
>>= readEitherString |
67 |
mem = case bep of |
68 |
Bad _ -> getIntElement "admin_ram" a |
69 |
Ok o -> getIntElement "memory" o |
70 |
running = getStringElement "status" a |
71 |
in |
72 |
name |+ (show `liftM` mem) |+ |
73 |
(show `liftM` disk) |+ |
74 |
running |+ pnode |+ snode |
75 |
|
76 |
boolToYN :: (Monad m) => Bool -> m String |
77 |
boolToYN True = return "Y" |
78 |
boolToYN _ = return "N" |
79 |
|
80 |
parseNode :: JSObject JSValue -> Result String |
81 |
parseNode a = |
82 |
let name = getStringElement "name" a |
83 |
offline = getBoolElement "offline" a |
84 |
drained = getBoolElement "drained" a |
85 |
mtotal = getIntElement "mtotal" a |
86 |
mnode = getIntElement "mnode" a |
87 |
mfree = getIntElement "mfree" a |
88 |
dtotal = getIntElement "dtotal" a |
89 |
dfree = getIntElement "dfree" a |
90 |
in name |+ |
91 |
(case offline of |
92 |
Ok True -> Ok "0|0|0|0|0|Y" |
93 |
_ -> |
94 |
(show `liftM` mtotal) |+ (show `liftM` mnode) |+ |
95 |
(show `liftM` mfree) |+ (show `liftM` dtotal) |+ |
96 |
(show `liftM` dfree) |+ |
97 |
((liftM2 (||) offline drained) >>= boolToYN) |
98 |
) |