Commit 513673d0 authored by Niklas Hambuechen's avatar Niklas Hambuechen
Browse files

Unit tests for job filtering



This tests only the filter logic; the QA testing filter management + logic
comes later.
Signed-off-by: default avatarNiklas Hambuechen <niklash@google.com>
Reviewed-by: default avatarKlaus Aehlig <aehlig@google.com>
parent 1c05226b
......@@ -37,6 +37,9 @@ SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
module Ganeti.JQScheduler.Filtering
( applyingFilter
, jobFiltering
-- * For testing only
, matchPredicate
, matches
) where
import Data.List
......
{-# LANGUAGE TemplateHaskell, ScopedTypeVariables #-}
{-# LANGUAGE TemplateHaskell, ScopedTypeVariables, NamedFieldPuns #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
{-| Unittests for the job scheduler.
......@@ -39,10 +39,13 @@ module Test.Ganeti.JQScheduler (testJQScheduler) where
import Control.Applicative
import Control.Lens ((&), (.~), _2)
import Data.List (inits)
import Data.Maybe
import qualified Data.Map as Map
import Data.Set (difference)
import Data.Set (Set, difference)
import qualified Data.Set as Set
import Data.Traversable (traverse)
import Text.JSON (JSValue(..))
import Test.HUnit
import Test.QuickCheck
......@@ -52,14 +55,19 @@ import Test.Ganeti.TestCommon
import Test.Ganeti.TestHelper
import Test.Ganeti.Types ()
import Ganeti.JQScheduler.Filtering
import Ganeti.JQScheduler.ReasonRateLimiting
import Ganeti.JQScheduler.Types
import Ganeti.JQueue.Lens
import Ganeti.JQueue.Objects
import Ganeti.Objects (FilterRule(..), FilterPredicate(..), FilterAction(..),
filterRuleOrder)
import Ganeti.OpCodes
import Ganeti.OpCodes.Lens
import Ganeti.Query.Language (Filter(..), FilterValue(..))
import Ganeti.SlotMap
import Ganeti.Types (makeJobId)
import Ganeti.Utils (isSubsequenceOf)
import Ganeti.Types
import Ganeti.Utils (isSubsequenceOf, newUUID)
{-# ANN module "HLint: ignore Use camelCase" #-}
......@@ -246,9 +254,356 @@ prop_reasonRateLimit =
| (k, slot@(Slot occup limit)) <- Map.toList newSlots ]
]
-- | Tests that filter rule ordering is determined (solely) by priority,
-- watermark and UUID, as defined in `doc/design-optables.rst`.
prop_filterRuleOrder :: Property
prop_filterRuleOrder = do
a <- arbitrary
b <- arbitrary `suchThat` ((frUuid a /=) . frUuid)
filterRuleOrder a b ==? (frPriority a, frWatermark a, frUuid a)
`compare`
(frPriority b, frWatermark b, frUuid b)
-- | Tests common inputs for `matchPredicate`, especially the predicates
-- and fields available to them as defined in the spec.
case_matchPredicate :: Assertion
case_matchPredicate = do
jid1 <- makeJobId 1
clusterName <- mkNonEmpty "cluster1"
let job =
QueuedJob
{ qjId = jid1
, qjOps =
[ QueuedOpCode
{ qoInput = ValidOpCode MetaOpCode
{ metaParams = CommonOpParams
{ opDryRun = Nothing
, opDebugLevel = Nothing
, opPriority = OpPrioHigh
, opDepends = Just []
, opComment = Nothing
, opReason = [("source1", "reason1", 1234)]}
, metaOpCode = OpClusterRename
{ opName = clusterName
}
}
, qoStatus = OP_STATUS_QUEUED
, qoResult = JSNull
, qoLog = []
, qoPriority = -1
, qoStartTimestamp = Nothing
, qoExecTimestamp = Nothing
, qoEndTimestamp = Nothing
}
]
, qjReceivedTimestamp = Nothing
, qjStartTimestamp = Nothing
, qjEndTimestamp = Nothing
, qjLivelock = Nothing
, qjProcessId = Nothing
}
let watermark = jid1
check = matchPredicate job watermark
-- jobid filters
assertEqual "matching jobid filter"
True
. check $ FPJobId (EQFilter "id" (NumericValue 1))
assertEqual "non-matching jobid filter"
False
. check $ FPJobId (EQFilter "id" (NumericValue 2))
assertEqual "non-matching jobid filter (string passed)"
False
. check $ FPJobId (EQFilter "id" (QuotedString "1"))
-- jobid filters: watermarks
assertEqual "matching jobid watermark filter"
True
. check $ FPJobId (EQFilter "id" (QuotedString "watermark"))
-- opcode filters
assertEqual "matching opcode filter (type of opcode)"
True
. check $ FPOpCode (EQFilter "OP_ID" (QuotedString "OP_CLUSTER_RENAME"))
assertEqual "non-matching opcode filter (type of opcode)"
False
. check $ FPOpCode (EQFilter "OP_ID" (QuotedString "OP_INSTANCE_CREATE"))
assertEqual "matching opcode filter (nested access)"
True
. check $ FPOpCode (EQFilter "name" (QuotedString "cluster1"))
assertEqual "non-matching opcode filter (nonexistent nested access)"
False
. check $ FPOpCode (EQFilter "something" (QuotedString "cluster1"))
-- reason filters
assertEqual "matching reason filter (reason field)"
True
. check $ FPReason (EQFilter "reason" (QuotedString "reason1"))
assertEqual "non-matching reason filter (reason field)"
False
. check $ FPReason (EQFilter "reason" (QuotedString "reasonGarbage"))
assertEqual "matching reason filter (source field)"
True
. check $ FPReason (EQFilter "source" (QuotedString "source1"))
assertEqual "matching reason filter (timestamp field)"
True
. check $ FPReason (EQFilter "timestamp" (NumericValue 1234))
assertEqual "non-matching reason filter (nonexistent field)"
False
. check $ FPReason (EQFilter "something" (QuotedString ""))
-- | Tests that jobs selected by `applyingFilter` actually match
-- and have an effect (are not CONTINUE filters).
prop_applyingFilter :: Property
prop_applyingFilter =
forAllShrink arbitrary shrink $ \(job, filters) ->
let applying = applyingFilter (Set.fromList filters) job
in isJust applying ==> case applying of
Just f -> job `matches` f && frAction f /= Continue
Nothing -> True
case_jobFiltering :: Assertion
case_jobFiltering = do
clusterName <- mkNonEmpty "cluster1"
jid1 <- makeJobId 1
jid2 <- makeJobId 2
jid3 <- makeJobId 3
jid4 <- makeJobId 4
unsetPrio <- mkNonNegative 1234
uuid1 <- newUUID
let j1 =
nullJobWithStat QueuedJob
{ qjId = jid1
, qjOps =
[ QueuedOpCode
{ qoInput = ValidOpCode MetaOpCode
{ metaParams = CommonOpParams
{ opDryRun = Nothing
, opDebugLevel = Nothing
, opPriority = OpPrioHigh
, opDepends = Just []
, opComment = Nothing
, opReason = [("source1", "reason1", 1234)]}
, metaOpCode = OpClusterRename
{ opName = clusterName
}
}
, qoStatus = OP_STATUS_QUEUED
, qoResult = JSNull
, qoLog = []
, qoPriority = -1
, qoStartTimestamp = Nothing
, qoExecTimestamp = Nothing
, qoEndTimestamp = Nothing
}
]
, qjReceivedTimestamp = Nothing
, qjStartTimestamp = Nothing
, qjEndTimestamp = Nothing
, qjLivelock = Nothing
, qjProcessId = Nothing
}
j2 = j1 & jJobL . qjIdL .~ jid2
j3 = j1 & jJobL . qjIdL .~ jid3
j4 = j1 & jJobL . qjIdL .~ jid4
fr1 =
FilterRule
{ frWatermark = jid1
, frPriority = unsetPrio
, frPredicates = [FPJobId (EQFilter "id" (NumericValue 1))]
, frAction = Reject
, frReasonTrail = []
, frUuid = uuid1
}
-- Gives the rule a new UUID.
rule fr = do
uuid <- newUUID
return fr{ frUuid = uuid }
-- Helper to create filter chains: assigns the filters in the list
-- increasing priorities, so that filters listed first are processed
-- first.
chain :: [FilterRule] -> Set FilterRule
chain frs
| any ((/= unsetPrio) . frPriority) frs =
error "Filter was passed to `chain` that already had a priority."
| otherwise =
Set.fromList
[ fr{ frPriority = prio }
| (fr, Just prio) <- zip frs (map mkNonNegative [1..]) ]
fr2 <- rule fr1{ frAction = Accept }
fr3 <- rule fr1{ frAction = Pause }
fr4 <- rule fr1{ frPredicates =
[FPJobId (GTFilter "id" (QuotedString "watermark"))]
}
fr5 <- rule fr1{ frPredicates = [] }
fr6 <- rule fr5{ frAction = Continue }
fr7 <- rule fr6{ frAction = RateLimit 2 }
fr8 <- rule fr4{ frAction = Continue, frWatermark = jid1 }
fr9 <- rule fr8{ frAction = RateLimit 2 }
assertEqual "j1 should be rejected (by fr1)"
[]
(jobFiltering (Queue [j1] [] []) (chain [fr1]) [j1])
assertEqual "j1 should be rejected (by fr1, it has priority)"
[]
(jobFiltering (Queue [j1] [] []) (chain [fr1, fr2]) [j1])
assertEqual "j1 should be accepted (by fr2, it has priority)"
[j1]
(jobFiltering (Queue [j1] [] []) (chain [fr2, fr1]) [j1])
assertEqual "j1 should be paused (by fr3)"
[]
(jobFiltering (Queue [j1] [] []) (chain [fr3]) [j1])
assertEqual "j2 should be rejected (over watermark1)"
[j1]
(jobFiltering (Queue [j1, j2] [] []) (chain [fr4]) [j1, j2])
assertEqual "all jobs should be rejected (since no predicates)"
[]
(jobFiltering (Queue [j1, j2] [] []) (chain [fr5]) [j1, j2])
assertEqual "j3 should be rate-limited"
[j1, j2]
(jobFiltering (Queue [j1, j2, j3] [] []) (chain [fr6, fr7]) [j1, j2, j3])
assertEqual "j4 should be rate-limited"
-- j1 doesn't apply to fr8/fr9 (since they match only watermark > jid1)
-- so j1 gets scheduled
[j1, j2, j3]
(jobFiltering (Queue [j1, j2, j3, j4] [] []) (chain [fr8, fr9])
[j1, j2, j3, j4])
-- | Tests the specified properties of `jobFiltering`, as defined in
-- `doc/design-optables.rst`.
prop_jobFiltering :: Property
prop_jobFiltering =
forAllShrink arbitrary shrink $ \q ->
forAllShrink (resize 4 arbitrary) shrink $ \(NonEmpty filterList) ->
let running = qRunning q ++ qManipulated q
enqueued = qEnqueued q
filters = Set.fromList filterList
toRun = jobFiltering q filters enqueued -- do the filtering
-- Helpers
-- Whether `fr` applies to more than `n` of the `jobs`
-- (that is, more than allowed).
exceeds :: Int -> FilterRule -> [JobWithStat] -> Bool
exceeds n fr jobs =
n < (length
. filter ((frUuid fr ==) . frUuid)
. mapMaybe (applyingFilter filters)
$ map jJob jobs)
-- Helpers for ensuring sensible coverage.
-- Makes sure that each action appears with some probability.
actionName = head . words . show
allActions = map actionName [ Accept, Continue, Pause, Reject
, RateLimit 0 ]
applyingActions = map (actionName . frAction)
. mapMaybe (applyingFilter filters)
$ map jJob enqueued
perc = 4 -- percent; low because it's per action
actionCovers =
foldr (.) id
[ stableCover (a `elem` applyingActions) perc ("is " ++ a)
| a <- allActions ]
-- `covers` should be after `==>` and before `conjoin` (see QuickCheck
-- bugs 25 and 27).
in (enqueued /= []) ==> actionCovers $ conjoin
[ printTestCase "scheduled jobs must be subsequence" $
toRun `isSubsequenceOf` enqueued
, printTestCase "a reason for each job (not) being scheduled" .
-- All enqueued jobs must have a reason why they were (not)
-- scheduled, determined by the filter that applies.
flip all enqueued $ \job ->
case applyingFilter filters (jJob job) of
-- If no filter matches, the job must run.
Nothing -> job `elem` toRun
Just fr@FilterRule{ frAction } -> case frAction of
-- ACCEPT filter permit the job immediately,
-- PAUSE/REJECT forbid running, CONTINUE filters cannot
-- be the output of `applyingFilter`, and
-- RATE_LIMIT filters have a more more complex property.
Accept -> job `elem` toRun
Continue -> error "must not happen"
Pause -> job `notElem` toRun
Reject -> job `notElem` toRun
RateLimit n ->
let -- Jobs in queue before our job.
jobsBefore = takeWhile (/= job) enqueued
in if job `elem` toRun
-- If it got scheduled, the job and any job
-- before it doesn't overfill the rate limit.
then not . exceeds n fr $ running
++ jobsBefore ++ [job]
-- If didn't get scheduled, then the rate limit
-- was already full before scheduling or the job
-- or one of the jobs before made it full.
else any (exceeds n fr . (running ++))
(inits $ jobsBefore ++ [job])
-- The `inits` bit includes the [] and [...job]
-- cases.
]
testSuite "JQScheduler"
[ 'case_parseReasonRateLimit
, 'prop_slotMapFromJob_conflicting_buckets
, 'case_reasonRateLimit
, 'prop_reasonRateLimit
, 'prop_filterRuleOrder
, 'case_matchPredicate
, 'prop_applyingFilter
, 'case_jobFiltering
, 'prop_jobFiltering
]
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment