diff --git a/htools/Ganeti/HTools/QC.hs b/htools/Ganeti/HTools/QC.hs index 6df169231a589424ba78c8439b43454e7043f569..a440e15d5575bf3dca4a4c65606d667fb65db484 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 bda66a17eb2214350bb7243be2ebadaff9eb5db1..6c6e45e36b31516702f075a05f39a4fbaadcbaf7 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",