root / test / hs / Test / Ganeti / JQueue.hs @ 72747d91
History | View | Annotate | Download (11.3 kB)
1 |
{-# LANGUAGE TemplateHaskell #-} |
---|---|
2 |
|
3 |
{-| Unittests for the job queue functionality. |
4 |
|
5 |
-} |
6 |
|
7 |
{- |
8 |
|
9 |
Copyright (C) 2012, 2013 Google Inc. |
10 |
|
11 |
This program is free software; you can redistribute it and/or modify |
12 |
it under the terms of the GNU General Public License as published by |
13 |
the Free Software Foundation; either version 2 of the License, or |
14 |
(at your option) any later version. |
15 |
|
16 |
This program is distributed in the hope that it will be useful, but |
17 |
WITHOUT ANY WARRANTY; without even the implied warranty of |
18 |
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU |
19 |
General Public License for more details. |
20 |
|
21 |
You should have received a copy of the GNU General Public License |
22 |
along with this program; if not, write to the Free Software |
23 |
Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA |
24 |
02110-1301, USA. |
25 |
|
26 |
-} |
27 |
|
28 |
module Test.Ganeti.JQueue (testJQueue) where |
29 |
|
30 |
import Control.Applicative |
31 |
import Control.Monad (when) |
32 |
import Data.Char (isAscii) |
33 |
import Data.List (nub, sort) |
34 |
import System.Directory |
35 |
import System.FilePath |
36 |
import System.IO.Temp |
37 |
import System.Posix.Files |
38 |
import Test.HUnit |
39 |
import Test.QuickCheck as QuickCheck |
40 |
import Test.QuickCheck.Monadic |
41 |
import Text.JSON |
42 |
|
43 |
import Test.Ganeti.TestCommon |
44 |
import Test.Ganeti.TestHelper |
45 |
import Test.Ganeti.Types () |
46 |
import Test.Ganeti.OpCodes |
47 |
|
48 |
import Ganeti.BasicTypes |
49 |
import qualified Ganeti.Constants as C |
50 |
import Ganeti.JQueue |
51 |
import Ganeti.OpCodes |
52 |
import Ganeti.Path |
53 |
import Ganeti.Types as Types |
54 |
|
55 |
{-# ANN module "HLint: ignore Use camelCase" #-} |
56 |
|
57 |
-- * Helpers |
58 |
|
59 |
-- | noTimestamp in Just form. |
60 |
justNoTs :: Maybe Timestamp |
61 |
justNoTs = Just noTimestamp |
62 |
|
63 |
-- | Generates a simple queued opcode. |
64 |
genQueuedOpCode :: Gen QueuedOpCode |
65 |
genQueuedOpCode = |
66 |
QueuedOpCode <$> pure (ValidOpCode $ wrapOpCode OpClusterQuery) <*> |
67 |
arbitrary <*> pure JSNull <*> pure [] <*> |
68 |
choose (C.opPrioLowest, C.opPrioHighest) <*> |
69 |
pure justNoTs <*> pure justNoTs <*> pure justNoTs |
70 |
|
71 |
-- | Generates an static, empty job. |
72 |
emptyJob :: (Monad m) => m QueuedJob |
73 |
emptyJob = do |
74 |
jid0 <- makeJobId 0 |
75 |
return $ QueuedJob jid0 [] justNoTs justNoTs justNoTs |
76 |
|
77 |
-- | Generates a job ID. |
78 |
genJobId :: Gen JobId |
79 |
genJobId = do |
80 |
p <- arbitrary::Gen (Types.NonNegative Int) |
81 |
makeJobId $ fromNonNegative p |
82 |
|
83 |
-- * Test cases |
84 |
|
85 |
-- | Tests default priority value. |
86 |
case_JobPriorityDef :: Assertion |
87 |
case_JobPriorityDef = do |
88 |
ej <- emptyJob |
89 |
assertEqual "for default priority" C.opPrioDefault $ calcJobPriority ej |
90 |
|
91 |
-- | Test arbitrary priorities. |
92 |
prop_JobPriority :: Property |
93 |
prop_JobPriority = |
94 |
forAll (listOf1 (genQueuedOpCode `suchThat` |
95 |
(not . opStatusFinalized . qoStatus))) $ \ops -> do |
96 |
jid0 <- makeJobId 0 |
97 |
let job = QueuedJob jid0 ops justNoTs justNoTs justNoTs |
98 |
calcJobPriority job ==? minimum (map qoPriority ops) |
99 |
|
100 |
-- | Tests default job status. |
101 |
case_JobStatusDef :: Assertion |
102 |
case_JobStatusDef = do |
103 |
ej <- emptyJob |
104 |
assertEqual "for job status" JOB_STATUS_SUCCESS $ calcJobStatus ej |
105 |
|
106 |
-- | Test some job status properties. |
107 |
prop_JobStatus :: Property |
108 |
prop_JobStatus = |
109 |
forAll genJobId $ \jid -> |
110 |
forAll genQueuedOpCode $ \op -> |
111 |
let job1 = QueuedJob jid [op] justNoTs justNoTs justNoTs |
112 |
st1 = calcJobStatus job1 |
113 |
op_succ = op { qoStatus = OP_STATUS_SUCCESS } |
114 |
op_err = op { qoStatus = OP_STATUS_ERROR } |
115 |
op_cnl = op { qoStatus = OP_STATUS_CANCELING } |
116 |
op_cnd = op { qoStatus = OP_STATUS_CANCELED } |
117 |
-- computes status for a job with an added opcode before |
118 |
st_pre_op pop = calcJobStatus (job1 { qjOps = pop:qjOps job1 }) |
119 |
-- computes status for a job with an added opcode after |
120 |
st_post_op pop = calcJobStatus (job1 { qjOps = qjOps job1 ++ [pop] }) |
121 |
in conjoin |
122 |
[ printTestCase "pre-success doesn't change status" |
123 |
(st_pre_op op_succ ==? st1) |
124 |
, printTestCase "post-success doesn't change status" |
125 |
(st_post_op op_succ ==? st1) |
126 |
, printTestCase "pre-error is error" |
127 |
(st_pre_op op_err ==? JOB_STATUS_ERROR) |
128 |
, printTestCase "pre-canceling is canceling" |
129 |
(st_pre_op op_cnl ==? JOB_STATUS_CANCELING) |
130 |
, printTestCase "pre-canceled is canceled" |
131 |
(st_pre_op op_cnd ==? JOB_STATUS_CANCELED) |
132 |
] |
133 |
|
134 |
-- | Tests job status equivalence with Python. Very similar to OpCodes test. |
135 |
case_JobStatusPri_py_equiv :: Assertion |
136 |
case_JobStatusPri_py_equiv = do |
137 |
let num_jobs = 2000::Int |
138 |
jobs <- genSample (vectorOf num_jobs $ do |
139 |
num_ops <- choose (1, 5) |
140 |
ops <- vectorOf num_ops genQueuedOpCode |
141 |
jid <- genJobId |
142 |
return $ QueuedJob jid ops justNoTs justNoTs justNoTs) |
143 |
let serialized = encode jobs |
144 |
-- check for non-ASCII fields, usually due to 'arbitrary :: String' |
145 |
mapM_ (\job -> when (any (not . isAscii) (encode job)) . |
146 |
assertFailure $ "Job has non-ASCII fields: " ++ show job |
147 |
) jobs |
148 |
py_stdout <- |
149 |
runPython "from ganeti import jqueue\n\ |
150 |
\from ganeti import serializer\n\ |
151 |
\import sys\n\ |
152 |
\job_data = serializer.Load(sys.stdin.read())\n\ |
153 |
\decoded = [jqueue._QueuedJob.Restore(None, o, False, False)\n\ |
154 |
\ for o in job_data]\n\ |
155 |
\encoded = [(job.CalcStatus(), job.CalcPriority())\n\ |
156 |
\ for job in decoded]\n\ |
157 |
\print serializer.Dump(encoded)" serialized |
158 |
>>= checkPythonResult |
159 |
let deserialised = decode py_stdout::Text.JSON.Result [(String, Int)] |
160 |
decoded <- case deserialised of |
161 |
Text.JSON.Ok jobs' -> return jobs' |
162 |
Error msg -> |
163 |
assertFailure ("Unable to decode jobs: " ++ msg) |
164 |
-- this already raised an expection, but we need it |
165 |
-- for proper types |
166 |
>> fail "Unable to decode jobs" |
167 |
assertEqual "Mismatch in number of returned jobs" |
168 |
(length decoded) (length jobs) |
169 |
mapM_ (\(py_sp, job) -> |
170 |
let hs_sp = (jobStatusToRaw $ calcJobStatus job, |
171 |
calcJobPriority job) |
172 |
in assertEqual ("Different result after encoding/decoding for " ++ |
173 |
show job) py_sp hs_sp |
174 |
) $ zip decoded jobs |
175 |
|
176 |
-- | Tests listing of Job ids. |
177 |
prop_ListJobIDs :: Property |
178 |
prop_ListJobIDs = monadicIO $ do |
179 |
jobs <- pick $ resize 10 (listOf1 genJobId `suchThat` (\l -> l == nub l)) |
180 |
(e, f, g) <- |
181 |
run . withSystemTempDirectory "jqueue-test." $ \tempdir -> do |
182 |
empty_dir <- getJobIDs [tempdir] |
183 |
mapM_ (\jid -> writeFile (tempdir </> jobFileName jid) "") jobs |
184 |
full_dir <- getJobIDs [tempdir] |
185 |
invalid_dir <- getJobIDs [tempdir </> "no-such-dir"] |
186 |
return (empty_dir, sortJobIDs full_dir, invalid_dir) |
187 |
stop $ conjoin [ printTestCase "empty directory" $ e ==? [] |
188 |
, printTestCase "directory with valid names" $ |
189 |
f ==? sortJobIDs jobs |
190 |
, printTestCase "invalid directory" $ g ==? [] |
191 |
] |
192 |
|
193 |
-- | Tests loading jobs from disk. |
194 |
prop_LoadJobs :: Property |
195 |
prop_LoadJobs = monadicIO $ do |
196 |
ops <- pick $ resize 5 (listOf1 genQueuedOpCode) |
197 |
jid <- pick genJobId |
198 |
let job = QueuedJob jid ops justNoTs justNoTs justNoTs |
199 |
job_s = encode job |
200 |
-- check that jobs in the right directories are parsed correctly |
201 |
(missing, current, archived, missing_current, broken) <- |
202 |
run . withSystemTempDirectory "jqueue-test." $ \tempdir -> do |
203 |
let load a = loadJobFromDisk tempdir a jid |
204 |
live_path = liveJobFile tempdir jid |
205 |
arch_path = archivedJobFile tempdir jid |
206 |
createDirectory $ tempdir </> jobQueueArchiveSubDir |
207 |
createDirectory $ dropFileName arch_path |
208 |
-- missing job |
209 |
missing <- load True |
210 |
writeFile live_path job_s |
211 |
-- this should exist |
212 |
current <- load False |
213 |
removeFile live_path |
214 |
writeFile arch_path job_s |
215 |
-- this should exist (archived) |
216 |
archived <- load True |
217 |
-- this should be missing |
218 |
missing_current <- load False |
219 |
removeFile arch_path |
220 |
writeFile live_path "invalid job" |
221 |
broken <- load True |
222 |
return (missing, current, archived, missing_current, broken) |
223 |
stop $ conjoin [ missing ==? noSuchJob |
224 |
, current ==? Ganeti.BasicTypes.Ok (job, False) |
225 |
, archived ==? Ganeti.BasicTypes.Ok (job, True) |
226 |
, missing_current ==? noSuchJob |
227 |
, printTestCase "broken job" (isBad broken) |
228 |
] |
229 |
|
230 |
-- | Tests computing job directories. Creates random directories, |
231 |
-- files and stale symlinks in a directory, and checks that we return |
232 |
-- \"the right thing\". |
233 |
prop_DetermineDirs :: Property |
234 |
prop_DetermineDirs = monadicIO $ do |
235 |
count <- pick $ choose (2, 10) |
236 |
nums <- pick $ genUniquesList count |
237 |
(arbitrary::Gen (QuickCheck.Positive Int)) |
238 |
let (valid, invalid) = splitAt (count `div` 2) $ |
239 |
map (\(QuickCheck.Positive i) -> show i) nums |
240 |
(tempdir, non_arch, with_arch, invalid_root) <- |
241 |
run . withSystemTempDirectory "jqueue-test." $ \tempdir -> do |
242 |
let arch_dir = tempdir </> jobQueueArchiveSubDir |
243 |
createDirectory arch_dir |
244 |
mapM_ (createDirectory . (arch_dir </>)) valid |
245 |
mapM_ (\p -> writeFile (arch_dir </> p) "") invalid |
246 |
mapM_ (\p -> createSymbolicLink "/dev/null/no/such/file" |
247 |
(arch_dir </> p <.> "missing")) invalid |
248 |
non_arch <- determineJobDirectories tempdir False |
249 |
with_arch <- determineJobDirectories tempdir True |
250 |
invalid_root <- determineJobDirectories (tempdir </> "no-such-subdir") True |
251 |
return (tempdir, non_arch, with_arch, invalid_root) |
252 |
let arch_dir = tempdir </> jobQueueArchiveSubDir |
253 |
stop $ conjoin [ non_arch ==? [tempdir] |
254 |
, sort with_arch ==? sort (tempdir:map (arch_dir </>) valid) |
255 |
, invalid_root ==? [tempdir </> "no-such-subdir"] |
256 |
] |
257 |
|
258 |
-- | Tests the JSON serialisation for 'InputOpCode'. |
259 |
prop_InputOpCode :: MetaOpCode -> Int -> Property |
260 |
prop_InputOpCode meta i = |
261 |
conjoin [ readJSON (showJSON valid) ==? Text.JSON.Ok valid |
262 |
, readJSON (showJSON invalid) ==? Text.JSON.Ok invalid |
263 |
] |
264 |
where valid = ValidOpCode meta |
265 |
invalid = InvalidOpCode (showJSON i) |
266 |
|
267 |
-- | Tests 'extractOpSummary'. |
268 |
prop_extractOpSummary :: MetaOpCode -> Int -> Property |
269 |
prop_extractOpSummary meta i = |
270 |
conjoin [ printTestCase "valid opcode" $ |
271 |
extractOpSummary (ValidOpCode meta) ==? summary |
272 |
, printTestCase "invalid opcode, correct object" $ |
273 |
extractOpSummary (InvalidOpCode jsobj) ==? summary |
274 |
, printTestCase "invalid opcode, empty object" $ |
275 |
extractOpSummary (InvalidOpCode emptyo) ==? invalid |
276 |
, printTestCase "invalid opcode, object with invalid OP_ID" $ |
277 |
extractOpSummary (InvalidOpCode invobj) ==? invalid |
278 |
, printTestCase "invalid opcode, not jsobject" $ |
279 |
extractOpSummary (InvalidOpCode jsinval) ==? invalid |
280 |
] |
281 |
where summary = opSummary (metaOpCode meta) |
282 |
jsobj = showJSON $ toJSObject [("OP_ID", |
283 |
showJSON ("OP_" ++ summary))] |
284 |
emptyo = showJSON $ toJSObject ([]::[(String, JSValue)]) |
285 |
invobj = showJSON $ toJSObject [("OP_ID", showJSON False)] |
286 |
jsinval = showJSON i |
287 |
invalid = "INVALID_OP" |
288 |
|
289 |
testSuite "JQueue" |
290 |
[ 'case_JobPriorityDef |
291 |
, 'prop_JobPriority |
292 |
, 'case_JobStatusDef |
293 |
, 'prop_JobStatus |
294 |
, 'case_JobStatusPri_py_equiv |
295 |
, 'prop_ListJobIDs |
296 |
, 'prop_LoadJobs |
297 |
, 'prop_DetermineDirs |
298 |
, 'prop_InputOpCode |
299 |
, 'prop_extractOpSummary |
300 |
] |