| 13 |
13 |
import Control.Monad
|
| 14 |
14 |
import Text.JSON
|
| 15 |
15 |
import Text.Printf (printf)
|
| 16 |
|
import Ganeti.HTools.Utils ()
|
|
16 |
import Ganeti.HTools.Utils
|
| 17 |
17 |
|
| 18 |
|
|
| 19 |
|
parseInstance :: JSObject JSValue -> Either String String
|
| 20 |
|
parseInstance a =
|
| 21 |
|
let name = getStringElement "name" a
|
|
18 |
parseInstance :: String -> JSObject JSValue -> Either String String
|
|
19 |
parseInstance n a =
|
|
20 |
let name = Right n
|
| 22 |
21 |
disk = case getIntElement "disk_usage" a of
|
| 23 |
|
Left _ -> let log_sz = apply2 (+)
|
| 24 |
|
(getIntElement "sda_size" a)
|
| 25 |
|
(getIntElement "sdb_size" a)
|
| 26 |
|
in apply2 (+) log_sz (Right $ 128 * 2)
|
|
22 |
Left _ -> let all_d = getListElement "disks" a `combineEithers`
|
|
23 |
asObjectList
|
|
24 |
szd = all_d `combineEithers`
|
|
25 |
(ensureEitherList .
|
|
26 |
map (getIntElement "size"))
|
|
27 |
sze = applyEither1 (map (+128)) szd
|
|
28 |
szf = applyEither1 sum sze
|
|
29 |
in szf
|
| 27 |
30 |
Right x -> Right x
|
| 28 |
|
bep = fromObj "beparams" a
|
| 29 |
|
pnode = getStringElement "pnode" a
|
| 30 |
|
snode = (listHead $ getListElement "snodes" a) `combine` readString
|
| 31 |
|
mem = case bep of
|
| 32 |
|
Left _ -> getIntElement "admin_ram" a
|
| 33 |
|
Right o -> getIntElement "memory" o
|
| 34 |
|
running = getStringElement "status" a
|
|
31 |
nodes = getListElement "nodes" a
|
|
32 |
pnode = eitherListHead nodes
|
|
33 |
`combineEithers` readEitherString
|
|
34 |
snode = applyEither1 (head . tail) nodes
|
|
35 |
`combineEithers` readEitherString
|
|
36 |
mem = getIntElement "memory" a
|
|
37 |
running = Right "running" --getStringElement "status" a
|
| 35 |
38 |
in
|
| 36 |
|
concatElems name $
|
| 37 |
|
concatElems (show `apply1` mem) $
|
| 38 |
|
concatElems (show `apply1` disk) $
|
| 39 |
|
concatElems running $
|
| 40 |
|
concatElems pnode snode
|
| 41 |
|
|
| 42 |
|
parseNode :: JSObject JSValue -> Either String String
|
| 43 |
|
parseNode a =
|
| 44 |
|
let name = getStringElement "name" a
|
| 45 |
|
mtotal = getIntElement "mtotal" a
|
| 46 |
|
mnode = getIntElement "mnode" a
|
| 47 |
|
mfree = getIntElement "mfree" a
|
| 48 |
|
dtotal = getIntElement "dtotal" a
|
| 49 |
|
dfree = getIntElement "dfree" a
|
| 50 |
|
in concatElems name $
|
| 51 |
|
concatElems (show `apply1` mtotal) $
|
| 52 |
|
concatElems (show `apply1` mnode) $
|
| 53 |
|
concatElems (show `apply1` mfree) $
|
| 54 |
|
concatElems (show `apply1` dtotal) (show `apply1` dfree)
|
|
39 |
concatEitherElems name $
|
|
40 |
concatEitherElems (show `applyEither1` mem) $
|
|
41 |
concatEitherElems (show `applyEither1` disk) $
|
|
42 |
concatEitherElems running $
|
|
43 |
concatEitherElems pnode snode
|
| 55 |
44 |
|
| 56 |
|
parseData :: String -> Maybe String
|
|
45 |
parseNode :: String -> JSObject JSValue -> Either String String
|
|
46 |
parseNode n a =
|
|
47 |
let name = Right n
|
|
48 |
mtotal = getIntElement "total_memory" a
|
|
49 |
mnode = getIntElement "reserved_memory" a
|
|
50 |
mfree = getIntElement "free_memory" a
|
|
51 |
dtotal = getIntElement "total_disk" a
|
|
52 |
dfree = getIntElement "free_disk" a
|
|
53 |
in concatEitherElems name $
|
|
54 |
concatEitherElems (show `applyEither1` mtotal) $
|
|
55 |
concatEitherElems (show `applyEither1` mnode) $
|
|
56 |
concatEitherElems (show `applyEither1` mfree) $
|
|
57 |
concatEitherElems (show `applyEither1` dtotal)
|
|
58 |
(show `applyEither1` dfree)
|
| 57 |
59 |
|
| 58 |
|
parseData x = Just x
|
|
60 |
parseData :: String -> Either String (String, String)
|
|
61 |
parseData body =
|
|
62 |
let
|
|
63 |
decoded = resultToEither $ decodeStrict body
|
|
64 |
obj = decoded -- decoded `combineEithers` fromJSObject
|
|
65 |
request = obj `combineEithers` getObjectElement "request"
|
|
66 |
rname = request `combineEithers` getStringElement "name"
|
|
67 |
ilist = obj `combineEithers` getObjectElement "instances"
|
|
68 |
nlist = obj `combineEithers` getObjectElement "nodes"
|
|
69 |
idata = applyEither1 fromJSObject ilist
|
|
70 |
ndata = applyEither1 fromJSObject nlist
|
|
71 |
iobj = idata `combineEithers` (ensureEitherList .
|
|
72 |
map (\(x,y) ->
|
|
73 |
asJSObject y `combineEithers`
|
|
74 |
parseInstance x))
|
|
75 |
ilines = iobj `combineEithers` (Right . unlines)
|
|
76 |
nobj = ndata `combineEithers` (ensureEitherList .
|
|
77 |
map (\(x,y) ->
|
|
78 |
asJSObject y `combineEithers`
|
|
79 |
parseNode x))
|
|
80 |
nlines = nobj `combineEithers` (Right . unlines)
|
|
81 |
in applyEither2 (,) nlines ilines
|
| 59 |
82 |
|
| 60 |
83 |
formatResponse :: Bool -> String -> [String] -> String
|
| 61 |
84 |
formatResponse success info nodes =
|