Statistics
| Branch: | Tag: | Revision:

root / test / hs / Test / Ganeti / Luxi.hs @ d605e261

History | View | Annotate | Download (6 kB)

1
{-# LANGUAGE TemplateHaskell #-}
2
{-# OPTIONS_GHC -fno-warn-orphans #-}
3

    
4
{-| Unittests for ganeti-htools.
5

    
6
-}
7

    
8
{-
9

    
10
Copyright (C) 2009, 2010, 2011, 2012 Google Inc.
11

    
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.
16

    
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.
21

    
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
25
02110-1301, USA.
26

    
27
-}
28

    
29
module Test.Ganeti.Luxi (testLuxi) where
30

    
31
import Test.HUnit
32
import Test.QuickCheck
33
import Test.QuickCheck.Monadic (monadicIO, run, stop)
34

    
35
import Data.List
36
import Control.Applicative
37
import Control.Concurrent (forkIO)
38
import Control.Exception (bracket)
39
import System.Directory (getTemporaryDirectory, removeFile)
40
import System.IO (hClose, openTempFile)
41
import qualified Text.JSON as J
42

    
43
import Test.Ganeti.TestHelper
44
import Test.Ganeti.TestCommon
45
import Test.Ganeti.Query.Language (genFilter)
46
import Test.Ganeti.OpCodes ()
47

    
48
import Ganeti.BasicTypes
49
import qualified Ganeti.Luxi as Luxi
50

    
51
{-# ANN module "HLint: ignore Use camelCase" #-}
52

    
53
-- * Luxi tests
54

    
55
$(genArbitrary ''Luxi.LuxiReq)
56

    
57
instance Arbitrary Luxi.LuxiOp where
58
  arbitrary = do
59
    lreq <- arbitrary
60
    case lreq of
61
      Luxi.ReqQuery -> Luxi.Query <$> arbitrary <*> genFields <*> genFilter
62
      Luxi.ReqQueryFields -> Luxi.QueryFields <$> arbitrary <*> genFields
63
      Luxi.ReqQueryNodes -> Luxi.QueryNodes <$> listOf genFQDN <*>
64
                            genFields <*> arbitrary
65
      Luxi.ReqQueryGroups -> Luxi.QueryGroups <$> arbitrary <*>
66
                             arbitrary <*> arbitrary
67
      Luxi.ReqQueryNetworks -> Luxi.QueryNetworks <$> arbitrary <*>
68
                             arbitrary <*> arbitrary
69
      Luxi.ReqQueryInstances -> Luxi.QueryInstances <$> listOf genFQDN <*>
70
                                genFields <*> arbitrary
71
      Luxi.ReqQueryJobs -> Luxi.QueryJobs <$> arbitrary <*> genFields
72
      Luxi.ReqQueryExports -> Luxi.QueryExports <$>
73
                              listOf genFQDN <*> arbitrary
74
      Luxi.ReqQueryConfigValues -> Luxi.QueryConfigValues <$> genFields
75
      Luxi.ReqQueryClusterInfo -> pure Luxi.QueryClusterInfo
76
      Luxi.ReqQueryTags -> do
77
        kind <- arbitrary
78
        Luxi.QueryTags kind <$> genLuxiTagName kind
79
      Luxi.ReqSubmitJob -> Luxi.SubmitJob <$> resize maxOpCodes arbitrary
80
      Luxi.ReqSubmitJobToDrainedQueue -> Luxi.SubmitJobToDrainedQueue <$>
81
                                         resize maxOpCodes arbitrary
82
      Luxi.ReqSubmitManyJobs -> Luxi.SubmitManyJobs <$>
83
                                resize maxOpCodes arbitrary
84
      Luxi.ReqWaitForJobChange -> Luxi.WaitForJobChange <$> arbitrary <*>
85
                                  genFields <*> pure J.JSNull <*>
86
                                  pure J.JSNull <*> arbitrary
87
      Luxi.ReqPickupJob -> Luxi.PickupJob <$> arbitrary
88
      Luxi.ReqArchiveJob -> Luxi.ArchiveJob <$> arbitrary
89
      Luxi.ReqAutoArchiveJobs -> Luxi.AutoArchiveJobs <$> arbitrary <*>
90
                                 arbitrary
91
      Luxi.ReqCancelJob -> Luxi.CancelJob <$> arbitrary
92
      Luxi.ReqChangeJobPriority -> Luxi.ChangeJobPriority <$> arbitrary <*>
93
                                   arbitrary
94
      Luxi.ReqSetDrainFlag -> Luxi.SetDrainFlag <$> arbitrary
95
      Luxi.ReqSetWatcherPause -> Luxi.SetWatcherPause <$> arbitrary
96

    
97
-- | Simple check that encoding/decoding of LuxiOp works.
98
prop_CallEncoding :: Luxi.LuxiOp -> Property
99
prop_CallEncoding op =
100
  (Luxi.validateCall (Luxi.buildCall op) >>= Luxi.decodeCall) ==? Ok op
101

    
102
-- | Helper to a get a temporary file name.
103
getTempFileName :: IO FilePath
104
getTempFileName = do
105
  tempdir <- getTemporaryDirectory
106
  (fpath, handle) <- openTempFile tempdir "luxitest"
107
  _ <- hClose handle
108
  removeFile fpath
109
  return fpath
110

    
111
-- | Server ping-pong helper.
112
luxiServerPong :: Luxi.Client -> IO ()
113
luxiServerPong c = do
114
  msg <- Luxi.recvMsgExt c
115
  case msg of
116
    Luxi.RecvOk m -> Luxi.sendMsg c m >> luxiServerPong c
117
    _ -> return ()
118

    
119
-- | Client ping-pong helper.
120
luxiClientPong :: Luxi.Client -> [String] -> IO [String]
121
luxiClientPong c =
122
  mapM (\m -> Luxi.sendMsg c m >> Luxi.recvMsg c)
123

    
124
-- | Monadic check that, given a server socket, we can connect via a
125
-- client to it, and that we can send a list of arbitrary messages and
126
-- get back what we sent.
127
prop_ClientServer :: [[DNSChar]] -> Property
128
prop_ClientServer dnschars = monadicIO $ do
129
  let msgs = map (map dnsGetChar) dnschars
130
  fpath <- run getTempFileName
131
  -- we need to create the server first, otherwise (if we do it in the
132
  -- forked thread) the client could try to connect to it before it's
133
  -- ready
134
  server <- run $ Luxi.getLuxiServer False fpath
135
  -- fork the server responder
136
  _ <- run . forkIO $
137
    bracket
138
      (Luxi.acceptClient server)
139
      (\c -> Luxi.closeClient c >> Luxi.closeServer fpath server)
140
      luxiServerPong
141
  replies <- run $
142
    bracket
143
      (Luxi.getLuxiClient fpath)
144
      Luxi.closeClient
145
      (`luxiClientPong` msgs)
146
  stop $ replies ==? msgs
147

    
148
-- | Check that Python and Haskell define the same Luxi requests list.
149
case_AllDefined :: Assertion
150
case_AllDefined = do
151
  py_stdout <- runPython "from ganeti import luxi\n\
152
                         \print '\\n'.join(luxi.REQ_ALL)" "" >>=
153
               checkPythonResult
154
  let py_ops = sort $ lines py_stdout
155
      hs_ops = Luxi.allLuxiCalls
156
      extra_py = py_ops \\ hs_ops
157
      extra_hs = hs_ops \\ py_ops
158
  assertBool ("Luxi calls missing from Haskell code:\n" ++
159
              unlines extra_py) (null extra_py)
160
  assertBool ("Extra Luxi calls in the Haskell code code:\n" ++
161
              unlines extra_hs) (null extra_hs)
162

    
163

    
164
testSuite "Luxi"
165
          [ 'prop_CallEncoding
166
          , 'prop_ClientServer
167
          , 'case_AllDefined
168
          ]