{-# 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 = 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 = forall (m :: * -> *). MonadGen m => Range Int32 -> m Int32
Gen.int32 forall a. (Bounded a, Integral a) => Range a
Range.exponentialBounded

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

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

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

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

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

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