{-# 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 (Alonzo)
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.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.Shelley.ConcreteCryptoTypes
import Test.Cardano.Ledger.ShelleyMA.Serialisation.Generators ()
import Test.Tasty
import Test.Tasty.QuickCheck

tests :: TestTree
tests :: TestTree
tests =
  TestName -> [TestTree] -> TestTree
testGroup
    TestName
"Alonzo CBOR round-trip"
    [ forall {p}. p -> TestTree
skip forall a b. (a -> b) -> a -> b
$
        forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"alonzo/Script twiddled" 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 Alonzo) forall era.
Eq (PlutusScript era) =>
AlonzoScript era -> AlonzoScript era -> Bool
eqAlonzoScriptRaw
    , forall {p}. p -> TestTree
skip forall a b. (a -> b) -> a -> b
$
        forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"alonzo/Data twiddled" 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 Alonzo) (forall (t1 :: * -> *) (t2 :: * -> *) era a.
(Memoized t1, Memoized t2) =>
(RawType t1 era -> RawType t2 era -> a) -> t1 era -> t2 era -> a
zipMemoRawType forall a. (Eq a, Show a) => a -> a -> Property
(===))
    , forall {p}. p -> TestTree
skip forall a b. (a -> b) -> a -> b
$
        forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"alonzo/BinaryData twiddled" forall a b. (a -> b) -> a -> b
$
          forall t.
(Show t, Eq t, Twiddle t, DecCBOR t) =>
Version -> t -> Property
roundTripTwiddledProperty @(BinaryData Alonzo)
    , forall {p}. p -> TestTree
skip forall a b. (a -> b) -> a -> b
$
        forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"alonzo/TxBody twiddled" 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 Alonzo) (forall (t1 :: * -> *) (t2 :: * -> *) era a.
(Memoized t1, Memoized t2) =>
(RawType t1 era -> RawType t2 era -> a) -> t1 era -> t2 era -> a
zipMemoRawType forall a. (Eq a, Show a) => a -> a -> Property
(===))
    , forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"alonzo/AlonzoUtxowPredFailure" forall a b. (a -> b) -> a -> b
$
        forall t.
(Show t, Eq t, EncCBOR t, DecCBOR t, HasCallStack) =>
t -> Expectation
roundTripCborExpectation @(AlonzoUtxowPredFailure Alonzo)
    , forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"alonzo/AlonzoUtxoPredFailure" forall a b. (a -> b) -> a -> b
$
        forall t.
(Show t, Eq t, EncCBOR t, DecCBOR t, HasCallStack) =>
t -> Expectation
roundTripCborExpectation @(AlonzoUtxoPredFailure Alonzo)
    , forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"alonzo/AlonzoUtxosPredFailure" forall a b. (a -> b) -> a -> b
$
        forall t.
(Show t, Eq t, EncCBOR t, DecCBOR t, HasCallStack) =>
t -> Expectation
roundTripCborExpectation @(AlonzoUtxosPredFailure Alonzo)
    , forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"alonzo/Block" 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) Alonzo)
          (forall era. Era era => Version
eraProtVerLow @Alonzo)
          (forall era. Era era => Version
eraProtVerHigh @Alonzo)
    ]
  where
    skip :: p -> TestTree
skip p
_ = forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"Test skipped" Bool
True