root / Ganeti / HTools / Rapi.hs @ aff363a4
History | View | Annotate | Download (3.4 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 |
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 (Either String String) |
28 |
getUrl url = do |
29 |
(code, body) <- curlGetString url [CurlSSLVerifyPeer False, |
30 |
CurlSSLVerifyHost 0] |
31 |
return (case code of |
32 |
CurlOK -> Right body |
33 |
_ -> Left $ printf "Curl error for '%s', error %s" |
34 |
url (show code)) |
35 |
|
36 |
getInstances :: String -> IO (Either String String) |
37 |
getInstances master = do |
38 |
let url2 = printf "https://%s:5080/2/instances?bulk=1" master |
39 |
body <- getUrl url2 |
40 |
let inst = body `combineEithers` |
41 |
loadJSArray `combineEithers` |
42 |
(parseEitherList parseInstance) |
43 |
return inst |
44 |
|
45 |
getNodes :: String -> IO (Either String String) |
46 |
getNodes master = do |
47 |
let url2 = printf "https://%s:5080/2/nodes?bulk=1" master |
48 |
body <- getUrl url2 |
49 |
let inst = body `combineEithers` |
50 |
loadJSArray `combineEithers` |
51 |
(parseEitherList parseNode) |
52 |
return inst |
53 |
|
54 |
parseInstance :: JSObject JSValue -> Either String String |
55 |
parseInstance a = |
56 |
let name = getStringElement "name" a |
57 |
disk = case getIntElement "disk_usage" a of |
58 |
Left _ -> let log_sz = applyEither2 (+) |
59 |
(getIntElement "sda_size" a) |
60 |
(getIntElement "sdb_size" a) |
61 |
in applyEither2 (+) log_sz |
62 |
(Right $ drbdOverhead * 2) |
63 |
Right x -> Right x |
64 |
bep = fromObj "beparams" a |
65 |
pnode = getStringElement "pnode" a |
66 |
snode = (eitherListHead $ getListElement "snodes" a) |
67 |
`combineEithers` readEitherString |
68 |
mem = case bep of |
69 |
Left _ -> getIntElement "admin_ram" a |
70 |
Right o -> getIntElement "memory" o |
71 |
running = getStringElement "status" a |
72 |
in |
73 |
concatEitherElems name $ |
74 |
concatEitherElems (show `applyEither1` mem) $ |
75 |
concatEitherElems (show `applyEither1` disk) $ |
76 |
concatEitherElems running $ |
77 |
concatEitherElems pnode snode |
78 |
|
79 |
boolToYN :: Bool -> Either String String |
80 |
boolToYN True = Right "Y" |
81 |
boolToYN _ = Right "N" |
82 |
|
83 |
parseNode :: JSObject JSValue -> Either String String |
84 |
parseNode a = |
85 |
let name = getStringElement "name" a |
86 |
offline = getBoolElement "offline" a |
87 |
drained = getBoolElement "drained" a |
88 |
mtotal = getIntElement "mtotal" a |
89 |
mnode = getIntElement "mnode" a |
90 |
mfree = getIntElement "mfree" a |
91 |
dtotal = getIntElement "dtotal" a |
92 |
dfree = getIntElement "dfree" a |
93 |
in concatEitherElems name $ |
94 |
(case offline of |
95 |
Right True -> Right "0|0|0|0|0|Y" |
96 |
_ -> |
97 |
concatEitherElems (show `applyEither1` mtotal) $ |
98 |
concatEitherElems (show `applyEither1` mnode) $ |
99 |
concatEitherElems (show `applyEither1` mfree) $ |
100 |
concatEitherElems (show `applyEither1` dtotal) $ |
101 |
concatEitherElems (show `applyEither1` dfree) |
102 |
((applyEither2 (||) offline drained) `combineEithers` boolToYN) |
103 |
) |