accomodate withdrawals in constructSharedTransaction

cardano-foundation · May 30, 2023 · 63f3cd3 · 63f3cd3
1 parent f1757d4
commit 63f3cd3
Showing 1 changed file with 21 additions and 12 deletions.
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
@@ -2677,12 +2677,6 @@ constructTransaction api argGenChange knownPools poolStatus apiWalletId body = d
                 not $ withinSlotInterval before hereafter $
                     scriptSlotIntervals script
 
-    toUsignedTxWdrl p = \case
-        ApiWithdrawalGeneral (ApiRewardAccount rewardAcc) amount Our ->
-            Just (rewardAcc, Coin.fromQuantity amount, p)
-        ApiWithdrawalGeneral _ _ External ->
-            Nothing
-
     unsignedTx path initialOuts decodedTx = UnsignedTx
         { unsignedCollateral =
             mapMaybe toUnsignedTxInp (decodedTx ^. #collateral)
@@ -2728,6 +2722,14 @@ constructTransaction api argGenChange knownPools poolStatus apiWalletId body = d
             . Map.toList
             . foldr (uncurry (Map.insertWith (<>))) Map.empty
 
+toUsignedTxWdrl
+    :: c -> ApiWithdrawalGeneral n -> Maybe (RewardAccount, Coin, c)
+toUsignedTxWdrl p = \case
+    ApiWithdrawalGeneral (ApiRewardAccount rewardAcc) amount Our ->
+        Just (rewardAcc, Coin.fromQuantity amount, p)
+    ApiWithdrawalGeneral _ _ External ->
+        Nothing
+
 toUnsignedTxOut :: ApiTxOutputGeneral n -> TxOut
 toUnsignedTxOut = \case
     WalletOutput o ->
@@ -2848,7 +2850,6 @@ parseValidityInterval ti validityInterval = do
 
     pure (before, hereafter)
 
--- TO-DO withdrawals
 -- TO-DO minting/burning
 -- TO-DO reference scripts
 constructSharedTransaction
@@ -2901,8 +2902,14 @@ constructSharedTransaction
                     trWorker db epoch knownPools
                     getPoolStatus NoWithdrawal
 
+        withdrawal <- case body ^. #withdrawal of
+            Just SelfWithdraw -> liftIO $
+                W.shelleyOnlyMkSelfWithdrawal @_ @_ @n
+                      netLayer (txWitnessTagFor @SharedKey) era db
+            _ -> pure NoWithdrawal
+
         let txCtx = defaultTransactionCtx
-                { txWithdrawal = NoWithdrawal
+                { txWithdrawal = withdrawal
                 , txMetadata = md
                 , txValidityInterval = (Just before, hereafter)
                 , txDelegationAction = optionalDelegationAction
@@ -2957,14 +2964,14 @@ constructSharedTransaction
                     { transaction = balancedTx
                     , coinSelection =
                         mkApiCoinSelection deposits refunds
-                        delCerts md (unsignedTx outs apiDecoded)
+                        delCerts md (unsignedTx outs apiDecoded delCerts)
                     , fee = apiDecoded ^. #fee
                     }
   where
     ti :: TimeInterpreter (ExceptT PastHorizonException IO)
     ti = timeInterpreter (api ^. networkLayer)
 
-    unsignedTx initialOuts decodedTx = UnsignedTx
+    unsignedTx initialOuts decodedTx rewardDel = UnsignedTx
         { unsignedCollateral =
             mapMaybe toUnsignedTxInp (decodedTx ^. #collateral)
         , unsignedInputs =
@@ -2975,8 +2982,10 @@ constructSharedTransaction
         , unsignedChange =
             drop (length initialOuts)
                 $ map toUnsignedTxChange (decodedTx ^. #outputs)
-        , unsignedWithdrawals =
-            []
+        , unsignedWithdrawals = case rewardDel of
+                Nothing -> []
+                Just (_, path) ->
+                    mapMaybe (toUsignedTxWdrl path) (decodedTx ^. #withdrawals)
         }
 
 decodeSharedTransaction