IAlloc.hs 3.64 KB
Newer Older
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
{-| Implementation of the iallocator interface.

-}

module Ganeti.HTools.IAlloc
    (
      parseData
    , formatResponse
    ) where

import Data.Either ()
import Data.Maybe
import Control.Monad
import Text.JSON
import Text.Printf (printf)
Iustin Pop's avatar
Iustin Pop committed
16
import Ganeti.HTools.Utils
17

Iustin Pop's avatar
Iustin Pop committed
18
19
20
parseInstance :: String -> JSObject JSValue -> Either String String
parseInstance n a =
    let name = Right n
21
        disk = case getIntElement "disk_usage" a of
Iustin Pop's avatar
Iustin Pop committed
22
23
24
25
26
27
28
29
                 Left _ -> let all_d = getListElement "disks" a `combineEithers`
                                       asObjectList
                               szd = all_d `combineEithers`
                                     (ensureEitherList .
                                      map (getIntElement "size"))
                               sze = applyEither1 (map (+128)) szd
                               szf = applyEither1 sum sze
                           in szf
30
                 Right x -> Right x
Iustin Pop's avatar
Iustin Pop committed
31
32
33
34
35
36
37
        nodes = getListElement "nodes" a
        pnode = eitherListHead nodes
                `combineEithers` readEitherString
        snode = applyEither1 (head . tail) nodes
                `combineEithers` readEitherString
        mem = getIntElement "memory" a
        running = Right "running" --getStringElement "status" a
38
    in
Iustin Pop's avatar
Iustin Pop committed
39
40
41
42
43
      concatEitherElems name $
                  concatEitherElems (show `applyEither1` mem) $
                  concatEitherElems (show `applyEither1` disk) $
                  concatEitherElems running $
                  concatEitherElems pnode snode
44

Iustin Pop's avatar
Iustin Pop committed
45
46
47
48
49
50
51
52
53
54
55
56
57
58
parseNode :: String -> JSObject JSValue -> Either String String
parseNode n a =
    let name = Right n
        mtotal = getIntElement "total_memory" a
        mnode = getIntElement "reserved_memory" a
        mfree = getIntElement "free_memory" a
        dtotal = getIntElement "total_disk" a
        dfree = getIntElement "free_disk" a
    in concatEitherElems name $
       concatEitherElems (show `applyEither1` mtotal) $
       concatEitherElems (show `applyEither1` mnode) $
       concatEitherElems (show `applyEither1` mfree) $
       concatEitherElems (show `applyEither1` dtotal)
                             (show `applyEither1` dfree)
59

Iustin Pop's avatar
Iustin Pop committed
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
parseData :: String -> Either String (String, String)
parseData body =
    let
        decoded = resultToEither $ decodeStrict body
        obj = decoded -- decoded `combineEithers` fromJSObject
        request = obj `combineEithers` getObjectElement "request"
        rname = request `combineEithers` getStringElement "name"
        ilist = obj `combineEithers` getObjectElement "instances"
        nlist = obj `combineEithers` getObjectElement "nodes"
        idata = applyEither1 fromJSObject ilist
        ndata = applyEither1 fromJSObject nlist
        iobj = idata `combineEithers` (ensureEitherList .
                                       map (\(x,y) ->
                                           asJSObject y `combineEithers`
                                                      parseInstance x))
        ilines = iobj `combineEithers` (Right . unlines)
        nobj = ndata `combineEithers` (ensureEitherList .
                                       map (\(x,y) ->
                                           asJSObject y `combineEithers`
                                                      parseNode x))
        nlines = nobj `combineEithers` (Right . unlines)
    in applyEither2 (,) nlines ilines
82
83
84
85
86
87
88
89

formatResponse :: Bool -> String -> [String] -> String
formatResponse success info nodes =
    let
        e_success = ("success", JSBool success)
        e_info = ("info", JSString . toJSString $ info)
        e_nodes = ("nodes", JSArray $ map (JSString . toJSString) nodes)
    in encodeStrict $ makeObj [e_success, e_info, e_nodes]