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

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

import Cardano.Ledger.Binary hiding (Range)
import qualified Data.ByteString as BS
import qualified Data.ByteString.Lazy as BS.Lazy
import qualified Data.ByteString.Short as BS.Short
import Data.Int (Int32, Int64)
import Data.List.NonEmpty (NonEmpty)
import Data.Map (Map)
import Data.Set (Set)
import Data.Text (Text)
import qualified Data.Time as Time
import qualified Data.Vector as V
import Data.Word (Word16, Word32, Word64, Word8)
import Hedgehog
import qualified Hedgehog.Gen as Gen
import Hedgehog.Gen.QuickCheck (arbitrary)
import qualified Hedgehog.Range as Range
import Test.Cardano.Ledger.Binary.Arbitrary ()

{- HLINT ignore "Redundant <$>" -}

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

data TestStruct = TestStruct
  { TestStruct -> ()
tsUnit :: ()
  , TestStruct -> Bool
tsBool :: !Bool
  , TestStruct -> Integer
tsInteger :: !Integer
  , TestStruct -> Word
tsWord :: !Word
  , TestStruct -> Word8
tsWord8 :: !Word8
  , TestStruct -> Word16
tsWord16 :: !Word16
  , TestStruct -> Word32
tsWord32 :: !Word32
  , TestStruct -> Word64
tsWord64 :: !Word64
  , TestStruct -> Int
tsInt :: !Int
  , TestStruct -> Float
tsFloat :: !Float
  , TestStruct -> Int32
tsInt32 :: !Int32
  , TestStruct -> Int64
tsInt64 :: !Int64
  , TestStruct -> (Bool, Bool)
tsTupleBoolBool :: !(Bool, Bool)
  , TestStruct -> (Bool, Bool, Bool)
tsTupleBoolBoolBool :: !(Bool, Bool, Bool)
  , TestStruct -> (Bool, Bool, Bool, Bool)
tsTupleBoolBoolBoolBool :: !(Bool, Bool, Bool, Bool)
  , TestStruct -> ByteString
tsByteString :: !BS.ByteString
  , TestStruct -> Text
tsText :: !Text
  , TestStruct -> [Bool]
tsListBool :: ![Bool]
  , TestStruct -> Either Bool Bool
tsEitherBoolBool :: !(Either Bool Bool)
  , TestStruct -> NonEmpty Bool
tsNonEmptyBool :: !(NonEmpty Bool)
  , TestStruct -> Maybe Bool
tsMaybeBool :: !(Maybe Bool)
  , TestStruct -> Map Bool Bool
tsMapBoolBool :: !(Map Bool Bool)
  , TestStruct -> Set Bool
tsSetBool :: !(Set Bool)
  , TestStruct -> Vector Bool
tsVectorBool :: !(V.Vector Bool)
  , TestStruct -> ByteString
tsLByteString :: BS.Lazy.ByteString
  , TestStruct -> ShortByteString
tsSByteString :: BS.Short.ShortByteString
  , TestStruct -> UTCTime
tsUTCTime :: Time.UTCTime
  }
  deriving (Int -> TestStruct -> ShowS
[TestStruct] -> ShowS
TestStruct -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TestStruct] -> ShowS
$cshowList :: [TestStruct] -> ShowS
show :: TestStruct -> String
$cshow :: TestStruct -> String
showsPrec :: Int -> TestStruct -> ShowS
$cshowsPrec :: Int -> TestStruct -> ShowS
Show, TestStruct -> TestStruct -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TestStruct -> TestStruct -> Bool
$c/= :: TestStruct -> TestStruct -> Bool
== :: TestStruct -> TestStruct -> Bool
$c== :: TestStruct -> TestStruct -> Bool
Eq)

genTestStruct :: Gen TestStruct
genTestStruct :: Gen TestStruct
genTestStruct =
  ()
-> Bool
-> Integer
-> Word
-> Word8
-> Word16
-> Word32
-> Word64
-> Int
-> Float
-> Int32
-> Int64
-> (Bool, Bool)
-> (Bool, Bool, Bool)
-> (Bool, Bool, Bool, Bool)
-> ByteString
-> Text
-> [Bool]
-> Either Bool Bool
-> NonEmpty Bool
-> Maybe Bool
-> Map Bool Bool
-> Set Bool
-> Vector Bool
-> ByteString
-> ShortByteString
-> UTCTime
-> TestStruct
TestStruct
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (m :: * -> *). MonadGen m => m Bool
Gen.bool
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (m :: * -> *) a. (MonadGen m, Integral a) => Range a -> m a
Gen.integral (forall a. Integral a => a -> a -> a -> Range a
Range.linearFrom Integer
0 (-Integer
1e40) Integer
1e40 :: Range Integer)
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (m :: * -> *). MonadGen m => Range Word -> m Word
Gen.word forall a. (Bounded a, Num a) => Range a
Range.constantBounded
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (m :: * -> *). MonadGen m => Range Word8 -> m Word8
Gen.word8 forall a. (Bounded a, Num a) => Range a
Range.constantBounded
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (m :: * -> *). MonadGen m => Range Word16 -> m Word16
Gen.word16 forall a. (Bounded a, Num a) => Range a
Range.constantBounded
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (m :: * -> *). MonadGen m => Range Word32 -> m Word32
Gen.word32 forall a. (Bounded a, Num a) => Range a
Range.constantBounded
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (m :: * -> *). MonadGen m => Range Word64 -> m Word64
Gen.word64 forall a. (Bounded a, Num a) => Range a
Range.constantBounded
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (m :: * -> *). MonadGen m => Range Int -> m Int
Gen.int forall a. (Bounded a, Num a) => Range a
Range.constantBounded
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (m :: * -> *). MonadGen m => Range Float -> m Float
Gen.float (forall a. a -> a -> Range a
Range.constant (-Float
1e12) Float
1e12)
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (m :: * -> *). MonadGen m => Range Int32 -> m Int32
Gen.int32 forall a. (Bounded a, Num a) => Range a
Range.constantBounded
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (m :: * -> *). MonadGen m => Range Int64 -> m Int64
Gen.int64 forall a. (Bounded a, Num a) => Range a
Range.constantBounded
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ((,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). MonadGen m => m Bool
Gen.bool forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (m :: * -> *). MonadGen m => m Bool
Gen.bool)
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ((,,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). MonadGen m => m Bool
Gen.bool forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (m :: * -> *). MonadGen m => m Bool
Gen.bool forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (m :: * -> *). MonadGen m => m Bool
Gen.bool)
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ((,,,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). MonadGen m => m Bool
Gen.bool forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (m :: * -> *). MonadGen m => m Bool
Gen.bool forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (m :: * -> *). MonadGen m => m Bool
Gen.bool forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (m :: * -> *). MonadGen m => m Bool
Gen.bool)
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (m :: * -> *). MonadGen m => Range Int -> m ByteString
Gen.bytes (forall a. Integral a => a -> a -> Range a
Range.linear Int
0 Int
20)
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (m :: * -> *). MonadGen m => Range Int -> m Char -> m Text
Gen.text (forall a. Integral a => a -> a -> Range a
Range.linear Int
0 Int
20) forall (m :: * -> *). MonadGen m => m Char
Gen.unicode
    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) forall (m :: * -> *). MonadGen m => m Bool
Gen.bool
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (m :: * -> *) a. MonadGen m => [m a] -> m a
Gen.choice [forall a b. b -> Either a b
Right forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). MonadGen m => m Bool
Gen.bool, forall a b. a -> Either a b
Left forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). MonadGen m => m Bool
Gen.bool]
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (m :: * -> *) a.
MonadGen m =>
Range Int -> m a -> m (NonEmpty a)
Gen.nonEmpty (forall a. Integral a => a -> a -> Range a
Range.linear Int
1 Int
20) forall (m :: * -> *). MonadGen m => m Bool
Gen.bool
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (m :: * -> *) a. MonadGen m => m a -> m (Maybe a)
Gen.maybe forall (m :: * -> *). MonadGen m => m Bool
Gen.bool
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f 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
2) ((,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). MonadGen m => m Bool
Gen.bool forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (m :: * -> *). MonadGen m => m Bool
Gen.bool)
    forall (f :: * -> *) a b. Applicative f => 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
2) forall (m :: * -> *). MonadGen m => m Bool
Gen.bool
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. [a] -> Vector a
V.fromList forall (f :: * -> *) a b. Functor 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) forall (m :: * -> *). MonadGen m => m Bool
Gen.bool)
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (ByteString -> ByteString
BS.Lazy.fromStrict forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). MonadGen m => Range Int -> m ByteString
Gen.bytes (forall a. Integral a => a -> a -> Range a
Range.linear Int
0 Int
20))
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (ByteString -> ShortByteString
BS.Short.toShort forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). MonadGen m => Range Int -> m ByteString
Gen.bytes (forall a. Integral a => a -> a -> Range a
Range.linear Int
0 Int
20))
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a (m :: * -> *). (Arbitrary a, MonadGen m) => m a
arbitrary

instance EncCBOR TestStruct where
  encCBOR :: TestStruct -> Encoding
encCBOR TestStruct
ts =
    Word -> Encoding
encodeListLen Word
1
      forall a. Semigroup a => a -> a -> a
<> forall a. EncCBOR a => a -> Encoding
encCBOR (TestStruct -> ()
tsUnit TestStruct
ts)
      forall a. Semigroup a => a -> a -> a
<> forall a. EncCBOR a => a -> Encoding
encCBOR (TestStruct -> Bool
tsBool TestStruct
ts)
      forall a. Semigroup a => a -> a -> a
<> forall a. EncCBOR a => a -> Encoding
encCBOR (TestStruct -> Integer
tsInteger TestStruct
ts)
      forall a. Semigroup a => a -> a -> a
<> forall a. EncCBOR a => a -> Encoding
encCBOR (TestStruct -> Word
tsWord TestStruct
ts)
      forall a. Semigroup a => a -> a -> a
<> forall a. EncCBOR a => a -> Encoding
encCBOR (TestStruct -> Word8
tsWord8 TestStruct
ts)
      forall a. Semigroup a => a -> a -> a
<> forall a. EncCBOR a => a -> Encoding
encCBOR (TestStruct -> Word16
tsWord16 TestStruct
ts)
      forall a. Semigroup a => a -> a -> a
<> forall a. EncCBOR a => a -> Encoding
encCBOR (TestStruct -> Word32
tsWord32 TestStruct
ts)
      forall a. Semigroup a => a -> a -> a
<> forall a. EncCBOR a => a -> Encoding
encCBOR (TestStruct -> Word64
tsWord64 TestStruct
ts)
      forall a. Semigroup a => a -> a -> a
<> forall a. EncCBOR a => a -> Encoding
encCBOR (TestStruct -> Int
tsInt TestStruct
ts)
      forall a. Semigroup a => a -> a -> a
<> forall a. EncCBOR a => a -> Encoding
encCBOR (TestStruct -> Float
tsFloat TestStruct
ts)
      forall a. Semigroup a => a -> a -> a
<> forall a. EncCBOR a => a -> Encoding
encCBOR (TestStruct -> Int32
tsInt32 TestStruct
ts)
      forall a. Semigroup a => a -> a -> a
<> forall a. EncCBOR a => a -> Encoding
encCBOR (TestStruct -> Int64
tsInt64 TestStruct
ts)
      forall a. Semigroup a => a -> a -> a
<> forall a. EncCBOR a => a -> Encoding
encCBOR (TestStruct -> (Bool, Bool)
tsTupleBoolBool TestStruct
ts)
      forall a. Semigroup a => a -> a -> a
<> forall a. EncCBOR a => a -> Encoding
encCBOR (TestStruct -> (Bool, Bool, Bool)
tsTupleBoolBoolBool TestStruct
ts)
      forall a. Semigroup a => a -> a -> a
<> forall a. EncCBOR a => a -> Encoding
encCBOR (TestStruct -> (Bool, Bool, Bool, Bool)
tsTupleBoolBoolBoolBool TestStruct
ts)
      forall a. Semigroup a => a -> a -> a
<> forall a. EncCBOR a => a -> Encoding
encCBOR (TestStruct -> ByteString
tsByteString TestStruct
ts)
      forall a. Semigroup a => a -> a -> a
<> forall a. EncCBOR a => a -> Encoding
encCBOR (TestStruct -> Text
tsText TestStruct
ts)
      forall a. Semigroup a => a -> a -> a
<> forall a. EncCBOR a => a -> Encoding
encCBOR (TestStruct -> [Bool]
tsListBool TestStruct
ts)
      forall a. Semigroup a => a -> a -> a
<> forall a. EncCBOR a => a -> Encoding
encCBOR (TestStruct -> Either Bool Bool
tsEitherBoolBool TestStruct
ts)
      forall a. Semigroup a => a -> a -> a
<> forall a. EncCBOR a => a -> Encoding
encCBOR (TestStruct -> NonEmpty Bool
tsNonEmptyBool TestStruct
ts)
      forall a. Semigroup a => a -> a -> a
<> forall a. EncCBOR a => a -> Encoding
encCBOR (TestStruct -> Maybe Bool
tsMaybeBool TestStruct
ts)
      forall a. Semigroup a => a -> a -> a
<> forall a. EncCBOR a => a -> Encoding
encCBOR (TestStruct -> Map Bool Bool
tsMapBoolBool TestStruct
ts)
      forall a. Semigroup a => a -> a -> a
<> forall a. EncCBOR a => a -> Encoding
encCBOR (TestStruct -> Set Bool
tsSetBool TestStruct
ts)
      forall a. Semigroup a => a -> a -> a
<> forall a. EncCBOR a => a -> Encoding
encCBOR (TestStruct -> Vector Bool
tsVectorBool TestStruct
ts)
      forall a. Semigroup a => a -> a -> a
<> forall a. EncCBOR a => a -> Encoding
encCBOR (TestStruct -> ByteString
tsLByteString TestStruct
ts)
      forall a. Semigroup a => a -> a -> a
<> forall a. EncCBOR a => a -> Encoding
encCBOR (TestStruct -> ShortByteString
tsSByteString TestStruct
ts)
      forall a. Semigroup a => a -> a -> a
<> forall a. EncCBOR a => a -> Encoding
encCBOR (TestStruct -> UTCTime
tsUTCTime TestStruct
ts)

instance DecCBOR TestStruct where
  decCBOR :: forall s. Decoder s TestStruct
decCBOR = do
    forall s. Int -> Decoder s ()
decodeListLenOf Int
1
    ()
-> Bool
-> Integer
-> Word
-> Word8
-> Word16
-> Word32
-> Word64
-> Int
-> Float
-> Int32
-> Int64
-> (Bool, Bool)
-> (Bool, Bool, Bool)
-> (Bool, Bool, Bool, Bool)
-> ByteString
-> Text
-> [Bool]
-> Either Bool Bool
-> NonEmpty Bool
-> Maybe Bool
-> Map Bool Bool
-> Set Bool
-> Vector Bool
-> ByteString
-> ShortByteString
-> UTCTime
-> TestStruct
TestStruct
      forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a s. DecCBOR a => Decoder s a
decCBOR
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a s. DecCBOR a => Decoder s a
decCBOR
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a s. DecCBOR a => Decoder s a
decCBOR
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a s. DecCBOR a => Decoder s a
decCBOR
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a s. DecCBOR a => Decoder s a
decCBOR
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a s. DecCBOR a => Decoder s a
decCBOR
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a s. DecCBOR a => Decoder s a
decCBOR
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a s. DecCBOR a => Decoder s a
decCBOR
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a s. DecCBOR a => Decoder s a
decCBOR
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a s. DecCBOR a => Decoder s a
decCBOR
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a s. DecCBOR a => Decoder s a
decCBOR
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a s. DecCBOR a => Decoder s a
decCBOR
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a s. DecCBOR a => Decoder s a
decCBOR
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a s. DecCBOR a => Decoder s a
decCBOR
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a s. DecCBOR a => Decoder s a
decCBOR
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a s. DecCBOR a => Decoder s a
decCBOR
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a s. DecCBOR a => Decoder s a
decCBOR
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a s. DecCBOR a => Decoder s a
decCBOR
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a s. DecCBOR a => Decoder s a
decCBOR
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a s. DecCBOR a => Decoder s a
decCBOR
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a s. DecCBOR a => Decoder s a
decCBOR
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a s. DecCBOR a => Decoder s a
decCBOR
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a s. DecCBOR a => Decoder s a
decCBOR
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a s. DecCBOR a => Decoder s a
decCBOR
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a s. DecCBOR a => Decoder s a
decCBOR
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a s. DecCBOR a => Decoder s a
decCBOR
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a s. DecCBOR a => Decoder s a
decCBOR

prop_roundTripSerialize' :: Property
prop_roundTripSerialize' :: Property
prop_roundTripSerialize' = HasCallStack => PropertyT IO () -> Property
property forall a b. (a -> b) -> a -> b
$ do
  TestStruct
ts <- forall (m :: * -> *) a.
(Monad m, Show a, HasCallStack) =>
Gen a -> PropertyT m a
forAll Gen TestStruct
genTestStruct
  (forall a. DecCBOR a => Version -> ByteString -> a
unsafeDeserialize' Version
byronProtVer forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. EncCBOR a => Version -> a -> ByteString
serialize' Version
byronProtVer forall a b. (a -> b) -> a -> b
$ TestStruct
ts) forall (m :: * -> *) a.
(MonadTest m, Eq a, Show a, HasCallStack) =>
a -> a -> m ()
=== TestStruct
ts

prop_roundTripEncodeNestedCbor :: Property
prop_roundTripEncodeNestedCbor :: Property
prop_roundTripEncodeNestedCbor = HasCallStack => PropertyT IO () -> Property
property forall a b. (a -> b) -> a -> b
$ do
  TestStruct
ts <- forall (m :: * -> *) a.
(Monad m, Show a, HasCallStack) =>
Gen a -> PropertyT m a
forAll Gen TestStruct
genTestStruct
  let encoded :: ByteString
encoded = forall a. EncCBOR a => Version -> a -> ByteString
serialize Version
byronProtVer forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. EncCBOR a => a -> Encoding
encodeNestedCbor forall a b. (a -> b) -> a -> b
$ TestStruct
ts
  forall a.
Version
-> Text
-> (forall s. Decoder s a)
-> ByteString
-> Either DecoderError a
decodeFullDecoder Version
byronProtVer Text
"" forall a s. DecCBOR a => Decoder s a
decodeNestedCbor ByteString
encoded forall (m :: * -> *) a.
(MonadTest m, Eq a, Show a, HasCallStack) =>
a -> a -> m ()
=== forall a b. b -> Either a b
Right TestStruct
ts

prop_decodeContainerSkelWithReplicate :: Property
prop_decodeContainerSkelWithReplicate :: Property
prop_decodeContainerSkelWithReplicate = HasCallStack => PropertyT IO () -> Property
property forall a b. (a -> b) -> a -> b
$
  forall (m :: * -> *). (MonadTest m, HasCallStack) => Bool -> m ()
assert forall a b. (a -> b) -> a -> b
$ case Encoding -> Either DecoderError (Vector ())
decode Encoding
vec of
    Right Vector ()
_ -> Bool
True
    Either DecoderError (Vector ())
_ -> Bool
False
  where
    decode :: Encoding -> Either DecoderError (V.Vector ())
    decode :: Encoding -> Either DecoderError (Vector ())
decode Encoding
enc = forall a.
DecCBOR a =>
Version -> ByteString -> Either DecoderError a
decodeFull Version
byronProtVer (forall a. EncCBOR a => Version -> a -> ByteString
serialize Version
byronProtVer Encoding
enc)

    vec :: Encoding
vec = Word -> Encoding
encodeListLen Word
4097 forall a. Semigroup a => a -> a -> a
<> forall a. Monoid a => [a] -> a
mconcat (forall a. Int -> a -> [a]
replicate Int
4097 Encoding
encodeNull)