From 5e9deac02b1d89c1eea02e9e150649f3eec9dc80 Mon Sep 17 00:00:00 2001
From: Iustin Pop <iustin@google.com>
Date: Thu, 15 Nov 2012 10:05:45 +0100
Subject: [PATCH] Create a new Ganeti/Types.hs module
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit
There are already three cases where we copied type definitions between
the htools-specific types into the main ganeti code. Let's stop doing
this βΊ and create a common types module that holds these.
Note that there already exists BasicTypes.hs, but that refers to very
low-level types, and can't use TH derivation itself.
A side effect of this unification is that there is a small conflict
between AdminStatus/AdminOffline and InstanceStatus/AdminOffline. As
such, I renamed AdminOffline and AdminDown to StatusOffline/StatusDown
in the InstanceStatus type.
The patch also moves the tests related to these types to a new test
module.
Signed-off-by: Iustin Pop <iustin@google.com>
Reviewed-by: Adeodato Simo <dato@google.com>
---
Makefile.am | 2 +
htest/Test/Ganeti/HTools/Node.hs | 4 +-
htest/Test/Ganeti/HTools/Types.hs | 15 +-----
htest/Test/Ganeti/Objects.hs | 4 +-
htest/Test/Ganeti/TestHTools.hs | 6 ---
htest/Test/Ganeti/Types.hs | 64 +++++++++++++++++++++++
htest/test.hs | 2 +
htools/Ganeti/HTools/Instance.hs | 4 +-
htools/Ganeti/HTools/Types.hs | 39 +-------------
htools/Ganeti/Objects.hs | 29 +----------
htools/Ganeti/Types.hs | 85 +++++++++++++++++++++++++++++++
11 files changed, 162 insertions(+), 92 deletions(-)
create mode 100644 htest/Test/Ganeti/Types.hs
create mode 100644 htools/Ganeti/Types.hs
diff --git a/Makefile.am b/Makefile.am
index 0a755960d..2a8fa9a74 100644
--- a/Makefile.am
+++ b/Makefile.am
@@ -477,6 +477,7 @@ HS_LIB_SRCS = \
htools/Ganeti/Runtime.hs \
htools/Ganeti/Ssconf.hs \
htools/Ganeti/THH.hs \
+ htools/Ganeti/Types.hs \
htools/Ganeti/Utils.hs
HS_TEST_SRCS = \
@@ -510,6 +511,7 @@ HS_TEST_SRCS = \
htest/Test/Ganeti/TestCommon.hs \
htest/Test/Ganeti/TestHTools.hs \
htest/Test/Ganeti/TestHelper.hs \
+ htest/Test/Ganeti/Types.hs \
htest/Test/Ganeti/Utils.hs
HS_LIBTEST_SRCS = $(HS_LIB_SRCS) $(HS_TEST_SRCS)
diff --git a/htest/Test/Ganeti/HTools/Node.hs b/htest/Test/Ganeti/HTools/Node.hs
index 2dd9c21b1..75293ab0f 100644
--- a/htest/Test/Ganeti/HTools/Node.hs
+++ b/htest/Test/Ganeti/HTools/Node.hs
@@ -190,7 +190,7 @@ prop_addOfflinePri :: NonNegative Int -> NonNegative Int -> Property
prop_addOfflinePri (NonNegative extra_mem) (NonNegative extra_cpu) =
forAll genOnlineNode $ \node ->
forAll (genInstanceSmallerThanNode node) $ \inst ->
- let inst' = inst { Instance.runSt = Types.AdminOffline
+ let inst' = inst { Instance.runSt = Types.StatusOffline
, Instance.mem = Node.availMem node + extra_mem
, Instance.vcpus = Node.availCpu node + extra_cpu }
in case Node.addPri node inst' of
@@ -204,7 +204,7 @@ prop_addOfflineSec :: NonNegative Int -> NonNegative Int
prop_addOfflineSec (NonNegative extra_mem) (NonNegative extra_cpu) pdx =
forAll genOnlineNode $ \node ->
forAll (genInstanceSmallerThanNode node) $ \inst ->
- let inst' = inst { Instance.runSt = Types.AdminOffline
+ let inst' = inst { Instance.runSt = Types.StatusOffline
, Instance.mem = Node.availMem node + extra_mem
, Instance.vcpus = Node.availCpu node + extra_cpu
, Instance.diskTemplate = Types.DTDrbd8 }
diff --git a/htest/Test/Ganeti/HTools/Types.hs b/htest/Test/Ganeti/HTools/Types.hs
index d72bec6ca..ea53d6932 100644
--- a/htest/Test/Ganeti/HTools/Types.hs
+++ b/htest/Test/Ganeti/HTools/Types.hs
@@ -44,6 +44,7 @@ import Control.Applicative
import Test.Ganeti.TestHelper
import Test.Ganeti.TestCommon
import Test.Ganeti.TestHTools
+import Test.Ganeti.Types ()
import Ganeti.BasicTypes
import qualified Ganeti.HTools.Types as Types
@@ -56,10 +57,6 @@ allDiskTemplates = [minBound..maxBound]
-- * Arbitrary instance
-$(genArbitrary ''Types.AllocPolicy)
-
-$(genArbitrary ''Types.DiskTemplate)
-
$(genArbitrary ''Types.FailMode)
$(genArbitrary ''Types.EvacMode)
@@ -122,12 +119,6 @@ instance Arbitrary Types.IPolicy where
-- * Test cases
-prop_AllocPolicy_serialisation :: Types.AllocPolicy -> Property
-prop_AllocPolicy_serialisation = testSerialisation
-
-prop_DiskTemplate_serialisation :: Types.DiskTemplate -> Property
-prop_DiskTemplate_serialisation = testSerialisation
-
prop_ISpec_serialisation :: Types.ISpec -> Property
prop_ISpec_serialisation = testSerialisation
@@ -156,9 +147,7 @@ prop_eitherToResult ei =
where r = eitherToResult ei
testSuite "HTools/Types"
- [ 'prop_AllocPolicy_serialisation
- , 'prop_DiskTemplate_serialisation
- , 'prop_ISpec_serialisation
+ [ 'prop_ISpec_serialisation
, 'prop_IPolicy_serialisation
, 'prop_EvacMode_serialisation
, 'prop_opToResult
diff --git a/htest/Test/Ganeti/Objects.hs b/htest/Test/Ganeti/Objects.hs
index c269950fe..6dc0af93c 100644
--- a/htest/Test/Ganeti/Objects.hs
+++ b/htest/Test/Ganeti/Objects.hs
@@ -41,6 +41,7 @@ import qualified Data.Set as Set
import Test.Ganeti.TestHelper
import Test.Ganeti.TestCommon
+import Test.Ganeti.Types ()
import qualified Ganeti.Constants as C
import Ganeti.Objects as Objects
@@ -87,8 +88,6 @@ instance Arbitrary Disk where
-- hard for partial ones, where all must be wrapped in a 'Maybe'
$(genArbitrary ''PartialBeParams)
-$(genArbitrary ''DiskTemplate)
-
$(genArbitrary ''AdminState)
$(genArbitrary ''NICMode)
@@ -138,7 +137,6 @@ instance Arbitrary NodeGroup where
-- tags
<*> (Set.fromList <$> genTags)
-$(genArbitrary ''AllocPolicy)
$(genArbitrary ''FilledISpecParams)
$(genArbitrary ''FilledIPolicy)
$(genArbitrary ''IpFamily)
diff --git a/htest/Test/Ganeti/TestHTools.hs b/htest/Test/Ganeti/TestHTools.hs
index b33f76672..44b53c87a 100644
--- a/htest/Test/Ganeti/TestHTools.hs
+++ b/htest/Test/Ganeti/TestHTools.hs
@@ -1,4 +1,3 @@
-{-# LANGUAGE TemplateHaskell #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
{-| Common functionality for htools-related unittests.
@@ -30,7 +29,6 @@ module Test.Ganeti.TestHTools where
import qualified Data.Map as Map
-import Test.Ganeti.TestHelper
import Test.Ganeti.TestCommon
import qualified Ganeti.Constants as C
@@ -111,7 +109,3 @@ setInstanceSmallerThanNode node inst =
, Instance.dsk = Node.availDisk node `div` 2
, Instance.vcpus = Node.availCpu node `div` 2
}
-
--- * Arbitrary instances
-
-$(genArbitrary ''Types.InstanceStatus)
diff --git a/htest/Test/Ganeti/Types.hs b/htest/Test/Ganeti/Types.hs
new file mode 100644
index 000000000..d4e6d4ed2
--- /dev/null
+++ b/htest/Test/Ganeti/Types.hs
@@ -0,0 +1,64 @@
+{-# LANGUAGE TemplateHaskell #-}
+{-# OPTIONS_GHC -fno-warn-orphans #-}
+
+{-| Unittests for 'Ganeti.Types'.
+
+-}
+
+{-
+
+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.Types
+ ( testTypes
+ , AllocPolicy(..)
+ , DiskTemplate(..)
+ , InstanceStatus(..)
+ ) where
+
+import Test.QuickCheck
+
+import Test.Ganeti.TestHelper
+import Test.Ganeti.TestCommon
+
+import Ganeti.Types
+
+-- * Arbitrary instance
+
+$(genArbitrary ''AllocPolicy)
+
+$(genArbitrary ''DiskTemplate)
+
+$(genArbitrary ''InstanceStatus)
+
+prop_AllocPolicy_serialisation :: AllocPolicy -> Property
+prop_AllocPolicy_serialisation = testSerialisation
+
+prop_DiskTemplate_serialisation :: DiskTemplate -> Property
+prop_DiskTemplate_serialisation = testSerialisation
+
+prop_InstanceStatus_serialisation :: InstanceStatus -> Property
+prop_InstanceStatus_serialisation = testSerialisation
+
+testSuite "Types"
+ [ 'prop_AllocPolicy_serialisation
+ , 'prop_DiskTemplate_serialisation
+ , 'prop_InstanceStatus_serialisation
+ ]
diff --git a/htest/test.hs b/htest/test.hs
index b41fb99bd..54d0dcce6 100644
--- a/htest/test.hs
+++ b/htest/test.hs
@@ -57,6 +57,7 @@ import Test.Ganeti.Query.Query
import Test.Ganeti.Rpc
import Test.Ganeti.Ssconf
import Test.Ganeti.THH
+import Test.Ganeti.Types
import Test.Ganeti.Utils
-- | Our default test options, overring the built-in test-framework
@@ -101,6 +102,7 @@ allTests =
, testRpc
, testSsconf
, testTHH
+ , testTypes
, testUtils
]
diff --git a/htools/Ganeti/HTools/Instance.hs b/htools/Ganeti/HTools/Instance.hs
index ad96d7f7c..346b5ddb8 100644
--- a/htools/Ganeti/HTools/Instance.hs
+++ b/htools/Ganeti/HTools/Instance.hs
@@ -100,8 +100,8 @@ isRunning _ = False
-- | Check if instance is offline.
isOffline :: Instance -> Bool
-isOffline (Instance {runSt = T.AdminOffline}) = True
-isOffline _ = False
+isOffline (Instance {runSt = T.StatusOffline}) = True
+isOffline _ = False
-- | Helper to check if the instance is not offline.
diff --git a/htools/Ganeti/HTools/Types.hs b/htools/Ganeti/HTools/Types.hs
index e0fdf5428..9a9b77ad0 100644
--- a/htools/Ganeti/HTools/Types.hs
+++ b/htools/Ganeti/HTools/Types.hs
@@ -79,6 +79,7 @@ import qualified Data.Map as M
import qualified Ganeti.Constants as C
import qualified Ganeti.THH as THH
import Ganeti.BasicTypes
+import Ganeti.Types
-- | The instance index type.
type Idx = Int
@@ -105,18 +106,6 @@ type GroupID = String
defaultGroupID :: GroupID
defaultGroupID = "00000000-0000-0000-0000-000000000000"
--- | Instance disk template type.
-$(THH.declareSADT "DiskTemplate"
- [ ("DTDiskless", 'C.dtDiskless)
- , ("DTFile", 'C.dtFile)
- , ("DTSharedFile", 'C.dtSharedFile)
- , ("DTPlain", 'C.dtPlain)
- , ("DTBlock", 'C.dtBlock)
- , ("DTDrbd8", 'C.dtDrbd8)
- , ("DTRbd", 'C.dtRbd)
- ])
-$(THH.makeJSONInstance ''DiskTemplate)
-
-- | Mirroring type.
data MirrorType = MirrorNone -- ^ No mirroring/movability
| MirrorInternal -- ^ DRBD-type mirroring
@@ -133,32 +122,6 @@ templateMirrorType DTBlock = MirrorExternal
templateMirrorType DTDrbd8 = MirrorInternal
templateMirrorType DTRbd = MirrorExternal
--- | The Group allocation policy type.
---
--- Note that the order of constructors is important as the automatic
--- Ord instance will order them in the order they are defined, so when
--- changing this data type be careful about the interaction with the
--- desired sorting order.
-$(THH.declareSADT "AllocPolicy"
- [ ("AllocPreferred", 'C.allocPolicyPreferred)
- , ("AllocLastResort", 'C.allocPolicyLastResort)
- , ("AllocUnallocable", 'C.allocPolicyUnallocable)
- ])
-$(THH.makeJSONInstance ''AllocPolicy)
-
--- | The Instance real state type.
-$(THH.declareSADT "InstanceStatus"
- [ ("AdminDown", 'C.inststAdmindown)
- , ("AdminOffline", 'C.inststAdminoffline)
- , ("ErrorDown", 'C.inststErrordown)
- , ("ErrorUp", 'C.inststErrorup)
- , ("NodeDown", 'C.inststNodedown)
- , ("NodeOffline", 'C.inststNodeoffline)
- , ("Running", 'C.inststRunning)
- , ("WrongNode", 'C.inststWrongnode)
- ])
-$(THH.makeJSONInstance ''InstanceStatus)
-
-- | The resource spec type.
data RSpec = RSpec
{ rspecCpu :: Int -- ^ Requested VCPUs
diff --git a/htools/Ganeti/Objects.hs b/htools/Ganeti/Objects.hs
index 71dd349d1..021f9ed22 100644
--- a/htools/Ganeti/Objects.hs
+++ b/htools/Ganeti/Objects.hs
@@ -100,7 +100,7 @@ import qualified Text.JSON as J
import qualified Ganeti.Constants as C
import Ganeti.JSON
-
+import Ganeti.Types
import Ganeti.THH
-- * Generic definitions
@@ -344,18 +344,6 @@ $(makeJSONInstance ''Hypervisor)
-- * Instance definitions
--- | Instance disk template type. **Copied from HTools/Types.hs**
-$(declareSADT "DiskTemplate"
- [ ("DTDiskless", 'C.dtDiskless)
- , ("DTFile", 'C.dtFile)
- , ("DTSharedFile", 'C.dtSharedFile)
- , ("DTPlain", 'C.dtPlain)
- , ("DTBlock", 'C.dtBlock)
- , ("DTDrbd8", 'C.dtDrbd8)
- , ("DTRados", 'C.dtRbd)
- ])
-$(makeJSONInstance ''DiskTemplate)
-
$(declareSADT "AdminState"
[ ("AdminOffline", 'C.adminstOffline)
, ("AdminDown", 'C.adminstDown)
@@ -500,21 +488,6 @@ instance TagsObject Node where
-- * NodeGroup definitions
--- | The Group allocation policy type.
---
--- Note that the order of constructors is important as the automatic
--- Ord instance will order them in the order they are defined, so when
--- changing this data type be careful about the interaction with the
--- desired sorting order.
---
--- FIXME: COPIED from Types.hs; we need to eliminate this duplication later
-$(declareSADT "AllocPolicy"
- [ ("AllocPreferred", 'C.allocPolicyPreferred)
- , ("AllocLastResort", 'C.allocPolicyLastResort)
- , ("AllocUnallocable", 'C.allocPolicyUnallocable)
- ])
-$(makeJSONInstance ''AllocPolicy)
-
-- | The disk parameters type.
type DiskParams = Container (Container JSValue)
diff --git a/htools/Ganeti/Types.hs b/htools/Ganeti/Types.hs
new file mode 100644
index 000000000..9ce9aa6d8
--- /dev/null
+++ b/htools/Ganeti/Types.hs
@@ -0,0 +1,85 @@
+{-# LANGUAGE TemplateHaskell #-}
+
+{-| Some common Ganeti types.
+
+This holds types common to both core work, and to htools. Types that
+are very core specific (e.g. configuration objects) should go in
+'Ganeti.Objects', while types that are specific to htools in-memory
+representation should go into 'Ganeti.HTools.Types'.
+
+-}
+
+{-
+
+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 Ganeti.Types
+ ( AllocPolicy(..)
+ , allocPolicyFromRaw
+ , allocPolicyToRaw
+ , InstanceStatus(..)
+ , instanceStatusFromRaw
+ , instanceStatusToRaw
+ , DiskTemplate(..)
+ , diskTemplateToRaw
+ , diskTemplateFromRaw
+ ) where
+
+import qualified Ganeti.Constants as C
+import qualified Ganeti.THH as THH
+
+-- | Instance disk template type.
+$(THH.declareSADT "DiskTemplate"
+ [ ("DTDiskless", 'C.dtDiskless)
+ , ("DTFile", 'C.dtFile)
+ , ("DTSharedFile", 'C.dtSharedFile)
+ , ("DTPlain", 'C.dtPlain)
+ , ("DTBlock", 'C.dtBlock)
+ , ("DTDrbd8", 'C.dtDrbd8)
+ , ("DTRbd", 'C.dtRbd)
+ ])
+$(THH.makeJSONInstance ''DiskTemplate)
+
+-- | The Group allocation policy type.
+--
+-- Note that the order of constructors is important as the automatic
+-- Ord instance will order them in the order they are defined, so when
+-- changing this data type be careful about the interaction with the
+-- desired sorting order.
+$(THH.declareSADT "AllocPolicy"
+ [ ("AllocPreferred", 'C.allocPolicyPreferred)
+ , ("AllocLastResort", 'C.allocPolicyLastResort)
+ , ("AllocUnallocable", 'C.allocPolicyUnallocable)
+ ])
+$(THH.makeJSONInstance ''AllocPolicy)
+
+-- | The Instance real state type. FIXME: this could be improved to
+-- just wrap a /NormalState AdminStatus | ErrorState ErrorCondition/.
+$(THH.declareSADT "InstanceStatus"
+ [ ("StatusDown", 'C.inststAdmindown)
+ , ("StatusOffline", 'C.inststAdminoffline)
+ , ("ErrorDown", 'C.inststErrordown)
+ , ("ErrorUp", 'C.inststErrorup)
+ , ("NodeDown", 'C.inststNodedown)
+ , ("NodeOffline", 'C.inststNodeoffline)
+ , ("Running", 'C.inststRunning)
+ , ("WrongNode", 'C.inststWrongnode)
+ ])
+$(THH.makeJSONInstance ''InstanceStatus)
--
GitLab