Try #3119:

lib/core-integration/src/Test/Integration/Framework/DSL.hs

@@ -2026,7 +2026,8 @@ faucetUtxoAmt = ada 100_000
     ada = (*) (1_000_000)
 
 getFromResponse
-    :: Lens' s a
+    :: HasCallStack
+    => Lens' s a
     -> (HTTP.Status, Either RequestException s)
     -> a
 getFromResponse getter (_, res) = case res of

lib/core-integration/src/Test/Integration/Scenario/API/Shelley/StakePools.hs

@@ -27,6 +27,7 @@ import Cardano.Wallet.Api.Types
     , ApiTxInput (..)
     , ApiWallet
     , ApiWalletDelegationStatus (..)
+    , ApiWithdrawal (..)
     , DecodeAddress
     , DecodeStakeAddress
     , EncodeAddress
@@ -122,6 +123,7 @@ import Test.Integration.Framework.DSL
     , quitStakePoolUnsigned
     , replaceStakeKey
     , request
+    , rewardWallet
     , triggerMaintenanceAction
     , unsafeRequest
     , unsafeResponse
@@ -139,7 +141,6 @@ import Test.Integration.Framework.DSL
 import Test.Integration.Framework.TestData
     ( errMsg403EmptyUTxO
     , errMsg403Fee
-    , errMsg403NonNullReward
     , errMsg403NotDelegating
     , errMsg403PoolAlreadyJoined
     , errMsg403WrongPass
@@ -401,6 +402,8 @@ spec = describe "SHELLEY_STAKE_POOLS" $ do
             [ expectResponseCode HTTP.status202
             , expectField (#status . #getApiT) (`shouldBe` Pending)
             , expectField (#direction . #getApiT) (`shouldBe` Incoming)
+            , expectField #depositTaken (`shouldBe` Quantity 0)
+            , expectField #depositReturned (`shouldBe` Quantity 1000000)
             ]
         let txid = getFromResponse Prelude.id rq
         let quitFeeAmt = getFromResponse #amount rq
@@ -524,6 +527,26 @@ spec = describe "SHELLEY_STAKE_POOLS" $ do
             , expectErrorMessage errMsg403NotDelegating
             ]
 
+    it "STAKE_POOLS_QUIT_03 - Can quit with rewards"
+        $ \ctx -> runResourceT $ do
+        (w, _) <- rewardWallet ctx
+
+        pool:_:_ <- map (view #id) . snd
+            <$> unsafeRequest @[ApiStakePool]
+                ctx (Link.listStakePools arbitraryStake) Empty
+        joinStakePool @n ctx pool (w, fixturePassphrase) >>= flip verify
+            [ expectResponseCode HTTP.status202
+            , expectField #depositTaken (`shouldBe` (Quantity 0))
+            , expectField #depositReturned (`shouldBe` (Quantity 0))
+            ]
+        waitForTxImmutability ctx
+        quitStakePool @n ctx (w, fixturePassphrase) >>= flip verify
+            [ expectResponseCode HTTP.status202
+            , expectField #depositTaken (`shouldBe` (Quantity 0))
+            , expectField #depositReturned
+                (`shouldBe` (Quantity 1000000))
+            ]
+
     it "STAKE_POOLS_JOIN_01 - Can rejoin another stakepool" $ \ctx -> runResourceT $ do
         w <- fixtureWallet ctx
         pool1:pool2:_ <- map (view #id) . snd
@@ -626,10 +649,12 @@ spec = describe "SHELLEY_STAKE_POOLS" $ do
                         (.> (Quantity 0))
                     ]
 
-        -- Can't quite if unspoiled rewards.
+        -- Can quit with rewards
         quitStakePool @n ctx (w, fixturePassphrase) >>= flip verify
-            [ expectResponseCode HTTP.status403
-            , expectErrorMessage errMsg403NonNullReward
+            [ expectResponseCode HTTP.status202
+            , expectField #depositReturned (`shouldBe` Quantity 1000000)
+            , expectField (#withdrawals)
+                (\[ApiWithdrawal _ c] -> c .> Quantity 0)
             ]
 
     it "STAKE_POOLS_JOIN_05 - \

lib/core-integration/src/Test/Integration/Scenario/API/Shelley/TransactionsNew.hs

@@ -189,6 +189,7 @@ import Test.Integration.Framework.TestData
     , errMsg403MissingWitsInTransaction
     , errMsg403MultiaccountTransaction
     , errMsg403MultidelegationTransaction
+    , errMsg403NonNullReward
     , errMsg403NotDelegating
     , errMsg403NotEnoughMoney
     , errMsg404NoSuchPool
@@ -2717,6 +2718,103 @@ spec = describe "NEW_SHELLEY_TRANSACTIONS" $ do
             , expectErrorMessage errMsg403NotDelegating
             ]
 
+    it "TRANS_NEW_QUIT_02a - Cannot quit with rewards without explicit withdrawal"
+        $ \ctx -> runResourceT $ do
+        (w, _) <- rewardWallet ctx
+
+        pool1:_:_ <- map (view #id) . snd
+            <$> unsafeRequest @[ApiStakePool]
+                ctx (Link.listStakePools arbitraryStake) Empty
+
+        let payload = Json [json|{
+                "delegations": [{
+                    "join": {
+                        "pool": #{pool1},
+                        "stake_key_index": "0H"
+                    }
+                }]
+            }|]
+        unsignedTx1 <- view #transaction . snd
+            <$> unsafeRequest @(ApiConstructTransaction n) ctx
+            (Link.createUnsignedTransaction @'Shelley w) payload
+        signedTx1 <- signTx ctx w unsignedTx1 [ expectResponseCode HTTP.status202 ]
+        submitTxWithWid ctx w signedTx1 >>= flip verify
+            [ expectSuccess
+            , expectResponseCode HTTP.status202
+            ]
+
+        waitForTxImmutability ctx
+
+        let payload2 = Json [json|{
+                "delegations": [{
+                    "quit": {
+                        "stake_key_index": "0H"
+                    }
+                }]
+            }|]
+        request @(ApiConstructTransaction n) ctx
+            (Link.createUnsignedTransaction @'Shelley w) Default payload2
+            >>= flip verify
+            [ expectResponseCode HTTP.status403
+            , expectErrorMessage errMsg403NonNullReward
+            ]
+
+    it "TRANS_NEW_QUIT_02b - Can quit with rewards with explicit withdrawal"
+        $ \ctx -> runResourceT $ do
+        (w, _) <- rewardWallet ctx
+
+        pool1:_:_ <- map (view #id) . snd
+            <$> unsafeRequest @[ApiStakePool]
+                ctx (Link.listStakePools arbitraryStake) Empty
+
+        let payload = Json [json|{
+                "delegations": [{
+                    "join": {
+                        "pool": #{pool1},
+                        "stake_key_index": "0H"
+                    }
+                }]
+            }|]
+        rUnsignedTx1 <- request @(ApiConstructTransaction n) ctx
+            (Link.createUnsignedTransaction @'Shelley w) Default payload
+        let unsignedTx1 = getFromResponse #transaction rUnsignedTx1
+        verify rUnsignedTx1
+            [ expectField (#coinSelection . #depositsReturned)
+                (`shouldBe` [])
+            , expectField (#coinSelection . #depositsTaken)
+                (`shouldBe` []) -- key already registered
+            ]
+        signedTx1 <- signTx ctx w unsignedTx1 [ expectResponseCode HTTP.status202 ]
+        submitTxWithWid ctx w signedTx1 >>= flip verify
+            [ expectSuccess
+            , expectResponseCode HTTP.status202
+            ]
+
+        waitForTxImmutability ctx
+
+        let payload2 = Json [json|{
+                "delegations": [{
+                    "quit": {
+                        "stake_key_index": "0H"
+                    }
+                }],
+                "withdrawal": "self"
+            }|]
+        rUnsignedTx2 <- request @(ApiConstructTransaction n) ctx
+            (Link.createUnsignedTransaction @'Shelley w) Default payload2
+        let unsignedTx2 = getFromResponse #transaction rUnsignedTx2
+        verify rUnsignedTx2
+            [ expectField (#coinSelection . #depositsReturned)
+                (`shouldBe` [Quantity 1000000])
+            , expectField (#coinSelection . #depositsTaken)
+                (`shouldBe` [])
+            ]
+        signedTx2 <- signTx ctx w unsignedTx2 [ expectResponseCode HTTP.status202 ]
+        submitTxWithWid ctx w signedTx2 >>= flip verify
+            [ expectSuccess
+            , expectResponseCode HTTP.status202
+            ]
+
     it "TRANS_NEW_CREATE_MULTI_TX - Tx including payments, delegation, metadata, withdrawals, validity_interval" $ \ctx -> runResourceT $ do
         wa <- fixtureWallet ctx
         wb <- emptyWallet ctx

lib/core/src/Cardano/Wallet.hs

@@ -2582,8 +2582,9 @@ quitStakePool
         )
     => ctx
     -> WalletId
+    -> Withdrawal
     -> ExceptT ErrStakePoolDelegation IO DelegationAction
-quitStakePool ctx wid = db & \DBLayer{..} -> do
+quitStakePool ctx wid wdrl = db & \DBLayer{..} -> do
     walMeta <- mapExceptT atomically
         $ withExceptT ErrStakePoolDelegationNoSuchWallet
         $ withNoSuchWallet wid
@@ -2593,7 +2594,7 @@ quitStakePool ctx wid = db & \DBLayer{..} -> do
         $ fetchRewardBalance @ctx @s @k ctx wid
 
     withExceptT ErrStakePoolQuit $ except $
-        guardQuit (walMeta ^. #delegation) rewards
+        guardQuit (walMeta ^. #delegation) wdrl rewards
 
     pure Quit
   where
@@ -3257,16 +3258,20 @@ guardJoin knownPools delegation pid mRetirementEpochInfo = do
 
 guardQuit
     :: WalletDelegation
+    -> Withdrawal
     -> Coin
     -> Either ErrCannotQuit ()
-guardQuit WalletDelegation{active,next} rewards = do
+guardQuit WalletDelegation{active,next} wdrl rewards = do
     let last_ = maybe active (view #status) $ lastMay next
 
     unless (isDelegatingTo anyone last_) $
         Left ErrNotDelegatingOrAboutTo
 
-    unless (rewards == Coin 0) $
-        Left $ ErrNonNullRewards rewards
+    case wdrl of
+        WithdrawalSelf {} -> return ()
+        _
+            | rewards == Coin 0  -> return ()
+            | otherwise          -> Left $ ErrNonNullRewards rewards
   where
     anyone = const True
 

lib/core/src/Cardano/Wallet/Api/Server.hs

@@ -1664,19 +1664,24 @@ selectCoinsForQuit
         , ctx ~ ApiLayer s k
         , DelegationAddress n k
         , MkKeyFingerprint k (Proxy n, k 'AddressK XPub)
+        , Bounded (Index (AddressIndexDerivationType k) 'AddressK)
         , SoftDerivation k
         , Typeable n
         , Typeable s
+        , WalletKey k
         )
     => ctx
     -> ApiT WalletId
     -> Handler (Api.ApiCoinSelection n)
 selectCoinsForQuit ctx (ApiT wid) = do
     withWorkerCtx ctx wid liftE liftE $ \wrk -> do
-        action <- liftHandler $ W.quitStakePool @_ @s @k wrk wid
+        (wdrl, _mkRwdAcct) <-
+            mkRewardAccountBuilder @_ @s @_ @n ctx wid (Just SelfWithdrawal)
+        action <- liftHandler $ W.quitStakePool @_ @s @k wrk wid wdrl
 
         let txCtx = defaultTransactionCtx
                 { txDelegationAction = Just action
+                , txWithdrawal = wdrl
                 }
 
         let transform s sel =
@@ -2187,7 +2192,7 @@ constructTransaction ctx genChange knownPools getPoolStatus (ApiT wid) body = do
                             W.joinStakePool @_ @s @k wrk curEpoch pools pid poolStatus wid
                         pure (del, act, Nothing)
                     [(Leaving _)] -> do
-                        del <- liftHandler $ W.quitStakePool @_ @s @k wrk wid
+                        del <- liftHandler $ W.quitStakePool @_ @s @k wrk wid wdrl
                         pure (del, Nothing, Just $ W.stakeKeyDeposit pp)
                     _ ->
                         liftHandler $ throwE ErrConstructTxMultidelegationNotSupported
@@ -2667,10 +2672,8 @@ quitStakePool ctx (ApiT wid) body = do
     let pwd = coerce $ getApiT $ body ^. #passphrase
 
     (sel, tx, txMeta, txTime, pp) <- withWorkerCtx ctx wid liftE liftE $ \wrk -> do
-        action <- liftHandler
-            $ W.quitStakePool @_ @s @k wrk wid
-
-        (wdrl, mkRwdAcct) <- mkRewardAccountBuilder @_ @s @_ @n ctx wid Nothing
+        (wdrl, mkRwdAcct) <- mkRewardAccountBuilder @_ @s @_ @n ctx wid (Just SelfWithdrawal)
+        action <- liftHandler $ W.quitStakePool wrk wid wdrl
         ttl <- liftIO $ W.getTxExpiry ti Nothing
         let txCtx = defaultTransactionCtx
                 { txWithdrawal = wdrl
@@ -3455,17 +3458,13 @@ mkApiTransaction timeInterpreter setTimeReference tx = do
     reclaimIfAny :: Natural
     reclaimIfAny
         | tx ^. (#txMeta . #direction) == W.Incoming =
-              if ( totalInWithoutFee > 0 && totalOut > 0 && totalOut > totalInWithoutFee)
-                 && (totalOut - totalInWithoutFee <= depositValue) then
+              if ( totalIn > 0 && totalOut > 0 && totalOut > totalIn)
+                 && (totalOut - totalIn <= depositValue) then
                   depositValue
               else
                   0
         | otherwise = 0
 
-    totalInWithoutFee :: Natural
-    totalInWithoutFee
-        = sum (txOutValue <$> mapMaybe snd (tx ^. #txInputs))
-
     totalIn :: Natural
     totalIn
         = sum (txOutValue <$> mapMaybe snd (tx ^. #txInputs))