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

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

import Cardano.Ledger.Alonzo (Alonzo)
import Cardano.Ledger.BaseTypes hiding ((==>))
import Cardano.Ledger.Mary (Mary)
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 Mary) @(TxAuxData Alonzo)
          (forall era. Era era => Version
eraProtVerLow @Mary)
          (forall era. Era era => Version
eraProtVerLow @Alonzo)
          (\TxAuxData Alonzo
_ TxAuxData Mary
_ -> 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 Mary
txBody ->
        let hasDeprecatedField :: Bool
hasDeprecatedField =
              case TxBody Mary
txBody forall s a. s -> Getting a s a -> a
^. forall era.
ShelleyEraTxBody era =>
Lens' (TxBody era) (StrictMaybe (Update era))
updateTxBodyL of
                StrictMaybe (Update Mary)
SNothing -> Bool
False
                SJust (Update (ProposedPPUpdates Map (KeyHash 'Genesis (EraCrypto Mary)) (PParamsUpdate Mary)
ups) EpochNo
_) ->
                  forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (\PParamsUpdate Mary
ppu -> forall a. StrictMaybe a -> Bool
isSJust (PParamsUpdate Mary
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 (EraCrypto Mary)) (PParamsUpdate Mary)
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 Mary) @(TxBody Alonzo)
                      (forall era. Era era => Version
eraProtVerLow @Mary)
                      (forall era. Era era => Version
eraProtVerLow @Alonzo)
                      (\TxBody Alonzo
_ TxBody Mary
_ -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ())
                      TxBody Mary
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 Mary) @(TxWits Alonzo)
          (forall era. Era era => Version
eraProtVerLow @Mary)
          (forall era. Era era => Version
eraProtVerLow @Alonzo)
          (\TxWits Alonzo
_ TxWits Mary
_ -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ())
    ]