Commit 2733df51 authored by Iustin Pop's avatar Iustin Pop

Split one more module out of QC and add test helpers

This splits the confd/utils tests, and adds the TestCommon module for
shared test code.
Signed-off-by: default avatarIustin Pop <iustin@google.com>
Reviewed-by: default avatarRené Nussbaumer <rn@google.com>
parent e5a29b6c
......@@ -62,7 +62,8 @@ HTOOLS_DIRS = \
htools/Ganeti/Query \
htest \
htest/Test \
htest/Test/Ganeti
htest/Test/Ganeti \
htest/Test/Ganeti/Confd
DIRS = \
autotools \
......@@ -377,6 +378,7 @@ HPCEXCL = --exclude Main \
--exclude Ganeti.HTools.QC \
--exclude Ganeti.HTools.Version \
--exclude Test.Ganeti.TestHelper \
--exclude Test.Ganeti.TestCommon \
$(patsubst htools.%,--exclude Test.%,$(subst /,.,$(patsubst %.hs,%, $(filter-out htest/%,$(HS_LIB_SRCS)))))
HS_LIB_SRCS = \
......@@ -430,7 +432,9 @@ HS_LIB_SRCS = \
htools/Ganeti/Ssconf.hs \
htools/Ganeti/THH.hs \
htest/Test/Ganeti/TestHelper.hs \
htest/Test/Ganeti/Objects.hs
htest/Test/Ganeti/TestCommon.hs \
htest/Test/Ganeti/Objects.hs \
htest/Test/Ganeti/Confd/Utils.hs
HS_BUILT_SRCS = htools/Ganeti/HTools/Version.hs htools/Ganeti/Constants.hs
......
{-# LANGUAGE TemplateHaskell #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
{-| Unittests for ganeti-htools.
-}
{-
Copyright (C) 2009, 2010, 2011, 2012 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.Confd.Utils (testConfdUtils) where
import Control.Applicative
import Test.QuickCheck
import qualified Text.JSON as J
import Test.Ganeti.TestHelper
import Test.Ganeti.TestCommon
import qualified Ganeti.BasicTypes as BasicTypes
import qualified Ganeti.Confd as Confd
import qualified Ganeti.Confd.Utils as Confd.Utils
import qualified Ganeti.Constants as C
import qualified Ganeti.Hash as Hash
instance Arbitrary Confd.ConfdRequestType where
arbitrary = elements [minBound..maxBound]
instance Arbitrary Confd.ConfdReqField where
arbitrary = elements [minBound..maxBound]
instance Arbitrary Confd.ConfdReqQ where
arbitrary = Confd.ConfdReqQ <$> arbitrary <*> arbitrary <*>
arbitrary <*> arbitrary
instance Arbitrary Confd.ConfdQuery where
arbitrary = oneof [ pure Confd.EmptyQuery
, Confd.PlainQuery <$> getName
, Confd.DictQuery <$> arbitrary
]
instance Arbitrary Confd.ConfdRequest where
arbitrary = Confd.ConfdRequest <$> arbitrary <*> arbitrary <*> arbitrary
<*> arbitrary
-- | Test that signing messages and checking signatures is correct. It
-- also tests, indirectly the serialisation of messages so we don't
-- need a separate test for that.
prop_ConfdUtils_req_sign :: Hash.HashKey -- ^ The hash key
-> NonNegative Integer -- ^ The base timestamp
-> Positive Integer -- ^ Delta for out of window
-> Bool -- ^ Whether delta should be + or -
-> Confd.ConfdRequest
-> Property
prop_ConfdUtils_req_sign key (NonNegative timestamp) (Positive bad_delta)
pm crq =
forAll (choose (0, fromIntegral C.confdMaxClockSkew)) $ \ good_delta ->
let encoded = J.encode crq
salt = show timestamp
signed = J.encode $ Confd.Utils.signMessage key salt encoded
good_timestamp = timestamp + if pm then good_delta else (-good_delta)
bad_delta' = fromIntegral C.confdMaxClockSkew + bad_delta
bad_timestamp = timestamp + if pm then bad_delta' else (-bad_delta')
ts_ok = Confd.Utils.parseMessage key signed good_timestamp
ts_bad = Confd.Utils.parseMessage key signed bad_timestamp
in printTestCase "Failed to parse good message"
(ts_ok ==? BasicTypes.Ok (encoded, crq)) .&&.
printTestCase ("Managed to deserialise message with bad\
\ timestamp, got " ++ show ts_bad)
(ts_bad ==? BasicTypes.Bad "Too old/too new timestamp or clock skew")
-- | Tests that signing with a different key fails detects failure
-- correctly.
prop_ConfdUtils_bad_key :: String -- ^ Salt
-> Confd.ConfdRequest -- ^ Request
-> Property
prop_ConfdUtils_bad_key salt crq =
-- fixme: we hardcode here the expected length of a sha1 key, as
-- otherwise we could have two short keys that differ only in the
-- final zero elements count, and those will be expanded to be the
-- same
forAll (vector 20) $ \key_sign ->
forAll (vector 20 `suchThat` (/= key_sign)) $ \key_verify ->
let signed = Confd.Utils.signMessage key_sign salt (J.encode crq)
encoded = J.encode signed
in printTestCase ("Accepted message signed with different key" ++ encoded) $
BasicTypes.Bad "HMAC verification failed" ==?
Confd.Utils.parseRequest key_verify encoded
testSuite "ConfdUtils"
[ 'prop_ConfdUtils_req_sign
, 'prop_ConfdUtils_bad_key
]
{-| Unittest helpers for ganeti-htools.
-}
{-
Copyright (C) 2009, 2010, 2011, 2012 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.TestCommon where
import Control.Applicative
import Data.List
import Test.QuickCheck
-- * Constants
-- | Maximum memory (1TiB, somewhat random value).
maxMem :: Int
maxMem = 1024 * 1024
-- | Maximum disk (8TiB, somewhat random value).
maxDsk :: Int
maxDsk = 1024 * 1024 * 8
-- | Max CPUs (1024, somewhat random value).
maxCpu :: Int
maxCpu = 1024
-- | Max vcpu ratio (random value).
maxVcpuRatio :: Double
maxVcpuRatio = 1024.0
-- | Max spindle ratio (random value).
maxSpindleRatio :: Double
maxSpindleRatio = 1024.0
-- | Max nodes, used just to limit arbitrary instances for smaller
-- opcode definitions (e.g. list of nodes in OpTestDelay).
maxNodes :: Int
maxNodes = 32
-- | Max opcodes or jobs in a submit job and submit many jobs.
maxOpCodes :: Int
maxOpCodes = 16
-- * Helper functions
-- | Checks for equality with proper annotation.
(==?) :: (Show a, Eq a) => a -> a -> Property
(==?) x y = printTestCase
("Expected equality, but '" ++
show x ++ "' /= '" ++ show y ++ "'") (x == y)
infix 3 ==?
-- | Show a message and fail the test.
failTest :: String -> Property
failTest msg = printTestCase msg False
-- * Arbitrary instances
-- | Defines a DNS name.
newtype DNSChar = DNSChar { dnsGetChar::Char }
instance Arbitrary DNSChar where
arbitrary = do
x <- elements (['a'..'z'] ++ ['0'..'9'] ++ "_-")
return (DNSChar x)
instance Show DNSChar where
show = show . dnsGetChar
-- | Generates a single name component.
getName :: Gen String
getName = do
n <- choose (1, 64)
dn <- vector n
return (map dnsGetChar dn)
-- | Generates an entire FQDN.
getFQDN :: Gen String
getFQDN = do
ncomps <- choose (1, 4)
names <- vectorOf ncomps getName
return $ intercalate "." names
-- | Combinator that generates a 'Maybe' using a sub-combinator.
getMaybe :: Gen a -> Gen (Maybe a)
getMaybe subgen = do
bool <- arbitrary
if bool
then Just <$> subgen
else return Nothing
......@@ -30,6 +30,7 @@ import Test.Framework
import System.Environment (getArgs)
import Ganeti.HTools.QC
import Test.Ganeti.Confd.Utils
import Test.Ganeti.Objects
-- | Our default test options, overring the built-in test-framework
......@@ -71,7 +72,7 @@ allTests =
, (True, testSsconf)
, (True, testQlang)
, (True, testRpc)
, (True, testConfd)
, (True, testConfdUtils)
, (True, testObjects)
, (False, testCluster)
]
......
......@@ -118,37 +118,7 @@ import qualified Ganeti.HTools.Program.Hscan
import qualified Ganeti.HTools.Program.Hspace
import Test.Ganeti.TestHelper (testSuite)
-- * Constants
-- | Maximum memory (1TiB, somewhat random value).
maxMem :: Int
maxMem = 1024 * 1024
-- | Maximum disk (8TiB, somewhat random value).
maxDsk :: Int
maxDsk = 1024 * 1024 * 8
-- | Max CPUs (1024, somewhat random value).
maxCpu :: Int
maxCpu = 1024
-- | Max vcpu ratio (random value).
maxVcpuRatio :: Double
maxVcpuRatio = 1024.0
-- | Max spindle ratio (random value).
maxSpindleRatio :: Double
maxSpindleRatio = 1024.0
-- | Max nodes, used just to limit arbitrary instances for smaller
-- opcode definitions (e.g. list of nodes in OpTestDelay).
maxNodes :: Int
maxNodes = 32
-- | Max opcodes or jobs in a submit job and submit many jobs.
maxOpCodes :: Int
maxOpCodes = 16
import Test.Ganeti.TestCommon
-- | All disk templates (used later)
allDiskTemplates :: [Types.DiskTemplate]
......@@ -203,17 +173,6 @@ isFailure :: Types.OpResult a -> Bool
isFailure (Types.OpFail _) = True
isFailure _ = False
-- | Checks for equality with proper annotation.
(==?) :: (Show a, Eq a) => a -> a -> Property
(==?) x y = printTestCase
("Expected equality, but '" ++
show x ++ "' /= '" ++ show y ++ "'") (x == y)
infix 3 ==?
-- | Show a message and fail the test.
failTest :: String -> Property
failTest msg = printTestCase msg False
-- | Return the python binary to use. If the PYTHON environment
-- variable is defined, use its value, otherwise use just \"python\".
pythonCmd :: IO String
......@@ -315,41 +274,6 @@ evacModeOptions Types.MirrorNone = []
evacModeOptions Types.MirrorInternal = [minBound..maxBound] -- DRBD can do all
evacModeOptions Types.MirrorExternal = [Types.ChangePrimary, Types.ChangeAll]
-- * Arbitrary instances
-- | Defines a DNS name.
newtype DNSChar = DNSChar { dnsGetChar::Char }
instance Arbitrary DNSChar where
arbitrary = do
x <- elements (['a'..'z'] ++ ['0'..'9'] ++ "_-")
return (DNSChar x)
instance Show DNSChar where
show = show . dnsGetChar
-- | Generates a single name component.
getName :: Gen String
getName = do
n <- choose (1, 64)
dn <- vector n
return (map dnsGetChar dn)
-- | Generates an entire FQDN.
getFQDN :: Gen String
getFQDN = do
ncomps <- choose (1, 4)
names <- vectorOf ncomps getName
return $ intercalate "." names
-- | Combinator that generates a 'Maybe' using a sub-combinator.
getMaybe :: Gen a -> Gen (Maybe a)
getMaybe subgen = do
bool <- arbitrary
if bool
then Just <$> subgen
else return Nothing
-- | Generates a fields list. This uses the same character set as a
-- DNS name (just for simplicity).
getFields :: Gen [String]
......@@ -2101,74 +2025,3 @@ testSuite "Qlang"
[ 'prop_Qlang_Serialisation
, 'prop_Qlang_FilterRegex_instances
]
-- * Confd tests (generic library)
instance Arbitrary Confd.ConfdRequestType where
arbitrary = elements [minBound..maxBound]
instance Arbitrary Confd.ConfdReqField where
arbitrary = elements [minBound..maxBound]
instance Arbitrary Confd.ConfdReqQ where
arbitrary = Confd.ConfdReqQ <$> arbitrary <*> arbitrary <*>
arbitrary <*> arbitrary
instance Arbitrary Confd.ConfdQuery where
arbitrary = oneof [ pure Confd.EmptyQuery
, Confd.PlainQuery <$> getName
, Confd.DictQuery <$> arbitrary
]
instance Arbitrary Confd.ConfdRequest where
arbitrary = Confd.ConfdRequest <$> arbitrary <*> arbitrary <*> arbitrary
<*> arbitrary
-- | Test that signing messages and checking signatures is correct. It
-- also tests, indirectly the serialisation of messages so we don't
-- need a separate test for that.
prop_Confd_req_sign :: Hash.HashKey -- ^ The hash key
-> NonNegative Integer -- ^ The base timestamp
-> Positive Integer -- ^ Delta for out of window
-> Bool -- ^ Whether delta should be + or -
-> Confd.ConfdRequest
-> Property
prop_Confd_req_sign key (NonNegative timestamp) (Positive bad_delta) pm crq =
forAll (choose (0, fromIntegral C.confdMaxClockSkew)) $ \ good_delta ->
let encoded = J.encode crq
salt = show timestamp
signed = J.encode $ Confd.Utils.signMessage key salt encoded
good_timestamp = timestamp + if pm then good_delta else (-good_delta)
bad_delta' = fromIntegral C.confdMaxClockSkew + bad_delta
bad_timestamp = timestamp + if pm then bad_delta' else (-bad_delta')
ts_ok = Confd.Utils.parseMessage key signed good_timestamp
ts_bad = Confd.Utils.parseMessage key signed bad_timestamp
in printTestCase "Failed to parse good message"
(ts_ok ==? Types.Ok (encoded, crq)) .&&.
printTestCase ("Managed to deserialise message with bad\
\ timestamp, got " ++ show ts_bad)
(ts_bad ==? Types.Bad "Too old/too new timestamp or clock skew")
-- | Tests that signing with a different key fails detects failure
-- correctly.
prop_Confd_bad_key :: String -- ^ Salt
-> Confd.ConfdRequest -- ^ Request
-> Property
prop_Confd_bad_key salt crq =
-- fixme: we hardcode here the expected length of a sha1 key, as
-- otherwise we could have two short keys that differ only in the
-- final zero elements count, and those will be expanded to be the
-- same
forAll (vector 20) $ \key_sign ->
forAll (vector 20 `suchThat` (/= key_sign)) $ \key_verify ->
let signed = Confd.Utils.signMessage key_sign salt (J.encode crq)
encoded = J.encode signed
in printTestCase ("Accepted message signed with different key" ++ encoded) $
Types.Bad "HMAC verification failed" ==?
Confd.Utils.parseRequest key_verify encoded
testSuite "Confd"
[ 'prop_Confd_req_sign
, 'prop_Confd_bad_key
]
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