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

module Test.Cardano.Ledger.Allegra.Translation (
  allegraTranslationTests,
  allegraEncodeDecodeTests,
) where

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

allegraEncodeDecodeTests :: TestTree
allegraEncodeDecodeTests :: TestTree
allegraEncodeDecodeTests =
  TestName -> [TestTree] -> TestTree
testGroup
    TestName
"encoded shelley types can be decoded as allegra types"
    [ TestName -> (ShelleyTxAuxData ShelleyEra -> Assertion) -> TestTree
forall a. Testable a => TestName -> a -> TestTree
testProperty
        TestName
"decoding auxiliary data (Annotator)"
        ( forall a b.
(ToCBOR a, DecCBOR (Annotator b), HasCallStack) =>
Version -> Version -> (b -> a -> Assertion) -> a -> Assertion
embedTripAnnExpectation @(TxAuxData ShelleyEra) @(TxAuxData AllegraEra)
            (forall era. Era era => Version
eraProtVerLow @ShelleyEra)
            (forall era. Era era => Version
eraProtVerLow @AllegraEra)
            (\TxAuxData AllegraEra
_ TxAuxData ShelleyEra
_ -> () -> Assertion
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ())
        )
    , TestName -> (ShelleyTxAuxData ShelleyEra -> Assertion) -> TestTree
forall a. Testable a => TestName -> a -> TestTree
testProperty
        TestName
"decoding auxiliary data"
        ( forall a b.
(Typeable b, Eq b, HasCallStack) =>
Version
-> Version -> Trip a b -> (b -> a -> Assertion) -> a -> Assertion
embedTripExpectation @(TxAuxData ShelleyEra) @(TxAuxData AllegraEra)
            (forall era. Era era => Version
eraProtVerLow @ShelleyEra)
            (forall era. Era era => Version
eraProtVerLow @AllegraEra)
            Trip (TxAuxData ShelleyEra) (TxAuxData AllegraEra)
Trip (ShelleyTxAuxData ShelleyEra) (AllegraTxAuxData AllegraEra)
forall a b. (EncCBOR a, DecCBOR b) => Trip a b
cborTrip
            (\TxAuxData AllegraEra
_ TxAuxData ShelleyEra
_ -> () -> Assertion
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ())
        )
    ]

allegraTranslationTests :: TestTree
allegraTranslationTests :: TestTree
allegraTranslationTests =
  TestName -> [TestTree] -> TestTree
testGroup
    TestName
"Allegra translation binary compatibiliby tests"
    [ TestName
-> (ShelleyTx (PreviousEra AllegraEra) -> Assertion) -> TestTree
forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"Tx compatibility" ((ShelleyTx (PreviousEra AllegraEra) -> Assertion) -> TestTree)
-> (ShelleyTx (PreviousEra AllegraEra) -> Assertion) -> TestTree
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 @AllegraEra @S.ShelleyTx TranslationContext AllegraEra
NoGenesis AllegraEra
forall era. NoGenesis era
NoGenesis ShelleyTx AllegraEra -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR ShelleyTx (PreviousEra AllegraEra) -> Encoding
ShelleyTx ShelleyEra -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR
    , TestName -> (ProposedPPUpdates ShelleyEra -> Assertion) -> TestTree
forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"ProposedPPUpdates compatibility" (forall (f :: * -> *).
(EncCBOR (f AllegraEra), EncCBOR (f ShelleyEra),
 TranslateEra AllegraEra f, Show (TranslationError AllegraEra f)) =>
f ShelleyEra -> Assertion
testTranslation @S.ProposedPPUpdates)
    , TestName
-> (ShelleyGovState (PreviousEra AllegraEra) -> Assertion)
-> TestTree
forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"ShelleyGovState compatibility" ((ShelleyGovState (PreviousEra AllegraEra) -> Assertion)
 -> TestTree)
-> (ShelleyGovState (PreviousEra AllegraEra) -> Assertion)
-> TestTree
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 @AllegraEra @S.ShelleyGovState TranslationContext AllegraEra
NoGenesis AllegraEra
forall era. NoGenesis era
NoGenesis ShelleyGovState AllegraEra -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR ShelleyGovState (PreviousEra AllegraEra) -> Encoding
ShelleyGovState ShelleyEra -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR
    , TestName -> (ShelleyTxOut ShelleyEra -> Assertion) -> TestTree
forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"TxOut compatibility" (forall (f :: * -> *).
(EncCBOR (f AllegraEra), EncCBOR (f ShelleyEra),
 TranslateEra AllegraEra f, Show (TranslationError AllegraEra f)) =>
f ShelleyEra -> Assertion
testTranslation @S.ShelleyTxOut)
    , TestName
-> (UTxO (PreviousEra AllegraEra) -> Assertion) -> TestTree
forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"UTxO compatibility" ((UTxO (PreviousEra AllegraEra) -> Assertion) -> TestTree)
-> (UTxO (PreviousEra AllegraEra) -> Assertion) -> TestTree
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 @AllegraEra @S.UTxO TranslationContext AllegraEra
NoGenesis AllegraEra
forall era. NoGenesis era
NoGenesis UTxO AllegraEra -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR UTxO (PreviousEra AllegraEra) -> Encoding
UTxO ShelleyEra -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR
    , TestName
-> (UTxOState (PreviousEra AllegraEra) -> Assertion) -> TestTree
forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"UTxOState compatibility" ((UTxOState (PreviousEra AllegraEra) -> Assertion) -> TestTree)
-> (UTxOState (PreviousEra AllegraEra) -> Assertion) -> TestTree
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 @AllegraEra @S.UTxOState TranslationContext AllegraEra
NoGenesis AllegraEra
forall era. NoGenesis era
NoGenesis UTxOState AllegraEra -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR UTxOState (PreviousEra AllegraEra) -> Encoding
UTxOState ShelleyEra -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR
    , TestName
-> (LedgerState (PreviousEra AllegraEra) -> Assertion) -> TestTree
forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"LedgerState compatibility" ((LedgerState (PreviousEra AllegraEra) -> Assertion) -> TestTree)
-> (LedgerState (PreviousEra AllegraEra) -> Assertion) -> TestTree
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 @AllegraEra @S.LedgerState TranslationContext AllegraEra
NoGenesis AllegraEra
forall era. NoGenesis era
NoGenesis LedgerState AllegraEra -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR LedgerState (PreviousEra AllegraEra) -> Encoding
LedgerState ShelleyEra -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR
    , TestName
-> (EpochState (PreviousEra AllegraEra) -> Assertion) -> TestTree
forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"EpochState compatibility" ((EpochState (PreviousEra AllegraEra) -> Assertion) -> TestTree)
-> (EpochState (PreviousEra AllegraEra) -> Assertion) -> TestTree
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 @AllegraEra @S.EpochState TranslationContext AllegraEra
NoGenesis AllegraEra
forall era. NoGenesis era
NoGenesis EpochState AllegraEra -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR EpochState (PreviousEra AllegraEra) -> Encoding
EpochState ShelleyEra -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR
    , TestName
-> (ShelleyTxWits (PreviousEra AllegraEra) -> Assertion)
-> TestTree
forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"ShelleyTxWits compatibility" ((ShelleyTxWits (PreviousEra AllegraEra) -> Assertion) -> TestTree)
-> (ShelleyTxWits (PreviousEra AllegraEra) -> Assertion)
-> TestTree
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 @AllegraEra @S.ShelleyTxWits TranslationContext AllegraEra
NoGenesis AllegraEra
forall era. NoGenesis era
NoGenesis ShelleyTxWits AllegraEra -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR ShelleyTxWits (PreviousEra AllegraEra) -> Encoding
ShelleyTxWits ShelleyEra -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR
    , TestName -> (Update ShelleyEra -> Assertion) -> TestTree
forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"Update compatibility" (forall (f :: * -> *).
(EncCBOR (f AllegraEra), EncCBOR (f ShelleyEra),
 TranslateEra AllegraEra f, Show (TranslationError AllegraEra f)) =>
f ShelleyEra -> Assertion
testTranslation @S.Update)
    ]

testTranslation ::
  forall f.
  ( EncCBOR (f AllegraEra)
  , EncCBOR (f ShelleyEra)
  , TranslateEra AllegraEra f
  , Show (TranslationError AllegraEra f)
  ) =>
  f ShelleyEra ->
  Assertion
testTranslation :: forall (f :: * -> *).
(EncCBOR (f AllegraEra), EncCBOR (f ShelleyEra),
 TranslateEra AllegraEra f, Show (TranslationError AllegraEra f)) =>
f ShelleyEra -> Assertion
testTranslation = [AllegraEra]
-> TranslationContext AllegraEra
-> f (PreviousEra AllegraEra)
-> 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 ([] :: [AllegraEra]) TranslationContext AllegraEra
NoGenesis AllegraEra
forall era. NoGenesis era
NoGenesis