Statistics
| Branch: | Tag: | Revision:

root / htools / Ganeti / HTools / IAlloc.hs @ bebe7a73

History | View | Annotate | Download (14 kB)

1 43643696 Iustin Pop
{-| Implementation of the iallocator interface.
2 43643696 Iustin Pop
3 43643696 Iustin Pop
-}
4 43643696 Iustin Pop
5 e2fa2baf Iustin Pop
{-
6 e2fa2baf Iustin Pop
7 8bc34c7b Iustin Pop
Copyright (C) 2009, 2010, 2011, 2012 Google Inc.
8 e2fa2baf Iustin Pop
9 e2fa2baf Iustin Pop
This program is free software; you can redistribute it and/or modify
10 e2fa2baf Iustin Pop
it under the terms of the GNU General Public License as published by
11 e2fa2baf Iustin Pop
the Free Software Foundation; either version 2 of the License, or
12 e2fa2baf Iustin Pop
(at your option) any later version.
13 e2fa2baf Iustin Pop
14 e2fa2baf Iustin Pop
This program is distributed in the hope that it will be useful, but
15 e2fa2baf Iustin Pop
WITHOUT ANY WARRANTY; without even the implied warranty of
16 e2fa2baf Iustin Pop
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
17 e2fa2baf Iustin Pop
General Public License for more details.
18 e2fa2baf Iustin Pop
19 e2fa2baf Iustin Pop
You should have received a copy of the GNU General Public License
20 e2fa2baf Iustin Pop
along with this program; if not, write to the Free Software
21 e2fa2baf Iustin Pop
Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
22 e2fa2baf Iustin Pop
02110-1301, USA.
23 e2fa2baf Iustin Pop
24 e2fa2baf Iustin Pop
-}
25 e2fa2baf Iustin Pop
26 43643696 Iustin Pop
module Ganeti.HTools.IAlloc
27 00dd69a2 Iustin Pop
  ( readRequest
28 00dd69a2 Iustin Pop
  , runIAllocator
29 00dd69a2 Iustin Pop
  , processRelocate
30 786c514c René Nussbaumer
  , loadData
31 00dd69a2 Iustin Pop
  ) where
32 43643696 Iustin Pop
33 43643696 Iustin Pop
import Data.Either ()
34 c3f8cb12 René Nussbaumer
import Data.Maybe (fromMaybe)
35 cabce2f4 Iustin Pop
import Data.List
36 43643696 Iustin Pop
import Control.Monad
37 34c5a24a Iustin Pop
import Text.JSON (JSObject, JSValue(JSArray),
38 34c5a24a Iustin Pop
                  makeObj, encodeStrict, decodeStrict, fromJSObject, showJSON)
39 7345b69b Iustin Pop
import System.Exit
40 cabce2f4 Iustin Pop
import System.IO
41 cabce2f4 Iustin Pop
42 cabce2f4 Iustin Pop
import qualified Ganeti.HTools.Cluster as Cluster
43 262a08a2 Iustin Pop
import qualified Ganeti.HTools.Container as Container
44 a679e9dc Iustin Pop
import qualified Ganeti.HTools.Group as Group
45 942403e6 Iustin Pop
import qualified Ganeti.HTools.Node as Node
46 942403e6 Iustin Pop
import qualified Ganeti.HTools.Instance as Instance
47 df5227dc Iustin Pop
import qualified Ganeti.Constants as C
48 cabce2f4 Iustin Pop
import Ganeti.HTools.CLI
49 e4c5beaf Iustin Pop
import Ganeti.HTools.Loader
50 b69be409 Iustin Pop
import Ganeti.HTools.JSON
51 e4c5beaf Iustin Pop
import Ganeti.HTools.Types
52 43643696 Iustin Pop
53 3603605a Iustin Pop
{-# ANN module "HLint: ignore Eta reduce" #-}
54 3603605a Iustin Pop
55 7c14b50a Iustin Pop
-- | Type alias for the result of an IAllocator call.
56 f9283686 Iustin Pop
type IAllocResult = (String, JSValue, Node.List, Instance.List)
57 7c14b50a Iustin Pop
58 9188aeef Iustin Pop
-- | Parse the basic specifications of an instance.
59 9188aeef Iustin Pop
--
60 9188aeef Iustin Pop
-- Instances in the cluster instance list and the instance in an
61 9188aeef Iustin Pop
-- 'Allocate' request share some common properties, which are read by
62 9188aeef Iustin Pop
-- this function.
63 e4c5beaf Iustin Pop
parseBaseInstance :: String
64 28f19313 Iustin Pop
                  -> JSRecord
65 e4c5beaf Iustin Pop
                  -> Result (String, Instance.Instance)
66 e4c5beaf Iustin Pop
parseBaseInstance n a = do
67 e8230242 Iustin Pop
  let extract x = tryFromObj ("invalid data for instance '" ++ n ++ "'") a x
68 e8230242 Iustin Pop
  disk  <- extract "disk_space_total"
69 e8230242 Iustin Pop
  mem   <- extract "memory"
70 e8230242 Iustin Pop
  vcpus <- extract "vcpus"
71 e8230242 Iustin Pop
  tags  <- extract "tags"
72 5a4a3b7f Iustin Pop
  dt    <- extract "disk_template"
73 7dd14211 Agata Murawska
  return (n, Instance.create n mem disk vcpus Running tags True 0 0 dt)
74 585d4420 Iustin Pop
75 525bfb36 Iustin Pop
-- | Parses an instance as found in the cluster instance list.
76 28f19313 Iustin Pop
parseInstance :: NameAssoc -- ^ The node name-to-index association list
77 28f19313 Iustin Pop
              -> String    -- ^ The name of the instance
78 28f19313 Iustin Pop
              -> JSRecord  -- ^ The JSON object
79 e4c5beaf Iustin Pop
              -> Result (String, Instance.Instance)
80 e4c5beaf Iustin Pop
parseInstance ktn n a = do
81 262f3e6c Iustin Pop
  base <- parseBaseInstance n a
82 e8230242 Iustin Pop
  nodes <- fromObj a "nodes"
83 e41f4ba0 Iustin Pop
  pnode <- if null nodes
84 e41f4ba0 Iustin Pop
           then Bad $ "empty node list for instance " ++ n
85 e41f4ba0 Iustin Pop
           else readEitherString $ head nodes
86 262f3e6c Iustin Pop
  pidx <- lookupNode ktn n pnode
87 262f3e6c Iustin Pop
  let snodes = tail nodes
88 3603605a Iustin Pop
  sidx <- if null snodes
89 3603605a Iustin Pop
            then return Node.noSecondary
90 3603605a Iustin Pop
            else readEitherString (head snodes) >>= lookupNode ktn n
91 262f3e6c Iustin Pop
  return (n, Instance.setBoth (snd base) pidx sidx)
92 585d4420 Iustin Pop
93 9188aeef Iustin Pop
-- | Parses a node as found in the cluster node list.
94 28f19313 Iustin Pop
parseNode :: NameAssoc   -- ^ The group association
95 28f19313 Iustin Pop
          -> String      -- ^ The node's name
96 28f19313 Iustin Pop
          -> JSRecord    -- ^ The JSON object
97 9188aeef Iustin Pop
          -> Result (String, Node.Node)
98 10ef6b4e Iustin Pop
parseNode ktg n a = do
99 3eeea90f Iustin Pop
  let desc = "invalid data for node '" ++ n ++ "'"
100 3eeea90f Iustin Pop
      extract x = tryFromObj desc a x
101 e8230242 Iustin Pop
  offline <- extract "offline"
102 e8230242 Iustin Pop
  drained <- extract "drained"
103 e8230242 Iustin Pop
  guuid   <- extract "group"
104 3eeea90f Iustin Pop
  vm_capable  <- annotateResult desc $ maybeFromObj a "vm_capable"
105 3eeea90f Iustin Pop
  let vm_capable' = fromMaybe True vm_capable
106 10ef6b4e Iustin Pop
  gidx <- lookupGroup ktg n guuid
107 3603605a Iustin Pop
  node <- if offline || drained || not vm_capable'
108 8bc34c7b Iustin Pop
            then return $ Node.create n 0 0 0 0 0 0 True 0 gidx
109 3603605a Iustin Pop
            else do
110 3603605a Iustin Pop
              mtotal <- extract "total_memory"
111 3603605a Iustin Pop
              mnode  <- extract "reserved_memory"
112 3603605a Iustin Pop
              mfree  <- extract "free_memory"
113 3603605a Iustin Pop
              dtotal <- extract "total_disk"
114 3603605a Iustin Pop
              dfree  <- extract "free_disk"
115 3603605a Iustin Pop
              ctotal <- extract "total_cpus"
116 8bc34c7b Iustin Pop
              ndparams <- extract "ndparams" >>= asJSObject
117 8bc34c7b Iustin Pop
              spindles <- tryFromObj desc (fromJSObject ndparams)
118 8bc34c7b Iustin Pop
                          "spindle_count"
119 3603605a Iustin Pop
              return $ Node.create n mtotal mnode mfree
120 8bc34c7b Iustin Pop
                     dtotal dfree ctotal False spindles gidx
121 262f3e6c Iustin Pop
  return (n, node)
122 144f190b Iustin Pop
123 a679e9dc Iustin Pop
-- | Parses a group as found in the cluster group list.
124 28f19313 Iustin Pop
parseGroup :: String     -- ^ The group UUID
125 28f19313 Iustin Pop
           -> JSRecord   -- ^ The JSON object
126 a679e9dc Iustin Pop
           -> Result (String, Group.Group)
127 a679e9dc Iustin Pop
parseGroup u a = do
128 1b2cb110 Iustin Pop
  let extract x = tryFromObj ("invalid data for group '" ++ u ++ "'") a x
129 1b2cb110 Iustin Pop
  name <- extract "name"
130 1b2cb110 Iustin Pop
  apol <- extract "alloc_policy"
131 6cff91f5 Iustin Pop
  ipol <- extract "ipolicy"
132 6cff91f5 Iustin Pop
  return (u, Group.create name u apol ipol)
133 a679e9dc Iustin Pop
134 9188aeef Iustin Pop
-- | Top-level parser.
135 96a12113 Iustin Pop
--
136 96a12113 Iustin Pop
-- The result is a tuple of eventual warning messages and the parsed
137 96a12113 Iustin Pop
-- request; if parsing the input data fails, we'll return a 'Bad'
138 96a12113 Iustin Pop
-- value.
139 96a12113 Iustin Pop
parseData :: String -- ^ The JSON message as received from Ganeti
140 96a12113 Iustin Pop
          -> Result ([String], Request) -- ^ Result tuple
141 e4c5beaf Iustin Pop
parseData body = do
142 c96d44df Iustin Pop
  decoded <- fromJResult "Parsing input IAllocator message" (decodeStrict body)
143 262f3e6c Iustin Pop
  let obj = fromJSObject decoded
144 e8230242 Iustin Pop
      extrObj x = tryFromObj "invalid iallocator message" obj x
145 e4c5beaf Iustin Pop
  -- request parser
146 e8230242 Iustin Pop
  request <- liftM fromJSObject (extrObj "request")
147 e8230242 Iustin Pop
  let extrReq x = tryFromObj "invalid request dict" request x
148 a679e9dc Iustin Pop
  -- existing group parsing
149 e8230242 Iustin Pop
  glist <- liftM fromJSObject (extrObj "nodegroups")
150 a679e9dc Iustin Pop
  gobj <- mapM (\(x, y) -> asJSObject y >>= parseGroup x . fromJSObject) glist
151 10ef6b4e Iustin Pop
  let (ktg, gl) = assignIndices gobj
152 e4c5beaf Iustin Pop
  -- existing node parsing
153 e8230242 Iustin Pop
  nlist <- liftM fromJSObject (extrObj "nodes")
154 10ef6b4e Iustin Pop
  nobj <- mapM (\(x,y) ->
155 10ef6b4e Iustin Pop
                    asJSObject y >>= parseNode ktg x . fromJSObject) nlist
156 497e30a1 Iustin Pop
  let (ktn, nl) = assignIndices nobj
157 e4c5beaf Iustin Pop
  -- existing instance parsing
158 e8230242 Iustin Pop
  ilist <- extrObj "instances"
159 e4c5beaf Iustin Pop
  let idata = fromJSObject ilist
160 262f3e6c Iustin Pop
  iobj <- mapM (\(x,y) ->
161 262f3e6c Iustin Pop
                    asJSObject y >>= parseInstance ktn x . fromJSObject) idata
162 88df1fa9 Iustin Pop
  let (kti, il) = assignIndices iobj
163 669ea132 Iustin Pop
  -- cluster tags
164 e8230242 Iustin Pop
  ctags <- extrObj "cluster_tags"
165 71375ef7 Iustin Pop
  cdata1 <- mergeData [] [] [] [] (ClusterData gl nl il ctags defIPolicy)
166 96a12113 Iustin Pop
  let (msgs, fix_nl) = checkData (cdNodes cdata1) (cdInstances cdata1)
167 96a12113 Iustin Pop
      cdata = cdata1 { cdNodes = fix_nl }
168 88df1fa9 Iustin Pop
      map_n = cdNodes cdata
169 695c1bab Iustin Pop
      map_i = cdInstances cdata
170 695c1bab Iustin Pop
      map_g = cdGroups cdata
171 e8230242 Iustin Pop
  optype <- extrReq "type"
172 e4c5beaf Iustin Pop
  rqtype <-
173 00dd69a2 Iustin Pop
    case () of
174 00dd69a2 Iustin Pop
      _ | optype == C.iallocatorModeAlloc ->
175 00dd69a2 Iustin Pop
            do
176 00dd69a2 Iustin Pop
              rname     <- extrReq "name"
177 00dd69a2 Iustin Pop
              req_nodes <- extrReq "required_nodes"
178 00dd69a2 Iustin Pop
              inew      <- parseBaseInstance rname request
179 00dd69a2 Iustin Pop
              let io = snd inew
180 00dd69a2 Iustin Pop
              return $ Allocate io req_nodes
181 00dd69a2 Iustin Pop
        | optype == C.iallocatorModeReloc ->
182 00dd69a2 Iustin Pop
            do
183 00dd69a2 Iustin Pop
              rname     <- extrReq "name"
184 00dd69a2 Iustin Pop
              ridx      <- lookupInstance kti rname
185 00dd69a2 Iustin Pop
              req_nodes <- extrReq "required_nodes"
186 00dd69a2 Iustin Pop
              ex_nodes  <- extrReq "relocate_from"
187 00dd69a2 Iustin Pop
              ex_idex   <- mapM (Container.findByName map_n) ex_nodes
188 00dd69a2 Iustin Pop
              return $ Relocate ridx req_nodes (map Node.idx ex_idex)
189 00dd69a2 Iustin Pop
        | optype == C.iallocatorModeChgGroup ->
190 00dd69a2 Iustin Pop
            do
191 00dd69a2 Iustin Pop
              rl_names <- extrReq "instances"
192 00dd69a2 Iustin Pop
              rl_insts <- mapM (liftM Instance.idx .
193 00dd69a2 Iustin Pop
                                Container.findByName map_i) rl_names
194 00dd69a2 Iustin Pop
              gr_uuids <- extrReq "target_groups"
195 00dd69a2 Iustin Pop
              gr_idxes <- mapM (liftM Group.idx .
196 00dd69a2 Iustin Pop
                                Container.findByName map_g) gr_uuids
197 00dd69a2 Iustin Pop
              return $ ChangeGroup rl_insts gr_idxes
198 00dd69a2 Iustin Pop
        | optype == C.iallocatorModeNodeEvac ->
199 00dd69a2 Iustin Pop
            do
200 00dd69a2 Iustin Pop
              rl_names <- extrReq "instances"
201 00dd69a2 Iustin Pop
              rl_insts <- mapM (Container.findByName map_i) rl_names
202 00dd69a2 Iustin Pop
              let rl_idx = map Instance.idx rl_insts
203 00dd69a2 Iustin Pop
              rl_mode <- extrReq "evac_mode"
204 00dd69a2 Iustin Pop
              return $ NodeEvacuate rl_idx rl_mode
205 695c1bab Iustin Pop
206 00dd69a2 Iustin Pop
        | otherwise -> fail ("Invalid request type '" ++ optype ++ "'")
207 1b0a6356 Iustin Pop
  return (msgs, Request rqtype cdata)
208 942403e6 Iustin Pop
209 d6cf394e Iustin Pop
-- | Formats the result into a valid IAllocator response message.
210 9188aeef Iustin Pop
formatResponse :: Bool     -- ^ Whether the request was successful
211 9188aeef Iustin Pop
               -> String   -- ^ Information text
212 d6cf394e Iustin Pop
               -> JSValue  -- ^ The JSON encoded result
213 d6cf394e Iustin Pop
               -> String   -- ^ The full JSON-formatted message
214 d6cf394e Iustin Pop
formatResponse success info result =
215 00dd69a2 Iustin Pop
  let e_success = ("success", showJSON success)
216 00dd69a2 Iustin Pop
      e_info = ("info", showJSON info)
217 00dd69a2 Iustin Pop
      e_result = ("result", result)
218 00dd69a2 Iustin Pop
  in encodeStrict $ makeObj [e_success, e_info, e_result]
219 cabce2f4 Iustin Pop
220 7c14b50a Iustin Pop
-- | Flatten the log of a solution into a string.
221 7c14b50a Iustin Pop
describeSolution :: Cluster.AllocSolution -> String
222 7c14b50a Iustin Pop
describeSolution = intercalate ", " . Cluster.asLog
223 cabce2f4 Iustin Pop
224 7c14b50a Iustin Pop
-- | Convert allocation/relocation results into the result format.
225 f9283686 Iustin Pop
formatAllocate :: Instance.List -> Cluster.AllocSolution -> Result IAllocResult
226 f9283686 Iustin Pop
formatAllocate il as = do
227 7c14b50a Iustin Pop
  let info = describeSolution as
228 129734d3 Iustin Pop
  case Cluster.asSolution as of
229 129734d3 Iustin Pop
    Nothing -> fail info
230 129734d3 Iustin Pop
    Just (nl, inst, nodes, _) ->
231 00dd69a2 Iustin Pop
      do
232 00dd69a2 Iustin Pop
        let il' = Container.add (Instance.idx inst) inst il
233 00dd69a2 Iustin Pop
        return (info, showJSON $ map Node.name nodes, nl, il')
234 cabce2f4 Iustin Pop
235 47eed3f4 Iustin Pop
-- | Convert a node-evacuation/change group result.
236 5440c877 Iustin Pop
formatNodeEvac :: Group.List
237 5440c877 Iustin Pop
               -> Node.List
238 5440c877 Iustin Pop
               -> Instance.List
239 4036f63a Iustin Pop
               -> (Node.List, Instance.List, Cluster.EvacSolution)
240 5440c877 Iustin Pop
               -> Result IAllocResult
241 f9283686 Iustin Pop
formatNodeEvac gl nl il (fin_nl, fin_il, es) =
242 00dd69a2 Iustin Pop
  let iname = Instance.name . flip Container.find il
243 00dd69a2 Iustin Pop
      nname = Node.name . flip Container.find nl
244 00dd69a2 Iustin Pop
      gname = Group.name . flip Container.find gl
245 00dd69a2 Iustin Pop
      fes = map (\(idx, msg) -> (iname idx, msg)) $ Cluster.esFailed es
246 00dd69a2 Iustin Pop
      mes = map (\(idx, gdx, ndxs) -> (iname idx, gname gdx, map nname ndxs))
247 00dd69a2 Iustin Pop
            $ Cluster.esMoved es
248 00dd69a2 Iustin Pop
      failed = length fes
249 00dd69a2 Iustin Pop
      moved  = length mes
250 00dd69a2 Iustin Pop
      info = show failed ++ " instances failed to move and " ++ show moved ++
251 00dd69a2 Iustin Pop
             " were moved successfully"
252 00dd69a2 Iustin Pop
  in Ok (info, showJSON (mes, fes, Cluster.esOpCodes es), fin_nl, fin_il)
253 47eed3f4 Iustin Pop
254 88df1fa9 Iustin Pop
-- | Runs relocate for a single instance.
255 88df1fa9 Iustin Pop
--
256 88df1fa9 Iustin Pop
-- This is wrapper over the 'Cluster.tryNodeEvac' function that is run
257 88df1fa9 Iustin Pop
-- with a single instance (ours), and further it checks that the
258 88df1fa9 Iustin Pop
-- result it got (in the nodes field) is actually consistent, as
259 88df1fa9 Iustin Pop
-- tryNodeEvac is designed to output primarily an opcode list, not a
260 88df1fa9 Iustin Pop
-- node list.
261 88df1fa9 Iustin Pop
processRelocate :: Group.List      -- ^ The group list
262 88df1fa9 Iustin Pop
                -> Node.List       -- ^ The node list
263 88df1fa9 Iustin Pop
                -> Instance.List   -- ^ The instance list
264 88df1fa9 Iustin Pop
                -> Idx             -- ^ The index of the instance to move
265 88df1fa9 Iustin Pop
                -> Int             -- ^ The number of nodes required
266 88df1fa9 Iustin Pop
                -> [Ndx]           -- ^ Nodes which should not be used
267 88df1fa9 Iustin Pop
                -> Result (Node.List, Instance.List, [Ndx]) -- ^ Solution list
268 88df1fa9 Iustin Pop
processRelocate gl nl il idx 1 exndx = do
269 88df1fa9 Iustin Pop
  let orig = Container.find idx il
270 88df1fa9 Iustin Pop
      sorig = Instance.sNode orig
271 88df1fa9 Iustin Pop
  when (exndx /= [sorig]) $
272 88df1fa9 Iustin Pop
       -- FIXME: we can't use the excluded nodes here; the logic is
273 88df1fa9 Iustin Pop
       -- already _but only partially_ implemented in tryNodeEvac...
274 88df1fa9 Iustin Pop
       fail $ "Unsupported request: excluded nodes not equal to\
275 88df1fa9 Iustin Pop
              \ instance's secondary node (" ++ show sorig ++ " versus " ++
276 88df1fa9 Iustin Pop
              show exndx ++ ")"
277 88df1fa9 Iustin Pop
  (nl', il', esol) <- Cluster.tryNodeEvac gl nl il ChangeSecondary [idx]
278 88df1fa9 Iustin Pop
  nodes <- case lookup idx (Cluster.esFailed esol) of
279 88df1fa9 Iustin Pop
             Just msg -> fail msg
280 88df1fa9 Iustin Pop
             Nothing ->
281 88df1fa9 Iustin Pop
                 case lookup idx (map (\(a, _, b) -> (a, b))
282 88df1fa9 Iustin Pop
                                  (Cluster.esMoved esol)) of
283 88df1fa9 Iustin Pop
                   Nothing ->
284 88df1fa9 Iustin Pop
                       fail "Internal error: lost instance idx during move"
285 88df1fa9 Iustin Pop
                   Just n -> return n
286 88df1fa9 Iustin Pop
  let inst = Container.find idx il'
287 88df1fa9 Iustin Pop
      pnode = Instance.pNode inst
288 88df1fa9 Iustin Pop
      snode = Instance.sNode inst
289 88df1fa9 Iustin Pop
  when (snode == sorig) $
290 88df1fa9 Iustin Pop
       fail "Internal error: instance didn't change secondary node?!"
291 f25508be Iustin Pop
  when (snode == pnode) $
292 f25508be Iustin Pop
       fail "Internal error: selected primary as new secondary?!"
293 88df1fa9 Iustin Pop
294 05ff7a00 Agata Murawska
  nodes' <- if nodes == [pnode, snode]
295 88df1fa9 Iustin Pop
            then return [snode] -- only the new secondary is needed
296 88df1fa9 Iustin Pop
            else fail $ "Internal error: inconsistent node list (" ++
297 88df1fa9 Iustin Pop
                 show nodes ++ ") versus instance nodes (" ++ show pnode ++
298 88df1fa9 Iustin Pop
                 "," ++ show snode ++ ")"
299 88df1fa9 Iustin Pop
  return (nl', il', nodes')
300 88df1fa9 Iustin Pop
301 88df1fa9 Iustin Pop
processRelocate _ _ _ _ reqn _ =
302 88df1fa9 Iustin Pop
  fail $ "Exchange " ++ show reqn ++ " nodes mode is not implemented"
303 88df1fa9 Iustin Pop
304 88df1fa9 Iustin Pop
formatRelocate :: (Node.List, Instance.List, [Ndx])
305 88df1fa9 Iustin Pop
               -> Result IAllocResult
306 88df1fa9 Iustin Pop
formatRelocate (nl, il, ndxs) =
307 00dd69a2 Iustin Pop
  let nodes = map (`Container.find` nl) ndxs
308 00dd69a2 Iustin Pop
      names = map Node.name nodes
309 00dd69a2 Iustin Pop
  in Ok ("success", showJSON names, nl, il)
310 88df1fa9 Iustin Pop
311 179c0828 Iustin Pop
-- | Process a request and return new node lists.
312 7c14b50a Iustin Pop
processRequest :: Request -> Result IAllocResult
313 cabce2f4 Iustin Pop
processRequest request =
314 71375ef7 Iustin Pop
  let Request rqtype (ClusterData gl nl il _ _) = request
315 cabce2f4 Iustin Pop
  in case rqtype of
316 7c14b50a Iustin Pop
       Allocate xi reqn ->
317 00dd69a2 Iustin Pop
         Cluster.tryMGAlloc gl nl il xi reqn >>= formatAllocate il
318 88df1fa9 Iustin Pop
       Relocate idx reqn exnodes ->
319 00dd69a2 Iustin Pop
         processRelocate gl nl il idx reqn exnodes >>= formatRelocate
320 20b376ff Iustin Pop
       ChangeGroup gdxs idxs ->
321 00dd69a2 Iustin Pop
         Cluster.tryChangeGroup gl nl il idxs gdxs >>=
322 00dd69a2 Iustin Pop
                formatNodeEvac gl nl il
323 47eed3f4 Iustin Pop
       NodeEvacuate xi mode ->
324 00dd69a2 Iustin Pop
         Cluster.tryNodeEvac gl nl il mode xi >>=
325 00dd69a2 Iustin Pop
                formatNodeEvac gl nl il
326 cabce2f4 Iustin Pop
327 179c0828 Iustin Pop
-- | Reads the request from the data file(s).
328 c3f8cb12 René Nussbaumer
readRequest :: FilePath -> IO Request
329 c3f8cb12 René Nussbaumer
readRequest fp = do
330 c3f8cb12 René Nussbaumer
  input_data <- readFile fp
331 c3f8cb12 René Nussbaumer
  case parseData input_data of
332 c3f8cb12 René Nussbaumer
    Bad err -> do
333 c3f8cb12 René Nussbaumer
      hPutStrLn stderr $ "Error: " ++ err
334 c3f8cb12 René Nussbaumer
      exitWith $ ExitFailure 1
335 c3f8cb12 René Nussbaumer
    Ok (fix_msgs, rq) -> maybeShowWarnings fix_msgs >> return rq
336 00152519 Iustin Pop
337 00152519 Iustin Pop
-- | Main iallocator pipeline.
338 f9283686 Iustin Pop
runIAllocator :: Request -> (Maybe (Node.List, Instance.List), String)
339 00152519 Iustin Pop
runIAllocator request =
340 f9283686 Iustin Pop
  let (ok, info, result, cdata) =
341 00dd69a2 Iustin Pop
        case processRequest request of
342 00dd69a2 Iustin Pop
          Ok (msg, r, nl, il) -> (True, "Request successful: " ++ msg, r,
343 00dd69a2 Iustin Pop
                                  Just (nl, il))
344 00dd69a2 Iustin Pop
          Bad msg -> (False, "Request failed: " ++ msg, JSArray [], Nothing)
345 ce6a0b53 Iustin Pop
      rstring = formatResponse ok info result
346 f9283686 Iustin Pop
  in (cdata, rstring)
347 786c514c René Nussbaumer
348 786c514c René Nussbaumer
-- | Load the data from an iallocation request file
349 786c514c René Nussbaumer
loadData :: FilePath -- ^ The path to the file
350 786c514c René Nussbaumer
         -> IO (Result ClusterData)
351 786c514c René Nussbaumer
loadData fp = do
352 786c514c René Nussbaumer
  Request _ cdata <- readRequest fp
353 786c514c René Nussbaumer
  return $ Ok cdata