From c5a432b082c9275ef79d64c55d1bc748e200d77b Mon Sep 17 00:00:00 2001
From: Pawel Jakubas <pawel.jakubas@iohk.io>
Date: Wed, 26 Apr 2023 10:22:21 +0200
Subject: [PATCH] call proper mkWihtdrawal from Cardano.Wallet

---
 .../Cardano/Wallet/Api/Http/Server/Error.hs   |  6 +++++
 .../Cardano/Wallet/Api/Http/Shelley/Server.hs |  7 ++++++
 lib/wallet/src/Cardano/Wallet.hs              | 23 +++++++++++++++++++
 3 files changed, 36 insertions(+)

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 7cb8e7b9507..718026af786 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
@@ -720,6 +720,12 @@ instance IsServerError ErrReadRewardAccount where
                 , "that is invalid for this type of wallet. Only new 'Shelley' "
                 , "wallets can do something with rewards and this one isn't."
                 ]
+        ErrReadRewardAccountMissing ->
+            apiError err501 MissingRewardAccount $ mconcat
+                [ "I couldn't read a reward account which is required for "
+                , "withdrawals. Either there is db malfunction or withdrawals "
+                , "was used for shared wallets missing delegation template."
+                ]
 
 instance IsServerError ErrReadPolicyPublicKey where
     toServerError = \case
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 f2f96c315b5..1ad07f80bb6 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
@@ -2892,6 +2892,13 @@ constructSharedTransaction
         AnyRecentEra (_recentEra :: Write.RecentEra era)
             <- guardIsRecentEra era
         (cp, _, _) <- handler $ W.readWallet wrk
+
+        withdrawal <- case body ^. #withdrawal of
+            Just SelfWithdraw -> liftIO $
+                W.mkSelfWithdrawalShared @_ @_ @n
+                    netLayer txLayer era db wid
+            _ -> pure NoWithdrawal
+
         let delegationTemplateM = Shared.delegationTemplate $ getState cp
         when (isNothing delegationTemplateM && isJust delegationRequest) $
             liftHandler $ throwE ErrConstructTxDelegationInvalid
diff --git a/lib/wallet/src/Cardano/Wallet.hs b/lib/wallet/src/Cardano/Wallet.hs
index b9c4415a438..cd365f0abef 100644
--- a/lib/wallet/src/Cardano/Wallet.hs
+++ b/lib/wallet/src/Cardano/Wallet.hs
@@ -89,6 +89,7 @@ module Cardano.Wallet
     , checkWalletIntegrity
     , mkExternalWithdrawal
     , mkSelfWithdrawal
+    , mkSelfWithdrawalShared
     , shelleyOnlyMkSelfWithdrawal
     , readRewardAccount
     , shelleyOnlyReadRewardAccount
@@ -1272,6 +1273,27 @@ shelleyOnlyMkSelfWithdrawal netLayer txWitnessTag era db =
     notShelleyWallet = throwIO
         $ ExceptionReadRewardAccount ErrReadRewardAccountNotAShelleyWallet
 
+mkSelfWithdrawalShared
+    :: forall ktype tx n block
+     . NetworkLayer IO block
+    -> TransactionLayer SharedKey ktype tx
+    -> AnyCardanoEra
+    -> DBLayer IO (SharedState n SharedKey) SharedKey
+    -> WalletId
+    -> IO Withdrawal
+mkSelfWithdrawalShared netLayer txLayer era db wallet = do
+    rewardAccountM <-
+        runExceptT (readSharedRewardAccount db wallet)
+            >>= either (throwIO . ExceptionReadRewardAccount) pure
+    when (isNothing rewardAccountM) $
+        throwIO $ ExceptionReadRewardAccount ErrReadRewardAccountMissing
+    let (rewardAccount, derivationPath) = fromJust rewardAccountM
+    balance <- getCachedRewardAccountBalance netLayer rewardAccount
+    pp <- currentProtocolParameters netLayer
+    return $ case checkRewardIsWorthTxCost txLayer pp era balance of
+        Left ErrWithdrawalNotBeneficial -> NoWithdrawal
+        Right () -> WithdrawalSelf rewardAccount derivationPath balance
+
 checkRewardIsWorthTxCost
     :: TxWitnessTag
     -> ProtocolParameters
@@ -3457,6 +3479,7 @@ data ErrNotASequentialWallet
 
 data ErrReadRewardAccount
     = ErrReadRewardAccountNotAShelleyWallet
+    | ErrReadRewardAccountMissing
     deriving (Generic, Eq, Show)
 
 data ErrWithdrawalNotBeneficial