{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE TypeFamilies #-}
{-# OPTIONS_GHC -Wno-orphans #-}

module Cardano.Ledger.Mary.Tx (
  validateTimelock,
)
where

import Cardano.Ledger.Allegra.Tx (validateTimelock)
import Cardano.Ledger.Core (EraTx (..), upgradeTxAuxData, upgradeTxBody, upgradeTxWits)
import Cardano.Ledger.Mary.Era (MaryEra)
import Cardano.Ledger.Mary.PParams ()
import Cardano.Ledger.Mary.TxAuxData ()
import Cardano.Ledger.Mary.TxBody ()
import Cardano.Ledger.Mary.TxWits ()
import Cardano.Ledger.Shelley.Tx (
  ShelleyTx (..),
  auxDataShelleyTxL,
  bodyShelleyTxL,
  mkBasicShelleyTx,
  shelleyMinFeeTx,
  sizeShelleyTxF,
  wireSizeShelleyTxF,
  witsShelleyTxL,
 )

-- ========================================

instance EraTx MaryEra where
  type Tx MaryEra = ShelleyTx MaryEra

  mkBasicTx :: TxBody MaryEra -> Tx MaryEra
mkBasicTx = forall era. EraTx era => TxBody era -> ShelleyTx era
mkBasicShelleyTx

  bodyTxL :: Lens' (Tx MaryEra) (TxBody MaryEra)
bodyTxL = forall era. EraTx era => Lens' (ShelleyTx era) (TxBody era)
bodyShelleyTxL
  {-# INLINE bodyTxL #-}

  witsTxL :: Lens' (Tx MaryEra) (TxWits MaryEra)
witsTxL = forall era. EraTx era => Lens' (ShelleyTx era) (TxWits era)
witsShelleyTxL
  {-# INLINE witsTxL #-}

  auxDataTxL :: Lens' (Tx MaryEra) (StrictMaybe (TxAuxData MaryEra))
auxDataTxL = forall era.
EraTx era =>
Lens' (ShelleyTx era) (StrictMaybe (TxAuxData era))
auxDataShelleyTxL
  {-# INLINE auxDataTxL #-}

  sizeTxF :: SimpleGetter (Tx MaryEra) Integer
sizeTxF = forall era. Era era => SimpleGetter (ShelleyTx era) Integer
sizeShelleyTxF
  {-# INLINE sizeTxF #-}

  wireSizeTxF :: SimpleGetter (Tx MaryEra) Word32
wireSizeTxF = forall era. Era era => SimpleGetter (ShelleyTx era) Word32
wireSizeShelleyTxF
  {-# INLINE wireSizeTxF #-}

  validateNativeScript :: Tx MaryEra -> NativeScript MaryEra -> Bool
validateNativeScript = forall era.
(EraTx era, AllegraEraTxBody era, AllegraEraScript era) =>
Tx era -> NativeScript era -> Bool
validateTimelock
  {-# INLINE validateNativeScript #-}

  getMinFeeTx :: PParams MaryEra -> Tx MaryEra -> Int -> Coin
getMinFeeTx PParams MaryEra
pp Tx MaryEra
tx Int
_ = forall era. EraTx era => PParams era -> Tx era -> Coin
shelleyMinFeeTx PParams MaryEra
pp Tx MaryEra
tx

  upgradeTx :: EraTx (PreviousEra MaryEra) =>
Tx (PreviousEra MaryEra)
-> Either (TxUpgradeError MaryEra) (Tx MaryEra)
upgradeTx (ShelleyTx TxBody AllegraEra
txb TxWits AllegraEra
txwits StrictMaybe (TxAuxData AllegraEra)
txAux) =
    forall era.
EraTx era =>
TxBody era
-> TxWits era -> StrictMaybe (TxAuxData era) -> ShelleyTx era
ShelleyTx
      forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall era.
(EraTxBody era, EraTxBody (PreviousEra era)) =>
TxBody (PreviousEra era)
-> Either (TxBodyUpgradeError era) (TxBody era)
upgradeTxBody TxBody AllegraEra
txb
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall era.
(EraTxWits era, EraTxWits (PreviousEra era)) =>
TxWits (PreviousEra era) -> TxWits era
upgradeTxWits TxWits AllegraEra
txwits)
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall era.
(EraTxAuxData era, EraTxAuxData (PreviousEra era)) =>
TxAuxData (PreviousEra era) -> TxAuxData era
upgradeTxAuxData StrictMaybe (TxAuxData AllegraEra)
txAux)