{-# 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
    ]