Fix inconsistency in python and haskell objects

Currently hv/disk_state_static parameters are supported only for cluster
object properly. For node groups and nodes they were introduced in
2da9f556, however only on the python side. This could cause problems
during upgrades from old versions.

This patch adds hv and disk states fields to haskell objects as a
notSerializedDefaultField which will fix the problem without the changes
in behaviour. Also it modifies corresponding haskell arbitrary instances.

The patch is inspired by e78fb0d6 and 553363a3.

Signed-off-by: Oleg Ponomarev <oponomarev@google.com>
Reviewed-by: Klaus Aehlig <aehlig@google.com>

diff --git a/src/Ganeti/Objects.hs b/src/Ganeti/Objects.hs
index 1b25933..c99c1c2 100644 (file)
--- a/src/Ganeti/Objects.hs
+++ b/src/Ganeti/Objects.hs
@@ -684,6 +684,18 @@ $(buildParam "ND" "ndp"
   , simpleField "cpu_speed"     [t| Double |]
   ])
 
+-- | Disk state parameters.
+--
+-- As according to the documentation this option is unused by Ganeti,
+-- the content is just a 'JSValue'.
+type DiskState = Container JSValue
+
+-- | Hypervisor state parameters.
+--
+-- As according to the documentation this option is unused by Ganeti,
+-- the content is just a 'JSValue'.
+type HypervisorState = Container JSValue
+
 $(buildObject "Node" "node" $
   [ simpleField "name"             [t| String |]
   , simpleField "primary_ip"       [t| String |]
@@ -696,6 +708,10 @@ $(buildObject "Node" "node" $
   , simpleField "vm_capable"       [t| Bool   |]
   , simpleField "ndparams"         [t| PartialNDParams |]
   , simpleField "powered"          [t| Bool   |]
+  , notSerializeDefaultField [| emptyContainer |] $
+    simpleField "hv_state_static"   [t| HypervisorState |]
+  , notSerializeDefaultField [| emptyContainer |] $
+    simpleField "disk_state_static" [t| DiskState       |]
   ]
   ++ timeStampFields
   ++ uuidFields
@@ -731,6 +747,10 @@ $(buildObject "NodeGroup" "group" $
   , simpleField "ipolicy"      [t| PartialIPolicy  |]
   , simpleField "diskparams"   [t| GroupDiskParams |]
   , simpleField "networks"     [t| Networks        |]
+  , notSerializeDefaultField [| emptyContainer |] $
+    simpleField "hv_state_static"   [t| HypervisorState |]
+  , notSerializeDefaultField [| emptyContainer |] $
+    simpleField "disk_state_static" [t| DiskState       |]
   ]
   ++ timeStampFields
   ++ uuidFields
@@ -796,18 +816,6 @@ type IAllocatorParams = Container JSValue
 -- | The master candidate client certificate digests
 type CandidateCertificates = Container String
 
--- | Disk state parameters.
---
--- As according to the documentation this option is unused by Ganeti,
--- the content is just a 'JSValue'.
-type DiskState = Container JSValue
-
--- | Hypervisor state parameters.
---
--- As according to the documentation this option is unused by Ganeti,
--- the content is just a 'JSValue'.
-type HypervisorState = Container JSValue
-
 -- * Cluster definitions
 $(buildObject "Cluster" "cluster" $
   [ simpleField "rsahostkeypub"                  [t| String                 |]

diff --git a/test/hs/Test/Ganeti/Objects.hs b/test/hs/Test/Ganeti/Objects.hs
index 8de58d2..db0252a 100644 (file)
--- a/test/hs/Test/Ganeti/Objects.hs
+++ b/test/hs/Test/Ganeti/Objects.hs
@@ -83,8 +83,8 @@ instance Arbitrary Node where
   arbitrary = Node <$> genFQDN <*> genFQDN <*> genFQDN
               <*> arbitrary <*> arbitrary <*> arbitrary <*> genFQDN
               <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary
-              <*> arbitrary <*> arbitrary <*> genFQDN <*> arbitrary
-              <*> (Set.fromList <$> genTags)
+              <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary
+              <*> genFQDN <*> arbitrary <*> (Set.fromList <$> genTags)
 
 $(genArbitrary ''BlockDriver)
 
@@ -524,6 +524,8 @@ genNodeGroup = do
   nic_param_list <- vectorOf num_networks (arbitrary::Gen PartialNicParams)
   net_map <- pure (GenericContainer . Map.fromList $
     zip net_uuid_list nic_param_list)
+  hv_state <- arbitrary
+  disk_state <- arbitrary
   -- timestamp fields
   ctime <- arbitrary
   mtime <- arbitrary
@@ -531,7 +533,7 @@ genNodeGroup = do
   serial <- arbitrary
   tags <- Set.fromList <$> genTags
   let group = NodeGroup name members ndparams alloc_policy ipolicy diskparams
-              net_map ctime mtime uuid serial tags
+              net_map hv_state disk_state ctime mtime uuid serial tags
   return group
 
 instance Arbitrary NodeGroup where