{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE RankNTypes #-} module Test.Gen.Cardano.Api.Byron ( tests ) where import Cardano.Api hiding (txIns) import Test.Gen.Cardano.Api.Typed import Hedgehog import Test.Hedgehog.Roundtrip.CBOR import Test.Tasty import Test.Tasty.Hedgehog prop_byron_roundtrip_txbody_CBOR :: Property prop_byron_roundtrip_txbody_CBOR :: Property prop_byron_roundtrip_txbody_CBOR = HasCallStack => PropertyT IO () -> Property PropertyT IO () -> Property property (PropertyT IO () -> Property) -> PropertyT IO () -> Property forall a b. (a -> b) -> a -> b $ do x <- Gen (ATxAux ByteString) -> PropertyT IO (ATxAux ByteString) forall (m :: * -> *) a. (Monad m, Show a, HasCallStack) => Gen a -> PropertyT m a forAll (Gen (ATxAux ByteString) -> PropertyT IO (ATxAux ByteString)) -> Gen (ATxAux ByteString) -> PropertyT IO (ATxAux ByteString) forall a b. (a -> b) -> a -> b $ [KeyWitness (ZonkAny 0)] -> Annotated Tx ByteString -> ATxAux ByteString forall era. [KeyWitness era] -> Annotated Tx ByteString -> ATxAux ByteString makeSignedByronTransaction [] (Annotated Tx ByteString -> ATxAux ByteString) -> GenT Identity (Annotated Tx ByteString) -> Gen (ATxAux ByteString) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> GenT Identity (Annotated Tx ByteString) HasCallStack => GenT Identity (Annotated Tx ByteString) genTxBodyByron tripping x serializeByronTx deserialiseByronTxCddl prop_byron_roundtrip_witness_CBOR :: Property prop_byron_roundtrip_witness_CBOR :: Property prop_byron_roundtrip_witness_CBOR = HasCallStack => PropertyT IO () -> Property PropertyT IO () -> Property property (PropertyT IO () -> Property) -> PropertyT IO () -> Property forall a b. (a -> b) -> a -> b $ do let byron :: CardanoEra ByronEra byron = CardanoEra ByronEra ByronEra x <- Gen (KeyWitness ByronEra) -> PropertyT IO (KeyWitness ByronEra) forall (m :: * -> *) a. (Monad m, Show a, HasCallStack) => Gen a -> PropertyT m a forAll Gen (KeyWitness ByronEra) genByronKeyWitness cardanoEraConstraints byron $ trippingCbor (AsKeyWitness (proxyToAsType Proxy)) x prop_byron_roundtrip_Tx_Cddl :: Property prop_byron_roundtrip_Tx_Cddl :: Property prop_byron_roundtrip_Tx_Cddl = HasCallStack => PropertyT IO () -> Property PropertyT IO () -> Property property (PropertyT IO () -> Property) -> PropertyT IO () -> Property forall a b. (a -> b) -> a -> b $ do x <- Gen (ATxAux ByteString) -> PropertyT IO (ATxAux ByteString) forall (m :: * -> *) a. (Monad m, Show a, HasCallStack) => Gen a -> PropertyT m a forAll Gen (ATxAux ByteString) genTxByron tripping x serializeByronTx deserialiseByronTxCddl tests :: TestTree tests :: TestTree tests = TestName -> [TestTree] -> TestTree testGroup TestName "Test.Gen.Cardano.Api.Byron" [ TestName -> Property -> TestTree testProperty TestName "Byron roundtrip txbody CBOR" Property prop_byron_roundtrip_txbody_CBOR , TestName -> Property -> TestTree testProperty TestName "Byron roundtrip witness CBOR" Property prop_byron_roundtrip_witness_CBOR , TestName -> Property -> TestTree testProperty TestName "Byron roundtrip tx CBOR" Property prop_byron_roundtrip_Tx_Cddl ]