{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# OPTIONS_GHC -Wno-orphans #-}

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

import Cardano.Ledger.Allegra.Tx (Tx (..), validateTimelock)
import Cardano.Ledger.Binary (Annotator, DecCBOR (..), EncCBOR, ToCBOR)
import Cardano.Ledger.Core (EraTx (..), HasEraTxLevel (..), STxTopLevel (..))
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.MemoBytes (EqRaw (..))
import Cardano.Ledger.Shelley.Tx (
  ShelleyTx (..),
  auxDataShelleyTxL,
  bodyShelleyTxL,
  mkBasicShelleyTx,
  shelleyMinFeeTx,
  shelleyTxEqRaw,
  sizeShelleyTxF,
  witsShelleyTxL,
 )
import Control.DeepSeq (NFData)
import Data.Typeable (Typeable)
import GHC.Generics (Generic)
import Lens.Micro (Lens', lens)
import NoThunks.Class (NoThunks)

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

instance HasEraTxLevel Tx MaryEra where
  toSTxLevel :: forall (l :: TxLevel). Tx l MaryEra -> STxLevel l MaryEra
toSTxLevel (MkMaryTx ShelleyTx {}) = forall era. STxTopLevel TopTx era
STopTxOnly @MaryEra

instance EraTx MaryEra where
  newtype Tx t MaryEra = MkMaryTx {forall (t :: TxLevel). Tx t MaryEra -> ShelleyTx t MaryEra
unMaryTx :: ShelleyTx t MaryEra}
    deriving newtype (Tx t MaryEra -> Tx t MaryEra -> Bool
(Tx t MaryEra -> Tx t MaryEra -> Bool)
-> (Tx t MaryEra -> Tx t MaryEra -> Bool) -> Eq (Tx t MaryEra)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall (t :: TxLevel). Tx t MaryEra -> Tx t MaryEra -> Bool
$c== :: forall (t :: TxLevel). Tx t MaryEra -> Tx t MaryEra -> Bool
== :: Tx t MaryEra -> Tx t MaryEra -> Bool
$c/= :: forall (t :: TxLevel). Tx t MaryEra -> Tx t MaryEra -> Bool
/= :: Tx t MaryEra -> Tx t MaryEra -> Bool
Eq, Tx t MaryEra -> ()
(Tx t MaryEra -> ()) -> NFData (Tx t MaryEra)
forall a. (a -> ()) -> NFData a
forall (t :: TxLevel). Tx t MaryEra -> ()
$crnf :: forall (t :: TxLevel). Tx t MaryEra -> ()
rnf :: Tx t MaryEra -> ()
NFData, Context -> Tx t MaryEra -> IO (Maybe ThunkInfo)
Proxy (Tx t MaryEra) -> String
(Context -> Tx t MaryEra -> IO (Maybe ThunkInfo))
-> (Context -> Tx t MaryEra -> IO (Maybe ThunkInfo))
-> (Proxy (Tx t MaryEra) -> String)
-> NoThunks (Tx t MaryEra)
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
forall (t :: TxLevel).
Typeable t =>
Context -> Tx t MaryEra -> IO (Maybe ThunkInfo)
forall (t :: TxLevel). Typeable t => Proxy (Tx t MaryEra) -> String
$cnoThunks :: forall (t :: TxLevel).
Typeable t =>
Context -> Tx t MaryEra -> IO (Maybe ThunkInfo)
noThunks :: Context -> Tx t MaryEra -> IO (Maybe ThunkInfo)
$cwNoThunks :: forall (t :: TxLevel).
Typeable t =>
Context -> Tx t MaryEra -> IO (Maybe ThunkInfo)
wNoThunks :: Context -> Tx t MaryEra -> IO (Maybe ThunkInfo)
$cshowTypeOf :: forall (t :: TxLevel). Typeable t => Proxy (Tx t MaryEra) -> String
showTypeOf :: Proxy (Tx t MaryEra) -> String
NoThunks, Int -> Tx t MaryEra -> ShowS
[Tx t MaryEra] -> ShowS
Tx t MaryEra -> String
(Int -> Tx t MaryEra -> ShowS)
-> (Tx t MaryEra -> String)
-> ([Tx t MaryEra] -> ShowS)
-> Show (Tx t MaryEra)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall (t :: TxLevel). Int -> Tx t MaryEra -> ShowS
forall (t :: TxLevel). [Tx t MaryEra] -> ShowS
forall (t :: TxLevel). Tx t MaryEra -> String
$cshowsPrec :: forall (t :: TxLevel). Int -> Tx t MaryEra -> ShowS
showsPrec :: Int -> Tx t MaryEra -> ShowS
$cshow :: forall (t :: TxLevel). Tx t MaryEra -> String
show :: Tx t MaryEra -> String
$cshowList :: forall (t :: TxLevel). [Tx t MaryEra] -> ShowS
showList :: [Tx t MaryEra] -> ShowS
Show, Typeable (Tx t MaryEra)
Typeable (Tx t MaryEra) =>
(Tx t MaryEra -> Encoding)
-> ((forall t. ToCBOR t => Proxy t -> Size)
    -> Proxy (Tx t MaryEra) -> Size)
-> ((forall t. ToCBOR t => Proxy t -> Size)
    -> Proxy [Tx t MaryEra] -> Size)
-> ToCBOR (Tx t MaryEra)
Tx t MaryEra -> Encoding
(forall t. ToCBOR t => Proxy t -> Size)
-> Proxy [Tx t MaryEra] -> Size
(forall t. ToCBOR t => Proxy t -> Size)
-> Proxy (Tx t MaryEra) -> Size
forall a.
Typeable a =>
(a -> Encoding)
-> ((forall t. ToCBOR t => Proxy t -> Size) -> Proxy a -> Size)
-> ((forall t. ToCBOR t => Proxy t -> Size) -> Proxy [a] -> Size)
-> ToCBOR a
forall (t :: TxLevel). Typeable t => Typeable (Tx t MaryEra)
forall (t :: TxLevel). Typeable t => Tx t MaryEra -> Encoding
forall (t :: TxLevel).
Typeable t =>
(forall t. ToCBOR t => Proxy t -> Size)
-> Proxy [Tx t MaryEra] -> Size
forall (t :: TxLevel).
Typeable t =>
(forall t. ToCBOR t => Proxy t -> Size)
-> Proxy (Tx t MaryEra) -> Size
$ctoCBOR :: forall (t :: TxLevel). Typeable t => Tx t MaryEra -> Encoding
toCBOR :: Tx t MaryEra -> Encoding
$cencodedSizeExpr :: forall (t :: TxLevel).
Typeable t =>
(forall t. ToCBOR t => Proxy t -> Size)
-> Proxy (Tx t MaryEra) -> Size
encodedSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy (Tx t MaryEra) -> Size
$cencodedListSizeExpr :: forall (t :: TxLevel).
Typeable t =>
(forall t. ToCBOR t => Proxy t -> Size)
-> Proxy [Tx t MaryEra] -> Size
encodedListSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy [Tx t MaryEra] -> Size
ToCBOR, Tx t MaryEra -> Encoding
(Tx t MaryEra -> Encoding) -> EncCBOR (Tx t MaryEra)
forall a. (a -> Encoding) -> EncCBOR a
forall (t :: TxLevel). Tx t MaryEra -> Encoding
$cencCBOR :: forall (t :: TxLevel). Tx t MaryEra -> Encoding
encCBOR :: Tx t MaryEra -> Encoding
EncCBOR)
    deriving ((forall x. Tx t MaryEra -> Rep (Tx t MaryEra) x)
-> (forall x. Rep (Tx t MaryEra) x -> Tx t MaryEra)
-> Generic (Tx t MaryEra)
forall x. Rep (Tx t MaryEra) x -> Tx t MaryEra
forall x. Tx t MaryEra -> Rep (Tx t MaryEra) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (t :: TxLevel) x. Rep (Tx t MaryEra) x -> Tx t MaryEra
forall (t :: TxLevel) x. Tx t MaryEra -> Rep (Tx t MaryEra) x
$cfrom :: forall (t :: TxLevel) x. Tx t MaryEra -> Rep (Tx t MaryEra) x
from :: forall x. Tx t MaryEra -> Rep (Tx t MaryEra) x
$cto :: forall (t :: TxLevel) x. Rep (Tx t MaryEra) x -> Tx t MaryEra
to :: forall x. Rep (Tx t MaryEra) x -> Tx t MaryEra
Generic)

  mkBasicTx :: forall (l :: TxLevel). TxBody l MaryEra -> Tx l MaryEra
mkBasicTx = ShelleyTx l MaryEra -> Tx l MaryEra
forall (t :: TxLevel). ShelleyTx t MaryEra -> Tx t MaryEra
MkMaryTx (ShelleyTx l MaryEra -> Tx l MaryEra)
-> (TxBody l MaryEra -> ShelleyTx l MaryEra)
-> TxBody l MaryEra
-> Tx l MaryEra
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TxBody l MaryEra -> ShelleyTx l MaryEra
forall era (l :: TxLevel).
(EraTx era, STxLevel l era ~ STxTopLevel l era) =>
TxBody l era -> ShelleyTx l era
mkBasicShelleyTx

  bodyTxL :: forall (l :: TxLevel). Lens' (Tx l MaryEra) (TxBody l MaryEra)
bodyTxL = (ShelleyTx l MaryEra -> f (ShelleyTx l MaryEra))
-> Tx l MaryEra -> f (Tx l MaryEra)
forall (t :: TxLevel) (f :: * -> *).
Functor f =>
(ShelleyTx t MaryEra -> f (ShelleyTx t MaryEra))
-> Tx t MaryEra -> f (Tx t MaryEra)
maryTxL ((ShelleyTx l MaryEra -> f (ShelleyTx l MaryEra))
 -> Tx l MaryEra -> f (Tx l MaryEra))
-> ((TxBody l MaryEra -> f (TxBody l MaryEra))
    -> ShelleyTx l MaryEra -> f (ShelleyTx l MaryEra))
-> (TxBody l MaryEra -> f (TxBody l MaryEra))
-> Tx l MaryEra
-> f (Tx l MaryEra)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TxBody l MaryEra -> f (TxBody l MaryEra))
-> ShelleyTx l MaryEra -> f (ShelleyTx l MaryEra)
forall (l :: TxLevel) era (f :: * -> *).
Functor f =>
(TxBody l era -> f (TxBody l era))
-> ShelleyTx l era -> f (ShelleyTx l era)
bodyShelleyTxL
  {-# INLINE bodyTxL #-}

  witsTxL :: forall (l :: TxLevel). Lens' (Tx l MaryEra) (TxWits MaryEra)
witsTxL = (ShelleyTx l MaryEra -> f (ShelleyTx l MaryEra))
-> Tx l MaryEra -> f (Tx l MaryEra)
forall (t :: TxLevel) (f :: * -> *).
Functor f =>
(ShelleyTx t MaryEra -> f (ShelleyTx t MaryEra))
-> Tx t MaryEra -> f (Tx t MaryEra)
maryTxL ((ShelleyTx l MaryEra -> f (ShelleyTx l MaryEra))
 -> Tx l MaryEra -> f (Tx l MaryEra))
-> ((ShelleyTxWits MaryEra -> f (ShelleyTxWits MaryEra))
    -> ShelleyTx l MaryEra -> f (ShelleyTx l MaryEra))
-> (ShelleyTxWits MaryEra -> f (ShelleyTxWits MaryEra))
-> Tx l MaryEra
-> f (Tx l MaryEra)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TxWits MaryEra -> f (TxWits MaryEra))
-> ShelleyTx l MaryEra -> f (ShelleyTx l MaryEra)
(ShelleyTxWits MaryEra -> f (ShelleyTxWits MaryEra))
-> ShelleyTx l MaryEra -> f (ShelleyTx l MaryEra)
forall (l :: TxLevel) era (f :: * -> *).
Functor f =>
(TxWits era -> f (TxWits era))
-> ShelleyTx l era -> f (ShelleyTx l era)
witsShelleyTxL
  {-# INLINE witsTxL #-}

  auxDataTxL :: forall (l :: TxLevel).
Lens' (Tx l MaryEra) (StrictMaybe (TxAuxData MaryEra))
auxDataTxL = (ShelleyTx l MaryEra -> f (ShelleyTx l MaryEra))
-> Tx l MaryEra -> f (Tx l MaryEra)
forall (t :: TxLevel) (f :: * -> *).
Functor f =>
(ShelleyTx t MaryEra -> f (ShelleyTx t MaryEra))
-> Tx t MaryEra -> f (Tx t MaryEra)
maryTxL ((ShelleyTx l MaryEra -> f (ShelleyTx l MaryEra))
 -> Tx l MaryEra -> f (Tx l MaryEra))
-> ((StrictMaybe (AllegraTxAuxData MaryEra)
     -> f (StrictMaybe (AllegraTxAuxData MaryEra)))
    -> ShelleyTx l MaryEra -> f (ShelleyTx l MaryEra))
-> (StrictMaybe (AllegraTxAuxData MaryEra)
    -> f (StrictMaybe (AllegraTxAuxData MaryEra)))
-> Tx l MaryEra
-> f (Tx l MaryEra)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (StrictMaybe (AllegraTxAuxData MaryEra)
 -> f (StrictMaybe (AllegraTxAuxData MaryEra)))
-> ShelleyTx l MaryEra -> f (ShelleyTx l MaryEra)
(StrictMaybe (TxAuxData MaryEra)
 -> f (StrictMaybe (TxAuxData MaryEra)))
-> ShelleyTx l MaryEra -> f (ShelleyTx l MaryEra)
forall (l :: TxLevel) era (f :: * -> *).
Functor f =>
(StrictMaybe (TxAuxData era) -> f (StrictMaybe (TxAuxData era)))
-> ShelleyTx l era -> f (ShelleyTx l era)
auxDataShelleyTxL
  {-# INLINE auxDataTxL #-}

  sizeTxF :: forall (l :: TxLevel).
HasCallStack =>
SimpleGetter (Tx l MaryEra) Word32
sizeTxF = (ShelleyTx l MaryEra -> Const r (ShelleyTx l MaryEra))
-> Tx l MaryEra -> Const r (Tx l MaryEra)
forall (t :: TxLevel) (f :: * -> *).
Functor f =>
(ShelleyTx t MaryEra -> f (ShelleyTx t MaryEra))
-> Tx t MaryEra -> f (Tx t MaryEra)
maryTxL ((ShelleyTx l MaryEra -> Const r (ShelleyTx l MaryEra))
 -> Tx l MaryEra -> Const r (Tx l MaryEra))
-> ((Word32 -> Const r Word32)
    -> ShelleyTx l MaryEra -> Const r (ShelleyTx l MaryEra))
-> (Word32 -> Const r Word32)
-> Tx l MaryEra
-> Const r (Tx l MaryEra)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word32 -> Const r Word32)
-> ShelleyTx l MaryEra -> Const r (ShelleyTx l MaryEra)
SimpleGetter (ShelleyTx l MaryEra) Word32
forall era (l :: TxLevel).
(HasCallStack, EraTx era) =>
SimpleGetter (ShelleyTx l era) Word32
sizeShelleyTxF
  {-# INLINE sizeTxF #-}

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

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

instance EqRaw (Tx t MaryEra) where
  eqRaw :: Tx t MaryEra -> Tx t MaryEra -> Bool
eqRaw = Tx t MaryEra -> Tx t MaryEra -> Bool
forall era (l :: TxLevel).
EraTx era =>
Tx l era -> Tx l era -> Bool
shelleyTxEqRaw

maryTxL :: Lens' (Tx t MaryEra) (ShelleyTx t MaryEra)
maryTxL :: forall (t :: TxLevel) (f :: * -> *).
Functor f =>
(ShelleyTx t MaryEra -> f (ShelleyTx t MaryEra))
-> Tx t MaryEra -> f (Tx t MaryEra)
maryTxL = (Tx t MaryEra -> ShelleyTx t MaryEra)
-> (Tx t MaryEra -> ShelleyTx t MaryEra -> Tx t MaryEra)
-> Lens
     (Tx t MaryEra)
     (Tx t MaryEra)
     (ShelleyTx t MaryEra)
     (ShelleyTx t MaryEra)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens Tx t MaryEra -> ShelleyTx t MaryEra
forall (t :: TxLevel). Tx t MaryEra -> ShelleyTx t MaryEra
unMaryTx (\Tx t MaryEra
x ShelleyTx t MaryEra
y -> Tx t MaryEra
x {unMaryTx = y})

instance Typeable t => DecCBOR (Annotator (Tx t MaryEra)) where
  decCBOR :: forall s. Decoder s (Annotator (Tx t MaryEra))
decCBOR = (ShelleyTx t MaryEra -> Tx t MaryEra)
-> Annotator (ShelleyTx t MaryEra) -> Annotator (Tx t MaryEra)
forall a b. (a -> b) -> Annotator a -> Annotator b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ShelleyTx t MaryEra -> Tx t MaryEra
forall (t :: TxLevel). ShelleyTx t MaryEra -> Tx t MaryEra
MkMaryTx (Annotator (ShelleyTx t MaryEra) -> Annotator (Tx t MaryEra))
-> Decoder s (Annotator (ShelleyTx t MaryEra))
-> Decoder s (Annotator (Tx t MaryEra))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s (Annotator (ShelleyTx t MaryEra))
forall s. Decoder s (Annotator (ShelleyTx t MaryEra))
forall a s. DecCBOR a => Decoder s a
decCBOR