root / Ganeti / HTools / Rapi.hs @ 942403e6
History | View | Annotate | Download (3 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 | 942403e6 | Iustin Pop | import Text.JSON (JSObject, JSValue) |
18 | a7654563 | Iustin Pop | import Text.Printf (printf) |
19 | 9ba5c28f | 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 | 942403e6 | Iustin Pop | getUrl :: String -> IO (Result String) |
28 | a7654563 | Iustin Pop | getUrl url = do |
29 | a7654563 | Iustin Pop | (code, body) <- curlGetString url [CurlSSLVerifyPeer False, |
30 | a7654563 | Iustin Pop | CurlSSLVerifyHost 0] |
31 | a7654563 | Iustin Pop | return (case code of |
32 | 942403e6 | Iustin Pop | CurlOK -> Ok body |
33 | 942403e6 | Iustin Pop | _ -> Bad $ printf "Curl error for '%s', error %s" |
34 | aab26f2d | Iustin Pop | url (show code)) |
35 | aab26f2d | Iustin Pop | |
36 | 942403e6 | Iustin Pop | getInstances :: String -> IO (Result String) |
37 | aff363a4 | Iustin Pop | getInstances master = do |
38 | aff363a4 | Iustin Pop | let url2 = printf "https://%s:5080/2/instances?bulk=1" master |
39 | aff363a4 | Iustin Pop | body <- getUrl url2 |
40 | 942403e6 | Iustin Pop | return $ (body >>= \x -> do |
41 | 942403e6 | Iustin Pop | arr <- loadJSArray x |
42 | 942403e6 | Iustin Pop | ilist <- mapM parseInstance arr |
43 | 942403e6 | Iustin Pop | return $ unlines ilist) |
44 | a7654563 | Iustin Pop | |
45 | 942403e6 | Iustin Pop | getNodes :: String -> IO (Result String) |
46 | aff363a4 | Iustin Pop | getNodes master = do |
47 | aff363a4 | Iustin Pop | let url2 = printf "https://%s:5080/2/nodes?bulk=1" master |
48 | aff363a4 | Iustin Pop | body <- getUrl url2 |
49 | 942403e6 | Iustin Pop | return $ (body >>= \x -> do |
50 | 942403e6 | Iustin Pop | arr <- loadJSArray x |
51 | 942403e6 | Iustin Pop | nlist <- mapM parseNode arr |
52 | 942403e6 | Iustin Pop | return $ unlines nlist) |
53 | a7654563 | Iustin Pop | |
54 | 942403e6 | Iustin Pop | parseInstance :: JSObject JSValue -> Result String |
55 | a7654563 | Iustin Pop | parseInstance a = |
56 | a7654563 | Iustin Pop | let name = getStringElement "name" a |
57 | a7654563 | Iustin Pop | disk = case getIntElement "disk_usage" a of |
58 | 942403e6 | Iustin Pop | Bad _ -> let log_sz = liftM2 (+) |
59 | 942403e6 | Iustin Pop | (getIntElement "sda_size" a) |
60 | 942403e6 | Iustin Pop | (getIntElement "sdb_size" a) |
61 | 942403e6 | Iustin Pop | in liftM2 (+) log_sz (Ok $ drbdOverhead * 2) |
62 | 942403e6 | Iustin Pop | x@(Ok _) -> x |
63 | aab26f2d | Iustin Pop | bep = fromObj "beparams" a |
64 | b8b9a53c | Iustin Pop | pnode = getStringElement "pnode" a |
65 | 942403e6 | Iustin Pop | snode = (liftM head $ getListElement "snodes" a) |
66 | 942403e6 | Iustin Pop | >>= readEitherString |
67 | aab26f2d | Iustin Pop | mem = case bep of |
68 | 942403e6 | Iustin Pop | Bad _ -> getIntElement "admin_ram" a |
69 | 942403e6 | Iustin Pop | Ok o -> getIntElement "memory" o |
70 | f82f1f39 | Iustin Pop | running = getStringElement "status" a |
71 | a7654563 | Iustin Pop | in |
72 | 942403e6 | Iustin Pop | name |+ (show `liftM` mem) |+ |
73 | 942403e6 | Iustin Pop | (show `liftM` disk) |+ |
74 | 942403e6 | Iustin Pop | running |+ pnode |+ snode |
75 | a7654563 | Iustin Pop | |
76 | 942403e6 | Iustin Pop | boolToYN :: Bool -> Result String |
77 | 942403e6 | Iustin Pop | boolToYN True = Ok "Y" |
78 | 942403e6 | Iustin Pop | boolToYN _ = Ok "N" |
79 | 00b15752 | Iustin Pop | |
80 | 942403e6 | Iustin Pop | parseNode :: JSObject JSValue -> Result String |
81 | a7654563 | Iustin Pop | parseNode a = |
82 | a7654563 | Iustin Pop | let name = getStringElement "name" a |
83 | 00b15752 | Iustin Pop | offline = getBoolElement "offline" a |
84 | 00b15752 | Iustin Pop | drained = getBoolElement "drained" a |
85 | a7654563 | Iustin Pop | mtotal = getIntElement "mtotal" a |
86 | 04be800a | Iustin Pop | mnode = getIntElement "mnode" a |
87 | a7654563 | Iustin Pop | mfree = getIntElement "mfree" a |
88 | a7654563 | Iustin Pop | dtotal = getIntElement "dtotal" a |
89 | a7654563 | Iustin Pop | dfree = getIntElement "dfree" a |
90 | 942403e6 | Iustin Pop | in name |+ |
91 | 00b15752 | Iustin Pop | (case offline of |
92 | 942403e6 | Iustin Pop | Ok True -> Ok "0|0|0|0|0|Y" |
93 | 00b15752 | Iustin Pop | _ -> |
94 | 942403e6 | Iustin Pop | (show `liftM` mtotal) |+ (show `liftM` mnode) |+ |
95 | 942403e6 | Iustin Pop | (show `liftM` mfree) |+ (show `liftM` dtotal) |+ |
96 | 942403e6 | Iustin Pop | (show `liftM` dfree) |+ |
97 | 942403e6 | Iustin Pop | ((liftM2 (||) offline drained) >>= boolToYN) |
98 | 00b15752 | Iustin Pop | ) |