From 2733df514086a25ff2c603eb39e6fab82abb9785 Mon Sep 17 00:00:00 2001
From: Iustin Pop <iustin@google.com>
Date: Wed, 29 Aug 2012 17:49:14 +0200
Subject: [PATCH] Split one more module out of QC and add test helpers
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit
This splits the confd/utils tests, and adds the TestCommon module for
shared test code.
Signed-off-by: Iustin Pop <iustin@google.com>
Reviewed-by: RenΓ© Nussbaumer <rn@google.com>
---
Makefile.am | 8 +-
htest/Test/Ganeti/Confd/Utils.hs | 111 +++++++++++++++++++++++
htest/Test/Ganeti/TestCommon.hs | 110 +++++++++++++++++++++++
htest/test.hs | 3 +-
htools/Ganeti/HTools/QC.hs | 149 +------------------------------
5 files changed, 230 insertions(+), 151 deletions(-)
create mode 100644 htest/Test/Ganeti/Confd/Utils.hs
create mode 100644 htest/Test/Ganeti/TestCommon.hs
diff --git a/Makefile.am b/Makefile.am
index 76d91733e..dabec8241 100644
--- a/Makefile.am
+++ b/Makefile.am
@@ -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
diff --git a/htest/Test/Ganeti/Confd/Utils.hs b/htest/Test/Ganeti/Confd/Utils.hs
new file mode 100644
index 000000000..bc6fa8388
--- /dev/null
+++ b/htest/Test/Ganeti/Confd/Utils.hs
@@ -0,0 +1,111 @@
+{-# 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
+ ]
diff --git a/htest/Test/Ganeti/TestCommon.hs b/htest/Test/Ganeti/TestCommon.hs
new file mode 100644
index 000000000..5ac3f638c
--- /dev/null
+++ b/htest/Test/Ganeti/TestCommon.hs
@@ -0,0 +1,110 @@
+{-| 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
diff --git a/htest/test.hs b/htest/test.hs
index d4fefcd7c..2cb65f4d0 100644
--- a/htest/test.hs
+++ b/htest/test.hs
@@ -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)
]
diff --git a/htools/Ganeti/HTools/QC.hs b/htools/Ganeti/HTools/QC.hs
index 07501420a..60cc24e10 100644
--- a/htools/Ganeti/HTools/QC.hs
+++ b/htools/Ganeti/HTools/QC.hs
@@ -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
- ]
--
GitLab