From 7514fe92cd4f5e5c854b91f11dc6ac399d9e6ba6 Mon Sep 17 00:00:00 2001
From: Iustin Pop <iustin@google.com>
Date: Sat, 18 Aug 2012 16:54:54 +0200
Subject: [PATCH] Add Objects definitions for the ispec/ipolicy types
Note that since we don't have yet a way to nicely handle two-level
optional parameters, the Filled/Partial types and filling function are
all manually built.
Signed-off-by: Iustin Pop <iustin@google.com>
Reviewed-by: Agata Murawska <agatamurawska@google.com>
---
htools/Ganeti/HTools/QC.hs | 2 +-
htools/Ganeti/Objects.hs | 70 ++++++++++++++++++++++++++++++++++++--
2 files changed, 69 insertions(+), 3 deletions(-)
diff --git a/htools/Ganeti/HTools/QC.hs b/htools/Ganeti/HTools/QC.hs
index bd58d3993..5bf17d675 100644
--- a/htools/Ganeti/HTools/QC.hs
+++ b/htools/Ganeti/HTools/QC.hs
@@ -540,7 +540,7 @@ instance Arbitrary Objects.Hypervisor where
arbitrary = elements [minBound..maxBound]
instance Arbitrary Objects.PartialNDParams where
- arbitrary = Objects.PartialNDParams <$> arbitrary
+ arbitrary = Objects.PartialNDParams <$> arbitrary <*> arbitrary
instance Arbitrary Objects.Node where
arbitrary = Objects.Node <$> getFQDN <*> getFQDN <*> getFQDN
diff --git a/htools/Ganeti/Objects.hs b/htools/Ganeti/Objects.hs
index 9b98b8fa1..380524c03 100644
--- a/htools/Ganeti/Objects.hs
+++ b/htools/Ganeti/Objects.hs
@@ -52,6 +52,12 @@ module Ganeti.Objects
, fillNDParams
, Node(..)
, AllocPolicy(..)
+ , FilledISpecParams(..)
+ , PartialISpecParams(..)
+ , fillISpecParams
+ , FilledIPolicy(..)
+ , PartialIPolicy(..)
+ , fillIPolicy
, NodeGroup(..)
, IpFamily(..)
, ipFamilyToVersion
@@ -289,10 +295,68 @@ $(buildObject "Instance" "inst" $
++ uuidFields
++ serialFields)
+-- * IPolicy definitions
+
+$(buildParam "ISpec" "ispec" $
+ [ simpleField C.ispecMemSize [t| Int |]
+ , simpleField C.ispecDiskSize [t| Int |]
+ , simpleField C.ispecDiskCount [t| Int |]
+ , simpleField C.ispecCpuCount [t| Int |]
+ , simpleField C.ispecSpindleUse [t| Int |]
+ ])
+
+-- | Custom partial ipolicy. This is not built via buildParam since it
+-- has a special 2-level inheritance mode.
+$(buildObject "PartialIPolicy" "ipolicy" $
+ [ renameField "MinSpecP" $ simpleField "min" [t| PartialISpecParams |]
+ , renameField "MaxSpecP" $ simpleField "max" [t| PartialISpecParams |]
+ , renameField "StdSpecP" $ simpleField "std" [t| PartialISpecParams |]
+ , optionalField . renameField "SpindleRatioP"
+ $ simpleField "spindle-ratio" [t| Double |]
+ , optionalField . renameField "VcpuRatioP"
+ $ simpleField "vcpu-ratio" [t| Double |]
+ , optionalField . renameField "DiskTemplatesP"
+ $ simpleField "disk-templates" [t| [DiskTemplate] |]
+ ])
+
+-- | Custom filled ipolicy. This is not built via buildParam since it
+-- has a special 2-level inheritance mode.
+$(buildObject "FilledIPolicy" "ipolicy" $
+ [ renameField "MinSpec" $ simpleField "min" [t| FilledISpecParams |]
+ , renameField "MaxSpec" $ simpleField "max" [t| FilledISpecParams |]
+ , renameField "StdSpec" $ simpleField "std" [t| FilledISpecParams |]
+ , simpleField "spindle-ratio" [t| Double |]
+ , simpleField "vcpu-ratio" [t| Double |]
+ , simpleField "disk-templates" [t| [DiskTemplate] |]
+ ])
+
+-- | Custom filler for the ipolicy types.
+fillIPolicy :: FilledIPolicy -> PartialIPolicy -> FilledIPolicy
+fillIPolicy (FilledIPolicy { ipolicyMinSpec = fmin
+ , ipolicyMaxSpec = fmax
+ , ipolicyStdSpec = fstd
+ , ipolicySpindleRatio = fspindleRatio
+ , ipolicyVcpuRatio = fvcpuRatio
+ , ipolicyDiskTemplates = fdiskTemplates})
+ (PartialIPolicy { ipolicyMinSpecP = pmin
+ , ipolicyMaxSpecP = pmax
+ , ipolicyStdSpecP = pstd
+ , ipolicySpindleRatioP = pspindleRatio
+ , ipolicyVcpuRatioP = pvcpuRatio
+ , ipolicyDiskTemplatesP = pdiskTemplates}) =
+ FilledIPolicy { ipolicyMinSpec = fillISpecParams fmin pmin
+ , ipolicyMaxSpec = fillISpecParams fmax pmax
+ , ipolicyStdSpec = fillISpecParams fstd pstd
+ , ipolicySpindleRatio = fromMaybe fspindleRatio pspindleRatio
+ , ipolicyVcpuRatio = fromMaybe fvcpuRatio pvcpuRatio
+ , ipolicyDiskTemplates = fromMaybe fdiskTemplates
+ pdiskTemplates
+ }
-- * Node definitions
$(buildParam "ND" "ndp" $
- [ simpleField "oob_program" [t| String |]
+ [ simpleField "oob_program" [t| String |]
+ , simpleField "spindle_count" [t| Int |]
])
$(buildObject "Node" "node" $
@@ -333,7 +397,8 @@ $(buildObject "NodeGroup" "group" $
[ simpleField "name" [t| String |]
, defaultField [| [] |] $ simpleField "members" [t| [String] |]
, simpleField "ndparams" [t| PartialNDParams |]
- , simpleField "alloc_policy" [t| AllocPolicy |]
+ , simpleField "alloc_policy" [t| AllocPolicy |]
+ , simpleField "ipolicy" [t| PartialIPolicy |]
]
++ timeStampFields
++ uuidFields
@@ -388,6 +453,7 @@ $(buildObject "Cluster" "cluster" $
, simpleField "blacklisted_os" [t| [String] |]
, simpleField "primary_ip_family" [t| IpFamily |]
, simpleField "prealloc_wipe_disks" [t| Bool |]
+ , simpleField "ipolicy" [t| FilledIPolicy |]
]
++ serialFields
++ timeStampFields
--
GitLab