{-# 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 =
  String -> [TestTree] -> TestTree
forall a. HasCallStack => String -> [SpecWith a] -> SpecWith a
testGroup
    (TypeRep -> String
forall a. Show a => a -> String
show (TypeRep -> String) -> TypeRep -> String
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))
    [ String -> (ApplyTxError e -> Expectation) -> TestTree
forall prop.
(HasCallStack, Testable prop) =>
String -> prop -> TestTree
testProperty String
"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 =
  String -> [TestTree] -> TestTree
forall a. HasCallStack => String -> [SpecWith a] -> SpecWith a
testGroup
    String
"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
    ]