{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE TypeApplications #-}

module Test.Cardano.Ledger.Mary.Translation (
  maryTranslationTests,
  maryEncodeDecodeTests,
) where

import Cardano.Ledger.Allegra (AllegraEra)
import Cardano.Ledger.Binary (EncCBOR)
import Cardano.Ledger.Core
import Cardano.Ledger.Genesis (NoGenesis (..))
import Cardano.Ledger.Mary (MaryEra)
import qualified Cardano.Ledger.Shelley.API as S
import Test.Cardano.Ledger.AllegraEraGen ()
import Test.Cardano.Ledger.Binary.RoundTrip
import Test.Cardano.Ledger.Mary.Arbitrary ()
import Test.Cardano.Ledger.Mary.Binary.Annotator ()
import Test.Cardano.Ledger.Shelley.Generator.ShelleyEraGen ()
import Test.Cardano.Ledger.Shelley.Serialisation.EraIndepGenerators ()
import Test.Cardano.Ledger.Shelley.Serialisation.Generators ()
import Test.Cardano.Ledger.ShelleyMA.Serialisation.Generators ()
import Test.Cardano.Ledger.TranslationTools (translateEraEncCBOR)
import Test.Tasty (TestTree, testGroup)
import Test.Tasty.HUnit (Assertion)
import Test.Tasty.QuickCheck (testProperty)

maryEncodeDecodeTests :: TestTree
maryEncodeDecodeTests :: TestTree
maryEncodeDecodeTests =
  String -> [TestTree] -> TestTree
forall a. HasCallStack => String -> [SpecWith a] -> SpecWith a
testGroup
    String
"encoded allegra types can be decoded as mary types"
    [ String -> (AllegraTxAuxData AllegraEra -> Assertion) -> TestTree
forall prop.
(HasCallStack, Testable prop) =>
String -> prop -> TestTree
testProperty
        String
"decoding metadata (Annotator)"
        ( forall a b.
(ToCBOR a, DecCBOR (Annotator b), HasCallStack) =>
Version -> Version -> (b -> a -> Assertion) -> a -> Assertion
embedTripAnnExpectation @(TxAuxData AllegraEra) @(TxAuxData MaryEra)
            (forall era. Era era => Version
eraProtVerLow @AllegraEra)
            (forall era. Era era => Version
eraProtVerLow @MaryEra)
            (\TxAuxData MaryEra
_ TxAuxData AllegraEra
_ -> () -> Assertion
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ())
        )
    , String -> (AllegraTxAuxData AllegraEra -> Assertion) -> TestTree
forall prop.
(HasCallStack, Testable prop) =>
String -> prop -> TestTree
testProperty
        String
"decoding metadata"
        ( forall a b.
(Typeable b, Eq b, HasCallStack) =>
Version
-> Version -> Trip a b -> (b -> a -> Assertion) -> a -> Assertion
embedTripExpectation @(TxAuxData AllegraEra) @(TxAuxData MaryEra)
            (forall era. Era era => Version
eraProtVerLow @AllegraEra)
            (forall era. Era era => Version
eraProtVerLow @MaryEra)
            Trip (AllegraTxAuxData AllegraEra) (AllegraTxAuxData MaryEra)
Trip (TxAuxData AllegraEra) (TxAuxData MaryEra)
forall a b. (EncCBOR a, DecCBOR b) => Trip a b
cborTrip
            (\TxAuxData MaryEra
_ TxAuxData AllegraEra
_ -> () -> Assertion
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ())
        )
    ]

maryTranslationTests :: TestTree
maryTranslationTests :: TestTree
maryTranslationTests =
  String -> [TestTree] -> TestTree
forall a. HasCallStack => String -> [SpecWith a] -> SpecWith a
testGroup
    String
"Mary translation binary compatibiliby tests"
    [ String -> (Tx TopTx AllegraEra -> Assertion) -> TestTree
forall prop.
(HasCallStack, Testable prop) =>
String -> prop -> TestTree
testProperty String
"Tx compatibility" (forall (f :: * -> *).
(EncCBOR (f AllegraEra), EncCBOR (f MaryEra),
 TranslateEra MaryEra f, Show (TranslationError MaryEra f)) =>
f AllegraEra -> Assertion
test @(Tx TopTx))
    , String -> (ProposedPPUpdates AllegraEra -> Assertion) -> TestTree
forall prop.
(HasCallStack, Testable prop) =>
String -> prop -> TestTree
testProperty String
"ProposedPPUpdates compatibility" (forall (f :: * -> *).
(EncCBOR (f AllegraEra), EncCBOR (f MaryEra),
 TranslateEra MaryEra f, Show (TranslationError MaryEra f)) =>
f AllegraEra -> Assertion
test @S.ProposedPPUpdates)
    , String -> (ShelleyGovState AllegraEra -> Assertion) -> TestTree
forall prop.
(HasCallStack, Testable prop) =>
String -> prop -> TestTree
testProperty String
"ShelleyGovState compatibility" (forall (f :: * -> *).
(EncCBOR (f AllegraEra), EncCBOR (f MaryEra),
 TranslateEra MaryEra f, Show (TranslationError MaryEra f)) =>
f AllegraEra -> Assertion
test @S.ShelleyGovState)
    , String -> (ShelleyTxOut AllegraEra -> Assertion) -> TestTree
forall prop.
(HasCallStack, Testable prop) =>
String -> prop -> TestTree
testProperty String
"TxOut compatibility" (forall (f :: * -> *).
(EncCBOR (f AllegraEra), EncCBOR (f MaryEra),
 TranslateEra MaryEra f, Show (TranslationError MaryEra f)) =>
f AllegraEra -> Assertion
test @S.ShelleyTxOut)
    , String -> (UTxO AllegraEra -> Assertion) -> TestTree
forall prop.
(HasCallStack, Testable prop) =>
String -> prop -> TestTree
testProperty String
"UTxO compatibility" (forall (f :: * -> *).
(EncCBOR (f AllegraEra), EncCBOR (f MaryEra),
 TranslateEra MaryEra f, Show (TranslationError MaryEra f)) =>
f AllegraEra -> Assertion
test @S.UTxO)
    , String -> (UTxOState AllegraEra -> Assertion) -> TestTree
forall prop.
(HasCallStack, Testable prop) =>
String -> prop -> TestTree
testProperty String
"UTxOState compatibility" (forall (f :: * -> *).
(EncCBOR (f AllegraEra), EncCBOR (f MaryEra),
 TranslateEra MaryEra f, Show (TranslationError MaryEra f)) =>
f AllegraEra -> Assertion
test @S.UTxOState)
    , String -> (LedgerState AllegraEra -> Assertion) -> TestTree
forall prop.
(HasCallStack, Testable prop) =>
String -> prop -> TestTree
testProperty String
"LedgerState compatibility" (forall (f :: * -> *).
(EncCBOR (f AllegraEra), EncCBOR (f MaryEra),
 TranslateEra MaryEra f, Show (TranslationError MaryEra f)) =>
f AllegraEra -> Assertion
test @S.LedgerState)
    , String -> (EpochState AllegraEra -> Assertion) -> TestTree
forall prop.
(HasCallStack, Testable prop) =>
String -> prop -> TestTree
testProperty String
"EpochState compatibility" (forall (f :: * -> *).
(EncCBOR (f AllegraEra), EncCBOR (f MaryEra),
 TranslateEra MaryEra f, Show (TranslationError MaryEra f)) =>
f AllegraEra -> Assertion
test @S.EpochState)
    , String -> (ShelleyTxWits AllegraEra -> Assertion) -> TestTree
forall prop.
(HasCallStack, Testable prop) =>
String -> prop -> TestTree
testProperty String
"ShelleyTxWits compatibility" (forall (f :: * -> *).
(EncCBOR (f AllegraEra), EncCBOR (f MaryEra),
 TranslateEra MaryEra f, Show (TranslationError MaryEra f)) =>
f AllegraEra -> Assertion
test @S.ShelleyTxWits)
    , String -> (Update AllegraEra -> Assertion) -> TestTree
forall prop.
(HasCallStack, Testable prop) =>
String -> prop -> TestTree
testProperty String
"Update compatibility" (forall (f :: * -> *).
(EncCBOR (f AllegraEra), EncCBOR (f MaryEra),
 TranslateEra MaryEra f, Show (TranslationError MaryEra f)) =>
f AllegraEra -> Assertion
test @S.Update)
    ]

test ::
  forall f.
  ( EncCBOR (f AllegraEra)
  , EncCBOR (f MaryEra)
  , TranslateEra MaryEra f
  , Show (TranslationError MaryEra f)
  ) =>
  f AllegraEra ->
  Assertion
test :: forall (f :: * -> *).
(EncCBOR (f AllegraEra), EncCBOR (f MaryEra),
 TranslateEra MaryEra f, Show (TranslationError MaryEra f)) =>
f AllegraEra -> Assertion
test = [MaryEra]
-> TranslationContext MaryEra
-> f (PreviousEra MaryEra)
-> Assertion
forall (proxy :: * -> *) era (f :: * -> *).
(HasCallStack, TranslateEra era f, EncCBOR (f era),
 EncCBOR (f (PreviousEra era)), Show (TranslationError era f)) =>
proxy era
-> TranslationContext era -> f (PreviousEra era) -> Assertion
translateEraEncCBOR ([] :: [MaryEra]) TranslationContext MaryEra
NoGenesis MaryEra
forall era. NoGenesis era
NoGenesis