{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE MonoLocalBinds #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}

module Test.Cardano.Ledger.ShelleyMA.Serialisation.Roundtrip where

import Cardano.Ledger.Allegra (AllegraEra)
import Cardano.Ledger.Binary (DecCBOR, EncCBOR)
import Cardano.Ledger.Core
import Cardano.Ledger.Mary (MaryEra)
import Cardano.Ledger.Shelley (ShelleyEra)
import Cardano.Ledger.Shelley.API (ApplyTx, ApplyTxError)
import Control.State.Transition.Extended (PredicateFailure)
import Data.Proxy (Proxy (Proxy))
import Data.Typeable (typeRep)
import Test.Cardano.Ledger.Binary.RoundTrip (
  roundTripCborExpectation,
 )
import Test.Cardano.Ledger.Mary.Arbitrary ()
import Test.Cardano.Ledger.Shelley.Generator.TxAuxData ()
import Test.Cardano.Ledger.Shelley.Serialisation.Generators ()
import Test.Cardano.Ledger.ShelleyMA.Serialisation.Generators ()
import Test.QuickCheck (Arbitrary)
import Test.Tasty (TestTree, testGroup)
import Test.Tasty.QuickCheck (testProperty)

eraRoundTripProps ::
  forall e.
  ( ApplyTx e
  , Arbitrary (ApplyTxError e)
  , EncCBOR (PredicateFailure (EraRule "LEDGER" e))
  , DecCBOR (PredicateFailure (EraRule "LEDGER" e))
  ) =>
  TestTree
eraRoundTripProps :: forall e.
(ApplyTx e, Arbitrary (ApplyTxError e),
 EncCBOR (PredicateFailure (EraRule "LEDGER" e)),
 DecCBOR (PredicateFailure (EraRule "LEDGER" e))) =>
TestTree
eraRoundTripProps =
  TestName -> [TestTree] -> TestTree
testGroup
    (TypeRep -> TestName
forall a. Show a => a -> TestName
show (TypeRep -> TestName) -> TypeRep -> TestName
forall a b. (a -> b) -> a -> b
$ Proxy e -> TypeRep
forall {k} (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
typeRep (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @e))
    [ TestName -> (ApplyTxError e -> Expectation) -> TestTree
forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"ApplyTxError" ((ApplyTxError e -> Expectation) -> TestTree)
-> (ApplyTxError e -> Expectation) -> TestTree
forall a b. (a -> b) -> a -> b
$ forall t.
(Show t, Eq t, EncCBOR t, DecCBOR t, HasCallStack) =>
t -> Expectation
roundTripCborExpectation @(ApplyTxError e)
    ]

allEraRoundtripTests :: TestTree
allEraRoundtripTests :: TestTree
allEraRoundtripTests =
  TestName -> [TestTree] -> TestTree
testGroup
    TestName
"All Era Roundtrip Tests"
    [ forall e.
(ApplyTx e, Arbitrary (ApplyTxError e),
 EncCBOR (PredicateFailure (EraRule "LEDGER" e)),
 DecCBOR (PredicateFailure (EraRule "LEDGER" e))) =>
TestTree
eraRoundTripProps @ShelleyEra
    , forall e.
(ApplyTx e, Arbitrary (ApplyTxError e),
 EncCBOR (PredicateFailure (EraRule "LEDGER" e)),
 DecCBOR (PredicateFailure (EraRule "LEDGER" e))) =>
TestTree
eraRoundTripProps @AllegraEra
    , forall e.
(ApplyTx e, Arbitrary (ApplyTxError e),
 EncCBOR (PredicateFailure (EraRule "LEDGER" e)),
 DecCBOR (PredicateFailure (EraRule "LEDGER" e))) =>
TestTree
eraRoundTripProps @MaryEra
    ]