call proper mkWihtdrawal from Cardano.Wallet

cardano-foundation · May 29, 2023 · c5a432b · c5a432b
1 parent 8a07ce9
commit c5a432b
Show file tree

Hide file tree

Showing 3 changed files with 36 additions and 0 deletions.
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
@@ -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
@@ -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
@@ -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