Revision ef947a42 src/Ganeti/HTools/Backend/IAlloc.hs
b/src/Ganeti/HTools/Backend/IAlloc.hs | ||
---|---|---|
34 | 34 |
import Data.Maybe (fromMaybe, isJust, fromJust) |
35 | 35 |
import Data.List |
36 | 36 |
import Control.Monad |
37 |
import System.Time |
|
37 | 38 |
import Text.JSON (JSObject, JSValue(JSArray), |
38 | 39 |
makeObj, encodeStrict, decodeStrict, fromJSObject, showJSON) |
39 | 40 |
|
... | ... | |
138 | 139 |
-- The result is a tuple of eventual warning messages and the parsed |
139 | 140 |
-- request; if parsing the input data fails, we'll return a 'Bad' |
140 | 141 |
-- value. |
141 |
parseData :: String -- ^ The JSON message as received from Ganeti |
|
142 |
parseData :: ClockTime -- ^ The current time |
|
143 |
-> String -- ^ The JSON message as received from Ganeti |
|
142 | 144 |
-> Result ([String], Request) -- ^ Result tuple |
143 |
parseData body = do |
|
145 |
parseData now body = do
|
|
144 | 146 |
decoded <- fromJResult "Parsing input IAllocator message" (decodeStrict body) |
145 | 147 |
let obj = fromJSObject decoded |
146 | 148 |
extrObj x = tryFromObj "invalid iallocator message" obj x |
... | ... | |
165 | 167 |
let (kti, il) = assignIndices iobj |
166 | 168 |
-- cluster tags |
167 | 169 |
ctags <- extrObj "cluster_tags" |
168 |
cdata1 <- mergeData [] [] [] [] (ClusterData gl nl il ctags defIPolicy) |
|
170 |
cdata1 <- mergeData [] [] [] [] now (ClusterData gl nl il ctags defIPolicy)
|
|
169 | 171 |
let (msgs, fix_nl) = checkData (cdNodes cdata1) (cdInstances cdata1) |
170 | 172 |
cdata = cdata1 { cdNodes = fix_nl } |
171 | 173 |
map_n = cdNodes cdata |
... | ... | |
380 | 382 |
-- | Reads the request from the data file(s). |
381 | 383 |
readRequest :: FilePath -> IO Request |
382 | 384 |
readRequest fp = do |
385 |
now <- getClockTime |
|
383 | 386 |
input_data <- case fp of |
384 | 387 |
"-" -> getContents |
385 | 388 |
_ -> readFile fp |
386 |
case parseData input_data of |
|
389 |
case parseData now input_data of
|
|
387 | 390 |
Bad err -> exitErr err |
388 | 391 |
Ok (fix_msgs, rq) -> maybeShowWarnings fix_msgs >> return rq |
389 | 392 |
|
Also available in: Unified diff