{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE UndecidableSuperClasses #-}
{-# OPTIONS_GHC -Wno-orphans #-}

-- | This module exports implementations of many of the functions outlined in the Alonzo specification.
--     The link to source of the specification
--       https://github.com/intersectmbo/cardano-ledger/tree/master/eras/alonzo/formal-spec
--     The most recent version of the document can be found here:
--       https://github.com/intersectmbo/cardano-ledger/releases/latest/download/alonzo-ledger.pdf
--     The functions can be found in Figures in that document, and sections of this code refer to those figures.
module Cardano.Ledger.Alonzo.Tx (
  -- Figure 1
  CostModel,
  getLanguageView,
  -- Figure 2
  Data,
  DataHash,
  IsValid (..),
  hashData,
  nonNativeLanguages,
  hashScriptIntegrity,
  EraIndependentScriptIntegrity,
  ScriptIntegrity (ScriptIntegrity),
  ScriptIntegrityHash,
  -- Figure 3
  AlonzoTx (AlonzoTx, body, wits, isValid, auxiliaryData),
  AlonzoEraTx (..),
  mkBasicAlonzoTx,
  bodyAlonzoTxL,
  witsAlonzoTxL,
  auxDataAlonzoTxL,
  sizeAlonzoTxF,
  wireSizeAlonzoTxF,
  isValidAlonzoTxL,
  txdats',
  txscripts',
  txrdmrs,
  TxBody (AlonzoTxBody),
  -- Figure 4
  totExUnits,
  alonzoMinFeeTx,
  --  Figure 5
  Shelley.txouts,
  -- Other
  toCBORForSizeComputation,
  toCBORForMempoolSubmission,
  alonzoEqTxRaw,
) where

import Cardano.Ledger.Allegra.Tx (validateTimelock)
import Cardano.Ledger.Alonzo.Era (AlonzoEra)
import Cardano.Ledger.Alonzo.PParams (
  AlonzoEraPParams,
  LangDepView (..),
  encodeLangViews,
  getLanguageView,
  ppPricesL,
 )
import Cardano.Ledger.Alonzo.Scripts (
  AlonzoEraScript,
  CostModel,
  ExUnits (..),
  txscriptfee,
 )
import Cardano.Ledger.Alonzo.TxBody (
  AlonzoEraTxBody (..),
  AlonzoTxBodyUpgradeError,
  ScriptIntegrityHash,
  TxBody (AlonzoTxBody),
 )
import Cardano.Ledger.Alonzo.TxWits (
  AlonzoEraTxWits (..),
  AlonzoTxWits (..),
  Redeemers (..),
  TxDats (..),
  txrdmrs,
  unRedeemersL,
  unTxDatsL,
 )
import Cardano.Ledger.Binary (
  DecCBOR (..),
  EncCBOR (encCBOR),
  Encoding,
  ToCBOR (..),
  decodeNullStrictMaybe,
  encodeListLen,
  encodeNullMaybe,
  serialize,
  serialize',
 )
import Cardano.Ledger.Binary.Coders
import Cardano.Ledger.Coin (Coin (..))
import Cardano.Ledger.Core
import Cardano.Ledger.MemoBytes (EqRaw (..))
import Cardano.Ledger.Plutus.Data (Data, hashData)
import Cardano.Ledger.Plutus.Language (nonNativeLanguages)
import Cardano.Ledger.Shelley.Tx (ShelleyTx (ShelleyTx), shelleyEqTxRaw)
import qualified Cardano.Ledger.State as Shelley
import Cardano.Ledger.Val (Val ((<+>), (<×>)))
import Control.Arrow (left)
import Control.DeepSeq (NFData (..))
import Data.Aeson (ToJSON (..))
import qualified Data.ByteString.Lazy as LBS
import Data.Maybe.Strict (
  StrictMaybe (..),
  strictMaybeToMaybe,
 )
import Data.Set (Set)
import Data.Typeable (Typeable)
import Data.Word (Word32)
import GHC.Generics (Generic)
import Lens.Micro hiding (set)
import NoThunks.Class (NoThunks)

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

-- | Tag indicating whether non-native scripts in this transaction are expected
-- to validate. This is added by the block creator when constructing the block.
newtype IsValid = IsValid Bool
  deriving (IsValid -> IsValid -> Bool
(IsValid -> IsValid -> Bool)
-> (IsValid -> IsValid -> Bool) -> Eq IsValid
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: IsValid -> IsValid -> Bool
== :: IsValid -> IsValid -> Bool
$c/= :: IsValid -> IsValid -> Bool
/= :: IsValid -> IsValid -> Bool
Eq, Int -> IsValid -> ShowS
[IsValid] -> ShowS
IsValid -> String
(Int -> IsValid -> ShowS)
-> (IsValid -> String) -> ([IsValid] -> ShowS) -> Show IsValid
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> IsValid -> ShowS
showsPrec :: Int -> IsValid -> ShowS
$cshow :: IsValid -> String
show :: IsValid -> String
$cshowList :: [IsValid] -> ShowS
showList :: [IsValid] -> ShowS
Show, (forall x. IsValid -> Rep IsValid x)
-> (forall x. Rep IsValid x -> IsValid) -> Generic IsValid
forall x. Rep IsValid x -> IsValid
forall x. IsValid -> Rep IsValid x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. IsValid -> Rep IsValid x
from :: forall x. IsValid -> Rep IsValid x
$cto :: forall x. Rep IsValid x -> IsValid
to :: forall x. Rep IsValid x -> IsValid
Generic)
  deriving newtype (Context -> IsValid -> IO (Maybe ThunkInfo)
Proxy IsValid -> String
(Context -> IsValid -> IO (Maybe ThunkInfo))
-> (Context -> IsValid -> IO (Maybe ThunkInfo))
-> (Proxy IsValid -> String)
-> NoThunks IsValid
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
$cnoThunks :: Context -> IsValid -> IO (Maybe ThunkInfo)
noThunks :: Context -> IsValid -> IO (Maybe ThunkInfo)
$cwNoThunks :: Context -> IsValid -> IO (Maybe ThunkInfo)
wNoThunks :: Context -> IsValid -> IO (Maybe ThunkInfo)
$cshowTypeOf :: Proxy IsValid -> String
showTypeOf :: Proxy IsValid -> String
NoThunks, IsValid -> ()
(IsValid -> ()) -> NFData IsValid
forall a. (a -> ()) -> NFData a
$crnf :: IsValid -> ()
rnf :: IsValid -> ()
NFData, Typeable IsValid
Typeable IsValid =>
(IsValid -> Encoding)
-> ((forall t. ToCBOR t => Proxy t -> Size)
    -> Proxy IsValid -> Size)
-> ((forall t. ToCBOR t => Proxy t -> Size)
    -> Proxy [IsValid] -> Size)
-> ToCBOR IsValid
IsValid -> Encoding
(forall t. ToCBOR t => Proxy t -> Size) -> Proxy [IsValid] -> Size
(forall t. ToCBOR t => Proxy t -> Size) -> Proxy IsValid -> 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
$ctoCBOR :: IsValid -> Encoding
toCBOR :: IsValid -> Encoding
$cencodedSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size) -> Proxy IsValid -> Size
encodedSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size) -> Proxy IsValid -> Size
$cencodedListSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size) -> Proxy [IsValid] -> Size
encodedListSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size) -> Proxy [IsValid] -> Size
ToCBOR, Typeable IsValid
Typeable IsValid =>
(IsValid -> Encoding)
-> ((forall t. EncCBOR t => Proxy t -> Size)
    -> Proxy IsValid -> Size)
-> ((forall t. EncCBOR t => Proxy t -> Size)
    -> Proxy [IsValid] -> Size)
-> EncCBOR IsValid
IsValid -> Encoding
(forall t. EncCBOR t => Proxy t -> Size) -> Proxy [IsValid] -> Size
(forall t. EncCBOR t => Proxy t -> Size) -> Proxy IsValid -> Size
forall a.
Typeable a =>
(a -> Encoding)
-> ((forall t. EncCBOR t => Proxy t -> Size) -> Proxy a -> Size)
-> ((forall t. EncCBOR t => Proxy t -> Size) -> Proxy [a] -> Size)
-> EncCBOR a
$cencCBOR :: IsValid -> Encoding
encCBOR :: IsValid -> Encoding
$cencodedSizeExpr :: (forall t. EncCBOR t => Proxy t -> Size) -> Proxy IsValid -> Size
encodedSizeExpr :: (forall t. EncCBOR t => Proxy t -> Size) -> Proxy IsValid -> Size
$cencodedListSizeExpr :: (forall t. EncCBOR t => Proxy t -> Size) -> Proxy [IsValid] -> Size
encodedListSizeExpr :: (forall t. EncCBOR t => Proxy t -> Size) -> Proxy [IsValid] -> Size
EncCBOR, Typeable IsValid
Typeable IsValid =>
(forall s. Decoder s IsValid)
-> (forall s. Proxy IsValid -> Decoder s ())
-> (Proxy IsValid -> Text)
-> DecCBOR IsValid
Proxy IsValid -> Text
forall s. Decoder s IsValid
forall a.
Typeable a =>
(forall s. Decoder s a)
-> (forall s. Proxy a -> Decoder s ())
-> (Proxy a -> Text)
-> DecCBOR a
forall s. Proxy IsValid -> Decoder s ()
$cdecCBOR :: forall s. Decoder s IsValid
decCBOR :: forall s. Decoder s IsValid
$cdropCBOR :: forall s. Proxy IsValid -> Decoder s ()
dropCBOR :: forall s. Proxy IsValid -> Decoder s ()
$clabel :: Proxy IsValid -> Text
label :: Proxy IsValid -> Text
DecCBOR, [IsValid] -> Value
[IsValid] -> Encoding
IsValid -> Bool
IsValid -> Value
IsValid -> Encoding
(IsValid -> Value)
-> (IsValid -> Encoding)
-> ([IsValid] -> Value)
-> ([IsValid] -> Encoding)
-> (IsValid -> Bool)
-> ToJSON IsValid
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: IsValid -> Value
toJSON :: IsValid -> Value
$ctoEncoding :: IsValid -> Encoding
toEncoding :: IsValid -> Encoding
$ctoJSONList :: [IsValid] -> Value
toJSONList :: [IsValid] -> Value
$ctoEncodingList :: [IsValid] -> Encoding
toEncodingList :: [IsValid] -> Encoding
$comitField :: IsValid -> Bool
omitField :: IsValid -> Bool
ToJSON)

data AlonzoTx era = AlonzoTx
  { forall era. AlonzoTx era -> TxBody era
body :: !(TxBody era)
  , forall era. AlonzoTx era -> TxWits era
wits :: !(TxWits era)
  , forall era. AlonzoTx era -> IsValid
isValid :: !IsValid
  , forall era. AlonzoTx era -> StrictMaybe (TxAuxData era)
auxiliaryData :: !(StrictMaybe (TxAuxData era))
  }
  deriving ((forall x. AlonzoTx era -> Rep (AlonzoTx era) x)
-> (forall x. Rep (AlonzoTx era) x -> AlonzoTx era)
-> Generic (AlonzoTx era)
forall x. Rep (AlonzoTx era) x -> AlonzoTx era
forall x. AlonzoTx era -> Rep (AlonzoTx era) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall era x. Rep (AlonzoTx era) x -> AlonzoTx era
forall era x. AlonzoTx era -> Rep (AlonzoTx era) x
$cfrom :: forall era x. AlonzoTx era -> Rep (AlonzoTx era) x
from :: forall x. AlonzoTx era -> Rep (AlonzoTx era) x
$cto :: forall era x. Rep (AlonzoTx era) x -> AlonzoTx era
to :: forall x. Rep (AlonzoTx era) x -> AlonzoTx era
Generic)

newtype AlonzoTxUpgradeError = ATUEBodyUpgradeError AlonzoTxBodyUpgradeError
  deriving (Int -> AlonzoTxUpgradeError -> ShowS
[AlonzoTxUpgradeError] -> ShowS
AlonzoTxUpgradeError -> String
(Int -> AlonzoTxUpgradeError -> ShowS)
-> (AlonzoTxUpgradeError -> String)
-> ([AlonzoTxUpgradeError] -> ShowS)
-> Show AlonzoTxUpgradeError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> AlonzoTxUpgradeError -> ShowS
showsPrec :: Int -> AlonzoTxUpgradeError -> ShowS
$cshow :: AlonzoTxUpgradeError -> String
show :: AlonzoTxUpgradeError -> String
$cshowList :: [AlonzoTxUpgradeError] -> ShowS
showList :: [AlonzoTxUpgradeError] -> ShowS
Show)

instance EraTx AlonzoEra where
  type Tx AlonzoEra = AlonzoTx AlonzoEra
  type TxUpgradeError AlonzoEra = AlonzoTxUpgradeError

  mkBasicTx :: TxBody AlonzoEra -> Tx AlonzoEra
mkBasicTx = TxBody AlonzoEra -> Tx AlonzoEra
TxBody AlonzoEra -> AlonzoTx AlonzoEra
forall era. Monoid (TxWits era) => TxBody era -> AlonzoTx era
mkBasicAlonzoTx

  bodyTxL :: Lens' (Tx AlonzoEra) (TxBody AlonzoEra)
bodyTxL = (TxBody AlonzoEra -> f (TxBody AlonzoEra))
-> Tx AlonzoEra -> f (Tx AlonzoEra)
(TxBody AlonzoEra -> f (TxBody AlonzoEra))
-> AlonzoTx AlonzoEra -> f (AlonzoTx AlonzoEra)
forall era (f :: * -> *).
Functor f =>
(TxBody era -> f (TxBody era)) -> AlonzoTx era -> f (AlonzoTx era)
bodyAlonzoTxL
  {-# INLINE bodyTxL #-}

  witsTxL :: Lens' (Tx AlonzoEra) (TxWits AlonzoEra)
witsTxL = (TxWits AlonzoEra -> f (TxWits AlonzoEra))
-> Tx AlonzoEra -> f (Tx AlonzoEra)
(TxWits AlonzoEra -> f (TxWits AlonzoEra))
-> AlonzoTx AlonzoEra -> f (AlonzoTx AlonzoEra)
forall era (f :: * -> *).
Functor f =>
(TxWits era -> f (TxWits era)) -> AlonzoTx era -> f (AlonzoTx era)
witsAlonzoTxL
  {-# INLINE witsTxL #-}

  auxDataTxL :: Lens' (Tx AlonzoEra) (StrictMaybe (TxAuxData AlonzoEra))
auxDataTxL = (StrictMaybe (TxAuxData AlonzoEra)
 -> f (StrictMaybe (TxAuxData AlonzoEra)))
-> Tx AlonzoEra -> f (Tx AlonzoEra)
(StrictMaybe (TxAuxData AlonzoEra)
 -> f (StrictMaybe (TxAuxData AlonzoEra)))
-> AlonzoTx AlonzoEra -> f (AlonzoTx AlonzoEra)
forall era (f :: * -> *).
Functor f =>
(StrictMaybe (TxAuxData era) -> f (StrictMaybe (TxAuxData era)))
-> AlonzoTx era -> f (AlonzoTx era)
auxDataAlonzoTxL
  {-# INLINE auxDataTxL #-}

  sizeTxF :: SimpleGetter (Tx AlonzoEra) Integer
sizeTxF = (Integer -> Const r Integer)
-> Tx AlonzoEra -> Const r (Tx AlonzoEra)
Getting r (AlonzoTx AlonzoEra) Integer
forall era. EraTx era => SimpleGetter (AlonzoTx era) Integer
SimpleGetter (AlonzoTx AlonzoEra) Integer
sizeAlonzoTxF
  {-# INLINE sizeTxF #-}

  wireSizeTxF :: SimpleGetter (Tx AlonzoEra) Word32
wireSizeTxF = (Word32 -> Const r Word32)
-> Tx AlonzoEra -> Const r (Tx AlonzoEra)
Getting r (AlonzoTx AlonzoEra) Word32
forall era. EraTx era => SimpleGetter (AlonzoTx era) Word32
SimpleGetter (AlonzoTx AlonzoEra) Word32
wireSizeAlonzoTxF
  {-# INLINE wireSizeTxF #-}

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

  getMinFeeTx :: PParams AlonzoEra -> Tx AlonzoEra -> Int -> Coin
getMinFeeTx PParams AlonzoEra
pp Tx AlonzoEra
tx Int
_ = PParams AlonzoEra -> Tx AlonzoEra -> Coin
forall era.
(EraTx era, AlonzoEraTxWits era, AlonzoEraPParams era) =>
PParams era -> Tx era -> Coin
alonzoMinFeeTx PParams AlonzoEra
pp Tx AlonzoEra
tx
  {-# INLINE getMinFeeTx #-}

  upgradeTx :: EraTx (PreviousEra AlonzoEra) =>
Tx (PreviousEra AlonzoEra)
-> Either (TxUpgradeError AlonzoEra) (Tx AlonzoEra)
upgradeTx (ShelleyTx TxBody MaryEra
body TxWits MaryEra
wits StrictMaybe (TxAuxData MaryEra)
aux) =
    TxBody AlonzoEra
-> TxWits AlonzoEra
-> IsValid
-> StrictMaybe (TxAuxData AlonzoEra)
-> AlonzoTx AlonzoEra
TxBody AlonzoEra
-> AlonzoTxWits AlonzoEra
-> IsValid
-> StrictMaybe (AlonzoTxAuxData AlonzoEra)
-> AlonzoTx AlonzoEra
forall era.
TxBody era
-> TxWits era
-> IsValid
-> StrictMaybe (TxAuxData era)
-> AlonzoTx era
AlonzoTx
      (TxBody AlonzoEra
 -> AlonzoTxWits AlonzoEra
 -> IsValid
 -> StrictMaybe (AlonzoTxAuxData AlonzoEra)
 -> AlonzoTx AlonzoEra)
-> Either AlonzoTxUpgradeError (TxBody AlonzoEra)
-> Either
     AlonzoTxUpgradeError
     (AlonzoTxWits AlonzoEra
      -> IsValid
      -> StrictMaybe (AlonzoTxAuxData AlonzoEra)
      -> AlonzoTx AlonzoEra)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (AlonzoTxBodyUpgradeError -> AlonzoTxUpgradeError)
-> Either AlonzoTxBodyUpgradeError (TxBody AlonzoEra)
-> Either AlonzoTxUpgradeError (TxBody AlonzoEra)
forall b c d. (b -> c) -> Either b d -> Either c d
forall (a :: * -> * -> *) b c d.
ArrowChoice a =>
a b c -> a (Either b d) (Either c d)
left AlonzoTxBodyUpgradeError -> AlonzoTxUpgradeError
ATUEBodyUpgradeError (TxBody (PreviousEra AlonzoEra)
-> Either (TxBodyUpgradeError AlonzoEra) (TxBody AlonzoEra)
forall era.
(EraTxBody era, EraTxBody (PreviousEra era)) =>
TxBody (PreviousEra era)
-> Either (TxBodyUpgradeError era) (TxBody era)
upgradeTxBody TxBody (PreviousEra AlonzoEra)
TxBody MaryEra
body)
      Either
  AlonzoTxUpgradeError
  (AlonzoTxWits AlonzoEra
   -> IsValid
   -> StrictMaybe (AlonzoTxAuxData AlonzoEra)
   -> AlonzoTx AlonzoEra)
-> Either AlonzoTxUpgradeError (AlonzoTxWits AlonzoEra)
-> Either
     AlonzoTxUpgradeError
     (IsValid
      -> StrictMaybe (AlonzoTxAuxData AlonzoEra) -> AlonzoTx AlonzoEra)
forall a b.
Either AlonzoTxUpgradeError (a -> b)
-> Either AlonzoTxUpgradeError a -> Either AlonzoTxUpgradeError b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> AlonzoTxWits AlonzoEra
-> Either AlonzoTxUpgradeError (AlonzoTxWits AlonzoEra)
forall a. a -> Either AlonzoTxUpgradeError a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TxWits (PreviousEra AlonzoEra) -> TxWits AlonzoEra
forall era.
(EraTxWits era, EraTxWits (PreviousEra era)) =>
TxWits (PreviousEra era) -> TxWits era
upgradeTxWits TxWits (PreviousEra AlonzoEra)
TxWits MaryEra
wits)
      Either
  AlonzoTxUpgradeError
  (IsValid
   -> StrictMaybe (AlonzoTxAuxData AlonzoEra) -> AlonzoTx AlonzoEra)
-> Either AlonzoTxUpgradeError IsValid
-> Either
     AlonzoTxUpgradeError
     (StrictMaybe (AlonzoTxAuxData AlonzoEra) -> AlonzoTx AlonzoEra)
forall a b.
Either AlonzoTxUpgradeError (a -> b)
-> Either AlonzoTxUpgradeError a -> Either AlonzoTxUpgradeError b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> IsValid -> Either AlonzoTxUpgradeError IsValid
forall a. a -> Either AlonzoTxUpgradeError a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bool -> IsValid
IsValid Bool
True)
      Either
  AlonzoTxUpgradeError
  (StrictMaybe (AlonzoTxAuxData AlonzoEra) -> AlonzoTx AlonzoEra)
-> Either
     AlonzoTxUpgradeError (StrictMaybe (AlonzoTxAuxData AlonzoEra))
-> Either AlonzoTxUpgradeError (AlonzoTx AlonzoEra)
forall a b.
Either AlonzoTxUpgradeError (a -> b)
-> Either AlonzoTxUpgradeError a -> Either AlonzoTxUpgradeError b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> StrictMaybe (AlonzoTxAuxData AlonzoEra)
-> Either
     AlonzoTxUpgradeError (StrictMaybe (AlonzoTxAuxData AlonzoEra))
forall a. a -> Either AlonzoTxUpgradeError a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((TxAuxData (PreviousEra AlonzoEra) -> AlonzoTxAuxData AlonzoEra)
-> StrictMaybe (TxAuxData (PreviousEra AlonzoEra))
-> StrictMaybe (AlonzoTxAuxData AlonzoEra)
forall a b. (a -> b) -> StrictMaybe a -> StrictMaybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap TxAuxData (PreviousEra AlonzoEra) -> TxAuxData AlonzoEra
TxAuxData (PreviousEra AlonzoEra) -> AlonzoTxAuxData AlonzoEra
forall era.
(EraTxAuxData era, EraTxAuxData (PreviousEra era)) =>
TxAuxData (PreviousEra era) -> TxAuxData era
upgradeTxAuxData StrictMaybe (TxAuxData (PreviousEra AlonzoEra))
StrictMaybe (TxAuxData MaryEra)
aux)

instance (Tx era ~ AlonzoTx era, AlonzoEraTx era) => EqRaw (AlonzoTx era) where
  eqRaw :: AlonzoTx era -> AlonzoTx era -> Bool
eqRaw = Tx era -> Tx era -> Bool
AlonzoTx era -> AlonzoTx era -> Bool
forall era. AlonzoEraTx era => Tx era -> Tx era -> Bool
alonzoEqTxRaw

class
  (EraTx era, AlonzoEraTxBody era, AlonzoEraTxWits era, AlonzoEraScript era) =>
  AlonzoEraTx era
  where
  isValidTxL :: Lens' (Tx era) IsValid

instance AlonzoEraTx AlonzoEra where
  isValidTxL :: Lens' (Tx AlonzoEra) IsValid
isValidTxL = (IsValid -> f IsValid) -> Tx AlonzoEra -> f (Tx AlonzoEra)
(IsValid -> f IsValid)
-> AlonzoTx AlonzoEra -> f (AlonzoTx AlonzoEra)
forall era (f :: * -> *).
Functor f =>
(IsValid -> f IsValid) -> AlonzoTx era -> f (AlonzoTx era)
isValidAlonzoTxL
  {-# INLINE isValidTxL #-}

mkBasicAlonzoTx :: Monoid (TxWits era) => TxBody era -> AlonzoTx era
mkBasicAlonzoTx :: forall era. Monoid (TxWits era) => TxBody era -> AlonzoTx era
mkBasicAlonzoTx TxBody era
txBody = TxBody era
-> TxWits era
-> IsValid
-> StrictMaybe (TxAuxData era)
-> AlonzoTx era
forall era.
TxBody era
-> TxWits era
-> IsValid
-> StrictMaybe (TxAuxData era)
-> AlonzoTx era
AlonzoTx TxBody era
txBody TxWits era
forall a. Monoid a => a
mempty (Bool -> IsValid
IsValid Bool
True) StrictMaybe (TxAuxData era)
forall a. StrictMaybe a
SNothing

-- | `TxBody` setter and getter for `AlonzoTx`.
bodyAlonzoTxL :: Lens' (AlonzoTx era) (TxBody era)
bodyAlonzoTxL :: forall era (f :: * -> *).
Functor f =>
(TxBody era -> f (TxBody era)) -> AlonzoTx era -> f (AlonzoTx era)
bodyAlonzoTxL = (AlonzoTx era -> TxBody era)
-> (AlonzoTx era -> TxBody era -> AlonzoTx era)
-> Lens (AlonzoTx era) (AlonzoTx era) (TxBody era) (TxBody era)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens AlonzoTx era -> TxBody era
forall era. AlonzoTx era -> TxBody era
body (\AlonzoTx era
tx TxBody era
txBody -> AlonzoTx era
tx {body = txBody})
{-# INLINEABLE bodyAlonzoTxL #-}

-- | `TxWits` setter and getter for `AlonzoTx`.
witsAlonzoTxL :: Lens' (AlonzoTx era) (TxWits era)
witsAlonzoTxL :: forall era (f :: * -> *).
Functor f =>
(TxWits era -> f (TxWits era)) -> AlonzoTx era -> f (AlonzoTx era)
witsAlonzoTxL = (AlonzoTx era -> TxWits era)
-> (AlonzoTx era -> TxWits era -> AlonzoTx era)
-> Lens (AlonzoTx era) (AlonzoTx era) (TxWits era) (TxWits era)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens AlonzoTx era -> TxWits era
forall era. AlonzoTx era -> TxWits era
wits (\AlonzoTx era
tx TxWits era
txWits -> AlonzoTx era
tx {wits = txWits})
{-# INLINEABLE witsAlonzoTxL #-}

-- | `TxAuxData` setter and getter for `AlonzoTx`.
auxDataAlonzoTxL :: Lens' (AlonzoTx era) (StrictMaybe (TxAuxData era))
auxDataAlonzoTxL :: forall era (f :: * -> *).
Functor f =>
(StrictMaybe (TxAuxData era) -> f (StrictMaybe (TxAuxData era)))
-> AlonzoTx era -> f (AlonzoTx era)
auxDataAlonzoTxL = (AlonzoTx era -> StrictMaybe (TxAuxData era))
-> (AlonzoTx era -> StrictMaybe (TxAuxData era) -> AlonzoTx era)
-> Lens
     (AlonzoTx era)
     (AlonzoTx era)
     (StrictMaybe (TxAuxData era))
     (StrictMaybe (TxAuxData era))
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens AlonzoTx era -> StrictMaybe (TxAuxData era)
forall era. AlonzoTx era -> StrictMaybe (TxAuxData era)
auxiliaryData (\AlonzoTx era
tx StrictMaybe (TxAuxData era)
txTxAuxData -> AlonzoTx era
tx {auxiliaryData = txTxAuxData})
{-# INLINEABLE auxDataAlonzoTxL #-}

-- | txsize computes the length of the serialised bytes (for estimations)
sizeAlonzoTxF :: forall era. EraTx era => SimpleGetter (AlonzoTx era) Integer
sizeAlonzoTxF :: forall era. EraTx era => SimpleGetter (AlonzoTx era) Integer
sizeAlonzoTxF =
  (AlonzoTx era -> Integer) -> SimpleGetter (AlonzoTx era) Integer
forall s a. (s -> a) -> SimpleGetter s a
to ((AlonzoTx era -> Integer) -> SimpleGetter (AlonzoTx era) Integer)
-> (AlonzoTx era -> Integer) -> SimpleGetter (AlonzoTx era) Integer
forall a b. (a -> b) -> a -> b
$
    Int64 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral
      (Int64 -> Integer)
-> (AlonzoTx era -> Int64) -> AlonzoTx era -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Int64
LBS.length
      (ByteString -> Int64)
-> (AlonzoTx era -> ByteString) -> AlonzoTx era -> Int64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Version -> Encoding -> ByteString
forall a. EncCBOR a => Version -> a -> ByteString
serialize (forall era. Era era => Version
eraProtVerLow @era)
      (Encoding -> ByteString)
-> (AlonzoTx era -> Encoding) -> AlonzoTx era -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AlonzoTx era -> Encoding
forall era.
(EncCBOR (TxBody era), EncCBOR (TxWits era),
 EncCBOR (TxAuxData era)) =>
AlonzoTx era -> Encoding
toCBORForSizeComputation
{-# INLINEABLE sizeAlonzoTxF #-}

-- | txsize computes the length of the serialised bytes (actual size)
wireSizeAlonzoTxF :: forall era. EraTx era => SimpleGetter (AlonzoTx era) Word32
wireSizeAlonzoTxF :: forall era. EraTx era => SimpleGetter (AlonzoTx era) Word32
wireSizeAlonzoTxF =
  (AlonzoTx era -> Word32) -> SimpleGetter (AlonzoTx era) Word32
forall s a. (s -> a) -> SimpleGetter s a
to ((AlonzoTx era -> Word32) -> SimpleGetter (AlonzoTx era) Word32)
-> (AlonzoTx era -> Word32) -> SimpleGetter (AlonzoTx era) Word32
forall a b. (a -> b) -> a -> b
$
    Int64 -> Word32
forall {a} {b}. (Integral a, Num b, Show a) => a -> b
checkedFromIntegral
      (Int64 -> Word32)
-> (AlonzoTx era -> Int64) -> AlonzoTx era -> Word32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Int64
LBS.length
      (ByteString -> Int64)
-> (AlonzoTx era -> ByteString) -> AlonzoTx era -> Int64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Version -> Encoding -> ByteString
forall a. EncCBOR a => Version -> a -> ByteString
serialize (forall era. Era era => Version
eraProtVerLow @era)
      (Encoding -> ByteString)
-> (AlonzoTx era -> Encoding) -> AlonzoTx era -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AlonzoTx era -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR
  where
    checkedFromIntegral :: a -> b
checkedFromIntegral a
n =
      if a
n a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= Word32 -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32
forall a. Bounded a => a
maxBound :: Word32)
        then a -> b
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
n
        else String -> b
forall a. HasCallStack => String -> a
error (String -> b) -> String -> b
forall a b. (a -> b) -> a -> b
$ String
"Impossible: Size of the transaction is too big: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
n
{-# INLINEABLE wireSizeAlonzoTxF #-}

isValidAlonzoTxL :: Lens' (AlonzoTx era) IsValid
isValidAlonzoTxL :: forall era (f :: * -> *).
Functor f =>
(IsValid -> f IsValid) -> AlonzoTx era -> f (AlonzoTx era)
isValidAlonzoTxL = (AlonzoTx era -> IsValid)
-> (AlonzoTx era -> IsValid -> AlonzoTx era)
-> Lens (AlonzoTx era) (AlonzoTx era) IsValid IsValid
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens AlonzoTx era -> IsValid
forall era. AlonzoTx era -> IsValid
isValid (\AlonzoTx era
tx IsValid
valid -> AlonzoTx era
tx {isValid = valid})
{-# INLINEABLE isValidAlonzoTxL #-}

deriving instance
  (Era era, Eq (TxBody era), Eq (TxWits era), Eq (TxAuxData era)) => Eq (AlonzoTx era)

deriving instance
  (Era era, Show (TxBody era), Show (TxAuxData era), Show (Script era), Show (TxWits era)) =>
  Show (AlonzoTx era)

instance
  ( Era era
  , NoThunks (TxWits era)
  , NoThunks (TxAuxData era)
  , NoThunks (TxBody era)
  ) =>
  NoThunks (AlonzoTx era)

instance
  ( Era era
  , NFData (TxWits era)
  , NFData (TxAuxData era)
  , NFData (TxBody era)
  ) =>
  NFData (AlonzoTx era)

-- | A ScriptIntegrityHash is the hash of three things.  The first two come
-- from the witnesses and the last comes from the Protocol Parameters.
data ScriptIntegrity era
  = ScriptIntegrity
      !(Redeemers era) -- From the witnesses
      !(TxDats era)
      !(Set LangDepView) -- From the Protocol parameters
  deriving (ScriptIntegrity era -> ScriptIntegrity era -> Bool
(ScriptIntegrity era -> ScriptIntegrity era -> Bool)
-> (ScriptIntegrity era -> ScriptIntegrity era -> Bool)
-> Eq (ScriptIntegrity era)
forall era.
AlonzoEraScript era =>
ScriptIntegrity era -> ScriptIntegrity era -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall era.
AlonzoEraScript era =>
ScriptIntegrity era -> ScriptIntegrity era -> Bool
== :: ScriptIntegrity era -> ScriptIntegrity era -> Bool
$c/= :: forall era.
AlonzoEraScript era =>
ScriptIntegrity era -> ScriptIntegrity era -> Bool
/= :: ScriptIntegrity era -> ScriptIntegrity era -> Bool
Eq, (forall x. ScriptIntegrity era -> Rep (ScriptIntegrity era) x)
-> (forall x. Rep (ScriptIntegrity era) x -> ScriptIntegrity era)
-> Generic (ScriptIntegrity era)
forall x. Rep (ScriptIntegrity era) x -> ScriptIntegrity era
forall x. ScriptIntegrity era -> Rep (ScriptIntegrity era) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall era x. Rep (ScriptIntegrity era) x -> ScriptIntegrity era
forall era x. ScriptIntegrity era -> Rep (ScriptIntegrity era) x
$cfrom :: forall era x. ScriptIntegrity era -> Rep (ScriptIntegrity era) x
from :: forall x. ScriptIntegrity era -> Rep (ScriptIntegrity era) x
$cto :: forall era x. Rep (ScriptIntegrity era) x -> ScriptIntegrity era
to :: forall x. Rep (ScriptIntegrity era) x -> ScriptIntegrity era
Generic)

deriving instance AlonzoEraScript era => Show (ScriptIntegrity era)

deriving instance AlonzoEraScript era => NoThunks (ScriptIntegrity era)

-- ScriptIntegrity is not transmitted over the network. The bytes are independently
-- reconstructed by all nodes. There are no original bytes to preserve.
-- Instead, we must use a reproducable serialization
instance Era era => SafeToHash (ScriptIntegrity era) where
  originalBytes :: ScriptIntegrity era -> ByteString
originalBytes (ScriptIntegrity Redeemers era
m TxDats era
d Set LangDepView
l) =
    let dBytes :: ByteString
dBytes = if Map DataHash (Data era) -> Bool
forall a. Map DataHash a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (TxDats era
d TxDats era
-> Getting
     (Map DataHash (Data era)) (TxDats era) (Map DataHash (Data era))
-> Map DataHash (Data era)
forall s a. s -> Getting a s a -> a
^. Getting
  (Map DataHash (Data era)) (TxDats era) (Map DataHash (Data era))
forall era. Era era => Lens' (TxDats era) (Map DataHash (Data era))
Lens' (TxDats era) (Map DataHash (Data era))
unTxDatsL) then ByteString
forall a. Monoid a => a
mempty else TxDats era -> ByteString
forall t. SafeToHash t => t -> ByteString
originalBytes TxDats era
d
        lBytes :: ByteString
lBytes = Version -> Encoding -> ByteString
forall a. EncCBOR a => Version -> a -> ByteString
serialize' (forall era. Era era => Version
eraProtVerLow @era) (Set LangDepView -> Encoding
encodeLangViews Set LangDepView
l)
     in Redeemers era -> ByteString
forall t. SafeToHash t => t -> ByteString
originalBytes Redeemers era
m ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
dBytes ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
lBytes

instance
  Era era =>
  HashAnnotated (ScriptIntegrity era) EraIndependentScriptIntegrity

hashScriptIntegrity ::
  forall era.
  AlonzoEraScript era =>
  Set LangDepView ->
  Redeemers era ->
  TxDats era ->
  StrictMaybe ScriptIntegrityHash
hashScriptIntegrity :: forall era.
AlonzoEraScript era =>
Set LangDepView
-> Redeemers era
-> TxDats era
-> StrictMaybe (SafeHash EraIndependentScriptIntegrity)
hashScriptIntegrity Set LangDepView
langViews Redeemers era
rdmrs TxDats era
dats =
  if Map (PlutusPurpose AsIx era) (Data era, ExUnits) -> Bool
forall a. Map (PlutusPurpose AsIx era) a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (Redeemers era
rdmrs Redeemers era
-> Getting
     (Map (PlutusPurpose AsIx era) (Data era, ExUnits))
     (Redeemers era)
     (Map (PlutusPurpose AsIx era) (Data era, ExUnits))
-> Map (PlutusPurpose AsIx era) (Data era, ExUnits)
forall s a. s -> Getting a s a -> a
^. Getting
  (Map (PlutusPurpose AsIx era) (Data era, ExUnits))
  (Redeemers era)
  (Map (PlutusPurpose AsIx era) (Data era, ExUnits))
forall era.
AlonzoEraScript era =>
Lens'
  (Redeemers era) (Map (PlutusPurpose AsIx era) (Data era, ExUnits))
Lens'
  (Redeemers era) (Map (PlutusPurpose AsIx era) (Data era, ExUnits))
unRedeemersL) Bool -> Bool -> Bool
&& Set LangDepView -> Bool
forall a. Set a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null Set LangDepView
langViews Bool -> Bool -> Bool
&& Map DataHash (Data era) -> Bool
forall a. Map DataHash a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (TxDats era
dats TxDats era
-> Getting
     (Map DataHash (Data era)) (TxDats era) (Map DataHash (Data era))
-> Map DataHash (Data era)
forall s a. s -> Getting a s a -> a
^. Getting
  (Map DataHash (Data era)) (TxDats era) (Map DataHash (Data era))
forall era. Era era => Lens' (TxDats era) (Map DataHash (Data era))
Lens' (TxDats era) (Map DataHash (Data era))
unTxDatsL)
    then StrictMaybe (SafeHash EraIndependentScriptIntegrity)
forall a. StrictMaybe a
SNothing
    else SafeHash EraIndependentScriptIntegrity
-> StrictMaybe (SafeHash EraIndependentScriptIntegrity)
forall a. a -> StrictMaybe a
SJust (ScriptIntegrity era -> SafeHash EraIndependentScriptIntegrity
forall x i. HashAnnotated x i => x -> SafeHash i
hashAnnotated (Redeemers era
-> TxDats era -> Set LangDepView -> ScriptIntegrity era
forall era.
Redeemers era
-> TxDats era -> Set LangDepView -> ScriptIntegrity era
ScriptIntegrity Redeemers era
rdmrs TxDats era
dats Set LangDepView
langViews))

-- ===============================================================
-- From the specification, Figure 4 "Functions related to fees"
-- ===============================================================

-- | This ensures that the size of transactions from Mary is unchanged.
-- The individual components all store their bytes; the only work we do in this
-- function is concatenating
toCBORForSizeComputation ::
  ( EncCBOR (TxBody era)
  , EncCBOR (TxWits era)
  , EncCBOR (TxAuxData era)
  ) =>
  AlonzoTx era ->
  Encoding
toCBORForSizeComputation :: forall era.
(EncCBOR (TxBody era), EncCBOR (TxWits era),
 EncCBOR (TxAuxData era)) =>
AlonzoTx era -> Encoding
toCBORForSizeComputation AlonzoTx {TxBody era
body :: forall era. AlonzoTx era -> TxBody era
body :: TxBody era
body, TxWits era
wits :: forall era. AlonzoTx era -> TxWits era
wits :: TxWits era
wits, StrictMaybe (TxAuxData era)
auxiliaryData :: forall era. AlonzoTx era -> StrictMaybe (TxAuxData era)
auxiliaryData :: StrictMaybe (TxAuxData era)
auxiliaryData} =
  Word -> Encoding
encodeListLen Word
3
    Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> TxBody era -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR TxBody era
body
    Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> TxWits era -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR TxWits era
wits
    Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> (TxAuxData era -> Encoding) -> Maybe (TxAuxData era) -> Encoding
forall a. (a -> Encoding) -> Maybe a -> Encoding
encodeNullMaybe TxAuxData era -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR (StrictMaybe (TxAuxData era) -> Maybe (TxAuxData era)
forall a. StrictMaybe a -> Maybe a
strictMaybeToMaybe StrictMaybe (TxAuxData era)
auxiliaryData)

alonzoMinFeeTx ::
  ( EraTx era
  , AlonzoEraTxWits era
  , AlonzoEraPParams era
  ) =>
  PParams era ->
  Tx era ->
  Coin
alonzoMinFeeTx :: forall era.
(EraTx era, AlonzoEraTxWits era, AlonzoEraPParams era) =>
PParams era -> Tx era -> Coin
alonzoMinFeeTx PParams era
pp Tx era
tx =
  (Tx era
tx Tx era -> Getting Integer (Tx era) Integer -> Integer
forall s a. s -> Getting a s a -> a
^. Getting Integer (Tx era) Integer
forall era. EraTx era => SimpleGetter (Tx era) Integer
SimpleGetter (Tx era) Integer
sizeTxF Integer -> Coin -> Coin
forall i. Integral i => i -> Coin -> Coin
forall t i. (Val t, Integral i) => i -> t -> t
<×> PParams era
pp PParams era -> Getting Coin (PParams era) Coin -> Coin
forall s a. s -> Getting a s a -> a
^. Getting Coin (PParams era) Coin
forall era. EraPParams era => Lens' (PParams era) Coin
Lens' (PParams era) Coin
ppMinFeeAL)
    Coin -> Coin -> Coin
forall t. Val t => t -> t -> t
<+> (PParams era
pp PParams era -> Getting Coin (PParams era) Coin -> Coin
forall s a. s -> Getting a s a -> a
^. Getting Coin (PParams era) Coin
forall era. EraPParams era => Lens' (PParams era) Coin
Lens' (PParams era) Coin
ppMinFeeBL)
    Coin -> Coin -> Coin
forall t. Val t => t -> t -> t
<+> Prices -> ExUnits -> Coin
txscriptfee (PParams era
pp PParams era -> Getting Prices (PParams era) Prices -> Prices
forall s a. s -> Getting a s a -> a
^. Getting Prices (PParams era) Prices
forall era. AlonzoEraPParams era => Lens' (PParams era) Prices
Lens' (PParams era) Prices
ppPricesL) ExUnits
allExunits
  where
    allExunits :: ExUnits
allExunits = Tx era -> ExUnits
forall era. (EraTx era, AlonzoEraTxWits era) => Tx era -> ExUnits
totExUnits Tx era
tx

totExUnits ::
  (EraTx era, AlonzoEraTxWits era) =>
  Tx era ->
  ExUnits
totExUnits :: forall era. (EraTx era, AlonzoEraTxWits era) => Tx era -> ExUnits
totExUnits Tx era
tx = ((Data era, ExUnits) -> ExUnits)
-> Map (PlutusPurpose AsIx era) (Data era, ExUnits) -> ExUnits
forall m a.
Monoid m =>
(a -> m) -> Map (PlutusPurpose AsIx era) a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (Data era, ExUnits) -> ExUnits
forall a b. (a, b) -> b
snd (Map (PlutusPurpose AsIx era) (Data era, ExUnits) -> ExUnits)
-> Map (PlutusPurpose AsIx era) (Data era, ExUnits) -> ExUnits
forall a b. (a -> b) -> a -> b
$ Tx era
tx Tx era
-> Getting
     (Map (PlutusPurpose AsIx era) (Data era, ExUnits))
     (Tx era)
     (Map (PlutusPurpose AsIx era) (Data era, ExUnits))
-> Map (PlutusPurpose AsIx era) (Data era, ExUnits)
forall s a. s -> Getting a s a -> a
^. (TxWits era
 -> Const
      (Map (PlutusPurpose AsIx era) (Data era, ExUnits)) (TxWits era))
-> Tx era
-> Const
     (Map (PlutusPurpose AsIx era) (Data era, ExUnits)) (Tx era)
forall era. EraTx era => Lens' (Tx era) (TxWits era)
Lens' (Tx era) (TxWits era)
witsTxL ((TxWits era
  -> Const
       (Map (PlutusPurpose AsIx era) (Data era, ExUnits)) (TxWits era))
 -> Tx era
 -> Const
      (Map (PlutusPurpose AsIx era) (Data era, ExUnits)) (Tx era))
-> ((Map (PlutusPurpose AsIx era) (Data era, ExUnits)
     -> Const
          (Map (PlutusPurpose AsIx era) (Data era, ExUnits))
          (Map (PlutusPurpose AsIx era) (Data era, ExUnits)))
    -> TxWits era
    -> Const
         (Map (PlutusPurpose AsIx era) (Data era, ExUnits)) (TxWits era))
-> Getting
     (Map (PlutusPurpose AsIx era) (Data era, ExUnits))
     (Tx era)
     (Map (PlutusPurpose AsIx era) (Data era, ExUnits))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Redeemers era
 -> Const
      (Map (PlutusPurpose AsIx era) (Data era, ExUnits)) (Redeemers era))
-> TxWits era
-> Const
     (Map (PlutusPurpose AsIx era) (Data era, ExUnits)) (TxWits era)
forall era.
AlonzoEraTxWits era =>
Lens' (TxWits era) (Redeemers era)
Lens' (TxWits era) (Redeemers era)
rdmrsTxWitsL ((Redeemers era
  -> Const
       (Map (PlutusPurpose AsIx era) (Data era, ExUnits)) (Redeemers era))
 -> TxWits era
 -> Const
      (Map (PlutusPurpose AsIx era) (Data era, ExUnits)) (TxWits era))
-> ((Map (PlutusPurpose AsIx era) (Data era, ExUnits)
     -> Const
          (Map (PlutusPurpose AsIx era) (Data era, ExUnits))
          (Map (PlutusPurpose AsIx era) (Data era, ExUnits)))
    -> Redeemers era
    -> Const
         (Map (PlutusPurpose AsIx era) (Data era, ExUnits)) (Redeemers era))
-> (Map (PlutusPurpose AsIx era) (Data era, ExUnits)
    -> Const
         (Map (PlutusPurpose AsIx era) (Data era, ExUnits))
         (Map (PlutusPurpose AsIx era) (Data era, ExUnits)))
-> TxWits era
-> Const
     (Map (PlutusPurpose AsIx era) (Data era, ExUnits)) (TxWits era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Map (PlutusPurpose AsIx era) (Data era, ExUnits)
 -> Const
      (Map (PlutusPurpose AsIx era) (Data era, ExUnits))
      (Map (PlutusPurpose AsIx era) (Data era, ExUnits)))
-> Redeemers era
-> Const
     (Map (PlutusPurpose AsIx era) (Data era, ExUnits)) (Redeemers era)
forall era.
AlonzoEraScript era =>
Lens'
  (Redeemers era) (Map (PlutusPurpose AsIx era) (Data era, ExUnits))
Lens'
  (Redeemers era) (Map (PlutusPurpose AsIx era) (Data era, ExUnits))
unRedeemersL

--------------------------------------------------------------------------------
-- Serialisation
--------------------------------------------------------------------------------

--------------------------------------------------------------------------------
-- Mempool Serialisation
--
-- We do not store the Tx bytes for the following reasons:
-- - A Tx serialised in this way never forms part of any hashed structure, hence
--   we do not worry about the serialisation changing and thus seeing a new
--   hash.
-- - The three principal components of this Tx already store their own bytes;
--   here we simply concatenate them. The final component, `IsValid`, is
--   just a flag and very cheap to serialise.
--------------------------------------------------------------------------------

-- | Encode to CBOR for the purposes of transmission from node to node, or from
-- wallet to node.
--
-- Note that this serialisation is neither the serialisation used on-chain
-- (where Txs are deconstructed using segwit), nor the serialisation used for
-- computing the transaction size (which omits the `IsValid` field for
-- compatibility with Mary - see 'toCBORForSizeComputation').
toCBORForMempoolSubmission ::
  ( EncCBOR (TxBody era)
  , EncCBOR (TxWits era)
  , EncCBOR (TxAuxData era)
  ) =>
  AlonzoTx era ->
  Encoding
toCBORForMempoolSubmission :: forall era.
(EncCBOR (TxBody era), EncCBOR (TxWits era),
 EncCBOR (TxAuxData era)) =>
AlonzoTx era -> Encoding
toCBORForMempoolSubmission
  AlonzoTx {TxBody era
body :: forall era. AlonzoTx era -> TxBody era
body :: TxBody era
body, TxWits era
wits :: forall era. AlonzoTx era -> TxWits era
wits :: TxWits era
wits, StrictMaybe (TxAuxData era)
auxiliaryData :: forall era. AlonzoTx era -> StrictMaybe (TxAuxData era)
auxiliaryData :: StrictMaybe (TxAuxData era)
auxiliaryData, IsValid
isValid :: forall era. AlonzoTx era -> IsValid
isValid :: IsValid
isValid} =
    Encode ('Closed 'Dense) (AlonzoTx era) -> Encoding
forall (w :: Wrapped) t. Encode w t -> Encoding
encode (Encode ('Closed 'Dense) (AlonzoTx era) -> Encoding)
-> Encode ('Closed 'Dense) (AlonzoTx era) -> Encoding
forall a b. (a -> b) -> a -> b
$
      (TxBody era
 -> TxWits era
 -> IsValid
 -> StrictMaybe (TxAuxData era)
 -> AlonzoTx era)
-> Encode
     ('Closed 'Dense)
     (TxBody era
      -> TxWits era
      -> IsValid
      -> StrictMaybe (TxAuxData era)
      -> AlonzoTx era)
forall t. t -> Encode ('Closed 'Dense) t
Rec TxBody era
-> TxWits era
-> IsValid
-> StrictMaybe (TxAuxData era)
-> AlonzoTx era
forall era.
TxBody era
-> TxWits era
-> IsValid
-> StrictMaybe (TxAuxData era)
-> AlonzoTx era
AlonzoTx
        Encode
  ('Closed 'Dense)
  (TxBody era
   -> TxWits era
   -> IsValid
   -> StrictMaybe (TxAuxData era)
   -> AlonzoTx era)
-> Encode ('Closed 'Dense) (TxBody era)
-> Encode
     ('Closed 'Dense)
     (TxWits era
      -> IsValid -> StrictMaybe (TxAuxData era) -> AlonzoTx era)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> TxBody era -> Encode ('Closed 'Dense) (TxBody era)
forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To TxBody era
body
        Encode
  ('Closed 'Dense)
  (TxWits era
   -> IsValid -> StrictMaybe (TxAuxData era) -> AlonzoTx era)
-> Encode ('Closed 'Dense) (TxWits era)
-> Encode
     ('Closed 'Dense)
     (IsValid -> StrictMaybe (TxAuxData era) -> AlonzoTx era)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> TxWits era -> Encode ('Closed 'Dense) (TxWits era)
forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To TxWits era
wits
        Encode
  ('Closed 'Dense)
  (IsValid -> StrictMaybe (TxAuxData era) -> AlonzoTx era)
-> Encode ('Closed 'Dense) IsValid
-> Encode
     ('Closed 'Dense) (StrictMaybe (TxAuxData era) -> AlonzoTx era)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> IsValid -> Encode ('Closed 'Dense) IsValid
forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To IsValid
isValid
        Encode
  ('Closed 'Dense) (StrictMaybe (TxAuxData era) -> AlonzoTx era)
-> Encode ('Closed 'Dense) (StrictMaybe (TxAuxData era))
-> Encode ('Closed 'Dense) (AlonzoTx era)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> (StrictMaybe (TxAuxData era) -> Encoding)
-> StrictMaybe (TxAuxData era)
-> Encode ('Closed 'Dense) (StrictMaybe (TxAuxData era))
forall t. (t -> Encoding) -> t -> Encode ('Closed 'Dense) t
E ((TxAuxData era -> Encoding) -> Maybe (TxAuxData era) -> Encoding
forall a. (a -> Encoding) -> Maybe a -> Encoding
encodeNullMaybe TxAuxData era -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR (Maybe (TxAuxData era) -> Encoding)
-> (StrictMaybe (TxAuxData era) -> Maybe (TxAuxData era))
-> StrictMaybe (TxAuxData era)
-> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StrictMaybe (TxAuxData era) -> Maybe (TxAuxData era)
forall a. StrictMaybe a -> Maybe a
strictMaybeToMaybe) StrictMaybe (TxAuxData era)
auxiliaryData

instance
  ( Era era
  , EncCBOR (TxBody era)
  , EncCBOR (TxAuxData era)
  , EncCBOR (TxWits era)
  ) =>
  EncCBOR (AlonzoTx era)
  where
  encCBOR :: AlonzoTx era -> Encoding
encCBOR = AlonzoTx era -> Encoding
forall era.
(EncCBOR (TxBody era), EncCBOR (TxWits era),
 EncCBOR (TxAuxData era)) =>
AlonzoTx era -> Encoding
toCBORForMempoolSubmission

instance
  ( Era era
  , EncCBOR (TxBody era)
  , EncCBOR (TxAuxData era)
  , EncCBOR (TxWits era)
  ) =>
  ToCBOR (AlonzoTx era)
  where
  toCBOR :: AlonzoTx era -> Encoding
toCBOR = forall era t. (Era era, EncCBOR t) => t -> Encoding
toEraCBOR @era

instance
  ( Typeable era
  , DecCBOR (TxBody era)
  , DecCBOR (TxWits era)
  , DecCBOR (TxAuxData era)
  ) =>
  DecCBOR (AlonzoTx era)
  where
  decCBOR :: forall s. Decoder s (AlonzoTx era)
decCBOR =
    Decode ('Closed 'Dense) (AlonzoTx era) -> Decoder s (AlonzoTx era)
forall t (w :: Wrapped) s. Typeable t => Decode w t -> Decoder s t
decode (Decode ('Closed 'Dense) (AlonzoTx era)
 -> Decoder s (AlonzoTx era))
-> Decode ('Closed 'Dense) (AlonzoTx era)
-> Decoder s (AlonzoTx era)
forall a b. (a -> b) -> a -> b
$
      (TxBody era
 -> TxWits era
 -> IsValid
 -> StrictMaybe (TxAuxData era)
 -> AlonzoTx era)
-> Decode
     ('Closed 'Dense)
     (TxBody era
      -> TxWits era
      -> IsValid
      -> StrictMaybe (TxAuxData era)
      -> AlonzoTx era)
forall t. t -> Decode ('Closed 'Dense) t
RecD TxBody era
-> TxWits era
-> IsValid
-> StrictMaybe (TxAuxData era)
-> AlonzoTx era
forall era.
TxBody era
-> TxWits era
-> IsValid
-> StrictMaybe (TxAuxData era)
-> AlonzoTx era
AlonzoTx
        Decode
  ('Closed 'Dense)
  (TxBody era
   -> TxWits era
   -> IsValid
   -> StrictMaybe (TxAuxData era)
   -> AlonzoTx era)
-> Decode ('Closed Any) (TxBody era)
-> Decode
     ('Closed 'Dense)
     (TxWits era
      -> IsValid -> StrictMaybe (TxAuxData era) -> AlonzoTx era)
forall a (w1 :: Wrapped) t (w :: Density).
Typeable a =>
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! Decode ('Closed Any) (TxBody era)
forall t (w :: Wrapped). DecCBOR t => Decode w t
From
        Decode
  ('Closed 'Dense)
  (TxWits era
   -> IsValid -> StrictMaybe (TxAuxData era) -> AlonzoTx era)
-> Decode ('Closed Any) (TxWits era)
-> Decode
     ('Closed 'Dense)
     (IsValid -> StrictMaybe (TxAuxData era) -> AlonzoTx era)
forall a (w1 :: Wrapped) t (w :: Density).
Typeable a =>
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! Decode ('Closed Any) (TxWits era)
forall t (w :: Wrapped). DecCBOR t => Decode w t
From
        Decode
  ('Closed 'Dense)
  (IsValid -> StrictMaybe (TxAuxData era) -> AlonzoTx era)
-> Decode ('Closed Any) IsValid
-> Decode
     ('Closed 'Dense) (StrictMaybe (TxAuxData era) -> AlonzoTx era)
forall a (w1 :: Wrapped) t (w :: Density).
Typeable a =>
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! Decode ('Closed Any) IsValid
forall t (w :: Wrapped). DecCBOR t => Decode w t
From
        Decode
  ('Closed 'Dense) (StrictMaybe (TxAuxData era) -> AlonzoTx era)
-> Decode ('Closed 'Dense) (StrictMaybe (TxAuxData era))
-> Decode ('Closed 'Dense) (AlonzoTx era)
forall a (w1 :: Wrapped) t (w :: Density).
Typeable a =>
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! (forall s. Decoder s (StrictMaybe (TxAuxData era)))
-> Decode ('Closed 'Dense) (StrictMaybe (TxAuxData era))
forall t. (forall s. Decoder s t) -> Decode ('Closed 'Dense) t
D (Decoder s (TxAuxData era)
-> Decoder s (StrictMaybe (TxAuxData era))
forall s a. Decoder s a -> Decoder s (StrictMaybe a)
decodeNullStrictMaybe Decoder s (TxAuxData era)
forall s. Decoder s (TxAuxData era)
forall a s. DecCBOR a => Decoder s a
decCBOR)
  {-# INLINE decCBOR #-}

alonzoEqTxRaw :: AlonzoEraTx era => Tx era -> Tx era -> Bool
alonzoEqTxRaw :: forall era. AlonzoEraTx era => Tx era -> Tx era -> Bool
alonzoEqTxRaw Tx era
tx1 Tx era
tx2 =
  Tx era -> Tx era -> Bool
forall era. EraTx era => Tx era -> Tx era -> Bool
shelleyEqTxRaw Tx era
tx1 Tx era
tx2 Bool -> Bool -> Bool
&& (Tx era
tx1 Tx era -> Getting IsValid (Tx era) IsValid -> IsValid
forall s a. s -> Getting a s a -> a
^. Getting IsValid (Tx era) IsValid
forall era. AlonzoEraTx era => Lens' (Tx era) IsValid
Lens' (Tx era) IsValid
isValidTxL IsValid -> IsValid -> Bool
forall a. Eq a => a -> a -> Bool
== Tx era
tx2 Tx era -> Getting IsValid (Tx era) IsValid -> IsValid
forall s a. s -> Getting a s a -> a
^. Getting IsValid (Tx era) IsValid
forall era. AlonzoEraTx era => Lens' (Tx era) IsValid
Lens' (Tx era) IsValid
isValidTxL)