root / test / hs / Test / Ganeti / Block / Drbd / Types.hs @ eb62691c
History | View | Annotate | Download (5.1 kB)
1 |
{-# LANGUAGE TemplateHaskell #-} |
---|---|
2 |
{-# OPTIONS_GHC -fno-warn-orphans #-} |
3 |
|
4 |
{-| Unittests for the types representing DRBD status -} |
5 |
|
6 |
{- |
7 |
|
8 |
Copyright (C) 2012 Google Inc. |
9 |
|
10 |
This program is free software; you can redistribute it and/or modify |
11 |
it under the terms of the GNU General Public License as published by |
12 |
the Free Software Foundation; either version 2 of the License, or |
13 |
(at your option) any later version. |
14 |
|
15 |
This program is distributed in the hope that it will be useful, but |
16 |
WITHOUT ANY WARRANTY; without even the implied warranty of |
17 |
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU |
18 |
General Public License for more details. |
19 |
|
20 |
You should have received a copy of the GNU General Public License |
21 |
along with this program; if not, write to the Free Software |
22 |
Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA |
23 |
02110-1301, USA. |
24 |
|
25 |
-} |
26 |
|
27 |
module Test.Ganeti.Block.Drbd.Types (testBlock_Drbd_Types) where |
28 |
|
29 |
import Test.QuickCheck |
30 |
|
31 |
import Test.Ganeti.TestHelper |
32 |
import Test.Ganeti.TestCommon |
33 |
|
34 |
import Text.JSON |
35 |
import Text.Printf |
36 |
|
37 |
import Ganeti.JSON |
38 |
|
39 |
import Ganeti.Block.Drbd.Types |
40 |
|
41 |
{-# ANN module "HLint: ignore Use camelCase" #-} |
42 |
{-# ANN module "HLint: ignore Use string literal" #-} |
43 |
|
44 |
-- * Arbitrary instances |
45 |
|
46 |
$(genArbitrary ''ConnState) |
47 |
$(genArbitrary ''Role) |
48 |
$(genArbitrary ''DiskState) |
49 |
$(genArbitrary ''SizeUnit) |
50 |
$(genArbitrary ''TimeUnit) |
51 |
|
52 |
-- | Natural numbers generator. |
53 |
natural :: Gen Int |
54 |
natural = choose (0, maxBound :: Int) |
55 |
|
56 |
-- | Generator of percentages. |
57 |
percent :: Gen Double |
58 |
percent = choose (0 :: Double, 100 :: Double) |
59 |
|
60 |
-- | Generator of write order flags. |
61 |
wOrderFlag :: Gen Char |
62 |
wOrderFlag = elements ['b', 'f', 'd', 'n'] |
63 |
|
64 |
-- | Property for testing the JSON serialization of a DeviceInfo. |
65 |
prop_DeviceInfo :: Property |
66 |
prop_DeviceInfo = do |
67 |
minor <- natural |
68 |
state <- arbitrary |
69 |
locRole <- arbitrary |
70 |
remRole <- arbitrary |
71 |
locState <- arbitrary |
72 |
remState <- arbitrary |
73 |
alg <- choose ('A','C') |
74 |
ns <- natural |
75 |
nr <- natural |
76 |
dw <- natural |
77 |
dr <- natural |
78 |
al <- natural |
79 |
bm <- natural |
80 |
lc <- natural |
81 |
pe <- natural |
82 |
ua <- natural |
83 |
ap <- natural |
84 |
ep <- genMaybe natural |
85 |
wo <- genMaybe wOrderFlag |
86 |
oos <- genMaybe natural |
87 |
inst <- genMaybe arbitrary |
88 |
let obtained = |
89 |
showJSON $ |
90 |
DeviceInfo minor state (LocalRemote locRole remRole) |
91 |
(LocalRemote locState remState) alg "r----" perfInd |
92 |
Nothing |
93 |
Nothing |
94 |
Nothing |
95 |
inst |
96 |
perfInd = |
97 |
PerfIndicators ns nr dw dr al bm lc pe ua ap ep wo oos |
98 |
expected = |
99 |
makeObj |
100 |
[ ("minor", showJSON minor) |
101 |
, ("connectionState", showJSON state) |
102 |
, ("localRole", showJSON locRole) |
103 |
, ("remoteRole", showJSON remRole) |
104 |
, ("localState", showJSON locState) |
105 |
, ("remoteState", showJSON remState) |
106 |
, ("replicationProtocol", showJSON alg) |
107 |
, ("ioFlags", showJSON "r----") |
108 |
, ("perfIndicators", showJSON perfInd) |
109 |
, ("instance", maybe JSNull showJSON inst) |
110 |
] |
111 |
obtained ==? expected |
112 |
|
113 |
-- | Property for testing the JSON serialization of a PerfIndicators. |
114 |
prop_PerfIndicators :: Property |
115 |
prop_PerfIndicators = do |
116 |
ns <- natural |
117 |
nr <- natural |
118 |
dw <- natural |
119 |
dr <- natural |
120 |
al <- natural |
121 |
bm <- natural |
122 |
lc <- natural |
123 |
pe <- natural |
124 |
ua <- natural |
125 |
ap <- natural |
126 |
ep <- genMaybe natural |
127 |
wo <- genMaybe wOrderFlag |
128 |
oos <- genMaybe natural |
129 |
let expected = |
130 |
showJSON $ |
131 |
PerfIndicators ns nr dw dr al bm lc pe ua ap ep wo oos |
132 |
obtained = |
133 |
optFieldsToObj |
134 |
[ Just ("networkSend", showJSON ns) |
135 |
, Just ("networkReceive", showJSON nr) |
136 |
, Just ("diskWrite", showJSON dw) |
137 |
, Just ("diskRead", showJSON dr) |
138 |
, Just ("activityLog", showJSON al) |
139 |
, Just ("bitMap", showJSON bm) |
140 |
, Just ("localCount", showJSON lc) |
141 |
, Just ("pending", showJSON pe) |
142 |
, Just ("unacknowledged", showJSON ua) |
143 |
, Just ("applicationPending", showJSON ap) |
144 |
, optionalJSField "epochs" ep |
145 |
, optionalJSField "writeOrder" wo |
146 |
, optionalJSField "outOfSync" oos |
147 |
] |
148 |
obtained ==? expected |
149 |
|
150 |
-- | Function for testing the JSON serialization of a SyncStatus. |
151 |
prop_SyncStatus :: Property |
152 |
prop_SyncStatus = do |
153 |
perc <- percent |
154 |
numer <- natural |
155 |
denom <- natural |
156 |
sizeU1 <- arbitrary |
157 |
h <- choose (0, 23) |
158 |
m <- choose (0, 59) |
159 |
s <- choose (0, 59) |
160 |
sp <- natural |
161 |
wa <- genMaybe natural |
162 |
sizeU2 <- arbitrary |
163 |
timeU <- arbitrary |
164 |
let obtained = showJSON $ |
165 |
SyncStatus perc numer denom sizeU1 (Time h m s) sp wa sizeU2 timeU |
166 |
expected = optFieldsToObj |
167 |
[ Just ("percentage", showJSON perc) |
168 |
, Just ("progress", showJSON $ show numer ++ "/" ++ show denom) |
169 |
, Just ("progressUnit", showJSON sizeU1) |
170 |
, Just ("timeToFinish", showJSON |
171 |
(printf "%02d:%02d:%02d" h m s :: String)) |
172 |
, Just ("speed", showJSON sp) |
173 |
, optionalJSField "want" wa |
174 |
, Just ("speedUnit", showJSON $ show sizeU2 ++ "/" ++ show timeU) |
175 |
] |
176 |
obtained ==? expected |
177 |
|
178 |
testSuite "Block/Drbd/Types" |
179 |
[ 'prop_DeviceInfo |
180 |
, 'prop_PerfIndicators |
181 |
, 'prop_SyncStatus |
182 |
] |