Store keys as ByteStrings
[ganeti-github.git] / test / hs / Test / Ganeti / Query / Network.hs
1 {-# LANGUAGE TemplateHaskell #-}
2 {-# OPTIONS_GHC -fno-warn-orphans #-}
3
4 {-| Unittests for Network Queries.
5
6 -}
7
8 {-
9
10 Copyright (C) 2013 Google Inc.
11 All rights reserved.
12
13 Redistribution and use in source and binary forms, with or without
14 modification, are permitted provided that the following conditions are
15 met:
16
17 1. Redistributions of source code must retain the above copyright notice,
18 this list of conditions and the following disclaimer.
19
20 2. Redistributions in binary form must reproduce the above copyright
21 notice, this list of conditions and the following disclaimer in the
22 documentation and/or other materials provided with the distribution.
23
24 THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
25 IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
26 TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
27 PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR
28 CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
29 EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
30 PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
31 PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
32 LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
33 NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
34 SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
35
36 -}
37
38 module Test.Ganeti.Query.Network
39 ( testQuery_Network
40 ) where
41
42 import Ganeti.JSON
43 import Ganeti.Objects
44 import Ganeti.Query.Network
45
46 import Test.Ganeti.Objects
47 import Test.Ganeti.TestCommon
48 import Test.Ganeti.TestHelper
49
50 import Test.QuickCheck
51
52 import qualified Data.ByteString.UTF8 as UTF8
53 import qualified Data.Map as Map
54 import Data.Maybe
55
56 instance Arbitrary ConfigData where
57 arbitrary = genEmptyCluster 0 >>= genConfigDataWithNetworks
58
59 -- | Check if looking up a valid network ID of a nodegroup yields
60 -- a non-Nothing result.
61 prop_getGroupConnection :: NodeGroup -> Property
62 prop_getGroupConnection group =
63 let net_keys = map UTF8.toString . Map.keys . fromContainer . groupNetworks
64 $ group
65 in True ==? all
66 (\nk -> isJust (getGroupConnection nk group)) net_keys
67
68 -- | Checks if looking up an ID of a non-existing network in a node group
69 -- yields 'Nothing'.
70 prop_getGroupConnection_notFound :: NodeGroup -> String -> Property
71 prop_getGroupConnection_notFound group uuid =
72 let net_map = fromContainer . groupNetworks $ group
73 in not (UTF8.fromString uuid `Map.member` net_map)
74 ==> isNothing (getGroupConnection uuid group)
75
76 -- | Checks whether actually connected instances are identified as such.
77 prop_instIsConnected :: ConfigData -> Property
78 prop_instIsConnected cfg =
79 let nets = (fromContainer . configNetworks) cfg
80 net_keys = map UTF8.toString $ Map.keys nets
81 in forAll (genInstWithNets net_keys) $ \inst ->
82 True ==? all (`instIsConnected` inst) net_keys
83
84 -- | Tests whether instances that are not connected to a network are
85 -- correctly classified as such.
86 prop_instIsConnected_notFound :: ConfigData -> String -> Property
87 prop_instIsConnected_notFound cfg network_uuid =
88 let nets = (fromContainer . configNetworks) cfg
89 net_keys = map UTF8.toString $ Map.keys nets
90 in notElem network_uuid net_keys ==>
91 forAll (genInstWithNets net_keys) $ \inst ->
92 not (instIsConnected network_uuid inst)
93
94 testSuite "Query_Network"
95 [ 'prop_getGroupConnection
96 , 'prop_getGroupConnection_notFound
97 , 'prop_instIsConnected
98 , 'prop_instIsConnected_notFound
99 ]
100
101