Synnefo » snf-ganeti » ganeti-local

import Control.Arrow (second)

import Text.JSON

import Ganeti.Query.Language

-- | Custom 'Filter' generator (top-level), which enforces a

genFilter :: Gen (Filter FilterField)

genFilter' :: Int -> Gen (Filter FilterField)

  oneof [ pure EmptyFilter

        , TrueFilter     <$> getName

        , EQFilter       <$> getName <*> value

        , LTFilter       <$> getName <*> value

        , GTFilter       <$> getName <*> value

        , LEFilter       <$> getName <*> value

        , GEFilter       <$> getName <*> value

        , RegexpFilter   <$> getName <*> arbitrary

        , ContainsFilter <$> getName <*> value

    where value = oneof [ QuotedString <$> getName

                        , NumericValue <$> arbitrary

  oneof [ AndFilter  <$> vectorOf n'' (genFilter' n')

        , OrFilter   <$> vectorOf n'' (genFilter' n')

        , NotFilter  <$> genFilter' n'

$(genArbitrary ''ItemType)

instance Arbitrary FilterRegex where

  arbitrary = getName >>= mkRegex -- a name should be a good regex

$(genArbitrary ''ResultStatus)

$(genArbitrary ''FieldType)

$(genArbitrary ''FieldDefinition)

-- | Generates an arbitrary JSValue. We do this via a function a not

-- via arbitrary instance since that would require us to define an

-- arbitrary for JSValue, which can be recursive, entering the usual

-- problems with that; so we only generate the base types, not the

-- recursive ones, and not 'JSNull', which we can't use in a

-- 'RSNormal' 'ResultEntry'.

genJSValue :: Gen JSValue

genJSValue = do

  oneof [ JSBool <$> arbitrary

        , JSRational <$> pure False <*> arbitrary

        , JSString <$> (toJSString <$> arbitrary)

        , (JSArray . map showJSON) <$> (arbitrary::Gen [Int])

        , JSObject . toJSObject . map (second showJSON) <$>

          (arbitrary::Gen [(String, Int)])

        ]

-- | Generates a 'ResultEntry' value.

genResultEntry :: Gen ResultEntry

genResultEntry = do

  rs <- arbitrary

  rv <- case rs of

          RSNormal -> Just <$> genJSValue

          _ -> pure Nothing

  return $ ResultEntry rs rv

$(genArbitrary ''QueryFieldsResult)

prop_filter_serialisation :: Property

prop_filter_serialisation = forAll genFilter testSerialisation

-- | Tests that filter regexes are serialised correctly.

prop_filterregex_instances :: FilterRegex -> Property

prop_filterregex_instances rex =

-- | Tests 'ResultStatus' serialisation.

prop_resultstatus_serialisation :: ResultStatus -> Property

prop_resultstatus_serialisation = testSerialisation

-- | Tests 'FieldType' serialisation.

prop_fieldtype_serialisation :: FieldType -> Property

prop_fieldtype_serialisation = testSerialisation

-- | Tests 'FieldDef' serialisation.

prop_fielddef_serialisation :: FieldDefinition -> Property

prop_fielddef_serialisation = testSerialisation

-- | Tests 'ResultEntry' serialisation. Needed especially as this is

-- done manually, and not via buildObject (different serialisation

-- format).

prop_resultentry_serialisation :: Property

prop_resultentry_serialisation = forAll genResultEntry testSerialisation

-- | Tests 'FieldDef' serialisation. We use a made-up maximum limit of

-- 20 for the generator, since otherwise the lists become too long and

-- we don't care so much about list length but rather structure.

prop_fieldsresult_serialisation :: Property

prop_fieldsresult_serialisation =

  forAll (resize 20 arbitrary::Gen QueryFieldsResult) testSerialisation

  [ 'prop_filter_serialisation

  , 'prop_filterregex_instances

  , 'prop_resultstatus_serialisation

  , 'prop_fieldtype_serialisation

  , 'prop_fielddef_serialisation

  , 'prop_resultentry_serialisation

  , 'prop_fieldsresult_serialisation