Merge #1676 #1679 #1680

1676: Bump cardano-node to pioneer-3 r=rvl a=Anviking

# Issue
None, or #1657
# Overview

- [x] I have bumped cardano-node to the `pioneer-3` tag, such that the new friends-and-family testnet works

# Comments

- `nix-shell` not working yet

<!-- Additional comments or screenshots to attach if any -->

<!-- 
Don't forget to:

 ✓ Self-review your changes to make sure nothing unexpected slipped through
 ✓ Assign yourself to the PR
 ✓ Assign one or several reviewer(s)
 ✓ Once created, link this PR to its corresponding ticket
 ✓ Assign the PR to a corresponding milestone
 ✓ Acknowledge any changes required to the Wiki
-->


1679: Reduce running time of fee estimation endpoint r=rvl a=rvl

### Issue Number

Relates to ADP-283 / #1648.

### Overview

The nightly api endpoint latency benchmark got 100× slower for `postTransactionFee`. This fixes it by moving common setup for coin selection outside of the loop.

### Comments

```
    Latencies for 10 fixture wallets scenario
        postTransactionFee - before - 102.2 ms
        postTransactionFee  - after - 4.8 ms
```

1680: Fix port selection in the db migration tests r=rvl a=rvl

### Issue number

Relates to #1649

### Overview

Each migration test running in turn was using the same port.

However due to the `SO_LINGER` TCP socket option, the port remains in use for a short time after the wallet server process exits.

So use a different port for each test.

### Comments

Tested with:

    nix-build -A migration-tests -o migration-tests && ./migration-tests/runall.sh


Co-authored-by: Johannes Lund <[email protected]>
Co-authored-by: Rodney Lorrimar <[email protected]>

lib/byron/src/Cardano/Wallet/Byron/Network.hs

@@ -171,7 +171,7 @@ import Ouroboros.Network.Protocol.LocalStateQuery.Type
 import Ouroboros.Network.Protocol.LocalTxSubmission.Client
     ( localTxSubmissionClientPeer )
 import Ouroboros.Network.Protocol.LocalTxSubmission.Type
-    ( LocalTxSubmission )
+    ( LocalTxSubmission, SubmitResult (..) )
 import System.IO.Error
     ( isDoesNotExistError )
 
@@ -275,8 +275,8 @@ withNetworkLayer tr gbp addrInfo versionData action = do
         liftIO $ traceWith tr $ MsgPostSealedTx tx
         result <- liftIO $ localTxSubmissionQ `send` CmdSubmitTx (toGenTx tx)
         case result of
-            Nothing  -> pure ()
-            Just err -> throwE $ ErrPostTxBadRequest $ T.pack (show err)
+            SubmitSuccess -> pure ()
+            SubmitFail err -> throwE $ ErrPostTxBadRequest $ T.pack (show err)
 
     _stakeDistribution =
         notImplemented "stakeDistribution"

lib/core/src/Cardano/Wallet.hs

@@ -1037,11 +1037,36 @@ selectCoinsForPayment
     -> NonEmpty TxOut
     -> ExceptT (ErrSelectForPayment e) IO CoinSelection
 selectCoinsForPayment ctx wid recipients = do
-    (wal, _, pending) <- withExceptT ErrSelectForPaymentNoSuchWallet $
-        readWallet @ctx @s @k ctx wid
-    txp <- withExceptT ErrSelectForPaymentNoSuchWallet $
-        readWalletTxParameters @ctx @s @k ctx wid
+    (utxo, txp) <- withExceptT ErrSelectForPaymentNoSuchWallet $
+        selectCoinsSetup @ctx @s @k ctx wid
+    selectCoinsForPaymentFromUTxO @ctx @t @k @e ctx utxo txp recipients
+
+-- | Retrieve wallet data which is needed for all types of coin selections.
+selectCoinsSetup
+    :: forall ctx s k.
+        ( HasDBLayer s k ctx
+        )
+    => ctx
+    -> WalletId
+    -> ExceptT ErrNoSuchWallet IO (W.UTxO, W.TxParameters)
+selectCoinsSetup ctx wid = do
+    (wal, _, pending) <- readWallet @ctx @s @k ctx wid
+    txp <- readWalletTxParameters @ctx @s @k ctx wid
     let utxo = availableUTxO @s pending wal
+    return (utxo, txp)
+
+selectCoinsForPaymentFromUTxO
+    :: forall ctx t k e.
+        ( HasTransactionLayer t k ctx
+        , HasLogger WalletLog ctx
+        , e ~ ErrValidateSelection t
+        )
+    => ctx
+    -> W.UTxO
+    -> W.TxParameters
+    -> NonEmpty TxOut
+    -> ExceptT (ErrSelectForPayment e) IO CoinSelection
+selectCoinsForPaymentFromUTxO ctx utxo txp recipients = do
     (sel, utxo') <- withExceptT ErrSelectForPaymentCoinSelection $ do
         let opts = coinSelOpts tl (txp ^. #getTxMaxSize)
         CoinSelection.random opts recipients utxo
@@ -1067,11 +1092,20 @@ selectCoinsForDelegation
     -> WalletId
     -> ExceptT ErrSelectForDelegation IO CoinSelection
 selectCoinsForDelegation ctx wid = do
-    (wal, _, pending) <- withExceptT ErrSelectForDelegationNoSuchWallet $
-        readWallet @ctx @s @k ctx wid
-    txp <- withExceptT ErrSelectForDelegationNoSuchWallet $
-        readWalletTxParameters @ctx @s @k ctx wid
-    let utxo = availableUTxO @s pending wal
+    (utxo, txp) <- withExceptT ErrSelectForDelegationNoSuchWallet $
+        selectCoinsSetup @ctx @s @k ctx wid
+    selectCoinsForDelegationFromUTxO @_ @t @k ctx utxo txp
+
+selectCoinsForDelegationFromUTxO
+    :: forall ctx t k.
+        ( HasTransactionLayer t k ctx
+        , HasLogger WalletLog ctx
+        )
+    => ctx
+    -> W.UTxO
+    -> W.TxParameters
+    -> ExceptT ErrSelectForDelegation IO CoinSelection
+selectCoinsForDelegationFromUTxO ctx utxo txp = do
     let sel = CoinSelection [] [] []
     let feePolicy = feeOpts tl (computeCertFee 1) (txp ^. #getFeePolicy)
     withExceptT ErrSelectForDelegationFee $ do
@@ -1092,9 +1126,11 @@ estimateFeeForDelegation
     => ctx
     -> WalletId
     -> ExceptT ErrSelectForDelegation IO FeeEstimation
-estimateFeeForDelegation ctx wid =
+estimateFeeForDelegation ctx wid = do
+    (utxo, txp) <- withExceptT ErrSelectForDelegationNoSuchWallet $
+        selectCoinsSetup @ctx @s @k ctx wid
     estimateFeeForCoinSelection $
-    selectCoinsForDelegation @_ @s @t @k ctx wid
+       selectCoinsForDelegationFromUTxO @_ @t @k ctx utxo txp
 
 -- | Constructs a set of coin selections that select all funds from the given
 --   source wallet, returning them as change.
@@ -1113,11 +1149,21 @@ selectCoinsForMigration
        -- ^ The source wallet ID.
     -> ExceptT ErrSelectForMigration IO [CoinSelection]
 selectCoinsForMigration ctx wid = do
-    (cp, _, pending) <- withExceptT ErrSelectForMigrationNoSuchWallet $
-        readWallet @ctx @s @k ctx wid
-    txp <- withExceptT ErrSelectForMigrationNoSuchWallet $
-        readWalletTxParameters @ctx @s @k ctx wid
-    let utxo = availableUTxO @s pending cp
+    (utxo, txp) <- withExceptT ErrSelectForMigrationNoSuchWallet $
+        selectCoinsSetup @ctx @s @k ctx wid
+    selectCoinsForMigrationFromUTxO @ctx @t @k ctx utxo txp wid
+
+selectCoinsForMigrationFromUTxO
+    :: forall ctx t k.
+        ( HasTransactionLayer t k ctx
+        )
+    => ctx
+    -> W.UTxO
+    -> W.TxParameters
+    -> WalletId
+       -- ^ The source wallet ID.
+    -> ExceptT ErrSelectForMigration IO [CoinSelection]
+selectCoinsForMigrationFromUTxO ctx utxo txp wid = do
     let feePolicy@(LinearFee (Quantity a) _ _) = txp ^. #getFeePolicy
     let feeOptions = (feeOpts tl computeFee feePolicy)
             { dustThreshold = Coin $ ceiling a }
@@ -1140,9 +1186,11 @@ estimateFeeForPayment
     -> WalletId
     -> NonEmpty TxOut
     -> ExceptT (ErrSelectForPayment e) IO FeeEstimation
-estimateFeeForPayment ctx wid recipients =
+estimateFeeForPayment ctx wid recipients = do
+    (utxo, txp) <- withExceptT ErrSelectForPaymentNoSuchWallet $
+        selectCoinsSetup @ctx @s @k ctx wid
     estimateFeeForCoinSelection $
-    selectCoinsForPayment @_ @s @t @k ctx wid recipients
+        selectCoinsForPaymentFromUTxO @ctx @t @k @e ctx utxo txp recipients
 
 -- | Augments the given outputs with new outputs. These new outputs corresponds
 -- to change outputs to which new addresses are being assigned to. This updates

lib/core/src/Ouroboros/Network/Client/Wallet.hs

@@ -99,6 +99,8 @@ import Ouroboros.Network.Protocol.LocalStateQuery.Type
     ( AcquireFailure )
 import Ouroboros.Network.Protocol.LocalTxSubmission.Client
     ( LocalTxClientStIdle (..), LocalTxSubmissionClient (..) )
+import Ouroboros.Network.Protocol.LocalTxSubmission.Type
+    ( SubmitResult (..) )
 
 import qualified Cardano.Wallet.Primitive.Types as W
 import qualified Ouroboros.Network.Protocol.ChainSync.ClientPipelined as P
@@ -508,7 +510,7 @@ localStateQuery queue =
 
 -- | Sending command to the localTxSubmission client. See also 'ChainSyncCmd'.
 data LocalTxSubmissionCmd tx err (m :: * -> *)
-    = CmdSubmitTx tx (Maybe err -> m ())
+    = CmdSubmitTx tx (SubmitResult err -> m ())
 
 -- | Client for the 'Local Tx Submission' mini-protocol.
 --

lib/jormungandr/test/migration/migration-test.hs

@@ -65,7 +65,7 @@ import Data.Aeson
 import Data.Aeson.Lens
     ( key, values, _Integral, _String )
 import Data.Maybe
-    ( isNothing )
+    ( fromMaybe, isNothing )
 import Data.Text
     ( Text )
 import Network.Wreq
@@ -74,6 +74,8 @@ import System.Environment
     ( getArgs )
 import System.Exit
     ( ExitCode (..), exitFailure, exitWith )
+import Text.Read
+    ( readMaybe )
 
 import qualified Data.Text as T
 
@@ -83,19 +85,19 @@ main = do
 
     cfg <- defaultConfigStdout
     withTrace cfg "migration-test" $ \tr ->
-        testMain @('Testnet 0) tr 9090 testAction launchArgs >>= exitWith
+        testMain @('Testnet 0) tr testAction launchArgs >>= exitWith
 
 -- | Something to do while the server is running.
 type TestAction (t :: NetworkDiscriminant) = Trace IO Text -> ApiBase -> IO ExitCode
 
 testMain
     :: forall t. (DecodeAddress t, EncodeAddress t)
     => Trace IO Text
-    -> Int
     -> TestAction t
     -> [String]
     -> IO ExitCode
-testMain tr serverPort testAction launchArgs = do
+testMain tr testAction launchArgs = do
+    let serverPort = getServerPort launchArgs
     let apiBase = mkApiBase serverPort
     let cmd = Command "cardano-wallet-jormungandr" launchArgs (pure ()) Inherit Inherit
     res <- withBackendProcess (trMessageText tr) cmd $ do
@@ -113,6 +115,15 @@ testMain tr serverPort testAction launchArgs = do
             logError tr ("Process exited with status " <> T.pack (show st))
             pure (ExitFailure 14)
 
+-- | Scan through cardano-wallet server CLI arguments to find a port.
+-- Returns the default 8090 if none found.
+getServerPort :: [String] -> Int
+getServerPort = fromMaybe 8090 . portArg
+  where
+    portArg ("--port":port:_) = readMaybe port
+    portArg (_:args) = portArg args
+    portArg [] = Nothing
+
 -- | @run@ action
 doRun
     :: forall t. (DecodeAddress t, EncodeAddress t)

lib/shelley/src/Cardano/Wallet/Shelley/Compatibility.hs

@@ -114,11 +114,11 @@ import qualified Data.Map.Strict as Map
 import qualified Ouroboros.Consensus.Shelley.Ledger as O
 import qualified Ouroboros.Network.Block as O
 import qualified Ouroboros.Network.Point as Point
+import qualified Shelley.Spec.Ledger.Address as SL
 import qualified Shelley.Spec.Ledger.BlockChain as SL
 import qualified Shelley.Spec.Ledger.Coin as SL
 import qualified Shelley.Spec.Ledger.PParams as SL
 import qualified Shelley.Spec.Ledger.Tx as SL
-import qualified Shelley.Spec.Ledger.TxData as SL
 import qualified Shelley.Spec.Ledger.UTxO as SL
 
 data Shelley

lib/shelley/src/Cardano/Wallet/Shelley/Network.hs

@@ -172,7 +172,7 @@ import Ouroboros.Network.Protocol.LocalStateQuery.Type
 import Ouroboros.Network.Protocol.LocalTxSubmission.Client
     ( localTxSubmissionClientPeer )
 import Ouroboros.Network.Protocol.LocalTxSubmission.Type
-    ( LocalTxSubmission )
+    ( LocalTxSubmission, SubmitResult (..) )
 import System.IO.Error
     ( isDoesNotExistError )
 
@@ -277,8 +277,8 @@ withNetworkLayer tr gbp addrInfo versionData action = do
         liftIO $ traceWith tr $ MsgPostSealedTx tx
         result <- liftIO $ localTxSubmissionQ `send` CmdSubmitTx (toGenTx tx)
         case result of
-            Nothing  -> pure ()
-            Just err -> throwE $ ErrPostTxBadRequest $ T.pack (show err)
+            SubmitSuccess -> pure ()
+            SubmitFail err -> throwE $ ErrPostTxBadRequest $ T.pack (show err)
 
     _stakeDistribution =
         notImplemented "stakeDistribution"

lib/shelley/test/data/cardano-node-shelley/deleg.skey

@@ -1,4 +1,4 @@
 type: Node operator signing key
 title: Genesis delegate operator key
 cbor-hex:
- 5820263a0af41b53f5b3eb42304f89e72391403b370c48f0a106f5507b1a1b579deb
+ 5820e3861a38dd4a6a1eba648f82ae6b5a6a17844f65e5c44e33c0b7f40ccd3479a9

lib/shelley/test/data/cardano-node-shelley/deleg.vkey

@@ -1,4 +1,4 @@
 type: Node operator verification key
 title: Genesis delegate operator key
 cbor-hex:
- 5820a08f5fac8ae31f6e2d0d486b8494aece6227f3ea12086dee4e9d283043c5246c
+ 5820b59ad95cbbe425071364030fd195fa2ec97fa1382ec041d9bb75a64e896ade4b