Skip to content

Commit

Permalink
Use Write.Tx type for tx field of PartialTx. (#4235)
Browse files Browse the repository at this point in the history
## Issue

ADP-3184

## Description

This PR adjusts the `tx` field of `PartialTx` to use the `Write.Tx`
(ledger) type instead of the equivalent type from `cardano-api`.

## Future work

Adjust `balanceTransaction` to return `Write.Tx` (ledger) instead of the
equivalent type from `cardano-api`.
  • Loading branch information
Anviking authored Nov 15, 2023
2 parents 57f4b1f + 590893f commit bc780bf
Show file tree
Hide file tree
Showing 5 changed files with 109 additions and 70 deletions.
25 changes: 19 additions & 6 deletions lib/balance-tx/lib/internal/Internal/Cardano/Write/Tx.hs
Original file line number Diff line number Diff line change
Expand Up @@ -52,6 +52,7 @@ module Internal.Cardano.Write.Tx
, CardanoApi.ShelleyLedgerEra
, cardanoEraFromRecentEra
, shelleyBasedEraFromRecentEra
, asCardanoApiTx
, fromCardanoApiTx
, toCardanoApiUTxO
, fromCardanoApiUTxO
Expand Down Expand Up @@ -791,14 +792,16 @@ outputs RecentEraBabbage = map sizedValue . toList . Babbage.btbOutputs
--
-- TODO [ADP-2353] Move to @cardano-api@ related module
modifyLedgerBody
:: (Core.TxBody (CardanoApi.ShelleyLedgerEra cardanoEra) ->
:: forall cardanoEra. IsRecentEra cardanoEra
=> (Core.TxBody (CardanoApi.ShelleyLedgerEra cardanoEra) ->
Core.TxBody (CardanoApi.ShelleyLedgerEra cardanoEra))
-> CardanoApi.Tx cardanoEra
-> CardanoApi.Tx cardanoEra
modifyLedgerBody f (CardanoApi.Tx body keyWits) = CardanoApi.Tx body' keyWits
-> Core.Tx (CardanoApi.ShelleyLedgerEra cardanoEra)
-> Core.Tx (CardanoApi.ShelleyLedgerEra cardanoEra)
modifyLedgerBody f = asCardanoApiTx @cardanoEra modify
where
body' =
case body of
modify (CardanoApi.Tx body keyWits) = CardanoApi.Tx body' keyWits
where
body' = case body of
CardanoApi.ByronTxBody {} ->
error "Impossible: ByronTxBody in CardanoApi.ShelleyLedgerEra"
CardanoApi.ShelleyTxBody
Expand All @@ -823,6 +826,16 @@ emptyTx era = withConstraints era $ Core.mkBasicTx Core.mkBasicTxBody
-- Compatibility
--------------------------------------------------------------------------------

asCardanoApiTx
:: forall era. IsRecentEra era
=> (CardanoApi.Tx era -> CardanoApi.Tx era)
-> Core.Tx (CardanoApi.ShelleyLedgerEra era)
-> Core.Tx (CardanoApi.ShelleyLedgerEra era)
asCardanoApiTx f
= fromCardanoApiTx
. f
. toCardanoApiTx

fromCardanoApiTx
:: forall era. IsRecentEra era
=> CardanoApi.Tx era
Expand Down
36 changes: 18 additions & 18 deletions lib/balance-tx/lib/internal/Internal/Cardano/Write/Tx/Balance.hs
Original file line number Diff line number Diff line change
Expand Up @@ -228,7 +228,6 @@ import Internal.Cardano.Write.Tx
, evaluateMinimumFee
, evaluateTransactionBalance
, feeOfBytes
, fromCardanoApiTx
, getFeePerByte
, isBelowMinimumCoinForTxOut
, maxScriptExecutionCost
Expand Down Expand Up @@ -471,7 +470,7 @@ deriving instance Show (ErrBalanceTx era)
-- and instead adjust the existing redeemer indexes ourselves when balancing,
-- even though they are in an "unordered" set.
data PartialTx era = PartialTx
{ tx :: CardanoApi.Tx era
{ tx :: Tx (ShelleyLedgerEra era)
, inputs :: UTxO (ShelleyLedgerEra era)
-- ^ NOTE: Can we rename this to something better? Perhaps 'extraUTxO'?
, redeemers :: [Redeemer]
Expand All @@ -494,13 +493,13 @@ instance
= nameF "PartialTx" $ mconcat
[ nameF "inputs" (blockListF' "-" inF (Map.toList ins))
, nameF "redeemers" (pretty redeemers)
, nameF "tx" (cardanoTxF tx)
, nameF "tx" (txF tx)
]
where
inF = build . show

cardanoTxF :: CardanoApi.Tx era -> Builder
cardanoTxF tx' = pretty $ pShow tx'
txF :: Tx (ShelleyLedgerEra era) -> Builder
txF tx' = pretty $ pShow tx'

data UTxOIndex era = UTxOIndex
{ walletUTxO :: !W.UTxO
Expand Down Expand Up @@ -654,10 +653,13 @@ assignMinimalAdaQuantitiesToOutputsWithoutAda
:: forall era
. RecentEra era
-> PParams (CardanoApi.ShelleyLedgerEra era)
-> CardanoApi.Tx era
-> CardanoApi.Tx era
assignMinimalAdaQuantitiesToOutputsWithoutAda era pp = withConstraints era $
modifyLedgerBody $ over outputsTxBodyL $ fmap modifyTxOut
-> Tx (CardanoApi.ShelleyLedgerEra era)
-> Tx (CardanoApi.ShelleyLedgerEra era)
assignMinimalAdaQuantitiesToOutputsWithoutAda era pp =
withConstraints era
$ modifyLedgerBody @era
$ over outputsTxBodyL
$ fmap modifyTxOut
where
modifyTxOut out = flip (modifyTxOutCoin era) out $ \c ->
if c == mempty then computeMinimumCoinForTxOut era pp out else c
Expand Down Expand Up @@ -687,12 +689,12 @@ balanceTransactionWithSelectionStrategyAndNoZeroAdaAdjustment
selectionStrategy
ptx@(PartialTx partialTx inputUTxO redeemers)
= do
guardExistingCollateral partialLedgerTx
guardExistingTotalCollateral partialLedgerTx
guardExistingReturnCollateral partialLedgerTx
guardExistingCollateral partialTx
guardExistingTotalCollateral partialTx
guardExistingReturnCollateral partialTx
guardWalletUTxOConsistencyWith inputUTxO

(balance0, minfee0, _) <- balanceAfterSettingMinFee partialLedgerTx
(balance0, minfee0, _) <- balanceAfterSettingMinFee partialTx

(extraInputs, extraCollateral', extraOutputs, s') <- do

Expand Down Expand Up @@ -729,7 +731,7 @@ balanceTransactionWithSelectionStrategyAndNoZeroAdaAdjustment
(recentEra @era)
protocolParameters
utxoAssumptions
(extractOutputsFromTx partialTx)
(extractOutputsFromTx (toCardanoApiTx partialTx))
redeemers
(UTxOSelection.fromIndexPair
(internalUtxoAvailable, externalSelectedUtxo))
Expand Down Expand Up @@ -828,8 +830,6 @@ balanceTransactionWithSelectionStrategyAndNoZeroAdaAdjustment
where
era = recentEra @era

partialLedgerTx = fromCardanoApiTx partialTx

-- | Extract the inputs from the raw 'tx' of the 'Partialtx', with the
-- corresponding 'TxOut' according to @combinedUTxO@.
--
Expand Down Expand Up @@ -870,7 +870,7 @@ balanceTransactionWithSelectionStrategyAndNoZeroAdaAdjustment
where
txIns :: [TxIn]
txIns = withConstraints (recentEra @era) $
Set.toList $ (fromCardanoApiTx tx) ^. (bodyTxL . inputsTxBodyL)
Set.toList $ tx ^. (bodyTxL . inputsTxBodyL)

guardTxSize
:: KeyWitnessCount
Expand Down Expand Up @@ -975,7 +975,7 @@ balanceTransactionWithSelectionStrategyAndNoZeroAdaAdjustment
:: TxUpdate
-> ExceptT (ErrBalanceTx era) m (Tx (ShelleyLedgerEra era))
assembleTransaction update = ExceptT . pure $ do
tx' <- left ErrBalanceTxUpdateError $ updateTx era partialLedgerTx update
tx' <- left ErrBalanceTxUpdateError $ updateTx era partialTx update
left ErrBalanceTxAssignRedeemers $
assignScriptRedeemers
era pp timeTranslation combinedUTxO redeemers tx'
Expand Down
Original file line number Diff line number Diff line change
Expand Up @@ -3427,7 +3427,7 @@ balanceTransaction
$ body ^. #transaction

pure $ Write.PartialTx
tx
(Write.fromCardanoApiTx tx)
externalUTxO
(fromApiRedeemer <$> body ^. #redeemers)

Expand Down
4 changes: 2 additions & 2 deletions lib/wallet/src/Cardano/Wallet.hs
Original file line number Diff line number Diff line change
Expand Up @@ -2356,7 +2356,7 @@ buildTransactionPure
changeAddrGen
(getState wallet)
PartialTx
{ tx = Cardano.Tx unsignedTxBody []
{ tx = Write.fromCardanoApiTx (Cardano.Tx unsignedTxBody [])
, inputs = Write.UTxO mempty
, redeemers = []
}
Expand Down Expand Up @@ -2992,7 +2992,7 @@ transactionFee DBLayer{atomically, walletState} protocolParams
(Left preSelection)

let ptx = PartialTx
{ tx = Cardano.Tx unsignedTxBody []
{ tx = Write.fromCardanoApiTx (Cardano.Tx unsignedTxBody [])
, inputs = Write.UTxO mempty
, redeemers = []
}
Expand Down
Loading

0 comments on commit bc780bf

Please sign in to comment.