{-# 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.Crypto (Crypto, StandardCrypto)
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 Crypto c => EraTx (MaryEra c) where
  {-# SPECIALIZE instance EraTx (MaryEra StandardCrypto) #-}

  type Tx (MaryEra c) = ShelleyTx (MaryEra c)

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

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

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

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

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

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

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

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

  upgradeTx :: EraTx (PreviousEra (MaryEra c)) =>
Tx (PreviousEra (MaryEra c))
-> Either (TxUpgradeError (MaryEra c)) (Tx (MaryEra c))
upgradeTx (ShelleyTx TxBody (AllegraEra c)
txb TxWits (AllegraEra c)
txwits StrictMaybe (TxAuxData (AllegraEra c))
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 c)
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 c)
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 c))
txAux)