{-# LANGUAGE CPP #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE RankNTypes #-} module Tests.Canonical (testTree) where import Prelude hiding (decodeFloat, encodeFloat) #if !MIN_VERSION_base(4,8,0) import Control.Applicative #endif import qualified Data.ByteString.Lazy as LBS import Data.Proxy import Codec.CBOR.Read (deserialiseFromBytes) import Codec.CBOR.Decoding import Test.Tasty (TestTree, testGroup) import Test.Tasty.QuickCheck (testProperty) import Test.QuickCheck import Tests.Properties hiding (testTree) -- | This is a version of 'prop_decodeRefdecodeImp' but where we restrict the -- encoded input to non-canonical forms. These forms are covered by the -- original property. This property just ensures that we have good coverage of -- this case. -- prop_decode_nonCanonical :: forall t. Token t => t -> Property prop_decode_nonCanonical x = let enc = serialiseRef x y = deserialiseRef t enc y' = deserialiseImp t enc enc' = serialiseImp t y' isCanonical = enc == enc' in not isCanonical ==> -- This property holds without this pre-condition, as demonstrated by -- prop_decodeRefdecodeImp, but using it ensures we get good coverage -- of the non-canonical cases y' `eq` fromRef y where eq = eqImp t t = Proxy :: Proxy t -- | Check that the special checked canonical form decoder primitives work. -- -- We decode with the normal and canonical decoder, and check that they agree -- in the canonical cases, and that the canonical decoder rejects the -- non-canonical cases. -- -- We have a QC coverage check to make sure we are covering enough of both -- canonical and non-canonical cases. -- prop_decodeCanonical :: forall t. Token t => (forall s. Decoder s (Imp t)) -> t -> Property prop_decodeCanonical decodeCanonical x = classify isCanonical "canonical" $ case deserialiseFromBytes decodeCanonical enc of Left _failure -> not isCanonical Right (trailing, y') -> isCanonical && eqImp t y y' && LBS.null trailing where enc = serialiseRef x y = deserialiseImp t enc -- It is canonical if it re-encodes to the same bytes we decoded isCanonical = serialiseImp t y == enc t = Proxy :: Proxy t prop_decodeCanonical_Word :: TokWord -> Property prop_decodeCanonical_Word = prop_decodeCanonical decodeWordCanonical prop_decodeCanonical_Word8 :: TokWord8 -> Property prop_decodeCanonical_Word8 = prop_decodeCanonical decodeWord8Canonical prop_decodeCanonical_Word16 :: TokWord16 -> Property prop_decodeCanonical_Word16 = prop_decodeCanonical decodeWord16Canonical prop_decodeCanonical_Word32 :: TokWord32 -> Property prop_decodeCanonical_Word32 = prop_decodeCanonical decodeWord32Canonical prop_decodeCanonical_Word64 :: TokWord64 -> Property prop_decodeCanonical_Word64 = prop_decodeCanonical decodeWord64Canonical --prop_decodeCanonical_NegWord :: TokNegWord -> Property --prop_decodeCanonical_NegWord = prop_decodeCanonical decodeNegWordCanonical prop_decodeCanonical_Int :: TokInt -> Property prop_decodeCanonical_Int = prop_decodeCanonical decodeIntCanonical prop_decodeCanonical_Int8 :: TokInt8 -> Property prop_decodeCanonical_Int8 = prop_decodeCanonical decodeInt8Canonical prop_decodeCanonical_Int16 :: TokInt16 -> Property prop_decodeCanonical_Int16 = prop_decodeCanonical decodeInt16Canonical prop_decodeCanonical_Int32 :: TokInt32 -> Property prop_decodeCanonical_Int32 = prop_decodeCanonical decodeInt32Canonical prop_decodeCanonical_Int64 :: TokInt64 -> Property prop_decodeCanonical_Int64 = prop_decodeCanonical decodeInt64Canonical prop_decodeCanonical_Integer :: TokInteger -> Property prop_decodeCanonical_Integer = prop_decodeCanonical decodeIntegerCanonical prop_decodeCanonical_Half :: TokHalf -> Property prop_decodeCanonical_Half = prop_decodeCanonical decodeFloat16Canonical prop_decodeCanonical_Float :: TokFloat -> Property prop_decodeCanonical_Float = prop_decodeCanonical decodeFloatCanonical prop_decodeCanonical_Double :: TokDouble -> Property prop_decodeCanonical_Double = prop_decodeCanonical decodeDoubleCanonical prop_decodeCanonical_Tag :: TokTag -> Property prop_decodeCanonical_Tag = prop_decodeCanonical decodeTagCanonical prop_decodeCanonical_Tag64 :: TokTag64 -> Property prop_decodeCanonical_Tag64 = prop_decodeCanonical decodeTag64Canonical prop_decodeCanonical_Simple :: Simple -> Property prop_decodeCanonical_Simple = prop_decodeCanonical decodeSimpleCanonical {- , decodeNegWordCanonical -- :: Decoder s Word , decodeNegWord64Canonical -- :: Decoder s Word64 , decodeBytesCanonical -- :: Decoder s ByteString , decodeByteArrayCanonical -- :: Decoder s ByteArray , decodeStringCanonical -- :: Decoder s Text , decodeUtf8ByteArrayCanonical -- :: Decoder s ByteArray , decodeListLenCanonical -- :: Decoder s Int , decodeMapLenCanonical -- :: Decoder s Int -} -------------------------------------------------------------------------------- -- TestTree API testTree :: TestTree testTree = testGroup "properties" [ testGroup "decode non-canonical encoding" [ testProperty "Word8" (prop_decode_nonCanonical :: TokWord8 -> Property) , testProperty "Word16" (prop_decode_nonCanonical :: TokWord16 -> Property) , testProperty "Word32" (prop_decode_nonCanonical :: TokWord32 -> Property) , testProperty "Word64" (prop_decode_nonCanonical :: TokWord64 -> Property) , testProperty "Word" (prop_decode_nonCanonical :: TokWord -> Property) -- , testProperty "NegWord" (prop_decode_nonCanonical :: TokNegWord -> Property) , testProperty "Int8" (prop_decode_nonCanonical :: TokInt8 -> Property) , testProperty "Int16" (prop_decode_nonCanonical :: TokInt16 -> Property) , testProperty "Int32" (prop_decode_nonCanonical :: TokInt32 -> Property) , testProperty "Int64" (prop_decode_nonCanonical :: TokInt64 -> Property) , testProperty "Int" (prop_decode_nonCanonical :: TokInt -> Property) , testProperty "Integer" (prop_decode_nonCanonical :: TokInteger -> Property) , testProperty "Half" (prop_decode_nonCanonical :: TokHalf -> Property) , testProperty "Float" (prop_decode_nonCanonical :: TokFloat -> Property) , testProperty "Double" (prop_decode_nonCanonical :: TokDouble -> Property) , testProperty "Tag" (prop_decode_nonCanonical :: TokTag -> Property) , testProperty "Tag64" (prop_decode_nonCanonical :: TokTag64 -> Property) , testProperty "Simple" (prop_decode_nonCanonical :: Simple -> Property) , testProperty "Term" (prop_decode_nonCanonical :: Term -> Property) ] , testGroup "canonical decoding" [ testProperty "Word" prop_decodeCanonical_Word , testProperty "Word8" prop_decodeCanonical_Word8 , testProperty "Word16" prop_decodeCanonical_Word16 , testProperty "Word32" prop_decodeCanonical_Word32 , testProperty "Word64" prop_decodeCanonical_Word64 , testProperty "Int" prop_decodeCanonical_Int , testProperty "Int8" prop_decodeCanonical_Int8 , testProperty "Int16" prop_decodeCanonical_Int16 , testProperty "Int32" prop_decodeCanonical_Int32 , testProperty "Int64" prop_decodeCanonical_Int64 , testProperty "Integer" prop_decodeCanonical_Integer , testProperty "Half" prop_decodeCanonical_Half , testProperty "Float" prop_decodeCanonical_Float , testProperty "Double" prop_decodeCanonical_Double , testProperty "Tag" prop_decodeCanonical_Tag , testProperty "Tag64" prop_decodeCanonical_Tag64 , testProperty "Simple" prop_decodeCanonical_Simple ] ]