Revision ed41c179 Ganeti/HTools/IAlloc.hs

b/Ganeti/HTools/IAlloc.hs
6 6
    (
7 7
      parseData
8 8
    , formatResponse
9
    , RqType(..)
10
    , Request(..)
9 11
    ) where
10 12

  
11 13
import Data.Either ()
......
22 24
import Ganeti.HTools.Types
23 25

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

  
29 31
data Request = Request RqType NodeList InstanceList String
......
88 90
  let idata = fromJSObject ilist
89 91
  iobj <- (mapM (\(x,y) -> asJSObject y >>= parseInstance ktn x)) idata
90 92
  let (kti, il) = assignIndices iobj
93
  (map_n, map_i, csf) <- mergeData (nl, il)
94
  req_nodes <- fromObj "required_nodes" request
91 95
  optype <- fromObj "type" request
92 96
  rqtype <-
93 97
      case optype of
94 98
        "allocate" ->
95 99
            do
96 100
              inew <- parseBaseInstance rname request
97
              let (iname, io) = inew
98
              return $ Allocate iname io
101
              let io = snd inew
102
              return $ Allocate io req_nodes
99 103
        "relocate" ->
100 104
            do
101 105
              ridx <- lookupNode kti rname rname
102
              return $ Relocate ridx
106
              ex_nodes <- fromObj "relocate_from" request
107
              let ex_nodes' = map (stripSuffix $ length csf) ex_nodes
108
              ex_idex <- mapM (findByName map_n) ex_nodes'
109
              return $ Relocate ridx req_nodes ex_idex
103 110
        other -> fail $ ("Invalid request type '" ++ other ++ "'")
104
  (map_n, map_i, csf) <- mergeData (nl, il)
105 111
  return $ Request rqtype map_n map_i csf
106 112

  
107 113
formatResponse :: Bool -> String -> [String] -> String

Also available in: Unified diff