{-# LANGUAGE BlockArguments #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# OPTIONS_GHC -Wno-orphans #-}

module PlutusLedgerApi.Test.ScriptContextBuilder.Builder
  ( UnitTestArgs (..)
  , InputBuilder (..)
  , TxOutBuilder (..)
  , ScriptContextBuilder (..)
  , ScriptContextBuilderState (..)
  , buildScriptContext
  , withRedeemer
  , withFee
  , withSigner
  , withSigners
  , withMint
  , withMintingScript
  , withSpendingScript
  , withRewardingScript
  , withRewardingScriptWithBuilder
  , withOutput
  , withInput
  , withScriptInput
  , withReferenceInput
  , withValue
  , withValidRange
  , withOutRef
  , withInlineDatum
  , withReferenceScript
  , withAddress
  , withWithdrawal
  , mkInput
  , addInput
  , addMint
  , mkMintingScriptWithPurpose
  , addChangeOutput
  , signAndAddChangeOutput
  , mkAdaValue
  , mkTxOut
  , withTxOutReferenceScript
  , withTxOutInlineDatum
  , withTxOutValue
  , withTxOutAddress
  , addOutput
  , addReferenceInput
  , buildBalancedScriptContext
  , balanceWithChangeOutput
  , builderPlaceHolderTxOutRef

    -- * Helpers
  , currencySymbolFromHex
  , singleCurrencySymbol
  )
where

import Control.Lens ((%~), (&), (.~), (^.))
import Data.ByteString.Base16 qualified as Base16
import Data.ByteString.Char8 qualified as BS8
import Data.Function (on)
import Data.List qualified as List
import Data.Maybe (isJust)
import Data.Ord (comparing)
import GHC.Generics (Generic)
import PlutusLedgerApi.Test.ScriptContextBuilder.Lenses
  ( scriptContextTxInfoL
  , txInfoFeeL
  , txInfoInputsL
  , txInfoMintL
  , txInfoOutputsL
  , txInfoRedeemersAssocL
  , txInfoReferenceInputsL
  , txInfoSignatoriesL
  )
import PlutusLedgerApi.V1.Address (toPubKeyHash, toScriptHash)
import PlutusLedgerApi.V3
  ( Address (Address)
  , BuiltinData
  , Credential (PubKeyCredential)
  , CurrencySymbol (CurrencySymbol)
  , Datum (Datum)
  , Lovelace (getLovelace)
  , OutputDatum (..)
  , POSIXTimeRange
  , PubKeyHash (PubKeyHash)
  , Redeemer (Redeemer)
  , ScriptContext (ScriptContext, scriptContextRedeemer, scriptContextScriptInfo, scriptContextTxInfo)
  , ScriptHash
  , ScriptInfo (MintingScript, RewardingScript, SpendingScript)
  , ScriptPurpose (..)
  , TxCert
  , TxId (TxId)
  , TxInInfo (TxInInfo, txInInfoOutRef, txInInfoResolved)
  , TxInfo (..)
  , TxOut (TxOut, txOutAddress, txOutDatum, txOutReferenceScript, txOutValue)
  , TxOutRef (TxOutRef)
  , Value (Value, getValue)
  , adaSymbol
  , adaToken
  , always
  , singleton
  )
import PlutusLedgerApi.V3.MintValue (MintValue (UnsafeMintValue), mintValueToMap)
import PlutusTx qualified
import PlutusTx.AssocMap qualified as Map
import PlutusTx.Builtins.Internal (BuiltinByteString (..))
import PlutusTx.Eq qualified
import PlutusTx.Numeric qualified as PlutusTx

instance PlutusTx.Eq.Eq ScriptPurpose where
  ScriptPurpose
a == :: ScriptPurpose -> ScriptPurpose -> Bool
== ScriptPurpose
b = ScriptPurpose -> BuiltinData
forall a. ToData a => a -> BuiltinData
PlutusTx.toBuiltinData ScriptPurpose
a BuiltinData -> BuiltinData -> Bool
forall a. Eq a => a -> a -> Bool
== ScriptPurpose -> BuiltinData
forall a. ToData a => a -> BuiltinData
PlutusTx.toBuiltinData ScriptPurpose
b

-- | Arguments for a unit test: a script context and additional parameters.
data UnitTestArgs = UnitTestArgs
  { UnitTestArgs -> ScriptContext
utaScriptContext :: ScriptContext
  , UnitTestArgs -> [BuiltinData]
utaParameters :: [BuiltinData]
  }
  deriving stock ((forall x. UnitTestArgs -> Rep UnitTestArgs x)
-> (forall x. Rep UnitTestArgs x -> UnitTestArgs)
-> Generic UnitTestArgs
forall x. Rep UnitTestArgs x -> UnitTestArgs
forall x. UnitTestArgs -> Rep UnitTestArgs x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. UnitTestArgs -> Rep UnitTestArgs x
from :: forall x. UnitTestArgs -> Rep UnitTestArgs x
$cto :: forall x. Rep UnitTestArgs x -> UnitTestArgs
to :: forall x. Rep UnitTestArgs x -> UnitTestArgs
Generic)

-- | Create a 'Value' containing only ADA from a 'Lovelace' amount.
mkAdaValue :: Lovelace -> Value
mkAdaValue :: Lovelace -> Value
mkAdaValue = CurrencySymbol -> TokenName -> Integer -> Value
singleton CurrencySymbol
adaSymbol TokenName
adaToken (Integer -> Value) -> (Lovelace -> Integer) -> Lovelace -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lovelace -> Integer
getLovelace

-- | Add a minting entry to an existing 'ScriptContext'.
addMint :: ScriptContext -> Value -> BuiltinData -> ScriptContext
addMint :: ScriptContext -> Value -> BuiltinData -> ScriptContext
addMint ScriptContext
ctx Value
newMint BuiltinData
redeemer =
  let existingMint :: Value
existingMint = Map CurrencySymbol (Map TokenName Integer) -> Value
Value (Map CurrencySymbol (Map TokenName Integer) -> Value)
-> Map CurrencySymbol (Map TokenName Integer) -> Value
forall a b. (a -> b) -> a -> b
$ MintValue -> Map CurrencySymbol (Map TokenName Integer)
mintValueToMap (ScriptContext
ctx ScriptContext
-> Getting MintValue ScriptContext MintValue -> MintValue
forall s a. s -> Getting a s a -> a
^. (TxInfo -> Const MintValue TxInfo)
-> ScriptContext -> Const MintValue ScriptContext
Lens' ScriptContext TxInfo
scriptContextTxInfoL ((TxInfo -> Const MintValue TxInfo)
 -> ScriptContext -> Const MintValue ScriptContext)
-> ((MintValue -> Const MintValue MintValue)
    -> TxInfo -> Const MintValue TxInfo)
-> Getting MintValue ScriptContext MintValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (MintValue -> Const MintValue MintValue)
-> TxInfo -> Const MintValue TxInfo
Lens' TxInfo MintValue
txInfoMintL)
      mergedMint :: MintValue
mergedMint = Map CurrencySymbol (Map TokenName Integer) -> MintValue
UnsafeMintValue (Value -> Map CurrencySymbol (Map TokenName Integer)
getValue (Value
existingMint Value -> Value -> Value
forall a. Semigroup a => a -> a -> a
<> Value
newMint))
      mintCS :: CurrencySymbol
mintCS = Value -> CurrencySymbol
singleCurrencySymbol Value
newMint
   in ScriptContext
ctx
        ScriptContext -> (ScriptContext -> ScriptContext) -> ScriptContext
forall a b. a -> (a -> b) -> b
& (TxInfo -> Identity TxInfo)
-> ScriptContext -> Identity ScriptContext
Lens' ScriptContext TxInfo
scriptContextTxInfoL ((TxInfo -> Identity TxInfo)
 -> ScriptContext -> Identity ScriptContext)
-> ((MintValue -> Identity MintValue) -> TxInfo -> Identity TxInfo)
-> (MintValue -> Identity MintValue)
-> ScriptContext
-> Identity ScriptContext
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (MintValue -> Identity MintValue) -> TxInfo -> Identity TxInfo
Lens' TxInfo MintValue
txInfoMintL ((MintValue -> Identity MintValue)
 -> ScriptContext -> Identity ScriptContext)
-> MintValue -> ScriptContext -> ScriptContext
forall s t a b. ASetter s t a b -> b -> s -> t
.~ MintValue
mergedMint
        ScriptContext -> (ScriptContext -> ScriptContext) -> ScriptContext
forall a b. a -> (a -> b) -> b
& (TxInfo -> Identity TxInfo)
-> ScriptContext -> Identity ScriptContext
Lens' ScriptContext TxInfo
scriptContextTxInfoL ((TxInfo -> Identity TxInfo)
 -> ScriptContext -> Identity ScriptContext)
-> ((Map ScriptPurpose Redeemer
     -> Identity (Map ScriptPurpose Redeemer))
    -> TxInfo -> Identity TxInfo)
-> (Map ScriptPurpose Redeemer
    -> Identity (Map ScriptPurpose Redeemer))
-> ScriptContext
-> Identity ScriptContext
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Map ScriptPurpose Redeemer
 -> Identity (Map ScriptPurpose Redeemer))
-> TxInfo -> Identity TxInfo
Lens' TxInfo (Map ScriptPurpose Redeemer)
txInfoRedeemersAssocL
          ((Map ScriptPurpose Redeemer
  -> Identity (Map ScriptPurpose Redeemer))
 -> ScriptContext -> Identity ScriptContext)
-> (Map ScriptPurpose Redeemer -> Map ScriptPurpose Redeemer)
-> ScriptContext
-> ScriptContext
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ ScriptPurpose
-> Redeemer
-> Map ScriptPurpose Redeemer
-> Map ScriptPurpose Redeemer
forall k v. Eq k => k -> v -> Map k v -> Map k v
Map.insert (CurrencySymbol -> ScriptPurpose
Minting CurrencySymbol
mintCS) (BuiltinData -> Redeemer
Redeemer BuiltinData
redeemer)

-- | Add a transaction input to an existing 'ScriptContext', sorted by 'TxOutRef'.
addInput :: TxInInfo -> ScriptContext -> ScriptContext
addInput :: TxInInfo -> ScriptContext -> ScriptContext
addInput TxInInfo
newInput =
  (TxInfo -> Identity TxInfo)
-> ScriptContext -> Identity ScriptContext
Lens' ScriptContext TxInfo
scriptContextTxInfoL ((TxInfo -> Identity TxInfo)
 -> ScriptContext -> Identity ScriptContext)
-> (([TxInInfo] -> Identity [TxInInfo])
    -> TxInfo -> Identity TxInfo)
-> ([TxInInfo] -> Identity [TxInInfo])
-> ScriptContext
-> Identity ScriptContext
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([TxInInfo] -> Identity [TxInInfo]) -> TxInfo -> Identity TxInfo
Lens' TxInfo [TxInInfo]
txInfoInputsL
    (([TxInInfo] -> Identity [TxInInfo])
 -> ScriptContext -> Identity ScriptContext)
-> ([TxInInfo] -> [TxInInfo]) -> ScriptContext -> ScriptContext
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (TxInInfo -> TxInInfo -> Ordering)
-> TxInInfo -> [TxInInfo] -> [TxInInfo]
forall a. (a -> a -> Ordering) -> a -> [a] -> [a]
List.insertBy ((TxInInfo -> TxOutRef) -> TxInInfo -> TxInInfo -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing TxInInfo -> TxOutRef
txInInfoOutRef) TxInInfo
newInput

-- | Add a reference input to an existing 'ScriptContext', sorted by 'TxOutRef'.
addReferenceInput :: TxInInfo -> ScriptContext -> ScriptContext
addReferenceInput :: TxInInfo -> ScriptContext -> ScriptContext
addReferenceInput TxInInfo
newInput =
  (TxInfo -> Identity TxInfo)
-> ScriptContext -> Identity ScriptContext
Lens' ScriptContext TxInfo
scriptContextTxInfoL ((TxInfo -> Identity TxInfo)
 -> ScriptContext -> Identity ScriptContext)
-> (([TxInInfo] -> Identity [TxInInfo])
    -> TxInfo -> Identity TxInfo)
-> ([TxInInfo] -> Identity [TxInInfo])
-> ScriptContext
-> Identity ScriptContext
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([TxInInfo] -> Identity [TxInInfo]) -> TxInfo -> Identity TxInfo
Lens' TxInfo [TxInInfo]
txInfoReferenceInputsL
    (([TxInInfo] -> Identity [TxInInfo])
 -> ScriptContext -> Identity ScriptContext)
-> ([TxInInfo] -> [TxInInfo]) -> ScriptContext -> ScriptContext
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (TxInInfo -> TxInInfo -> Ordering)
-> TxInInfo -> [TxInInfo] -> [TxInInfo]
forall a. (a -> a -> Ordering) -> a -> [a] -> [a]
List.insertBy ((TxInInfo -> TxOutRef) -> TxInInfo -> TxInInfo -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing TxInInfo -> TxOutRef
txInInfoOutRef) TxInInfo
newInput

-- | Prepend a transaction output to an existing 'ScriptContext'.
addOutput :: TxOut -> ScriptContext -> ScriptContext
addOutput :: TxOut -> ScriptContext -> ScriptContext
addOutput TxOut
newOutput =
  (TxInfo -> Identity TxInfo)
-> ScriptContext -> Identity ScriptContext
Lens' ScriptContext TxInfo
scriptContextTxInfoL ((TxInfo -> Identity TxInfo)
 -> ScriptContext -> Identity ScriptContext)
-> (([TxOut] -> Identity [TxOut]) -> TxInfo -> Identity TxInfo)
-> ([TxOut] -> Identity [TxOut])
-> ScriptContext
-> Identity ScriptContext
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([TxOut] -> Identity [TxOut]) -> TxInfo -> Identity TxInfo
Lens' TxInfo [TxOut]
txInfoOutputsL (([TxOut] -> Identity [TxOut])
 -> ScriptContext -> Identity ScriptContext)
-> ([TxOut] -> [TxOut]) -> ScriptContext -> ScriptContext
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (TxOut
newOutput TxOut -> [TxOut] -> [TxOut]
forall a. a -> [a] -> [a]
:)

-- | A composable builder for constructing transaction inputs.
newtype InputBuilder = InputBuilder {InputBuilder -> InputBuilderState -> InputBuilderState
runInputBuilder :: InputBuilderState -> InputBuilderState}

-- | Accumulated state for 'InputBuilder'.
data InputBuilderState = InputBuilderState
  { InputBuilderState -> TxOutRef
ibOutRef :: TxOutRef
  -- ^ UTXO reference for the input.
  , InputBuilderState -> Address
ibAddress :: Address
  -- ^ Address of the input.
  , InputBuilderState -> Value
ibValue :: Value
  -- ^ The value (assets) contained in the input.
  , InputBuilderState -> OutputDatum
ibDatum :: OutputDatum
  -- ^ Optional inline datum.
  , InputBuilderState -> Maybe ScriptHash
ibReferenceScript :: Maybe ScriptHash
  -- ^ Optional reference script.
  }

instance Semigroup InputBuilder where
  InputBuilder InputBuilderState -> InputBuilderState
a <> :: InputBuilder -> InputBuilder -> InputBuilder
<> InputBuilder InputBuilderState -> InputBuilderState
b = (InputBuilderState -> InputBuilderState) -> InputBuilder
InputBuilder (InputBuilderState -> InputBuilderState
a (InputBuilderState -> InputBuilderState)
-> (InputBuilderState -> InputBuilderState)
-> InputBuilderState
-> InputBuilderState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. InputBuilderState -> InputBuilderState
b)

instance Monoid InputBuilder where
  mempty :: InputBuilder
mempty = (InputBuilderState -> InputBuilderState) -> InputBuilder
InputBuilder InputBuilderState -> InputBuilderState
forall a. a -> a
id

-- | Default placeholder 'TxOutRef' used when none is specified.
builderPlaceHolderTxOutRef :: TxOutRef
builderPlaceHolderTxOutRef :: TxOutRef
builderPlaceHolderTxOutRef = TxId -> Integer -> TxOutRef
TxOutRef TxId
"deadbeef" Integer
0

builderPlaceHolderAddress :: Address
builderPlaceHolderAddress :: Address
builderPlaceHolderAddress = Credential -> Maybe StakingCredential -> Address
Address (PubKeyHash -> Credential
PubKeyCredential (BuiltinByteString -> PubKeyHash
PubKeyHash BuiltinByteString
"deadbeef")) Maybe StakingCredential
forall a. Maybe a
Nothing

defaultInputBuilderState :: InputBuilderState
defaultInputBuilderState :: InputBuilderState
defaultInputBuilderState =
  InputBuilderState
    { ibOutRef :: TxOutRef
ibOutRef = TxOutRef
builderPlaceHolderTxOutRef
    , ibAddress :: Address
ibAddress = Address
builderPlaceHolderAddress
    , ibValue :: Value
ibValue = Value
forall a. Monoid a => a
mempty
    , ibDatum :: OutputDatum
ibDatum = OutputDatum
NoOutputDatum
    , ibReferenceScript :: Maybe ScriptHash
ibReferenceScript = Maybe ScriptHash
forall a. Maybe a
Nothing
    }

-- | Set the UTXO reference for an input.
withOutRef :: TxOutRef -> InputBuilder
withOutRef :: TxOutRef -> InputBuilder
withOutRef TxOutRef
outRef =
  (InputBuilderState -> InputBuilderState) -> InputBuilder
InputBuilder \InputBuilderState
inputBuilder -> InputBuilderState
inputBuilder {ibOutRef = outRef}

-- | Set the address for an input.
withAddress :: Address -> InputBuilder
withAddress :: Address -> InputBuilder
withAddress Address
address =
  (InputBuilderState -> InputBuilderState) -> InputBuilder
InputBuilder \InputBuilderState
inputBuilder -> InputBuilderState
inputBuilder {ibAddress = address}

-- | Set the value for an input.
withValue :: Value -> InputBuilder
withValue :: Value -> InputBuilder
withValue Value
value =
  (InputBuilderState -> InputBuilderState) -> InputBuilder
InputBuilder \InputBuilderState
inputBuilder -> InputBuilderState
inputBuilder {ibValue = value}

-- | Attach an inline datum to an input.
withInlineDatum :: BuiltinData -> InputBuilder
withInlineDatum :: BuiltinData -> InputBuilder
withInlineDatum BuiltinData
datum =
  (InputBuilderState -> InputBuilderState) -> InputBuilder
InputBuilder \InputBuilderState
inputBuilder -> InputBuilderState
inputBuilder {ibDatum = OutputDatum (Datum datum)}

-- | Attach a reference script to an input.
withReferenceScript :: ScriptHash -> InputBuilder
withReferenceScript :: ScriptHash -> InputBuilder
withReferenceScript ScriptHash
scriptHash =
  (InputBuilderState -> InputBuilderState) -> InputBuilder
InputBuilder \InputBuilderState
inputBuilder -> InputBuilderState
inputBuilder {ibReferenceScript = Just scriptHash}

-- | Finalize an 'InputBuilder' into a 'TxInInfo'.
mkInput :: InputBuilder -> TxInInfo
mkInput :: InputBuilder -> TxInInfo
mkInput (InputBuilder InputBuilderState -> InputBuilderState
modify) =
  let builder :: InputBuilderState
builder = InputBuilderState -> InputBuilderState
modify InputBuilderState
defaultInputBuilderState
   in TxInInfo
        { txInInfoOutRef :: TxOutRef
txInInfoOutRef = InputBuilderState -> TxOutRef
ibOutRef InputBuilderState
builder
        , txInInfoResolved :: TxOut
txInInfoResolved =
            TxOut
              { txOutAddress :: Address
txOutAddress = InputBuilderState -> Address
ibAddress InputBuilderState
builder
              , txOutValue :: Value
txOutValue = InputBuilderState -> Value
ibValue InputBuilderState
builder
              , txOutDatum :: OutputDatum
txOutDatum = InputBuilderState -> OutputDatum
ibDatum InputBuilderState
builder
              , txOutReferenceScript :: Maybe ScriptHash
txOutReferenceScript = Maybe ScriptHash
forall a. Maybe a
Nothing
              }
        }

-- | A composable builder for constructing transaction outputs.
newtype TxOutBuilder = TxOutBuilder
  { TxOutBuilder -> TxOutBuilderState -> TxOutBuilderState
runTxOutBuilder :: TxOutBuilderState -> TxOutBuilderState
  }

-- | Accumulated state for 'TxOutBuilder'.
data TxOutBuilderState = TxOutBuilderState
  { TxOutBuilderState -> Address
tobAddress :: Address
  , TxOutBuilderState -> Value
tobValue :: Value
  , TxOutBuilderState -> OutputDatum
tobDatum :: OutputDatum
  , TxOutBuilderState -> Maybe ScriptHash
tobReferenceScript :: Maybe ScriptHash
  }

defaultTxOutBuilderState :: TxOutBuilderState
defaultTxOutBuilderState :: TxOutBuilderState
defaultTxOutBuilderState =
  TxOutBuilderState
    { tobAddress :: Address
tobAddress = Address
builderPlaceHolderAddress
    , tobValue :: Value
tobValue = Value
forall a. Monoid a => a
mempty
    , tobDatum :: OutputDatum
tobDatum = OutputDatum
NoOutputDatum
    , tobReferenceScript :: Maybe ScriptHash
tobReferenceScript = Maybe ScriptHash
forall a. Maybe a
Nothing
    }

instance Semigroup TxOutBuilder where
  TxOutBuilder TxOutBuilderState -> TxOutBuilderState
f <> :: TxOutBuilder -> TxOutBuilder -> TxOutBuilder
<> TxOutBuilder TxOutBuilderState -> TxOutBuilderState
g = (TxOutBuilderState -> TxOutBuilderState) -> TxOutBuilder
TxOutBuilder (TxOutBuilderState -> TxOutBuilderState
f (TxOutBuilderState -> TxOutBuilderState)
-> (TxOutBuilderState -> TxOutBuilderState)
-> TxOutBuilderState
-> TxOutBuilderState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TxOutBuilderState -> TxOutBuilderState
g)

instance Monoid TxOutBuilder where
  mempty :: TxOutBuilder
mempty = (TxOutBuilderState -> TxOutBuilderState) -> TxOutBuilder
TxOutBuilder TxOutBuilderState -> TxOutBuilderState
forall a. a -> a
id

-- | Set the address for a transaction output.
withTxOutAddress :: Address -> TxOutBuilder
withTxOutAddress :: Address -> TxOutBuilder
withTxOutAddress Address
addr =
  (TxOutBuilderState -> TxOutBuilderState) -> TxOutBuilder
TxOutBuilder \TxOutBuilderState
tob -> TxOutBuilderState
tob {tobAddress = addr}

-- | Add value to a transaction output (accumulates with existing value).
withTxOutValue :: Value -> TxOutBuilder
withTxOutValue :: Value -> TxOutBuilder
withTxOutValue Value
val =
  (TxOutBuilderState -> TxOutBuilderState) -> TxOutBuilder
TxOutBuilder \TxOutBuilderState
tob -> TxOutBuilderState
tob {tobValue = tobValue tob <> val}

-- | Attach an inline datum to a transaction output.
withTxOutInlineDatum :: BuiltinData -> TxOutBuilder
withTxOutInlineDatum :: BuiltinData -> TxOutBuilder
withTxOutInlineDatum BuiltinData
datum =
  (TxOutBuilderState -> TxOutBuilderState) -> TxOutBuilder
TxOutBuilder \TxOutBuilderState
tob -> TxOutBuilderState
tob {tobDatum = OutputDatum $ Datum datum}

-- | Attach a reference script to a transaction output.
withTxOutReferenceScript :: ScriptHash -> TxOutBuilder
withTxOutReferenceScript :: ScriptHash -> TxOutBuilder
withTxOutReferenceScript ScriptHash
scriptHash =
  (TxOutBuilderState -> TxOutBuilderState) -> TxOutBuilder
TxOutBuilder \TxOutBuilderState
tob -> TxOutBuilderState
tob {tobReferenceScript = Just scriptHash}

-- | Finalize a 'TxOutBuilder' into a 'TxOut'.
mkTxOut :: TxOutBuilder -> TxOut
mkTxOut :: TxOutBuilder -> TxOut
mkTxOut (TxOutBuilder TxOutBuilderState -> TxOutBuilderState
modify) =
  let finalState :: TxOutBuilderState
finalState = TxOutBuilderState -> TxOutBuilderState
modify TxOutBuilderState
defaultTxOutBuilderState
   in TxOut
        { txOutAddress :: Address
txOutAddress = TxOutBuilderState -> Address
tobAddress TxOutBuilderState
finalState
        , txOutValue :: Value
txOutValue = TxOutBuilderState -> Value
tobValue TxOutBuilderState
finalState
        , txOutDatum :: OutputDatum
txOutDatum = TxOutBuilderState -> OutputDatum
tobDatum TxOutBuilderState
finalState
        , txOutReferenceScript :: Maybe ScriptHash
txOutReferenceScript = TxOutBuilderState -> Maybe ScriptHash
tobReferenceScript TxOutBuilderState
finalState
        }

-- | Create a minimal 'ScriptContext' for a minting script.
mkMintingScriptWithPurpose :: Value -> BuiltinData -> ScriptContext
mkMintingScriptWithPurpose :: Value -> BuiltinData -> ScriptContext
mkMintingScriptWithPurpose Value
mintValue BuiltinData
redeemer =
  ScriptContext
    { scriptContextTxInfo :: TxInfo
scriptContextTxInfo = TxInfo
mintingScriptTxInfo
    , scriptContextRedeemer :: Redeemer
scriptContextRedeemer = BuiltinData -> Redeemer
Redeemer BuiltinData
redeemer
    , scriptContextScriptInfo :: ScriptInfo
scriptContextScriptInfo = CurrencySymbol -> ScriptInfo
MintingScript CurrencySymbol
mintCS
    }
  where
    mintCS :: CurrencySymbol
    mintCS :: CurrencySymbol
mintCS = Value -> CurrencySymbol
singleCurrencySymbol Value
mintValue

    mintingScriptTxInfo :: TxInfo
    mintingScriptTxInfo :: TxInfo
mintingScriptTxInfo =
      TxInfo
        { txInfoInputs :: [TxInInfo]
txInfoInputs = [TxInInfo]
forall a. Monoid a => a
mempty
        , txInfoReferenceInputs :: [TxInInfo]
txInfoReferenceInputs = [TxInInfo]
forall a. Monoid a => a
mempty
        , txInfoOutputs :: [TxOut]
txInfoOutputs = [TxOut]
forall a. Monoid a => a
mempty
        , txInfoFee :: Lovelace
txInfoFee = Lovelace
0
        , txInfoMint :: MintValue
txInfoMint = Map CurrencySymbol (Map TokenName Integer) -> MintValue
UnsafeMintValue (Value -> Map CurrencySymbol (Map TokenName Integer)
getValue Value
mintValue)
        , txInfoTxCerts :: [TxCert]
txInfoTxCerts = [TxCert]
forall a. Monoid a => a
mempty
        , txInfoWdrl :: Map Credential Lovelace
txInfoWdrl = Map Credential Lovelace
forall k v. Map k v
Map.empty
        , txInfoValidRange :: POSIXTimeRange
txInfoValidRange = POSIXTimeRange
forall a. Interval a
always
        , txInfoSignatories :: [PubKeyHash]
txInfoSignatories = [PubKeyHash]
forall a. Monoid a => a
mempty
        , txInfoRedeemers :: Map ScriptPurpose Redeemer
txInfoRedeemers = ScriptPurpose -> Redeemer -> Map ScriptPurpose Redeemer
forall k v. k -> v -> Map k v
Map.singleton (CurrencySymbol -> ScriptPurpose
Minting CurrencySymbol
mintCS) (BuiltinData -> Redeemer
Redeemer BuiltinData
redeemer)
        , txInfoData :: Map DatumHash Datum
txInfoData = Map DatumHash Datum
forall k v. Map k v
Map.empty
        , txInfoId :: TxId
txInfoId = BuiltinByteString -> TxId
TxId BuiltinByteString
""
        , txInfoVotes :: Map Voter (Map GovernanceActionId Vote)
txInfoVotes = Map Voter (Map GovernanceActionId Vote)
forall k v. Map k v
Map.empty
        , txInfoProposalProcedures :: [ProposalProcedure]
txInfoProposalProcedures = [ProposalProcedure]
forall a. Monoid a => a
mempty
        , txInfoCurrentTreasuryAmount :: Maybe Lovelace
txInfoCurrentTreasuryAmount = Maybe Lovelace
forall a. Maybe a
Nothing
        , txInfoTreasuryDonation :: Maybe Lovelace
txInfoTreasuryDonation = Maybe Lovelace
forall a. Maybe a
Nothing
        }

-- | Compute and add a change output to the given public key hash.
addChangeOutput :: PubKeyHash -> ScriptContext -> ScriptContext
addChangeOutput :: PubKeyHash -> ScriptContext -> ScriptContext
addChangeOutput PubKeyHash
signerPkh ScriptContext
ctx =
  let info :: TxInfo
info = ScriptContext
ctx ScriptContext -> Getting TxInfo ScriptContext TxInfo -> TxInfo
forall s a. s -> Getting a s a -> a
^. Getting TxInfo ScriptContext TxInfo
Lens' ScriptContext TxInfo
scriptContextTxInfoL
      totalInputValue :: Value
totalInputValue = (TxInInfo -> Value) -> [TxInInfo] -> Value
forall m a. Monoid m => (a -> m) -> [a] -> m
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) (TxInfo
info TxInfo -> Getting [TxInInfo] TxInfo [TxInInfo] -> [TxInInfo]
forall s a. s -> Getting a s a -> a
^. Getting [TxInInfo] TxInfo [TxInInfo]
Lens' TxInfo [TxInInfo]
txInfoInputsL)
      totalOutputValue :: Value
totalOutputValue = (TxOut -> Value) -> [TxOut] -> Value
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap TxOut -> Value
txOutValue (TxInfo
info TxInfo -> Getting [TxOut] TxInfo [TxOut] -> [TxOut]
forall s a. s -> Getting a s a -> a
^. Getting [TxOut] TxInfo [TxOut]
Lens' TxInfo [TxOut]
txInfoOutputsL)
      feeValue :: Value
feeValue = Lovelace -> Value
mkAdaValue (TxInfo
info TxInfo -> Getting Lovelace TxInfo Lovelace -> Lovelace
forall s a. s -> Getting a s a -> a
^. Getting Lovelace TxInfo Lovelace
Lens' TxInfo Lovelace
txInfoFeeL)
      mintedValue :: Value
mintedValue = Map CurrencySymbol (Map TokenName Integer) -> Value
Value (MintValue -> Map CurrencySymbol (Map TokenName Integer)
mintValueToMap (TxInfo
info TxInfo
-> ((MintValue -> Const MintValue MintValue)
    -> TxInfo -> Const MintValue TxInfo)
-> MintValue
forall s a. s -> Getting a s a -> a
^. (MintValue -> Const MintValue MintValue)
-> TxInfo -> Const MintValue TxInfo
Lens' TxInfo MintValue
txInfoMintL))
      changeOutput :: TxOut
changeOutput =
        Address -> Value -> OutputDatum -> Maybe ScriptHash -> TxOut
TxOut
          (Credential -> Maybe StakingCredential -> Address
Address (PubKeyHash -> Credential
PubKeyCredential PubKeyHash
signerPkh) Maybe StakingCredential
forall a. Maybe a
Nothing)
          ( Value
mintedValue
              Value -> Value -> Value
forall a. Semigroup a => a -> a -> a
<> Value
totalInputValue
              Value -> Value -> Value
forall a. Semigroup a => a -> a -> a
<> Value -> Value
forall a. AdditiveGroup a => a -> a
PlutusTx.negate Value
feeValue
              Value -> Value -> Value
forall a. Semigroup a => a -> a -> a
<> Value -> Value
forall a. AdditiveGroup a => a -> a
PlutusTx.negate Value
totalOutputValue
          )
          OutputDatum
NoOutputDatum
          Maybe ScriptHash
forall a. Maybe a
Nothing
   in ScriptContext
ctx ScriptContext -> (ScriptContext -> ScriptContext) -> ScriptContext
forall a b. a -> (a -> b) -> b
& (TxInfo -> Identity TxInfo)
-> ScriptContext -> Identity ScriptContext
Lens' ScriptContext TxInfo
scriptContextTxInfoL ((TxInfo -> Identity TxInfo)
 -> ScriptContext -> Identity ScriptContext)
-> (([TxOut] -> Identity [TxOut]) -> TxInfo -> Identity TxInfo)
-> ([TxOut] -> Identity [TxOut])
-> ScriptContext
-> Identity ScriptContext
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([TxOut] -> Identity [TxOut]) -> TxInfo -> Identity TxInfo
Lens' TxInfo [TxOut]
txInfoOutputsL (([TxOut] -> Identity [TxOut])
 -> ScriptContext -> Identity ScriptContext)
-> ([TxOut] -> [TxOut]) -> ScriptContext -> ScriptContext
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (TxOut
changeOutput TxOut -> [TxOut] -> [TxOut]
forall a. a -> [a] -> [a]
:)

-- | Balance the transaction by adding a change output to the first public key input.
balanceWithChangeOutput :: ScriptContext -> ScriptContext
balanceWithChangeOutput :: ScriptContext -> ScriptContext
balanceWithChangeOutput ScriptContext
ctx =
  let info :: TxInfo
info = ScriptContext
ctx ScriptContext -> Getting TxInfo ScriptContext TxInfo -> TxInfo
forall s a. s -> Getting a s a -> a
^. Getting TxInfo ScriptContext TxInfo
Lens' ScriptContext TxInfo
scriptContextTxInfoL
      resolvedInputs :: [TxOut]
resolvedInputs = (TxInInfo -> TxOut) -> [TxInInfo] -> [TxOut]
forall a b. (a -> b) -> [a] -> [b]
map TxInInfo -> TxOut
txInInfoResolved (TxInfo
info TxInfo -> Getting [TxInInfo] TxInfo [TxInInfo] -> [TxInInfo]
forall s a. s -> Getting a s a -> a
^. Getting [TxInInfo] TxInfo [TxInInfo]
Lens' TxInfo [TxInInfo]
txInfoInputsL)
      signerPkh :: PubKeyHash
signerPkh = case (TxOut -> Bool) -> [TxOut] -> [TxOut]
forall a. (a -> Bool) -> [a] -> [a]
filter (Maybe PubKeyHash -> Bool
forall a. Maybe a -> Bool
isJust (Maybe PubKeyHash -> Bool)
-> (TxOut -> Maybe PubKeyHash) -> TxOut -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Address -> Maybe PubKeyHash
toPubKeyHash (Address -> Maybe PubKeyHash)
-> (TxOut -> Address) -> TxOut -> Maybe PubKeyHash
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TxOut -> Address
txOutAddress) [TxOut]
resolvedInputs of
        TxOut (Address (PubKeyCredential PubKeyHash
pkh) Maybe StakingCredential
_) Value
_ OutputDatum
_ Maybe ScriptHash
_ : [TxOut]
_ -> PubKeyHash
pkh
        [TxOut]
_ -> BuiltinByteString -> PubKeyHash
PubKeyHash BuiltinByteString
"deadbeef"
      -- \^ Fallback to default if no public key input is found
      totalInputValue :: Value
totalInputValue = (TxInInfo -> Value) -> [TxInInfo] -> Value
forall m a. Monoid m => (a -> m) -> [a] -> m
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) (TxInfo
info TxInfo -> Getting [TxInInfo] TxInfo [TxInInfo] -> [TxInInfo]
forall s a. s -> Getting a s a -> a
^. Getting [TxInInfo] TxInfo [TxInInfo]
Lens' TxInfo [TxInInfo]
txInfoInputsL)
      totalOutputValue :: Value
totalOutputValue = (TxOut -> Value) -> [TxOut] -> Value
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap TxOut -> Value
txOutValue (TxInfo
info TxInfo -> Getting [TxOut] TxInfo [TxOut] -> [TxOut]
forall s a. s -> Getting a s a -> a
^. Getting [TxOut] TxInfo [TxOut]
Lens' TxInfo [TxOut]
txInfoOutputsL)
      feeValue :: Value
feeValue = Lovelace -> Value
mkAdaValue (TxInfo
info TxInfo -> Getting Lovelace TxInfo Lovelace -> Lovelace
forall s a. s -> Getting a s a -> a
^. Getting Lovelace TxInfo Lovelace
Lens' TxInfo Lovelace
txInfoFeeL)
      mintedValue :: Value
mintedValue = Map CurrencySymbol (Map TokenName Integer) -> Value
Value (Map CurrencySymbol (Map TokenName Integer) -> Value)
-> Map CurrencySymbol (Map TokenName Integer) -> Value
forall a b. (a -> b) -> a -> b
$ MintValue -> Map CurrencySymbol (Map TokenName Integer)
mintValueToMap (TxInfo
info TxInfo
-> ((MintValue -> Const MintValue MintValue)
    -> TxInfo -> Const MintValue TxInfo)
-> MintValue
forall s a. s -> Getting a s a -> a
^. (MintValue -> Const MintValue MintValue)
-> TxInfo -> Const MintValue TxInfo
Lens' TxInfo MintValue
txInfoMintL)
      changeOutput :: TxOut
changeOutput =
        Address -> Value -> OutputDatum -> Maybe ScriptHash -> TxOut
TxOut
          (Credential -> Maybe StakingCredential -> Address
Address (PubKeyHash -> Credential
PubKeyCredential PubKeyHash
signerPkh) Maybe StakingCredential
forall a. Maybe a
Nothing)
          ( Value
mintedValue
              Value -> Value -> Value
forall a. Semigroup a => a -> a -> a
<> Value
totalInputValue
              Value -> Value -> Value
forall a. Semigroup a => a -> a -> a
<> Value -> Value
forall a. AdditiveGroup a => a -> a
PlutusTx.negate Value
feeValue
              Value -> Value -> Value
forall a. Semigroup a => a -> a -> a
<> Value -> Value
forall a. AdditiveGroup a => a -> a
PlutusTx.negate Value
totalOutputValue
          )
          OutputDatum
NoOutputDatum
          Maybe ScriptHash
forall a. Maybe a
Nothing
   in ScriptContext
ctx ScriptContext -> (ScriptContext -> ScriptContext) -> ScriptContext
forall a b. a -> (a -> b) -> b
& (TxInfo -> Identity TxInfo)
-> ScriptContext -> Identity ScriptContext
Lens' ScriptContext TxInfo
scriptContextTxInfoL ((TxInfo -> Identity TxInfo)
 -> ScriptContext -> Identity ScriptContext)
-> (([TxOut] -> Identity [TxOut]) -> TxInfo -> Identity TxInfo)
-> ([TxOut] -> Identity [TxOut])
-> ScriptContext
-> Identity ScriptContext
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([TxOut] -> Identity [TxOut]) -> TxInfo -> Identity TxInfo
Lens' TxInfo [TxOut]
txInfoOutputsL (([TxOut] -> Identity [TxOut])
 -> ScriptContext -> Identity ScriptContext)
-> ([TxOut] -> [TxOut]) -> ScriptContext -> ScriptContext
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ ([TxOut] -> [TxOut] -> [TxOut]
forall a. Semigroup a => a -> a -> a
<> [TxOut
changeOutput])

-- | Add a signatory to an existing 'ScriptContext'.
addSigner :: PubKeyHash -> ScriptContext -> ScriptContext
addSigner :: PubKeyHash -> ScriptContext -> ScriptContext
addSigner PubKeyHash
signerPkh =
  (TxInfo -> Identity TxInfo)
-> ScriptContext -> Identity ScriptContext
Lens' ScriptContext TxInfo
scriptContextTxInfoL ((TxInfo -> Identity TxInfo)
 -> ScriptContext -> Identity ScriptContext)
-> (([PubKeyHash] -> Identity [PubKeyHash])
    -> TxInfo -> Identity TxInfo)
-> ([PubKeyHash] -> Identity [PubKeyHash])
-> ScriptContext
-> Identity ScriptContext
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([PubKeyHash] -> Identity [PubKeyHash])
-> TxInfo -> Identity TxInfo
Lens' TxInfo [PubKeyHash]
txInfoSignatoriesL (([PubKeyHash] -> Identity [PubKeyHash])
 -> ScriptContext -> Identity ScriptContext)
-> ([PubKeyHash] -> [PubKeyHash]) -> ScriptContext -> ScriptContext
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (PubKeyHash
signerPkh PubKeyHash -> [PubKeyHash] -> [PubKeyHash]
forall a. a -> [a] -> [a]
:)

-- | Add a signatory and compute a change output for the same public key hash.
signAndAddChangeOutput :: PubKeyHash -> ScriptContext -> ScriptContext
signAndAddChangeOutput :: PubKeyHash -> ScriptContext -> ScriptContext
signAndAddChangeOutput PubKeyHash
signerPkh ScriptContext
ctx =
  PubKeyHash -> ScriptContext -> ScriptContext
addSigner PubKeyHash
signerPkh (PubKeyHash -> ScriptContext -> ScriptContext
addChangeOutput PubKeyHash
signerPkh ScriptContext
ctx)

-- | A composable builder for constructing a 'ScriptContext'.
newtype ScriptContextBuilder = ScriptContextBuilder
  { ScriptContextBuilder
-> ScriptContextBuilderState -> ScriptContextBuilderState
runBuilder :: ScriptContextBuilderState -> ScriptContextBuilderState
  }

-- | Accumulated state for 'ScriptContextBuilder'.
data ScriptContextBuilderState = ScriptContextBuilderState
  { ScriptContextBuilderState -> [TxInInfo]
scbInputs :: [TxInInfo]
  , ScriptContextBuilderState -> [TxInInfo]
scbReferenceInputs :: [TxInInfo]
  , ScriptContextBuilderState -> [TxOut]
scbOutputs :: [TxOut]
  , ScriptContextBuilderState -> Integer
scbFee :: Integer
  , ScriptContextBuilderState -> Value
scbMint :: Value
  , ScriptContextBuilderState -> [TxCert]
scbCerts :: [TxCert]
  , ScriptContextBuilderState -> Map Credential Lovelace
scbWdrl :: Map.Map Credential Lovelace
  , ScriptContextBuilderState -> POSIXTimeRange
scbValidRange :: POSIXTimeRange
  , ScriptContextBuilderState -> [PubKeyHash]
scbSignatories :: [PubKeyHash]
  , ScriptContextBuilderState -> Map ScriptPurpose Redeemer
scbRedeemers :: Map.Map ScriptPurpose Redeemer
  , ScriptContextBuilderState -> TxId
scbTxId :: TxId
  , ScriptContextBuilderState -> ScriptInfo
scbScriptInfo :: ScriptInfo
  , ScriptContextBuilderState -> BuiltinData
scbRedeemer :: BuiltinData
  }

defaultScriptContextBuilderState :: ScriptContextBuilderState
defaultScriptContextBuilderState :: ScriptContextBuilderState
defaultScriptContextBuilderState =
  ScriptContextBuilderState
    { scbInputs :: [TxInInfo]
scbInputs = []
    , scbReferenceInputs :: [TxInInfo]
scbReferenceInputs = []
    , scbOutputs :: [TxOut]
scbOutputs = []
    , scbFee :: Integer
scbFee = Integer
0
    , scbMint :: Value
scbMint = Value
forall a. Monoid a => a
mempty
    , scbCerts :: [TxCert]
scbCerts = []
    , scbWdrl :: Map Credential Lovelace
scbWdrl = Map Credential Lovelace
forall k v. Map k v
Map.empty
    , scbValidRange :: POSIXTimeRange
scbValidRange = POSIXTimeRange
forall a. Interval a
always
    , scbRedeemers :: Map ScriptPurpose Redeemer
scbRedeemers = Map ScriptPurpose Redeemer
forall k v. Map k v
Map.empty
    , scbSignatories :: [PubKeyHash]
scbSignatories = []
    , scbTxId :: TxId
scbTxId = BuiltinByteString -> TxId
TxId BuiltinByteString
"deadbeef"
    , scbScriptInfo :: ScriptInfo
scbScriptInfo = CurrencySymbol -> ScriptInfo
MintingScript (CurrencySymbol -> ScriptInfo) -> CurrencySymbol -> ScriptInfo
forall a b. (a -> b) -> a -> b
$ [Char] -> CurrencySymbol
currencySymbolFromHex [Char]
"deadbeef"
    , scbRedeemer :: BuiltinData
scbRedeemer = () -> BuiltinData
forall a. ToData a => a -> BuiltinData
PlutusTx.toBuiltinData ()
    }

instance Semigroup ScriptContextBuilder where
  (ScriptContextBuilder ScriptContextBuilderState -> ScriptContextBuilderState
f) <> :: ScriptContextBuilder
-> ScriptContextBuilder -> ScriptContextBuilder
<> (ScriptContextBuilder ScriptContextBuilderState -> ScriptContextBuilderState
g) = (ScriptContextBuilderState -> ScriptContextBuilderState)
-> ScriptContextBuilder
ScriptContextBuilder (ScriptContextBuilderState -> ScriptContextBuilderState
g (ScriptContextBuilderState -> ScriptContextBuilderState)
-> (ScriptContextBuilderState -> ScriptContextBuilderState)
-> ScriptContextBuilderState
-> ScriptContextBuilderState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ScriptContextBuilderState -> ScriptContextBuilderState
f)

instance Monoid ScriptContextBuilder where
  mempty :: ScriptContextBuilder
mempty = (ScriptContextBuilderState -> ScriptContextBuilderState)
-> ScriptContextBuilder
ScriptContextBuilder ScriptContextBuilderState -> ScriptContextBuilderState
forall a. a -> a
id

-- | Set the transaction fee.
withFee :: Integer -> ScriptContextBuilder
withFee :: Integer -> ScriptContextBuilder
withFee Integer
fee = (ScriptContextBuilderState -> ScriptContextBuilderState)
-> ScriptContextBuilder
ScriptContextBuilder \ScriptContextBuilderState
scb -> ScriptContextBuilderState
scb {scbFee = fee}

-- | Set the transaction validity time range.
withValidRange :: POSIXTimeRange -> ScriptContextBuilder
withValidRange :: POSIXTimeRange -> ScriptContextBuilder
withValidRange POSIXTimeRange
validRange = (ScriptContextBuilderState -> ScriptContextBuilderState)
-> ScriptContextBuilder
ScriptContextBuilder \ScriptContextBuilderState
scb -> ScriptContextBuilderState
scb {scbValidRange = validRange}

-- | Add a signatory to the transaction.
withSigner :: PubKeyHash -> ScriptContextBuilder
withSigner :: PubKeyHash -> ScriptContextBuilder
withSigner PubKeyHash
pkh = (ScriptContextBuilderState -> ScriptContextBuilderState)
-> ScriptContextBuilder
ScriptContextBuilder \ScriptContextBuilderState
scb ->
  ScriptContextBuilderState
scb {scbSignatories = List.insert pkh (scbSignatories scb)}

-- | Add multiple signatories to the transaction.
withSigners :: [PubKeyHash] -> ScriptContextBuilder
withSigners :: [PubKeyHash] -> ScriptContextBuilder
withSigners [PubKeyHash]
pks = (ScriptContextBuilderState -> ScriptContextBuilderState)
-> ScriptContextBuilder
ScriptContextBuilder \ScriptContextBuilderState
scb ->
  ScriptContextBuilderState
scb {scbSignatories = foldr (\PubKeyHash
p [PubKeyHash]
acc -> PubKeyHash -> [PubKeyHash] -> [PubKeyHash]
forall a. Ord a => a -> [a] -> [a]
List.insert PubKeyHash
p [PubKeyHash]
acc) (scbSignatories scb) pks}

-- | Add a minting entry with the given value and redeemer.
withMint :: Value -> BuiltinData -> ScriptContextBuilder
withMint :: Value -> BuiltinData -> ScriptContextBuilder
withMint Value
value BuiltinData
redeemer = (ScriptContextBuilderState -> ScriptContextBuilderState)
-> ScriptContextBuilder
ScriptContextBuilder \ScriptContextBuilderState
scb ->
  let mintCS :: CurrencySymbol
mintCS = Value -> CurrencySymbol
singleCurrencySymbol Value
value
      newRedeemers :: Map ScriptPurpose Redeemer
newRedeemers = ScriptPurpose
-> Redeemer
-> Map ScriptPurpose Redeemer
-> Map ScriptPurpose Redeemer
forall k v. Eq k => k -> v -> Map k v -> Map k v
Map.insert (CurrencySymbol -> ScriptPurpose
Minting CurrencySymbol
mintCS) (BuiltinData -> Redeemer
Redeemer BuiltinData
redeemer) (ScriptContextBuilderState -> Map ScriptPurpose Redeemer
scbRedeemers ScriptContextBuilderState
scb)
   in ScriptContextBuilderState
scb {scbMint = scbMint scb <> value, scbRedeemers = newRedeemers}

-- | Add a transaction output.
withOutput :: TxOutBuilder -> ScriptContextBuilder
withOutput :: TxOutBuilder -> ScriptContextBuilder
withOutput TxOutBuilder
modify = (ScriptContextBuilderState -> ScriptContextBuilderState)
-> ScriptContextBuilder
ScriptContextBuilder \ScriptContextBuilderState
scb ->
  ScriptContextBuilderState
scb {scbOutputs = mkTxOut modify : scbOutputs scb}

-- | Add a public-key input. Errors if the address is a script address.
withInput :: InputBuilder -> ScriptContextBuilder
withInput :: InputBuilder -> ScriptContextBuilder
withInput InputBuilder
inputBuilder = (ScriptContextBuilderState -> ScriptContextBuilderState)
-> ScriptContextBuilder
ScriptContextBuilder \ScriptContextBuilderState
scb ->
  if Maybe PubKeyHash -> Bool
forall a. Maybe a -> Bool
isJust (Address -> Maybe PubKeyHash
toPubKeyHash (TxOut -> Address
txOutAddress (TxInInfo -> TxOut
txInInfoResolved TxInInfo
newInput)))
    then ScriptContextBuilderState
scb {scbInputs = List.insertBy (comparing txInInfoOutRef) newInput (scbInputs scb)}
    else [Char] -> ScriptContextBuilderState
forall a. HasCallStack => [Char] -> a
error [Char]
"withInput: Input address is not a public key address"
  where
    newInput :: TxInInfo
    newInput :: TxInInfo
newInput = InputBuilder -> TxInInfo
mkInput InputBuilder
inputBuilder

-- | Add a script input with a redeemer. Errors if the address is not a script address.
withScriptInput :: BuiltinData -> InputBuilder -> ScriptContextBuilder
withScriptInput :: BuiltinData -> InputBuilder -> ScriptContextBuilder
withScriptInput BuiltinData
redeemer InputBuilder
modify = (ScriptContextBuilderState -> ScriptContextBuilderState)
-> ScriptContextBuilder
ScriptContextBuilder \ScriptContextBuilderState
scb ->
  let newInput :: TxInInfo
newInput = InputBuilder -> TxInInfo
mkInput InputBuilder
modify
      inputOutRef :: TxOutRef
inputOutRef = TxInInfo -> TxOutRef
txInInfoOutRef TxInInfo
newInput
      newRedeemers :: Map ScriptPurpose Redeemer
newRedeemers = ScriptPurpose
-> Redeemer
-> Map ScriptPurpose Redeemer
-> Map ScriptPurpose Redeemer
forall k v. Eq k => k -> v -> Map k v -> Map k v
Map.insert (TxOutRef -> ScriptPurpose
Spending TxOutRef
inputOutRef) (BuiltinData -> Redeemer
Redeemer BuiltinData
redeemer) (ScriptContextBuilderState -> Map ScriptPurpose Redeemer
scbRedeemers ScriptContextBuilderState
scb)
   in if Maybe ScriptHash -> Bool
forall a. Maybe a -> Bool
isJust (Address -> Maybe ScriptHash
toScriptHash (TxOut -> Address
txOutAddress (TxOut -> Address) -> TxOut -> Address
forall a b. (a -> b) -> a -> b
$ TxInInfo -> TxOut
txInInfoResolved TxInInfo
newInput))
        then
          ScriptContextBuilderState
scb
            { scbInputs = List.insertBy (comparing txInInfoOutRef) newInput (scbInputs scb)
            , scbRedeemers = newRedeemers
            }
        else [Char] -> ScriptContextBuilderState
forall a. HasCallStack => [Char] -> a
error [Char]
"withScriptInput: Input address is not a script address"

-- | Add a reference input (read-only, not spent).
withReferenceInput :: InputBuilder -> ScriptContextBuilder
withReferenceInput :: InputBuilder -> ScriptContextBuilder
withReferenceInput InputBuilder
inputBuilder = (ScriptContextBuilderState -> ScriptContextBuilderState)
-> ScriptContextBuilder
ScriptContextBuilder \ScriptContextBuilderState
scb ->
  ScriptContextBuilderState
scb
    { scbReferenceInputs =
        List.insertBy
          (comparing txInInfoOutRef)
          (mkInput inputBuilder)
          (scbReferenceInputs scb)
    }

-- | Set the script purpose to minting and add a mint entry.
withMintingScript :: Value -> BuiltinData -> ScriptContextBuilder
withMintingScript :: Value -> BuiltinData -> ScriptContextBuilder
withMintingScript Value
mintValue BuiltinData
redeemer =
  Value -> BuiltinData -> ScriptContextBuilder
withMint Value
mintValue BuiltinData
redeemer ScriptContextBuilder
-> ScriptContextBuilder -> ScriptContextBuilder
forall a. Semigroup a => a -> a -> a
<> (ScriptContextBuilderState -> ScriptContextBuilderState)
-> ScriptContextBuilder
ScriptContextBuilder \ScriptContextBuilderState
scb ->
    ScriptContextBuilderState
scb {scbScriptInfo = MintingScript (singleCurrencySymbol mintValue)}

-- | Set the script purpose to spending and add the script input.
withSpendingScript :: BuiltinData -> InputBuilder -> ScriptContextBuilder
withSpendingScript :: BuiltinData -> InputBuilder -> ScriptContextBuilder
withSpendingScript BuiltinData
redeemer InputBuilder
modify = (ScriptContextBuilderState -> ScriptContextBuilderState)
-> ScriptContextBuilder
ScriptContextBuilder \ScriptContextBuilderState
scb ->
  let scriptInput :: TxInInfo
scriptInput = InputBuilder -> TxInInfo
mkInput InputBuilder
modify
      outRef :: TxOutRef
outRef = TxInInfo -> TxOutRef
txInInfoOutRef TxInInfo
scriptInput
      newRedeemers :: Map ScriptPurpose Redeemer
newRedeemers = ScriptPurpose
-> Redeemer
-> Map ScriptPurpose Redeemer
-> Map ScriptPurpose Redeemer
forall k v. Eq k => k -> v -> Map k v -> Map k v
Map.insert (TxOutRef -> ScriptPurpose
Spending TxOutRef
outRef) (BuiltinData -> Redeemer
Redeemer BuiltinData
redeemer) (ScriptContextBuilderState -> Map ScriptPurpose Redeemer
scbRedeemers ScriptContextBuilderState
scb)
      datum :: Maybe Datum
datum =
        case TxOut -> OutputDatum
txOutDatum (TxInInfo -> TxOut
txInInfoResolved TxInInfo
scriptInput) of
          OutputDatum
NoOutputDatum -> Maybe Datum
forall a. Maybe a
Nothing
          OutputDatum (Datum BuiltinData
dat) -> Datum -> Maybe Datum
forall a. a -> Maybe a
Just (BuiltinData -> Datum
Datum BuiltinData
dat)
          OutputDatumHash {} -> Maybe Datum
forall a. Maybe a
Nothing
   in ScriptContextBuilderState
scb
        { scbScriptInfo = SpendingScript outRef datum
        , scbInputs = List.insertBy (comparing txInInfoOutRef) scriptInput (scbInputs scb)
        , scbRedeemers = newRedeemers
        , scbRedeemer = redeemer
        }

-- | Set the script purpose to rewarding with a fixed redeemer.
withRewardingScript :: BuiltinData -> Credential -> Integer -> ScriptContextBuilder
withRewardingScript :: BuiltinData -> Credential -> Integer -> ScriptContextBuilder
withRewardingScript BuiltinData
redeemer Credential
cred Integer
adaAmount =
  (ScriptContextBuilderState -> ScriptContextBuilderState)
-> ScriptContextBuilder
ScriptContextBuilder \ScriptContextBuilderState
scb ->
    ScriptContextBuilderState
scb
      { scbWdrl = Map.insert cred (fromIntegral adaAmount) (scbWdrl scb)
      , scbRedeemers = Map.insert (Rewarding cred) (Redeemer redeemer) (scbRedeemers scb)
      , scbRedeemer = redeemer
      , scbScriptInfo = RewardingScript cred
      }

-- | Set the script purpose to rewarding with a redeemer computed from the builder state.
withRewardingScriptWithBuilder
  :: (ScriptContextBuilderState -> BuiltinData)
  -> Credential
  -> Integer
  -> ScriptContextBuilder
withRewardingScriptWithBuilder :: (ScriptContextBuilderState -> BuiltinData)
-> Credential -> Integer -> ScriptContextBuilder
withRewardingScriptWithBuilder ScriptContextBuilderState -> BuiltinData
mkRedeemer Credential
cred Integer
adaAmount =
  (ScriptContextBuilderState -> ScriptContextBuilderState)
-> ScriptContextBuilder
ScriptContextBuilder \ScriptContextBuilderState
scb ->
    let redeemer :: BuiltinData
redeemer = ScriptContextBuilderState -> BuiltinData
mkRedeemer ScriptContextBuilderState
scb
     in ScriptContextBuilderState
scb
          { scbWdrl = Map.insert cred (fromIntegral adaAmount) (scbWdrl scb)
          , scbRedeemers = Map.insert (Rewarding cred) (Redeemer redeemer) (scbRedeemers scb)
          , scbRedeemer = redeemer
          , scbScriptInfo = RewardingScript cred
          }

-- | Add a withdrawal entry for a credential and ADA amount.
withWithdrawal :: Credential -> Integer -> ScriptContextBuilder
withWithdrawal :: Credential -> Integer -> ScriptContextBuilder
withWithdrawal Credential
cred Integer
adaAmount = (ScriptContextBuilderState -> ScriptContextBuilderState)
-> ScriptContextBuilder
ScriptContextBuilder \ScriptContextBuilderState
scb ->
  ScriptContextBuilderState
scb {scbWdrl = Map.insert cred (fromIntegral adaAmount) (scbWdrl scb)}

-- | Set the top-level redeemer for the script context.
withRedeemer :: BuiltinData -> ScriptContextBuilder
withRedeemer :: BuiltinData -> ScriptContextBuilder
withRedeemer BuiltinData
redeemer = (ScriptContextBuilderState -> ScriptContextBuilderState)
-> ScriptContextBuilder
ScriptContextBuilder \ScriptContextBuilderState
scb -> ScriptContextBuilderState
scb {scbRedeemer = redeemer}

-- | Build a 'ScriptContext' from a 'ScriptContextBuilder'.
buildScriptContext :: ScriptContextBuilder -> ScriptContext
buildScriptContext :: ScriptContextBuilder -> ScriptContext
buildScriptContext ScriptContextBuilder
modify =
  ScriptContext
    { scriptContextTxInfo :: TxInfo
scriptContextTxInfo =
        TxInfo
          { txInfoInputs :: [TxInInfo]
txInfoInputs = [TxInInfo] -> [TxInInfo]
forall a. [a] -> [a]
reverse ([TxInInfo] -> [TxInInfo]) -> [TxInInfo] -> [TxInInfo]
forall a b. (a -> b) -> a -> b
$ ScriptContextBuilderState -> [TxInInfo]
scbInputs ScriptContextBuilderState
finalState
          , txInfoReferenceInputs :: [TxInInfo]
txInfoReferenceInputs = [TxInInfo] -> [TxInInfo]
forall a. [a] -> [a]
reverse ([TxInInfo] -> [TxInInfo]) -> [TxInInfo] -> [TxInInfo]
forall a b. (a -> b) -> a -> b
$ ScriptContextBuilderState -> [TxInInfo]
scbReferenceInputs ScriptContextBuilderState
finalState
          , txInfoOutputs :: [TxOut]
txInfoOutputs = [TxOut] -> [TxOut]
forall a. [a] -> [a]
reverse ([TxOut] -> [TxOut]) -> [TxOut] -> [TxOut]
forall a b. (a -> b) -> a -> b
$ ScriptContextBuilderState -> [TxOut]
scbOutputs ScriptContextBuilderState
finalState
          , txInfoMint :: MintValue
txInfoMint = Map CurrencySymbol (Map TokenName Integer) -> MintValue
UnsafeMintValue (Map CurrencySymbol (Map TokenName Integer) -> MintValue)
-> Map CurrencySymbol (Map TokenName Integer) -> MintValue
forall a b. (a -> b) -> a -> b
$ Value -> Map CurrencySymbol (Map TokenName Integer)
getValue (ScriptContextBuilderState -> Value
scbMint ScriptContextBuilderState
finalState)
          , txInfoRedeemers :: Map ScriptPurpose Redeemer
txInfoRedeemers = ScriptContextBuilderState -> Map ScriptPurpose Redeemer
scbRedeemers ScriptContextBuilderState
finalState
          , txInfoFee :: Lovelace
txInfoFee = Integer -> Lovelace
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ScriptContextBuilderState -> Integer
scbFee ScriptContextBuilderState
finalState)
          , txInfoSignatories :: [PubKeyHash]
txInfoSignatories = ScriptContextBuilderState -> [PubKeyHash]
scbSignatories ScriptContextBuilderState
finalState
          , txInfoTxCerts :: [TxCert]
txInfoTxCerts = ScriptContextBuilderState -> [TxCert]
scbCerts ScriptContextBuilderState
finalState
          , txInfoWdrl :: Map Credential Lovelace
txInfoWdrl = ScriptContextBuilderState -> Map Credential Lovelace
scbWdrl ScriptContextBuilderState
finalState
          , txInfoValidRange :: POSIXTimeRange
txInfoValidRange = ScriptContextBuilderState -> POSIXTimeRange
scbValidRange ScriptContextBuilderState
finalState
          , txInfoData :: Map DatumHash Datum
txInfoData = Map DatumHash Datum
forall k v. Map k v
Map.empty
          , txInfoId :: TxId
txInfoId = ScriptContextBuilderState -> TxId
scbTxId ScriptContextBuilderState
finalState
          , txInfoVotes :: Map Voter (Map GovernanceActionId Vote)
txInfoVotes = Map Voter (Map GovernanceActionId Vote)
forall k v. Map k v
Map.empty
          , txInfoProposalProcedures :: [ProposalProcedure]
txInfoProposalProcedures = []
          , txInfoCurrentTreasuryAmount :: Maybe Lovelace
txInfoCurrentTreasuryAmount = Maybe Lovelace
forall a. Maybe a
Nothing
          , txInfoTreasuryDonation :: Maybe Lovelace
txInfoTreasuryDonation = Maybe Lovelace
forall a. Maybe a
Nothing
          }
    , scriptContextRedeemer :: Redeemer
scriptContextRedeemer = BuiltinData -> Redeemer
Redeemer (BuiltinData -> Redeemer) -> BuiltinData -> Redeemer
forall a b. (a -> b) -> a -> b
$ ScriptContextBuilderState -> BuiltinData
scbRedeemer ScriptContextBuilderState
finalState
    , scriptContextScriptInfo :: ScriptInfo
scriptContextScriptInfo = ScriptContextBuilderState -> ScriptInfo
scbScriptInfo ScriptContextBuilderState
finalState
    }
  where
    finalState :: ScriptContextBuilderState
finalState = ScriptContextBuilder
-> ScriptContextBuilderState -> ScriptContextBuilderState
runBuilder ScriptContextBuilder
modify ScriptContextBuilderState
defaultScriptContextBuilderState

comparePurposeLedger :: ScriptPurpose -> ScriptPurpose -> Ordering
comparePurposeLedger :: ScriptPurpose -> ScriptPurpose -> Ordering
comparePurposeLedger = (ScriptPurpose -> Word)
-> ScriptPurpose -> ScriptPurpose -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing \case
  Spending {} -> Word
0 :: Word
  Minting {} -> Word
1
  Certifying {} -> Word
2
  Rewarding {} -> Word
3
  Voting {} -> Word
4
  Proposing {} -> Word
5

-- | Build a 'ScriptContext' and automatically balance it with a change output.
buildBalancedScriptContext :: ScriptContextBuilder -> ScriptContext
buildBalancedScriptContext :: ScriptContextBuilder -> ScriptContext
buildBalancedScriptContext ScriptContextBuilder
modify =
  ScriptContext -> ScriptContext
balanceWithChangeOutput
    ScriptContext
      { scriptContextTxInfo :: TxInfo
scriptContextTxInfo =
          TxInfo
            { txInfoInputs :: [TxInInfo]
txInfoInputs = ScriptContextBuilderState -> [TxInInfo]
scbInputs ScriptContextBuilderState
finalState
            , txInfoReferenceInputs :: [TxInInfo]
txInfoReferenceInputs = ScriptContextBuilderState -> [TxInInfo]
scbReferenceInputs ScriptContextBuilderState
finalState
            , txInfoOutputs :: [TxOut]
txInfoOutputs = ScriptContextBuilderState -> [TxOut]
scbOutputs ScriptContextBuilderState
finalState
            , txInfoMint :: MintValue
txInfoMint = Map CurrencySymbol (Map TokenName Integer) -> MintValue
UnsafeMintValue (Value -> Map CurrencySymbol (Map TokenName Integer)
getValue (ScriptContextBuilderState -> Value
scbMint ScriptContextBuilderState
finalState))
            , txInfoRedeemers :: Map ScriptPurpose Redeemer
txInfoRedeemers =
                [(ScriptPurpose, Redeemer)] -> Map ScriptPurpose Redeemer
forall k v. [(k, v)] -> Map k v
Map.unsafeFromList ([(ScriptPurpose, Redeemer)] -> Map ScriptPurpose Redeemer)
-> [(ScriptPurpose, Redeemer)] -> Map ScriptPurpose Redeemer
forall a b. (a -> b) -> a -> b
$
                  ((ScriptPurpose, Redeemer)
 -> (ScriptPurpose, Redeemer) -> Ordering)
-> [(ScriptPurpose, Redeemer)] -> [(ScriptPurpose, Redeemer)]
forall a. (a -> a -> Ordering) -> [a] -> [a]
List.sortBy (ScriptPurpose -> ScriptPurpose -> Ordering
comparePurposeLedger (ScriptPurpose -> ScriptPurpose -> Ordering)
-> ((ScriptPurpose, Redeemer) -> ScriptPurpose)
-> (ScriptPurpose, Redeemer)
-> (ScriptPurpose, Redeemer)
-> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` (ScriptPurpose, Redeemer) -> ScriptPurpose
forall a b. (a, b) -> a
fst) ([(ScriptPurpose, Redeemer)] -> [(ScriptPurpose, Redeemer)])
-> [(ScriptPurpose, Redeemer)] -> [(ScriptPurpose, Redeemer)]
forall a b. (a -> b) -> a -> b
$
                    Map ScriptPurpose Redeemer -> [(ScriptPurpose, Redeemer)]
forall k v. Map k v -> [(k, v)]
Map.toList (Map ScriptPurpose Redeemer -> [(ScriptPurpose, Redeemer)])
-> Map ScriptPurpose Redeemer -> [(ScriptPurpose, Redeemer)]
forall a b. (a -> b) -> a -> b
$
                      ScriptContextBuilderState -> Map ScriptPurpose Redeemer
scbRedeemers ScriptContextBuilderState
finalState
            , txInfoFee :: Lovelace
txInfoFee = Integer -> Lovelace
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ScriptContextBuilderState -> Integer
scbFee ScriptContextBuilderState
finalState)
            , txInfoSignatories :: [PubKeyHash]
txInfoSignatories = ScriptContextBuilderState -> [PubKeyHash]
scbSignatories ScriptContextBuilderState
finalState
            , txInfoTxCerts :: [TxCert]
txInfoTxCerts = ScriptContextBuilderState -> [TxCert]
scbCerts ScriptContextBuilderState
finalState
            , txInfoWdrl :: Map Credential Lovelace
txInfoWdrl = ScriptContextBuilderState -> Map Credential Lovelace
scbWdrl ScriptContextBuilderState
finalState
            , txInfoValidRange :: POSIXTimeRange
txInfoValidRange = ScriptContextBuilderState -> POSIXTimeRange
scbValidRange ScriptContextBuilderState
finalState
            , txInfoData :: Map DatumHash Datum
txInfoData = Map DatumHash Datum
forall k v. Map k v
Map.empty
            , txInfoId :: TxId
txInfoId = ScriptContextBuilderState -> TxId
scbTxId ScriptContextBuilderState
finalState
            , txInfoVotes :: Map Voter (Map GovernanceActionId Vote)
txInfoVotes = Map Voter (Map GovernanceActionId Vote)
forall k v. Map k v
Map.empty
            , txInfoProposalProcedures :: [ProposalProcedure]
txInfoProposalProcedures = []
            , txInfoCurrentTreasuryAmount :: Maybe Lovelace
txInfoCurrentTreasuryAmount = Maybe Lovelace
forall a. Maybe a
Nothing
            , txInfoTreasuryDonation :: Maybe Lovelace
txInfoTreasuryDonation = Maybe Lovelace
forall a. Maybe a
Nothing
            }
      , scriptContextRedeemer :: Redeemer
scriptContextRedeemer = BuiltinData -> Redeemer
Redeemer (ScriptContextBuilderState -> BuiltinData
scbRedeemer ScriptContextBuilderState
finalState)
      , scriptContextScriptInfo :: ScriptInfo
scriptContextScriptInfo = ScriptContextBuilderState -> ScriptInfo
scbScriptInfo ScriptContextBuilderState
finalState
      }
  where
    finalState :: ScriptContextBuilderState
finalState = ScriptContextBuilder
-> ScriptContextBuilderState -> ScriptContextBuilderState
runBuilder ScriptContextBuilder
modify ScriptContextBuilderState
defaultScriptContextBuilderState

-- * Helpers

-- | Convert a hex encoded Haskell 'String' to a 'CurrencySymbol'.
currencySymbolFromHex :: String -> CurrencySymbol
currencySymbolFromHex :: [Char] -> CurrencySymbol
currencySymbolFromHex [Char]
hexStr =
  case ByteString -> Either [Char] ByteString
Base16.decode ([Char] -> ByteString
BS8.pack [Char]
hexStr) of
    Left [Char]
err -> [Char] -> CurrencySymbol
forall a. HasCallStack => [Char] -> a
error ([Char] -> CurrencySymbol) -> [Char] -> CurrencySymbol
forall a b. (a -> b) -> a -> b
$ [Char]
"currencySymbolFromHex: invalid hex: " [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
err
    Right ByteString
bs -> BuiltinByteString -> CurrencySymbol
CurrencySymbol (ByteString -> BuiltinByteString
BuiltinByteString ByteString
bs)

{-| Extract the single currency symbol from a 'Value'. Errors if the value
contains zero or more than one currency symbol. -}
singleCurrencySymbol :: Value -> CurrencySymbol
singleCurrencySymbol :: Value -> CurrencySymbol
singleCurrencySymbol Value
val = case Map CurrencySymbol (Map TokenName Integer) -> [CurrencySymbol]
forall k v. Map k v -> [k]
Map.keys (Value -> Map CurrencySymbol (Map TokenName Integer)
getValue Value
val) of
  [CurrencySymbol
cs] -> CurrencySymbol
cs
  [CurrencySymbol]
keys ->
    [Char] -> CurrencySymbol
forall a. HasCallStack => [Char] -> a
error ([Char] -> CurrencySymbol) -> [Char] -> CurrencySymbol
forall a b. (a -> b) -> a -> b
$
      [Char]
"singleCurrencySymbol: expected exactly 1 currency symbol, got "
        [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> Int -> [Char]
forall a. Show a => a -> [Char]
show ([CurrencySymbol] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [CurrencySymbol]
keys)