{-# 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 = TxBody MaryEra -> Tx MaryEra
TxBody MaryEra -> ShelleyTx MaryEra
forall era. EraTx era => TxBody era -> ShelleyTx era
mkBasicShelleyTx

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

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

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

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

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

  validateNativeScript :: Tx MaryEra -> NativeScript MaryEra -> Bool
validateNativeScript = Tx MaryEra -> NativeScript MaryEra -> Bool
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
_ = PParams MaryEra -> Tx MaryEra -> Coin
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) =
    TxBody MaryEra
-> TxWits MaryEra
-> StrictMaybe (TxAuxData MaryEra)
-> ShelleyTx MaryEra
TxBody MaryEra
-> ShelleyTxWits MaryEra
-> StrictMaybe (AllegraTxAuxData MaryEra)
-> ShelleyTx MaryEra
forall era.
EraTx era =>
TxBody era
-> TxWits era -> StrictMaybe (TxAuxData era) -> ShelleyTx era
ShelleyTx
      (TxBody MaryEra
 -> ShelleyTxWits MaryEra
 -> StrictMaybe (AllegraTxAuxData MaryEra)
 -> ShelleyTx MaryEra)
-> Either Void (TxBody MaryEra)
-> Either
     Void
     (ShelleyTxWits MaryEra
      -> StrictMaybe (AllegraTxAuxData MaryEra) -> ShelleyTx MaryEra)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TxBody (PreviousEra MaryEra)
-> Either (TxBodyUpgradeError MaryEra) (TxBody MaryEra)
forall era.
(EraTxBody era, EraTxBody (PreviousEra era)) =>
TxBody (PreviousEra era)
-> Either (TxBodyUpgradeError era) (TxBody era)
upgradeTxBody TxBody AllegraEra
TxBody (PreviousEra MaryEra)
txb
      Either
  Void
  (ShelleyTxWits MaryEra
   -> StrictMaybe (AllegraTxAuxData MaryEra) -> ShelleyTx MaryEra)
-> Either Void (ShelleyTxWits MaryEra)
-> Either
     Void (StrictMaybe (AllegraTxAuxData MaryEra) -> ShelleyTx MaryEra)
forall a b. Either Void (a -> b) -> Either Void a -> Either Void b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ShelleyTxWits MaryEra -> Either Void (ShelleyTxWits MaryEra)
forall a. a -> Either Void a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TxWits (PreviousEra MaryEra) -> TxWits MaryEra
forall era.
(EraTxWits era, EraTxWits (PreviousEra era)) =>
TxWits (PreviousEra era) -> TxWits era
upgradeTxWits TxWits AllegraEra
TxWits (PreviousEra MaryEra)
txwits)
      Either
  Void (StrictMaybe (AllegraTxAuxData MaryEra) -> ShelleyTx MaryEra)
-> Either Void (StrictMaybe (AllegraTxAuxData MaryEra))
-> Either Void (ShelleyTx MaryEra)
forall a b. Either Void (a -> b) -> Either Void a -> Either Void b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> StrictMaybe (AllegraTxAuxData MaryEra)
-> Either Void (StrictMaybe (AllegraTxAuxData MaryEra))
forall a. a -> Either Void a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((TxAuxData (PreviousEra MaryEra) -> AllegraTxAuxData MaryEra)
-> StrictMaybe (TxAuxData (PreviousEra MaryEra))
-> StrictMaybe (AllegraTxAuxData MaryEra)
forall a b. (a -> b) -> StrictMaybe a -> StrictMaybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap TxAuxData (PreviousEra MaryEra) -> AllegraTxAuxData MaryEra
TxAuxData (PreviousEra MaryEra) -> TxAuxData MaryEra
forall era.
(EraTxAuxData era, EraTxAuxData (PreviousEra era)) =>
TxAuxData (PreviousEra era) -> TxAuxData era
upgradeTxAuxData StrictMaybe (TxAuxData AllegraEra)
StrictMaybe (TxAuxData (PreviousEra MaryEra))
txAux)