IAlloc.hs 4.12 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

18
19
20
21
22
data RqType
    = Allocate
    | Relocate
    deriving (Show)

Iustin Pop's avatar
Iustin Pop committed
23
24
25
parseInstance :: String -> JSObject JSValue -> Either String String
parseInstance n a =
    let name = Right n
26
        disk = case getIntElement "disk_usage" a of
Iustin Pop's avatar
Iustin Pop committed
27
28
29
30
31
32
33
34
                 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
35
                 Right x -> Right x
Iustin Pop's avatar
Iustin Pop committed
36
37
38
39
40
41
42
        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
43
    in
Iustin Pop's avatar
Iustin Pop committed
44
45
46
47
48
      concatEitherElems name $
                  concatEitherElems (show `applyEither1` mem) $
                  concatEitherElems (show `applyEither1` disk) $
                  concatEitherElems running $
                  concatEitherElems pnode snode
49

Iustin Pop's avatar
Iustin Pop committed
50
51
52
53
54
55
56
57
58
59
60
61
62
63
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)
64

65
66
67
68
69
70
71
validateRequest :: String -> Either String RqType
validateRequest rq =
    case rq of
      "allocate" -> Right Allocate
      "relocate" -> Right Relocate
      _ -> Left ("Invalid request type '" ++ rq ++ "'")

Iustin Pop's avatar
Iustin Pop committed
72
73
74
75
76
parseData :: String -> Either String (String, String)
parseData body =
    let
        decoded = resultToEither $ decodeStrict body
        obj = decoded -- decoded `combineEithers` fromJSObject
77
        -- request parser
Iustin Pop's avatar
Iustin Pop committed
78
79
        request = obj `combineEithers` getObjectElement "request"
        rname = request `combineEithers` getStringElement "name"
80
81
82
        rtype = request `combineEithers` getStringElement "type"
                `combineEithers` validateRequest
        -- existing intstance parsing
Iustin Pop's avatar
Iustin Pop committed
83
84
85
86
87
88
89
        ilist = obj `combineEithers` getObjectElement "instances"
        idata = applyEither1 fromJSObject ilist
        iobj = idata `combineEithers` (ensureEitherList .
                                       map (\(x,y) ->
                                           asJSObject y `combineEithers`
                                                      parseInstance x))
        ilines = iobj `combineEithers` (Right . unlines)
90
91
92
        -- existing node parsing
        nlist = obj `combineEithers` getObjectElement "nodes"
        ndata = applyEither1 fromJSObject nlist
Iustin Pop's avatar
Iustin Pop committed
93
94
95
96
97
98
        nobj = ndata `combineEithers` (ensureEitherList .
                                       map (\(x,y) ->
                                           asJSObject y `combineEithers`
                                                      parseNode x))
        nlines = nobj `combineEithers` (Right . unlines)
    in applyEither2 (,) nlines ilines
99
100
101
102
103
104
105
106

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]