Move definition of txConstraints to cardano-wallet. (#4163)

## Issue

ADP-3185

## Description

This PR moves the definition of function `txConstraints` back to
`cardano-wallet`.

The `txConstraints` function and `TxConstraints` type:

- are part of the transaction size and cost abstraction used by the
wallet's **_balance migration algorithm_** (which is completely separate
from the UTxO selection algorithm used by `balanceTransaction`);
- are **_only_** used by the wallet's **_balance migration algorithm_**;
- are **_not_** used at all within the `cardano-balance-tx` library.

So we can safely move the `txConstraints` function away from
`cardano-balance-tx`.

This is consistent with our goal of minimising the public interface of
`cardano-balance-tx`.

## Notes

An alternative approach to this PR would be to move `txConstraints` to
the `Internal` module hierarchy of `cardano-balance-tx`, and then have
`cardano-wallet` depend on the `Internal` module hierarchy. However,
depending on an internal module seems unnecessary when we can just move
this function to the only package that depends on it.

lib/balance-tx/lib/Cardano/Write/Tx/SizeEstimation.hs

@@ -9,11 +9,9 @@
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
 {-# LANGUAGE NamedFieldPuns #-}
-{-# LANGUAGE OverloadedLabels #-}
 {-# LANGUAGE Rank2Types #-}
 {-# LANGUAGE RoleAnnotations #-}
 {-# LANGUAGE ScopedTypeVariables #-}
-{-# LANGUAGE TypeApplications #-}
 {-# LANGUAGE TypeFamilies #-}
 {-# LANGUAGE UndecidableInstances #-}
 {- HLINT ignore "Use <$>" -}
@@ -35,14 +33,10 @@ module Cardano.Write.Tx.SizeEstimation
     , TxWitnessTag (..)
     , assumedTxWitnessTag
 
-     -- * Needed for balance migration
-    , txConstraints
-
      -- * Needed for estimateSignedTxSize
     , sizeOf_BootstrapWitnesses
-
-      -- * For the wallet
-    , _txRewardWithdrawalCost
+    , sizeOf_VKeyWitnesses
+    , sizeOf_Withdrawals
     )
 
     where
@@ -51,212 +45,40 @@ import Prelude
 
 import Cardano.Address.Script
     ( Script (..) )
-import Cardano.Ledger.Api
-    ( ppMaxTxSizeL, ppMaxValSizeL, ppMinFeeBL )
 import Cardano.Wallet.Primitive.Types.Address
     ( Address (..) )
 import Cardano.Wallet.Primitive.Types.Coin
     ( Coin (..) )
-import Cardano.Wallet.Primitive.Types.TokenBundle
-    ( TokenBundle (..) )
 import Cardano.Wallet.Primitive.Types.TokenMap
     ( AssetId (..) )
 import Cardano.Wallet.Primitive.Types.TokenPolicy
     ( TokenName (..) )
-import Cardano.Wallet.Primitive.Types.TokenQuantity
-    ( TokenQuantity (..) )
 import Cardano.Wallet.Primitive.Types.Tx.Constraints
-    ( TxConstraints (..), TxSize (..), txOutMaxCoin )
-import Cardano.Write.ProtocolParameters
-    ( ProtocolParameters (..) )
+    ( TxSize (..) )
 import Cardano.Write.Tx
-    ( FeePerByte (..)
-    , IsRecentEra (recentEra)
-    , RecentEra (..)
-    , ShelleyLedgerEra
-    , TxOut
-    , computeMinimumCoinForTxOut
-    , getFeePerByte
-    , isBelowMinimumCoinForTxOut
-    , withConstraints
-    )
+    ( FeePerByte (..) )
 import Cardano.Write.Tx.Sign
     ( estimateMaxWitnessRequiredPerInput )
 import Cardano.Write.UTxOAssumptions
     ( UTxOAssumptions (..) )
-import Control.Lens
-    ( (^.) )
-import Data.Generics.Internal.VL.Lens
-    ( view )
 import Data.Generics.Labels
     ()
-import Data.Monoid.Monus
-    ( Monus ((<\>)) )
 import Data.Set
     ( Set )
-import Data.Word
-    ( Word64, Word8 )
 import GHC.Generics
     ( Generic )
-import GHC.Stack
-    ( HasCallStack )
 import Numeric.Natural
     ( Natural )
 
 import qualified Cardano.Address.Script as CA
-import qualified Cardano.Wallet.Primitive.Types.Address as W
 import qualified Cardano.Wallet.Primitive.Types.Coin as Coin
 import qualified Cardano.Wallet.Primitive.Types.TokenBundle as TokenBundle
 import qualified Cardano.Wallet.Primitive.Types.Tx.TxOut as W
-import qualified Cardano.Wallet.Shelley.Compatibility.Ledger as Convert
-import qualified Cardano.Write.Tx as Write
 import qualified Codec.CBOR.Encoding as CBOR
 import qualified Codec.CBOR.Write as CBOR
 import qualified Data.ByteString as BS
 import qualified Data.Foldable as F
 
--- | Like the 'TxConstraints' field 'txRewardWithdrawalCost', but with added
--- support for shared wallets via the 'CA.ScriptTemplate' argument.
---
--- We may or may not want to support shared wallets in the full txConstraints.
-_txRewardWithdrawalCost
-    :: Write.FeePerByte
-    -> Either CA.ScriptTemplate TxWitnessTag
-    -> Coin
-    -> Coin
-_txRewardWithdrawalCost feePerByte witType =
-    Convert.toWallet
-    . Write.feeOfBytes feePerByte
-    . unTxSize
-    . _txRewardWithdrawalSize witType
-
--- | Like the 'TxConstraints' field 'txRewardWithdrawalSize', but with added
--- support for shared wallets via the 'CA.ScriptTemplate' argument.
---
--- We may or may not want to support shared wallets in the full txConstraints.
-_txRewardWithdrawalSize
-    :: Either CA.ScriptTemplate TxWitnessTag
-    -> Coin
-    -> TxSize
-_txRewardWithdrawalSize _ (Coin 0) = TxSize 0
-_txRewardWithdrawalSize witType _ =
-    sizeOf_Withdrawals 1 <> wits
-  where
-    wits = case witType of
-        Right TxWitnessByronUTxO ->
-            sizeOf_BootstrapWitnesses 1 - sizeOf_BootstrapWitnesses 0
-        Right TxWitnessShelleyUTxO ->
-            sizeOf_VKeyWitnesses 1
-        Left scriptTemplate ->
-            let n = fromIntegral $ estimateMaxWitnessRequiredPerInput
-                    $ view #template scriptTemplate
-            in sizeOf_VKeyWitnesses n
-txConstraints
-    :: forall era. IsRecentEra era
-    => ProtocolParameters era
-    -> TxWitnessTag
-    -> TxConstraints
-txConstraints (ProtocolParameters protocolParams) witnessTag = TxConstraints
-    { txBaseCost
-    , txBaseSize
-    , txInputCost
-    , txInputSize
-    , txOutputCost
-    , txOutputSize
-    , txOutputMaximumSize
-    , txOutputMaximumTokenQuantity
-    , txOutputMinimumAdaQuantity
-    , txOutputBelowMinimumAdaQuantity
-    , txRewardWithdrawalCost
-    , txRewardWithdrawalSize
-    , txMaximumSize
-    }
-  where
-    era = recentEra @era
-
-    txBaseCost =
-        constantTxFee <> estimateTxCost feePerByte empty
-
-    constantTxFee = withConstraints era $
-        Convert.toWallet $ protocolParams ^. ppMinFeeBL
-
-    feePerByte = getFeePerByte (recentEra @era) protocolParams
-
-    txBaseSize =
-        estimateTxSize empty
-
-    txInputCost =
-        marginalCostOf empty {txInputCount = 1}
-
-    txInputSize =
-        marginalSizeOf empty {txInputCount = 1}
-
-    txOutputCost bundle =
-        marginalCostOf empty {txOutputs = [mkTxOut bundle]}
-
-    txOutputSize bundle =
-        marginalSizeOf empty {txOutputs = [mkTxOut bundle]}
-
-    txOutputMaximumSize = withConstraints era $ (<>)
-        (txOutputSize mempty)
-        (TxSize (protocolParams ^. ppMaxValSizeL))
-
-    txOutputMaximumTokenQuantity =
-        TokenQuantity $ fromIntegral $ maxBound @Word64
-
-    txOutputMinimumAdaQuantity addr tokens = Convert.toWallet $
-        computeMinimumCoinForTxOut
-            era
-            protocolParams
-            (mkLedgerTxOut era addr (TokenBundle txOutMaxCoin tokens))
-
-    txOutputBelowMinimumAdaQuantity addr bundle =
-            isBelowMinimumCoinForTxOut
-                era
-                protocolParams
-                (mkLedgerTxOut era addr bundle)
-
-    txRewardWithdrawalCost =
-        _txRewardWithdrawalCost feePerByte (Right witnessTag)
-
-    txRewardWithdrawalSize =
-        _txRewardWithdrawalSize (Right witnessTag)
-
-    txMaximumSize = withConstraints era $
-        TxSize $ protocolParams ^. ppMaxTxSizeL
-
-    empty :: TxSkeleton
-    empty = emptyTxSkeleton witnessTag
-
-    -- Computes the size difference between the given skeleton and an empty
-    -- skeleton.
-    marginalCostOf :: TxSkeleton -> Coin
-    marginalCostOf skeleton =
-        estimateTxCost feePerByte skeleton <\>
-        estimateTxCost feePerByte empty
-
-    -- Computes the size difference between the given skeleton and an empty
-    -- skeleton.
-    marginalSizeOf :: TxSkeleton -> TxSize
-    marginalSizeOf =
-        (<\> txBaseSize) . estimateTxSize
-
-    -- Constructs a real transaction output from a token bundle.
-    mkTxOut :: TokenBundle -> W.TxOut
-    mkTxOut = W.TxOut dummyAddress
-      where
-        dummyAddress :: Address
-        dummyAddress = Address $ BS.replicate dummyAddressLength nullByte
-
-        dummyAddressLength :: Int
-        dummyAddressLength = 57
-        -- Note: We are at liberty to overestimate the length of an address
-        -- (which is safe). Therefore, we can choose a length that we know is
-        -- greater than or equal to all address lengths.
-
-        nullByte :: Word8
-        nullByte = 0
-
 --------------------------------------------------------------------------------
 -- Size estimation
 --------------------------------------------------------------------------------
@@ -279,19 +101,6 @@ data TxSkeleton = TxSkeleton
     }
     deriving (Eq, Show, Generic)
 
--- | Constructs an empty transaction skeleton.
---
--- This may be used to estimate the size and cost of an empty transaction.
---
-emptyTxSkeleton :: TxWitnessTag -> TxSkeleton
-emptyTxSkeleton txWitnessTag = TxSkeleton
-    { txWitnessTag
-    , txInputCount = 0
-    , txOutputs = []
-    , txChange = []
-    , txPaymentTemplate = Nothing
-    }
-
 -- | Estimates the final cost of a transaction based on its skeleton.
 --
 -- The constant tx fee is /not/ included in the result of this function.
@@ -687,19 +496,6 @@ sizeOf_Array = 3
 sumVia :: (Foldable t, Num m) => (a -> m) -> t a -> m
 sumVia f = F.foldl' (\t -> (t +) . f) 0
 
-mkLedgerTxOut
-    :: HasCallStack
-    => RecentEra era
-    -> W.Address
-    -> TokenBundle
-    -> TxOut (ShelleyLedgerEra era)
-mkLedgerTxOut txOutEra address bundle =
-    case txOutEra of
-        RecentEraBabbage -> Convert.toBabbageTxOut txOut
-        RecentEraConway -> Convert.toConwayTxOut txOut
-      where
-        txOut = W.TxOut address bundle
-
 data TxWitnessTag
     = TxWitnessByronUTxO
     | TxWitnessShelleyUTxO

lib/wallet/src/Cardano/Wallet.hs

@@ -489,7 +489,7 @@ import Cardano.Wallet.Shelley.Compatibility
 import Cardano.Wallet.Shelley.Compatibility.Ledger
     ( toLedgerAddress, toWallet, toWalletCoin )
 import Cardano.Wallet.Shelley.Transaction
-    ( txWitnessTagForKey )
+    ( txConstraints, txWitnessTagForKey, _txRewardWithdrawalCost )
 import Cardano.Wallet.Transaction
     ( DelegationAction (..)
     , ErrCannotJoin (..)
@@ -521,7 +521,7 @@ import Cardano.Write.Tx.Balance
     , constructUTxOIndex
     )
 import Cardano.Write.Tx.SizeEstimation
-    ( TxWitnessTag (..), _txRewardWithdrawalCost )
+    ( TxWitnessTag (..) )
 import Cardano.Write.Tx.TimeTranslation
     ( TimeTranslation )
 import Control.Arrow
@@ -656,7 +656,6 @@ import qualified Cardano.Wallet.Primitive.Types.UTxOStatistics as UTxOStatistics
 import qualified Cardano.Wallet.Read as Read
 import qualified Cardano.Write.ProtocolParameters as Write
 import qualified Cardano.Write.Tx as Write
-import qualified Cardano.Write.Tx.SizeEstimation as Write
 import qualified Data.ByteArray as BA
 import qualified Data.Delta.Update as Delta
 import qualified Data.Foldable as F
@@ -1804,7 +1803,7 @@ calcMinimumCoinValues pp txLayer =
     uncurry (constraints ^. #txOutputMinimumAdaQuantity)
      . (\o -> (o ^. #address, o ^. #tokens . #tokens))
   where
-    constraints = Write.txConstraints pp $ transactionWitnessTag txLayer
+    constraints = txConstraints pp $ transactionWitnessTag txLayer
 
 signTransaction
   :: forall k ktype
@@ -2649,10 +2648,10 @@ createMigrationPlan
 createMigrationPlan ctx rewardWithdrawal = do
     (wallet, _, pending) <- readWallet ctx
     (Write.InAnyRecentEra _era pp, _) <- readNodeTipStateForTxWrite nl
-    let txConstraints = Write.txConstraints pp (transactionWitnessTag tl)
+    let constraints = txConstraints pp (transactionWitnessTag tl)
         utxo = availableUTxO pending wallet
     pure
-        $ Migration.createPlan txConstraints utxo
+        $ Migration.createPlan constraints utxo
         $ Migration.RewardWithdrawal
         $ withdrawalToCoin rewardWithdrawal
   where