{-# LANGUAGE DataKinds            #-}
{-# LANGUAGE DeriveAnyClass       #-}
{-# LANGUAGE DeriveFunctor        #-}
{-# LANGUAGE DeriveGeneric        #-}
{-# LANGUAGE DerivingVia          #-}
{-# LANGUAGE FlexibleInstances    #-}
{-# LANGUAGE NamedFieldPuns       #-}
{-# LANGUAGE NoImplicitPrelude    #-}
{-# LANGUAGE OverloadedStrings    #-}
{-# LANGUAGE ScopedTypeVariables  #-}
{-# LANGUAGE TemplateHaskell      #-}
{-# LANGUAGE TypeApplications     #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE ViewPatterns         #-}
{-# OPTIONS_GHC -Wno-simplifiable-class-constraints #-}
{-# OPTIONS_GHC -fno-specialise #-}
{-# OPTIONS_GHC -fno-omit-interface-pragmas #-}
module Plutus.V1.Ledger.Contexts
    (
    -- * Pending transactions and related types
      TxInfo(..)
    , ScriptContext(..)
    , ScriptPurpose(..)
    , TxOut(..)
    , TxOutRef(..)
    , TxInInfo(..)
    , findOwnInput
    , findDatum
    , findDatumHash
    , findTxInByTxOutRef
    , findContinuingOutputs
    , getContinuingOutputs
    -- ** Hashes (see note [Hashes in validator scripts])
    -- * Validator functions
    -- ** Signatures
    , txSignedBy
    -- ** Transactions
    , pubKeyOutput
    , scriptOutputsAt
    , pubKeyOutputsAt
    , valueLockedBy
    , valuePaidTo
    , adaLockedBy
    , signsTransaction
    , spendsOutput
    , valueSpent
    , valueProduced
    , ownCurrencySymbol
    , ownHashes
    , ownHash
    , fromSymbol
    ) where

import GHC.Generics (Generic)
import PlutusTx
import PlutusTx.Prelude
import Prettyprinter (Pretty (..), nest, viaShow, vsep, (<+>))

import Plutus.V1.Ledger.Ada (Ada)
import Plutus.V1.Ledger.Ada qualified as Ada
import Plutus.V1.Ledger.Address (Address (..), toPubKeyHash)
import Plutus.V1.Ledger.Bytes (LedgerBytes (..))
import Plutus.V1.Ledger.Credential (Credential (..), StakingCredential)
import Plutus.V1.Ledger.Crypto (PubKey (..), PubKeyHash (..), Signature (..))
import Plutus.V1.Ledger.DCert (DCert (..))
import Plutus.V1.Ledger.Scripts
import Plutus.V1.Ledger.Time (POSIXTimeRange)
import Plutus.V1.Ledger.Tx (TxOut (..), TxOutRef (..))
import Plutus.V1.Ledger.TxId
import Plutus.V1.Ledger.Value (CurrencySymbol (..), Value)
import Prelude qualified as Haskell

{- Note [Script types in pending transactions]
To validate a transaction, we have to evaluate the validation script of each of
the transaction's inputs. The validation script sees the data of the
transaction output it validates, and the redeemer of the transaction input of
the transaction that consumes it.
In addition, the validation script also needs information on the transaction as
a whole (not just the output-input pair it is concerned with). This information
is provided by the `TxInfo` type. A `TxInfo` contains the hashes of
redeemer and data scripts of all of its inputs and outputs.
-}

-- | An input of a pending transaction.
data TxInInfo = TxInInfo
    { TxInInfo -> TxOutRef
txInInfoOutRef   :: TxOutRef
    , TxInInfo -> TxOut
txInInfoResolved :: TxOut
    } deriving stock ((forall x. TxInInfo -> Rep TxInInfo x)
-> (forall x. Rep TxInInfo x -> TxInInfo) -> Generic TxInInfo
forall x. Rep TxInInfo x -> TxInInfo
forall x. TxInInfo -> Rep TxInInfo x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep TxInInfo x -> TxInInfo
$cfrom :: forall x. TxInInfo -> Rep TxInInfo x
Generic, Int -> TxInInfo -> ShowS
[TxInInfo] -> ShowS
TxInInfo -> String
(Int -> TxInInfo -> ShowS)
-> (TxInInfo -> String) -> ([TxInInfo] -> ShowS) -> Show TxInInfo
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TxInInfo] -> ShowS
$cshowList :: [TxInInfo] -> ShowS
show :: TxInInfo -> String
$cshow :: TxInInfo -> String
showsPrec :: Int -> TxInInfo -> ShowS
$cshowsPrec :: Int -> TxInInfo -> ShowS
Haskell.Show, TxInInfo -> TxInInfo -> Bool
(TxInInfo -> TxInInfo -> Bool)
-> (TxInInfo -> TxInInfo -> Bool) -> Eq TxInInfo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TxInInfo -> TxInInfo -> Bool
$c/= :: TxInInfo -> TxInInfo -> Bool
== :: TxInInfo -> TxInInfo -> Bool
$c== :: TxInInfo -> TxInInfo -> Bool
Haskell.Eq)

instance Eq TxInInfo where
    TxInInfo TxOutRef
ref TxOut
res == :: TxInInfo -> TxInInfo -> Bool
== TxInInfo TxOutRef
ref' TxOut
res' = TxOutRef
ref TxOutRef -> TxOutRef -> Bool
forall a. Eq a => a -> a -> Bool
== TxOutRef
ref' Bool -> Bool -> Bool
&& TxOut
res TxOut -> TxOut -> Bool
forall a. Eq a => a -> a -> Bool
== TxOut
res'

instance Pretty TxInInfo where
    pretty :: TxInInfo -> Doc ann
pretty TxInInfo{TxOutRef
txInInfoOutRef :: TxOutRef
txInInfoOutRef :: TxInInfo -> TxOutRef
txInInfoOutRef, TxOut
txInInfoResolved :: TxOut
txInInfoResolved :: TxInInfo -> TxOut
txInInfoResolved} =
        TxOutRef -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty TxOutRef
txInInfoOutRef Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
"->" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> TxOut -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty TxOut
txInInfoResolved

-- | Purpose of the script that is currently running
data ScriptPurpose
    = Minting CurrencySymbol
    | Spending TxOutRef
    | Rewarding StakingCredential
    | Certifying DCert
    deriving stock ((forall x. ScriptPurpose -> Rep ScriptPurpose x)
-> (forall x. Rep ScriptPurpose x -> ScriptPurpose)
-> Generic ScriptPurpose
forall x. Rep ScriptPurpose x -> ScriptPurpose
forall x. ScriptPurpose -> Rep ScriptPurpose x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ScriptPurpose x -> ScriptPurpose
$cfrom :: forall x. ScriptPurpose -> Rep ScriptPurpose x
Generic, Int -> ScriptPurpose -> ShowS
[ScriptPurpose] -> ShowS
ScriptPurpose -> String
(Int -> ScriptPurpose -> ShowS)
-> (ScriptPurpose -> String)
-> ([ScriptPurpose] -> ShowS)
-> Show ScriptPurpose
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ScriptPurpose] -> ShowS
$cshowList :: [ScriptPurpose] -> ShowS
show :: ScriptPurpose -> String
$cshow :: ScriptPurpose -> String
showsPrec :: Int -> ScriptPurpose -> ShowS
$cshowsPrec :: Int -> ScriptPurpose -> ShowS
Haskell.Show, ScriptPurpose -> ScriptPurpose -> Bool
(ScriptPurpose -> ScriptPurpose -> Bool)
-> (ScriptPurpose -> ScriptPurpose -> Bool) -> Eq ScriptPurpose
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ScriptPurpose -> ScriptPurpose -> Bool
$c/= :: ScriptPurpose -> ScriptPurpose -> Bool
== :: ScriptPurpose -> ScriptPurpose -> Bool
$c== :: ScriptPurpose -> ScriptPurpose -> Bool
Haskell.Eq)

instance Eq ScriptPurpose where
    {-# INLINABLE (==) #-}
    Minting CurrencySymbol
cs == :: ScriptPurpose -> ScriptPurpose -> Bool
== Minting CurrencySymbol
cs'           = CurrencySymbol
cs CurrencySymbol -> CurrencySymbol -> Bool
forall a. Eq a => a -> a -> Bool
== CurrencySymbol
cs'
    Spending TxOutRef
ref == Spending TxOutRef
ref'       = TxOutRef
ref TxOutRef -> TxOutRef -> Bool
forall a. Eq a => a -> a -> Bool
== TxOutRef
ref'
    Rewarding StakingCredential
sc == Rewarding StakingCredential
sc'       = StakingCredential
sc StakingCredential -> StakingCredential -> Bool
forall a. Eq a => a -> a -> Bool
== StakingCredential
sc'
    Certifying DCert
cert == Certifying DCert
cert' = DCert
cert DCert -> DCert -> Bool
forall a. Eq a => a -> a -> Bool
== DCert
cert'
    ScriptPurpose
_ == ScriptPurpose
_                              = Bool
False

instance Pretty ScriptPurpose where
    pretty :: ScriptPurpose -> Doc ann
pretty = ScriptPurpose -> Doc ann
forall a ann. Show a => a -> Doc ann
viaShow

-- | A pending transaction. This is the view as seen by validator scripts, so some details are stripped out.
data TxInfo = TxInfo
    { TxInfo -> [TxInInfo]
txInfoInputs      :: [TxInInfo] -- ^ Transaction inputs
    , TxInfo -> [TxOut]
txInfoOutputs     :: [TxOut] -- ^ Transaction outputs
    , TxInfo -> Value
txInfoFee         :: Value -- ^ The fee paid by this transaction.
    , TxInfo -> Value
txInfoMint        :: Value -- ^ The 'Value' minted by this transaction.
    , TxInfo -> [DCert]
txInfoDCert       :: [DCert] -- ^ Digests of certificates included in this transaction
    , TxInfo -> [(StakingCredential, Integer)]
txInfoWdrl        :: [(StakingCredential, Integer)] -- ^ Withdrawals
    , TxInfo -> POSIXTimeRange
txInfoValidRange  :: POSIXTimeRange -- ^ The valid range for the transaction.
    , TxInfo -> [PubKeyHash]
txInfoSignatories :: [PubKeyHash] -- ^ Signatures provided with the transaction, attested that they all signed the tx
    , TxInfo -> [(DatumHash, Datum)]
txInfoData        :: [(DatumHash, Datum)]
    , TxInfo -> TxId
txInfoId          :: TxId
    -- ^ Hash of the pending transaction (excluding witnesses)
    } deriving stock ((forall x. TxInfo -> Rep TxInfo x)
-> (forall x. Rep TxInfo x -> TxInfo) -> Generic TxInfo
forall x. Rep TxInfo x -> TxInfo
forall x. TxInfo -> Rep TxInfo x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep TxInfo x -> TxInfo
$cfrom :: forall x. TxInfo -> Rep TxInfo x
Generic, Int -> TxInfo -> ShowS
[TxInfo] -> ShowS
TxInfo -> String
(Int -> TxInfo -> ShowS)
-> (TxInfo -> String) -> ([TxInfo] -> ShowS) -> Show TxInfo
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TxInfo] -> ShowS
$cshowList :: [TxInfo] -> ShowS
show :: TxInfo -> String
$cshow :: TxInfo -> String
showsPrec :: Int -> TxInfo -> ShowS
$cshowsPrec :: Int -> TxInfo -> ShowS
Haskell.Show, TxInfo -> TxInfo -> Bool
(TxInfo -> TxInfo -> Bool)
-> (TxInfo -> TxInfo -> Bool) -> Eq TxInfo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TxInfo -> TxInfo -> Bool
$c/= :: TxInfo -> TxInfo -> Bool
== :: TxInfo -> TxInfo -> Bool
$c== :: TxInfo -> TxInfo -> Bool
Haskell.Eq)

instance Eq TxInfo where
    {-# INLINABLE (==) #-}
    TxInfo [TxInInfo]
i [TxOut]
o Value
f Value
m [DCert]
c [(StakingCredential, Integer)]
w POSIXTimeRange
r [PubKeyHash]
s [(DatumHash, Datum)]
d TxId
tid == :: TxInfo -> TxInfo -> Bool
== TxInfo [TxInInfo]
i' [TxOut]
o' Value
f' Value
m' [DCert]
c' [(StakingCredential, Integer)]
w' POSIXTimeRange
r' [PubKeyHash]
s' [(DatumHash, Datum)]
d' TxId
tid' =
        [TxInInfo]
i [TxInInfo] -> [TxInInfo] -> Bool
forall a. Eq a => a -> a -> Bool
== [TxInInfo]
i' Bool -> Bool -> Bool
&& [TxOut]
o [TxOut] -> [TxOut] -> Bool
forall a. Eq a => a -> a -> Bool
== [TxOut]
o' Bool -> Bool -> Bool
&& Value
f Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
== Value
f' Bool -> Bool -> Bool
&& Value
m Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
== Value
m' Bool -> Bool -> Bool
&& [DCert]
c [DCert] -> [DCert] -> Bool
forall a. Eq a => a -> a -> Bool
== [DCert]
c' Bool -> Bool -> Bool
&& [(StakingCredential, Integer)]
w [(StakingCredential, Integer)]
-> [(StakingCredential, Integer)] -> Bool
forall a. Eq a => a -> a -> Bool
== [(StakingCredential, Integer)]
w' Bool -> Bool -> Bool
&& POSIXTimeRange
r POSIXTimeRange -> POSIXTimeRange -> Bool
forall a. Eq a => a -> a -> Bool
== POSIXTimeRange
r' Bool -> Bool -> Bool
&& [PubKeyHash]
s [PubKeyHash] -> [PubKeyHash] -> Bool
forall a. Eq a => a -> a -> Bool
== [PubKeyHash]
s' Bool -> Bool -> Bool
&& [(DatumHash, Datum)]
d [(DatumHash, Datum)] -> [(DatumHash, Datum)] -> Bool
forall a. Eq a => a -> a -> Bool
== [(DatumHash, Datum)]
d' Bool -> Bool -> Bool
&& TxId
tid TxId -> TxId -> Bool
forall a. Eq a => a -> a -> Bool
== TxId
tid'

instance Pretty TxInfo where
    pretty :: TxInfo -> Doc ann
pretty TxInfo{[TxInInfo]
txInfoInputs :: [TxInInfo]
txInfoInputs :: TxInfo -> [TxInInfo]
txInfoInputs, [TxOut]
txInfoOutputs :: [TxOut]
txInfoOutputs :: TxInfo -> [TxOut]
txInfoOutputs, Value
txInfoFee :: Value
txInfoFee :: TxInfo -> Value
txInfoFee, Value
txInfoMint :: Value
txInfoMint :: TxInfo -> Value
txInfoMint, [DCert]
txInfoDCert :: [DCert]
txInfoDCert :: TxInfo -> [DCert]
txInfoDCert, [(StakingCredential, Integer)]
txInfoWdrl :: [(StakingCredential, Integer)]
txInfoWdrl :: TxInfo -> [(StakingCredential, Integer)]
txInfoWdrl, POSIXTimeRange
txInfoValidRange :: POSIXTimeRange
txInfoValidRange :: TxInfo -> POSIXTimeRange
txInfoValidRange, [PubKeyHash]
txInfoSignatories :: [PubKeyHash]
txInfoSignatories :: TxInfo -> [PubKeyHash]
txInfoSignatories, [(DatumHash, Datum)]
txInfoData :: [(DatumHash, Datum)]
txInfoData :: TxInfo -> [(DatumHash, Datum)]
txInfoData, TxId
txInfoId :: TxId
txInfoId :: TxInfo -> TxId
txInfoId} =
        [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
vsep
            [ Doc ann
"TxId:" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> TxId -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty TxId
txInfoId
            , Doc ann
"Inputs:" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> [TxInInfo] -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty [TxInInfo]
txInfoInputs
            , Doc ann
"Outputs:" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> [TxOut] -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty [TxOut]
txInfoOutputs
            , Doc ann
"Fee:" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Value -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Value
txInfoFee
            , Doc ann
"Value minted:" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Value -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Value
txInfoMint
            , Doc ann
"DCerts:" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> [DCert] -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty [DCert]
txInfoDCert
            , Doc ann
"Wdrl:" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> [(StakingCredential, Integer)] -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty [(StakingCredential, Integer)]
txInfoWdrl
            , Doc ann
"Valid range:" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> POSIXTimeRange -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty POSIXTimeRange
txInfoValidRange
            , Doc ann
"Signatories:" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> [PubKeyHash] -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty [PubKeyHash]
txInfoSignatories
            , Doc ann
"Datums:" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> [(DatumHash, Datum)] -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty [(DatumHash, Datum)]
txInfoData
            ]

data ScriptContext = ScriptContext{ScriptContext -> TxInfo
scriptContextTxInfo :: TxInfo, ScriptContext -> ScriptPurpose
scriptContextPurpose :: ScriptPurpose }
    deriving stock ((forall x. ScriptContext -> Rep ScriptContext x)
-> (forall x. Rep ScriptContext x -> ScriptContext)
-> Generic ScriptContext
forall x. Rep ScriptContext x -> ScriptContext
forall x. ScriptContext -> Rep ScriptContext x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ScriptContext x -> ScriptContext
$cfrom :: forall x. ScriptContext -> Rep ScriptContext x
Generic, ScriptContext -> ScriptContext -> Bool
(ScriptContext -> ScriptContext -> Bool)
-> (ScriptContext -> ScriptContext -> Bool) -> Eq ScriptContext
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ScriptContext -> ScriptContext -> Bool
$c/= :: ScriptContext -> ScriptContext -> Bool
== :: ScriptContext -> ScriptContext -> Bool
$c== :: ScriptContext -> ScriptContext -> Bool
Haskell.Eq, Int -> ScriptContext -> ShowS
[ScriptContext] -> ShowS
ScriptContext -> String
(Int -> ScriptContext -> ShowS)
-> (ScriptContext -> String)
-> ([ScriptContext] -> ShowS)
-> Show ScriptContext
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ScriptContext] -> ShowS
$cshowList :: [ScriptContext] -> ShowS
show :: ScriptContext -> String
$cshow :: ScriptContext -> String
showsPrec :: Int -> ScriptContext -> ShowS
$cshowsPrec :: Int -> ScriptContext -> ShowS
Haskell.Show)

instance Eq ScriptContext where
    {-# INLINABLE (==) #-}
    ScriptContext TxInfo
info ScriptPurpose
purpose == :: ScriptContext -> ScriptContext -> Bool
== ScriptContext TxInfo
info' ScriptPurpose
purpose' = TxInfo
info TxInfo -> TxInfo -> Bool
forall a. Eq a => a -> a -> Bool
== TxInfo
info' Bool -> Bool -> Bool
&& ScriptPurpose
purpose ScriptPurpose -> ScriptPurpose -> Bool
forall a. Eq a => a -> a -> Bool
== ScriptPurpose
purpose'

instance Pretty ScriptContext where
    pretty :: ScriptContext -> Doc ann
pretty ScriptContext{TxInfo
scriptContextTxInfo :: TxInfo
scriptContextTxInfo :: ScriptContext -> TxInfo
scriptContextTxInfo, ScriptPurpose
scriptContextPurpose :: ScriptPurpose
scriptContextPurpose :: ScriptContext -> ScriptPurpose
scriptContextPurpose} =
        [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
vsep
            [ Doc ann
"Purpose:" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> ScriptPurpose -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty ScriptPurpose
scriptContextPurpose
            , Int -> Doc ann -> Doc ann
forall ann. Int -> Doc ann -> Doc ann
nest Int
2 (Doc ann -> Doc ann) -> Doc ann -> Doc ann
forall a b. (a -> b) -> a -> b
$ [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
vsep [Doc ann
"TxInfo:", TxInfo -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty TxInfo
scriptContextTxInfo]
            ]

{-# INLINABLE findOwnInput #-}
-- | Find the input currently being validated.
findOwnInput :: ScriptContext -> Maybe TxInInfo
findOwnInput :: ScriptContext -> Maybe TxInInfo
findOwnInput ScriptContext{scriptContextTxInfo :: ScriptContext -> TxInfo
scriptContextTxInfo=TxInfo{[TxInInfo]
txInfoInputs :: [TxInInfo]
txInfoInputs :: TxInfo -> [TxInInfo]
txInfoInputs}, scriptContextPurpose :: ScriptContext -> ScriptPurpose
scriptContextPurpose=Spending TxOutRef
txOutRef} =
    (TxInInfo -> Bool) -> [TxInInfo] -> Maybe TxInInfo
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (\TxInInfo{TxOutRef
txInInfoOutRef :: TxOutRef
txInInfoOutRef :: TxInInfo -> TxOutRef
txInInfoOutRef} -> TxOutRef
txInInfoOutRef TxOutRef -> TxOutRef -> Bool
forall a. Eq a => a -> a -> Bool
== TxOutRef
txOutRef) [TxInInfo]
txInfoInputs
findOwnInput ScriptContext
_ = Maybe TxInInfo
forall a. Maybe a
Nothing

{-# INLINABLE findDatum #-}
-- | Find the data corresponding to a data hash, if there is one
findDatum :: DatumHash -> TxInfo -> Maybe Datum
findDatum :: DatumHash -> TxInfo -> Maybe Datum
findDatum DatumHash
dsh TxInfo{[(DatumHash, Datum)]
txInfoData :: [(DatumHash, Datum)]
txInfoData :: TxInfo -> [(DatumHash, Datum)]
txInfoData} = (DatumHash, Datum) -> Datum
forall a b. (a, b) -> b
snd ((DatumHash, Datum) -> Datum)
-> Maybe (DatumHash, Datum) -> Maybe Datum
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((DatumHash, Datum) -> Bool)
-> [(DatumHash, Datum)] -> Maybe (DatumHash, Datum)
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (DatumHash, Datum) -> Bool
forall b. (DatumHash, b) -> Bool
f [(DatumHash, Datum)]
txInfoData
    where
        f :: (DatumHash, b) -> Bool
f (DatumHash
dsh', b
_) = DatumHash
dsh' DatumHash -> DatumHash -> Bool
forall a. Eq a => a -> a -> Bool
== DatumHash
dsh

{-# INLINABLE findDatumHash #-}
-- | Find the hash of a datum, if it is part of the pending transaction's
--   hashes
findDatumHash :: Datum -> TxInfo -> Maybe DatumHash
findDatumHash :: Datum -> TxInfo -> Maybe DatumHash
findDatumHash Datum
ds TxInfo{[(DatumHash, Datum)]
txInfoData :: [(DatumHash, Datum)]
txInfoData :: TxInfo -> [(DatumHash, Datum)]
txInfoData} = (DatumHash, Datum) -> DatumHash
forall a b. (a, b) -> a
fst ((DatumHash, Datum) -> DatumHash)
-> Maybe (DatumHash, Datum) -> Maybe DatumHash
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((DatumHash, Datum) -> Bool)
-> [(DatumHash, Datum)] -> Maybe (DatumHash, Datum)
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (DatumHash, Datum) -> Bool
forall a. (a, Datum) -> Bool
f [(DatumHash, Datum)]
txInfoData
    where
        f :: (a, Datum) -> Bool
f (a
_, Datum
ds') = Datum
ds' Datum -> Datum -> Bool
forall a. Eq a => a -> a -> Bool
== Datum
ds

{-# INLINABLE findTxInByTxOutRef #-}
findTxInByTxOutRef :: TxOutRef -> TxInfo -> Maybe TxInInfo
findTxInByTxOutRef :: TxOutRef -> TxInfo -> Maybe TxInInfo
findTxInByTxOutRef TxOutRef
outRef TxInfo{[TxInInfo]
txInfoInputs :: [TxInInfo]
txInfoInputs :: TxInfo -> [TxInInfo]
txInfoInputs} =
    (TxInInfo -> Bool) -> [TxInInfo] -> Maybe TxInInfo
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (\TxInInfo{TxOutRef
txInInfoOutRef :: TxOutRef
txInInfoOutRef :: TxInInfo -> TxOutRef
txInInfoOutRef} -> TxOutRef
txInInfoOutRef TxOutRef -> TxOutRef -> Bool
forall a. Eq a => a -> a -> Bool
== TxOutRef
outRef) [TxInInfo]
txInfoInputs

{-# INLINABLE findContinuingOutputs #-}
-- | Finds all the outputs that pay to the same script address that we are currently spending from, if any.
findContinuingOutputs :: ScriptContext -> [Integer]
findContinuingOutputs :: ScriptContext -> [Integer]
findContinuingOutputs ScriptContext
ctx | Just TxInInfo{txInInfoResolved :: TxInInfo -> TxOut
txInInfoResolved=TxOut{Address
txOutAddress :: TxOut -> Address
txOutAddress :: Address
txOutAddress}} <- ScriptContext -> Maybe TxInInfo
findOwnInput ScriptContext
ctx = (TxOut -> Bool) -> [TxOut] -> [Integer]
forall a. (a -> Bool) -> [a] -> [Integer]
findIndices (Address -> TxOut -> Bool
f Address
txOutAddress) (TxInfo -> [TxOut]
txInfoOutputs (TxInfo -> [TxOut]) -> TxInfo -> [TxOut]
forall a b. (a -> b) -> a -> b
$ ScriptContext -> TxInfo
scriptContextTxInfo ScriptContext
ctx)
    where
        f :: Address -> TxOut -> Bool
f Address
addr TxOut{txOutAddress :: TxOut -> Address
txOutAddress=Address
otherAddress} = Address
addr Address -> Address -> Bool
forall a. Eq a => a -> a -> Bool
== Address
otherAddress
findContinuingOutputs ScriptContext
_ = BuiltinString -> [Integer]
forall a. BuiltinString -> a
traceError BuiltinString
"Le" -- "Can't find any continuing outputs"

{-# INLINABLE getContinuingOutputs #-}
getContinuingOutputs :: ScriptContext -> [TxOut]
getContinuingOutputs :: ScriptContext -> [TxOut]
getContinuingOutputs ScriptContext
ctx | Just TxInInfo{txInInfoResolved :: TxInInfo -> TxOut
txInInfoResolved=TxOut{Address
txOutAddress :: Address
txOutAddress :: TxOut -> Address
txOutAddress}} <- ScriptContext -> Maybe TxInInfo
findOwnInput ScriptContext
ctx = (TxOut -> Bool) -> [TxOut] -> [TxOut]
forall a. (a -> Bool) -> [a] -> [a]
filter (Address -> TxOut -> Bool
f Address
txOutAddress) (TxInfo -> [TxOut]
txInfoOutputs (TxInfo -> [TxOut]) -> TxInfo -> [TxOut]
forall a b. (a -> b) -> a -> b
$ ScriptContext -> TxInfo
scriptContextTxInfo ScriptContext
ctx)
    where
        f :: Address -> TxOut -> Bool
f Address
addr TxOut{txOutAddress :: TxOut -> Address
txOutAddress=Address
otherAddress} = Address
addr Address -> Address -> Bool
forall a. Eq a => a -> a -> Bool
== Address
otherAddress
getContinuingOutputs ScriptContext
_ = BuiltinString -> [TxOut]
forall a. BuiltinString -> a
traceError BuiltinString
"Lf" -- "Can't get any continuing outputs"

{- Note [Hashes in validator scripts]

We need to deal with hashes of four different things in a validator script:

1. Transactions
2. Validator scripts
3. Data scripts
4. Redeemer scripts

The mockchain code in 'Ledger.Tx' only deals with the hashes of(1)
and (2), and uses the 'Ledger.Tx.TxId' and `Digest SHA256` types for
them.

In PLC validator scripts the situation is different: First, they need to work
with hashes of (1-4). Second, the `Digest SHA256` type is not available in PLC
- we have to represent all hashes as `ByteStrings`.

To ensure that we only compare hashes of the correct type inside a validator
script, we define a newtype for each of them, as well as functions for creating
them from the correct types in Haskell, and for comparing them (in
`Language.Plutus.Runtime.TH`).

-}

{-# INLINABLE txSignedBy #-}
-- | Check if a transaction was signed by the given public key.
txSignedBy :: TxInfo -> PubKeyHash -> Bool
txSignedBy :: TxInfo -> PubKeyHash -> Bool
txSignedBy TxInfo{[PubKeyHash]
txInfoSignatories :: [PubKeyHash]
txInfoSignatories :: TxInfo -> [PubKeyHash]
txInfoSignatories} PubKeyHash
k = case (PubKeyHash -> Bool) -> [PubKeyHash] -> Maybe PubKeyHash
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (PubKeyHash -> PubKeyHash -> Bool
forall a. Eq a => a -> a -> Bool
(==) PubKeyHash
k) [PubKeyHash]
txInfoSignatories of
    Just PubKeyHash
_  -> Bool
True
    Maybe PubKeyHash
Nothing -> Bool
False

{-# INLINABLE pubKeyOutput #-}
-- | Get the public key hash that locks the transaction output, if any.
pubKeyOutput :: TxOut -> Maybe PubKeyHash
pubKeyOutput :: TxOut -> Maybe PubKeyHash
pubKeyOutput TxOut{Address
txOutAddress :: Address
txOutAddress :: TxOut -> Address
txOutAddress} = Address -> Maybe PubKeyHash
toPubKeyHash Address
txOutAddress

{-# INLINABLE ownHashes #-}
-- | Get the validator and datum hashes of the output that is curently being validated
ownHashes :: ScriptContext -> (ValidatorHash, DatumHash)
ownHashes :: ScriptContext -> (ValidatorHash, DatumHash)
ownHashes (ScriptContext -> Maybe TxInInfo
findOwnInput -> Just TxInInfo{txInInfoResolved :: TxInInfo -> TxOut
txInInfoResolved=TxOut{txOutAddress :: TxOut -> Address
txOutAddress=Address (ScriptCredential ValidatorHash
s) Maybe StakingCredential
_, txOutDatumHash :: TxOut -> Maybe DatumHash
txOutDatumHash=Just DatumHash
dh}}) = (ValidatorHash
s,DatumHash
dh)
ownHashes ScriptContext
_ = BuiltinString -> (ValidatorHash, DatumHash)
forall a. BuiltinString -> a
traceError BuiltinString
"Lg" -- "Can't get validator and datum hashes"

{-# INLINABLE ownHash #-}
-- | Get the hash of the validator script that is currently being validated.
ownHash :: ScriptContext -> ValidatorHash
ownHash :: ScriptContext -> ValidatorHash
ownHash ScriptContext
p = (ValidatorHash, DatumHash) -> ValidatorHash
forall a b. (a, b) -> a
fst (ScriptContext -> (ValidatorHash, DatumHash)
ownHashes ScriptContext
p)

{-# INLINABLE fromSymbol #-}
-- | Convert a 'CurrencySymbol' to a 'ValidatorHash'
fromSymbol :: CurrencySymbol -> ValidatorHash
fromSymbol :: CurrencySymbol -> ValidatorHash
fromSymbol (CurrencySymbol BuiltinByteString
s) = BuiltinByteString -> ValidatorHash
ValidatorHash BuiltinByteString
s

{-# INLINABLE scriptOutputsAt #-}
-- | Get the list of 'TxOut' outputs of the pending transaction at
--   a given script address.
scriptOutputsAt :: ValidatorHash -> TxInfo -> [(DatumHash, Value)]
scriptOutputsAt :: ValidatorHash -> TxInfo -> [(DatumHash, Value)]
scriptOutputsAt ValidatorHash
h TxInfo
p =
    let flt :: TxOut -> Maybe (DatumHash, Value)
flt TxOut{txOutDatumHash :: TxOut -> Maybe DatumHash
txOutDatumHash=Just DatumHash
ds, txOutAddress :: TxOut -> Address
txOutAddress=Address (ScriptCredential ValidatorHash
s) Maybe StakingCredential
_, Value
txOutValue :: TxOut -> Value
txOutValue :: Value
txOutValue} | ValidatorHash
s ValidatorHash -> ValidatorHash -> Bool
forall a. Eq a => a -> a -> Bool
== ValidatorHash
h = (DatumHash, Value) -> Maybe (DatumHash, Value)
forall a. a -> Maybe a
Just (DatumHash
ds, Value
txOutValue)
        flt TxOut
_ = Maybe (DatumHash, Value)
forall a. Maybe a
Nothing
    in (TxOut -> Maybe (DatumHash, Value))
-> [TxOut] -> [(DatumHash, Value)]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe TxOut -> Maybe (DatumHash, Value)
flt (TxInfo -> [TxOut]
txInfoOutputs TxInfo
p)

{-# INLINABLE valueLockedBy #-}
-- | Get the total value locked by the given validator in this transaction.
valueLockedBy :: TxInfo -> ValidatorHash -> Value
valueLockedBy :: TxInfo -> ValidatorHash -> Value
valueLockedBy TxInfo
ptx ValidatorHash
h =
    let outputs :: [Value]
outputs = ((DatumHash, Value) -> Value) -> [(DatumHash, Value)] -> [Value]
forall a b. (a -> b) -> [a] -> [b]
map (DatumHash, Value) -> Value
forall a b. (a, b) -> b
snd (ValidatorHash -> TxInfo -> [(DatumHash, Value)]
scriptOutputsAt ValidatorHash
h TxInfo
ptx)
    in [Value] -> Value
forall a. Monoid a => [a] -> a
mconcat [Value]
outputs

{-# INLINABLE pubKeyOutputsAt #-}
-- | Get the values paid to a public key address by a pending transaction.
pubKeyOutputsAt :: PubKeyHash -> TxInfo -> [Value]
pubKeyOutputsAt :: PubKeyHash -> TxInfo -> [Value]
pubKeyOutputsAt PubKeyHash
pk TxInfo
p =
    let flt :: TxOut -> Maybe Value
flt TxOut{txOutAddress :: TxOut -> Address
txOutAddress = Address (PubKeyCredential PubKeyHash
pk') Maybe StakingCredential
_, Value
txOutValue :: Value
txOutValue :: TxOut -> Value
txOutValue} | PubKeyHash
pk PubKeyHash -> PubKeyHash -> Bool
forall a. Eq a => a -> a -> Bool
== PubKeyHash
pk' = Value -> Maybe Value
forall a. a -> Maybe a
Just Value
txOutValue
        flt TxOut
_                             = Maybe Value
forall a. Maybe a
Nothing
    in (TxOut -> Maybe Value) -> [TxOut] -> [Value]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe TxOut -> Maybe Value
flt (TxInfo -> [TxOut]
txInfoOutputs TxInfo
p)

{-# INLINABLE valuePaidTo #-}
-- | Get the total value paid to a public key address by a pending transaction.
valuePaidTo :: TxInfo -> PubKeyHash -> Value
valuePaidTo :: TxInfo -> PubKeyHash -> Value
valuePaidTo TxInfo
ptx PubKeyHash
pkh = [Value] -> Value
forall a. Monoid a => [a] -> a
mconcat (PubKeyHash -> TxInfo -> [Value]
pubKeyOutputsAt PubKeyHash
pkh TxInfo
ptx)

{-# INLINABLE adaLockedBy #-}
-- | Get the total amount of 'Ada' locked by the given validator in this transaction.
adaLockedBy :: TxInfo -> ValidatorHash -> Ada
adaLockedBy :: TxInfo -> ValidatorHash -> Ada
adaLockedBy TxInfo
ptx ValidatorHash
h = Value -> Ada
Ada.fromValue (TxInfo -> ValidatorHash -> Value
valueLockedBy TxInfo
ptx ValidatorHash
h)

{-# INLINABLE signsTransaction #-}
-- | Check if the provided signature is the result of signing the pending
--   transaction (without witnesses) with the given public key.
signsTransaction :: Signature -> PubKey -> TxInfo -> Bool
signsTransaction :: Signature -> PubKey -> TxInfo -> Bool
signsTransaction (Signature BuiltinByteString
sig) (PubKey (LedgerBytes BuiltinByteString
pk)) TxInfo{txInfoId :: TxInfo -> TxId
txInfoId=TxId BuiltinByteString
h} =
    BuiltinByteString -> BuiltinByteString -> BuiltinByteString -> Bool
verifySignature BuiltinByteString
pk BuiltinByteString
h BuiltinByteString
sig

{-# INLINABLE valueSpent #-}
-- | Get the total value of inputs spent by this transaction.
valueSpent :: TxInfo -> Value
valueSpent :: TxInfo -> Value
valueSpent = (TxInInfo -> Value) -> [TxInInfo] -> Value
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (TxOut -> Value
txOutValue (TxOut -> Value) -> (TxInInfo -> TxOut) -> TxInInfo -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TxInInfo -> TxOut
txInInfoResolved) ([TxInInfo] -> Value) -> (TxInfo -> [TxInInfo]) -> TxInfo -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TxInfo -> [TxInInfo]
txInfoInputs

{-# INLINABLE valueProduced #-}
-- | Get the total value of outputs produced by this transaction.
valueProduced :: TxInfo -> Value
valueProduced :: TxInfo -> Value
valueProduced = (TxOut -> Value) -> [TxOut] -> Value
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap TxOut -> Value
txOutValue ([TxOut] -> Value) -> (TxInfo -> [TxOut]) -> TxInfo -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TxInfo -> [TxOut]
txInfoOutputs

{-# INLINABLE ownCurrencySymbol #-}
-- | The 'CurrencySymbol' of the current validator script.
ownCurrencySymbol :: ScriptContext -> CurrencySymbol
ownCurrencySymbol :: ScriptContext -> CurrencySymbol
ownCurrencySymbol ScriptContext{scriptContextPurpose :: ScriptContext -> ScriptPurpose
scriptContextPurpose=Minting CurrencySymbol
cs} = CurrencySymbol
cs
ownCurrencySymbol ScriptContext
_                                              = BuiltinString -> CurrencySymbol
forall a. BuiltinString -> a
traceError BuiltinString
"Lh" -- "Can't get currency symbol of the current validator script"

{-# INLINABLE spendsOutput #-}
-- | Check if the pending transaction spends a specific transaction output
--   (identified by the hash of a transaction and an index into that
--   transactions' outputs)
spendsOutput :: TxInfo -> TxId -> Integer -> Bool
spendsOutput :: TxInfo -> TxId -> Integer -> Bool
spendsOutput TxInfo
p TxId
h Integer
i =
    let spendsOutRef :: TxInInfo -> Bool
spendsOutRef TxInInfo
inp =
            let outRef :: TxOutRef
outRef = TxInInfo -> TxOutRef
txInInfoOutRef TxInInfo
inp
            in TxId
h TxId -> TxId -> Bool
forall a. Eq a => a -> a -> Bool
== TxOutRef -> TxId
txOutRefId TxOutRef
outRef
                Bool -> Bool -> Bool
&& Integer
i Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== TxOutRef -> Integer
txOutRefIdx TxOutRef
outRef

    in (TxInInfo -> Bool) -> [TxInInfo] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any TxInInfo -> Bool
spendsOutRef (TxInfo -> [TxInInfo]
txInfoInputs TxInfo
p)

makeLift ''TxInInfo
makeIsDataIndexed ''TxInInfo [('TxInInfo,0)]

makeLift ''TxInfo
makeIsDataIndexed ''TxInfo [('TxInfo,0)]


makeLift ''ScriptPurpose
makeIsDataIndexed ''ScriptPurpose
    [ ('Minting,0)
    , ('Spending,1)
    , ('Rewarding,2)
    , ('Certifying,3)
    ]

makeLift ''ScriptContext
makeIsDataIndexed ''ScriptContext [('ScriptContext,0)]