From b0c0c44950bea839e861948e01ffe97754a624da Mon Sep 17 00:00:00 2001
From: Jonathan Knowles <jonathan.knowles@iohk.io>
Date: Wed, 12 May 2021 04:31:14 +0000
Subject: [PATCH] Make `migrateWallet` endpoint return non-empty tx list.

In the case where there really is nothing to migrate, we already return
a 403 error. So there's no point in using types that make it possible to
return an empty list of transactions as part of a successful response.
---
 lib/core/src/Cardano/Wallet.hs            |  5 ++--
 lib/core/src/Cardano/Wallet/Api.hs        |  6 +++--
 lib/core/src/Cardano/Wallet/Api/Server.hs | 28 +++++++++++++----------
 specifications/api/swagger.yaml           |  1 +
 4 files changed, 24 insertions(+), 16 deletions(-)

diff --git a/lib/core/src/Cardano/Wallet.hs b/lib/core/src/Cardano/Wallet.hs
index d91048d08f9..eb1e7750b9c 100644
--- a/lib/core/src/Cardano/Wallet.hs
+++ b/lib/core/src/Cardano/Wallet.hs
@@ -1843,9 +1843,10 @@ migrationPlanToSelectionWithdrawals
     => MigrationPlan
     -> Withdrawal
     -> NonEmpty Address
-    -> [(SelectionResult noChange, Withdrawal)]
+    -> Maybe (NonEmpty (SelectionResult noChange, Withdrawal))
 migrationPlanToSelectionWithdrawals plan rewardWithdrawal outputAddressesToCycle
-    = fst
+    = NE.nonEmpty
+    $ fst
     $ L.foldr
         (accumulate)
         ([], NE.toList $ NE.cycle outputAddressesToCycle)
diff --git a/lib/core/src/Cardano/Wallet/Api.hs b/lib/core/src/Cardano/Wallet/Api.hs
index 4d9193887f5..49bfd158324 100644
--- a/lib/core/src/Cardano/Wallet/Api.hs
+++ b/lib/core/src/Cardano/Wallet/Api.hs
@@ -227,6 +227,8 @@ import Data.Generics.Product.Typed
     ( HasType, typed )
 import Data.Kind
     ( Type )
+import Data.List.NonEmpty
+    ( NonEmpty )
 import GHC.Generics
     ( Generic )
 import Servant.API
@@ -513,7 +515,7 @@ type MigrateShelleyWallet n = "wallets"
     :> Capture "walletId" (ApiT WalletId)
     :> "migrations"
     :> ReqBody '[JSON] (ApiWalletMigrationPostDataT n "raw")
-    :> PostAccepted '[JSON] [ApiTransactionT n]
+    :> PostAccepted '[JSON] (NonEmpty (ApiTransactionT n))
 
 -- | https://input-output-hk.github.io/cardano-wallet/api/#operation/createShelleyWalletMigrationPlan
 type CreateShelleyWalletMigrationPlan n = "wallets"
@@ -797,7 +799,7 @@ type MigrateByronWallet n = "byron-wallets"
     :> Capture "walletId" (ApiT WalletId)
     :> "migrations"
     :> ReqBody '[JSON] (ApiWalletMigrationPostDataT n "lenient")
-    :> PostAccepted '[JSON] [ApiTransactionT n]
+    :> PostAccepted '[JSON] (NonEmpty (ApiTransactionT n))
 
 -- | https://input-output-hk.github.io/cardano-wallet/api/#operation/createByronWalletMigrationPlan
 type CreateByronWalletMigrationPlan n = "byron-wallets"
diff --git a/lib/core/src/Cardano/Wallet/Api/Server.hs b/lib/core/src/Cardano/Wallet/Api/Server.hs
index 54b06839a82..f24119c9892 100644
--- a/lib/core/src/Cardano/Wallet/Api/Server.hs
+++ b/lib/core/src/Cardano/Wallet/Api/Server.hs
@@ -2053,8 +2053,18 @@ mkApiWalletMigrationPlan s addresses rewardWithdrawal plan
         Nothing
   where
     maybeSelections :: Maybe (NonEmpty (ApiCoinSelection n))
-    maybeSelections = NE.nonEmpty $
-        mkApiCoinSelectionForMigration <$> unsignedTxs
+    maybeSelections = fmap mkApiCoinSelectionForMigration <$> maybeUnsignedTxs
+
+    maybeSelectionWithdrawals
+        :: Maybe (NonEmpty (SelectionResult Void, Withdrawal))
+    maybeSelectionWithdrawals
+        = W.migrationPlanToSelectionWithdrawals plan rewardWithdrawal
+        $ getApiT . fst <$> addresses
+
+    maybeUnsignedTxs = fmap mkUnsignedTx <$> maybeSelectionWithdrawals
+      where
+        mkUnsignedTx (selection, withdrawal) = W.selectionToUnsignedTx
+            withdrawal (selection {changeGenerated = []}) s
 
     totalFee :: Quantity "lovelace" Natural
     totalFee = coinToQuantity $ view #totalFee plan
@@ -2071,14 +2081,6 @@ mkApiWalletMigrationPlan s addresses rewardWithdrawal plan
         & F.foldMap (view #inputBalance)
         & mkApiWalletMigrationBalance
 
-    selectionWithdrawals :: [(SelectionResult Void, Withdrawal)]
-    selectionWithdrawals
-        = W.migrationPlanToSelectionWithdrawals plan rewardWithdrawal
-        $ getApiT . fst <$> addresses
-
-    unsignedTxs = selectionWithdrawals <&> \(selection, withdrawal) ->
-        W.selectionToUnsignedTx withdrawal (selection {changeGenerated = []}) s
-
     mkApiCoinSelectionForMigration unsignedTx =
         mkApiCoinSelection [] Nothing Nothing unsignedTx
 
@@ -2103,14 +2105,16 @@ migrateWallet
     => ctx
     -> ApiT WalletId
     -> ApiWalletMigrationPostData n p
-    -> Handler [ApiTransaction n]
+    -> Handler (NonEmpty (ApiTransaction n))
 migrateWallet ctx (ApiT wid) postData = do
     (rewardWithdrawal, mkRewardAccount) <-
         mkRewardAccountBuilder @_ @s @_ @n ctx wid Nothing
     withWorkerCtx ctx wid liftE liftE $ \wrk -> do
         plan <- liftHandler $ W.createMigrationPlan wrk wid rewardWithdrawal
         txTimeToLive <- liftIO $ W.getTxExpiry ti Nothing
-        let selectionWithdrawals = W.migrationPlanToSelectionWithdrawals
+        selectionWithdrawals <- liftHandler
+            $ failWith ErrCreateMigrationPlanEmpty
+            $ W.migrationPlanToSelectionWithdrawals
                 plan rewardWithdrawal addresses
         forM selectionWithdrawals $ \(selection, txWithdrawal) -> do
             let txContext = defaultTransactionCtx
diff --git a/specifications/api/swagger.yaml b/specifications/api/swagger.yaml
index 0d778581858..d947896042f 100644
--- a/specifications/api/swagger.yaml
+++ b/specifications/api/swagger.yaml
@@ -3655,6 +3655,7 @@ x-responsesMigrateWallet: &responsesMigrateWallet
         schema:
           type: array
           items: *ApiTransaction
+          minItems: 1
 
 x-responsesDeleteWallet: &responsesDeleteWallet
   <<: *responsesErr400