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

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

import Cardano.Ledger.Allegra (Allegra)
import Cardano.Ledger.Binary
import Cardano.Ledger.Core
import Cardano.Ledger.Genesis (NoGenesis (..))
import Cardano.Ledger.Mary (Mary)
import Cardano.Ledger.Mary.Translation ()
import Cardano.Ledger.Shelley (Shelley)
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.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, translateEraEncoding)
import Test.Tasty (TestTree, testGroup)
import Test.Tasty.HUnit (Assertion)
import Test.Tasty.QuickCheck (testProperty)

maryEncodeDecodeTests :: TestTree
maryEncodeDecodeTests :: TestTree
maryEncodeDecodeTests =
  TestName -> [TestTree] -> TestTree
testGroup
    TestName
"encoded allegra types can be decoded as mary types"
    [ forall a. Testable a => TestName -> a -> TestTree
testProperty
        TestName
"decoding metadata"
        ( forall a b.
(ToCBOR a, DecCBOR (Annotator b), HasCallStack) =>
Version -> Version -> (b -> a -> Assertion) -> a -> Assertion
embedTripAnnExpectation @(TxAuxData Allegra) @(TxAuxData Mary)
            (forall era. Era era => Version
eraProtVerLow @Shelley)
            (forall era. Era era => Version
eraProtVerLow @Allegra)
            (\TxAuxData Mary
_ TxAuxData (AllegraEra StandardCrypto)
_ -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ())
        )
    ]

maryTranslationTests :: TestTree
maryTranslationTests :: TestTree
maryTranslationTests =
  TestName -> [TestTree] -> TestTree
testGroup
    TestName
"Mary translation binary compatibiliby tests"
    [ forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"Tx compatibility" forall a b. (a -> b) -> a -> b
$
        forall era (f :: * -> *).
(HasCallStack, TranslateEra era f,
 Show (TranslationError era f)) =>
TranslationContext era
-> (f era -> Encoding)
-> (f (PreviousEra era) -> Encoding)
-> f (PreviousEra era)
-> Assertion
translateEraEncoding @Mary @S.ShelleyTx forall era. NoGenesis era
NoGenesis forall a. ToCBOR a => a -> Encoding
toCBOR forall a. ToCBOR a => a -> Encoding
toCBOR
    , forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"ProposedPPUpdates compatibility" (forall (f :: * -> *).
(EncCBOR (f (AllegraEra StandardCrypto)), EncCBOR (f Mary),
 TranslateEra Mary f, Show (TranslationError Mary f)) =>
f (AllegraEra StandardCrypto) -> Assertion
test @S.ProposedPPUpdates)
    , forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"ShelleyGovState compatibility" forall a b. (a -> b) -> a -> b
$
        forall era (f :: * -> *).
(HasCallStack, TranslateEra era f,
 Show (TranslationError era f)) =>
TranslationContext era
-> (f era -> Encoding)
-> (f (PreviousEra era) -> Encoding)
-> f (PreviousEra era)
-> Assertion
translateEraEncoding @Mary @S.ShelleyGovState forall era. NoGenesis era
NoGenesis forall a. ToCBOR a => a -> Encoding
toCBOR forall a. ToCBOR a => a -> Encoding
toCBOR
    , forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"TxOut compatibility" (forall (f :: * -> *).
(EncCBOR (f (AllegraEra StandardCrypto)), EncCBOR (f Mary),
 TranslateEra Mary f, Show (TranslationError Mary f)) =>
f (AllegraEra StandardCrypto) -> Assertion
test @S.ShelleyTxOut)
    , forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"UTxO compatibility" forall a b. (a -> b) -> a -> b
$
        forall era (f :: * -> *).
(HasCallStack, TranslateEra era f,
 Show (TranslationError era f)) =>
TranslationContext era
-> (f era -> Encoding)
-> (f (PreviousEra era) -> Encoding)
-> f (PreviousEra era)
-> Assertion
translateEraEncoding @Mary @S.UTxO forall era. NoGenesis era
NoGenesis forall a. ToCBOR a => a -> Encoding
toCBOR forall a. ToCBOR a => a -> Encoding
toCBOR
    , forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"UTxOState compatibility" forall a b. (a -> b) -> a -> b
$
        forall era (f :: * -> *).
(HasCallStack, TranslateEra era f,
 Show (TranslationError era f)) =>
TranslationContext era
-> (f era -> Encoding)
-> (f (PreviousEra era) -> Encoding)
-> f (PreviousEra era)
-> Assertion
translateEraEncoding @Mary @S.UTxOState forall era. NoGenesis era
NoGenesis forall a. ToCBOR a => a -> Encoding
toCBOR forall a. ToCBOR a => a -> Encoding
toCBOR
    , forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"LedgerState compatibility" forall a b. (a -> b) -> a -> b
$
        forall era (f :: * -> *).
(HasCallStack, TranslateEra era f,
 Show (TranslationError era f)) =>
TranslationContext era
-> (f era -> Encoding)
-> (f (PreviousEra era) -> Encoding)
-> f (PreviousEra era)
-> Assertion
translateEraEncoding @Mary @S.LedgerState forall era. NoGenesis era
NoGenesis forall a. ToCBOR a => a -> Encoding
toCBOR forall a. ToCBOR a => a -> Encoding
toCBOR
    , forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"EpochState compatibility" forall a b. (a -> b) -> a -> b
$
        forall era (f :: * -> *).
(HasCallStack, TranslateEra era f,
 Show (TranslationError era f)) =>
TranslationContext era
-> (f era -> Encoding)
-> (f (PreviousEra era) -> Encoding)
-> f (PreviousEra era)
-> Assertion
translateEraEncoding @Mary @S.EpochState forall era. NoGenesis era
NoGenesis forall a. ToCBOR a => a -> Encoding
toCBOR forall a. ToCBOR a => a -> Encoding
toCBOR
    , forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"ShelleyTxWits compatibility" forall a b. (a -> b) -> a -> b
$
        forall era (f :: * -> *).
(HasCallStack, TranslateEra era f,
 Show (TranslationError era f)) =>
TranslationContext era
-> (f era -> Encoding)
-> (f (PreviousEra era) -> Encoding)
-> f (PreviousEra era)
-> Assertion
translateEraEncoding @Mary @S.ShelleyTxWits forall era. NoGenesis era
NoGenesis forall a. ToCBOR a => a -> Encoding
toCBOR forall a. ToCBOR a => a -> Encoding
toCBOR
    , forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"Update compatibility" (forall (f :: * -> *).
(EncCBOR (f (AllegraEra StandardCrypto)), EncCBOR (f Mary),
 TranslateEra Mary f, Show (TranslationError Mary f)) =>
f (AllegraEra StandardCrypto) -> Assertion
test @S.Update)
    ]

test ::
  forall f.
  ( EncCBOR (f Allegra)
  , EncCBOR (f Mary)
  , TranslateEra Mary f
  , Show (TranslationError Mary f)
  ) =>
  f Allegra ->
  Assertion
test :: forall (f :: * -> *).
(EncCBOR (f (AllegraEra StandardCrypto)), EncCBOR (f Mary),
 TranslateEra Mary f, Show (TranslationError Mary f)) =>
f (AllegraEra StandardCrypto) -> Assertion
test = 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 ([] :: [Mary]) forall era. NoGenesis era
NoGenesis