{-# LANGUAGE TemplateHaskell #-}
{-# OPTIONS_GHC -Wno-simplifiable-class-constraints #-}
{-# OPTIONS_GHC -fno-omit-interface-pragmas #-}
{-# OPTIONS_GHC -fno-specialise #-}
{-# OPTIONS_GHC -fno-strictness #-}

-- | A custom ScriptContext and TxInfo which only "decodes" the fields we need.
module Hydra.ScriptContext where

import PlutusLedgerApi.V2.Contexts hiding (
  ScriptContext,
  TxInfo (..),
  scriptContextPurpose,
  scriptContextTxInfo,
 )
import PlutusTx.Prelude

import PlutusLedgerApi.V2 (
  Address (..),
  Credential (..),
  CurrencySymbol,
  Datum,
  DatumHash,
  Map,
  OutputDatum,
  PubKeyHash,
  ScriptHash,
  Value,
 )
import PlutusTx (makeIsDataIndexed)
import PlutusTx.AssocMap (lookup)

-- * Tx info

data TxInfo = TxInfo
  { TxInfo -> [TxInInfo]
txInfoInputs :: [TxInInfo]
  -- ^ Transaction inputs; cannot be an empty list
  , TxInfo -> BuiltinData
txInfoReferenceInputs :: BuiltinData
  -- ^ Transaction reference 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 -> BuiltinData
txInfoDCert :: BuiltinData
  -- ^ Digests of certificates included in this transaction
  , TxInfo -> BuiltinData
txInfoWdrl :: BuiltinData
  -- ^ Withdrawals
  , -- XXX: using POSIXTimeRange adds ~300 bytes, needed for Head
    TxInfo -> BuiltinData
txInfoValidRange :: BuiltinData
  -- ^ The valid range for the transaction.
  , TxInfo -> [PubKeyHash]
txInfoSignatories :: [PubKeyHash]
  -- ^ Signatures provided with the transaction, attested that they all signed the tx
  , TxInfo -> BuiltinData
txInfoRedeemers :: BuiltinData
  -- ^ A table of redeemers attached to the transaction
  , TxInfo -> Map DatumHash Datum
txInfoData :: Map DatumHash Datum
  -- ^ The lookup table of datums attached to the transaction
  , TxInfo -> BuiltinData
txInfoId :: BuiltinData
  -- ^ Hash of the pending transaction body (i.e. transaction excluding witnesses)
  }

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

-- * Script context

-- | The context that the currently-executing script can access.
data ScriptContext = ScriptContext
  { ScriptContext -> TxInfo
scriptContextTxInfo :: TxInfo
  -- ^ information about the transaction the currently-executing script is included in
  , ScriptContext -> ScriptPurpose
scriptContextPurpose :: ScriptPurpose
  -- ^ the purpose of the currently-executing script
  }

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

-- * Utilities

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

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

-- | Find the input currently being validated.
findOwnInput :: ScriptContext -> Maybe TxInInfo
findOwnInput :: ScriptContext -> Maybe TxInInfo
findOwnInput ScriptContext{scriptContextTxInfo :: ScriptContext -> TxInfo
scriptContextTxInfo = TxInfo{[TxInInfo]
txInfoInputs :: TxInfo -> [TxInInfo]
txInfoInputs :: [TxInInfo]
txInfoInputs}, scriptContextPurpose :: ScriptContext -> ScriptPurpose
scriptContextPurpose = Spending TxOutRef
txOutRef} =
  (TxInInfo -> Bool) -> [TxInInfo] -> Maybe TxInInfo
forall a. (a -> Bool) -> [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
{-# INLINEABLE findOwnInput #-}

-- | 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{Map DatumHash Datum
txInfoData :: TxInfo -> Map DatumHash Datum
txInfoData :: Map DatumHash Datum
txInfoData} = DatumHash -> Map DatumHash Datum -> Maybe Datum
forall k v. Eq k => k -> Map k v -> Maybe v
lookup DatumHash
dsh Map DatumHash Datum
txInfoData
{-# INLINEABLE findDatum #-}

-- | Given a UTXO reference and a transaction (`TxInfo`), resolve it to one of the transaction's inputs (`TxInInfo`).
findTxInByTxOutRef :: TxOutRef -> TxInfo -> Maybe TxInInfo
findTxInByTxOutRef :: TxOutRef -> TxInfo -> Maybe TxInInfo
findTxInByTxOutRef TxOutRef
outRef TxInfo{[TxInInfo]
txInfoInputs :: TxInfo -> [TxInInfo]
txInfoInputs :: [TxInInfo]
txInfoInputs} =
  (TxInInfo -> Bool) -> [TxInInfo] -> Maybe TxInInfo
forall a. (a -> Bool) -> [a] -> Maybe a
find (\TxInInfo{TxOutRef
txInInfoOutRef :: TxInInfo -> TxOutRef
txInInfoOutRef :: TxOutRef
txInInfoOutRef} -> TxOutRef
txInInfoOutRef TxOutRef -> TxOutRef -> Bool
forall a. Eq a => a -> a -> Bool
== TxOutRef
outRef) [TxInInfo]
txInfoInputs
{-# INLINEABLE findTxInByTxOutRef #-}

-- | 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"
{-# INLINEABLE ownCurrencySymbol #-}