Commit 4a1dc2bf authored by Iustin Pop's avatar Iustin Pop
Browse files

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: default avatarIustin Pop <iustin@google.com>
Reviewed-by: default avatarAgata Murawska <agatamurawska@google.com>
parent f2f06e2e
......@@ -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
......
......@@ -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",
......
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