{-# LANGUAGE DataKinds #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE LambdaCase #-}

{- |
Module      : Singular.Registry.TxBuilder.Reject
Description : Reject transaction for a registry's pending requests
License     : Apache-2.0

Builds a reject transaction that consumes every pending request of the
registry, in any window: a reject carries no admission (Lean
@exitAdmission .reject = none@, #320). The folder keeps the tip and
refunds the remaining ADA to the request owners. The trie root does
NOT change.
-}
module Singular.Registry.TxBuilder.Reject
    ( rejectRequestsImpl
    , rejectRequestsWithRefs
    ) where

import Control.Monad (when)
import Data.List (sortOn)
import Data.Map.Strict qualified as Map
import Data.Ord (Down (..))
import Data.Void (Void)
import Lens.Micro ((&), (.~), (^.))

import Cardano.Ledger.Address (Addr)
import Cardano.Ledger.Alonzo.Scripts (AsIx)
import Cardano.Ledger.Api.Tx
    ( bodyTxL
    )
import Cardano.Ledger.Api.Tx.Body
    ( feeTxBodyL
    )
import Cardano.Ledger.Api.Tx.Out
    ( TxOut
    , coinTxOutL
    , datumTxOutL
    , mkBasicTxOut
    , referenceScriptTxOutL
    , valueTxOutL
    )
import Cardano.Ledger.BaseTypes (StrictMaybe (..))
import Cardano.Ledger.Conway.Scripts
    ( ConwayPlutusPurpose
    )
import Cardano.Ledger.Core (Script)
import Cardano.Ledger.Plutus.ExUnits (ExUnits)

import Cardano.Slotting.Slot (SlotNo)
import Cardano.Tx.Build qualified as Tx
import Cardano.Tx.Ledger (ConwayTx)
import Singular.Registry.Config
    ( CageConfig (..)
    )
import Singular.Registry.Evidence (NoWitness)
import Singular.Registry.Ledger
    ( Coin (..)
    , ConwayEra
    , PParams
    , TokenId
    , TxIn
    )
import Singular.Registry.LedgerProvider
    ( Session (..)
    , TipObservation (..)
    )
import Singular.Registry.SessionIO (outputsAt, parameters)
import Singular.Registry.SessionIO qualified as Services
import Singular.Registry.TxBuilder.Internal.Identity
import Singular.Registry.TxBuilder.Internal.Lookup
import Singular.Registry.Types
    ( CageDatum (..)
    , OnChainTokenState (..)
    , RequestAction (..)
    , UpdateRedeemer (..)
    )

-- | Empty query generalized algebraic data type (no context needed).
data NoCtx a

{- | Build a reject transaction for every pending request
of the registry, attaching the state and request scripts
to the transaction itself.
-}
rejectRequestsImpl
    :: CageConfig
    -> Session NoWitness IO
    -> TokenId
    -> Addr
    -> IO ConwayTx
rejectRequestsImpl :: CageConfig
-> Session NoWitness IO -> TokenId -> Addr -> IO ConwayTx
rejectRequestsImpl CageConfig
cfg Session NoWitness IO
view TokenId
tid Addr
addr =
    CageConfig
-> Session NoWitness IO
-> TokenId
-> Addr
-> [(TxIn, TxOut ConwayEra)]
-> IO ConwayTx
rejectRequestsWithRefs CageConfig
cfg Session NoWitness IO
view TokenId
tid Addr
addr []

{- | Build a reject transaction resolving its scripts through reference
outputs when the caller has published them.

The state validator alone is fifteen kilobytes and the request validator
another two and a half, so a reject that carries both inline is 18317
bytes against the protocol's `MaxTxSizeUTxO` of 16384 and the ledger
refuses it before a script runs. Given outputs that carry those scripts,
every purpose resolves through them instead and the transaction carries
neither. An empty list keeps the attaching form, for a caller that has
nothing published.
-}
rejectRequestsWithRefs
    :: CageConfig
    -> Session NoWitness IO
    -> TokenId
    -> Addr
    -> [(TxIn, TxOut ConwayEra)]
    -- ^ Outputs carrying the reject's scripts as reference scripts
    -> IO ConwayTx
rejectRequestsWithRefs :: CageConfig
-> Session NoWitness IO
-> TokenId
-> Addr
-> [(TxIn, TxOut ConwayEra)]
-> IO ConwayTx
rejectRequestsWithRefs CageConfig
cfg Session NoWitness IO
view TokenId
tid Addr
addr [(TxIn, TxOut ConwayEra)]
refUtxos = do
    (stateUtxo, reqUtxos, feeUtxo, pp) <-
        CageConfig
-> Session NoWitness IO
-> TokenId
-> Addr
-> IO
     ((TxIn, TxOut ConwayEra), [(TxIn, TxOut ConwayEra)],
      (TxIn, TxOut ConwayEra), PParams ConwayEra)
queryRejectContext CageConfig
cfg Session NoWitness IO
view TokenId
tid Addr
addr
    let (_stateIn, stateOut) = stateUtxo
    let (oldState, newStateOut, script) =
            prepareRejectState cfg stateOut
        requestScript = CageConfig -> TokenId -> Script ConwayEra
mkRequestScript CageConfig
cfg TokenId
tid
    (lowerSlot, upperSlot) <- rejectValidity view
    let evalTx = Session NoWitness IO
-> ConwayTx
-> IO
     (Map (ConwayPlutusPurpose AsIx ConwayEra) (Either [Char] ExUnits))
mkRejectEvalTx Session NoWitness IO
view
        prog =
            CageConfig
-> PParams ConwayEra
-> TxIn
-> [(TxIn, TxOut ConwayEra)]
-> (TxIn, TxOut ConwayEra)
-> OnChainTokenState
-> TxOut ConwayEra
-> Script ConwayEra
-> Script ConwayEra
-> SlotNo
-> SlotNo
-> [(TxIn, TxOut ConwayEra)]
-> TxBuild NoCtx Void ()
buildRejectProgram
                CageConfig
cfg
                PParams ConwayEra
pp
                ((TxIn, BabbageTxOut ConwayEra) -> TxIn
forall a b. (a, b) -> a
fst (TxIn, BabbageTxOut ConwayEra)
stateUtxo)
                [(TxIn, TxOut ConwayEra)]
[(TxIn, BabbageTxOut ConwayEra)]
reqUtxos
                (TxIn, TxOut ConwayEra)
(TxIn, BabbageTxOut ConwayEra)
feeUtxo
                OnChainTokenState
oldState
                TxOut ConwayEra
BabbageTxOut ConwayEra
newStateOut
                AlonzoScript ConwayEra
Script ConwayEra
script
                AlonzoScript ConwayEra
Script ConwayEra
requestScript
                SlotNo
lowerSlot
                SlotNo
upperSlot
                [(TxIn, TxOut ConwayEra)]
refUtxos
    result <-
        Tx.build
            (Tx.mkPParamsBound pp)
            (Tx.InterpretIO (const (pure undefined)))
            evalTx
            (feeUtxo : stateUtxo : reqUtxos)
            refUtxos
            addr
            (prog :: Tx.TxBuild NoCtx Void ())
    case result of
        Right ConwayTx
tx -> ConwayTx -> IO ConwayTx
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ConwayTx
tx
        Left BuildError Void
err ->
            [Char] -> IO ConwayTx
forall a. HasCallStack => [Char] -> a
error ([Char] -> IO ConwayTx) -> [Char] -> IO ConwayTx
forall a b. (a -> b) -> a -> b
$
                [Char]
"rejectRequests: build failed: "
                    [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> BuildError Void -> [Char]
forall a. Show a => a -> [Char]
show BuildError Void
err

{- | Query cage UTxOs, find state, select every pending
request of the registry, pick fee UTxO. A request is
pending when it sits at the registry's request address
with a request datum naming this registry's token; no
window selects among them.
-}
queryRejectContext
    :: CageConfig
    -> Session NoWitness IO
    -> TokenId
    -> Addr
    -> IO
        ( (TxIn, TxOut ConwayEra)
        , [(TxIn, TxOut ConwayEra)]
        , (TxIn, TxOut ConwayEra)
        , PParams ConwayEra
        )
queryRejectContext :: CageConfig
-> Session NoWitness IO
-> TokenId
-> Addr
-> IO
     ((TxIn, TxOut ConwayEra), [(TxIn, TxOut ConwayEra)],
      (TxIn, TxOut ConwayEra), PParams ConwayEra)
queryRejectContext CageConfig
cfg Session NoWitness IO
view TokenId
tid Addr
addr = do
    let stateAddr :: Addr
stateAddr =
            CageConfig -> Network -> Addr
cageAddrFromCfg CageConfig
cfg (CageConfig -> Network
network CageConfig
cfg)
        reqAddr :: Addr
reqAddr =
            CageConfig -> TokenId -> Network -> Addr
requestAddrFromCfg CageConfig
cfg TokenId
tid (CageConfig -> Network
network CageConfig
cfg)
    stateUtxos <- Session NoWitness IO -> Addr -> IO [(TxIn, TxOut ConwayEra)]
forall w. Session w IO -> Addr -> IO [(TxIn, TxOut ConwayEra)]
outputsAt Session NoWitness IO
view Addr
stateAddr
    requestUtxos <- outputsAt view reqAddr
    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]
"rejectRequests: 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 reqUtxos =
            ((TxIn, TxOut ConwayEra) -> TxIn)
-> [(TxIn, TxOut ConwayEra)] -> [(TxIn, TxOut ConwayEra)]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn (TxIn, TxOut ConwayEra) -> TxIn
(TxIn, BabbageTxOut ConwayEra) -> TxIn
forall a b. (a, b) -> a
fst ([(TxIn, TxOut ConwayEra)] -> [(TxIn, TxOut ConwayEra)])
-> [(TxIn, TxOut ConwayEra)] -> [(TxIn, TxOut ConwayEra)]
forall a b. (a -> b) -> a -> b
$
                TokenId -> [(TxIn, TxOut ConwayEra)] -> [(TxIn, TxOut ConwayEra)]
findRequestUtxos TokenId
tid [(TxIn, TxOut ConwayEra)]
[(TxIn, BabbageTxOut ConwayEra)]
requestUtxos
    when (null reqUtxos) $
        error
            "rejectRequests: no pending \
            \requests"
    pp <- parameters view
    walletUtxos <- outputsAt view addr
    -- A published reference output lives in this same wallet. Spending
    -- one to pay the fee would destroy the script the transaction is
    -- resolving through, and collateral must be ada-only besides.
    let spendableUtxos =
            [ (TxIn, BabbageTxOut ConwayEra)
u
            | u :: (TxIn, BabbageTxOut ConwayEra)
u@(TxIn
_, BabbageTxOut ConwayEra
o) <- [(TxIn, BabbageTxOut ConwayEra)]
walletUtxos
            , BabbageTxOut ConwayEra
o BabbageTxOut ConwayEra
-> Getting
     (StrictMaybe (Script ConwayEra))
     (BabbageTxOut ConwayEra)
     (StrictMaybe (Script ConwayEra))
-> StrictMaybe (Script ConwayEra)
forall s a. s -> Getting a s a -> a
^. (StrictMaybe (Script ConwayEra)
 -> Const
      (StrictMaybe (Script ConwayEra)) (StrictMaybe (Script ConwayEra)))
-> TxOut ConwayEra
-> Const (StrictMaybe (Script ConwayEra)) (TxOut ConwayEra)
Getting
  (StrictMaybe (Script ConwayEra))
  (BabbageTxOut ConwayEra)
  (StrictMaybe (Script ConwayEra))
forall era.
BabbageEraTxOut era =>
Lens' (TxOut era) (StrictMaybe (Script era))
Lens' (TxOut ConwayEra) (StrictMaybe (Script ConwayEra))
referenceScriptTxOutL StrictMaybe (Script ConwayEra)
-> StrictMaybe (Script ConwayEra) -> Bool
forall a. Eq a => a -> a -> Bool
== StrictMaybe (Script ConwayEra)
forall a. StrictMaybe a
SNothing
            ]
    feeUtxo <- case sortOn
        (Down . (^. coinTxOutL) . snd)
        spendableUtxos of
        [] -> [Char] -> IO (TxIn, BabbageTxOut ConwayEra)
forall a. HasCallStack => [Char] -> a
error [Char]
"rejectRequests: no UTxOs"
        ((TxIn, BabbageTxOut ConwayEra)
u : [(TxIn, BabbageTxOut ConwayEra)]
_) -> (TxIn, BabbageTxOut ConwayEra) -> IO (TxIn, BabbageTxOut ConwayEra)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TxIn, BabbageTxOut ConwayEra)
u
    pure (stateUtxo, reqUtxos, feeUtxo, pp)

-- | Extract state, build new state output.
prepareRejectState
    :: CageConfig
    -> TxOut ConwayEra
    -> (OnChainTokenState, TxOut ConwayEra, Script ConwayEra)
prepareRejectState :: CageConfig
-> TxOut ConwayEra
-> (OnChainTokenState, TxOut ConwayEra, Script ConwayEra)
prepareRejectState CageConfig
cfg TxOut ConwayEra
stateOut =
    let scriptAddr :: Addr
scriptAddr =
            CageConfig -> Network -> Addr
cageAddrFromCfg CageConfig
cfg (CageConfig -> Network
network CageConfig
cfg)
        oldState :: OnChainTokenState
oldState =
            case TxOut ConwayEra -> Maybe CageDatum
extractCageDatum TxOut ConwayEra
stateOut of
                Just (StateDatum OnChainTokenState
s) -> OnChainTokenState
s
                Maybe CageDatum
_ ->
                    [Char] -> OnChainTokenState
forall a. HasCallStack => [Char] -> a
error
                        [Char]
"rejectRequests: invalid \
                        \state datum"
        newStateOut :: BabbageTxOut ConwayEra
newStateOut =
            Addr -> Value ConwayEra -> TxOut ConwayEra
forall era.
(EraTxOut era, HasCallStack) =>
Addr -> Value era -> TxOut era
mkBasicTxOut
                Addr
scriptAddr
                (TxOut ConwayEra
BabbageTxOut ConwayEra
stateOut BabbageTxOut ConwayEra
-> Getting
     (Value ConwayEra) (BabbageTxOut ConwayEra) (Value ConwayEra)
-> Value ConwayEra
forall s a. s -> Getting a s a -> a
^. (Value ConwayEra -> Const (Value ConwayEra) (Value ConwayEra))
-> TxOut ConwayEra -> Const (Value ConwayEra) (TxOut ConwayEra)
Getting
  (Value ConwayEra) (BabbageTxOut ConwayEra) (Value ConwayEra)
forall era. EraTxOut era => Lens' (TxOut era) (Value era)
Lens' (TxOut ConwayEra) (Value ConwayEra)
valueTxOutL)
                TxOut ConwayEra
-> (TxOut 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))
-> TxOut ConwayEra -> Identity (BabbageTxOut ConwayEra)
forall era. BabbageEraTxOut era => Lens' (TxOut era) (Datum era)
Lens' (TxOut ConwayEra) (Datum ConwayEra)
datumTxOutL
                    ((Datum ConwayEra -> Identity (Datum ConwayEra))
 -> TxOut ConwayEra -> Identity (BabbageTxOut ConwayEra))
-> Datum ConwayEra -> TxOut ConwayEra -> BabbageTxOut ConwayEra
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Data -> Datum ConwayEra
mkInlineDatum
                        ( CageDatum -> Data
forall a. ToData a => a -> Data
toPlcData
                            (OnChainTokenState -> CageDatum
StateDatum OnChainTokenState
oldState)
                        )
        script :: Script ConwayEra
script = CageConfig -> Script ConwayEra
mkCageScript CageConfig
cfg
    in  (OnChainTokenState
oldState, TxOut ConwayEra
BabbageTxOut ConwayEra
newStateOut, AlonzoScript ConwayEra
Script ConwayEra
script)

{- | The reject's validity starts at its acquired view's tip. The clock
chooses only the upper bound, with shorter horizons tried as needed.
Keep that bound after the tip even when the clock is behind it. No
request deadline selects the interval: a reject is admitted in every window.
-}
rejectValidity :: Session NoWitness IO -> IO (SlotNo, SlotNo)
rejectValidity :: Session NoWitness IO -> IO (SlotNo, SlotNo)
rejectValidity Session NoWitness IO
view = do
    now <- IO Integer
currentPosixMs
    lowerSlot <- observedSlot <$> Services.tip view
    -- A tip supplies the lower slot directly, but both ledger bounds must
    -- remain inside this view's validated finite conversion context.
    _ <- Services.slotStart view lowerSlot
    upperSlot <-
        tryUpperSlots view $
            map
                (now +)
                [120_000, 60_000, 30_000, 10_000, 5_000, 2_000, 1_000]
    let finalUpper = SlotNo -> SlotNo -> SlotNo
forall a. Ord a => a -> a -> a
max (SlotNo
lowerSlot SlotNo -> SlotNo -> SlotNo
forall a. Num a => a -> a -> a
+ SlotNo
1) SlotNo
upperSlot
    _ <- Services.slotStart view finalUpper
    capped <-
        Services.validityUpper view lowerSlot (Just lowerSlot) finalUpper
    pure (lowerSlot, capped)

-- | Wrap common local evaluation for the story language.
mkRejectEvalTx
    :: Session NoWitness IO
    -> ConwayTx
    -> IO
        ( Map.Map
            (ConwayPlutusPurpose AsIx ConwayEra)
            (Either String ExUnits)
        )
mkRejectEvalTx :: Session NoWitness IO
-> ConwayTx
-> IO
     (Map (ConwayPlutusPurpose AsIx ConwayEra) (Either [Char] ExUnits))
mkRejectEvalTx Session NoWitness IO
view ConwayTx
tx = do
    r <- Session NoWitness IO -> ConwayTx -> IO (EvaluateTxResult ConwayEra)
forall w.
Session w IO -> ConwayTx -> IO (EvaluateTxResult ConwayEra)
Services.evaluateTx Session NoWitness IO
view ConwayTx
tx
    pure $
        Map.map
            ( \case
                Left TransactionScriptFailure ConwayEra
e -> [Char] -> Either [Char] ExUnits
forall a b. a -> Either a b
Left (TransactionScriptFailure ConwayEra -> [Char]
forall a. Show a => a -> [Char]
show TransactionScriptFailure ConwayEra
e)
                Right ExUnits
eu -> ExUnits -> Either [Char] ExUnits
forall a b. b -> Either a b
Right ExUnits
eu
            )
            r

-- | The TxBuild story language program for a reject tx.
buildRejectProgram
    :: CageConfig
    -> PParams ConwayEra
    -> TxIn
    -> [(TxIn, TxOut ConwayEra)]
    -> (TxIn, TxOut ConwayEra)
    -> OnChainTokenState
    -> TxOut ConwayEra
    -> Script ConwayEra
    -> Script ConwayEra
    -> SlotNo
    -> SlotNo
    -> [(TxIn, TxOut ConwayEra)]
    -> Tx.TxBuild NoCtx Void ()
buildRejectProgram :: CageConfig
-> PParams ConwayEra
-> TxIn
-> [(TxIn, TxOut ConwayEra)]
-> (TxIn, TxOut ConwayEra)
-> OnChainTokenState
-> TxOut ConwayEra
-> Script ConwayEra
-> Script ConwayEra
-> SlotNo
-> SlotNo
-> [(TxIn, TxOut ConwayEra)]
-> TxBuild NoCtx Void ()
buildRejectProgram
    CageConfig
cfg
    PParams ConwayEra
pp
    TxIn
stateIn
    [(TxIn, TxOut ConwayEra)]
reqUtxos
    (TxIn, TxOut ConwayEra)
feeUtxo
    OnChainTokenState
oldState
    TxOut ConwayEra
newStateOut
    Script ConwayEra
script
    Script ConwayEra
requestScript
    SlotNo
lowerSlot
    SlotNo
upperSlot
    [(TxIn, TxOut ConwayEra)]
refUtxos = do
        let stateRef :: OnChainTxOutRef
stateRef = TxIn -> OnChainTxOutRef
txInToRef TxIn
stateIn
            OnChainTokenState
                { stateMaxFee :: OnChainTokenState -> Integer
stateMaxFee = Integer
tipAmount
                } = OnChainTokenState
oldState
        let actions :: [RequestAction]
actions =
                Int -> RequestAction -> [RequestAction]
forall a. Int -> a -> [a]
replicate ([(TxIn, BabbageTxOut ConwayEra)] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(TxIn, TxOut ConwayEra)]
[(TxIn, BabbageTxOut ConwayEra)]
reqUtxos) RequestAction
Rejected
        _ <- TxIn -> UpdateRedeemer -> TxBuild NoCtx Void Word32
forall r (q :: * -> *) e.
ToData r =>
TxIn -> r -> TxBuild q e Word32
Tx.spendScript TxIn
stateIn ([RequestAction] -> UpdateRedeemer
Modify [RequestAction]
actions)
        mapM_
            ( \(TxIn
rIn, BabbageTxOut ConwayEra
_) ->
                TxIn -> UpdateRedeemer -> TxBuild NoCtx Void Word32
forall r (q :: * -> *) e.
ToData r =>
TxIn -> r -> TxBuild q e Word32
Tx.spendScript
                    TxIn
rIn
                    (OnChainTxOutRef -> UpdateRedeemer
Contribute OnChainTxOutRef
stateRef)
            )
            reqUtxos
        _ <- Tx.output newStateOut
        Coin _fee <- Tx.peek $ \ConwayTx
tx ->
            let f :: Coin
f = ConwayTx
tx ConwayTx -> Getting Coin ConwayTx Coin -> Coin
forall s a. s -> Getting a s a -> a
^. (TxBody TopTx ConwayEra -> Const Coin (TxBody TopTx ConwayEra))
-> ConwayTx -> Const Coin ConwayTx
forall era (l :: TxLevel).
EraTx era =>
Lens' (Tx l era) (TxBody l era)
forall (l :: TxLevel). Lens' (Tx l ConwayEra) (TxBody l ConwayEra)
bodyTxL ((TxBody TopTx ConwayEra -> Const Coin (TxBody TopTx ConwayEra))
 -> ConwayTx -> Const Coin ConwayTx)
-> ((Coin -> Const Coin Coin)
    -> TxBody TopTx ConwayEra -> Const Coin (TxBody TopTx ConwayEra))
-> Getting Coin ConwayTx Coin
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Coin -> Const Coin Coin)
-> TxBody TopTx ConwayEra -> Const Coin (TxBody TopTx ConwayEra)
forall era. EraTxBody era => Lens' (TxBody TopTx era) Coin
Lens' (TxBody TopTx ConwayEra) Coin
feeTxBodyL
            in  if Coin
f Coin -> Coin -> Bool
forall a. Ord a => a -> a -> Bool
> Integer -> Coin
Coin Integer
0
                    then Coin -> Convergence Coin
forall a. a -> Convergence a
Tx.Ok Coin
f
                    else Coin -> Convergence Coin
forall a. a -> Convergence a
Tx.Iterate Coin
f
        -- Rejected rows refund exactly `input − tip` floored at min-UTxO
        -- (NOTE-014 item A2) via the single shared helper — no fee share.
        let refundOuts =
                ((TxIn, BabbageTxOut ConwayEra) -> BabbageTxOut ConwayEra)
-> [(TxIn, BabbageTxOut ConwayEra)] -> [BabbageTxOut ConwayEra]
forall a b. (a -> b) -> [a] -> [b]
map
                    ( \(TxIn
_, BabbageTxOut ConwayEra
reqOut) ->
                        PParams ConwayEra
-> Network -> Integer -> TxOut ConwayEra -> TxOut ConwayEra
computeRefund PParams ConwayEra
pp (CageConfig -> Network
network CageConfig
cfg) Integer
tipAmount TxOut ConwayEra
BabbageTxOut ConwayEra
reqOut
                    )
                    [(TxIn, TxOut ConwayEra)]
[(TxIn, BabbageTxOut ConwayEra)]
reqUtxos
        mapM_ Tx.output refundOuts
        -- #157 removed-consumer-encoding: the pinned consumer and its mandatory withdrawal are
        -- gone. Every rule it re-walked beside the fold — request value
        -- coverage, the mint binding — is the cage's own now, checked
        -- once from the transaction's own evidence.
        if null refUtxos
            then do
                Tx.attachScript script
                Tx.attachScript requestScript
            else mapM_ (Tx.reference . fst) refUtxos
        Tx.collateral (fst feeUtxo)
        Tx.validFrom lowerSlot
        Tx.validTo upperSlot