content: {-# LANGUAGE TemplateHaskell #-}
  {-# OPTIONS_GHC -fno-warn-orphans #-}
  
  {-| Unittests for 'Ganeti.Types'.
  
  -}
  
  {-
  
  Copyright (C) 2012, 2013 Google Inc.
  All rights reserved.
  
  Redistribution and use in source and binary forms, with or without
  modification, are permitted provided that the following conditions are
  met:
  
  1. Redistributions of source code must retain the above copyright notice,
  this list of conditions and the following disclaimer.
  
  2. Redistributions in binary form must reproduce the above copyright
  notice, this list of conditions and the following disclaimer in the
  documentation and/or other materials provided with the distribution.
  
  THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
  IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
  TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
  PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR
  CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
  EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
  PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
  PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
  LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
  NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
  SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
  
  -}
  
  module Test.Ganeti.Types
    ( testTypes
    , AllocPolicy(..)
    , DiskTemplate(..)
    , allDiskTemplates
    , InstanceStatus(..)
    , NonEmpty(..)
    , Hypervisor(..)
    , JobId(..)
    , genReasonTrail
    ) where
  
  import System.Time (ClockTime(..))
  
  import Test.QuickCheck as QuickCheck hiding (Result)
  import Test.HUnit
  import qualified Text.JSON as J
  
  import Test.Ganeti.TestHelper
  import Test.Ganeti.TestCommon
  
  import Ganeti.BasicTypes
  import qualified Ganeti.Constants as C
  import qualified Ganeti.ConstantUtils as ConstantUtils
  import Ganeti.Types as Types
  import Ganeti.JSON
  
  {-# ANN module "HLint: ignore Use camelCase" #-}
  
  -- * Arbitrary instance
  
  instance Arbitrary ClockTime where
    arbitrary = TOD <$> arbitrary <*> fmap (`mod` (10^(12::Int))) arbitrary
  
  instance (Arbitrary a, Ord a, Num a, Show a) =>
    Arbitrary (Types.Positive a) where
    arbitrary = do
      (QuickCheck.Positive i) <- arbitrary
      Types.mkPositive i
  
  instance (Arbitrary a, Ord a, Num a, Show a) =>
    Arbitrary (Types.NonNegative a) where
    arbitrary = do
      (QuickCheck.NonNegative i) <- arbitrary
      Types.mkNonNegative i
  
  instance (Arbitrary a, Ord a, Num a, Show a) =>
    Arbitrary (Types.Negative a) where
    arbitrary = do
      (QuickCheck.Positive i) <- arbitrary
      Types.mkNegative $ negate i
  
  instance (Arbitrary a) => Arbitrary (Types.NonEmpty a) where
    arbitrary = do
      QuickCheck.NonEmpty lst <- arbitrary
      Types.mkNonEmpty lst
  
  $(genArbitrary ''AllocPolicy)
  
  -- | Valid disk templates (depending on configure options).
  allDiskTemplates :: [DiskTemplate]
  allDiskTemplates = [minBound..maxBound]::[DiskTemplate]
  
  -- | Custom 'Arbitrary' instance for 'DiskTemplate', which needs to
  -- handle the case of file storage being disabled at configure time.
  instance Arbitrary DiskTemplate where
    arbitrary = elements allDiskTemplates
  
  $(genArbitrary ''InstanceStatus)
  
  $(genArbitrary ''MigrationMode)
  
  $(genArbitrary ''VerifyOptionalChecks)
  
  $(genArbitrary ''DdmSimple)
  
  $(genArbitrary ''DdmFull)
  
  $(genArbitrary ''CVErrorCode)
  
  $(genArbitrary ''Hypervisor)
  
  $(genArbitrary ''TagKind)
  
  $(genArbitrary ''OobCommand)
  
  -- | Valid storage types.
  allStorageTypes :: [StorageType]
  allStorageTypes = [minBound..maxBound]::[StorageType]
  
  -- | Custom 'Arbitrary' instance for 'StorageType', which needs to
  -- handle the case of file storage being disabled at configure time.
  instance Arbitrary StorageType where
    arbitrary = elements allStorageTypes
  
  $(genArbitrary ''EvacMode)
  
  $(genArbitrary ''FileDriver)
  
  $(genArbitrary ''InstCreateMode)
  
  $(genArbitrary ''RebootType)
  
  $(genArbitrary ''ExportMode)
  
  $(genArbitrary ''IAllocatorTestDir)
  
  $(genArbitrary ''IAllocatorMode)
  
  $(genArbitrary ''NICMode)
  
  $(genArbitrary ''JobStatus)
  
  $(genArbitrary ''FinalizedJobStatus)
  
  instance Arbitrary JobId where
    arbitrary = do
      (Positive i) <- arbitrary
      makeJobId i
  
  $(genArbitrary ''JobIdDep)
  
  $(genArbitrary ''JobDependency)
  
  $(genArbitrary ''OpSubmitPriority)
  
  $(genArbitrary ''OpStatus)
  
  $(genArbitrary ''ELogType)
  
  -- | Generates one element of a reason trail
  genReasonElem :: Gen ReasonElem
  genReasonElem = (,,) <$> genFQDN <*> genFQDN <*> arbitrary
  
  -- | Generates a reason trail
  genReasonTrail :: Gen ReasonTrail
  genReasonTrail = do
    size <- choose (0, 10)
    vectorOf size genReasonElem
  
  -- * Properties
  
  prop_AllocPolicy_serialisation :: AllocPolicy -> Property
  prop_AllocPolicy_serialisation = testSerialisation
  
  -- | Test 'AllocPolicy' ordering is as expected.
  case_AllocPolicy_order :: Assertion
  case_AllocPolicy_order =
    assertEqual "sort order" [ Types.AllocPreferred
                             , Types.AllocLastResort
                             , Types.AllocUnallocable
                             ] [minBound..maxBound]
  
  prop_DiskTemplate_serialisation :: DiskTemplate -> Property
  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 negative numbers.
  prop_Neg_pass :: QuickCheck.Positive Int -> Property
  prop_Neg_pass (QuickCheck.Positive i) =
    case mkNegative i' of
      Bad msg -> failTest $ "Fail to build negative: " ++ msg
      Ok nn -> fromNegative nn ==? i'
    where i' = negate i
  
  -- | Tests building negative numbers.
  prop_Neg_fail :: QuickCheck.NonNegative Int -> Property
  prop_Neg_fail (QuickCheck.NonNegative i) =
    case mkNegative i::Result (Types.Negative Int) of
      Bad _ -> passTest
      Ok nn -> failTest $ "Built negative number '" ++ show nn ++
               "' from non-negative value " ++ show i
  
  -- | Tests building non-empty lists.
  prop_NonEmpty_pass :: QuickCheck.NonEmptyList String -> 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 =
    assertEqual "building non-empty list from an empty list"
      (Bad "Received empty value for non-empty list") (mkNonEmpty ([]::[Int]))
  
  -- | Tests migration mode serialisation.
  prop_MigrationMode_serialisation :: MigrationMode -> Property
  prop_MigrationMode_serialisation = testSerialisation
  
  -- | Tests verify optional checks serialisation.
  prop_VerifyOptionalChecks_serialisation :: VerifyOptionalChecks -> Property
  prop_VerifyOptionalChecks_serialisation = testSerialisation
  
  -- | Tests 'DdmSimple' serialisation.
  prop_DdmSimple_serialisation :: DdmSimple -> Property
  prop_DdmSimple_serialisation = testSerialisation
  
  -- | Tests 'DdmFull' serialisation.
  prop_DdmFull_serialisation :: DdmFull -> Property
  prop_DdmFull_serialisation = testSerialisation
  
  -- | Tests 'CVErrorCode' serialisation.
  prop_CVErrorCode_serialisation :: CVErrorCode -> Property
  prop_CVErrorCode_serialisation = testSerialisation
  
  -- | Tests equivalence with Python, based on Constants.hs code.
  case_CVErrorCode_pyequiv :: Assertion
  case_CVErrorCode_pyequiv = do
    let all_py_codes = C.cvAllEcodesStrings
        all_hs_codes = ConstantUtils.mkSet $
                       map Types.cVErrorCodeToRaw [minBound..maxBound]
    assertEqual "for CVErrorCode equivalence" all_py_codes all_hs_codes
  
  -- | Test 'Hypervisor' serialisation.
  prop_Hypervisor_serialisation :: Hypervisor -> Property
  prop_Hypervisor_serialisation = testSerialisation
  
  -- | Test 'OobCommand' serialisation.
  prop_OobCommand_serialisation :: OobCommand -> Property
  prop_OobCommand_serialisation = testSerialisation
  
  -- | Test 'StorageType' serialisation.
  prop_StorageType_serialisation :: StorageType -> Property
  prop_StorageType_serialisation = testSerialisation
  
  -- | Test 'NodeEvacMode' serialisation.
  prop_NodeEvacMode_serialisation :: EvacMode -> Property
  prop_NodeEvacMode_serialisation = testSerialisation
  
  -- | Test 'FileDriver' serialisation.
  prop_FileDriver_serialisation :: FileDriver -> Property
  prop_FileDriver_serialisation = testSerialisation
  
  -- | Test 'InstCreate' serialisation.
  prop_InstCreateMode_serialisation :: InstCreateMode -> Property
  prop_InstCreateMode_serialisation = testSerialisation
  
  -- | Test 'RebootType' serialisation.
  prop_RebootType_serialisation :: RebootType -> Property
  prop_RebootType_serialisation = testSerialisation
  
  -- | Test 'ExportMode' serialisation.
  prop_ExportMode_serialisation :: ExportMode -> Property
  prop_ExportMode_serialisation = testSerialisation
  
  -- | Test 'IAllocatorTestDir' serialisation.
  prop_IAllocatorTestDir_serialisation :: IAllocatorTestDir -> Property
  prop_IAllocatorTestDir_serialisation = testSerialisation
  
  -- | Test 'IAllocatorMode' serialisation.
  prop_IAllocatorMode_serialisation :: IAllocatorMode -> Property
  prop_IAllocatorMode_serialisation = testSerialisation
  
  -- | Tests equivalence with Python, based on Constants.hs code.
  case_IAllocatorMode_pyequiv :: Assertion
  case_IAllocatorMode_pyequiv = do
    let all_py_codes = C.validIallocatorModes
        all_hs_codes = ConstantUtils.mkSet $
                       map Types.iAllocatorModeToRaw [minBound..maxBound]
    assertEqual "for IAllocatorMode equivalence" all_py_codes all_hs_codes
  
  -- | Test 'NICMode' serialisation.
  prop_NICMode_serialisation :: NICMode -> Property
  prop_NICMode_serialisation = testSerialisation
  
  -- | Test 'OpStatus' serialisation.
  prop_OpStatus_serialization :: OpStatus -> Property
  prop_OpStatus_serialization = testSerialisation
  
  -- | Test 'JobStatus' serialisation.
  prop_JobStatus_serialization :: JobStatus -> Property
  prop_JobStatus_serialization = testSerialisation
  
  -- | Test 'JobStatus' ordering is as expected.
  case_JobStatus_order :: Assertion
  case_JobStatus_order =
    assertEqual "sort order" [ Types.JOB_STATUS_QUEUED
                             , Types.JOB_STATUS_WAITING
                             , Types.JOB_STATUS_CANCELING
                             , Types.JOB_STATUS_RUNNING
                             , Types.JOB_STATUS_CANCELED
                             , Types.JOB_STATUS_SUCCESS
                             , Types.JOB_STATUS_ERROR
                             ] [minBound..maxBound]
  
  -- | Tests equivalence with Python, based on Constants.hs code.
  case_NICMode_pyequiv :: Assertion
  case_NICMode_pyequiv = do
    let all_py_codes = C.nicValidModes
        all_hs_codes = ConstantUtils.mkSet $
                       map Types.nICModeToRaw [minBound..maxBound]
    assertEqual "for NICMode equivalence" all_py_codes all_hs_codes
  
  -- | Test 'FinalizedJobStatus' serialisation.
  prop_FinalizedJobStatus_serialisation :: FinalizedJobStatus -> Property
  prop_FinalizedJobStatus_serialisation = testSerialisation
  
  -- | Tests equivalence with Python, based on Constants.hs code.
  case_FinalizedJobStatus_pyequiv :: Assertion
  case_FinalizedJobStatus_pyequiv = do
    let all_py_codes = C.jobsFinalized
        all_hs_codes = ConstantUtils.mkSet $
                       map Types.finalizedJobStatusToRaw [minBound..maxBound]
    assertEqual "for FinalizedJobStatus equivalence" all_py_codes all_hs_codes
  
  -- | Tests JobId serialisation (both from string and ints).
  prop_JobId_serialisation :: JobId -> Property
  prop_JobId_serialisation jid =
    conjoin [ testSerialisation jid
            , (J.readJSON . J.showJSON . show $ fromJobId jid) ==? J.Ok jid
            , case (fromJVal . J.showJSON . negate $
                    fromJobId jid)::Result JobId of
                Bad _ -> passTest
                Ok jid' -> failTest $ "Parsed negative job id as id " ++
                           show (fromJobId jid')
            ]
  
  -- | Tests that fractional job IDs are not accepted.
  prop_JobId_fractional :: Property
  prop_JobId_fractional =
    forAll (arbitrary `suchThat`
            (\d -> fromIntegral (truncate d::Int) /= d)) $ \d ->
    case J.readJSON (J.showJSON (d::Double)) of
      J.Error _ -> passTest
      J.Ok jid -> failTest $ "Parsed fractional value " ++ show d ++
                  " as job id " ++ show (fromJobId jid)
  
  -- | Tests that a job ID is not parseable from \"bad\" JSON values.
  case_JobId_BadTypes :: Assertion
  case_JobId_BadTypes = do
    let helper jsval = case J.readJSON jsval of
                         J.Error _ -> return ()
                         J.Ok jid -> assertFailure $ "Parsed " ++ show jsval
                                     ++ " as job id " ++ show (fromJobId jid)
    helper J.JSNull
    helper (J.JSBool True)
    helper (J.JSBool False)
    helper (J.JSArray [])
  
  -- | Test 'JobDependency' serialisation.
  prop_JobDependency_serialisation :: JobDependency -> Property
  prop_JobDependency_serialisation = testSerialisation
  
  -- | Test 'OpSubmitPriority' serialisation.
  prop_OpSubmitPriority_serialisation :: OpSubmitPriority -> Property
  prop_OpSubmitPriority_serialisation = testSerialisation
  
  -- | Tests string formatting for 'OpSubmitPriority'.
  prop_OpSubmitPriority_string :: OpSubmitPriority -> Property
  prop_OpSubmitPriority_string prio =
    parseSubmitPriority (fmtSubmitPriority prio) ==? Just prio
  
  -- | Test 'ELogType' serialisation.
  prop_ELogType_serialisation :: ELogType -> Property
  prop_ELogType_serialisation = testSerialisation
  
  testSuite "Types"
    [ 'prop_AllocPolicy_serialisation
    , 'case_AllocPolicy_order
    , 'prop_DiskTemplate_serialisation
    , 'prop_InstanceStatus_serialisation
    , 'prop_NonNeg_pass
    , 'prop_NonNeg_fail
    , 'prop_Positive_pass
    , 'prop_Positive_fail
    , 'prop_Neg_pass
    , 'prop_Neg_fail
    , 'prop_NonEmpty_pass
    , 'case_NonEmpty_fail
    , 'prop_MigrationMode_serialisation
    , 'prop_VerifyOptionalChecks_serialisation
    , 'prop_DdmSimple_serialisation
    , 'prop_DdmFull_serialisation
    , 'prop_CVErrorCode_serialisation
    , 'case_CVErrorCode_pyequiv
    , 'prop_Hypervisor_serialisation
    , 'prop_OobCommand_serialisation
    , 'prop_StorageType_serialisation
    , 'prop_NodeEvacMode_serialisation
    , 'prop_FileDriver_serialisation
    , 'prop_InstCreateMode_serialisation
    , 'prop_RebootType_serialisation
    , 'prop_ExportMode_serialisation
    , 'prop_IAllocatorTestDir_serialisation
    , 'prop_IAllocatorMode_serialisation
    , 'case_IAllocatorMode_pyequiv
    , 'prop_NICMode_serialisation
    , 'prop_OpStatus_serialization
    , 'prop_JobStatus_serialization
    , 'case_JobStatus_order
    , 'case_NICMode_pyequiv
    , 'prop_FinalizedJobStatus_serialisation
    , 'case_FinalizedJobStatus_pyequiv
    , 'prop_JobId_serialisation
    , 'prop_JobId_fractional
    , 'case_JobId_BadTypes
    , 'prop_JobDependency_serialisation
    , 'prop_OpSubmitPriority_serialisation
    , 'prop_OpSubmitPriority_string
    , 'prop_ELogType_serialisation
    ]
  