Synnefo » snf-ganeti » ganeti-local

	htest/Test/Ganeti/Confd \

	htest/Test/Ganeti/Query

	htest/Test/Ganeti/Luxi.hs \

	htest/Test/Ganeti/OpCodes.hs \

	htest/Test/Ganeti/Query/Language.hs \

	htest/Test/Ganeti/Rpc.hs \

	htest/Test/Ganeti/Ssconf.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.Luxi (testLuxi) where

import Test.QuickCheck

import Test.QuickCheck.Monadic (monadicIO, run, stop)

import Control.Applicative

import Control.Concurrent (forkIO)

import Control.Exception (bracket)

import System.Directory (getTemporaryDirectory, removeFile)

import System.IO (hClose, openTempFile)

import qualified Text.JSON as J

import Test.Ganeti.TestHelper

import Test.Ganeti.TestCommon

import Test.Ganeti.Query.Language (genFilter)

import Test.Ganeti.OpCodes ()

import Ganeti.BasicTypes

import qualified Ganeti.Luxi as Luxi

-- * Luxi tests

instance Arbitrary Luxi.TagObject where

  arbitrary = elements [minBound..maxBound]

instance Arbitrary Luxi.LuxiReq where

  arbitrary = elements [minBound..maxBound]

instance Arbitrary Luxi.LuxiOp where

  arbitrary = do

    lreq <- arbitrary

    case lreq of

      Luxi.ReqQuery -> Luxi.Query <$> arbitrary <*> getFields <*> genFilter

      Luxi.ReqQueryFields -> Luxi.QueryFields <$> arbitrary <*> getFields

      Luxi.ReqQueryNodes -> Luxi.QueryNodes <$> (listOf getFQDN) <*>

                            getFields <*> arbitrary

      Luxi.ReqQueryGroups -> Luxi.QueryGroups <$> arbitrary <*>

                             arbitrary <*> arbitrary

      Luxi.ReqQueryInstances -> Luxi.QueryInstances <$> (listOf getFQDN) <*>

                                getFields <*> arbitrary

      Luxi.ReqQueryJobs -> Luxi.QueryJobs <$> arbitrary <*> getFields

      Luxi.ReqQueryExports -> Luxi.QueryExports <$>

                              (listOf getFQDN) <*> arbitrary

      Luxi.ReqQueryConfigValues -> Luxi.QueryConfigValues <$> getFields

      Luxi.ReqQueryClusterInfo -> pure Luxi.QueryClusterInfo

      Luxi.ReqQueryTags -> Luxi.QueryTags <$> arbitrary <*> getFQDN

      Luxi.ReqSubmitJob -> Luxi.SubmitJob <$> (resize maxOpCodes arbitrary)

      Luxi.ReqSubmitManyJobs -> Luxi.SubmitManyJobs <$>

                                (resize maxOpCodes arbitrary)

      Luxi.ReqWaitForJobChange -> Luxi.WaitForJobChange <$> arbitrary <*>

                                  getFields <*> pure J.JSNull <*>

                                  pure J.JSNull <*> arbitrary

      Luxi.ReqArchiveJob -> Luxi.ArchiveJob <$> arbitrary

      Luxi.ReqAutoArchiveJobs -> Luxi.AutoArchiveJobs <$> arbitrary <*>

                                 arbitrary

      Luxi.ReqCancelJob -> Luxi.CancelJob <$> arbitrary

      Luxi.ReqSetDrainFlag -> Luxi.SetDrainFlag <$> arbitrary

      Luxi.ReqSetWatcherPause -> Luxi.SetWatcherPause <$> arbitrary

-- | Simple check that encoding/decoding of LuxiOp works.

prop_Luxi_CallEncoding :: Luxi.LuxiOp -> Property

prop_Luxi_CallEncoding op =

  (Luxi.validateCall (Luxi.buildCall op) >>= Luxi.decodeCall) ==? Ok op

-- | Helper to a get a temporary file name.

getTempFileName :: IO FilePath

getTempFileName = do

  tempdir <- getTemporaryDirectory

  (fpath, handle) <- openTempFile tempdir "luxitest"

  _ <- hClose handle

  removeFile fpath

  return fpath

-- | Server ping-pong helper.

luxiServerPong :: Luxi.Client -> IO ()

luxiServerPong c = do

  msg <- Luxi.recvMsgExt c

  case msg of

    Luxi.RecvOk m -> Luxi.sendMsg c m >> luxiServerPong c

    _ -> return ()

-- | Client ping-pong helper.

luxiClientPong :: Luxi.Client -> [String] -> IO [String]

luxiClientPong c =

  mapM (\m -> Luxi.sendMsg c m >> Luxi.recvMsg c)

-- | Monadic check that, given a server socket, we can connect via a

-- client to it, and that we can send a list of arbitrary messages and

-- get back what we sent.

prop_Luxi_ClientServer :: [[DNSChar]] -> Property

prop_Luxi_ClientServer dnschars = monadicIO $ do

  let msgs = map (map dnsGetChar) dnschars

  fpath <- run $ getTempFileName

  -- we need to create the server first, otherwise (if we do it in the

  -- forked thread) the client could try to connect to it before it's

  -- ready

  server <- run $ Luxi.getServer fpath

  -- fork the server responder

  _ <- run . forkIO $

    bracket

      (Luxi.acceptClient server)

      (\c -> Luxi.closeClient c >> Luxi.closeServer fpath server)

      luxiServerPong

  replies <- run $

    bracket

      (Luxi.getClient fpath)

      Luxi.closeClient

      (\c -> luxiClientPong c msgs)

  stop $ replies ==? msgs

testSuite "Luxi"

          [ 'prop_Luxi_CallEncoding

          , 'prop_Luxi_ClientServer

          ]

{-# 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.OpCodes

  ( testOpCodes

  , OpCodes.OpCode(..)

  ) where

import qualified Test.HUnit as HUnit

import Test.QuickCheck

import Control.Applicative

import Data.List

import qualified Text.JSON as J

import Test.Ganeti.TestHelper

import Test.Ganeti.TestCommon

import qualified Ganeti.Constants as C

import qualified Ganeti.OpCodes as OpCodes

-- * Arbitrary instances

instance Arbitrary OpCodes.ReplaceDisksMode where

  arbitrary = elements [minBound..maxBound]

instance Arbitrary OpCodes.DiskIndex where

  arbitrary = choose (0, C.maxDisks - 1) >>= OpCodes.mkDiskIndex

instance Arbitrary OpCodes.OpCode where

  arbitrary = do

    op_id <- elements OpCodes.allOpIDs

    case op_id of

      "OP_TEST_DELAY" ->

        OpCodes.OpTestDelay <$> arbitrary <*> arbitrary

                 <*> resize maxNodes (listOf getFQDN)

      "OP_INSTANCE_REPLACE_DISKS" ->

        OpCodes.OpInstanceReplaceDisks <$> getFQDN <*> getMaybe getFQDN <*>

          arbitrary <*> resize C.maxDisks arbitrary <*> getMaybe getName

      "OP_INSTANCE_FAILOVER" ->

        OpCodes.OpInstanceFailover <$> getFQDN <*> arbitrary <*>

          getMaybe getFQDN

      "OP_INSTANCE_MIGRATE" ->

        OpCodes.OpInstanceMigrate <$> getFQDN <*> arbitrary <*>

          arbitrary <*> arbitrary <*> getMaybe getFQDN

      _ -> fail "Wrong opcode"

-- * Test cases

-- | Check that opcode serialization is idempotent.

prop_OpCodes_serialization :: OpCodes.OpCode -> Property

prop_OpCodes_serialization op =

  case J.readJSON (J.showJSON op) of

    J.Error e -> failTest $ "Cannot deserialise: " ++ e

    J.Ok op' -> op ==? op'

-- | Check that Python and Haskell defined the same opcode list.

case_OpCodes_AllDefined :: HUnit.Assertion

case_OpCodes_AllDefined = do

  py_stdout <- runPython "from ganeti import opcodes\n\

                         \print '\\n'.join(opcodes.OP_MAPPING.keys())" "" >>=

               checkPythonResult

  let py_ops = sort $ lines py_stdout

      hs_ops = OpCodes.allOpIDs

      -- extra_py = py_ops \\ hs_ops

      extra_hs = hs_ops \\ py_ops

  -- FIXME: uncomment when we have parity

  -- HUnit.assertBool ("OpCodes missing from Haskell code:\n" ++

  --                  unlines extra_py) (null extra_py)

  HUnit.assertBool ("Extra OpCodes in the Haskell code code:\n" ++

                    unlines extra_hs) (null extra_hs)

-- | Custom HUnit test case that forks a Python process and checks

-- correspondence between Haskell-generated OpCodes and their Python

-- decoded, validated and re-encoded version.

--

-- Note that we have a strange beast here: since launching Python is

-- expensive, we don't do this via a usual QuickProperty, since that's

-- slow (I've tested it, and it's indeed quite slow). Rather, we use a

-- single HUnit assertion, and in it we manually use QuickCheck to

-- generate 500 opcodes times the number of defined opcodes, which

-- then we pass in bulk to Python. The drawbacks to this method are

-- two fold: we cannot control the number of generated opcodes, since

-- HUnit assertions don't get access to the test options, and for the

-- same reason we can't run a repeatable seed. We should probably find

-- a better way to do this, for example by having a

-- separately-launched Python process (if not running the tests would

-- be skipped).

case_OpCodes_py_compat :: HUnit.Assertion

case_OpCodes_py_compat = do

  let num_opcodes = length OpCodes.allOpIDs * 500

  sample_opcodes <- sample' (vectorOf num_opcodes

                             (arbitrary::Gen OpCodes.OpCode))

  let opcodes = head sample_opcodes

      serialized = J.encode opcodes

  py_stdout <-

     runPython "from ganeti import opcodes\n\

               \import sys\n\

               \from ganeti import serializer\n\

               \op_data = serializer.Load(sys.stdin.read())\n\

               \decoded = [opcodes.OpCode.LoadOpCode(o) for o in op_data]\n\

               \for op in decoded:\n\

               \  op.Validate(True)\n\

               \encoded = [op.__getstate__() for op in decoded]\n\

               \print serializer.Dump(encoded)" serialized

     >>= checkPythonResult

  let deserialised = (J.decode py_stdout::J.Result [OpCodes.OpCode])

  decoded <- case deserialised of

               J.Ok ops -> return ops

               J.Error msg ->

                 HUnit.assertFailure ("Unable to decode opcodes: " ++ msg)

                 -- this already raised an expection, but we need it

                 -- for proper types

                 >> fail "Unable to decode opcodes"

  HUnit.assertEqual "Mismatch in number of returned opcodes"

    (length opcodes) (length decoded)

  mapM_ (uncurry (HUnit.assertEqual "Different result after encoding/decoding")

        ) $ zip opcodes decoded

testSuite "OpCodes"

            [ 'prop_OpCodes_serialization

            , 'case_OpCodes_AllDefined

            , 'case_OpCodes_py_compat

            ]

{-# 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.Query.Language

  ( testQlang

  , genFilter

  ) where

import Test.QuickCheck

import Control.Applicative

import qualified Text.JSON as J

import Test.Ganeti.TestHelper

import Test.Ganeti.TestCommon

import qualified Ganeti.Query.Language as Qlang

-- | Custom 'Qlang.Filter' generator (top-level), which enforces a

-- (sane) limit on the depth of the generated filters.

genFilter :: Gen (Qlang.Filter Qlang.FilterField)

genFilter = choose (0, 10) >>= genFilter'

-- | Custom generator for filters that correctly halves the state of

-- the generators at each recursive step, per the QuickCheck

-- documentation, in order not to run out of memory.

genFilter' :: Int -> Gen (Qlang.Filter Qlang.FilterField)

genFilter' 0 =

  oneof [ return Qlang.EmptyFilter

        , Qlang.TrueFilter     <$> getName

        , Qlang.EQFilter       <$> getName <*> value

        , Qlang.LTFilter       <$> getName <*> value

        , Qlang.GTFilter       <$> getName <*> value

        , Qlang.LEFilter       <$> getName <*> value

        , Qlang.GEFilter       <$> getName <*> value

        , Qlang.RegexpFilter   <$> getName <*> arbitrary

        , Qlang.ContainsFilter <$> getName <*> value

        ]

    where value = oneof [ Qlang.QuotedString <$> getName

                        , Qlang.NumericValue <$> arbitrary

                        ]

genFilter' n = do

  oneof [ Qlang.AndFilter  <$> vectorOf n'' (genFilter' n')

        , Qlang.OrFilter   <$> vectorOf n'' (genFilter' n')

        , Qlang.NotFilter  <$> genFilter' n'

        ]

  where n' = n `div` 2 -- sub-filter generator size

        n'' = max n' 2 -- but we don't want empty or 1-element lists,

                       -- so use this for and/or filter list length

instance Arbitrary Qlang.ItemType where

  arbitrary = elements [minBound..maxBound]

instance Arbitrary Qlang.FilterRegex where

  arbitrary = getName >>= Qlang.mkRegex -- a name should be a good regex

-- | Tests that serialisation/deserialisation of filters is

-- idempotent.

prop_Qlang_Serialisation :: Property

prop_Qlang_Serialisation =

  forAll genFilter $ \flt ->

  J.readJSON (J.showJSON flt) ==? J.Ok flt

prop_Qlang_FilterRegex_instances :: Qlang.FilterRegex -> Property

prop_Qlang_FilterRegex_instances rex =

  printTestCase "failed JSON encoding"

    (J.readJSON (J.showJSON rex) ==? J.Ok rex) .&&.

  printTestCase "failed read/show instances" (read (show rex) ==? rex)

testSuite "Qlang"

  [ 'prop_Qlang_Serialisation

  , 'prop_Qlang_FilterRegex_instances

  ]

{-# 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.Ssconf (testSsconf) where

import Test.QuickCheck

import Data.List

import Test.Ganeti.TestHelper

import qualified Ganeti.Ssconf as Ssconf

-- * Ssconf tests

instance Arbitrary Ssconf.SSKey where

  arbitrary = elements [minBound..maxBound]

prop_Ssconf_filename :: Ssconf.SSKey -> Property

prop_Ssconf_filename key =

  printTestCase "Key doesn't start with correct prefix" $

    Ssconf.sSFilePrefix `isPrefixOf` Ssconf.keyToFilename (Just "") key

testSuite "Ssconf"

  [ 'prop_Ssconf_filename

  ]

import Control.Exception (catchJust)

import Control.Monad

import qualified Test.HUnit as HUnit

import System.Environment (getEnv)

import System.Exit (ExitCode(..))

import System.IO.Error (isDoesNotExistError)

import System.Process (readProcessWithExitCode)

-- | Return the python binary to use. If the PYTHON environment

-- variable is defined, use its value, otherwise use just \"python\".

pythonCmd :: IO String

pythonCmd = catchJust (guard . isDoesNotExistError)

            (getEnv "PYTHON") (const (return "python"))

-- | Run Python with an expression, returning the exit code, standard

-- output and error.

runPython :: String -> String -> IO (ExitCode, String, String)

runPython expr stdin = do

  py_binary <- pythonCmd

  readProcessWithExitCode py_binary ["-c", expr] stdin

-- | Check python exit code, and fail via HUnit assertions if

-- non-zero. Otherwise, return the standard output.

checkPythonResult :: (ExitCode, String, String) -> IO String

checkPythonResult (py_code, py_stdout, py_stderr) = do

  HUnit.assertEqual ("python exited with error: " ++ py_stderr)

       ExitSuccess py_code

  return py_stdout

-- | Generates a fields list. This uses the same character set as a

-- DNS name (just for simplicity).

getFields :: Gen [String]

getFields = do

  n <- choose (1, 32)

  vectorOf n getName

import Test.Ganeti.Luxi

import Test.Ganeti.OpCodes

import Test.Ganeti.Query.Language

import Test.Ganeti.Ssconf