diff --git a/lib/wallet/api/http/Cardano/Wallet/Api/Http/Server/Error.hs b/lib/wallet/api/http/Cardano/Wallet/Api/Http/Server/Error.hs
index c8dcaed6da9..cd8c9eaa130 100644
--- a/lib/wallet/api/http/Cardano/Wallet/Api/Http/Server/Error.hs
+++ b/lib/wallet/api/http/Cardano/Wallet/Api/Http/Server/Error.hs
@@ -109,6 +109,8 @@ import Cardano.Wallet.Primitive.Types.Tx.SealedTx
     ( serialisedTx )
 import Cardano.Wallet.Shelley.Transaction
     ( KeyWitnessCount (..) )
+import Cardano.Wallet.Shelley.Transaction
+    ( KeyWitnessCount (..) )
 import Cardano.Wallet.Transaction
     ( ErrAssignRedeemers (..), ErrSignTx (..) )
 import Cardano.Wallet.Write.Tx.Balance
diff --git a/lib/wallet/api/http/Cardano/Wallet/Api/Http/Shelley/Server.hs b/lib/wallet/api/http/Cardano/Wallet/Api/Http/Shelley/Server.hs
index a20b606aa2b..da33fe84215 100644
--- a/lib/wallet/api/http/Cardano/Wallet/Api/Http/Shelley/Server.hs
+++ b/lib/wallet/api/http/Cardano/Wallet/Api/Http/Shelley/Server.hs
@@ -682,7 +682,7 @@ import qualified Cardano.Wallet.Primitive.Types.UTxOSelection as UTxOSelection
 import qualified Cardano.Wallet.Read as Read
 import qualified Cardano.Wallet.Registry as Registry
 import qualified Cardano.Wallet.Write.Tx as WriteTx
-import qualified Cardano.Wallet.Write.Tx.Balance as W
+import qualified Cardano.Wallet.Write.Tx.Balance as WriteTx
 import qualified Control.Concurrent.Concierge as Concierge
 import qualified Data.ByteString as BS
 import qualified Data.Foldable as F
@@ -1760,7 +1760,7 @@ selectCoins ctx@ApiLayer {..} argGenChange (ApiT walletId) body = do
                 & maybe (pure NoWithdrawal)
                     (shelleyOnlyMkWithdrawal @s @k @n
                         netLayer txLayer db walletId era)
-        let genChange = W.defaultChangeAddressGen argGenChange
+        let genChange = W.defaultChangeAddressGen argGenChange (Proxy @k)
         let paymentOuts = NE.toList $ addressAmountToTxOut <$> body ^. #payments
         let txCtx = defaultTransactionCtx
                 { txWithdrawal = withdrawal
@@ -1829,7 +1829,9 @@ selectCoinsForJoin ctx@ApiLayer{..}
             poolId
             poolStatus
             walletId
-        let changeAddrGen = W.defaultChangeAddressGen (delegationAddress @n)
+        let changeAddrGen = W.defaultChangeAddressGen
+                (delegationAddress @n)
+                (Proxy @k)
 
         let txCtx = defaultTransactionCtx { txDelegationAction = Just action }
 
@@ -1882,7 +1884,9 @@ selectCoinsForQuit ctx@ApiLayer{..} (ApiT walletId) = do
         withdrawal <- W.shelleyOnlyMkSelfWithdrawal @_ @_ @_ @_ @n
             netLayer txLayer era db walletId
         action <- WD.quitStakePoolDelegationAction db walletId withdrawal
-        let changeAddrGen = W.defaultChangeAddressGen (delegationAddress @n)
+        let changeAddrGen = W.defaultChangeAddressGen
+                (delegationAddress @n)
+                (Proxy @k)
         let txCtx = defaultTransactionCtx
                 { txDelegationAction = Just action
                 , txWithdrawal = withdrawal
@@ -2823,7 +2827,7 @@ constructSharedTransaction
     -> ApiConstructTransactionData n
     -> Handler (ApiConstructTransaction n)
 constructSharedTransaction
-    ctx genChange _knownPools _getPoolStatus (ApiT wid) body = do
+    ctx argGenChange _knownPools _getPoolStatus (ApiT wid) body = do
     let isNoPayload =
             isNothing (body ^. #payments) &&
             isNothing (body ^. #withdrawal) &&
@@ -2870,7 +2874,7 @@ constructSharedTransaction
                     txLayer netLayer db wid txCtx PreSelection {outputs = outs}
 
                 balancedTx <-
-                    balanceTransaction ctx genChange scriptLookup
+                    balanceTransaction ctx argGenChange scriptLookup
                     (Just (Shared.paymentTemplate $ getState cp)) (ApiT wid)
                         ApiBalanceTransactionPostData
                         { transaction =
@@ -3005,10 +3009,10 @@ balanceTransaction
 
         let mkPartialTx
                 :: forall era. WriteTx.IsRecentEra era => Cardano.Tx era
-                -> Handler (W.PartialTx era)
+                -> Handler (WriteTx.PartialTx era)
             mkPartialTx tx = do
                 utxo <- fmap WriteTx.toCardanoUTxO $ mkLedgerUTxO $ body ^. #inputs
-                pure $ W.PartialTx
+                pure $ WriteTx.PartialTx
                     tx
                     utxo
                     (fromApiRedeemer <$> body ^. #redeemers)
@@ -3035,7 +3039,7 @@ balanceTransaction
                 mkRecentEra = case Cardano.cardanoEra @era of
                     Cardano.BabbageEra -> pure WriteTx.RecentEraBabbage
                     Cardano.AlonzoEra -> pure WriteTx.RecentEraAlonzo
-                    _ -> liftHandler $ throwE $ W.ErrOldEraNotSupported era
+                    _ -> liftHandler $ throwE $ WriteTx.ErrOldEraNotSupported era
 
                 mkLedgerUTxO
                     :: [ApiExternalInput n]
@@ -3051,18 +3055,20 @@ balanceTransaction
 
         let balanceTx
                 :: forall era. WriteTx.IsRecentEra era
-                => W.PartialTx era
+                => WriteTx.PartialTx era
                 -> Handler (Cardano.Tx era)
             balanceTx partialTx =
-                liftHandler $ fst <$> W.balanceTransaction @_ @IO @s @k @ktype
+                liftHandler $ fst <$> WriteTx.balanceTransaction @_ @IO @s
                     (MsgWallet . W.MsgBalanceTx >$< wrk ^. W.logger)
-                    (ctx ^. typed)
-                    genInpScripts
-                    mScriptTemplate
+                    (WriteTx.CoinSelection
+                        txLayer
+                        genInpScripts
+                        mScriptTemplate
+                        (const True) "") -- FIXME
                     (pp, nodePParams)
                     ti
                     utxoIndex
-                    (W.defaultChangeAddressGen argGenChange)
+                    (W.defaultChangeAddressGen argGenChange (Proxy @k))
                     (getState wallet)
                     partialTx
               where
@@ -3074,7 +3080,7 @@ balanceTransaction
                         ])
                     $ W.currentNodeProtocolParameters pp
 
-        anyRecentTx <- maybeToHandler (W.ErrOldEraNotSupported era)
+        anyRecentTx <- maybeToHandler (WriteTx.ErrOldEraNotSupported era)
             . WriteTx.asAnyRecentEra
             . cardanoTxIdeallyNoLaterThan era
             . getApiT $ body ^. #transaction
@@ -3444,17 +3450,16 @@ joinStakePool
         let tr = wrk ^. logger
             db = wrk ^. typed @(DBLayer IO s k)
             ti = timeInterpreter netLayer
-            genChange = W.defaultChangeAddressGen argGenChange
 
         (BuiltTx{..}, txTime) <- liftIO $
-            W.buildSignSubmitTransaction @k @'CredFromKeyK @s @n
+            W.buildSignSubmitTransaction @k @s @n
                 ti
                 db
                 netLayer
                 txLayer
                 (coerce $ getApiT $ body ^. #passphrase)
                 walletId
-                genChange
+                (W.defaultChangeAddressGen argGenChange (Proxy @k))
                 (AnyRecentEra recentEra)
                 (PreSelection [])
                 =<< WD.joinStakePool
@@ -3511,7 +3516,7 @@ delegationFee ctx@ApiLayer{..} (ApiT walletId) = do
                 txLayer
                 (timeInterpreter netLayer)
                 (AnyRecentEra recentEra)
-                (W.defaultChangeAddressGen (delegationAddress @n))
+                (W.defaultChangeAddressGen (delegationAddress @n) (Proxy @k))
                 walletId
         pure $ mkApiFee (Just deposit) [] feePercentiles
 
@@ -3545,14 +3550,14 @@ quitStakePool ctx@ApiLayer{..} argGenChange (ApiT walletId) body = do
             Just Refl -> liftIO $ WD.quitStakePool netLayer db ti walletId
             _ -> liftHandler $ throwE ErrReadRewardAccountNotAShelleyWallet
         (BuiltTx{..}, txTime) <- liftIO $ do
-            W.buildSignSubmitTransaction @k @'CredFromKeyK @s @n
+            W.buildSignSubmitTransaction @k @s @n
                 ti
                 db
                 netLayer
                 txLayer
                 (coerce $ getApiT $ body ^. #passphrase)
                 walletId
-                (W.defaultChangeAddressGen argGenChange)
+                (W.defaultChangeAddressGen argGenChange (Proxy @k))
                 (AnyRecentEra recentEra)
                 (PreSelection [])
                 txCtx
@@ -4147,7 +4152,7 @@ guardIsRecentEra (Cardano.AnyCardanoEra era) = case era of
     Cardano.ShelleyEra -> liftE invalidEra
     Cardano.ByronEra   -> liftE invalidEra
   where
-    invalidEra = W.ErrOldEraNotSupported $ Cardano.AnyCardanoEra era
+    invalidEra = WriteTx.ErrOldEraNotSupported $ Cardano.AnyCardanoEra era
 
 mkWithdrawal
     :: forall (n :: NetworkDiscriminant) ktype tx block
diff --git a/lib/wallet/src/Cardano/Api/Gen.hs b/lib/wallet/src/Cardano/Api/Gen.hs
index 5e8f477305d..adac77aaf8f 100644
--- a/lib/wallet/src/Cardano/Api/Gen.hs
+++ b/lib/wallet/src/Cardano/Api/Gen.hs
@@ -301,10 +301,9 @@ genSlotNo32 = do
 
 genLovelace :: Gen Lovelace
 genLovelace = frequency
-    [ (10, Lovelace . intCast . getNonNegative @Int <$> arbitrary)
-    , (50, choose (1_000_000, 1_000_000_000))
-    , (10, choose (txOutMinLovelace, txOutMaxLovelace))
-    , (30, genEncodingBoundaryLovelace)
+    [ (3, Lovelace . intCast . getNonNegative @Int <$> arbitrary)
+    , (95, choose (1_000_000, 10_000_000_000))
+    , (2, genEncodingBoundaryLovelace)
     ]
 
 genEncodingBoundaryLovelace :: Gen Lovelace
@@ -517,7 +516,9 @@ genAssetName :: Gen AssetName
 genAssetName =
   frequency
     -- mostly from a small number of choices, so we get plenty of repetition
-    [ (9, elements ["", "a", "b", "c"])
+    [ (7, pure "")
+    , (5, pure "a")
+    , (3, elements ["b", "c"])
     , (1, AssetName . fromString <$> (scale (min 32) (listOf genAlphaNum)))
     , (1, AssetName . fromString <$> (vectorOf 1 genAlphaNum))
     , (1, AssetName . fromString <$> (vectorOf 32 genAlphaNum))
@@ -533,8 +534,9 @@ genPolicyId = frequency
       --
       -- And because of the additional choice of asset name we repeat ourselves
       -- even more here.
-    [ (80, pure $ fromString ('a' : replicate 55 '0'))
-    , (18, elements [ fromString (x : replicate 55 '0') | x <- ['a'..'c'] ])
+    [ (70, pure $ fromString ('a' : replicate 55 '0'))
+    , (20, pure $ fromString ('b' : replicate 55 '0'))
+    , (8, pure $ fromString ('c' : replicate 55 '0'))
        -- and some from the full range of the type
     , (2, PolicyId <$> genScriptHash)
     ]
@@ -583,7 +585,7 @@ genSignedValue = do
 -- | Generate a 'Value' suitable for minting, i.e. non-ADA asset ID and a
 -- positive or negative quantity.
 genValueForMinting :: Gen Value
-genValueForMinting =
+genValueForMinting = scale (`div` 2) $
   valueFromList <$> listOf ((,) <$> genAssetIdNoAda <*> genSignedQuantity)
 
 genTxMintValue :: forall era. CardanoEra era -> Gen (TxMintValue BuildTx era)
@@ -892,7 +894,7 @@ genPaymentCredential :: Gen PaymentCredential
 genPaymentCredential =
     oneof
         [ byKey
-        , byScript
+--        , byScript -- FIXME
         ]
     where
         byKey :: Gen PaymentCredential
@@ -928,7 +930,7 @@ genAddressInEra era =
 
     ShelleyBasedEra _ ->
       oneof
-        [ byronAddressInEra   <$> genAddressByron
+        [ byronAddressInEra <$> genAddressByron
         , shelleyAddressInEra <$> genAddressShelley
         ]
 
@@ -1402,7 +1404,7 @@ genTxBodyContent era = do
         txIns <- listOf1 genTxIn
         ctxs <- vectorOf (length txIns) (genWitnessSpend era)
         pure $ zip txIns (BuildTxWith <$> ctxs)
-    txOuts <- scale (`div` 3) $ listOf1 $ genTxOut era
+    txOuts <- listOf1 $ scale (`div` 4) $ genTxOut era
     txFee <- genTxFee era
     txValidityRange <- genTxValidityRange era
     txMetadata <- genTxMetadataInEra era
diff --git a/lib/wallet/src/Cardano/Wallet.hs b/lib/wallet/src/Cardano/Wallet.hs
index dacc7c0f0f7..92a3a32f72b 100644
--- a/lib/wallet/src/Cardano/Wallet.hs
+++ b/lib/wallet/src/Cardano/Wallet.hs
@@ -489,6 +489,7 @@ import Cardano.Wallet.Write.Tx.Balance
     , PartialTx (..)
     , assignChangeAddresses
     , balanceTransaction
+    , vkCoinSelection
     )
 import Control.Arrow
     ( first )
@@ -619,6 +620,7 @@ import qualified Cardano.Tx.Balance.Internal.CoinSelection as CS
 import qualified Cardano.Wallet.Checkpoints.Policy as CP
 import qualified Cardano.Wallet.DB.WalletState as WS
 import qualified Cardano.Wallet.DB.WalletState as WalletState
+import qualified Cardano.Wallet.DB.WalletState as WS
 import qualified Cardano.Wallet.Primitive.AddressDiscovery.Random as Rnd
 import qualified Cardano.Wallet.Primitive.AddressDiscovery.Sequential as Seq
 import qualified Cardano.Wallet.Primitive.AddressDiscovery.Shared as Shared
@@ -635,6 +637,7 @@ import qualified Cardano.Wallet.Primitive.Types.UTxOSelection as UTxOSelection
 import qualified Cardano.Wallet.Primitive.Types.UTxOStatistics as UTxOStatistics
 import qualified Cardano.Wallet.Read as Read
 import qualified Cardano.Wallet.Write.Tx as WriteTx
+import qualified Cardano.Wallet.Write.Tx.Balance as WriteTx
 import qualified Data.ByteArray as BA
 import qualified Data.Foldable as F
 import qualified Data.List as L
@@ -1573,6 +1576,7 @@ normalizeDelegationAddress s addr = do
 assignChangeAddressesAndUpdateDb
     :: forall ctx s k.
         ( GenChange s
+        , BoundedAddressLength k
         , HasDBLayer IO s k ctx
         , AddressBookIso s
         )
@@ -1594,7 +1598,7 @@ assignChangeAddressesAndUpdateDb ctx wid argGenChange selection =
         s = getState $ getLatest wallet
         (selectionUpdated, stateUpdated) =
             assignChangeAddresses
-                (defaultChangeAddressGen argGenChange)
+                (defaultChangeAddressGen argGenChange (Proxy @k))
                 selection
                 s
 
@@ -1602,6 +1606,7 @@ assignChangeAddressesWithoutDbUpdate
     :: forall ctx s k.
         ( GenChange s
         , HasDBLayer IO s k ctx
+        , BoundedAddressLength k
         )
     => ctx
     -> WalletId
@@ -1614,7 +1619,7 @@ assignChangeAddressesWithoutDbUpdate ctx wid argGenChange selection =
             withNoSuchWallet wid $ readCheckpoint wid
         let (selectionUpdated, _) =
                 assignChangeAddresses
-                    (defaultChangeAddressGen argGenChange)
+                    (defaultChangeAddressGen argGenChange (Proxy @k))
                     selection
                     (getState cp)
         pure selectionUpdated
@@ -1981,7 +1986,7 @@ type MakeRewardAccountBuilder k =
 --
 -- Requires the encryption passphrase in order to decrypt the root private key.
 buildSignSubmitTransaction
-    :: forall k ktype s (n :: NetworkDiscriminant)
+    :: forall k s (n :: NetworkDiscriminant)
      . ( Typeable n
        , Typeable s
        , Typeable k
@@ -1989,14 +1994,14 @@ buildSignSubmitTransaction
        , HardDerivation k
        , BoundedAddressLength k
        , Bounded (Index (AddressIndexDerivationType k) (AddressCredential k))
-       , IsOwned s k ktype
+       , IsOwned s k 'CredFromKeyK
        , IsOurs s RewardAccount
        , AddressBookIso s
        )
     => TimeInterpreter (ExceptT PastHorizonException IO)
     -> DBLayer IO s k
     -> NetworkLayer IO Read.Block
-    -> TransactionLayer k ktype SealedTx
+    -> TransactionLayer k 'CredFromKeyK SealedTx
     -> Passphrase "user"
     -> WalletId
     -> ChangeAddressGen s
@@ -2020,7 +2025,7 @@ buildSignSubmitTransaction ti db@DBLayer{..} netLayer txLayer pwd walletId
                         Nothing
             txWithSlot@(builtTx, slot) <- throwOnErr <=< modifyDBMaybe walletsDB
                 $ adjustNoSuchWallet walletId wrapNoWalletForConstruct $ \s ->
-                    buildAndSignTransactionPure @k @ktype @s @n
+                    buildAndSignTransactionPure @k @s @n
                         pureTimeInterpreter
                         (Set.fromList pendingTxs)
                         rootKey
@@ -2069,7 +2074,7 @@ buildSignSubmitTransaction ti db@DBLayer{..} netLayer txLayer pwd walletId
     wrapBalanceConstructError = either ExceptionBalanceTx ExceptionConstructTx
 
 buildAndSignTransactionPure
-    :: forall k ktype s (n :: NetworkDiscriminant)
+    :: forall k s (n :: NetworkDiscriminant)
      . ( Typeable n
        , Typeable s
        , Typeable k
@@ -2077,7 +2082,7 @@ buildAndSignTransactionPure
        , HardDerivation k
        , BoundedAddressLength k
        , Bounded (Index (AddressIndexDerivationType k) (AddressCredential k))
-       , IsOwned s k ktype
+       , IsOwned s k 'CredFromKeyK
        , IsOurs s RewardAccount
        )
     => TimeInterpreter (Either PastHorizonException)
@@ -2086,7 +2091,7 @@ buildAndSignTransactionPure
     -> PassphraseScheme
     -> Passphrase "user"
     -> ProtocolParameters
-    -> TransactionLayer k ktype SealedTx
+    -> TransactionLayer k 'CredFromKeyK SealedTx
     -> ChangeAddressGen s
     -> AnyRecentEra
     -> PreSelection
@@ -2102,13 +2107,13 @@ buildAndSignTransactionPure
     WriteTx.withRecentEra era $ \(_ :: WriteTx.RecentEra recentEra) -> do
         wallet <- get
         (unsignedBalancedTx, updatedWalletState) <- lift $
-            buildTransactionPure @s @k @ktype @n @recentEra
+            buildTransactionPure @s @k @'CredFromKeyK @n @recentEra
                 wallet ti pendingTxs txLayer changeAddrGen
                 protocolParams preSelection txCtx
         put wallet { getState = updatedWalletState }
 
         let passphrase = preparePassphrase passphraseScheme userPassphrase
-            signedTx = signTransaction @k @ktype
+            signedTx = signTransaction @k @'CredFromKeyK
                 txLayer
                 anyCardanoEra
                 (isOwned (getState wallet) (rootKey, passphrase))
@@ -2243,11 +2248,13 @@ buildTransactionPure
                 (Left preSelection)
 
     withExceptT Left $
-        balanceTransaction @_ @_ @s @k @ktype
+        balanceTransaction @_ @_ @s
             nullTracer
-            txLayer
-            Nothing -- "To input scripts" resolver
-            Nothing -- Script template
+            (WriteTx.CoinSelection
+                txLayer
+                Nothing -- "To input scripts" resolver
+                Nothing -- Script template
+                (const True) "") -- FIXME
             nodeProtocolParameters
             ti
             (UTxOIndex.fromMap
@@ -3789,7 +3796,11 @@ instance HasSeverityAnnotation TxSubmitLog where
 
 -- | Construct the default 'ChangeAddressGen s' for a given 's'.
 defaultChangeAddressGen
-    :: forall s. GenChange s
+    :: forall s (k :: Depth -> * -> *). (GenChange s, BoundedAddressLength k)
     => ArgGenChange s
+    -> Proxy k
     -> ChangeAddressGen s
-defaultChangeAddressGen arg = ChangeAddressGen $ \s -> genChange arg s
+defaultChangeAddressGen arg proxy =
+    ChangeAddressGen
+        (genChange arg)
+        (maxLengthAddressFor proxy)
diff --git a/lib/wallet/src/Cardano/Wallet/Gen.hs b/lib/wallet/src/Cardano/Wallet/Gen.hs
index b80b8448ddb..903f3cd9b51 100644
--- a/lib/wallet/src/Cardano/Wallet/Gen.hs
+++ b/lib/wallet/src/Cardano/Wallet/Gen.hs
@@ -26,6 +26,7 @@ module Cardano.Wallet.Gen
     , genScript
     , genScriptCosigners
     , genScriptTemplate
+    , genReadyScriptTemplate
     , genMockXPub
     , genNatural
     , genWalletId
@@ -33,8 +34,7 @@ module Cardano.Wallet.Gen
 
 import Prelude
 
-import Cardano.Address.Derivation
-    ( XPub, xpubFromBytes )
+import Cardano.Address.Derivation ( XPub, xpubFromBytes )
 import Cardano.Address.Script
     ( Cosigner (..), Script (..), ScriptTemplate (..) )
 import Cardano.Api
@@ -45,8 +45,7 @@ import Cardano.Api
     )
 import Cardano.Mnemonic
     ( ConsistentEntropy, EntropySize, Mnemonic, entropyToMnemonic )
-import Cardano.Wallet.Primitive.AddressDiscovery.Shared
-    ( retrieveAllCosigners )
+import Cardano.Wallet.Primitive.AddressDiscovery.Shared ( retrieveAllCosigners )
 import Cardano.Wallet.Primitive.Types
     ( ActiveSlotCoefficient (..)
     , BlockHeader (..)
@@ -56,42 +55,25 @@ import Cardano.Wallet.Primitive.Types
     , WalletId (..)
     , WithOrigin (..)
     )
-import Cardano.Wallet.Primitive.Types.Address
-    ( Address (..) )
-import Cardano.Wallet.Primitive.Types.Hash
-    ( Hash (..) )
-import Cardano.Wallet.Primitive.Types.ProtocolMagic
-    ( ProtocolMagic (..) )
+import Cardano.Wallet.Primitive.Types.Address ( Address (..) )
+import Cardano.Wallet.Primitive.Types.Hash ( Hash (..) )
+import Cardano.Wallet.Primitive.Types.ProtocolMagic ( ProtocolMagic (..) )
 import Cardano.Wallet.Unsafe
     ( unsafeFromHex, unsafeMkEntropy, unsafeMkPercentage )
-import Control.Monad
-    ( replicateM )
-import Crypto.Hash
-    ( hash )
-import Data.Aeson
-    ( ToJSON (..) )
-import Data.ByteArray.Encoding
-    ( Base (..), convertToBase )
-import Data.List
-    ( sortOn )
-import Data.List.Extra
-    ( nubOrdOn )
-import Data.Maybe
-    ( fromMaybe )
-import Data.Proxy
-    ( Proxy (..) )
-import Data.Quantity
-    ( Percentage (..), Quantity (..) )
-import Data.Ratio
-    ( denominator, numerator, (%) )
-import Data.Text
-    ( Text )
-import Data.Word
-    ( Word32 )
-import GHC.TypeLits
-    ( natVal )
-import Numeric.Natural
-    ( Natural )
+import Control.Monad ( replicateM )
+import Crypto.Hash ( hash )
+import Data.Aeson ( ToJSON (..) )
+import Data.ByteArray.Encoding ( Base (..), convertToBase )
+import Data.List ( sortOn )
+import Data.List.Extra ( nubOrdOn )
+import Data.Maybe ( fromMaybe )
+import Data.Proxy ( Proxy (..) )
+import Data.Quantity ( Percentage (..), Quantity (..) )
+import Data.Ratio ( denominator, numerator, (%) )
+import Data.Text ( Text )
+import Data.Word ( Word32 )
+import GHC.TypeLits ( natVal )
+import Numeric.Natural ( Natural )
 import Test.QuickCheck
     ( Arbitrary (..)
     , Gen
@@ -349,6 +331,13 @@ genScriptTemplate = do
     xpubs <- vectorOf (length cosignersSubset) genMockXPub
     pure $ ScriptTemplate (Map.fromList $ zip cosignersSubset xpubs) script
 
+genReadyScriptTemplate :: Gen ScriptTemplate
+genReadyScriptTemplate = do
+    script <- genScriptCosigners `suchThat` (not . null . retrieveAllCosigners)
+    let scriptCosigners = retrieveAllCosigners script
+    xpubs <- vectorOf (length scriptCosigners) genMockXPub
+    pure $ ScriptTemplate (Map.fromList $ zip scriptCosigners xpubs) script
+
 genMockXPub :: Gen XPub
 genMockXPub = fromMaybe impossible . xpubFromBytes . BS.pack <$> genBytes
   where
diff --git a/lib/wallet/src/Cardano/Wallet/Shelley/Compatibility.hs b/lib/wallet/src/Cardano/Wallet/Shelley/Compatibility.hs
index a22671862ec..7c5fe514f88 100644
--- a/lib/wallet/src/Cardano/Wallet/Shelley/Compatibility.hs
+++ b/lib/wallet/src/Cardano/Wallet/Shelley/Compatibility.hs
@@ -63,6 +63,7 @@ module Cardano.Wallet.Shelley.Compatibility
     , toCardanoTxId
     , toCardanoTxIn
     , toCardanoUTxO
+    , fromCardanoUTxO
     , fromCardanoTxIn
     , fromCardanoTxOut
     , fromCardanoWdrls
@@ -1464,6 +1465,12 @@ toCardanoUTxO era = Cardano.UTxO
     . Map.toList
     . W.unUTxO
 
+fromCardanoUTxO :: IsCardanoEra era => Cardano.UTxO era -> W.UTxO
+fromCardanoUTxO (Cardano.UTxO map) = W.UTxO
+    . Map.mapKeys fromCardanoTxIn
+    . Map.map fromCardanoTxOut
+    $ map
+
 toCardanoTxOut :: ShelleyBasedEra era -> W.TxOut -> Cardano.TxOut ctx era
 toCardanoTxOut era = case era of
     ShelleyBasedEraShelley -> toShelleyTxOut
diff --git a/lib/wallet/src/Cardano/Wallet/Shelley/Transaction.hs b/lib/wallet/src/Cardano/Wallet/Shelley/Transaction.hs
index 449e11f1556..a5d763908f4 100644
--- a/lib/wallet/src/Cardano/Wallet/Shelley/Transaction.hs
+++ b/lib/wallet/src/Cardano/Wallet/Shelley/Transaction.hs
@@ -1112,14 +1112,22 @@ estimateKeyWitnessCount utxo txbody@(Cardano.TxBody txbodycontent) =
             fromIntegral
             $ sumVia estimateMaxWitnessRequiredPerInput
             $ mapMaybe toTimelockScript scripts
-    in
-    numberOfShelleyWitnesses $ fromIntegral $
-        length vkInsUnique +
-        length txExtraKeyWits' +
-        length txWithdrawals' +
-        txUpdateProposal' +
-        txCerts +
-        scriptVkWitsUpperBound
+        nonInputWits = numberOfShelleyWitnesses $ fromIntegral $
+            length txExtraKeyWits' +
+            length txWithdrawals' +
+            txUpdateProposal' +
+            txCerts +
+            scriptVkWitsUpperBound
+        inputWits = KeyWitnessCount
+            { nKeyWits = fromIntegral
+                . length
+                $ filter (not . hasBootstrapAddr utxo) vkInsUnique
+            , nBootstrapWits = fromIntegral
+                . length
+                $ filter (hasBootstrapAddr utxo) vkInsUnique
+            }
+        in
+            nonInputWits <> inputWits
   where
     scripts = case txbody of
         Cardano.ShelleyTxBody _ _ shelleyBodyScripts _ _ _ -> shelleyBodyScripts
@@ -1168,6 +1176,21 @@ estimateKeyWitnessCount utxo txbody@(Cardano.TxBody txbodycontent) =
                 , "Caller is expected to ensure this does not happen."
                 ]
 
+    hasBootstrapAddr
+        :: Cardano.UTxO era
+        -> Cardano.TxIn
+        -> Bool
+    hasBootstrapAddr (Cardano.UTxO u) inp = case Map.lookup inp u of
+        Just (Cardano.TxOut addrInEra _ _ _) ->
+            case addrInEra of
+                Cardano.AddressInEra Cardano.ByronAddressInAnyEra _ -> True
+                _ -> False
+        Nothing ->
+            error $ unwords
+                [ "estimateMaxWitnessRequiredPerInput: input not in utxo."
+                , "Caller is expected to ensure this does not happen."
+                ]
+
 maxScriptExecutionCost
     :: ProtocolParameters
      -- ^ Current protocol parameters
diff --git a/lib/wallet/src/Cardano/Wallet/Write/Tx.hs b/lib/wallet/src/Cardano/Wallet/Write/Tx.hs
index 21f6a9a59dc..3f4d4200bf3 100644
--- a/lib/wallet/src/Cardano/Wallet/Write/Tx.hs
+++ b/lib/wallet/src/Cardano/Wallet/Write/Tx.hs
@@ -133,6 +133,9 @@ module Cardano.Wallet.Write.Tx
     -- * Balancing
     , evaluateMinimumFee
     , evaluateTransactionBalance
+
+    -- * Constraints
+    , withStandardCryptoConstraint
     )
     where
 
diff --git a/lib/wallet/src/Cardano/Wallet/Write/Tx/Balance.hs b/lib/wallet/src/Cardano/Wallet/Write/Tx/Balance.hs
index df3f8e2180f..4f43af68e31 100644
--- a/lib/wallet/src/Cardano/Wallet/Write/Tx/Balance.hs
+++ b/lib/wallet/src/Cardano/Wallet/Write/Tx/Balance.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE DataKinds #-}
 {-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE DuplicateRecordFields #-}
 {-# LANGUAGE ExistentialQuantification #-}
@@ -5,6 +6,7 @@
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE OverloadedLabels #-}
+{-# LANGUAGE Rank2Types #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TupleSections #-}
 {-# LANGUAGE TypeApplications #-}
@@ -49,7 +51,9 @@ import Cardano.Tx.Balance.Internal.CoinSelection
     , toExternalUTxOMap
     )
 import Cardano.Wallet.Primitive.AddressDerivation
-    ( BoundedAddressLength (..) )
+    ( BoundedAddressLength (..), Depth (..) )
+import Cardano.Wallet.Primitive.AddressDerivation.Shared
+    ( SharedKey (..) )
 import Cardano.Wallet.Primitive.Slotting
     ( PastHorizonException, TimeInterpreter )
 import Cardano.Wallet.Primitive.Types
@@ -93,11 +97,13 @@ import Cardano.Wallet.Transaction
     , TransactionLayer (..)
     , TxFeeAndChange (..)
     , TxFeeUpdate (UseNewTxFee)
+    , WitnessCount (verificationKey)
     , WitnessCountCtx (..)
     , defaultTransactionCtx
     )
 import Cardano.Wallet.Write.Tx
-    ( IsRecentEra (..)
+    ( Address
+    , IsRecentEra (..)
     , PParams
     , RecentEra (..)
     , computeMinimumCoinForTxOut
@@ -108,7 +114,7 @@ import Cardano.Wallet.Write.Tx
 import Control.Arrow
     ( left )
 import Control.Monad
-    ( forM, unless, when )
+    ( forM, forM_, unless, when )
 import Control.Monad.Random
     ( MonadRandom, evalRand )
 import Control.Monad.Trans.Class
@@ -162,6 +168,10 @@ import Text.Pretty.Simple
 import qualified Cardano.Address.Script as CA
 import qualified Cardano.Api as Cardano
 import qualified Cardano.Api.Shelley as Cardano
+import Cardano.Ledger.Address
+    ( Addr (..) )
+import Cardano.Ledger.Credential
+    ( Credential (..) )
 import qualified Cardano.Wallet.Primitive.Types as W
 import qualified Cardano.Wallet.Primitive.Types.Address as W
 import qualified Cardano.Wallet.Primitive.Types.Coin as Coin
@@ -170,13 +180,19 @@ import qualified Cardano.Wallet.Primitive.Types.TokenBundle as TokenBundle
 import qualified Cardano.Wallet.Primitive.Types.Tx as W
 import qualified Cardano.Wallet.Primitive.Types.Tx.TxIn as W
 import qualified Cardano.Wallet.Primitive.Types.Tx.TxOut as W
-import qualified Cardano.Wallet.Primitive.Types.UTxO as W
 import qualified Cardano.Wallet.Primitive.Types.UTxO as UTxO
+import qualified Cardano.Wallet.Primitive.Types.UTxO as W
 import qualified Cardano.Wallet.Primitive.Types.UTxOIndex as UTxOIndex
 import qualified Cardano.Wallet.Primitive.Types.UTxOSelection as UTxOSelection
+import Cardano.Wallet.Shelley.Compatibility.Ledger
+    ( toLedger )
 import qualified Cardano.Wallet.Write.Tx as Write.Tx
 import qualified Data.Map as Map
+import Data.Maybe
+    ( isJust )
 import qualified Data.Set as Set
+import Data.Typeable
+    ( typeOf )
 
 -- | Helper wrapper type for the sake of logging.
 data BuildableInAnyEra tx = forall era.
@@ -252,6 +268,8 @@ data ErrBalanceTx
     | ErrBalanceTxExistingTotalCollateral
     | ErrBalanceTxExistingReturnCollateral
     | ErrBalanceTxConflictingNetworks
+    | ErrBalanceTxUnspendableUTxO W.TxOut
+    | ErrBalanceTxNotYetSupportedSharedWalletWithPreselectedUTxO
     | ErrBalanceTxAssignRedeemers ErrAssignRedeemers
     | ErrBalanceTxInternalError ErrBalanceTxInternalError
     | ErrBalanceTxInputResolutionConflicts (NonEmpty (W.TxOut, W.TxOut))
@@ -293,16 +311,73 @@ instance Buildable (PartialTx era) where
         cardanoTxF :: Cardano.Tx era -> Builder
         cardanoTxF tx' = pretty $ pShow tx'
 
+data CoinSelection = forall k ktype. CoinSelection
+    { txLayer
+        :: TransactionLayer k ktype SealedTx
+        -- TODO: Replace with smaller and smaller parts of 'TransactionLayer'
+    , inputScriptLookup
+        :: Maybe ([(W.TxIn, W.TxOut)] -> [CA.Script KeyHash])
+    , inputScriptTemplate
+        :: Maybe ScriptTemplate
+    , canSpendFrom :: Address -> Bool
+    , description :: String
+    }
+
+instance Show CoinSelection where
+    show (CoinSelection _ _ template _ description) = unwords
+        [ "CoinSelection {"
+        , "description = " <> show description
+        , "template = " <> show template
+        , "}"
+        ]
+
+-- Coin-selection assuming wallet UTxOs are either
+vkCoinSelection
+    :: forall k. TransactionLayer k 'CredFromKeyK SealedTx
+    -> CoinSelection
+vkCoinSelection tl =
+    CoinSelection
+        tl
+        Nothing
+        Nothing
+        hasPaymentKeyCred
+        "vkCoinSelection"
+  where
+    hasPaymentKeyCred :: Address -> Bool
+    hasPaymentKeyCred (Addr _network (KeyHashObj _) _stakeCred)     = True
+    hasPaymentKeyCred (Addr _network (ScriptHashObj _ ) _stakeCred) = False
+    hasPaymentKeyCred (AddrBootstrap _)                             = True
+    -- NOTE: It would be better to make the validation stricter depending on
+    -- whether we are using a byron or shelley wallet. This would however
+    -- warrant some new type-class in the wallet, @CanValidateUTxO@ or similar,
+    -- which does not seem worth it at the moment.
+
+-- | Coin-selection from wallet UTxOs locked by scripts
+scriptCoinSelection
+    :: ScriptTemplate
+    -> ([(W.TxIn, W.TxOut)] -> [CA.Script KeyHash])
+    -> TransactionLayer SharedKey 'CredFromScriptK SealedTx
+    -> CoinSelection
+scriptCoinSelection template scriptLookup tl =
+    CoinSelection
+        tl
+        (Just scriptLookup)
+        (Just template)
+        hasPaymentScriptCred
+        "scriptCoinSelection"
+  where
+    hasPaymentScriptCred :: Address -> Bool
+    hasPaymentScriptCred (Addr _network (KeyHashObj _) _stakeCred)     = False
+    hasPaymentScriptCred (Addr _network (ScriptHashObj _ ) _stakeCred) = True
+    hasPaymentScriptCred (AddrBootstrap _)                             = False
+
 balanceTransaction
-    :: forall era m s k ktype.
+    :: forall era m changeState.
         ( MonadRandom m
         , IsRecentEra era
-        , BoundedAddressLength k
         )
     => Tracer m BalanceTxLog
-    -> TransactionLayer k ktype SealedTx
-    -> Maybe ([(W.TxIn, W.TxOut)] -> [CA.Script KeyHash])
-    -> Maybe ScriptTemplate
+    -> CoinSelection
     -> (W.ProtocolParameters, Cardano.ProtocolParameters)
     -- ^ 'Cardano.ProtocolParameters' can be retrieved via a Local State Query
     -- to a local node.
@@ -324,12 +399,11 @@ balanceTransaction
     -- or similar ticket. Relevant ledger code: https://github.com/input-output-hk/cardano-ledger/blob/fdec04e8c071060a003263cdcb37e7319fb4dbf3/eras/alonzo/impl/src/Cardano/Ledger/Alonzo/TxInfo.hs#L428-L440
     -> UTxOIndex WalletUTxO
     -- ^ TODO [ADP-1789] Replace with @Cardano.UTxO@
-    -> ChangeAddressGen s
-    -> s
+    -> ChangeAddressGen changeState
+    -> changeState
     -> PartialTx era
-    -> ExceptT ErrBalanceTx m (Cardano.Tx era, s)
-balanceTransaction
-    tr txLayer toInpScriptsM mScriptTemplate pp ti idx genChange s unadjustedPtx = do
+    -> ExceptT ErrBalanceTx m (Cardano.Tx era, changeState)
+balanceTransaction tr coinSelection pp ti idx genChange s unadjustedPtx = do
     -- TODO [ADP-1490] Take 'Ledger.PParams era' directly as argument, and avoid
     -- converting to/from Cardano.ProtocolParameters. This may affect
     -- performance. The addition of this one specific conversion seems to have
@@ -341,8 +415,8 @@ balanceTransaction
 
     let balanceWith strategy =
             balanceTransactionWithSelectionStrategyAndNoZeroAdaAdjustment
-                @era @m @s @k @ktype
-                tr txLayer toInpScriptsM mScriptTemplate
+                @era @m @changeState
+                tr coinSelection
                 pp ti idx genChange s strategy adjustedPtx
     balanceWith SelectionStrategyOptimal
         `catchE` \e ->
@@ -418,28 +492,28 @@ increaseZeroAdaOutputs era pp = modifyLedgerBody $
 
 -- | Internal helper to 'balanceTransaction'
 balanceTransactionWithSelectionStrategyAndNoZeroAdaAdjustment
-    :: forall era m s k ktype.
-        ( BoundedAddressLength k
-        , MonadRandom m
+    :: forall era m changeState.
+        ( MonadRandom m
         , IsRecentEra era
         )
     => Tracer m BalanceTxLog
-    -> TransactionLayer k ktype SealedTx
-    -> Maybe ([(W.TxIn, W.TxOut)] -> [CA.Script KeyHash])
-    -> Maybe ScriptTemplate
+    -> CoinSelection
     -> (W.ProtocolParameters, Cardano.ProtocolParameters)
     -> TimeInterpreter (Either PastHorizonException)
     -> UTxOIndex WalletUTxO
-    -> ChangeAddressGen s
-    -> s
+    -> ChangeAddressGen changeState
+    -> changeState
     -> SelectionStrategy
     -> PartialTx era
-    -> ExceptT ErrBalanceTx m (Cardano.Tx era, s)
+    -> ExceptT ErrBalanceTx m (Cardano.Tx era, changeState)
 balanceTransactionWithSelectionStrategyAndNoZeroAdaAdjustment
     tr
-    txLayer
-    toInpScriptsM
-    mScriptTemplate
+    (CoinSelection
+        txLayer
+        toInpScriptsM
+        mScriptTemplate
+        canSpendFrom
+        _desc)
     (pp, nodePParams)
     ti
     internalUtxoAvailable
@@ -457,6 +531,7 @@ balanceTransactionWithSelectionStrategyAndNoZeroAdaAdjustment
     let era = Cardano.anyCardanoEra $ Cardano.cardanoEra @era
 
     (balance0, minfee0, _) <- balanceAfterSettingMinFee partialTx
+    externalSelectedUtxo <- extractExternallySelectedUTxO ptx
 
     (extraInputs, extraCollateral', extraOutputs, s') <- do
 
@@ -471,13 +546,25 @@ balanceTransactionWithSelectionStrategyAndNoZeroAdaAdjustment
 
         randomSeed <- stdGenSeed
         let
+            isPreselected :: W.TxIn -> Bool
+            isPreselected = flip Set.member
+                $ Set.fromList
+                $ map fromCardanoTxIn
+                $ Map.keys
+                $ unUTxO
+                $ view #inputs ptx
+
             transform
                 :: Selection
-                -> ([(W.TxIn, W.TxOut)], [(W.TxIn, W.TxOut)], [W.TxOut], s)
+                -> ( [(W.TxIn, W.TxOut)]
+                   , [(W.TxIn, W.TxOut)]
+                   , [W.TxOut]
+                   , changeState
+                   )
             transform sel =
                 let (sel', s') = assignChangeAddresses genChange sel s
                     inputs = F.toList (sel' ^. #inputs)
-                in  ( inputs
+                in  ( filter (not . isPreselected . fst) inputs
                     , sel' ^. #collateral
                     , sel' ^. #change
                     , s'
@@ -487,7 +574,6 @@ balanceTransactionWithSelectionStrategyAndNoZeroAdaAdjustment
             (UTxOIndex.size internalUtxoAvailable)
             (BuildableInAnyEra Cardano.cardanoEra ptx)
 
-        externalSelectedUtxo <- extractExternallySelectedUTxO ptx
         let mSel = selectAssets'
                 era
                 (extractOutputsFromTx $ toSealed partialTx)
@@ -535,8 +621,22 @@ balanceTransactionWithSelectionStrategyAndNoZeroAdaAdjustment
                 toInpScripts $ extraInputs <> extraCollateral'
             Nothing ->
                 []
+
+    when (isJust toInpScriptsM && externalSelectedUtxo /= UTxOIndex.empty) $ do
+        throwE ErrBalanceTxNotYetSupportedSharedWalletWithPreselectedUTxO
+
+
     let extraCollateral = fst <$> extraCollateral'
     let unsafeFromLovelace (Cardano.Lovelace l) = Coin.unsafeFromIntegral l
+
+    -- Rather than validate that the entire UTxO set can be spent using the
+    -- provided @CoinSelection@, we only validate the inputs we selected. This
+    -- provides nicer error messages when the CoinSelection's assumptions about
+    -- the UTxO set are broken without sacrificing too much performance.
+    forM_ (extraInputs ++ extraCollateral') $ \(_i, o@(W.TxOut addr _)) -> do
+        unless (canSpendFrom $ toLedger addr) $ do
+            throwE $ ErrBalanceTxUnspendableUTxO o
+
     candidateTx <- assembleTransaction $ TxUpdate
         { extraInputs
         , extraCollateral
@@ -697,8 +797,6 @@ balanceTransactionWithSelectionStrategyAndNoZeroAdaAdjustment
         case conflicts of
             [] -> return ()
             (c:cs) -> throwE $ ErrBalanceTxInputResolutionConflicts (c :| cs)
-      where
-         unUTxO (Cardano.UTxO u) = u
 
     walletUTxO :: W.UTxO
     walletUTxO = toExternalUTxOMap $ UTxOIndex.toMap internalUtxoAvailable
@@ -715,8 +813,7 @@ balanceTransactionWithSelectionStrategyAndNoZeroAdaAdjustment
          , unUTxO $ toCardanoUTxO Cardano.shelleyBasedEra walletUTxO
          ]
 
-      where
-         unUTxO (Cardano.UTxO u) = u
+    unUTxO (Cardano.UTxO u) = u
 
     assembleTransaction
         :: TxUpdate
@@ -880,7 +977,7 @@ balanceTransactionWithSelectionStrategyAndNoZeroAdaAdjustment
                 , minimumCollateralPercentage =
                     view #minimumCollateralPercentage pp
                 , maximumLengthChangeAddress =
-                    maxLengthAddressFor $ Proxy @k
+                    maxLengthChangeAddress genChange
                 }
 
             selectionParams = SelectionParams
@@ -918,8 +1015,23 @@ balanceTransactionWithSelectionStrategyAndNoZeroAdaAdjustment
                     $ runExceptT
                     $ performSelection selectionConstraints selectionParams
 
-newtype ChangeAddressGen s =
-    ChangeAddressGen { getChangeAddressGen ::  (s -> (W.Address, s)) }
+data ChangeAddressGen s = ChangeAddressGen
+    { getChangeAddressGen ::  (s -> (W.Address, s))
+
+    -- | Returns the longest address that the wallet can generate for a given
+    --   key.
+    --
+    -- This is useful in situations where we want to compute some function of
+    -- an output under construction (such as a minimum UTxO value), but don't
+    -- yet have convenient access to a real address.
+    --
+    -- Please note that this address should:
+    --
+    --  - never be used for anything besides its length and validity properties.
+    --  - never be used as a payment target within a real transaction.
+    --
+    , maxLengthChangeAddress :: W.Address
+    }
 
 -- | Augments the given outputs with new outputs. These new outputs correspond
 -- to change outputs to which new addresses have been assigned. This updates
@@ -929,7 +1041,7 @@ assignChangeAddresses
     -> SelectionOf TokenBundle
     -> s
     -> (SelectionOf W.TxOut, s)
-assignChangeAddresses (ChangeAddressGen genChange) sel = runState $ do
+assignChangeAddresses (ChangeAddressGen genChange _) sel = runState $ do
     changeOuts <- forM (view #change sel) $ \bundle -> do
         addr <- state genChange
         pure $ W.TxOut addr bundle
diff --git a/lib/wallet/src/Cardano/Wallet/Write/Tx/Gen.hs b/lib/wallet/src/Cardano/Wallet/Write/Tx/Gen.hs
index 6573679290f..54d64332a0d 100644
--- a/lib/wallet/src/Cardano/Wallet/Write/Tx/Gen.hs
+++ b/lib/wallet/src/Cardano/Wallet/Write/Tx/Gen.hs
@@ -11,6 +11,7 @@ module Cardano.Wallet.Write.Tx.Gen
     , shrinkBinaryData
     , shrinkDatum
     , genTxOut
+    , shrinkTxOut
     )
     where
 
@@ -23,14 +24,19 @@ import Cardano.Wallet.Write.Tx
     , Datum (..)
     , DatumHash
     , LatestLedgerEra
-    , RecentEra
+    , RecentEra (..)
     , ShelleyLedgerEra
     , TxOut
+    , Value
     , cardanoEraFromRecentEra
+    , coin
     , datumFromCardanoScriptData
     , datumHashFromBytes
     , datumToCardanoScriptData
+    , modifyCoin
+    , recentEra
     , shelleyBasedEraFromRecentEra
+    , withStandardCryptoConstraint
     )
 import Data.ByteString
     ( ByteString )
@@ -45,6 +51,7 @@ import Test.QuickCheck
     , listOf
     , oneof
     , scale
+    , shrink
     , shrinkMapBy
     , sized
     , vector
@@ -53,6 +60,12 @@ import Test.QuickCheck
 
 import qualified Cardano.Api.Gen as Cardano
 import qualified Cardano.Api.Shelley as Cardano
+import qualified Cardano.Ledger.Alonzo.TxBody as Alonzo
+import qualified Cardano.Ledger.Babbage.TxBody as Babbage
+import Cardano.Ledger.BaseTypes
+    ( StrictMaybe (..) )
+import Cardano.Ledger.Coin
+    ( Coin (..) )
 import qualified Data.ByteString as BS
 import qualified PlutusLedgerApi.V1 as PV1
 
@@ -106,3 +119,49 @@ genByteString = BS.pack <$> (choose (0, 64) >>= vector)
 genTxOut :: RecentEra era -> Gen (TxOut (ShelleyLedgerEra era))
 genTxOut era = Cardano.toShelleyTxOut (shelleyBasedEraFromRecentEra era)
     <$> Cardano.genTxOut (cardanoEraFromRecentEra era)
+
+shrinkValue
+    :: RecentEra era
+    -> Value (Cardano.ShelleyLedgerEra era)
+    -> [Value (Cardano.ShelleyLedgerEra era)]
+shrinkValue era v = withStandardCryptoConstraint era $ tail
+    [ modifyCoin (const c') v
+    | c' <- prepend shrinkCoin (coin v)
+    ]
+  where
+    prepend shrinker = \x -> x : shrinker x
+    shrinkCoin (Coin c) = map Coin $ shrink c
+
+shrinkTxOut
+    :: RecentEra era
+    -> TxOut (Cardano.ShelleyLedgerEra era)
+    -> [TxOut (Cardano.ShelleyLedgerEra era)]
+shrinkTxOut era@RecentEraBabbage (Babbage.TxOut addr value datum script) = tail
+    [ Babbage.TxOut addr' value' datum' script'
+    | addr' <- prepend (const []) addr
+    , value' <- prepend (shrinkValue era) value
+    , datum' <- prepend shrinkDatum datum
+    , script' <- prepend shrinkStrictMaybe script
+    ]
+  where
+    prepend shrinker = \x -> x : shrinker x
+shrinkTxOut era@RecentEraAlonzo (Alonzo.TxOut addr value datum) = tail
+    [ Alonzo.TxOut addr' value' datum'
+    | addr' <- prepend (const []) addr
+    , value' <- prepend (shrinkValue era) value
+    , datum' <- prepend shrinkStrictMaybe datum
+    ]
+  where
+    prepend shrinker = \x -> x : shrinker x
+
+
+shrinkStrictMaybe :: StrictMaybe a -> [StrictMaybe a]
+shrinkStrictMaybe x = case x of
+    SNothing -> []
+    SJust _ -> [SNothing]
+
+
+
+
+
+
diff --git a/lib/wallet/test/unit/Cardano/Wallet/Shelley/TransactionSpec.hs b/lib/wallet/test/unit/Cardano/Wallet/Shelley/TransactionSpec.hs
index aa07ad8f37c..125db0493b0 100644
--- a/lib/wallet/test/unit/Cardano/Wallet/Shelley/TransactionSpec.hs
+++ b/lib/wallet/test/unit/Cardano/Wallet/Shelley/TransactionSpec.hs
@@ -39,7 +39,8 @@ import Cardano.Address.Derivation
 import Cardano.Address.Script
     ( KeyHash (..)
     , KeyRole (Delegation, Payment, Policy)
-    , Script
+    , Script (..)
+    , ScriptTemplate (..)
     , serializeScript
     )
 import Cardano.Api
@@ -55,15 +56,21 @@ import Cardano.Api
 import Cardano.Api.Extra
     ( asAnyShelleyBasedEra, withShelleyBasedTx )
 import Cardano.Api.Gen
-    ( genAddressInEra
+    ( genAddressByron
+    , genAddressInEra
     , genEncodingBoundaryLovelace
+    , genNetworkId
+    , genPaymentCredential
+    , genScriptHash
     , genSignedValue
+    , genStakeAddressReference
     , genTx
     , genTxBodyContent
     , genTxForBalancing
     , genTxInEra
     , genTxOut
     , genTxOutDatum
+    , genTxOutValue
     , genValueForTxOut
     , genWitnesses
     )
@@ -109,7 +116,7 @@ import Cardano.Wallet
 import Cardano.Wallet.Byron.Compatibility
     ( maryTokenBundleMaxSize )
 import Cardano.Wallet.Gen
-    ( genMnemonic, genScript )
+    ( genMnemonic, genReadyScriptTemplate, genScript )
 import Cardano.Wallet.Primitive.AddressDerivation
     ( DelegationAddress (delegationAddress)
     , Depth (..)
@@ -129,11 +136,16 @@ import Cardano.Wallet.Primitive.AddressDerivation.Byron
     ( ByronKey )
 import Cardano.Wallet.Primitive.AddressDerivation.Icarus
     ( IcarusKey )
+import Cardano.Wallet.Primitive.AddressDerivation.SharedKey
+    ( SharedKey, replaceCosignersWithVerKeys )
 import Cardano.Wallet.Primitive.AddressDerivation.Shelley
     ( ShelleyKey, generateKeyFromSeed )
+import Cardano.Wallet.Primitive.AddressDiscovery.Random
+    ( RndState (..), mkRndState )
 import Cardano.Wallet.Primitive.AddressDiscovery.Sequential
     ( SeqState
     , defaultAddressPoolGap
+    , mkSeqStateFromAccountXPub
     , mkSeqStateFromRootXPrv
     , purposeBIP44
     , purposeCIP1852
@@ -242,7 +254,7 @@ import Cardano.Wallet.Shelley.Compatibility
     , toCardanoValue
     )
 import Cardano.Wallet.Shelley.Compatibility.Ledger
-    ( toBabbageTxOut, toLedgerTokenBundle, toWallet )
+    ( toBabbageTxOut, toLedger, toLedgerTokenBundle, toWallet )
 import Cardano.Wallet.Shelley.Transaction
     ( EraConstraints
     , KeyWitnessCount (KeyWitnessCount)
@@ -296,13 +308,18 @@ import Cardano.Wallet.Write.Tx
     )
 import Cardano.Wallet.Write.Tx.Balance
     ( ChangeAddressGen (..)
+    , CoinSelection (..)
     , ErrBalanceTx (..)
     , ErrBalanceTxInternalError (..)
     , ErrSelectAssets (..)
     , PartialTx (..)
     , balanceTransaction
     , posAndNegFromCardanoValue
+    , scriptCoinSelection
+    , vkCoinSelection
     )
+import Cardano.Wallet.Write.Tx.Gen
+    ( shrinkTxOut )
 import Control.Arrow
     ( first )
 import Control.Monad
@@ -464,6 +481,7 @@ import Test.Utils.Paths
 import Test.Utils.Pretty
     ( Pretty (..), (====) )
 
+import qualified Cardano.Address.Style.Shelley as CA
 import qualified Cardano.Api as Cardano
 import qualified Cardano.Api.Gen as Cardano
 import qualified Cardano.Api.Shelley as Cardano
@@ -2105,13 +2123,12 @@ instance Arbitrary TxMetadataValue where
     arbitrary = TxMetaNumber <$> arbitrary
 
 instance Arbitrary UTxO where
-    arbitrary = do
-        n <- choose (1,10)
-        inps <- vectorOf n arbitrary
-        let addr = Address $ BS.pack (1:replicate 56 0)
-        coins <- vectorOf n arbitrary
-        let outs = map (TxOut addr) coins
-        pure $ UTxO $ Map.fromList $ zip inps outs
+    arbitrary = scale (* 3) $ UTxO . Map.fromList <$> listOf genEntry
+      where
+        genEntry = (,) <$> genIn <*> genOut
+          where
+            genIn = Compatibility.fromCardanoTxIn <$> Cardano.genTxIn
+            genOut = Compatibility.fromCardanoTxOut <$> genTxOut AlonzoEra
 
 instance Arbitrary XPrv where
     arbitrary = fromJust . xprvFromBytes . BS.pack <$> vectorOf 96 arbitrary
@@ -2456,10 +2473,158 @@ instance Arbitrary KeyHash where
 instance Arbitrary StdGenSeed  where
   arbitrary = StdGenSeed . fromIntegral @Int <$> arbitrary
 
+instance Arbitrary ScriptTemplate where
+    arbitrary = genReadyScriptTemplate
+
+-- "Wallet"
+data Wallet'' = Wallet''
+    CoinSelection
+    UTxO
+    AnyChangeAddressGenWithInitialState
+    deriving Show
+
+instance Arbitrary Wallet'' where
+    arbitrary = oneof
+        [ Wallet''
+            <$> (pure shelleyVkCs)
+            <*> (genWalletUTxO genShelleyVkAddr)
+            <*> (pure dummyShelleyChangeAddressGen)
+
+        , Wallet''
+            <$> (pure byronVkCs)
+            <*> (genWalletUTxO genByronVkAddr)
+            <*> (pure dummyByronChangeAddressGen)
+
+        , do
+            template <- genReadyScriptTemplate
+            let scriptLookup = genDummyScriptLookupForTemplate template
+            let tl = newTransactionLayer @SharedKey Cardano.Mainnet
+            let cs = scriptCoinSelection
+                    template
+                    scriptLookup
+                    tl
+            -- Whether or not the payment ceredential is a key or script hash
+            -- in the change addresses isn't that interesting, so we can use
+            -- the shelley change address generator for now.
+            let change = dummyShelleyChangeAddressGen
+            utxo <- genWalletUTxO genSharedAddr
+            pure $ Wallet'' cs utxo change
+        ]
+      where
+        shelleyVkCs = vkCoinSelection tl
+          where
+            tl = newTransactionLayer @ShelleyKey Cardano.Mainnet
+
+        byronVkCs = vkCoinSelection tl
+          where
+            tl = newTransactionLayer @ByronKey Cardano.Mainnet
+
+        genShelleyVkAddr :: Gen (Cardano.AddressInEra Cardano.AlonzoEra)
+        genShelleyVkAddr = Cardano.shelleyAddressInEra
+            <$> (Cardano.makeShelleyAddress
+                <$> genNetworkId
+                <*> genPaymentCredential -- only vk credentials
+                <*> genStakeAddressReference)
+
+        genByronVkAddr :: Gen (Cardano.AddressInEra Cardano.AlonzoEra)
+        genByronVkAddr = Cardano.byronAddressInEra <$> genAddressByron
+
+
+        genSharedAddr :: Gen (Cardano.AddressInEra Cardano.AlonzoEra)
+        genSharedAddr = Cardano.shelleyAddressInEra
+            <$> (Cardano.makeShelleyAddress
+                <$> genNetworkId
+                <*> (Cardano.PaymentCredentialByScript <$> genScriptHash)
+                <*> genStakeAddressReference)
+
+        genWalletUTxO genAddr = scale (* 2) $
+            UTxO . Map.fromList <$> listOf genEntry
+          where
+            genEntry = (,) <$> genIn <*> genOut
+              where
+                genIn :: Gen TxIn
+                genIn = genTxIn
+
+                genOut :: Gen TxOut
+                genOut = Compatibility.fromCardanoTxOut <$>
+                  (Cardano.TxOut
+                        <$> genAddr
+                        <*> (scale (* 2) (genTxOutValue era))
+                        <*> (pure Cardano.TxOutDatumNone)
+                        <*> (pure Cardano.ReferenceScriptNone))
+                  where
+                    era = Cardano.AlonzoEra
+
+        genDummyScriptLookupForTemplate
+            :: ScriptTemplate
+            -> ([(TxIn, TxOut)] -> [Script KeyHash])
+        genDummyScriptLookupForTemplate template =
+            let
+                scriptAtIx i = replaceCosignersWithVerKeys
+                        CA.UTxOExternal template (toEnum i)
+                scriptLookup ins = map scriptAtIx $ take (length ins) $ [0 ..]
+            in
+                scriptLookup
+
+-- | Encapsulates both a 'ChangeAddressGen s' and the 's' required for the
+-- generator. This allows properties like 'prop_balanceTransactionValid' to
+-- easily generate arbitrary change address generators.
+data AnyChangeAddressGenWithInitialState where
+    AnyChangeAddressGenWithInitialState
+        :: forall s. ChangeAddressGen s
+        -> s
+        -> AnyChangeAddressGenWithInitialState
+
+-- Byron style addresses, corresponding to the change addresses generated by
+-- "byron wallets".
+dummyByronChangeAddressGen :: AnyChangeAddressGenWithInitialState
+dummyByronChangeAddressGen = AnyChangeAddressGenWithInitialState
+    (defaultChangeAddressGen @(RndState 'Mainnet)
+        (byronRootK, pwd)
+        (Proxy @ByronKey))
+    (mkRndState byronRootK 0)
+  where
+    byronRootK = Byron.generateKeyFromSeed mw mempty
+    mw = SomeMnemonic $ either (error . show) id
+        (entropyToMnemonic @12 <$> mkEntropy "0000000000000000")
+    pwd = mempty
+
+-- | Shelley base addresses, corresponding to the change addresses generated by
+-- normal shelley wallets.
+dummyShelleyChangeAddressGen :: AnyChangeAddressGenWithInitialState
+dummyShelleyChangeAddressGen = AnyChangeAddressGenWithInitialState
+    (defaultChangeAddressGen @(SeqState 'Mainnet ShelleyKey )
+        (delegationAddress @'Mainnet @ShelleyKey)
+        (Proxy @ShelleyKey))
+    (mkSeqStateFromAccountXPub
+        (publicKey $ Shelley.ShelleyKey acctK)
+        Nothing
+        purposeCIP1852
+        defaultAddressPoolGap)
+
+  where
+    mw = SomeMnemonic $ either (error . show) id
+        (entropyToMnemonic @12 <$> mkEntropy "0000000000000000")
+    pwd = Passphrase ""
+    rootK = Shelley.unsafeGenerateKeyFromSeed (mw, Nothing) mempty
+    acctK = Shelley.deriveAccountPrivateKeyShelley
+                purposeBIP44
+                pwd
+                (getRawKey rootK)
+                minBound
+
+instance Show AnyChangeAddressGenWithInitialState where
+    show (AnyChangeAddressGenWithInitialState (ChangeAddressGen gen _) s) =
+        let
+            firstChangeAddr = fst $ gen s
+        in
+            show $ toLedger firstChangeAddr
+
+
 balanceTransactionSpec :: Spec
 balanceTransactionSpec = describe "balanceTransaction" $ do
     -- TODO: Create a test to show that datums are passed through...
-
+    --
     it "doesn't balance transactions with existing 'totalCollateral'"
         $ property prop_balanceTransactionExistingTotalCollateral
 
@@ -2544,6 +2709,7 @@ balanceTransactionSpec = describe "balanceTransaction" $ do
                 ]
         let balance =
                 balanceTransactionWithDummyChangeState
+                    (vkCoinSelection testTxLayer)
                     walletUTxO
                     testStdGenSeed
 
@@ -2746,13 +2912,13 @@ balanceTransactionSpec = describe "balanceTransaction" $ do
     balanceTx tx = flip evalRand (stdGenFromSeed testStdGenSeed) $ runExceptT $
        fst <$> balanceTransaction
             nullTracer
-            testTxLayer
-            Nothing
-            Nothing
+            (vkCoinSelection testTxLayer)
             mockProtocolParametersForBalancing
             (dummyTimeInterpreterWithHorizon horizon)
             utxoIndex
-            (defaultChangeAddressGen $ delegationAddress @'Mainnet)
+            (defaultChangeAddressGen
+                (delegationAddress @'Mainnet)
+                (Proxy @ShelleyKey))
             (getState wal)
             tx
       where
@@ -3261,7 +3427,6 @@ instance Show Wallet' where
         , nameF "pending" (""+||pending||+"")
         ]
 
-
 mkTestWallet :: ShelleyKey 'RootK XPrv -> UTxO -> Wallet'
 mkTestWallet rootK utxo = Wallet'
     (UTxOIndex.fromMap $ CS.toInternalUTxOMap utxo)
@@ -3272,7 +3437,7 @@ mkTestWallet rootK utxo = Wallet'
 
 instance Arbitrary Wallet' where
     arbitrary = do
-        utxo <- scale (* 3) genUTxO
+        utxo <- scale (* 5) genUTxO
         mw <- SomeMnemonic <$> genMnemonic @12
         pure $ mkTestWallet (rootK mw) utxo
       where
@@ -3424,6 +3589,8 @@ instance Arbitrary (PartialTx Cardano.BabbageEra) where
         | tx' <- shrinkTxBabbage tx
         ]
 
+instance Arbitrary (Cardano.TxBody Cardano.BabbageEra) where
+    arbitrary = (\(Cardano.Tx body _) -> body) <$> genTxForBalancing Cardano.BabbageEra
 
 shrinkInputResolution
     :: forall era.
@@ -3501,20 +3668,23 @@ shrinkTxBodyAlonzo (Cardano.ShelleyTxBody e bod scripts scriptData aux val) =
         -> [Ledger.TxBody (Cardano.ShelleyLedgerEra Cardano.AlonzoEra)]
     shrinkLedgerTxBody body = tail
         [ body
-            { Alonzo.txwdrls = wdrls' }
-            { Alonzo.outputs = outs' }
-            { Alonzo.inputs = ins' }
-            { Alonzo.txcerts = certs' }
-            { Alonzo.mint = mint' }
-            { Alonzo.reqSignerHashes = rsh' }
-            { Alonzo.txUpdates = updates' }
-            { Alonzo.txfee = txfee' }
+            { Alonzo.txwdrls = wdrls'
+            , Alonzo.outputs = outs'
+            , Alonzo.inputs = ins'
+            , Alonzo.txcerts = certs'
+            , Alonzo.mint = mint'
+            , Alonzo.reqSignerHashes = rsh'
+            , Alonzo.txUpdates = updates'
+            , Alonzo.txfee = txfee'
+            , Alonzo.adHash = adHash'
+            , Alonzo.txvldt = vldt'
+            }
         | updates' <-
             prependOriginal shrinkStrictMaybe (Alonzo.txUpdates body)
         , wdrls' <-
             prependOriginal shrinkWdrl (Alonzo.txwdrls body)
         , outs' <-
-            prependOriginal (shrinkSeq (const [])) (Alonzo.outputs body)
+            prependOriginal (shrinkSeq $ shrinkTxOut RecentEraAlonzo) (Alonzo.outputs body)
         , ins' <-
             prependOriginal (shrinkSet (const [])) (Alonzo.inputs body)
         , certs' <-
@@ -3525,7 +3695,18 @@ shrinkTxBodyAlonzo (Cardano.ShelleyTxBody e bod scripts scriptData aux val) =
             prependOriginal (shrinkSet (const [])) (Alonzo.reqSignerHashes body)
         , txfee' <-
             prependOriginal shrinkFee (Alonzo.txfee body)
+        , adHash' <-
+            prependOriginal shrinkStrictMaybe (Alonzo.adHash body)
+        , vldt' <-
+            prependOriginal shrinkValidity (Alonzo.txvldt body)
         ]
+      where
+        shrinkValidity (ValidityInterval a b) = tail
+            [ ValidityInterval a' b'
+            | a' <- prependOriginal shrinkStrictMaybe a
+            , b' <- prependOriginal shrinkStrictMaybe b
+            ]
+
 
 shrinkTxBodyBabbage
     :: Cardano.TxBody Cardano.BabbageEra -> [Cardano.TxBody Cardano.BabbageEra]
@@ -3611,12 +3792,12 @@ shrinkFee _ = [Ledger.Coin 0]
 
 shrinkWdrl :: Wdrl era -> [Wdrl era]
 shrinkWdrl (Wdrl m) = map (Wdrl . Map.fromList) $
-    shrinkList shrinkWdrl' (Map.toList m)
+    shrinkList (const []) (Map.toList m)
     where
-    shrinkWdrl' (acc, Ledger.Coin c) =
-        [ (acc, Ledger.Coin c')
-        | c' <- filter (>= 1) $ shrink c
-        ]
+--    _shrinkWdrl' (acc, Ledger.Coin c) =
+--        [ (acc, Ledger.Coin c')
+--        | c' <- filter (>= 1) $ shrink c
+--        ]
 
 shrinkStrictMaybe :: StrictMaybe a -> [StrictMaybe a]
 shrinkStrictMaybe = \case
@@ -3637,13 +3818,13 @@ balanceTransaction' (Wallet' utxoIndex wallet _pending) seed tx  =
     flip evalRand (stdGenFromSeed seed) $ runExceptT $
         fst <$> balanceTransaction
             nullTracer
-            testTxLayer
-            Nothing
-            Nothing
+            (vkCoinSelection testTxLayer)
             mockProtocolParametersForBalancing
             dummyTimeInterpreter
             utxoIndex
-            (defaultChangeAddressGen $ delegationAddress @'Mainnet)
+            (defaultChangeAddressGen
+                (delegationAddress @'Mainnet)
+                (Proxy @ShelleyKey))
             (getState wallet)
             tx
 
@@ -3651,8 +3832,11 @@ newtype DummyChangeState = DummyChangeState { nextUnusedIndex :: Int }
     deriving (Show, Eq)
 
 dummyChangeAddrGen :: ChangeAddressGen DummyChangeState
-dummyChangeAddrGen = ChangeAddressGen $ \(DummyChangeState i) ->
+dummyChangeAddrGen = ChangeAddressGen
+    { getChangeAddressGen = \(DummyChangeState i) ->
         (addressAtIx $ toEnum i, DummyChangeState $ succ i)
+    , maxLengthChangeAddress = addressAtIx minBound
+    }
       where
         addressAtIx
             :: Index
@@ -3676,21 +3860,44 @@ dummyChangeAddrGen = ChangeAddressGen $ \(DummyChangeState i) ->
                     (getRawKey rootK)
                     minBound
 
+
+balanceTransaction''
+    :: WriteTx.IsRecentEra era
+    => CoinSelection
+    -> UTxO
+    -> AnyChangeAddressGenWithInitialState
+    -> StdGenSeed
+    -> PartialTx era
+    -> Either
+        ErrBalanceTx (Cardano.Tx era)
+balanceTransaction'' cs utxo (AnyChangeAddressGenWithInitialState change s) seed ptx =
+    fmap fst $ flip evalRand (stdGenFromSeed seed) $ runExceptT $
+        balanceTransaction @_ @(Rand StdGen)
+            (nullTracer @(Rand StdGen))
+            cs
+            mockProtocolParametersForBalancing
+            dummyTimeInterpreter
+            utxoIndex
+            change
+            s
+            ptx
+  where
+    utxoIndex = UTxOIndex.fromMap $ CS.toInternalUTxOMap utxo
+
 balanceTransactionWithDummyChangeState
     :: WriteTx.IsRecentEra era
-    => UTxO
+    => CoinSelection
+    -> UTxO
     -> StdGenSeed
     -> PartialTx era
     -> Either
         ErrBalanceTx
         (Cardano.Tx era, DummyChangeState)
-balanceTransactionWithDummyChangeState utxo seed ptx =
+balanceTransactionWithDummyChangeState cs utxo seed ptx =
     flip evalRand (stdGenFromSeed seed) $ runExceptT $
         balanceTransaction @_ @(Rand StdGen)
             (nullTracer @(Rand StdGen))
-            testTxLayer
-            Nothing
-            Nothing
+            cs
             mockProtocolParametersForBalancing
             dummyTimeInterpreter
             utxoIndex
@@ -3919,21 +4126,24 @@ balanceTransactionGoldenSpec = describe "balance goldens" $ do
 --
 -- TODO: Generate data for other eras than Alonzo
 prop_balanceTransactionValid
-    :: Wallet'
+    :: Wallet''
     -> ShowBuildable (PartialTx Cardano.AlonzoEra)
     -> StdGenSeed
     -> Property
-prop_balanceTransactionValid wallet (ShowBuildable partialTx) seed
+prop_balanceTransactionValid (Wallet'' cs walletUTxO change) (ShowBuildable partialTx) seed
     = withMaxSuccess 1_000 $ do
         let combinedUTxO = mconcat
                 [ view #inputs partialTx
                 , Compatibility.toCardanoUTxO Cardano.ShelleyBasedEraAlonzo walletUTxO
                 ]
         let originalBalance = txBalance (view #tx partialTx) combinedUTxO
-        let res = balanceTransaction'
-                wallet
+        let res = balanceTransaction''
+                cs
+                (Compatibility.fromCardanoUTxO (view #inputs partialTx) <> walletUTxO)
+                change
                 seed
                 partialTx
+        let originalOuts = txOutputs (view #tx partialTx)
         case res of
             Right tx -> counterexample ("\nResult: " <> show (Pretty tx)) $ do
                 label "success"
@@ -3943,6 +4153,16 @@ prop_balanceTransactionValid wallet (ShowBuildable partialTx) seed
                         "fee above 1 ada"
                     $ classify (hasZeroAdaOutputs $ view #tx partialTx)
                         "partial tx had zero ada outputs"
+                    $ classify (hasZeroAdaOutputs $ view #tx partialTx)
+                        "partial tx had zero ada outputs"
+                    $ classify (length originalOuts > 0)
+                        "has payment outputs"
+                    $ classify (length originalOuts > 5)
+                        ">5 payment outputs"
+                    $ classify (length originalOuts > 10)
+                        ">10 payment outputs"
+                    $ classify (length originalOuts > 20)
+                        ">20 payment outputs"
                     $ classify (hasCollateral tx)
                         "balanced tx has collateral"
                     $ conjoin
@@ -3986,7 +4206,7 @@ prop_balanceTransactionValid wallet (ShowBuildable partialTx) seed
                             property True
                         (True, False) ->
                             label "missing tokens" $
-                            property True
+                            counterexample (show err) $ property True
                         (True, True) ->
                             property False
             Left (ErrBalanceTxUpdateError (ErrExistingKeyWitnesses _)) ->
@@ -4036,6 +4256,14 @@ prop_balanceTransactionValid wallet (ShowBuildable partialTx) seed
                 label "unable to construct change" $ property True
             Left ErrBalanceTxInputResolutionConflicts{} ->
                 label "input resolution conflicts" $ property True
+            Left (ErrBalanceTxUnspendableUTxO (TxOut addr _)) ->
+                label "unspendable utxo" $
+                    counterexample (show (toLedger addr)) $ property False
+                -- Unless we generate codependent UTxO and CoinSelection values,
+                -- we need :
+            Left ErrBalanceTxNotYetSupportedSharedWalletWithPreselectedUTxO ->
+                 label "shared wallet with preselected inputs (not yet supported)"
+                    $ property True
             Left err -> label "other error" $
                 counterexample ("balanceTransaction failed: " <> show err) False
   where
@@ -4127,11 +4355,6 @@ prop_balanceTransactionValid wallet (ShowBuildable partialTx) seed
                     out
                 ]
 
-    walletUTxO :: UTxO
-    walletUTxO =
-        let Wallet' _ w _ = wallet
-        in view #utxo w
-
     hasZeroAdaOutputs :: Cardano.Tx Cardano.AlonzoEra -> Bool
     hasZeroAdaOutputs (Cardano.Tx (Cardano.ShelleyTxBody _ body _ _ _ _) _) =
         any hasZeroAda (Alonzo.outputs body)
@@ -4179,6 +4402,10 @@ prop_balanceTransactionValid wallet (ShowBuildable partialTx) seed
     ledgerPParams = Cardano.toLedgerPParams
         Cardano.ShelleyBasedEraAlonzo nodePParams
 
+    txOutputs :: Cardano.Tx era -> [Cardano.TxOut Cardano.CtxTx era]
+    txOutputs (Cardano.Tx (Cardano.TxBody content) _) =
+        Cardano.txOuts content
+
 prop_balanceTransactionExistingTotalCollateral
     :: Wallet'
     -> ShowBuildable (PartialTx Cardano.BabbageEra)