detect the same vote in voteAction

cardano-foundation · Apr 30, 2024 · abafcdb · abafcdb
1 parent e390a0b
commit abafcdb
Show file tree

Hide file tree

Showing 3 changed files with 36 additions and 15 deletions.
diff --git a/lib/api/src/Cardano/Wallet/Api/Http/Shelley/Server.hs b/lib/api/src/Cardano/Wallet/Api/Http/Shelley/Server.hs
@@ -2761,6 +2761,13 @@ constructTransaction api argGenChange knownPools poolStatus apiWalletId body = d
                     db
             _ -> pure NoWithdrawal
 
+        (optionalVoteAction, votingSameAgain) <- case (body ^. #vote) of
+            Just (ApiT action) -> do
+                (voteAction, votingSameAgain) <- liftIO $ IODeleg.voteAction wrk action
+                pure (Just voteAction, votingSameAgain)
+            Nothing ->
+                pure (Nothing, False)
+
         currentEpochSlotting <- liftIO $ getCurrentEpochSlotting netLayer
         optionalDelegationAction <- liftIO $
             forM delegationRequest $
@@ -2769,13 +2776,6 @@ constructTransaction api argGenChange knownPools poolStatus apiWalletId body = d
                     currentEpochSlotting knownPools
                     poolStatus withdrawal
 
-        optionalVoteAction <- case (body ^. #vote) of
-            Just (ApiT action) ->
-                liftIO $ Just <$>
-                    IODeleg.voteAction wrk action
-            Nothing ->
-                pure Nothing
-
         let transactionCtx0 = defaultTransactionCtx
                 { txWithdrawal = withdrawal
                 , txVotingAction = optionalVoteAction
@@ -3312,17 +3312,19 @@ constructSharedTransaction
         when (isNothing delegationTemplateM && isJust delegationRequest) $
             liftHandler $ throwE ErrConstructTxDelegationInvalid
 
+        (optionalVoteAction, votingSameAgain) <- case (body ^. #vote) of
+            Just (ApiT action) -> do
+                (voteAction, votingSameAgain) <- liftIO $ IODeleg.voteAction wrk action
+                pure (Just voteAction, votingSameAgain)
+            Nothing ->
+                pure (Nothing, False)
+
         optionalDelegationAction <- liftIO $
             forM delegationRequest $
                 IODeleg.handleDelegationRequest
                     wrk currentEpochSlotting knownPools
                     getPoolStatus NoWithdrawal
 
-        optionalVoteAction <- case (body ^. #vote) of
-            Just (ApiT action) -> liftIO $ Just <$>
-                IODeleg.voteAction wrk action
-            Nothing -> pure Nothing
-
         let txCtx = defaultTransactionCtx
                 { txWithdrawal = withdrawal
                 , txDeposit = Just $ W.getStakeKeyDeposit pp

diff --git a/lib/integration/scenarios/Test/Integration/Scenario/API/Shelley/TransactionsNew.hs b/lib/integration/scenarios/Test/Integration/Scenario/API/Shelley/TransactionsNew.hs
@@ -3458,6 +3458,12 @@ spec = describe "NEW_SHELLEY_TRANSACTIONS" $ do
                      (`shouldBe` votingAndDelegating (ApiT pool1) (ApiT Abstain) [])
                 ]
 
+        rTx3 <- request @(ApiConstructTransaction n) ctx
+            (Link.createUnsignedTransaction @'Shelley src) Default delegationJoin
+        verify rTx3
+            [ expectResponseCode HTTP.status202
+            ]
+
     it "TRANS_NEW_JOIN_02 - Can join stakepool in case I have many UTxOs on 1 address"
         $ \ctx -> runResourceT $ do
         let amt = minUTxOValue (_mainEra ctx)

diff --git a/lib/wallet/src/Cardano/Wallet/IO/Delegation.hs b/lib/wallet/src/Cardano/Wallet/IO/Delegation.hs
@@ -85,6 +85,9 @@ import Cardano.Wallet.Primitive.Passphrase
 import Cardano.Wallet.Primitive.Types
     ( PoolLifeCycleStatus
     , ProtocolParameters (..)
+    , WalletDelegation (..)
+    , WalletDelegationNext (..)
+    , WalletDelegationStatus (..)
     , WalletId
     )
 import Cardano.Wallet.Primitive.Types.DRep
@@ -159,8 +162,9 @@ handleDelegationRequest
 voteAction
     :: WalletLayer IO s
     -> DRep
-    -> IO Tx.VotingAction
+    -> IO (Tx.VotingAction, Bool)
 voteAction ctx action = do
+    (_,(_, dlg),_) <- W.readWallet ctx
     (_, stakeKeyIsRegistered) <- db & \DBLayer{atomically,walletState} ->
         atomically $
             (,) <$> readDelegation walletState
@@ -170,12 +174,21 @@ voteAction ctx action = do
 
     pure $
         if stakeKeyIsRegistered
-        then Tx.Vote action
-        else Tx.VoteRegisteringKey action
+        then (Tx.Vote action, sameWalletDelegation dlg)
+        else (Tx.VoteRegisteringKey action, sameWalletDelegation dlg)
   where
     db = ctx ^. dbLayer
     tr = ctx ^. logger
 
+    isDRepSame (Voting drep) = drep == action
+    isDRepSame (DelegatingVoting _ drep) = drep == action
+    isDRepSame _ = False
+
+    isSameNext (WalletDelegationNext _ deleg) = isDRepSame deleg
+
+    sameWalletDelegation (WalletDelegation current coming) =
+        isDRepSame current || any isSameNext coming
+
 {-----------------------------------------------------------------------------
     Used by Daedalus
 ------------------------------------------------------------------------------}