{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -Wno-orphans #-}

module Test.Cardano.Ledger.Alonzo.Translation (
  tests,
) where

import Cardano.Ledger.Alonzo (AlonzoEra)
import Cardano.Ledger.BaseTypes hiding ((==>))
import Cardano.Ledger.Mary (MaryEra)
import Cardano.Ledger.Shelley.Core
import Cardano.Ledger.Shelley.PParams
import Lens.Micro
import Test.Cardano.Ledger.AllegraEraGen ()
import Test.Cardano.Ledger.Alonzo.Binary.Annotator ()
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.QuickCheck ((==>))
import Test.QuickCheck.Monadic
import Test.Tasty (TestTree, testGroup)
import Test.Tasty.QuickCheck (testProperty)

tests :: TestTree
tests :: TestTree
tests =
  TestName -> [TestTree] -> TestTree
testGroup
    TestName
"Translation"
    [ TestTree
alonzoEncodeDecodeTests
    ]

alonzoEncodeDecodeTests :: TestTree
alonzoEncodeDecodeTests :: TestTree
alonzoEncodeDecodeTests =
  TestName -> [TestTree] -> TestTree
testGroup
    TestName
"encoded mary types can be decoded as alonzo types"
    [ TestName -> (TxAuxData MaryEra -> Expectation) -> TestTree
forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"decoding auxilliary (Annotator)" ((TxAuxData MaryEra -> Expectation) -> TestTree)
-> (TxAuxData MaryEra -> Expectation) -> TestTree
forall a b. (a -> b) -> a -> b
$
        forall a b.
(ToCBOR a, DecCBOR (Annotator b), HasCallStack) =>
Version -> Version -> (b -> a -> Expectation) -> a -> Expectation
embedTripAnnExpectation @(TxAuxData MaryEra) @(TxAuxData AlonzoEra)
          (forall era. Era era => Version
eraProtVerLow @MaryEra)
          (forall era. Era era => Version
eraProtVerLow @AlonzoEra)
          (\TxAuxData AlonzoEra
_ TxAuxData MaryEra
_ -> () -> Expectation
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ())
    , TestName -> (TxAuxData MaryEra -> Expectation) -> TestTree
forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"decoding auxilliary" ((TxAuxData MaryEra -> Expectation) -> TestTree)
-> (TxAuxData MaryEra -> Expectation) -> TestTree
forall a b. (a -> b) -> a -> b
$
        forall a b.
(Typeable b, Eq b, HasCallStack) =>
Version
-> Version
-> Trip a b
-> (b -> a -> Expectation)
-> a
-> Expectation
embedTripExpectation @(TxAuxData MaryEra) @(TxAuxData AlonzoEra)
          (forall era. Era era => Version
eraProtVerLow @MaryEra)
          (forall era. Era era => Version
eraProtVerLow @AlonzoEra)
          Trip (AllegraTxAuxData MaryEra) (AlonzoTxAuxData AlonzoEra)
Trip (TxAuxData MaryEra) (TxAuxData AlonzoEra)
forall a b. (EncCBOR a, DecCBOR b) => Trip a b
cborTrip
          (\TxAuxData AlonzoEra
_ TxAuxData MaryEra
_ -> () -> Expectation
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ())
    , TestName -> (TxBody MaryEra -> Property) -> TestTree
forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"decoding txbody" ((TxBody MaryEra -> Property) -> TestTree)
-> (TxBody MaryEra -> Property) -> TestTree
forall a b. (a -> b) -> a -> b
$ \TxBody MaryEra
txBody ->
        let hasDeprecatedField :: Bool
hasDeprecatedField =
              case TxBody MaryEra
txBody TxBody MaryEra
-> Getting
     (StrictMaybe (Update MaryEra))
     (TxBody MaryEra)
     (StrictMaybe (Update MaryEra))
-> StrictMaybe (Update MaryEra)
forall s a. s -> Getting a s a -> a
^. Getting
  (StrictMaybe (Update MaryEra))
  (TxBody MaryEra)
  (StrictMaybe (Update MaryEra))
forall era.
ShelleyEraTxBody era =>
Lens' (TxBody era) (StrictMaybe (Update era))
Lens' (TxBody MaryEra) (StrictMaybe (Update MaryEra))
updateTxBodyL of
                StrictMaybe (Update MaryEra)
SNothing -> Bool
False
                SJust (Update (ProposedPPUpdates Map (KeyHash 'Genesis) (PParamsUpdate MaryEra)
ups) EpochNo
_) ->
                  (PParamsUpdate MaryEra -> Bool)
-> Map (KeyHash 'Genesis) (PParamsUpdate MaryEra) -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (\PParamsUpdate MaryEra
ppu -> StrictMaybe Coin -> Bool
forall a. StrictMaybe a -> Bool
isSJust (PParamsUpdate MaryEra
ppu PParamsUpdate MaryEra
-> Getting
     (StrictMaybe Coin) (PParamsUpdate MaryEra) (StrictMaybe Coin)
-> StrictMaybe Coin
forall s a. s -> Getting a s a -> a
^. Getting
  (StrictMaybe Coin) (PParamsUpdate MaryEra) (StrictMaybe Coin)
forall era.
(EraPParams era, ProtVerAtMost era 4) =>
Lens' (PParamsUpdate era) (StrictMaybe Coin)
Lens' (PParamsUpdate MaryEra) (StrictMaybe Coin)
ppuMinUTxOValueL)) Map (KeyHash 'Genesis) (PParamsUpdate MaryEra)
ups
         in Bool -> Bool
not Bool
hasDeprecatedField Bool -> Property -> Property
forall prop. Testable prop => Bool -> prop -> Property
==>
              PropertyM IO () -> Property
forall a. Testable a => PropertyM IO a -> Property
monadicIO
                ( Expectation -> PropertyM IO ()
forall (m :: * -> *) a. Monad m => m a -> PropertyM m a
run (Expectation -> PropertyM IO ()) -> Expectation -> PropertyM IO ()
forall a b. (a -> b) -> a -> b
$ do
                    forall a b.
(ToCBOR a, DecCBOR (Annotator b), HasCallStack) =>
Version -> Version -> (b -> a -> Expectation) -> a -> Expectation
embedTripAnnExpectation @(TxBody MaryEra) @(TxBody AlonzoEra)
                      (forall era. Era era => Version
eraProtVerLow @MaryEra)
                      (forall era. Era era => Version
eraProtVerLow @AlonzoEra)
                      (\TxBody AlonzoEra
_ TxBody MaryEra
_ -> () -> Expectation
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ())
                      TxBody MaryEra
txBody
                    forall a b.
(Typeable b, Eq b, HasCallStack) =>
Version
-> Version
-> Trip a b
-> (b -> a -> Expectation)
-> a
-> Expectation
embedTripExpectation @(TxBody MaryEra) @(TxBody AlonzoEra)
                      (forall era. Era era => Version
eraProtVerLow @MaryEra)
                      (forall era. Era era => Version
eraProtVerLow @AlonzoEra)
                      Trip (TxBody MaryEra) (TxBody AlonzoEra)
forall a b. (EncCBOR a, DecCBOR b) => Trip a b
cborTrip
                      (\TxBody AlonzoEra
_ TxBody MaryEra
_ -> () -> Expectation
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ())
                      TxBody MaryEra
txBody
                )
    , TestName -> (TxWits MaryEra -> Expectation) -> TestTree
forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"decoding witnesses (Annotator)" ((TxWits MaryEra -> Expectation) -> TestTree)
-> (TxWits MaryEra -> Expectation) -> TestTree
forall a b. (a -> b) -> a -> b
$
        forall a b.
(ToCBOR a, DecCBOR (Annotator b), HasCallStack) =>
Version -> Version -> (b -> a -> Expectation) -> a -> Expectation
embedTripAnnExpectation @(TxWits MaryEra) @(TxWits AlonzoEra)
          (forall era. Era era => Version
eraProtVerLow @MaryEra)
          (forall era. Era era => Version
eraProtVerLow @AlonzoEra)
          (\TxWits AlonzoEra
_ TxWits MaryEra
_ -> () -> Expectation
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ())
    , TestName -> (TxWits MaryEra -> Expectation) -> TestTree
forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"decoding witnesses" ((TxWits MaryEra -> Expectation) -> TestTree)
-> (TxWits MaryEra -> Expectation) -> TestTree
forall a b. (a -> b) -> a -> b
$
        forall a b.
(Typeable b, Eq b, HasCallStack) =>
Version
-> Version
-> Trip a b
-> (b -> a -> Expectation)
-> a
-> Expectation
embedTripExpectation @(TxWits MaryEra) @(TxWits AlonzoEra)
          (forall era. Era era => Version
eraProtVerLow @MaryEra)
          (forall era. Era era => Version
eraProtVerLow @AlonzoEra)
          Trip (TxWits MaryEra) (TxWits AlonzoEra)
Trip (ShelleyTxWits MaryEra) (AlonzoTxWits AlonzoEra)
forall a b. (EncCBOR a, DecCBOR b) => Trip a b
cborTrip
          (\TxWits AlonzoEra
_ TxWits MaryEra
_ -> () -> Expectation
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ())
    ]