{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell #-}

module Test.Cardano.Ledger.Binary.Vintage.Drop (tests) where

import Cardano.Ledger.Binary
import Data.ByteString (ByteString)
import Data.Int (Int32)
import Data.Word (Word64, Word8)
import Hedgehog
import qualified Hedgehog.Gen as Gen
import qualified Hedgehog.Range as Range

tests :: IO Bool
tests :: IO Bool
tests = Group -> IO Bool
forall (m :: * -> *). MonadIO m => Group -> m Bool
checkParallel $$(discover)

------------------------------------------------------------------------------
-- Properties testing whether dropping elements actully removes it or not

genInt32 :: Gen Int32
genInt32 :: Gen Int32
genInt32 = Range Int32 -> Gen Int32
forall (m :: * -> *). MonadGen m => Range Int32 -> m Int32
Gen.int32 Range Int32
forall a. (Bounded a, Integral a) => Range a
Range.exponentialBounded

genBytes :: Gen ByteString
genBytes :: Gen ByteString
genBytes = Range Int -> Gen ByteString
forall (m :: * -> *). MonadGen m => Range Int -> m ByteString
Gen.bytes (Int -> Int -> Range Int
forall a. Integral a => a -> a -> Range a
Range.linear Int
0 Int
1000)

genWord8 :: Gen Word8
genWord8 :: Gen Word8
genWord8 = Range Word8 -> Gen Word8
forall (m :: * -> *). MonadGen m => Range Word8 -> m Word8
Gen.word8 Range Word8
forall a. (Bounded a, Integral a) => Range a
Range.exponentialBounded

genWord64 :: Gen Word64
genWord64 :: Gen Word64
genWord64 = Range Word64 -> Gen Word64
forall (m :: * -> *). MonadGen m => Range Word64 -> m Word64
Gen.word64 Range Word64
forall a. (Bounded a, Integral a) => Range a
Range.exponentialBounded

prop_dropMap :: Property
prop_dropMap :: Property
prop_dropMap = HasCallStack => PropertyT IO () -> Property
PropertyT IO () -> Property
property (PropertyT IO () -> Property) -> PropertyT IO () -> Property
forall a b. (a -> b) -> a -> b
$ do
  mp <-
    Gen (Map Int32 [Word8]) -> PropertyT IO (Map Int32 [Word8])
forall (m :: * -> *) a.
(Monad m, Show a, HasCallStack) =>
Gen a -> PropertyT m a
forAll (Gen (Map Int32 [Word8]) -> PropertyT IO (Map Int32 [Word8]))
-> Gen (Map Int32 [Word8]) -> PropertyT IO (Map Int32 [Word8])
forall a b. (a -> b) -> a -> b
$
      Range Int
-> GenT Identity (Int32, [Word8]) -> Gen (Map Int32 [Word8])
forall (m :: * -> *) k v.
(MonadGen m, Ord k) =>
Range Int -> m (k, v) -> m (Map k v)
Gen.map
        (Int -> Int -> Range Int
forall a. a -> a -> Range a
Range.constant Int
0 Int
10)
        ( (,)
            (Int32 -> [Word8] -> (Int32, [Word8]))
-> Gen Int32 -> GenT Identity ([Word8] -> (Int32, [Word8]))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Int32
genInt32
            GenT Identity ([Word8] -> (Int32, [Word8]))
-> GenT Identity [Word8] -> GenT Identity (Int32, [Word8])
forall a b.
GenT Identity (a -> b) -> GenT Identity a -> GenT Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Range Int -> Gen Word8 -> GenT Identity [Word8]
forall (m :: * -> *) a. MonadGen m => Range Int -> m a -> m [a]
Gen.list (Int -> Int -> Range Int
forall a. a -> a -> Range a
Range.constant Int
0 Int
10) Gen Word8
genWord8
        )
  let encodedBs = Version -> Map Int32 [Word8] -> ByteString
forall a. EncCBOR a => Version -> a -> ByteString
serialize Version
byronProtVer Map Int32 [Word8]
mp
  decodeFull byronProtVer encodedBs === Right mp
  decodeFullDecoder
    byronProtVer
    "Drop Test Failed"
    (dropMap dropInt32 (dropList dropWord8))
    encodedBs
    === Right ()

prop_dropTuple :: Property
prop_dropTuple :: Property
prop_dropTuple = HasCallStack => PropertyT IO () -> Property
PropertyT IO () -> Property
property (PropertyT IO () -> Property) -> PropertyT IO () -> Property
forall a b. (a -> b) -> a -> b
$ do
  (set, bs) <-
    Gen (Set Int32, ByteString) -> PropertyT IO (Set Int32, ByteString)
forall (m :: * -> *) a.
(Monad m, Show a, HasCallStack) =>
Gen a -> PropertyT m a
forAll (Gen (Set Int32, ByteString)
 -> PropertyT IO (Set Int32, ByteString))
-> Gen (Set Int32, ByteString)
-> PropertyT IO (Set Int32, ByteString)
forall a b. (a -> b) -> a -> b
$
      (,)
        (Set Int32 -> ByteString -> (Set Int32, ByteString))
-> GenT Identity (Set Int32)
-> GenT Identity (ByteString -> (Set Int32, ByteString))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Range Int -> Gen Int32 -> GenT Identity (Set Int32)
forall (m :: * -> *) a.
(MonadGen m, Ord a) =>
Range Int -> m a -> m (Set a)
Gen.set (Int -> Int -> Range Int
forall a. a -> a -> Range a
Range.constant Int
0 Int
10) Gen Int32
genInt32
        GenT Identity (ByteString -> (Set Int32, ByteString))
-> Gen ByteString -> Gen (Set Int32, ByteString)
forall a b.
GenT Identity (a -> b) -> GenT Identity a -> GenT Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen ByteString
genBytes
  let encodedBs = Version -> (Set Int32, ByteString) -> ByteString
forall a. EncCBOR a => Version -> a -> ByteString
serialize Version
byronProtVer (Set Int32
set, ByteString
bs)
  decodeFull byronProtVer encodedBs === Right (set, bs)
  decodeFullDecoder
    byronProtVer
    "Drop Test Failed"
    (dropTuple (dropSet dropInt32) dropBytes)
    encodedBs
    === Right ()

prop_dropTriple :: Property
prop_dropTriple :: Property
prop_dropTriple = HasCallStack => PropertyT IO () -> Property
PropertyT IO () -> Property
property (PropertyT IO () -> Property) -> PropertyT IO () -> Property
forall a b. (a -> b) -> a -> b
$ do
  tri <- Gen (Int32, Word8, Word64) -> PropertyT IO (Int32, Word8, Word64)
forall (m :: * -> *) a.
(Monad m, Show a, HasCallStack) =>
Gen a -> PropertyT m a
forAll (Gen (Int32, Word8, Word64) -> PropertyT IO (Int32, Word8, Word64))
-> Gen (Int32, Word8, Word64)
-> PropertyT IO (Int32, Word8, Word64)
forall a b. (a -> b) -> a -> b
$ (,,) (Int32 -> Word8 -> Word64 -> (Int32, Word8, Word64))
-> Gen Int32
-> GenT Identity (Word8 -> Word64 -> (Int32, Word8, Word64))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Int32
genInt32 GenT Identity (Word8 -> Word64 -> (Int32, Word8, Word64))
-> Gen Word8 -> GenT Identity (Word64 -> (Int32, Word8, Word64))
forall a b.
GenT Identity (a -> b) -> GenT Identity a -> GenT Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen Word8
genWord8 GenT Identity (Word64 -> (Int32, Word8, Word64))
-> Gen Word64 -> Gen (Int32, Word8, Word64)
forall a b.
GenT Identity (a -> b) -> GenT Identity a -> GenT Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen Word64
genWord64
  let encodedBs = Version -> (Int32, Word8, Word64) -> ByteString
forall a. EncCBOR a => Version -> a -> ByteString
serialize Version
byronProtVer (Int32, Word8, Word64)
tri
  decodeFull byronProtVer encodedBs === Right tri
  decodeFullDecoder
    byronProtVer
    "Drop Test Failed"
    (dropTriple dropInt32 dropWord8 dropWord64)
    encodedBs
    === Right ()