Luxi.hs 5.75 KB
Newer Older
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
{-# 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

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

35
import Data.List
36
37
38
39
40
41
42
43
44
45
46
47
import Control.Applicative
import Control.Concurrent (forkIO)
import Control.Exception (bracket)
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
48
import qualified Ganeti.UDSServer as US
49

Iustin Pop's avatar
Iustin Pop committed
50
51
{-# ANN module "HLint: ignore Use camelCase" #-}

52
53
-- * Luxi tests

54
$(genArbitrary ''Luxi.LuxiReq)
55
56
57
58
59

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

-- | Simple check that encoding/decoding of LuxiOp works.
97
98
prop_CallEncoding :: Luxi.LuxiOp -> Property
prop_CallEncoding op =
99
  (US.parseCall (Luxi.buildCall op) >>= uncurry Luxi.decodeLuxiCall) ==? Ok op
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116

-- | 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.
117
118
prop_ClientServer :: [[DNSChar]] -> Property
prop_ClientServer dnschars = monadicIO $ do
119
  let msgs = map (map dnsGetChar) dnschars
Jose A. Lopes's avatar
Jose A. Lopes committed
120
  fpath <- run $ getTempFileName "luxitest"
121
122
123
  -- 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
124
  server <- run $ Luxi.getLuxiServer False fpath
125
126
127
128
  -- fork the server responder
  _ <- run . forkIO $
    bracket
      (Luxi.acceptClient server)
129
      (\c -> Luxi.closeClient c >> Luxi.closeServer server)
130
131
132
      luxiServerPong
  replies <- run $
    bracket
133
      (Luxi.getLuxiClient fpath)
134
      Luxi.closeClient
Iustin Pop's avatar
Iustin Pop committed
135
      (`luxiClientPong` msgs)
136
137
  stop $ replies ==? msgs

138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
-- | Check that Python and Haskell define the same Luxi requests list.
case_AllDefined :: Assertion
case_AllDefined = do
  py_stdout <- runPython "from ganeti import luxi\n\
                         \print '\\n'.join(luxi.REQ_ALL)" "" >>=
               checkPythonResult
  let py_ops = sort $ lines py_stdout
      hs_ops = Luxi.allLuxiCalls
      extra_py = py_ops \\ hs_ops
      extra_hs = hs_ops \\ py_ops
  assertBool ("Luxi calls missing from Haskell code:\n" ++
              unlines extra_py) (null extra_py)
  assertBool ("Extra Luxi calls in the Haskell code code:\n" ++
              unlines extra_hs) (null extra_hs)


154
testSuite "Luxi"
155
156
          [ 'prop_CallEncoding
          , 'prop_ClientServer
157
          , 'case_AllDefined
158
          ]