root / Ganeti / HTools / Rapi.hs @ e015b554
History | View | Annotate | Download (2.8 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 Data.List |
17 |
import Control.Monad |
18 |
import Text.JSON (JSObject, JSValue) |
19 |
import Text.Printf (printf) |
20 |
import Ganeti.HTools.Utils |
21 |
|
22 |
-- | Read an URL via curl and return the body if successful |
23 |
getUrl :: (Monad m) => String -> IO (m String) |
24 |
getUrl url = do |
25 |
(code, body) <- curlGetString url [CurlSSLVerifyPeer False, |
26 |
CurlSSLVerifyHost 0] |
27 |
return (case code of |
28 |
CurlOK -> return body |
29 |
_ -> fail $ printf "Curl error for '%s', error %s" |
30 |
url (show code)) |
31 |
|
32 |
-- | Append the default port if not passed in |
33 |
formatHost :: String -> String |
34 |
formatHost master = |
35 |
if elem ':' master then master |
36 |
else "https://" ++ master ++ ":5080" |
37 |
|
38 |
getInstances :: String -> IO (Result String) |
39 |
getInstances master = do |
40 |
let url2 = printf "%s/2/instances?bulk=1" (formatHost master) |
41 |
body <- getUrl url2 |
42 |
return $ (body >>= \x -> do |
43 |
arr <- loadJSArray x |
44 |
ilist <- mapM parseInstance arr |
45 |
return $ unlines ilist) |
46 |
|
47 |
getNodes :: String -> IO (Result String) |
48 |
getNodes master = do |
49 |
let url2 = printf "%s/2/nodes?bulk=1" (formatHost master) |
50 |
body <- getUrl url2 |
51 |
return $ (body >>= \x -> do |
52 |
arr <- loadJSArray x |
53 |
nlist <- mapM parseNode arr |
54 |
return $ unlines nlist) |
55 |
|
56 |
parseInstance :: JSObject JSValue -> Result String |
57 |
parseInstance a = |
58 |
let name = getStringElement "name" a |
59 |
disk = getIntElement "disk_usage" a |
60 |
mem = getObjectElement "beparams" a >>= getIntElement "memory" |
61 |
pnode = getStringElement "pnode" a |
62 |
snode = (liftM head $ getListElement "snodes" a) >>= readEitherString |
63 |
running = getStringElement "status" a |
64 |
in |
65 |
name |+ (show `liftM` mem) |+ |
66 |
(show `liftM` disk) |+ |
67 |
running |+ pnode |+ snode |
68 |
|
69 |
boolToYN :: (Monad m) => Bool -> m String |
70 |
boolToYN True = return "Y" |
71 |
boolToYN _ = return "N" |
72 |
|
73 |
parseNode :: JSObject JSValue -> Result String |
74 |
parseNode a = |
75 |
let name = getStringElement "name" a |
76 |
offline = getBoolElement "offline" a |
77 |
drained = getBoolElement "drained" a |
78 |
mtotal = getIntElement "mtotal" a |
79 |
mnode = getIntElement "mnode" a |
80 |
mfree = getIntElement "mfree" a |
81 |
dtotal = getIntElement "dtotal" a |
82 |
dfree = getIntElement "dfree" a |
83 |
in name |+ |
84 |
(case offline of |
85 |
Ok True -> Ok "0|0|0|0|0|Y" |
86 |
_ -> |
87 |
(show `liftM` mtotal) |+ (show `liftM` mnode) |+ |
88 |
(show `liftM` mfree) |+ (show `liftM` dtotal) |+ |
89 |
(show `liftM` dfree) |+ |
90 |
((liftM2 (||) offline drained) >>= boolToYN) |
91 |
) |