fix joinStakePool logic

cardano-foundation · Apr 30, 2024 · c5915f0 · c5915f0
1 parent ee257db
commit c5915f0
Show file tree

Hide file tree

Showing 2 changed files with 19 additions and 8 deletions.
diff --git a/lib/integration/scenarios/Test/Integration/Scenario/API/Shelley/StakePools.hs b/lib/integration/scenarios/Test/Integration/Scenario/API/Shelley/StakePools.hs
@@ -51,7 +51,7 @@ import Cardano.Wallet.Api.Types.Amount
     ( ApiAmount (ApiAmount)
     )
 import Cardano.Wallet.Api.Types.Error
-    ( ApiErrorInfo (NoUtxosAvailable)
+    ( ApiErrorInfo (NoUtxosAvailable, PoolAlreadyJoinedSameVote)
     )
 import Cardano.Wallet.Faucet
     ( Faucet (..)
@@ -631,12 +631,12 @@ spec = describe "SHELLEY_STAKE_POOLS" $ do
                     ]
 
             -- joinStakePool would try once again joining pool and voting Abstain
-            joinStakePool @n ctx (SpecificPool pool) (w, fixturePassphrase)
-                >>= flip
-                    verify
-                    [ expectResponseCode HTTP.status403
-                    , expectErrorMessage (errMsg403PoolAlreadyJoined $ toText pool)
-                    ]
+            r <- joinStakePool @n ctx (SpecificPool pool) (w, fixturePassphrase)
+            verify r
+                [ expectResponseCode HTTP.status403
+
+                ]
+            decodeErrorInfo r `shouldBe` PoolAlreadyJoinedSameVote
 
     it "STAKE_POOLS_JOIN_03 - Cannot join a pool that has retired" $ \ctx -> runResourceT $ do
         waitForEpoch 3 ctx -- One pool retires at epoch 3

diff --git a/lib/wallet/src/Cardano/Wallet/IO/Delegation.hs b/lib/wallet/src/Cardano/Wallet/IO/Delegation.hs
@@ -363,14 +363,16 @@ joinStakePool ctx wid pools poolId poolStatus passphrase = do
     pp <- currentProtocolParameters netLayer
     currentEpochSlotting <- W.getCurrentEpochSlotting netLayer
 
+    (_,(_, dlg),_) <- W.readWallet ctx
+
     (delegation, votingM) <-
         joinStakePoolDelegationAction
             ctx
             currentEpochSlotting
             pools
             poolId
             poolStatus
-            Nothing
+            (Just $ votingWalletDelegation dlg)
 
     ttl <- W.transactionExpirySlot ti Nothing
     let transactionCtx =
@@ -398,6 +400,15 @@ joinStakePool ctx wid pools poolId poolStatus passphrase = do
     ti = timeInterpreter netLayer
     txLayer = ctx ^. transactionLayer
 
+    votingWalletDelegation (WalletDelegation current coming) =
+        isVoting current || any isVotingNext coming
+      where
+        isVoting (Voting _) = True
+        isVoting (DelegatingVoting _ _) = True
+        isVoting _ = False
+
+        isVotingNext (WalletDelegationNext _ deleg) = isVoting deleg
+
 {-----------------------------------------------------------------------------
     Quit stake pool
 ------------------------------------------------------------------------------}