address withdrawals

cardano-foundation · Oct 12, 2021 · b324b7b · b324b7b
1 parent 18f71d0
commit b324b7b
Show file tree

Hide file tree

Showing 2 changed files with 19 additions and 7 deletions.
diff --git a/lib/core/src/Cardano/Wallet/Api/Server.hs b/lib/core/src/Cardano/Wallet/Api/Server.hs
@@ -2353,28 +2353,40 @@ balanceTransaction ctx genChange (ApiT wid) body = do
             txCtx { txFeePadding }
 
 submitTransaction
-    :: forall ctx s k.
+    :: forall ctx s k (n :: NetworkDiscriminant).
         ( ctx ~ ApiLayer s k
         , HasNetworkLayer IO ctx
         , IsOwned s k
+        , WalletKey k
+        , HardDerivation k
+        , Typeable s
+        , Typeable n
+        , Bounded (Index (AddressIndexDerivationType k) 'AddressK)
         )
     => ctx
     -> ApiT WalletId
     -> ApiT W.SealedTx
     -> Handler ApiTxId
 submitTransaction ctx (ApiT wid) (ApiT sealedTx) = do
     ttl <- liftIO $ W.getTxExpiry ti Nothing
-    let txCtx = defaultTransactionCtx
-            { txTimeToLive = ttl
-            --, txWithdrawal = wdrl TODO
-            }
+    let (Tx txId _ _ _inps _outs wdrlMap _ _) = tx
+
     let sel = undefined
     _ <- withWorkerCtx ctx wid liftE liftE $ \wrk -> do
+        (acct, _, _) <- liftHandler $ W.readRewardAccount @_ @s @k @n wrk wid
+        (wdrl, _) <- mkRewardAccountBuilder @_ @s @_ @n ctx wid $
+            if Map.member acct wdrlMap
+            then Just SelfWithdrawal
+            else Nothing
+        let txCtx = defaultTransactionCtx
+                { txTimeToLive = ttl
+                , txWithdrawal = wdrl
+                }
         (txMeta,_) <- liftHandler
             $ W.constructTxMeta @_ @s @k wrk wid txCtx sel
         liftHandler
             $ W.submitTx @_ @s @k wrk wid (tx, txMeta, sealedTx)
-    return $ ApiTxId (ApiT (tx ^. #txId))
+    return $ ApiTxId (ApiT txId)
   where
     tx = decodeTx tl sealedTx
     tl = ctx ^. W.transactionLayer @k

diff --git a/lib/shelley/src/Cardano/Wallet/Shelley/Api/Server.hs b/lib/shelley/src/Cardano/Wallet/Shelley/Api/Server.hs
@@ -316,7 +316,7 @@ server byron icarus shelley multisig spl ntp =
         :<|> postTransactionOld shelley (delegationAddress @n)
         :<|> postTransactionFeeOld shelley
         :<|> balanceTransaction shelley (delegationAddress @n)
-        :<|> submitTransaction shelley
+        :<|> submitTransaction @_ @_ @_ @n shelley
 
     shelleyMigrations :: Server (ShelleyMigrations n)
     shelleyMigrations =