| {-# LANGUAGE TemplateHaskell #-} |
| |
| {-| Unittests for the job queue functionality. |
| |
| -} |
| |
| {- |
| |
| Copyright (C) 2012, 2013 Google Inc. |
| |
| This program is free software; you can redistribute it and/or modify |
| it under the terms of the GNU General Public License as published by |
| the Free Software Foundation; either version 2 of the License, or |
| (at your option) any later version. |
| |
| This program is distributed in the hope that it will be useful, but |
| WITHOUT ANY WARRANTY; without even the implied warranty of |
| MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU |
| General Public License for more details. |
| |
| You should have received a copy of the GNU General Public License |
| along with this program; if not, write to the Free Software |
| Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA |
| 02110-1301, USA. |
| |
| -} |
| |
| module Test.Ganeti.JQueue (testJQueue) where |
| |
| import Control.Applicative |
| import Control.Monad (when) |
| import Data.Char (isAscii) |
| import Data.List (nub, sort) |
| import System.Directory |
| import System.FilePath |
| import System.IO.Temp |
| import System.Posix.Files |
| import Test.HUnit |
| import Test.QuickCheck as QuickCheck |
| import Test.QuickCheck.Monadic |
| import Text.JSON |
| |
| import Test.Ganeti.TestCommon |
| import Test.Ganeti.TestHelper |
| import Test.Ganeti.Types () |
| import Test.Ganeti.OpCodes |
| |
| import Ganeti.BasicTypes |
| import qualified Ganeti.Constants as C |
| import Ganeti.JQueue |
| import Ganeti.OpCodes |
| import Ganeti.Path |
| import Ganeti.Types as Types |
| |
| {-# ANN module "HLint: ignore Use camelCase" #-} |
| |
| -- * Helpers |
| |
| -- | noTimestamp in Just form. |
| justNoTs :: Maybe Timestamp |
| justNoTs = Just noTimestamp |
| |
| -- | Generates a simple queued opcode. |
| genQueuedOpCode :: Gen QueuedOpCode |
| genQueuedOpCode = |
| QueuedOpCode <$> pure (ValidOpCode $ wrapOpCode OpClusterQuery) <*> |
| arbitrary <*> pure JSNull <*> pure [] <*> |
| choose (C.opPrioLowest, C.opPrioHighest) <*> |
| pure justNoTs <*> pure justNoTs <*> pure justNoTs |
| |
| -- | Generates an static, empty job. |
| emptyJob :: (Monad m) => m QueuedJob |
| emptyJob = do |
| jid0 <- makeJobId 0 |
| return $ QueuedJob jid0 [] justNoTs justNoTs justNoTs |
| |
| -- | Generates a job ID. |
| genJobId :: Gen JobId |
| genJobId = do |
| p <- arbitrary::Gen (Types.NonNegative Int) |
| makeJobId $ fromNonNegative p |
| |
| -- * Test cases |
| |
| -- | Tests default priority value. |
| case_JobPriorityDef :: Assertion |
| case_JobPriorityDef = do |
| ej <- emptyJob |
| assertEqual "for default priority" C.opPrioDefault $ calcJobPriority ej |
| |
| -- | Test arbitrary priorities. |
| prop_JobPriority :: Property |
| prop_JobPriority = |
| forAll (listOf1 (genQueuedOpCode `suchThat` |
| (not . opStatusFinalized . qoStatus))) $ \ops -> do |
| jid0 <- makeJobId 0 |
| let job = QueuedJob jid0 ops justNoTs justNoTs justNoTs |
| calcJobPriority job ==? minimum (map qoPriority ops) |
| |
| -- | Tests default job status. |
| case_JobStatusDef :: Assertion |
| case_JobStatusDef = do |
| ej <- emptyJob |
| assertEqual "for job status" JOB_STATUS_SUCCESS $ calcJobStatus ej |
| |
| -- | Test some job status properties. |
| prop_JobStatus :: Property |
| prop_JobStatus = |
| forAll genJobId $ \jid -> |
| forAll genQueuedOpCode $ \op -> |
| let job1 = QueuedJob jid [op] justNoTs justNoTs justNoTs |
| st1 = calcJobStatus job1 |
| op_succ = op { qoStatus = OP_STATUS_SUCCESS } |
| op_err = op { qoStatus = OP_STATUS_ERROR } |
| op_cnl = op { qoStatus = OP_STATUS_CANCELING } |
| op_cnd = op { qoStatus = OP_STATUS_CANCELED } |
| -- computes status for a job with an added opcode before |
| st_pre_op pop = calcJobStatus (job1 { qjOps = pop:qjOps job1 }) |
| -- computes status for a job with an added opcode after |
| st_post_op pop = calcJobStatus (job1 { qjOps = qjOps job1 ++ [pop] }) |
| in conjoin |
| [ printTestCase "pre-success doesn't change status" |
| (st_pre_op op_succ ==? st1) |
| , printTestCase "post-success doesn't change status" |
| (st_post_op op_succ ==? st1) |
| , printTestCase "pre-error is error" |
| (st_pre_op op_err ==? JOB_STATUS_ERROR) |
| , printTestCase "pre-canceling is canceling" |
| (st_pre_op op_cnl ==? JOB_STATUS_CANCELING) |
| , printTestCase "pre-canceled is canceled" |
| (st_pre_op op_cnd ==? JOB_STATUS_CANCELED) |
| ] |
| |
| -- | Tests job status equivalence with Python. Very similar to OpCodes test. |
| case_JobStatusPri_py_equiv :: Assertion |
| case_JobStatusPri_py_equiv = do |
| let num_jobs = 2000::Int |
| jobs <- genSample (vectorOf num_jobs $ do |
| num_ops <- choose (1, 5) |
| ops <- vectorOf num_ops genQueuedOpCode |
| jid <- genJobId |
| return $ QueuedJob jid ops justNoTs justNoTs justNoTs) |
| let serialized = encode jobs |
| -- check for non-ASCII fields, usually due to 'arbitrary :: String' |
| mapM_ (\job -> when (any (not . isAscii) (encode job)) . |
| assertFailure $ "Job has non-ASCII fields: " ++ show job |
| ) jobs |
| py_stdout <- |
| runPython "from ganeti import jqueue\n\ |
| \from ganeti import serializer\n\ |
| \import sys\n\ |
| \job_data = serializer.Load(sys.stdin.read())\n\ |
| \decoded = [jqueue._QueuedJob.Restore(None, o, False, False)\n\ |
| \ for o in job_data]\n\ |
| \encoded = [(job.CalcStatus(), job.CalcPriority())\n\ |
| \ for job in decoded]\n\ |
| \print serializer.Dump(encoded)" serialized |
| >>= checkPythonResult |
| let deserialised = decode py_stdout::Text.JSON.Result [(String, Int)] |
| decoded <- case deserialised of |
| Text.JSON.Ok jobs' -> return jobs' |
| Error msg -> |
| assertFailure ("Unable to decode jobs: " ++ msg) |
| -- this already raised an expection, but we need it |
| -- for proper types |
| >> fail "Unable to decode jobs" |
| assertEqual "Mismatch in number of returned jobs" |
| (length decoded) (length jobs) |
| mapM_ (\(py_sp, job) -> |
| let hs_sp = (jobStatusToRaw $ calcJobStatus job, |
| calcJobPriority job) |
| in assertEqual ("Different result after encoding/decoding for " ++ |
| show job) py_sp hs_sp |
| ) $ zip decoded jobs |
| |
| -- | Tests listing of Job ids. |
| prop_ListJobIDs :: Property |
| prop_ListJobIDs = monadicIO $ do |
| let extractJobIDs jIDs = do |
| either_jobs <- jIDs |
| case either_jobs of |
| Right j -> return j |
| Left e -> fail $ show e |
| isLeft e = |
| case e of |
| Left _ -> True |
| _ -> False |
| jobs <- pick $ resize 10 (listOf1 genJobId `suchThat` (\l -> l == nub l)) |
| (e, f, g) <- |
| run . withSystemTempDirectory "jqueue-test." $ \tempdir -> do |
| empty_dir <- extractJobIDs $ getJobIDs [tempdir] |
| mapM_ (\jid -> writeFile (tempdir </> jobFileName jid) "") jobs |
| full_dir <- extractJobIDs $ getJobIDs [tempdir] |
| invalid_dir <- getJobIDs [tempdir </> "no-such-dir"] |
| return (empty_dir, sortJobIDs full_dir, invalid_dir) |
| stop $ conjoin [ printTestCase "empty directory" $ e ==? [] |
| , printTestCase "directory with valid names" $ |
| f ==? sortJobIDs jobs |
| , printTestCase "invalid directory" $ isLeft g |
| ] |
| |
| -- | Tests loading jobs from disk. |
| prop_LoadJobs :: Property |
| prop_LoadJobs = monadicIO $ do |
| ops <- pick $ resize 5 (listOf1 genQueuedOpCode) |
| jid <- pick genJobId |
| let job = QueuedJob jid ops justNoTs justNoTs justNoTs |
| job_s = encode job |
| -- check that jobs in the right directories are parsed correctly |
| (missing, current, archived, missing_current, broken) <- |
| run . withSystemTempDirectory "jqueue-test." $ \tempdir -> do |
| let load a = loadJobFromDisk tempdir a jid |
| live_path = liveJobFile tempdir jid |
| arch_path = archivedJobFile tempdir jid |
| createDirectory $ tempdir </> jobQueueArchiveSubDir |
| createDirectory $ dropFileName arch_path |
| -- missing job |
| missing <- load True |
| writeFile live_path job_s |
| -- this should exist |
| current <- load False |
| removeFile live_path |
| writeFile arch_path job_s |
| -- this should exist (archived) |
| archived <- load True |
| -- this should be missing |
| missing_current <- load False |
| removeFile arch_path |
| writeFile live_path "invalid job" |
| broken <- load True |
| return (missing, current, archived, missing_current, broken) |
| stop $ conjoin [ missing ==? noSuchJob |
| , current ==? Ganeti.BasicTypes.Ok (job, False) |
| , archived ==? Ganeti.BasicTypes.Ok (job, True) |
| , missing_current ==? noSuchJob |
| , printTestCase "broken job" (isBad broken) |
| ] |
| |
| -- | Tests computing job directories. Creates random directories, |
| -- files and stale symlinks in a directory, and checks that we return |
| -- \"the right thing\". |
| prop_DetermineDirs :: Property |
| prop_DetermineDirs = monadicIO $ do |
| count <- pick $ choose (2, 10) |
| nums <- pick $ genUniquesList count |
| (arbitrary::Gen (QuickCheck.Positive Int)) |
| let (valid, invalid) = splitAt (count `div` 2) $ |
| map (\(QuickCheck.Positive i) -> show i) nums |
| (tempdir, non_arch, with_arch, invalid_root) <- |
| run . withSystemTempDirectory "jqueue-test." $ \tempdir -> do |
| let arch_dir = tempdir </> jobQueueArchiveSubDir |
| createDirectory arch_dir |
| mapM_ (createDirectory . (arch_dir </>)) valid |
| mapM_ (\p -> writeFile (arch_dir </> p) "") invalid |
| mapM_ (\p -> createSymbolicLink "/dev/null/no/such/file" |
| (arch_dir </> p <.> "missing")) invalid |
| non_arch <- determineJobDirectories tempdir False |
| with_arch <- determineJobDirectories tempdir True |
| invalid_root <- determineJobDirectories (tempdir </> "no-such-subdir") True |
| return (tempdir, non_arch, with_arch, invalid_root) |
| let arch_dir = tempdir </> jobQueueArchiveSubDir |
| stop $ conjoin [ non_arch ==? [tempdir] |
| , sort with_arch ==? sort (tempdir:map (arch_dir </>) valid) |
| , invalid_root ==? [tempdir </> "no-such-subdir"] |
| ] |
| |
| -- | Tests the JSON serialisation for 'InputOpCode'. |
| prop_InputOpCode :: MetaOpCode -> Int -> Property |
| prop_InputOpCode meta i = |
| conjoin [ readJSON (showJSON valid) ==? Text.JSON.Ok valid |
| , readJSON (showJSON invalid) ==? Text.JSON.Ok invalid |
| ] |
| where valid = ValidOpCode meta |
| invalid = InvalidOpCode (showJSON i) |
| |
| -- | Tests 'extractOpSummary'. |
| prop_extractOpSummary :: MetaOpCode -> Int -> Property |
| prop_extractOpSummary meta i = |
| conjoin [ printTestCase "valid opcode" $ |
| extractOpSummary (ValidOpCode meta) ==? summary |
| , printTestCase "invalid opcode, correct object" $ |
| extractOpSummary (InvalidOpCode jsobj) ==? summary |
| , printTestCase "invalid opcode, empty object" $ |
| extractOpSummary (InvalidOpCode emptyo) ==? invalid |
| , printTestCase "invalid opcode, object with invalid OP_ID" $ |
| extractOpSummary (InvalidOpCode invobj) ==? invalid |
| , printTestCase "invalid opcode, not jsobject" $ |
| extractOpSummary (InvalidOpCode jsinval) ==? invalid |
| ] |
| where summary = opSummary (metaOpCode meta) |
| jsobj = showJSON $ toJSObject [("OP_ID", |
| showJSON ("OP_" ++ summary))] |
| emptyo = showJSON $ toJSObject ([]::[(String, JSValue)]) |
| invobj = showJSON $ toJSObject [("OP_ID", showJSON False)] |
| jsinval = showJSON i |
| invalid = "INVALID_OP" |
| |
| testSuite "JQueue" |
| [ 'case_JobPriorityDef |
| , 'prop_JobPriority |
| , 'case_JobStatusDef |
| , 'prop_JobStatus |
| , 'case_JobStatusPri_py_equiv |
| , 'prop_ListJobIDs |
| , 'prop_LoadJobs |
| , 'prop_DetermineDirs |
| , 'prop_InputOpCode |
| , 'prop_extractOpSummary |
| ] |
