From 9de303af97c2b45630b4be461475d29e671abaca Mon Sep 17 00:00:00 2001
From: Michele Tartara <mtartara@google.com>
Date: Mon, 26 Nov 2012 09:37:39 +0100
Subject: [PATCH] Add unit tests for the JSON serialization of DRBD status
The serialization itself is done by Text.JSON, so the tests deal with checking
that Text.JSON objects are created correctly from the DRBD parser data
structures.
Signed-off-by: Michele Tartara <mtartara@google.com>
Reviewed-by: Iustin Pop <iustin@google.com>
---
Makefile.am | 1 +
htest/Test/Ganeti/Block/Drbd/Types.hs | 179 ++++++++++++++++++++++++++
htest/test.hs | 2 +
htools/Ganeti/Block/Drbd/Types.hs | 4 +-
4 files changed, 184 insertions(+), 2 deletions(-)
create mode 100644 htest/Test/Ganeti/Block/Drbd/Types.hs
diff --git a/Makefile.am b/Makefile.am
index 0c1dcb103..4bd4bdd34 100644
--- a/Makefile.am
+++ b/Makefile.am
@@ -496,6 +496,7 @@ HS_TEST_SRCS = \
htest/Test/Ganeti/Attoparsec.hs \
htest/Test/Ganeti/BasicTypes.hs \
htest/Test/Ganeti/Block/Drbd/Parser.hs \
+ htest/Test/Ganeti/Block/Drbd/Types.hs \
htest/Test/Ganeti/Common.hs \
htest/Test/Ganeti/Confd/Utils.hs \
htest/Test/Ganeti/Daemon.hs \
diff --git a/htest/Test/Ganeti/Block/Drbd/Types.hs b/htest/Test/Ganeti/Block/Drbd/Types.hs
new file mode 100644
index 000000000..18691285e
--- /dev/null
+++ b/htest/Test/Ganeti/Block/Drbd/Types.hs
@@ -0,0 +1,179 @@
+{-# LANGUAGE TemplateHaskell #-}
+{-# OPTIONS_GHC -fno-warn-orphans #-}
+
+{-| Unittests for the types representing DRBD status -}
+
+{-
+
+Copyright (C) 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.Block.Drbd.Types (testBlock_Drbd_Types) where
+
+import Test.QuickCheck
+
+import Test.Ganeti.TestHelper
+import Test.Ganeti.TestCommon
+
+import Text.JSON
+import Text.Printf
+
+import Ganeti.JSON
+
+import Ganeti.Block.Drbd.Types
+
+{-# ANN module "HLint: ignore Use camelCase" #-}
+{-# ANN module "HLint: ignore Use string literal" #-}
+
+-- * Arbitrary instances
+
+$(genArbitrary ''ConnState)
+$(genArbitrary ''Role)
+$(genArbitrary ''DiskState)
+$(genArbitrary ''SizeUnit)
+$(genArbitrary ''TimeUnit)
+
+-- | Natural numbers generator.
+natural :: Gen Int
+natural = choose (0, maxBound :: Int)
+
+-- | Generator of percentages.
+percent :: Gen Double
+percent = choose (0 :: Double, 100 :: Double)
+
+-- | Generator of write order flags.
+wOrderFlag :: Gen Char
+wOrderFlag = elements ['b', 'f', 'd', 'n']
+
+-- | Property for testing the JSON serialization of a DeviceInfo.
+prop_DeviceInfo :: Property
+prop_DeviceInfo = do
+ minor <- natural
+ state <- arbitrary
+ locRole <- arbitrary
+ remRole <- arbitrary
+ locState <- arbitrary
+ remState <- arbitrary
+ alg <- choose ('A','C')
+ ns <- natural
+ nr <- natural
+ dw <- natural
+ dr <- natural
+ al <- natural
+ bm <- natural
+ lc <- natural
+ pe <- natural
+ ua <- natural
+ ap <- natural
+ ep <- genMaybe natural
+ wo <- genMaybe wOrderFlag
+ oos <- genMaybe natural
+ let obtained =
+ showJSON $
+ DeviceInfo minor state (LocalRemote locRole remRole)
+ (LocalRemote locState remState) alg "r----" perfInd
+ Nothing
+ Nothing
+ Nothing
+ perfInd =
+ PerfIndicators ns nr dw dr al bm lc pe ua ap ep wo oos
+ expected =
+ makeObj
+ [ ("minor", showJSON minor)
+ , ("connectionState", showJSON state)
+ , ("localRole", showJSON locRole)
+ , ("remoteRole", showJSON remRole)
+ , ("localState", showJSON locState)
+ , ("remoteState", showJSON remState)
+ , ("replicationProtocol", showJSON alg)
+ , ("ioFlags", showJSON "r----")
+ , ("perfIndicators", showJSON perfInd)
+ ]
+ obtained ==? expected
+
+-- | Property for testing the JSON serialization of a PerfIndicators.
+prop_PerfIndicators :: Property
+prop_PerfIndicators = do
+ ns <- natural
+ nr <- natural
+ dw <- natural
+ dr <- natural
+ al <- natural
+ bm <- natural
+ lc <- natural
+ pe <- natural
+ ua <- natural
+ ap <- natural
+ ep <- genMaybe natural
+ wo <- genMaybe wOrderFlag
+ oos <- genMaybe natural
+ let expected =
+ showJSON $
+ PerfIndicators ns nr dw dr al bm lc pe ua ap ep wo oos
+ obtained =
+ optFieldsToObj
+ [ Just ("networkSend", showJSON ns)
+ , Just ("networkReceive", showJSON nr)
+ , Just ("diskWrite", showJSON dw)
+ , Just ("diskRead", showJSON dr)
+ , Just ("activityLog", showJSON al)
+ , Just ("bitMap", showJSON bm)
+ , Just ("localCount", showJSON lc)
+ , Just ("pending", showJSON pe)
+ , Just ("unacknowledged", showJSON ua)
+ , Just ("applicationPending", showJSON ap)
+ , optionalJSField "epochs" ep
+ , optionalJSField "writeOrder" wo
+ , optionalJSField "outOfSync" oos
+ ]
+ obtained ==? expected
+
+-- | Function for testing the JSON serialization of a SyncStatus.
+prop_SyncStatus :: Property
+prop_SyncStatus = do
+ perc <- percent
+ numer <- natural
+ denom <- natural
+ sizeU1 <- arbitrary
+ h <- choose (0, 23)
+ m <- choose (0, 59)
+ s <- choose (0, 59)
+ sp <- natural
+ wa <- genMaybe natural
+ sizeU2 <- arbitrary
+ timeU <- arbitrary
+ let obtained = showJSON $
+ SyncStatus perc numer denom sizeU1 (Time h m s) sp wa sizeU2 timeU
+ expected = optFieldsToObj
+ [ Just ("percentage", showJSON perc)
+ , Just ("progress", showJSON $ show numer ++ "/" ++ show denom)
+ , Just ("progressUnit", showJSON sizeU1)
+ , Just ("timeToFinish", showJSON
+ (printf "%02d:%02d:%02d" h m s :: String))
+ , Just ("speed", showJSON sp)
+ , optionalJSField "want" wa
+ , Just ("speedUnit", showJSON $ show sizeU2 ++ "/" ++ show timeU)
+ ]
+ obtained ==? expected
+
+testSuite "Block/Drbd/Types"
+ [ 'prop_DeviceInfo
+ , 'prop_PerfIndicators
+ , 'prop_SyncStatus
+ ]
diff --git a/htest/test.hs b/htest/test.hs
index eade8bf09..b4aa2ab40 100644
--- a/htest/test.hs
+++ b/htest/test.hs
@@ -33,6 +33,7 @@ import Test.Ganeti.TestImports ()
import Test.Ganeti.Attoparsec
import Test.Ganeti.BasicTypes
import Test.Ganeti.Block.Drbd.Parser
+import Test.Ganeti.Block.Drbd.Types
import Test.Ganeti.Common
import Test.Ganeti.Confd.Utils
import Test.Ganeti.Daemon
@@ -82,6 +83,7 @@ allTests =
, testConfd_Utils
, testDaemon
, testBlock_Drbd_Parser
+ , testBlock_Drbd_Types
, testErrors
, testHTools_Backend_Simu
, testHTools_Backend_Text
diff --git a/htools/Ganeti/Block/Drbd/Types.hs b/htools/Ganeti/Block/Drbd/Types.hs
index 30ce0c9e0..28769101a 100644
--- a/htools/Ganeti/Block/Drbd/Types.hs
+++ b/htools/Ganeti/Block/Drbd/Types.hs
@@ -247,8 +247,8 @@ instance JSON PerfIndicators where
data SyncStatus =
SyncStatus
{ percentage :: Double -- ^ Percentage of syncronized data
- , partialSyncSize :: Integer -- ^ Numerator of the fraction of synced data
- , totalSyncSize :: Integer -- ^ Denominator of the fraction of
+ , partialSyncSize :: Int -- ^ Numerator of the fraction of synced data
+ , totalSyncSize :: Int -- ^ Denominator of the fraction of
-- synced data
, syncUnit :: SizeUnit -- ^ Measurement unit of the previous
-- fraction
--
GitLab