{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}

module Test.Cardano.Ledger.Alonzo.Serialisation.Tripping where

import Cardano.Ledger.Alonzo (AlonzoEra)
import Cardano.Ledger.Alonzo.Rules (
  AlonzoUtxoPredFailure,
  AlonzoUtxosPredFailure,
  AlonzoUtxowPredFailure,
 )
import Cardano.Ledger.Alonzo.Scripts (eqAlonzoScriptRaw)
import Cardano.Ledger.Block (Block)
import Cardano.Ledger.Core
import Cardano.Ledger.MemoBytes (zipMemoRawType)
import Cardano.Ledger.Plutus.Data (BinaryData, Data (..))
import Cardano.Protocol.Crypto (StandardCrypto)
import Cardano.Protocol.TPraos.BHeader (BHeader)
import Test.Cardano.Ledger.Alonzo.Arbitrary ()
import Test.Cardano.Ledger.Alonzo.Serialisation.Generators ()
import Test.Cardano.Ledger.Binary.Arbitrary ()
import Test.Cardano.Ledger.Binary.RoundTrip
import Test.Cardano.Ledger.ShelleyMA.Serialisation.Generators ()
import Test.Cardano.Protocol.Binary.Annotator ()
import Test.Tasty
import Test.Tasty.QuickCheck

tests :: TestTree
tests :: TestTree
tests =
  TestName -> [TestTree] -> TestTree
testGroup
    TestName
"Alonzo CBOR round-trip"
    [ TestTree -> TestTree
forall {p}. p -> TestTree
skip (TestTree -> TestTree) -> TestTree -> TestTree
forall a b. (a -> b) -> a -> b
$
        TestName -> (Version -> Script AlonzoEra -> Property) -> TestTree
forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"alonzo/Script twiddled" ((Version -> Script AlonzoEra -> Property) -> TestTree)
-> (Version -> Script AlonzoEra -> Property) -> TestTree
forall a b. (a -> b) -> a -> b
$
          forall t q.
(Twiddle t, DecCBOR (Annotator t), Testable q) =>
(t -> t -> q) -> Version -> t -> Property
roundTripAnnTwiddledProperty @(Script AlonzoEra) Script AlonzoEra -> Script AlonzoEra -> Bool
AlonzoScript AlonzoEra -> AlonzoScript AlonzoEra -> Bool
forall era.
Eq (PlutusScript era) =>
AlonzoScript era -> AlonzoScript era -> Bool
eqAlonzoScriptRaw
    , TestTree -> TestTree
forall {p}. p -> TestTree
skip (TestTree -> TestTree) -> TestTree -> TestTree
forall a b. (a -> b) -> a -> b
$
        TestName -> (Version -> Data AlonzoEra -> Property) -> TestTree
forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"alonzo/Data twiddled" ((Version -> Data AlonzoEra -> Property) -> TestTree)
-> (Version -> Data AlonzoEra -> Property) -> TestTree
forall a b. (a -> b) -> a -> b
$
          forall t q.
(Twiddle t, DecCBOR (Annotator t), Testable q) =>
(t -> t -> q) -> Version -> t -> Property
roundTripAnnTwiddledProperty @(Data AlonzoEra) ((RawType (Data AlonzoEra) -> RawType (Data AlonzoEra) -> Property)
-> Data AlonzoEra -> Data AlonzoEra -> Property
forall t1 t2 a.
(Memoized t1, Memoized t2) =>
(RawType t1 -> RawType t2 -> a) -> t1 -> t2 -> a
zipMemoRawType RawType (Data AlonzoEra) -> RawType (Data AlonzoEra) -> Property
PlutusData AlonzoEra -> PlutusData AlonzoEra -> Property
forall a. (Eq a, Show a) => a -> a -> Property
(===))
    , TestTree -> TestTree
forall {p}. p -> TestTree
skip (TestTree -> TestTree) -> TestTree -> TestTree
forall a b. (a -> b) -> a -> b
$
        TestName
-> (Version -> BinaryData AlonzoEra -> Property) -> TestTree
forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"alonzo/BinaryData twiddled" ((Version -> BinaryData AlonzoEra -> Property) -> TestTree)
-> (Version -> BinaryData AlonzoEra -> Property) -> TestTree
forall a b. (a -> b) -> a -> b
$
          forall t.
(Show t, Eq t, Twiddle t, DecCBOR t) =>
Version -> t -> Property
roundTripTwiddledProperty @(BinaryData AlonzoEra)
    , TestTree -> TestTree
forall {p}. p -> TestTree
skip (TestTree -> TestTree) -> TestTree -> TestTree
forall a b. (a -> b) -> a -> b
$
        TestName -> (Version -> TxBody AlonzoEra -> Property) -> TestTree
forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"alonzo/TxBody twiddled" ((Version -> TxBody AlonzoEra -> Property) -> TestTree)
-> (Version -> TxBody AlonzoEra -> Property) -> TestTree
forall a b. (a -> b) -> a -> b
$
          forall t q.
(Twiddle t, DecCBOR (Annotator t), Testable q) =>
(t -> t -> q) -> Version -> t -> Property
roundTripAnnTwiddledProperty @(TxBody AlonzoEra) ((RawType (TxBody AlonzoEra)
 -> RawType (TxBody AlonzoEra) -> Property)
-> TxBody AlonzoEra -> TxBody AlonzoEra -> Property
forall t1 t2 a.
(Memoized t1, Memoized t2) =>
(RawType t1 -> RawType t2 -> a) -> t1 -> t2 -> a
zipMemoRawType AlonzoTxBodyRaw -> AlonzoTxBodyRaw -> Property
RawType (TxBody AlonzoEra)
-> RawType (TxBody AlonzoEra) -> Property
forall a. (Eq a, Show a) => a -> a -> Property
(===))
    , TestName
-> (AlonzoUtxowPredFailure AlonzoEra -> Expectation) -> TestTree
forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"alonzo/AlonzoUtxowPredFailure" ((AlonzoUtxowPredFailure AlonzoEra -> Expectation) -> TestTree)
-> (AlonzoUtxowPredFailure AlonzoEra -> Expectation) -> TestTree
forall a b. (a -> b) -> a -> b
$
        forall t.
(Show t, Eq t, EncCBOR t, DecCBOR t, HasCallStack) =>
t -> Expectation
roundTripCborExpectation @(AlonzoUtxowPredFailure AlonzoEra)
    , TestName
-> (AlonzoUtxoPredFailure AlonzoEra -> Expectation) -> TestTree
forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"alonzo/AlonzoUtxoPredFailure" ((AlonzoUtxoPredFailure AlonzoEra -> Expectation) -> TestTree)
-> (AlonzoUtxoPredFailure AlonzoEra -> Expectation) -> TestTree
forall a b. (a -> b) -> a -> b
$
        forall t.
(Show t, Eq t, EncCBOR t, DecCBOR t, HasCallStack) =>
t -> Expectation
roundTripCborExpectation @(AlonzoUtxoPredFailure AlonzoEra)
    , TestName
-> (AlonzoUtxosPredFailure AlonzoEra -> Expectation) -> TestTree
forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"alonzo/AlonzoUtxosPredFailure" ((AlonzoUtxosPredFailure AlonzoEra -> Expectation) -> TestTree)
-> (AlonzoUtxosPredFailure AlonzoEra -> Expectation) -> TestTree
forall a b. (a -> b) -> a -> b
$
        forall t.
(Show t, Eq t, EncCBOR t, DecCBOR t, HasCallStack) =>
t -> Expectation
roundTripCborExpectation @(AlonzoUtxosPredFailure AlonzoEra)
    , TestName
-> (Block (BHeader StandardCrypto) AlonzoEra -> Expectation)
-> TestTree
forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"alonzo/Block (Annotator)" ((Block (BHeader StandardCrypto) AlonzoEra -> Expectation)
 -> TestTree)
-> (Block (BHeader StandardCrypto) AlonzoEra -> Expectation)
-> TestTree
forall a b. (a -> b) -> a -> b
$
        forall t.
(Show t, Eq t, ToCBOR t, DecCBOR (Annotator t), HasCallStack) =>
Version -> Version -> t -> Expectation
roundTripAnnRangeExpectation @(Block (BHeader StandardCrypto) AlonzoEra)
          (forall era. Era era => Version
eraProtVerLow @AlonzoEra)
          (forall era. Era era => Version
eraProtVerHigh @AlonzoEra)
    , TestName
-> (Block (BHeader StandardCrypto) AlonzoEra -> Expectation)
-> TestTree
forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"alonzo/Block" ((Block (BHeader StandardCrypto) AlonzoEra -> Expectation)
 -> TestTree)
-> (Block (BHeader StandardCrypto) AlonzoEra -> Expectation)
-> TestTree
forall a b. (a -> b) -> a -> b
$
        forall t.
(Show t, Eq t, EncCBOR t, DecCBOR t, HasCallStack) =>
Version -> Version -> t -> Expectation
roundTripCborRangeExpectation @(Block (BHeader StandardCrypto) AlonzoEra)
          (forall era. Era era => Version
eraProtVerLow @AlonzoEra)
          (forall era. Era era => Version
eraProtVerHigh @AlonzoEra)
    ]
  where
    skip :: p -> TestTree
skip p
_ = TestName -> Bool -> TestTree
forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"Test skipped" Bool
True