## root / htest / Test / Ganeti / Objects.hs @ 8d2b6a12

History | View | Annotate | Download (4 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.Objects |

30 |
( testObjects |

31 |
, Hypervisor(..) |

32 |
, Node(..) |

33 |
) where |

34 | |

35 |
import Test.QuickCheck |

36 | |

37 |
import Control.Applicative |

38 |
import qualified Data.Map as Map |

39 |
import qualified Data.Set as Set |

40 |
import qualified Text.JSON as J |

41 | |

42 |
import Test.Ganeti.TestHelper |

43 |
import Test.Ganeti.TestCommon |

44 |
import Ganeti.Objects as Objects |

45 | |

46 |
-- * Arbitrary instances |

47 | |

48 |
instance Arbitrary Hypervisor where |

49 |
arbitrary = elements [minBound..maxBound] |

50 | |

51 |
instance Arbitrary PartialNDParams where |

52 |
arbitrary = PartialNDParams <$> arbitrary <*> arbitrary |

53 | |

54 |
instance Arbitrary Node where |

55 |
arbitrary = Node <$> getFQDN <*> getFQDN <*> getFQDN |

56 |
<*> arbitrary <*> arbitrary <*> arbitrary <*> getFQDN |

57 |
<*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary |

58 |
<*> arbitrary <*> arbitrary <*> getFQDN <*> arbitrary |

59 |
<*> (Set.fromList <$> genTags) |

60 | |

61 |
instance Arbitrary FileDriver where |

62 |
arbitrary = elements [minBound..maxBound] |

63 | |

64 |
instance Arbitrary BlockDriver where |

65 |
arbitrary = elements [minBound..maxBound] |

66 | |

67 |
instance Arbitrary DiskMode where |

68 |
arbitrary = elements [minBound..maxBound] |

69 | |

70 |
instance Arbitrary DiskLogicalId where |

71 |
arbitrary = oneof [ LIDPlain <$> arbitrary <*> arbitrary |

72 |
, LIDDrbd8 <$> getFQDN <*> getFQDN <*> arbitrary |

73 |
<*> arbitrary <*> arbitrary <*> arbitrary |

74 |
, LIDFile <$> arbitrary <*> arbitrary |

75 |
, LIDBlockDev <$> arbitrary <*> arbitrary |

76 |
, LIDRados <$> arbitrary <*> arbitrary |

77 |
] |

78 | |

79 |
-- | 'Disk' 'arbitrary' instance. Since we don't test disk hierarchy |

80 |
-- properties, we only generate disks with no children (FIXME), as |

81 |
-- generating recursive datastructures is a bit more work. |

82 |
instance Arbitrary Disk where |

83 |
arbitrary = Disk <$> arbitrary <*> (pure []) <*> arbitrary |

84 |
<*> arbitrary <*> arbitrary |

85 | |

86 |
-- * Test properties |

87 | |

88 |
-- | Tests that fillDict behaves correctly |

89 |
prop_fillDict :: [(Int, Int)] -> [(Int, Int)] -> Property |

90 |
prop_fillDict defaults custom = |

91 |
let d_map = Map.fromList defaults |

92 |
d_keys = map fst defaults |

93 |
c_map = Map.fromList custom |

94 |
c_keys = map fst custom |

95 |
in printTestCase "Empty custom filling" |

96 |
(fillDict d_map Map.empty [] == d_map) .&&. |

97 |
printTestCase "Empty defaults filling" |

98 |
(fillDict Map.empty c_map [] == c_map) .&&. |

99 |
printTestCase "Delete all keys" |

100 |
(fillDict d_map c_map (d_keys++c_keys) == Map.empty) |

101 | |

102 |
-- | Test that the serialisation of 'DiskLogicalId', which is |

103 |
-- implemented manually, is idempotent. Since we don't have a |

104 |
-- standalone JSON instance for DiskLogicalId (it's a data type that |

105 |
-- expands over two fields in a JSObject), we test this by actially |

106 |
-- testing entire Disk serialisations. So this tests two things at |

107 |
-- once, basically. |

108 |
prop_Disk_serialisation :: Disk -> Property |

109 |
prop_Disk_serialisation disk = |

110 |
J.readJSON (J.showJSON disk) ==? J.Ok disk |

111 | |

112 |
-- | Check that node serialisation is idempotent. |

113 |
prop_Node_serialisation :: Node -> Property |

114 |
prop_Node_serialisation node = |

115 |
J.readJSON (J.showJSON node) ==? J.Ok node |

116 | |

117 |
testSuite "Objects" |

118 |
[ 'prop_fillDict |

119 |
, 'prop_Disk_serialisation |

120 |
, 'prop_Node_serialisation |

121 |
] |