Commit 5e9deac0 authored by Iustin Pop's avatar Iustin Pop
Browse files

Create a new Ganeti/Types.hs module

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: default avatarIustin Pop <iustin@google.com>
Reviewed-by: default avatarAdeodato Simo <dato@google.com>
parent dc6296ff
......@@ -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)
......
......@@ -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 }
......
......@@ -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
......
......@@ -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)
......
{-# 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)
{-# 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
]
......@@ -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
]
......
......@@ -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.
......
......@@ -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
......
......@@ -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)
......
{-# 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)
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment