## root / test / hs / Test / Ganeti / Types.hs @ dde8b625

History | View | Annotate | Download (14.8 kB)

1 |
{-# LANGUAGE TemplateHaskell #-} |
---|---|

2 |
{-# OPTIONS_GHC -fno-warn-orphans #-} |

3 | |

4 |
{-| Unittests for 'Ganeti.Types'. |

5 | |

6 |
-} |

7 | |

8 |
{- |

9 | |

10 |
Copyright (C) 2012, 2013 Google Inc. |

11 | |

12 |
This program is free software; you can redistribute it and/or modify |

13 |
it under the terms of the GNU General Public License as published by |

14 |
the Free Software Foundation; either version 2 of the License, or |

15 |
(at your option) any later version. |

16 | |

17 |
This program is distributed in the hope that it will be useful, but |

18 |
WITHOUT ANY WARRANTY; without even the implied warranty of |

19 |
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU |

20 |
General Public License for more details. |

21 | |

22 |
You should have received a copy of the GNU General Public License |

23 |
along with this program; if not, write to the Free Software |

24 |
Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA |

25 |
02110-1301, USA. |

26 | |

27 |
-} |

28 | |

29 |
module Test.Ganeti.Types |

30 |
( testTypes |

31 |
, AllocPolicy(..) |

32 |
, DiskTemplate(..) |

33 |
, allDiskTemplates |

34 |
, InstanceStatus(..) |

35 |
, NonEmpty(..) |

36 |
, Hypervisor(..) |

37 |
, JobId(..) |

38 |
) where |

39 | |

40 |
import Control.Applicative |

41 |
import System.Time (ClockTime(..)) |

42 | |

43 |
import Test.QuickCheck as QuickCheck hiding (Result) |

44 |
import Test.HUnit |

45 |
import qualified Text.JSON as J |

46 | |

47 |
import Test.Ganeti.TestHelper |

48 |
import Test.Ganeti.TestCommon |

49 | |

50 |
import Ganeti.BasicTypes |

51 |
import qualified Ganeti.Constants as C |

52 |
import qualified Ganeti.ConstantUtils as ConstantUtils |

53 |
import Ganeti.Types as Types |

54 |
import Ganeti.JSON |

55 | |

56 |
{-# ANN module "HLint: ignore Use camelCase" #-} |

57 | |

58 |
-- * Arbitrary instance |

59 | |

60 |
instance Arbitrary ClockTime where |

61 |
arbitrary = TOD <$> arbitrary <*> fmap (`mod` (10^(12::Int))) arbitrary |

62 | |

63 |
instance (Arbitrary a, Ord a, Num a, Show a) => |

64 |
Arbitrary (Types.Positive a) where |

65 |
arbitrary = do |

66 |
(QuickCheck.Positive i) <- arbitrary |

67 |
Types.mkPositive i |

68 | |

69 |
instance (Arbitrary a, Ord a, Num a, Show a) => |

70 |
Arbitrary (Types.NonNegative a) where |

71 |
arbitrary = do |

72 |
(QuickCheck.NonNegative i) <- arbitrary |

73 |
Types.mkNonNegative i |

74 | |

75 |
instance (Arbitrary a, Ord a, Num a, Show a) => |

76 |
Arbitrary (Types.Negative a) where |

77 |
arbitrary = do |

78 |
(QuickCheck.Positive i) <- arbitrary |

79 |
Types.mkNegative $ negate i |

80 | |

81 |
instance (Arbitrary a) => Arbitrary (Types.NonEmpty a) where |

82 |
arbitrary = do |

83 |
QuickCheck.NonEmpty lst <- arbitrary |

84 |
Types.mkNonEmpty lst |

85 | |

86 |
$(genArbitrary ''AllocPolicy) |

87 | |

88 |
-- | Valid disk templates (depending on configure options). |

89 |
allDiskTemplates :: [DiskTemplate] |

90 |
allDiskTemplates = [minBound..maxBound]::[DiskTemplate] |

91 | |

92 |
-- | Custom 'Arbitrary' instance for 'DiskTemplate', which needs to |

93 |
-- handle the case of file storage being disabled at configure time. |

94 |
instance Arbitrary DiskTemplate where |

95 |
arbitrary = elements allDiskTemplates |

96 | |

97 |
$(genArbitrary ''InstanceStatus) |

98 | |

99 |
$(genArbitrary ''MigrationMode) |

100 | |

101 |
$(genArbitrary ''VerifyOptionalChecks) |

102 | |

103 |
$(genArbitrary ''DdmSimple) |

104 | |

105 |
$(genArbitrary ''DdmFull) |

106 | |

107 |
$(genArbitrary ''CVErrorCode) |

108 | |

109 |
$(genArbitrary ''Hypervisor) |

110 | |

111 |
$(genArbitrary ''TagKind) |

112 | |

113 |
$(genArbitrary ''OobCommand) |

114 | |

115 |
-- | Valid storage types. |

116 |
allStorageTypes :: [StorageType] |

117 |
allStorageTypes = [minBound..maxBound]::[StorageType] |

118 | |

119 |
-- | Custom 'Arbitrary' instance for 'StorageType', which needs to |

120 |
-- handle the case of file storage being disabled at configure time. |

121 |
instance Arbitrary StorageType where |

122 |
arbitrary = elements allStorageTypes |

123 | |

124 |
$(genArbitrary ''EvacMode) |

125 | |

126 |
$(genArbitrary ''FileDriver) |

127 | |

128 |
$(genArbitrary ''InstCreateMode) |

129 | |

130 |
$(genArbitrary ''RebootType) |

131 | |

132 |
$(genArbitrary ''ExportMode) |

133 | |

134 |
$(genArbitrary ''IAllocatorTestDir) |

135 | |

136 |
$(genArbitrary ''IAllocatorMode) |

137 | |

138 |
$(genArbitrary ''NICMode) |

139 | |

140 |
$(genArbitrary ''JobStatus) |

141 | |

142 |
$(genArbitrary ''FinalizedJobStatus) |

143 | |

144 |
instance Arbitrary JobId where |

145 |
arbitrary = do |

146 |
(Positive i) <- arbitrary |

147 |
makeJobId i |

148 | |

149 |
$(genArbitrary ''JobIdDep) |

150 | |

151 |
$(genArbitrary ''JobDependency) |

152 | |

153 |
$(genArbitrary ''OpSubmitPriority) |

154 | |

155 |
$(genArbitrary ''OpStatus) |

156 | |

157 |
$(genArbitrary ''ELogType) |

158 | |

159 |
-- * Properties |

160 | |

161 |
prop_AllocPolicy_serialisation :: AllocPolicy -> Property |

162 |
prop_AllocPolicy_serialisation = testSerialisation |

163 | |

164 |
-- | Test 'AllocPolicy' ordering is as expected. |

165 |
case_AllocPolicy_order :: Assertion |

166 |
case_AllocPolicy_order = |

167 |
assertEqual "sort order" [ Types.AllocPreferred |

168 |
, Types.AllocLastResort |

169 |
, Types.AllocUnallocable |

170 |
] [minBound..maxBound] |

171 | |

172 |
prop_DiskTemplate_serialisation :: DiskTemplate -> Property |

173 |
prop_DiskTemplate_serialisation = testSerialisation |

174 | |

175 |
prop_InstanceStatus_serialisation :: InstanceStatus -> Property |

176 |
prop_InstanceStatus_serialisation = testSerialisation |

177 | |

178 |
-- | Tests building non-negative numbers. |

179 |
prop_NonNeg_pass :: QuickCheck.NonNegative Int -> Property |

180 |
prop_NonNeg_pass (QuickCheck.NonNegative i) = |

181 |
case mkNonNegative i of |

182 |
Bad msg -> failTest $ "Fail to build non-negative: " ++ msg |

183 |
Ok nn -> fromNonNegative nn ==? i |

184 | |

185 |
-- | Tests building non-negative numbers. |

186 |
prop_NonNeg_fail :: QuickCheck.Positive Int -> Property |

187 |
prop_NonNeg_fail (QuickCheck.Positive i) = |

188 |
case mkNonNegative (negate i)::Result (Types.NonNegative Int) of |

189 |
Bad _ -> passTest |

190 |
Ok nn -> failTest $ "Built non-negative number '" ++ show nn ++ |

191 |
"' from negative value " ++ show i |

192 | |

193 |
-- | Tests building positive numbers. |

194 |
prop_Positive_pass :: QuickCheck.Positive Int -> Property |

195 |
prop_Positive_pass (QuickCheck.Positive i) = |

196 |
case mkPositive i of |

197 |
Bad msg -> failTest $ "Fail to build positive: " ++ msg |

198 |
Ok nn -> fromPositive nn ==? i |

199 | |

200 |
-- | Tests building positive numbers. |

201 |
prop_Positive_fail :: QuickCheck.NonNegative Int -> Property |

202 |
prop_Positive_fail (QuickCheck.NonNegative i) = |

203 |
case mkPositive (negate i)::Result (Types.Positive Int) of |

204 |
Bad _ -> passTest |

205 |
Ok nn -> failTest $ "Built positive number '" ++ show nn ++ |

206 |
"' from negative or zero value " ++ show i |

207 | |

208 |
-- | Tests building negative numbers. |

209 |
prop_Neg_pass :: QuickCheck.Positive Int -> Property |

210 |
prop_Neg_pass (QuickCheck.Positive i) = |

211 |
case mkNegative i' of |

212 |
Bad msg -> failTest $ "Fail to build negative: " ++ msg |

213 |
Ok nn -> fromNegative nn ==? i' |

214 |
where i' = negate i |

215 | |

216 |
-- | Tests building negative numbers. |

217 |
prop_Neg_fail :: QuickCheck.NonNegative Int -> Property |

218 |
prop_Neg_fail (QuickCheck.NonNegative i) = |

219 |
case mkNegative i::Result (Types.Negative Int) of |

220 |
Bad _ -> passTest |

221 |
Ok nn -> failTest $ "Built negative number '" ++ show nn ++ |

222 |
"' from non-negative value " ++ show i |

223 | |

224 |
-- | Tests building non-empty lists. |

225 |
prop_NonEmpty_pass :: QuickCheck.NonEmptyList String -> Property |

226 |
prop_NonEmpty_pass (QuickCheck.NonEmpty xs) = |

227 |
case mkNonEmpty xs of |

228 |
Bad msg -> failTest $ "Fail to build non-empty list: " ++ msg |

229 |
Ok nn -> fromNonEmpty nn ==? xs |

230 | |

231 |
-- | Tests building positive numbers. |

232 |
case_NonEmpty_fail :: Assertion |

233 |
case_NonEmpty_fail = |

234 |
assertEqual "building non-empty list from an empty list" |

235 |
(Bad "Received empty value for non-empty list") (mkNonEmpty ([]::[Int])) |

236 | |

237 |
-- | Tests migration mode serialisation. |

238 |
prop_MigrationMode_serialisation :: MigrationMode -> Property |

239 |
prop_MigrationMode_serialisation = testSerialisation |

240 | |

241 |
-- | Tests verify optional checks serialisation. |

242 |
prop_VerifyOptionalChecks_serialisation :: VerifyOptionalChecks -> Property |

243 |
prop_VerifyOptionalChecks_serialisation = testSerialisation |

244 | |

245 |
-- | Tests 'DdmSimple' serialisation. |

246 |
prop_DdmSimple_serialisation :: DdmSimple -> Property |

247 |
prop_DdmSimple_serialisation = testSerialisation |

248 | |

249 |
-- | Tests 'DdmFull' serialisation. |

250 |
prop_DdmFull_serialisation :: DdmFull -> Property |

251 |
prop_DdmFull_serialisation = testSerialisation |

252 | |

253 |
-- | Tests 'CVErrorCode' serialisation. |

254 |
prop_CVErrorCode_serialisation :: CVErrorCode -> Property |

255 |
prop_CVErrorCode_serialisation = testSerialisation |

256 | |

257 |
-- | Tests equivalence with Python, based on Constants.hs code. |

258 |
case_CVErrorCode_pyequiv :: Assertion |

259 |
case_CVErrorCode_pyequiv = do |

260 |
let all_py_codes = C.cvAllEcodesStrings |

261 |
all_hs_codes = ConstantUtils.mkSet $ |

262 |
map Types.cVErrorCodeToRaw [minBound..maxBound] |

263 |
assertEqual "for CVErrorCode equivalence" all_py_codes all_hs_codes |

264 | |

265 |
-- | Test 'Hypervisor' serialisation. |

266 |
prop_Hypervisor_serialisation :: Hypervisor -> Property |

267 |
prop_Hypervisor_serialisation = testSerialisation |

268 | |

269 |
-- | Test 'OobCommand' serialisation. |

270 |
prop_OobCommand_serialisation :: OobCommand -> Property |

271 |
prop_OobCommand_serialisation = testSerialisation |

272 | |

273 |
-- | Test 'StorageType' serialisation. |

274 |
prop_StorageType_serialisation :: StorageType -> Property |

275 |
prop_StorageType_serialisation = testSerialisation |

276 | |

277 |
-- | Test 'NodeEvacMode' serialisation. |

278 |
prop_NodeEvacMode_serialisation :: EvacMode -> Property |

279 |
prop_NodeEvacMode_serialisation = testSerialisation |

280 | |

281 |
-- | Test 'FileDriver' serialisation. |

282 |
prop_FileDriver_serialisation :: FileDriver -> Property |

283 |
prop_FileDriver_serialisation = testSerialisation |

284 | |

285 |
-- | Test 'InstCreate' serialisation. |

286 |
prop_InstCreateMode_serialisation :: InstCreateMode -> Property |

287 |
prop_InstCreateMode_serialisation = testSerialisation |

288 | |

289 |
-- | Test 'RebootType' serialisation. |

290 |
prop_RebootType_serialisation :: RebootType -> Property |

291 |
prop_RebootType_serialisation = testSerialisation |

292 | |

293 |
-- | Test 'ExportMode' serialisation. |

294 |
prop_ExportMode_serialisation :: ExportMode -> Property |

295 |
prop_ExportMode_serialisation = testSerialisation |

296 | |

297 |
-- | Test 'IAllocatorTestDir' serialisation. |

298 |
prop_IAllocatorTestDir_serialisation :: IAllocatorTestDir -> Property |

299 |
prop_IAllocatorTestDir_serialisation = testSerialisation |

300 | |

301 |
-- | Test 'IAllocatorMode' serialisation. |

302 |
prop_IAllocatorMode_serialisation :: IAllocatorMode -> Property |

303 |
prop_IAllocatorMode_serialisation = testSerialisation |

304 | |

305 |
-- | Tests equivalence with Python, based on Constants.hs code. |

306 |
case_IAllocatorMode_pyequiv :: Assertion |

307 |
case_IAllocatorMode_pyequiv = do |

308 |
let all_py_codes = C.validIallocatorModes |

309 |
all_hs_codes = ConstantUtils.mkSet $ |

310 |
map Types.iAllocatorModeToRaw [minBound..maxBound] |

311 |
assertEqual "for IAllocatorMode equivalence" all_py_codes all_hs_codes |

312 | |

313 |
-- | Test 'NICMode' serialisation. |

314 |
prop_NICMode_serialisation :: NICMode -> Property |

315 |
prop_NICMode_serialisation = testSerialisation |

316 | |

317 |
-- | Test 'OpStatus' serialisation. |

318 |
prop_OpStatus_serialization :: OpStatus -> Property |

319 |
prop_OpStatus_serialization = testSerialisation |

320 | |

321 |
-- | Test 'JobStatus' serialisation. |

322 |
prop_JobStatus_serialization :: JobStatus -> Property |

323 |
prop_JobStatus_serialization = testSerialisation |

324 | |

325 |
-- | Test 'JobStatus' ordering is as expected. |

326 |
case_JobStatus_order :: Assertion |

327 |
case_JobStatus_order = |

328 |
assertEqual "sort order" [ Types.JOB_STATUS_QUEUED |

329 |
, Types.JOB_STATUS_WAITING |

330 |
, Types.JOB_STATUS_CANCELING |

331 |
, Types.JOB_STATUS_RUNNING |

332 |
, Types.JOB_STATUS_CANCELED |

333 |
, Types.JOB_STATUS_SUCCESS |

334 |
, Types.JOB_STATUS_ERROR |

335 |
] [minBound..maxBound] |

336 | |

337 |
-- | Tests equivalence with Python, based on Constants.hs code. |

338 |
case_NICMode_pyequiv :: Assertion |

339 |
case_NICMode_pyequiv = do |

340 |
let all_py_codes = C.nicValidModes |

341 |
all_hs_codes = ConstantUtils.mkSet $ |

342 |
map Types.nICModeToRaw [minBound..maxBound] |

343 |
assertEqual "for NICMode equivalence" all_py_codes all_hs_codes |

344 | |

345 |
-- | Test 'FinalizedJobStatus' serialisation. |

346 |
prop_FinalizedJobStatus_serialisation :: FinalizedJobStatus -> Property |

347 |
prop_FinalizedJobStatus_serialisation = testSerialisation |

348 | |

349 |
-- | Tests equivalence with Python, based on Constants.hs code. |

350 |
case_FinalizedJobStatus_pyequiv :: Assertion |

351 |
case_FinalizedJobStatus_pyequiv = do |

352 |
let all_py_codes = C.jobsFinalized |

353 |
all_hs_codes = ConstantUtils.mkSet $ |

354 |
map Types.finalizedJobStatusToRaw [minBound..maxBound] |

355 |
assertEqual "for FinalizedJobStatus equivalence" all_py_codes all_hs_codes |

356 | |

357 |
-- | Tests JobId serialisation (both from string and ints). |

358 |
prop_JobId_serialisation :: JobId -> Property |

359 |
prop_JobId_serialisation jid = |

360 |
conjoin [ testSerialisation jid |

361 |
, (J.readJSON . J.showJSON . show $ fromJobId jid) ==? J.Ok jid |

362 |
, case (fromJVal . J.showJSON . negate $ |

363 |
fromJobId jid)::Result JobId of |

364 |
Bad _ -> passTest |

365 |
Ok jid' -> failTest $ "Parsed negative job id as id " ++ |

366 |
show (fromJobId jid') |

367 |
] |

368 | |

369 |
-- | Tests that fractional job IDs are not accepted. |

370 |
prop_JobId_fractional :: Property |

371 |
prop_JobId_fractional = |

372 |
forAll (arbitrary `suchThat` |

373 |
(\d -> fromIntegral (truncate d::Int) /= d)) $ \d -> |

374 |
case J.readJSON (J.showJSON (d::Double)) of |

375 |
J.Error _ -> passTest |

376 |
J.Ok jid -> failTest $ "Parsed fractional value " ++ show d ++ |

377 |
" as job id " ++ show (fromJobId jid) |

378 | |

379 |
-- | Tests that a job ID is not parseable from \"bad\" JSON values. |

380 |
case_JobId_BadTypes :: Assertion |

381 |
case_JobId_BadTypes = do |

382 |
let helper jsval = case J.readJSON jsval of |

383 |
J.Error _ -> return () |

384 |
J.Ok jid -> assertFailure $ "Parsed " ++ show jsval |

385 |
++ " as job id " ++ show (fromJobId jid) |

386 |
helper J.JSNull |

387 |
helper (J.JSBool True) |

388 |
helper (J.JSBool False) |

389 |
helper (J.JSArray []) |

390 | |

391 |
-- | Test 'JobDependency' serialisation. |

392 |
prop_JobDependency_serialisation :: JobDependency -> Property |

393 |
prop_JobDependency_serialisation = testSerialisation |

394 | |

395 |
-- | Test 'OpSubmitPriority' serialisation. |

396 |
prop_OpSubmitPriority_serialisation :: OpSubmitPriority -> Property |

397 |
prop_OpSubmitPriority_serialisation = testSerialisation |

398 | |

399 |
-- | Tests string formatting for 'OpSubmitPriority'. |

400 |
prop_OpSubmitPriority_string :: OpSubmitPriority -> Property |

401 |
prop_OpSubmitPriority_string prio = |

402 |
parseSubmitPriority (fmtSubmitPriority prio) ==? Just prio |

403 | |

404 |
-- | Test 'ELogType' serialisation. |

405 |
prop_ELogType_serialisation :: ELogType -> Property |

406 |
prop_ELogType_serialisation = testSerialisation |

407 | |

408 |
testSuite "Types" |

409 |
[ 'prop_AllocPolicy_serialisation |

410 |
, 'case_AllocPolicy_order |

411 |
, 'prop_DiskTemplate_serialisation |

412 |
, 'prop_InstanceStatus_serialisation |

413 |
, 'prop_NonNeg_pass |

414 |
, 'prop_NonNeg_fail |

415 |
, 'prop_Positive_pass |

416 |
, 'prop_Positive_fail |

417 |
, 'prop_Neg_pass |

418 |
, 'prop_Neg_fail |

419 |
, 'prop_NonEmpty_pass |

420 |
, 'case_NonEmpty_fail |

421 |
, 'prop_MigrationMode_serialisation |

422 |
, 'prop_VerifyOptionalChecks_serialisation |

423 |
, 'prop_DdmSimple_serialisation |

424 |
, 'prop_DdmFull_serialisation |

425 |
, 'prop_CVErrorCode_serialisation |

426 |
, 'case_CVErrorCode_pyequiv |

427 |
, 'prop_Hypervisor_serialisation |

428 |
, 'prop_OobCommand_serialisation |

429 |
, 'prop_StorageType_serialisation |

430 |
, 'prop_NodeEvacMode_serialisation |

431 |
, 'prop_FileDriver_serialisation |

432 |
, 'prop_InstCreateMode_serialisation |

433 |
, 'prop_RebootType_serialisation |

434 |
, 'prop_ExportMode_serialisation |

435 |
, 'prop_IAllocatorTestDir_serialisation |

436 |
, 'prop_IAllocatorMode_serialisation |

437 |
, 'case_IAllocatorMode_pyequiv |

438 |
, 'prop_NICMode_serialisation |

439 |
, 'prop_OpStatus_serialization |

440 |
, 'prop_JobStatus_serialization |

441 |
, 'case_JobStatus_order |

442 |
, 'case_NICMode_pyequiv |

443 |
, 'prop_FinalizedJobStatus_serialisation |

444 |
, 'case_FinalizedJobStatus_pyequiv |

445 |
, 'prop_JobId_serialisation |

446 |
, 'prop_JobId_fractional |

447 |
, 'case_JobId_BadTypes |

448 |
, 'prop_JobDependency_serialisation |

449 |
, 'prop_OpSubmitPriority_serialisation |

450 |
, 'prop_OpSubmitPriority_string |

451 |
, 'prop_ELogType_serialisation |

452 |
] |