{-# 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.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"
    [ forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"decoding auxilliary" 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
_ -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ())
    , forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"decoding txbody" forall a b. (a -> b) -> a -> b
$ \TxBody MaryEra
txBody ->
        let hasDeprecatedField :: Bool
hasDeprecatedField =
              case TxBody MaryEra
txBody forall s a. s -> Getting a s a -> a
^. forall era.
ShelleyEraTxBody era =>
Lens' (TxBody era) (StrictMaybe (Update era))
updateTxBodyL of
                StrictMaybe (Update MaryEra)
SNothing -> Bool
False
                SJust (Update (ProposedPPUpdates Map (KeyHash 'Genesis) (PParamsUpdate MaryEra)
ups) EpochNo
_) ->
                  forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (\PParamsUpdate MaryEra
ppu -> forall a. StrictMaybe a -> Bool
isSJust (PParamsUpdate MaryEra
ppu forall s a. s -> Getting a s a -> a
^. forall era.
(EraPParams era, ProtVerAtMost era 4) =>
Lens' (PParamsUpdate era) (StrictMaybe Coin)
ppuMinUTxOValueL)) Map (KeyHash 'Genesis) (PParamsUpdate MaryEra)
ups
         in Bool -> Bool
not Bool
hasDeprecatedField forall prop. Testable prop => Bool -> prop -> Property
==>
              forall a. Testable a => PropertyM IO a -> Property
monadicIO
                ( forall (m :: * -> *) a. Monad m => m a -> PropertyM m a
run forall a b. (a -> b) -> a -> b
$
                    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
_ -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ())
                      TxBody MaryEra
txBody
                )
    , forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"decoding witnesses" 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
_ -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ())
    ]