1 {-# LANGUAGE TemplateHaskell #-}
2 {-# OPTIONS_GHC -fno-warn-orphans #-}
4 {-| Unittests for ganeti-htools.
10 Copyright (C) 2009, 2010, 2011, 2012 Google Inc.
12 This program is free software; you can redistribute it and/or modify
13 it under the terms of the GNU General Public License as published by
14 the Free Software Foundation; either version 2 of the License, or
15 (at your option) any later version.
17 This program is distributed in the hope that it will be useful, but
18 WITHOUT ANY WARRANTY; without even the implied warranty of
19 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
20 General Public License for more details.
22 You should have received a copy of the GNU General Public License
23 along with this program; if not, write to the Free Software
24 Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
29 module Test.Ganeti.Luxi (testLuxi) where
31 import Test.QuickCheck
32 import Test.QuickCheck.Monadic (monadicIO, run, stop)
34 import Control.Applicative
35 import Control.Concurrent (forkIO)
36 import Control.Exception (bracket)
37 import System.Directory (getTemporaryDirectory, removeFile)
38 import System.IO (hClose, openTempFile)
39 import qualified Text.JSON as J
41 import Test.Ganeti.TestHelper
42 import Test.Ganeti.TestCommon
43 import Test.Ganeti.Query.Language (genFilter)
44 import Test.Ganeti.OpCodes ()
46 import Ganeti.BasicTypes
47 import qualified Ganeti.Luxi as Luxi
51 instance Arbitrary Luxi.TagObject where
52 arbitrary = elements [minBound..maxBound]
54 instance Arbitrary Luxi.LuxiReq where
55 arbitrary = elements [minBound..maxBound]
57 instance Arbitrary Luxi.LuxiOp where
61 Luxi.ReqQuery -> Luxi.Query <$> arbitrary <*> getFields <*> genFilter
62 Luxi.ReqQueryFields -> Luxi.QueryFields <$> arbitrary <*> getFields
63 Luxi.ReqQueryNodes -> Luxi.QueryNodes <$> (listOf getFQDN) <*>
64 getFields <*> arbitrary
65 Luxi.ReqQueryGroups -> Luxi.QueryGroups <$> arbitrary <*>
66 arbitrary <*> arbitrary
67 Luxi.ReqQueryInstances -> Luxi.QueryInstances <$> (listOf getFQDN) <*>
68 getFields <*> arbitrary
69 Luxi.ReqQueryJobs -> Luxi.QueryJobs <$> arbitrary <*> getFields
70 Luxi.ReqQueryExports -> Luxi.QueryExports <$>
71 (listOf getFQDN) <*> arbitrary
72 Luxi.ReqQueryConfigValues -> Luxi.QueryConfigValues <$> getFields
73 Luxi.ReqQueryClusterInfo -> pure Luxi.QueryClusterInfo
74 Luxi.ReqQueryTags -> Luxi.QueryTags <$> arbitrary <*> getFQDN
75 Luxi.ReqSubmitJob -> Luxi.SubmitJob <$> (resize maxOpCodes arbitrary)
76 Luxi.ReqSubmitManyJobs -> Luxi.SubmitManyJobs <$>
77 (resize maxOpCodes arbitrary)
78 Luxi.ReqWaitForJobChange -> Luxi.WaitForJobChange <$> arbitrary <*>
79 getFields <*> pure J.JSNull <*>
80 pure J.JSNull <*> arbitrary
81 Luxi.ReqArchiveJob -> Luxi.ArchiveJob <$> arbitrary
82 Luxi.ReqAutoArchiveJobs -> Luxi.AutoArchiveJobs <$> arbitrary <*>
84 Luxi.ReqCancelJob -> Luxi.CancelJob <$> arbitrary
85 Luxi.ReqSetDrainFlag -> Luxi.SetDrainFlag <$> arbitrary
86 Luxi.ReqSetWatcherPause -> Luxi.SetWatcherPause <$> arbitrary
88 -- | Simple check that encoding/decoding of LuxiOp works.
89 prop_Luxi_CallEncoding :: Luxi.LuxiOp -> Property
90 prop_Luxi_CallEncoding op =
91 (Luxi.validateCall (Luxi.buildCall op) >>= Luxi.decodeCall) ==? Ok op
93 -- | Helper to a get a temporary file name.
94 getTempFileName :: IO FilePath
96 tempdir <- getTemporaryDirectory
97 (fpath, handle) <- openTempFile tempdir "luxitest"
102 -- | Server ping-pong helper.
103 luxiServerPong :: Luxi.Client -> IO ()
104 luxiServerPong c = do
105 msg <- Luxi.recvMsgExt c
107 Luxi.RecvOk m -> Luxi.sendMsg c m >> luxiServerPong c
110 -- | Client ping-pong helper.
111 luxiClientPong :: Luxi.Client -> [String] -> IO [String]
113 mapM (\m -> Luxi.sendMsg c m >> Luxi.recvMsg c)
115 -- | Monadic check that, given a server socket, we can connect via a
116 -- client to it, and that we can send a list of arbitrary messages and
117 -- get back what we sent.
118 prop_Luxi_ClientServer :: [[DNSChar]] -> Property
119 prop_Luxi_ClientServer dnschars = monadicIO $ do
120 let msgs = map (map dnsGetChar) dnschars
121 fpath <- run $ getTempFileName
122 -- we need to create the server first, otherwise (if we do it in the
123 -- forked thread) the client could try to connect to it before it's
125 server <- run $ Luxi.getServer fpath
126 -- fork the server responder
129 (Luxi.acceptClient server)
130 (\c -> Luxi.closeClient c >> Luxi.closeServer fpath server)
134 (Luxi.getClient fpath)
136 (\c -> luxiClientPong c msgs)
137 stop $ replies ==? msgs
140 [ 'prop_Luxi_CallEncoding
141 , 'prop_Luxi_ClientServer