{-# LANGUAGE NumericUnderscores #-}

{- |
Module      : Singular.Registry.TxBuilder.Retract
Description : Retract request transaction
License     : Apache-2.0

Builds the retract transaction that cancels a
pending request. The requester spends their request
UTxO (recovering locked ADA) while referencing the
State UTxO. Validity interval is Phase 2.
-}
module Singular.Registry.TxBuilder.Retract
    ( retractRequestImpl
    , retractRequestAtTipImpl
    ) where

import Control.Monad (when)
import Data.List (nub)
import Data.Map.Strict qualified as Map
import Data.Sequence.Strict qualified as StrictSeq
import Data.Set qualified as Set
import Lens.Micro ((&), (.~), (^.))

import Cardano.Ledger.Address (Addr)
import Cardano.Ledger.Allegra.Scripts
    ( ValidityInterval (..)
    )
import Cardano.Ledger.Alonzo.Scripts (AsIx (..))
import Cardano.Ledger.Alonzo.TxBody
    ( reqSignerHashesTxBodyL
    , scriptIntegrityHashTxBodyL
    )
import Cardano.Ledger.Api.Tx
    ( mkBasicTx
    , witsTxL
    )
import Cardano.Ledger.Api.Tx.Body
    ( collateralInputsTxBodyL
    , inputsTxBodyL
    , mkBasicTxBody
    , outputsTxBodyL
    , referenceInputsTxBodyL
    , vldtTxBodyL
    )
import Cardano.Ledger.Api.Tx.Out
    ( coinTxOutL
    , datumTxOutL
    , getMinCoinTxOut
    )
import Cardano.Ledger.Api.Tx.Wits
    ( Redeemers (..)
    , rdmrsTxWitsL
    , scriptTxWitsL
    )
import Cardano.Ledger.BaseTypes
    ( SlotNo (..)
    , StrictMaybe (SJust)
    )
import Cardano.Ledger.Conway.Scripts
    ( ConwayPlutusPurpose (..)
    )
import Cardano.Ledger.Core (hashScript)
import Cardano.Ledger.TxIn (TxIn)

import Cardano.Tx.Ledger (ConwayTx)
import PlutusTx.Builtins.Internal
    ( BuiltinByteString (..)
    )
import Singular.Registry.Config
    ( CageConfig (..)
    )
import Singular.Registry.Evidence (NoWitness)
import Singular.Registry.Ledger
    ( ConwayTxBody
    , TokenId
    )
import Singular.Registry.LedgerProvider
    ( Session (..)
    , TipObservation (..)
    )
import Singular.Registry.SessionIO (outputsAt, parameters)
import Singular.Registry.SessionIO qualified as Services
import Singular.Registry.TxBuilder.Edges (selectFunding)
import Singular.Registry.TxBuilder.Internal
import Singular.Registry.Types
    ( CageDatum (..)
    , OnChainRequest (..)
    , OnChainTokenState (..)
    , UpdateRedeemer (..)
    )

{- | Build a retract-request transaction.

The requester spends their request UTxO while referencing the
state UTxO. All its lovelace is paid to the request owner's key,
with the consumed request reference as the return's inline datum.
Wallet funding pays fees separately. Requires Phase 2 validity.
-}
retractRequestImpl
    :: CageConfig
    -> Session NoWitness IO
    -> TokenId
    -- ^ Token the request belongs to
    -> TxIn
    -- ^ UTxO reference of the request to retract
    -> Addr
    -- ^ Fee payer and change address
    -> IO ConwayTx
retractRequestImpl :: CageConfig
-> Session NoWitness IO -> TokenId -> TxIn -> Addr -> IO ConwayTx
retractRequestImpl = SlotNo
-> CageConfig
-> Session NoWitness IO
-> TokenId
-> TxIn
-> Addr
-> IO ConwayTx
retractRequestAtTipImpl (Word64 -> SlotNo
SlotNo Word64
0)

{- | Use the caller's tip as the lower validity bound, while staying
inside phase 2. Refuse @lower-bound-ahead-of-view@ if that bound or the
phase-two opening is later than the acquired view's own tip.
-}
retractRequestAtTipImpl
    :: SlotNo
    -> CageConfig
    -> Session NoWitness IO
    -> TokenId
    -> TxIn
    -> Addr
    -> IO ConwayTx
retractRequestAtTipImpl :: SlotNo
-> CageConfig
-> Session NoWitness IO
-> TokenId
-> TxIn
-> Addr
-> IO ConwayTx
retractRequestAtTipImpl SlotNo
tip CageConfig
cfg Session NoWitness IO
view TokenId
tid TxIn
reqTxIn Addr
addr = do
    let reqAddr :: Addr
reqAddr =
            CageConfig -> TokenId -> Network -> Addr
requestAddrFromCfg CageConfig
cfg TokenId
tid (CageConfig -> Network
network CageConfig
cfg)
        stateAddr :: Addr
stateAddr =
            CageConfig -> Network -> Addr
cageAddrFromCfg CageConfig
cfg (CageConfig -> Network
network CageConfig
cfg)
    requestUtxos <- Session NoWitness IO -> Addr -> IO Outputs
forall w. Session w IO -> Addr -> IO Outputs
outputsAt Session NoWitness IO
view Addr
reqAddr
    stateUtxos <- outputsAt view stateAddr
    let reqUtxo =
            TxIn -> Outputs -> Maybe (TxIn, TxOut ConwayEra)
findUtxoByTxIn TxIn
reqTxIn Outputs
[(TxIn, BabbageTxOut ConwayEra)]
requestUtxos
    reqUtxoPair <- case reqUtxo of
        Maybe (TxIn, BabbageTxOut ConwayEra)
Nothing ->
            [Char] -> IO (TxIn, BabbageTxOut ConwayEra)
forall a. HasCallStack => [Char] -> a
error
                [Char]
"retractRequest: request UTxO \
                \not found on chain"
        Just (TxIn, BabbageTxOut ConwayEra)
x -> (TxIn, BabbageTxOut ConwayEra) -> IO (TxIn, BabbageTxOut ConwayEra)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TxIn, BabbageTxOut ConwayEra)
x
    let (reqIn, reqOut) = reqUtxoPair
    let policyId = CageConfig -> PolicyID
cagePolicyIdFromCfg CageConfig
cfg
    stateUtxo <-
        case findStateUtxo
            policyId
            tid
            stateUtxos of
            Maybe (TxIn, TxOut ConwayEra)
Nothing ->
                [Char] -> IO (TxIn, BabbageTxOut ConwayEra)
forall a. HasCallStack => [Char] -> a
error
                    [Char]
"retractRequest: state UTxO \
                    \not found"
            Just (TxIn, TxOut ConwayEra)
x -> (TxIn, BabbageTxOut ConwayEra) -> IO (TxIn, BabbageTxOut ConwayEra)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TxIn, TxOut ConwayEra)
(TxIn, BabbageTxOut ConwayEra)
x
    let (stateIn, stateOut) = stateUtxo
    pp <- parameters view
    walletUtxos <- outputsAt view addr
    -- The funding output is also the collateral, so it must hold ada and
    -- nothing else, and must not be a published reference script.
    feeUtxo <- case selectFunding Nothing walletUtxos of
        Left [Char]
why -> [Char] -> IO (TxIn, BabbageTxOut ConwayEra)
forall a. HasCallStack => [Char] -> a
error ([Char]
"retractRequest: " [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
why)
        Right (TxIn, TxOut ConwayEra)
u -> (TxIn, BabbageTxOut ConwayEra) -> IO (TxIn, BabbageTxOut ConwayEra)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TxIn, TxOut ConwayEra)
(TxIn, BabbageTxOut ConwayEra)
u
    let reqDatum = case TxOut ConwayEra -> Maybe CageDatum
extractCageDatum TxOut ConwayEra
BabbageTxOut ConwayEra
reqOut of
            Just (RequestDatum OnChainRequest
r) -> OnChainRequest
r
            Maybe CageDatum
_ ->
                [Char] -> OnChainRequest
forall a. HasCallStack => [Char] -> a
error
                    [Char]
"retractRequest: invalid \
                    \request datum"
        OnChainRequest
            { requestOwner =
                BuiltinByteString ownerBs
            , requestSubmittedAt = submAt
            } = reqDatum
        ownerKh = ByteString -> KeyHash Guard
addrWitnessKeyHash ByteString
ownerBs
    let stateDatum =
            case TxOut ConwayEra -> Maybe CageDatum
extractCageDatum TxOut ConwayEra
BabbageTxOut ConwayEra
stateOut of
                Just (StateDatum OnChainTokenState
s) -> OnChainTokenState
s
                Maybe CageDatum
_ ->
                    [Char] -> OnChainTokenState
forall a. HasCallStack => [Char] -> a
error
                        [Char]
"retractRequest: invalid \
                        \state datum"
        OnChainTokenState
            { stateProcessTime = procTime
            , stateRetractTime = retrTime
            } = stateDatum
    let phase2Start = Integer
submAt Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
procTime
        phase2End = Integer
submAt Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
procTime Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
retrTime
    phase2Slot <-
        Services.ceilingSlot view phase2Start
    let lowerSlot = SlotNo -> SlotNo -> SlotNo
forall a. Ord a => a -> a -> a
max SlotNo
tip SlotNo
phase2Slot
    observed <- Services.tip view
    when (lowerSlot > observedSlot observed) $
        fail "retractRequest: lower-bound-ahead-of-view"
    _ <- Services.slotStart view lowerSlot
    -- The window's end may lie past what the node can translate to a slot
    -- (its horizon). A validity upper bound anywhere inside the window is as
    -- correct as its end, so a nearer bound stands in: the window's end first,
    -- then thirty, ten and three seconds from now, never past the end.
    nowMs <- currentPosixMs
    SlotNo s <-
        tryUpperSlots
            view
            ( nub
                [ phase2End
                , min phase2End (nowMs + 30_000)
                , min phase2End (nowMs + 10_000)
                , min phase2End (nowMs + 3_000)
                ]
            )
    upperSlot <-
        Services.validityUpper
            view
            (observedSlot observed)
            (Just lowerSlot)
            (SlotNo (max 0 (s - 1)))
    let script = CageConfig -> TokenId -> Script ConwayEra
mkRequestScript CageConfig
cfg TokenId
tid
        scriptHash = Script ConwayEra -> ScriptHash
forall era. EraScript era => Script era -> ScriptHash
hashScript AlonzoScript ConwayEra
Script ConwayEra
script
        allInputs =
            [TxIn] -> Set TxIn
forall a. Ord a => [a] -> Set a
Set.fromList [TxIn
reqIn, (TxIn, BabbageTxOut ConwayEra) -> TxIn
forall a b. (a, b) -> a
fst (TxIn, BabbageTxOut ConwayEra)
feeUtxo]
        reqIx = TxIn -> Set TxIn -> Word32
spendingIndex TxIn
reqIn Set TxIn
allInputs
        stateRef = TxIn -> OnChainTxOutRef
txInToRef TxIn
stateIn
        redeemer = OnChainTxOutRef -> UpdateRedeemer
Retract OnChainTxOutRef
stateRef
        spendPurpose =
            AsIx Word32 TxIn -> ConwayPlutusPurpose AsIx era
forall (f :: * -> * -> *) era.
f Word32 TxIn -> ConwayPlutusPurpose f era
ConwaySpending (Word32 -> AsIx Word32 TxIn
forall ix it. ix -> AsIx ix it
AsIx Word32
reqIx)
        redeemers =
            Map (PlutusPurpose AsIx ConwayEra) (Data ConwayEra, ExUnits)
-> Redeemers ConwayEra
forall era.
AlonzoEraScript era =>
Map (PlutusPurpose AsIx era) (Data era, ExUnits) -> Redeemers era
Redeemers (Map (PlutusPurpose AsIx ConwayEra) (Data ConwayEra, ExUnits)
 -> Redeemers ConwayEra)
-> Map (PlutusPurpose AsIx ConwayEra) (Data ConwayEra, ExUnits)
-> Redeemers ConwayEra
forall a b. (a -> b) -> a -> b
$
                PlutusPurpose AsIx ConwayEra
-> (Data ConwayEra, ExUnits)
-> Map (PlutusPurpose AsIx ConwayEra) (Data ConwayEra, ExUnits)
forall k a. k -> a -> Map k a
Map.singleton
                    PlutusPurpose AsIx ConwayEra
ConwayPlutusPurpose AsIx ConwayEra
forall {era}. ConwayPlutusPurpose AsIx era
spendPurpose
                    ( UpdateRedeemer -> Data ConwayEra
forall a. ToData a => a -> Data ConwayEra
toLedgerData UpdateRedeemer
redeemer
                    , ExUnits
placeholderExUnits
                    )
        integrity =
            PParams ConwayEra
-> Redeemers ConwayEra -> StrictMaybe ScriptIntegrityHash
computeScriptIntegrity PParams ConwayEra
pp Redeemers ConwayEra
redeemers
        vldt =
            StrictMaybe SlotNo -> StrictMaybe SlotNo -> ValidityInterval
ValidityInterval
                (SlotNo -> StrictMaybe SlotNo
forall a. a -> StrictMaybe a
SJust SlotNo
lowerSlot)
                (SlotNo -> StrictMaybe SlotNo
forall a. a -> StrictMaybe a
SJust SlotNo
upperSlot)
        boundRefund =
            PParams ConwayEra
-> Network -> Integer -> TxOut ConwayEra -> TxOut ConwayEra
computeRefund PParams ConwayEra
pp (CageConfig -> Network
network CageConfig
cfg) Integer
0 TxOut ConwayEra
BabbageTxOut ConwayEra
reqOut
                BabbageTxOut ConwayEra
-> (BabbageTxOut ConwayEra -> BabbageTxOut ConwayEra)
-> BabbageTxOut ConwayEra
forall a b. a -> (a -> b) -> b
& (Datum ConwayEra -> Identity (Datum ConwayEra))
-> TxOut ConwayEra -> Identity (TxOut ConwayEra)
(Datum ConwayEra -> Identity (Datum ConwayEra))
-> BabbageTxOut ConwayEra -> Identity (BabbageTxOut ConwayEra)
forall era. BabbageEraTxOut era => Lens' (TxOut era) (Datum era)
Lens' (TxOut ConwayEra) (Datum ConwayEra)
datumTxOutL ((Datum ConwayEra -> Identity (Datum ConwayEra))
 -> BabbageTxOut ConwayEra -> Identity (BabbageTxOut ConwayEra))
-> Datum ConwayEra
-> BabbageTxOut ConwayEra
-> BabbageTxOut ConwayEra
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Data -> Datum ConwayEra
mkInlineDatum (OnChainTxOutRef -> Data
forall a. ToData a => a -> Data
toPlcData (TxIn -> OnChainTxOutRef
txInToRef TxIn
reqIn))
        refund =
            BabbageTxOut ConwayEra
boundRefund
                BabbageTxOut ConwayEra
-> (BabbageTxOut ConwayEra -> BabbageTxOut ConwayEra)
-> BabbageTxOut ConwayEra
forall a b. a -> (a -> b) -> b
& (Coin -> Identity Coin)
-> TxOut ConwayEra -> Identity (TxOut ConwayEra)
(Coin -> Identity Coin)
-> BabbageTxOut ConwayEra -> Identity (BabbageTxOut ConwayEra)
forall era. (HasCallStack, EraTxOut era) => Lens' (TxOut era) Coin
Lens' (TxOut ConwayEra) Coin
coinTxOutL
                    ((Coin -> Identity Coin)
 -> BabbageTxOut ConwayEra -> Identity (BabbageTxOut ConwayEra))
-> Coin -> BabbageTxOut ConwayEra -> BabbageTxOut ConwayEra
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Coin -> Coin -> Coin
forall a. Ord a => a -> a -> a
max (BabbageTxOut ConwayEra
boundRefund BabbageTxOut ConwayEra
-> Getting Coin (BabbageTxOut ConwayEra) Coin -> Coin
forall s a. s -> Getting a s a -> a
^. (Coin -> Const Coin Coin)
-> TxOut ConwayEra -> Const Coin (TxOut ConwayEra)
Getting Coin (BabbageTxOut ConwayEra) Coin
forall era. (HasCallStack, EraTxOut era) => Lens' (TxOut era) Coin
Lens' (TxOut ConwayEra) Coin
coinTxOutL) (PParams ConwayEra -> TxOut ConwayEra -> Coin
forall era. EraTxOut era => PParams era -> TxOut era -> Coin
getMinCoinTxOut PParams ConwayEra
pp TxOut ConwayEra
BabbageTxOut ConwayEra
boundRefund)
        body :: ConwayTxBody
        body =
            ConwayTxBody
forall era (l :: TxLevel).
(EraTxBody era, Typeable l) =>
TxBody l era
forall (l :: TxLevel). Typeable l => TxBody l ConwayEra
mkBasicTxBody
                ConwayTxBody -> (ConwayTxBody -> ConwayTxBody) -> ConwayTxBody
forall a b. a -> (a -> b) -> b
& (Set TxIn -> Identity (Set TxIn))
-> ConwayTxBody -> Identity ConwayTxBody
forall era (l :: TxLevel).
EraTxBody era =>
Lens' (TxBody l era) (Set TxIn)
forall (l :: TxLevel). Lens' (TxBody l ConwayEra) (Set TxIn)
inputsTxBodyL
                    ((Set TxIn -> Identity (Set TxIn))
 -> ConwayTxBody -> Identity ConwayTxBody)
-> Set TxIn -> ConwayTxBody -> ConwayTxBody
forall s t a b. ASetter s t a b -> b -> s -> t
.~ TxIn -> Set TxIn
forall a. a -> Set a
Set.singleton TxIn
reqIn
                ConwayTxBody -> (ConwayTxBody -> ConwayTxBody) -> ConwayTxBody
forall a b. a -> (a -> b) -> b
& (Set TxIn -> Identity (Set TxIn))
-> ConwayTxBody -> Identity ConwayTxBody
forall era (l :: TxLevel).
BabbageEraTxBody era =>
Lens' (TxBody l era) (Set TxIn)
forall (l :: TxLevel). Lens' (TxBody l ConwayEra) (Set TxIn)
referenceInputsTxBodyL
                    ((Set TxIn -> Identity (Set TxIn))
 -> ConwayTxBody -> Identity ConwayTxBody)
-> Set TxIn -> ConwayTxBody -> ConwayTxBody
forall s t a b. ASetter s t a b -> b -> s -> t
.~ TxIn -> Set TxIn
forall a. a -> Set a
Set.singleton TxIn
stateIn
                ConwayTxBody -> (ConwayTxBody -> ConwayTxBody) -> ConwayTxBody
forall a b. a -> (a -> b) -> b
& (StrictSeq (TxOut ConwayEra)
 -> Identity (StrictSeq (TxOut ConwayEra)))
-> ConwayTxBody -> Identity ConwayTxBody
(StrictSeq (BabbageTxOut ConwayEra)
 -> Identity (StrictSeq (BabbageTxOut ConwayEra)))
-> ConwayTxBody -> Identity ConwayTxBody
forall era (l :: TxLevel).
EraTxBody era =>
Lens' (TxBody l era) (StrictSeq (TxOut era))
forall (l :: TxLevel).
Lens' (TxBody l ConwayEra) (StrictSeq (TxOut ConwayEra))
outputsTxBodyL
                    ((StrictSeq (BabbageTxOut ConwayEra)
  -> Identity (StrictSeq (BabbageTxOut ConwayEra)))
 -> ConwayTxBody -> Identity ConwayTxBody)
-> StrictSeq (BabbageTxOut ConwayEra)
-> ConwayTxBody
-> ConwayTxBody
forall s t a b. ASetter s t a b -> b -> s -> t
.~ BabbageTxOut ConwayEra -> StrictSeq (BabbageTxOut ConwayEra)
forall a. a -> StrictSeq a
StrictSeq.singleton
                        BabbageTxOut ConwayEra
refund
                ConwayTxBody -> (ConwayTxBody -> ConwayTxBody) -> ConwayTxBody
forall a b. a -> (a -> b) -> b
& (Set TxIn -> Identity (Set TxIn))
-> ConwayTxBody -> Identity ConwayTxBody
forall era.
AlonzoEraTxBody era =>
Lens' (TxBody TopTx era) (Set TxIn)
Lens' ConwayTxBody (Set TxIn)
collateralInputsTxBodyL
                    ((Set TxIn -> Identity (Set TxIn))
 -> ConwayTxBody -> Identity ConwayTxBody)
-> Set TxIn -> ConwayTxBody -> ConwayTxBody
forall s t a b. ASetter s t a b -> b -> s -> t
.~ TxIn -> Set TxIn
forall a. a -> Set a
Set.singleton
                        ((TxIn, BabbageTxOut ConwayEra) -> TxIn
forall a b. (a, b) -> a
fst (TxIn, BabbageTxOut ConwayEra)
feeUtxo)
                ConwayTxBody -> (ConwayTxBody -> ConwayTxBody) -> ConwayTxBody
forall a b. a -> (a -> b) -> b
& (Set (KeyHash Guard) -> Identity (Set (KeyHash Guard)))
-> ConwayTxBody -> Identity ConwayTxBody
forall era (l :: TxLevel).
(AlonzoEraTxBody era, AtMostEra "Conway" era) =>
Lens' (TxBody l era) (Set (KeyHash Guard))
forall (l :: TxLevel).
AtMostEra "Conway" ConwayEra =>
Lens' (TxBody l ConwayEra) (Set (KeyHash Guard))
Lens' ConwayTxBody (Set (KeyHash Guard))
reqSignerHashesTxBodyL
                    ((Set (KeyHash Guard) -> Identity (Set (KeyHash Guard)))
 -> ConwayTxBody -> Identity ConwayTxBody)
-> Set (KeyHash Guard) -> ConwayTxBody -> ConwayTxBody
forall s t a b. ASetter s t a b -> b -> s -> t
.~ KeyHash Guard -> Set (KeyHash Guard)
forall a. a -> Set a
Set.singleton KeyHash Guard
ownerKh
                ConwayTxBody -> (ConwayTxBody -> ConwayTxBody) -> ConwayTxBody
forall a b. a -> (a -> b) -> b
& (ValidityInterval -> Identity ValidityInterval)
-> ConwayTxBody -> Identity ConwayTxBody
forall era (l :: TxLevel).
AllegraEraTxBody era =>
Lens' (TxBody l era) ValidityInterval
forall (l :: TxLevel). Lens' (TxBody l ConwayEra) ValidityInterval
vldtTxBodyL ((ValidityInterval -> Identity ValidityInterval)
 -> ConwayTxBody -> Identity ConwayTxBody)
-> ValidityInterval -> ConwayTxBody -> ConwayTxBody
forall s t a b. ASetter s t a b -> b -> s -> t
.~ ValidityInterval
vldt
                ConwayTxBody -> (ConwayTxBody -> ConwayTxBody) -> ConwayTxBody
forall a b. a -> (a -> b) -> b
& (StrictMaybe ScriptIntegrityHash
 -> Identity (StrictMaybe ScriptIntegrityHash))
-> ConwayTxBody -> Identity ConwayTxBody
forall era (l :: TxLevel).
AlonzoEraTxBody era =>
Lens' (TxBody l era) (StrictMaybe ScriptIntegrityHash)
forall (l :: TxLevel).
Lens' (TxBody l ConwayEra) (StrictMaybe ScriptIntegrityHash)
scriptIntegrityHashTxBodyL
                    ((StrictMaybe ScriptIntegrityHash
  -> Identity (StrictMaybe ScriptIntegrityHash))
 -> ConwayTxBody -> Identity ConwayTxBody)
-> StrictMaybe ScriptIntegrityHash -> ConwayTxBody -> ConwayTxBody
forall s t a b. ASetter s t a b -> b -> s -> t
.~ StrictMaybe ScriptIntegrityHash
integrity
        tx =
            ConwayTxBody -> ConwayTx
forall era (l :: TxLevel). EraTx era => TxBody l era -> Tx l era
forall (l :: TxLevel). TxBody l ConwayEra -> Tx l ConwayEra
mkBasicTx ConwayTxBody
body
                ConwayTx -> (ConwayTx -> ConwayTx) -> ConwayTx
forall a b. a -> (a -> b) -> b
& (AlonzoTxWits ConwayEra -> Identity (AlonzoTxWits ConwayEra))
-> ConwayTx -> Identity ConwayTx
(TxWits ConwayEra -> Identity (TxWits ConwayEra))
-> ConwayTx -> Identity ConwayTx
forall era (l :: TxLevel).
EraTx era =>
Lens' (Tx l era) (TxWits era)
forall (l :: TxLevel). Lens' (Tx l ConwayEra) (TxWits ConwayEra)
witsTxL ((AlonzoTxWits ConwayEra -> Identity (AlonzoTxWits ConwayEra))
 -> ConwayTx -> Identity ConwayTx)
-> ((Map ScriptHash (Script ConwayEra)
     -> Identity (Map ScriptHash (AlonzoScript ConwayEra)))
    -> AlonzoTxWits ConwayEra -> Identity (AlonzoTxWits ConwayEra))
-> (Map ScriptHash (Script ConwayEra)
    -> Identity (Map ScriptHash (AlonzoScript ConwayEra)))
-> ConwayTx
-> Identity ConwayTx
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Map ScriptHash (Script ConwayEra)
 -> Identity (Map ScriptHash (AlonzoScript ConwayEra)))
-> AlonzoTxWits ConwayEra -> Identity (AlonzoTxWits ConwayEra)
(Map ScriptHash (Script ConwayEra)
 -> Identity (Map ScriptHash (Script ConwayEra)))
-> TxWits ConwayEra -> Identity (TxWits ConwayEra)
forall era.
EraTxWits era =>
Lens' (TxWits era) (Map ScriptHash (Script era))
Lens' (TxWits ConwayEra) (Map ScriptHash (Script ConwayEra))
scriptTxWitsL
                    ((Map ScriptHash (Script ConwayEra)
  -> Identity (Map ScriptHash (AlonzoScript ConwayEra)))
 -> ConwayTx -> Identity ConwayTx)
-> Map ScriptHash (AlonzoScript ConwayEra) -> ConwayTx -> ConwayTx
forall s t a b. ASetter s t a b -> b -> s -> t
.~ ScriptHash
-> AlonzoScript ConwayEra
-> Map ScriptHash (AlonzoScript ConwayEra)
forall k a. k -> a -> Map k a
Map.singleton
                        ScriptHash
scriptHash
                        AlonzoScript ConwayEra
script
                ConwayTx -> (ConwayTx -> ConwayTx) -> ConwayTx
forall a b. a -> (a -> b) -> b
& (AlonzoTxWits ConwayEra -> Identity (AlonzoTxWits ConwayEra))
-> ConwayTx -> Identity ConwayTx
(TxWits ConwayEra -> Identity (TxWits ConwayEra))
-> ConwayTx -> Identity ConwayTx
forall era (l :: TxLevel).
EraTx era =>
Lens' (Tx l era) (TxWits era)
forall (l :: TxLevel). Lens' (Tx l ConwayEra) (TxWits ConwayEra)
witsTxL ((AlonzoTxWits ConwayEra -> Identity (AlonzoTxWits ConwayEra))
 -> ConwayTx -> Identity ConwayTx)
-> ((Redeemers ConwayEra -> Identity (Redeemers ConwayEra))
    -> AlonzoTxWits ConwayEra -> Identity (AlonzoTxWits ConwayEra))
-> (Redeemers ConwayEra -> Identity (Redeemers ConwayEra))
-> ConwayTx
-> Identity ConwayTx
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Redeemers ConwayEra -> Identity (Redeemers ConwayEra))
-> AlonzoTxWits ConwayEra -> Identity (AlonzoTxWits ConwayEra)
(Redeemers ConwayEra -> Identity (Redeemers ConwayEra))
-> TxWits ConwayEra -> Identity (TxWits ConwayEra)
forall era.
AlonzoEraTxWits era =>
Lens' (TxWits era) (Redeemers era)
Lens' (TxWits ConwayEra) (Redeemers ConwayEra)
rdmrsTxWitsL
                    ((Redeemers ConwayEra -> Identity (Redeemers ConwayEra))
 -> ConwayTx -> Identity ConwayTx)
-> Redeemers ConwayEra -> ConwayTx -> ConwayTx
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Redeemers ConwayEra
redeemers
    evaluateAndBalance
        view
        pp
        [feeUtxo, reqUtxoPair]
        addr
        tx