From 4a1dc2bf30073cc265af09e46e5929ed536dcb04 Mon Sep 17 00:00:00 2001
From: Iustin Pop <iustin@google.com>
Date: Mon, 20 Aug 2012 19:13:15 +0200
Subject: [PATCH] Create a custom type for disk indices
While (again) trying to test Python/Haskell encoding interoperability,
I found another bug: the disk index is declared in Python as
ht.TPositiveInt, but in Haskell just as Int, so it can take negative
values too. Clearly we can do better, so let's add a wrapper type that
protects creation of invalid indices via a smart constructor
(http://www.haskell.org/haskellwiki/Smart_constructors, the runtime
checking variant).
This means that outside of OpCodes.hs, it's not possible to load
invalid values, and this also applies to de-serialisation from JSON
data.
Signed-off-by: Iustin Pop <iustin@google.com>
Reviewed-by: Agata Murawska <agatamurawska@google.com>
---
htools/Ganeti/HTools/QC.hs | 3 +++
htools/Ganeti/OpCodes.hs | 21 ++++++++++++++++++++-
2 files changed, 23 insertions(+), 1 deletion(-)
diff --git a/htools/Ganeti/HTools/QC.hs b/htools/Ganeti/HTools/QC.hs
index 6df169231..a440e15d5 100644
--- a/htools/Ganeti/HTools/QC.hs
+++ b/htools/Ganeti/HTools/QC.hs
@@ -461,6 +461,9 @@ instance Arbitrary Node.Node where
instance Arbitrary OpCodes.ReplaceDisksMode where
arbitrary = elements [minBound..maxBound]
+instance Arbitrary OpCodes.DiskIndex where
+ arbitrary = choose (0, C.maxDisks - 1) >>= OpCodes.mkDiskIndex
+
instance Arbitrary OpCodes.OpCode where
arbitrary = do
op_id <- elements OpCodes.allOpIDs
diff --git a/htools/Ganeti/OpCodes.hs b/htools/Ganeti/OpCodes.hs
index bda66a17e..6c6e45e36 100644
--- a/htools/Ganeti/OpCodes.hs
+++ b/htools/Ganeti/OpCodes.hs
@@ -28,6 +28,9 @@ Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
module Ganeti.OpCodes
( OpCode(..)
, ReplaceDisksMode(..)
+ , DiskIndex
+ , mkDiskIndex
+ , unDiskIndex
, opID
, allOpIDs
) where
@@ -48,6 +51,22 @@ $(declareSADT "ReplaceDisksMode"
])
$(makeJSONInstance ''ReplaceDisksMode)
+-- | Disk index type (embedding constraints on the index value via a
+-- smart constructor).
+newtype DiskIndex = DiskIndex { unDiskIndex :: Int }
+ deriving (Show, Read, Eq, Ord)
+
+-- | Smart constructor for 'DiskIndex'.
+mkDiskIndex :: (Monad m) => Int -> m DiskIndex
+mkDiskIndex i | i >= 0 && i < C.maxDisks = return (DiskIndex i)
+ | otherwise = fail $ "Invalid value for disk index '" ++
+ show i ++ "', required between 0 and " ++
+ show C.maxDisks
+
+instance JSON DiskIndex where
+ readJSON v = readJSON v >>= mkDiskIndex
+ showJSON = showJSON . unDiskIndex
+
-- | OpCode representation.
--
-- We only implement a subset of Ganeti opcodes, but only what we
@@ -62,7 +81,7 @@ $(genOpCode "OpCode"
[ simpleField "instance_name" [t| String |]
, optionalField $ simpleField "remote_node" [t| String |]
, simpleField "mode" [t| ReplaceDisksMode |]
- , simpleField "disks" [t| [Int] |]
+ , simpleField "disks" [t| [DiskIndex] |]
, optionalField $ simpleField "iallocator" [t| String |]
])
, ("OpInstanceFailover",
--
GitLab