Statistics
| Branch: | Tag: | Revision:

root / Ganeti / HTools / IAlloc.hs @ 497e30a1

History | View | Annotate | Download (3.6 kB)

1
{-| Implementation of the iallocator interface.
2

    
3
-}
4

    
5
module Ganeti.HTools.IAlloc
6
    (
7
      parseData
8
    , formatResponse
9
    ) where
10

    
11
import Data.Either ()
12
--import Data.Maybe
13
import Control.Monad
14
import Text.JSON (JSObject, JSValue(JSBool, JSString, JSArray),
15
                  makeObj, encodeStrict, decodeStrict,
16
                  fromJSObject, toJSString)
17
--import Text.Printf (printf)
18
import qualified Ganeti.HTools.Node as Node
19
import qualified Ganeti.HTools.Instance as Instance
20
import Ganeti.HTools.Loader
21
import Ganeti.HTools.Utils
22
import Ganeti.HTools.Types
23

    
24
data RqType
25
    = Allocate String Instance.Instance
26
    | Relocate Int
27
    deriving (Show)
28

    
29
data Request = Request RqType IdxNode IdxInstance NameList NameList
30
    deriving (Show)
31

    
32
parseBaseInstance :: String
33
                  -> JSObject JSValue
34
                  -> Result (String, Instance.Instance)
35
parseBaseInstance n a = do
36
  disk <- case fromObj "disk_usage" a of
37
            Bad _ -> do
38
                all_d <- fromObj "disks" a >>= asObjectList
39
                szd <- mapM (fromObj "size") all_d
40
                let sze = map (+128) szd
41
                    szf = (sum sze)::Int
42
                return szf
43
            x@(Ok _) -> x
44
  mem <- fromObj "memory" a
45
  let running = "running"
46
  return $ (n, Instance.create n mem disk running 0 0)
47

    
48
parseInstance :: NameAssoc
49
              -> String
50
              -> JSObject JSValue
51
              -> Result (String, Instance.Instance)
52
parseInstance ktn n a = do
53
    base <- parseBaseInstance n a
54
    nodes <- fromObj "nodes" a
55
    pnode <- readEitherString $ head nodes
56
    snode <- readEitherString $ (head . tail) nodes
57
    pidx <- lookupNode ktn n pnode
58
    sidx <- lookupNode ktn n snode
59
    return (n, Instance.setBoth (snd base) pidx sidx)
60

    
61
parseNode :: String -> JSObject JSValue -> Result (String, Node.Node)
62
parseNode n a = do
63
    let name = n
64
    mtotal <- fromObj "total_memory" a
65
    mnode <- fromObj "reserved_memory" a
66
    mfree <- fromObj "free_memory" a
67
    dtotal <- fromObj "total_disk" a
68
    dfree <- fromObj "free_disk" a
69
    offline <- fromObj "offline" a
70
    drained <- fromObj "offline" a
71
    return $ (name, Node.create n mtotal mnode mfree dtotal dfree
72
                      (offline || drained))
73

    
74
parseData :: String -> Result Request
75
parseData body = do
76
  decoded <- fromJResult $ decodeStrict body
77
  let obj = decoded
78
  -- request parser
79
  request <- fromObj "request" obj
80
  rname <- fromObj "name" request
81
  -- existing node parsing
82
  nlist <- fromObj "nodes" obj
83
  let ndata = fromJSObject nlist
84
  nobj <- (mapM (\(x,y) -> asJSObject y >>= parseNode x)) ndata
85
  let (ktn, nl) = assignIndices nobj
86
  -- existing instance parsing
87
  ilist <- fromObj "instances" obj
88
  let idata = fromJSObject ilist
89
  iobj <- (mapM (\(x,y) -> asJSObject y >>= parseInstance ktn x)) idata
90
  let (kti, il) = assignIndices iobj
91
  optype <- fromObj "type" request
92
  rqtype <-
93
      case optype of
94
        "allocate" ->
95
            do
96
              inew <- parseBaseInstance rname request
97
              let (iname, io) = inew
98
              return $ Allocate iname io
99
        "relocate" ->
100
            do
101
              ridx <- lookupNode kti rname rname
102
              return $ Relocate ridx
103
        other -> fail $ ("Invalid request type '" ++ other ++ "'")
104

    
105
  return $ Request rqtype nl il (swapPairs ktn) (swapPairs kti)
106

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