{-# LANGUAGE DataKinds #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# OPTIONS_GHC -Wno-orphans #-}

module Test.Cardano.Ledger.Babbage.BinarySpec (spec) where

import Cardano.Ledger.Alonzo.TxWits (Redeemers, TxDats)
import Cardano.Ledger.Babbage
import Cardano.Ledger.Block (Block (Block))
import Cardano.Protocol.Crypto (StandardCrypto)
import qualified Cardano.Protocol.Praos.BlockHeader as Praos
import qualified Test.Cardano.Base.QuickCheck as BaseQC
import Test.Cardano.Ledger.Alonzo.Binary.RoundTrip (roundTripAlonzoCommonSpec)
import Test.Cardano.Ledger.Babbage.Arbitrary ()
import Test.Cardano.Ledger.Babbage.Era ()
import Test.Cardano.Ledger.Babbage.TreeDiff ()
import Test.Cardano.Ledger.Common
import Test.Cardano.Ledger.Core.Binary as Binary (
  decoderEquivalenceCoreEraTypesSpec,
  decoderEquivalenceEraSpec,
  txSizeSpec,
 )
import Test.Cardano.Ledger.Core.Binary.RoundTrip (
  roundTripAnnEraExpectation,
  roundTripEraExpectation,
 )
import Test.Cardano.Protocol.Praos.BlockHeader.Arbitrary ()

spec :: Spec
spec :: Spec
spec = do
  String -> Spec -> Spec
forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"RoundTrip" (Spec -> Spec) -> Spec -> Spec
forall a b. (a -> b) -> a -> b
$ do
    forall era. AlonzoEraTest era => Spec
roundTripAlonzoCommonSpec @BabbageEra
    String -> Property -> Spec
forall prop.
(HasCallStack, Testable prop) =>
String -> prop -> Spec
prop String
"Block (Praos.Header)" (Property -> Spec) -> Property -> Spec
forall a b. (a -> b) -> a -> b
$
      Int -> Property -> Property
forall prop. Testable prop => Int -> prop -> Property
BaseQC.withNumTests Int
25 (Property -> Property) -> Property -> Property
forall a b. (a -> b) -> a -> b
$
        Gen (Block (Header StandardCrypto) BabbageEra)
-> (Block (Header StandardCrypto) BabbageEra -> Property)
-> Property
forall a prop.
(Show a, Testable prop) =>
Gen a -> (a -> prop) -> Property
forAll (Header StandardCrypto
-> BlockBody BabbageEra -> Block (Header StandardCrypto) BabbageEra
Header StandardCrypto
-> AlonzoBlockBody BabbageEra
-> Block (Header StandardCrypto) BabbageEra
forall h era. h -> BlockBody era -> Block h era
Block (Header StandardCrypto
 -> AlonzoBlockBody BabbageEra
 -> Block (Header StandardCrypto) BabbageEra)
-> Gen (Header StandardCrypto)
-> Gen
     (AlonzoBlockBody BabbageEra
      -> Block (Header StandardCrypto) BabbageEra)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (Header StandardCrypto)
forall a. Arbitrary a => Gen a
arbitrary Gen
  (AlonzoBlockBody BabbageEra
   -> Block (Header StandardCrypto) BabbageEra)
-> Gen (AlonzoBlockBody BabbageEra)
-> Gen (Block (Header StandardCrypto) BabbageEra)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Int -> Int)
-> Gen (AlonzoBlockBody BabbageEra)
-> Gen (AlonzoBlockBody BabbageEra)
forall a. (Int -> Int) -> Gen a -> Gen a
scale (Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2) Gen (AlonzoBlockBody BabbageEra)
forall a. Arbitrary a => Gen a
arbitrary) ((Block (Header StandardCrypto) BabbageEra -> Property)
 -> Property)
-> (Block (Header StandardCrypto) BabbageEra -> Property)
-> Property
forall a b. (a -> b) -> a -> b
$ \Block (Header StandardCrypto) BabbageEra
block ->
          [Expectation] -> Property
forall prop. Testable prop => [prop] -> Property
conjoin
            [ forall era t.
(Era era, Show t, Eq t, EncCBOR t, DecCBOR t, HasCallStack) =>
t -> Expectation
roundTripEraExpectation @BabbageEra @(Block (Praos.Header StandardCrypto) BabbageEra) Block (Header StandardCrypto) BabbageEra
block
            , forall era t.
(Era era, Show t, Eq t, ToCBOR t, DecCBOR (Annotator t),
 HasCallStack) =>
t -> Expectation
roundTripAnnEraExpectation @BabbageEra @(Block (Praos.Header StandardCrypto) BabbageEra) Block (Header StandardCrypto) BabbageEra
block
            ]
  String -> Spec -> Spec
forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"DecCBOR instances equivalence" (Spec -> Spec) -> Spec -> Spec
forall a b. (a -> b) -> a -> b
$ do
    forall era.
(EraTx era, Arbitrary (Tx TopTx era), Arbitrary (TxBody TopTx era),
 Arbitrary (TxWits era), Arbitrary (TxAuxData era),
 Arbitrary (Script era), HasCallStack) =>
Spec
Binary.decoderEquivalenceCoreEraTypesSpec @BabbageEra
    forall era t.
(Era era, Eq t, ToCBOR t, DecCBOR (Annotator t), Arbitrary t,
 Show t) =>
Spec
decoderEquivalenceEraSpec @BabbageEra @(TxDats BabbageEra)
    forall era t.
(Era era, Eq t, ToCBOR t, DecCBOR (Annotator t), Arbitrary t,
 Show t) =>
Spec
decoderEquivalenceEraSpec @BabbageEra @(Redeemers BabbageEra)
  forall era.
(EraTx era, Arbitrary (Tx TopTx era), SafeToHash (TxWits era)) =>
Spec
Binary.txSizeSpec @BabbageEra