{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# 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,
  getCoin,
  EraIndependentScriptIntegrity,
  ScriptIntegrity (ScriptIntegrity),
  ScriptIntegrityHash,
  -- Figure 3
  AlonzoTx (AlonzoTx, body, wits, isValid, auxiliaryData),
  AlonzoEraTx (..),
  mkBasicAlonzoTx,
  bodyAlonzoTxL,
  witsAlonzoTxL,
  auxDataAlonzoTxL,
  sizeAlonzoTxF,
  wireSizeAlonzoTxF,
  isValidAlonzoTxL,
  txdats',
  txscripts',
  txrdmrs,
  AlonzoTxBody (..),
  -- Figure 4
  totExUnits,
  alonzoMinFeeTx,
  minfee,
  --  Figure 5
  isTwoPhaseScriptAddressFromMap,
  Shelley.txouts,
  indexRedeemers,
  -- Figure 6
  getMapFromValue,
  -- Segwit
  alonzoSegwitTx,
  -- Other
  toCBORForSizeComputation,
  toCBORForMempoolSubmission,
  alonzoEqTxRaw,
)
where

import Cardano.Ledger.Address (Addr (..))
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 (PlutusPurpose, hoistPlutusPurpose),
  AsIxItem,
  CostModel,
  ExUnits (..),
  lookupPlutusScript,
  toAsIx,
  txscriptfee,
 )
import Cardano.Ledger.Alonzo.TxBody (
  AlonzoEraTxBody (..),
  AlonzoTxBody (..),
  AlonzoTxBodyUpgradeError,
  ScriptIntegrityHash,
 )
import Cardano.Ledger.Alonzo.TxWits (
  AlonzoEraTxWits (..),
  AlonzoTxWits (..),
  Redeemers (..),
  TxDats (..),
  nullDats,
  nullRedeemers,
  txrdmrs,
  unRedeemers,
 )
import Cardano.Ledger.Binary (
  Annotator (..),
  DecCBOR (..),
  EncCBOR (encCBOR),
  Encoding,
  ToCBOR (..),
  decodeNullMaybe,
  encodeListLen,
  encodeNullMaybe,
  serialize,
  serialize',
 )
import Cardano.Ledger.Binary.Coders
import Cardano.Ledger.Coin (Coin (..))
import Cardano.Ledger.Core
import Cardano.Ledger.Crypto
import Cardano.Ledger.Mary.Value (AssetName, MaryValue (..), MultiAsset (..), PolicyID (..))
import Cardano.Ledger.MemoBytes (EqRaw (..))
import Cardano.Ledger.Plutus.Data (Data, hashData)
import Cardano.Ledger.Plutus.Language (nonNativeLanguages)
import Cardano.Ledger.SafeHash (HashAnnotated, SafeToHash (..), hashAnnotated)
import Cardano.Ledger.Shelley.Tx (ShelleyTx (ShelleyTx), shelleyEqTxRaw)
import qualified Cardano.Ledger.UTxO 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 qualified Data.Map.Strict as Map
import Data.Maybe (isJust)
import Data.Maybe.Strict (
  StrictMaybe (..),
  maybeToStrictMaybe,
  strictMaybeToMaybe,
 )
import Data.Set (Set)
import qualified Data.Set as 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
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: IsValid -> IsValid -> Bool
$c/= :: IsValid -> IsValid -> Bool
== :: IsValid -> IsValid -> Bool
$c== :: IsValid -> IsValid -> Bool
Eq, Int -> IsValid -> ShowS
[IsValid] -> ShowS
IsValid -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [IsValid] -> ShowS
$cshowList :: [IsValid] -> ShowS
show :: IsValid -> String
$cshow :: IsValid -> String
showsPrec :: Int -> IsValid -> ShowS
$cshowsPrec :: Int -> IsValid -> ShowS
Show, 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
$cto :: forall x. Rep IsValid x -> IsValid
$cfrom :: forall x. IsValid -> Rep IsValid x
Generic)
  deriving newtype (Context -> IsValid -> IO (Maybe ThunkInfo)
Proxy IsValid -> String
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
showTypeOf :: Proxy IsValid -> String
$cshowTypeOf :: Proxy IsValid -> String
wNoThunks :: Context -> IsValid -> IO (Maybe ThunkInfo)
$cwNoThunks :: Context -> IsValid -> IO (Maybe ThunkInfo)
noThunks :: Context -> IsValid -> IO (Maybe ThunkInfo)
$cnoThunks :: Context -> IsValid -> IO (Maybe ThunkInfo)
NoThunks, IsValid -> ()
forall a. (a -> ()) -> NFData a
rnf :: IsValid -> ()
$crnf :: IsValid -> ()
NFData, Typeable 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
encodedListSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size) -> Proxy [IsValid] -> Size
$cencodedListSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size) -> Proxy [IsValid] -> Size
encodedSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size) -> Proxy IsValid -> Size
$cencodedSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size) -> Proxy IsValid -> Size
toCBOR :: IsValid -> Encoding
$ctoCBOR :: IsValid -> Encoding
ToCBOR, Typeable 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
encodedListSizeExpr :: (forall t. EncCBOR t => Proxy t -> Size) -> Proxy [IsValid] -> Size
$cencodedListSizeExpr :: (forall t. EncCBOR t => Proxy t -> Size) -> Proxy [IsValid] -> Size
encodedSizeExpr :: (forall t. EncCBOR t => Proxy t -> Size) -> Proxy IsValid -> Size
$cencodedSizeExpr :: (forall t. EncCBOR t => Proxy t -> Size) -> Proxy IsValid -> Size
encCBOR :: IsValid -> Encoding
$cencCBOR :: IsValid -> Encoding
EncCBOR, Typeable 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 ()
label :: Proxy IsValid -> Text
$clabel :: Proxy IsValid -> Text
dropCBOR :: forall s. Proxy IsValid -> Decoder s ()
$cdropCBOR :: forall s. Proxy IsValid -> Decoder s ()
decCBOR :: forall s. Decoder s IsValid
$cdecCBOR :: forall s. Decoder s IsValid
DecCBOR, [IsValid] -> Encoding
[IsValid] -> Value
IsValid -> Bool
IsValid -> Encoding
IsValid -> Value
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
omitField :: IsValid -> Bool
$comitField :: IsValid -> Bool
toEncodingList :: [IsValid] -> Encoding
$ctoEncodingList :: [IsValid] -> Encoding
toJSONList :: [IsValid] -> Value
$ctoJSONList :: [IsValid] -> Value
toEncoding :: IsValid -> Encoding
$ctoEncoding :: IsValid -> Encoding
toJSON :: IsValid -> Value
$ctoJSON :: IsValid -> Value
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 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
$cto :: forall era x. Rep (AlonzoTx era) x -> AlonzoTx era
$cfrom :: forall era x. AlonzoTx era -> Rep (AlonzoTx era) x
Generic)

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

instance Crypto c => EraTx (AlonzoEra c) where
  {-# SPECIALIZE instance EraTx (AlonzoEra StandardCrypto) #-}

  type Tx (AlonzoEra c) = AlonzoTx (AlonzoEra c)
  type TxUpgradeError (AlonzoEra c) = AlonzoTxUpgradeError

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

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

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

  auxDataTxL :: Lens'
  (Tx (AlonzoEra c)) (StrictMaybe (AuxiliaryData (AlonzoEra c)))
auxDataTxL = forall era. Lens' (AlonzoTx era) (StrictMaybe (TxAuxData era))
auxDataAlonzoTxL
  {-# INLINE auxDataTxL #-}

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

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

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

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

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

instance (Tx era ~ AlonzoTx era, AlonzoEraTx era) => EqRaw (AlonzoTx era) where
  eqRaw :: AlonzoTx era -> AlonzoTx era -> Bool
eqRaw = 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 Crypto c => AlonzoEraTx (AlonzoEra c) where
  {-# SPECIALIZE instance AlonzoEraTx (AlonzoEra StandardCrypto) #-}

  isValidTxL :: Lens' (Tx (AlonzoEra c)) IsValid
isValidTxL = forall era. Lens' (AlonzoTx era) IsValid
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 = forall era.
TxBody era
-> TxWits era
-> IsValid
-> StrictMaybe (TxAuxData era)
-> AlonzoTx era
AlonzoTx TxBody era
txBody forall a. Monoid a => a
mempty (Bool -> IsValid
IsValid Bool
True) forall a. StrictMaybe a
SNothing

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

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

-- | `TxAuxData` setter and getter for `AlonzoTx`.
auxDataAlonzoTxL :: Lens' (AlonzoTx era) (StrictMaybe (TxAuxData era))
auxDataAlonzoTxL :: forall era. Lens' (AlonzoTx era) (StrictMaybe (TxAuxData era))
auxDataAlonzoTxL = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens forall era. AlonzoTx era -> StrictMaybe (TxAuxData era)
auxiliaryData (\AlonzoTx era
tx StrictMaybe (TxAuxData era)
txTxAuxData -> AlonzoTx era
tx {auxiliaryData :: StrictMaybe (TxAuxData era)
auxiliaryData = StrictMaybe (TxAuxData era)
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 =
  forall s a. (s -> a) -> SimpleGetter s a
to forall a b. (a -> b) -> a -> b
$
    forall a b. (Integral a, Num b) => a -> b
fromIntegral
      forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Int64
LBS.length
      forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. EncCBOR a => Version -> a -> ByteString
serialize (forall era. Era era => Version
eraProtVerLow @era)
      forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 =
  forall s a. (s -> a) -> SimpleGetter s a
to forall a b. (a -> b) -> a -> b
$
    forall {a} {b}. (Integral a, Num b, Show a) => a -> b
checkedFromIntegral
      forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Int64
LBS.length
      forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. EncCBOR a => Version -> a -> ByteString
serialize (forall era. Era era => Version
eraProtVerLow @era)
      forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. EncCBOR a => a -> Encoding
encCBOR
  where
    checkedFromIntegral :: a -> b
checkedFromIntegral a
n =
      if a
n forall a. Ord a => a -> a -> Bool
<= forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. Bounded a => a
maxBound :: Word32)
        then forall a b. (Integral a, Num b) => a -> b
fromIntegral a
n
        else forall a. HasCallStack => String -> a
error forall a b. (a -> b) -> a -> b
$ String
"Impossible: Size of the transaction is too big: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show a
n
{-# INLINEABLE wireSizeAlonzoTxF #-}

isValidAlonzoTxL :: Lens' (AlonzoTx era) IsValid
isValidAlonzoTxL :: forall era. Lens' (AlonzoTx era) IsValid
isValidAlonzoTxL = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens forall era. AlonzoTx era -> IsValid
isValid (\AlonzoTx era
tx IsValid
valid -> AlonzoTx era
tx {isValid :: IsValid
isValid = 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)

-- =========================================================
-- Figure 2: Definitions for Transactions

getCoin :: EraTxOut era => TxOut era -> Coin
getCoin :: forall era. EraTxOut era => TxOut era -> Coin
getCoin TxOut era
txOut = TxOut era
txOut forall s a. s -> Getting a s a -> a
^. forall era. (HasCallStack, EraTxOut era) => Lens' (TxOut era) Coin
coinTxOutL
{-# DEPRECATED getCoin "In favor of `coinTxOutL`" #-}

-- | 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
forall era.
AlonzoEraScript era =>
ScriptIntegrity era -> ScriptIntegrity era -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ScriptIntegrity era -> ScriptIntegrity era -> Bool
$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
Eq, 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
$cto :: forall era x. Rep (ScriptIntegrity era) x -> ScriptIntegrity era
$cfrom :: forall era x. ScriptIntegrity era -> Rep (ScriptIntegrity era) x
Generic, Typeable)

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 forall era. TxDats era -> Bool
nullDats TxDats era
d then forall a. Monoid a => a
mempty else forall t. SafeToHash t => t -> ByteString
originalBytes TxDats era
d
        lBytes :: ByteString
lBytes = forall a. EncCBOR a => Version -> a -> ByteString
serialize' (forall era. Era era => Version
eraProtVerLow @era) (Set LangDepView -> Encoding
encodeLangViews Set LangDepView
l)
     in forall t. SafeToHash t => t -> ByteString
originalBytes Redeemers era
m forall a. Semigroup a => a -> a -> a
<> ByteString
dBytes forall a. Semigroup a => a -> a -> a
<> ByteString
lBytes

instance
  (Era era, c ~ EraCrypto era) =>
  HashAnnotated (ScriptIntegrity era) EraIndependentScriptIntegrity c

hashScriptIntegrity ::
  forall era.
  AlonzoEraScript era =>
  Set LangDepView ->
  Redeemers era ->
  TxDats era ->
  StrictMaybe (ScriptIntegrityHash (EraCrypto era))
hashScriptIntegrity :: forall era.
AlonzoEraScript era =>
Set LangDepView
-> Redeemers era
-> TxDats era
-> StrictMaybe (ScriptIntegrityHash (EraCrypto era))
hashScriptIntegrity Set LangDepView
langViews Redeemers era
rdmrs TxDats era
dats =
  if forall era. Redeemers era -> Bool
nullRedeemers Redeemers era
rdmrs Bool -> Bool -> Bool
&& forall a. Set a -> Bool
Set.null Set LangDepView
langViews Bool -> Bool -> Bool
&& forall era. TxDats era -> Bool
nullDats TxDats era
dats
    then forall a. StrictMaybe a
SNothing
    else forall a. a -> StrictMaybe a
SJust (forall x index c.
(HashAnnotated x index c, HashAlgorithm (HASH c)) =>
x -> SafeHash c index
hashAnnotated (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 :: TxBody era
body :: forall era. AlonzoTx era -> TxBody era
body, TxWits era
wits :: TxWits era
wits :: forall era. AlonzoTx era -> TxWits era
wits, StrictMaybe (TxAuxData era)
auxiliaryData :: StrictMaybe (TxAuxData era)
auxiliaryData :: forall era. AlonzoTx era -> StrictMaybe (TxAuxData era)
auxiliaryData} =
  Word -> Encoding
encodeListLen Word
3
    forall a. Semigroup a => a -> a -> a
<> forall a. EncCBOR a => a -> Encoding
encCBOR TxBody era
body
    forall a. Semigroup a => a -> a -> a
<> forall a. EncCBOR a => a -> Encoding
encCBOR TxWits era
wits
    forall a. Semigroup a => a -> a -> a
<> forall a. (a -> Encoding) -> Maybe a -> Encoding
encodeNullMaybe forall a. EncCBOR a => a -> Encoding
encCBOR (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 forall s a. s -> Getting a s a -> a
^. forall era. EraTx era => SimpleGetter (Tx era) Integer
sizeTxF forall t i. (Val t, Integral i) => i -> t -> t
<×> PParams era
pp forall s a. s -> Getting a s a -> a
^. forall era. EraPParams era => Lens' (PParams era) Coin
ppMinFeeAL)
    forall t. Val t => t -> t -> t
<+> (PParams era
pp forall s a. s -> Getting a s a -> a
^. forall era. EraPParams era => Lens' (PParams era) Coin
ppMinFeeBL)
    forall t. Val t => t -> t -> t
<+> Prices -> ExUnits -> Coin
txscriptfee (PParams era
pp forall s a. s -> Getting a s a -> a
^. forall era. AlonzoEraPParams era => Lens' (PParams era) Prices
ppPricesL) ExUnits
allExunits
  where
    allExunits :: ExUnits
allExunits = forall era. (EraTx era, AlonzoEraTxWits era) => Tx era -> ExUnits
totExUnits Tx era
tx

minfee ::
  ( EraTx era
  , AlonzoEraTxWits era
  , AlonzoEraPParams era
  ) =>
  PParams era ->
  Tx era ->
  Coin
minfee :: forall era.
(EraTx era, AlonzoEraTxWits era, AlonzoEraPParams era) =>
PParams era -> Tx era -> Coin
minfee = forall era.
(EraTx era, AlonzoEraTxWits era, AlonzoEraPParams era) =>
PParams era -> Tx era -> Coin
alonzoMinFeeTx
{-# DEPRECATED minfee "In favor of `getMinFeeTx`" #-}

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

-- ===============================================================
-- Operations on scripts from specification
-- Figure 6:Indexing script and data objects
-- ===============================================================

{-# DEPRECATED getMapFromValue "No longer used" #-}
getMapFromValue :: MaryValue c -> Map.Map (PolicyID c) (Map.Map AssetName Integer)
getMapFromValue :: forall c. MaryValue c -> Map (PolicyID c) (Map AssetName Integer)
getMapFromValue (MaryValue Coin
_ (MultiAsset Map (PolicyID c) (Map AssetName Integer)
m)) = Map (PolicyID c) (Map AssetName Integer)
m

-- | Find the Data and ExUnits assigned to a plutus script.
indexRedeemers ::
  (AlonzoEraTxWits era, EraTx era) =>
  Tx era ->
  PlutusPurpose AsIxItem era ->
  Maybe (Data era, ExUnits)
indexRedeemers :: forall era.
(AlonzoEraTxWits era, EraTx era) =>
Tx era -> PlutusPurpose AsIxItem era -> Maybe (Data era, ExUnits)
indexRedeemers Tx era
tx PlutusPurpose AsIxItem era
sp = forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (forall era (g :: * -> * -> *) (f :: * -> * -> *).
AlonzoEraScript era =>
(forall ix it. g ix it -> f ix it)
-> PlutusPurpose g era -> PlutusPurpose f era
hoistPlutusPurpose forall ix it. AsIxItem ix it -> AsIx ix it
toAsIx PlutusPurpose AsIxItem era
sp) Map (PlutusPurpose AsIx era) (Data era, ExUnits)
redeemers
  where
    redeemers :: Map (PlutusPurpose AsIx era) (Data era, ExUnits)
redeemers = forall era.
Redeemers era -> Map (PlutusPurpose AsIx era) (Data era, ExUnits)
unRedeemers (Tx era
tx forall s a. s -> Getting a s a -> a
^. forall era. EraTx era => Lens' (Tx era) (TxWits era)
witsTxL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era.
AlonzoEraTxWits era =>
Lens' (TxWits era) (Redeemers era)
rdmrsTxWitsL)
{-# DEPRECATED indexRedeemers "As no longer needed" #-}

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

-- | Construct an annotated Alonzo style transaction.
alonzoSegwitTx ::
  AlonzoEraTx era =>
  Annotator (TxBody era) ->
  Annotator (TxWits era) ->
  IsValid ->
  Maybe (Annotator (TxAuxData era)) ->
  Annotator (Tx era)
alonzoSegwitTx :: forall era.
AlonzoEraTx era =>
Annotator (TxBody era)
-> Annotator (TxWits era)
-> IsValid
-> Maybe (Annotator (TxAuxData era))
-> Annotator (Tx era)
alonzoSegwitTx Annotator (TxBody era)
txBodyAnn Annotator (TxWits era)
txWitsAnn IsValid
isValid Maybe (Annotator (TxAuxData era))
auxDataAnn = forall a. (FullByteString -> a) -> Annotator a
Annotator forall a b. (a -> b) -> a -> b
$ \FullByteString
bytes ->
  let txBody :: TxBody era
txBody = forall a. Annotator a -> FullByteString -> a
runAnnotator Annotator (TxBody era)
txBodyAnn FullByteString
bytes
      txWits :: TxWits era
txWits = forall a. Annotator a -> FullByteString -> a
runAnnotator Annotator (TxWits era)
txWitsAnn FullByteString
bytes
      txAuxData :: StrictMaybe (TxAuxData era)
txAuxData = forall a. Maybe a -> StrictMaybe a
maybeToStrictMaybe (forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a. Annotator a -> FullByteString -> a
runAnnotator FullByteString
bytes forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (Annotator (TxAuxData era))
auxDataAnn)
   in forall era. EraTx era => TxBody era -> Tx era
mkBasicTx TxBody era
txBody
        forall a b. a -> (a -> b) -> b
& forall era. EraTx era => Lens' (Tx era) (TxWits era)
witsTxL forall s t a b. ASetter s t a b -> b -> s -> t
.~ TxWits era
txWits
        forall a b. a -> (a -> b) -> b
& forall era.
EraTx era =>
Lens' (Tx era) (StrictMaybe (AuxiliaryData era))
auxDataTxL forall s t a b. ASetter s t a b -> b -> s -> t
.~ StrictMaybe (TxAuxData era)
txAuxData
        forall a b. a -> (a -> b) -> b
& forall era. AlonzoEraTx era => Lens' (Tx era) IsValid
isValidTxL forall s t a b. ASetter s t a b -> b -> s -> t
.~ IsValid
isValid

--------------------------------------------------------------------------------
-- 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 :: TxBody era
body :: forall era. AlonzoTx era -> TxBody era
body, TxWits era
wits :: TxWits era
wits :: forall era. AlonzoTx era -> TxWits era
wits, StrictMaybe (TxAuxData era)
auxiliaryData :: StrictMaybe (TxAuxData era)
auxiliaryData :: forall era. AlonzoTx era -> StrictMaybe (TxAuxData era)
auxiliaryData, IsValid
isValid :: IsValid
isValid :: forall era. AlonzoTx era -> IsValid
isValid} =
    forall (w :: Wrapped) t. Encode w t -> Encoding
encode forall a b. (a -> b) -> a -> b
$
      forall t. t -> Encode ('Closed 'Dense) t
Rec forall era.
TxBody era
-> TxWits era
-> IsValid
-> StrictMaybe (TxAuxData era)
-> AlonzoTx era
AlonzoTx
        forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To TxBody era
body
        forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To TxWits era
wits
        forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To IsValid
isValid
        forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> forall t. (t -> Encoding) -> t -> Encode ('Closed 'Dense) t
E (forall a. (a -> Encoding) -> Maybe a -> Encoding
encodeNullMaybe forall a. EncCBOR a => a -> Encoding
encCBOR forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 = 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 (Annotator (TxBody era))
  , DecCBOR (Annotator (TxWits era))
  , DecCBOR (Annotator (TxAuxData era))
  ) =>
  DecCBOR (Annotator (AlonzoTx era))
  where
  decCBOR :: forall s. Decoder s (Annotator (AlonzoTx era))
decCBOR =
    forall (w :: Wrapped) t s. Decode w t -> Decoder s t
decode forall a b. (a -> b) -> a -> b
$
      forall (w :: Wrapped) t1. Decode w t1 -> Decode w (Annotator t1)
Ann (forall t. t -> Decode ('Closed 'Dense) t
RecD forall era.
TxBody era
-> TxWits era
-> IsValid
-> StrictMaybe (TxAuxData era)
-> AlonzoTx era
AlonzoTx)
        forall (w1 :: Wrapped) a t (d :: Density).
Decode w1 (Annotator (a -> t))
-> Decode ('Closed d) (Annotator a) -> Decode w1 (Annotator t)
<*! forall t (w :: Wrapped). DecCBOR t => Decode w t
From
        forall (w1 :: Wrapped) a t (d :: Density).
Decode w1 (Annotator (a -> t))
-> Decode ('Closed d) (Annotator a) -> Decode w1 (Annotator t)
<*! forall t (w :: Wrapped). DecCBOR t => Decode w t
From
        forall (w1 :: Wrapped) a t (d :: Density).
Decode w1 (Annotator (a -> t))
-> Decode ('Closed d) (Annotator a) -> Decode w1 (Annotator t)
<*! forall (w :: Wrapped) t1. Decode w t1 -> Decode w (Annotator t1)
Ann forall t (w :: Wrapped). DecCBOR t => Decode w t
From
        forall (w1 :: Wrapped) a t (d :: Density).
Decode w1 (Annotator (a -> t))
-> Decode ('Closed d) (Annotator a) -> Decode w1 (Annotator t)
<*! forall t. (forall s. Decoder s t) -> Decode ('Closed 'Dense) t
D
          ( forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Maybe a -> StrictMaybe a
maybeToStrictMaybe
              forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s a. Decoder s a -> Decoder s (Maybe a)
decodeNullMaybe forall a s. DecCBOR a => Decoder s a
decCBOR
          )
  {-# INLINE decCBOR #-}

-- | Compute if an Addr has the hash of a TwoPhaseScript, we can tell
--   what kind of Script from the Hash, by looking it up in the Map
isTwoPhaseScriptAddressFromMap ::
  forall era.
  AlonzoEraScript era =>
  Map.Map (ScriptHash (EraCrypto era)) (Script era) ->
  Addr (EraCrypto era) ->
  Bool
isTwoPhaseScriptAddressFromMap :: forall era.
AlonzoEraScript era =>
Map (ScriptHash (EraCrypto era)) (Script era)
-> Addr (EraCrypto era) -> Bool
isTwoPhaseScriptAddressFromMap Map (ScriptHash (EraCrypto era)) (Script era)
hashScriptMap Addr (EraCrypto era)
addr = forall a. Maybe a -> Bool
isJust forall a b. (a -> b) -> a -> b
$ do
  ScriptHash (EraCrypto era)
scriptHash <- forall c. Addr c -> Maybe (ScriptHash c)
Shelley.getScriptHash Addr (EraCrypto era)
addr
  forall era.
AlonzoEraScript era =>
ScriptHash (EraCrypto era)
-> Map (ScriptHash (EraCrypto era)) (Script era)
-> Maybe (PlutusScript era)
lookupPlutusScript ScriptHash (EraCrypto era)
scriptHash Map (ScriptHash (EraCrypto era)) (Script era)
hashScriptMap
{-# DEPRECATED isTwoPhaseScriptAddressFromMap "No longer used. Inline implementation if you need it" #-}

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 =
  forall era. EraTx era => Tx era -> Tx era -> Bool
shelleyEqTxRaw Tx era
tx1 Tx era
tx2 Bool -> Bool -> Bool
&& (Tx era
tx1 forall s a. s -> Getting a s a -> a
^. forall era. AlonzoEraTx era => Lens' (Tx era) IsValid
isValidTxL forall a. Eq a => a -> a -> Bool
== Tx era
tx2 forall s a. s -> Getting a s a -> a
^. forall era. AlonzoEraTx era => Lens' (Tx era) IsValid
isValidTxL)