Revision 3f6af65c Ganeti/HTools/IAlloc.hs

b/Ganeti/HTools/IAlloc.hs
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 =

Also available in: Unified diff