Commit edb5a1c8 authored by Iustin Pop's avatar Iustin Pop
Browse files

Add more basic validation types



This mirrors the ht.py types PositiveInt, NonNegative, etc., except
that they work at a more generic level (any numeric type, respectively
any non-empty list).
Signed-off-by: default avatarIustin Pop <iustin@google.com>
Reviewed-by: default avatarAdeodato Simo <dato@google.com>
parent 469a1490
......@@ -31,23 +31,37 @@ module Test.Ganeti.Types
, AllocPolicy(..)
, DiskTemplate(..)
, InstanceStatus(..)
, NonEmpty(..)
) where
import Test.QuickCheck
import Test.QuickCheck as QuickCheck hiding (Result)
import Test.HUnit
import Test.Ganeti.TestHelper
import Test.Ganeti.TestCommon
import Ganeti.Types
import Ganeti.BasicTypes
import Ganeti.Types as Types
-- * Arbitrary instance
instance (Arbitrary a, Ord a, Num a, Show a) =>
Arbitrary (Types.Positive a) where
arbitrary = do
(QuickCheck.Positive i) <- arbitrary
Types.mkPositive i
$(genArbitrary ''AllocPolicy)
$(genArbitrary ''DiskTemplate)
$(genArbitrary ''InstanceStatus)
instance (Arbitrary a) => Arbitrary (Types.NonEmpty a) where
arbitrary = do
QuickCheck.NonEmpty lst <- arbitrary
Types.mkNonEmpty lst
prop_AllocPolicy_serialisation :: AllocPolicy -> Property
prop_AllocPolicy_serialisation = testSerialisation
......@@ -57,8 +71,57 @@ prop_DiskTemplate_serialisation = testSerialisation
prop_InstanceStatus_serialisation :: InstanceStatus -> Property
prop_InstanceStatus_serialisation = testSerialisation
-- | Tests building non-negative numbers.
prop_NonNeg_pass :: QuickCheck.NonNegative Int -> Property
prop_NonNeg_pass (QuickCheck.NonNegative i) =
case mkNonNegative i of
Bad msg -> failTest $ "Fail to build non-negative: " ++ msg
Ok nn -> fromNonNegative nn ==? i
-- | Tests building non-negative numbers.
prop_NonNeg_fail :: QuickCheck.Positive Int -> Property
prop_NonNeg_fail (QuickCheck.Positive i) =
case mkNonNegative (negate i)::Result (Types.NonNegative Int) of
Bad _ -> passTest
Ok nn -> failTest $ "Built non-negative number '" ++ show nn ++
"' from negative value " ++ show i
-- | Tests building positive numbers.
prop_Positive_pass :: QuickCheck.Positive Int -> Property
prop_Positive_pass (QuickCheck.Positive i) =
case mkPositive i of
Bad msg -> failTest $ "Fail to build positive: " ++ msg
Ok nn -> fromPositive nn ==? i
-- | Tests building positive numbers.
prop_Positive_fail :: QuickCheck.NonNegative Int -> Property
prop_Positive_fail (QuickCheck.NonNegative i) =
case mkPositive (negate i)::Result (Types.Positive Int) of
Bad _ -> passTest
Ok nn -> failTest $ "Built positive number '" ++ show nn ++
"' from negative or zero value " ++ show i
-- | Tests building non-empty lists.
prop_NonEmpty_pass :: QuickCheck.NonEmptyList [Char] -> Property
prop_NonEmpty_pass (QuickCheck.NonEmpty xs) =
case mkNonEmpty xs of
Bad msg -> failTest $ "Fail to build non-empty list: " ++ msg
Ok nn -> fromNonEmpty nn ==? xs
-- | Tests building positive numbers.
case_NonEmpty_fail :: Assertion
case_NonEmpty_fail = do
assertEqual "building non-empty list from an empty list"
(Bad "Received empty value for non-empty list") (mkNonEmpty ([]::[Int]))
testSuite "Types"
[ 'prop_AllocPolicy_serialisation
, 'prop_DiskTemplate_serialisation
, 'prop_InstanceStatus_serialisation
, 'prop_NonNeg_pass
, 'prop_NonNeg_fail
, 'prop_Positive_pass
, 'prop_Positive_fail
, 'prop_NonEmpty_pass
, 'case_NonEmpty_fail
]
......@@ -40,11 +40,67 @@ module Ganeti.Types
, DiskTemplate(..)
, diskTemplateToRaw
, diskTemplateFromRaw
, NonNegative
, fromNonNegative
, mkNonNegative
, Positive
, fromPositive
, mkPositive
, NonEmpty
, fromNonEmpty
, mkNonEmpty
) where
import qualified Text.JSON as JSON
import qualified Ganeti.Constants as C
import qualified Ganeti.THH as THH
-- * Generic types
-- | Type that holds a non-negative value.
newtype NonNegative a = NonNegative { fromNonNegative :: a }
deriving (Show, Read, Eq)
-- | Smart constructor for 'NonNegative'.
mkNonNegative :: (Monad m, Num a, Ord a, Show a) => a -> m (NonNegative a)
mkNonNegative i | i >= 0 = return (NonNegative i)
| otherwise = fail $ "Invalid value for non-negative type '" ++
show i ++ "'"
instance (JSON.JSON a, Num a, Ord a, Show a) => JSON.JSON (NonNegative a) where
showJSON = JSON.showJSON . fromNonNegative
readJSON v = JSON.readJSON v >>= mkNonNegative
-- | Type that holds a positive value.
newtype Positive a = Positive { fromPositive :: a }
deriving (Show, Read, Eq)
-- | Smart constructor for 'Positive'.
mkPositive :: (Monad m, Num a, Ord a, Show a) => a -> m (Positive a)
mkPositive i | i > 0 = return (Positive i)
| otherwise = fail $ "Invalid value for positive type '" ++
show i ++ "'"
instance (JSON.JSON a, Num a, Ord a, Show a) => JSON.JSON (Positive a) where
showJSON = JSON.showJSON . fromPositive
readJSON v = JSON.readJSON v >>= mkPositive
-- | Type that holds a non-null list.
newtype NonEmpty a = NonEmpty { fromNonEmpty :: [a] }
deriving (Show, Read, Eq)
-- | Smart constructor for 'NonEmpty'.
mkNonEmpty :: (Monad m) => [a] -> m (NonEmpty a)
mkNonEmpty [] = fail "Received empty value for non-empty list"
mkNonEmpty xs = return (NonEmpty xs)
instance (JSON.JSON a) => JSON.JSON (NonEmpty a) where
showJSON = JSON.showJSON . fromNonEmpty
readJSON v = JSON.readJSON v >>= mkNonEmpty
-- * Ganeti types
-- | Instance disk template type.
$(THH.declareSADT "DiskTemplate"
[ ("DTDiskless", 'C.dtDiskless)
......
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