Allow redelegation to the same pool in Conway (#4562)

<!--
Detail in a few bullet points the work accomplished in this PR.

Before you submit, don't forget to:

* Make sure the GitHub PR fields are correct:
   ✓ Set a good Title for your PR.
   ✓ Assign yourself to the PR.
   ✓ Assign one or more reviewer(s).
   ✓ Link to a Jira issue, and/or other GitHub issues or PRs.
   ✓ In the PR description delete any empty sections
     and all text commented in <!--, so that this text does not appear
     in merge commit messages.

* Don't waste reviewers' time:
   ✓ If it's a draft, select the Create Draft PR option.
✓ Self-review your changes to make sure nothing unexpected slipped
through.

* Try to make your intent clear:
   ✓ Write a good Description that explains what this PR is meant to do.
   ✓ Jira will detect and link to this PR once created, but you can also
     link this PR in the description of the corresponding Jira ticket.
   ✓ Highlight what Testing you have done.
   ✓ Acknowledge any changes required to the Documentation.
-->

- [x] Change of re-delegation logic.
- [x] Adjust unit tests
- [x] Add new unit tests
- [x] Add integration testing showing the case
- [x]  Babbage: re-delegation to the same pool -> ERROR
- [x] Conway:  re-delegation to the same pool -> ERROR
- [x] Conway: re-delegation to the same pool + new vote or re-vote other
than recent -> OK
- [x] Conway: re-delegation to the same pool + vote the same again ->
ERROR
- [x] Conway: re-delegation to the different pool + vote the same again
-> OK
- [x] Conway: vote the same again -> ERROR
- [x] check joinStakePools
- [x] add handleDelegationVoteRequest

### Comments
In order to run integration tests do the following:
(a) Babbage
```
just integration-tests-cabal-match TRANS_NEW_JOIN_01f
```
(b) Conway
```
just conway-integration-tests-cabal-match TRANS_NEW_JOIN_01f
```
<!-- Additional comments, links, or screenshots to attach, if any. -->

### Issue Number
adp 3312
<!-- Reference the Jira/GitHub issue that this PR relates to, and which
requirements it tackles.
  Note: Jira issues of the form ADP- will be auto-linked. -->

lib/api/src/Cardano/Wallet/Api/Http/Server/Error.hs

@@ -37,6 +37,7 @@ import Cardano.Wallet
     ( ErrAddCosignerKey (..)
     , ErrCannotJoin (..)
     , ErrCannotQuit (..)
+    , ErrCannotVote (..)
     , ErrConstructSharedWallet (..)
     , ErrConstructTx (..)
     , ErrCreateMigrationPlan (..)
@@ -240,6 +241,7 @@ instance IsServerError WalletException where
         ExceptionWritePolicyPublicKey e -> toServerError e
         ExceptionSoftDerivationIndex e -> toServerError e
         ExceptionHardenedDerivationIndex e -> toServerError e
+        ExceptionVoting e -> toServerError e
 
 instance IsServerError ErrNoSuchWallet where
     toServerError = \case
@@ -721,6 +723,23 @@ instance IsServerError ErrCannotJoin where
                 [ "I couldn't find any stake pool with the given id: "
                 , toText pid
                 ]
+        ErrAlreadyDelegatingVoting pid ->
+            apiError err403 PoolAlreadyJoinedSameVote $ mconcat
+                [ "I couldn't join a stake pool with the given id: "
+                , toText pid
+                , " and vote. I have already joined this pool, also voted the same last time;"
+                , " joining/voting again would incur an unnecessary fee!"
+                ]
+
+instance IsServerError ErrCannotVote where
+    toServerError = \case
+        ErrAlreadyVoted drep ->
+            apiError err403 SameVote $ mconcat
+                [ "I couldn't cast a vote :  "
+                , toText drep
+                , ". I have already voted like that;"
+                , " repeating this action would incur an unnecessary fee!"
+                ]
 
 instance IsServerError ErrCannotQuit where
     toServerError = \case

lib/api/src/Cardano/Wallet/Api/Http/Shelley/Server.hs

@@ -2762,19 +2762,11 @@ constructTransaction api argGenChange knownPools poolStatus apiWalletId body = d
             _ -> pure NoWithdrawal
 
         currentEpochSlotting <- liftIO $ getCurrentEpochSlotting netLayer
-        optionalDelegationAction <- liftIO $
-            forM delegationRequest $
-                IODeleg.handleDelegationRequest
-                    wrk
-                    currentEpochSlotting knownPools
-                    poolStatus withdrawal
-
-        optionalVoteAction <- case (body ^. #vote) of
-            Just (ApiT action) ->
-                liftIO $ Just <$>
-                    IODeleg.voteAction wrk action
-            Nothing ->
-                pure Nothing
+        (optionalDelegationAction, optionalVoteAction) <- liftIO $
+            IODeleg.handleDelegationVoteRequest wrk
+            currentEpochSlotting knownPools
+            poolStatus withdrawal delegationRequest
+            (getApiT <$> body ^. #vote)
 
         let transactionCtx0 = defaultTransactionCtx
                 { txWithdrawal = withdrawal
@@ -3312,16 +3304,11 @@ constructSharedTransaction
         when (isNothing delegationTemplateM && isJust delegationRequest) $
             liftHandler $ throwE ErrConstructTxDelegationInvalid
 
-        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
+        (optionalDelegationAction, optionalVoteAction) <- liftIO $
+            IODeleg.handleDelegationVoteRequest wrk
+            currentEpochSlotting knownPools
+            getPoolStatus NoWithdrawal delegationRequest
+            (getApiT <$> body ^. #vote)
 
         let txCtx = defaultTransactionCtx
                 { txWithdrawal = withdrawal

lib/api/src/Cardano/Wallet/Api/Types/Error.hs

@@ -168,11 +168,13 @@ data ApiErrorInfo
     | OutputTokenQuantityExceedsLimit
     | PastHorizon
     | PoolAlreadyJoined
+    | PoolAlreadyJoinedSameVote
     | QueryParamMissing
     | RedeemerInvalidData
     | RedeemerScriptFailure
     | RedeemerTargetNotFound
     | RejectedByCoreNode
+    | SameVote
     | SharedWalletActive
     | SharedWalletCannotUpdateKey
     | SharedWalletIncomplete

lib/integration/framework/Test/Integration/Framework/DSL.hs

@@ -202,6 +202,7 @@ module Test.Integration.Framework.DSL
     , votingAndDelegating
     , getSlotParams
     , arbitraryStake
+    , delegateToPool
 
     -- * CLI
     , commandName
@@ -305,13 +306,14 @@ import Cardano.Wallet.Api.Types
     , ApiBlockReference (..)
     , ApiByronWallet
     , ApiCoinSelection
+    , ApiConstructTransaction
     , ApiEra (..)
     , ApiFee (..)
     , ApiMaintenanceAction (..)
     , ApiNetworkInformation
     , ApiNetworkParameters (..)
     , ApiPoolSpecifier
-    , ApiSerialisedTransaction
+    , ApiSerialisedTransaction (..)
     , ApiSharedWallet (..)
     , ApiT (..)
     , ApiTransaction
@@ -3639,3 +3641,56 @@ babbageOrConway ctx valBabbage valConway =
     case _mainEra ctx of
         ApiBabbage -> valBabbage
         _ -> valConway
+
+delegateToPool
+    :: forall n m. (HasSNetworkId n, MonadFail m, MonadUnliftIO m)
+    => Context
+    -> ResourceT m (ApiWallet, PoolId)
+delegateToPool ctx = do
+    let initialAmt = 100 * minUTxOValue (_mainEra ctx)
+    src <- fixtureWalletWith @n ctx [initialAmt, initialAmt]
+    pool1 : _ <- map (view #id) <$> notRetiringPools ctx
+
+    let delegationJoin = Json [aesonQQ|{
+            "delegations": [{
+                "join": {
+                    "pool": #{ApiT pool1},
+                    "stake_key_index": "0H"
+                }
+            }]
+        }|]
+    rTx1 <- request @(ApiConstructTransaction n) ctx
+        (Link.createUnsignedTransaction @'Shelley src) Default delegationJoin
+    verify rTx1
+        [ expectResponseCode HTTP.status202
+        ]
+
+    let ApiSerialisedTransaction apiTx1 _ = getFromResponse #transaction rTx1
+    signedTx1 <- signTx ctx src apiTx1 [ expectResponseCode HTTP.status202 ]
+
+    submittedTx1 <- submitTxWithWid ctx src signedTx1
+    verify submittedTx1
+        [ expectSuccess
+        , expectResponseCode HTTP.status202
+        ]
+
+    eventually "Wallet has joined pool and deposit info persists" $ do
+        rJoin' <- request @(ApiTransaction n) ctx
+            (Link.getTransaction @'Shelley src
+                (getResponse submittedTx1))
+            Default Empty
+        verify rJoin'
+            [ expectResponseCode HTTP.status200
+            , expectField #depositReturned (`shouldBe` ApiAmount 0)
+            ]
+
+    waitNumberOfEpochBoundaries 2 ctx
+
+    let getSrcWallet =
+            let endpoint = Link.getWallet @'Shelley src
+             in request @ApiWallet ctx endpoint Default Empty
+    eventually "Wallet is delegating to pool1" $ do
+        getSrcWallet >>= flip verify
+            [ expectField #delegation (`shouldBe` delegating (ApiT pool1) [])
+            ]
+    return (src, pool1)

lib/integration/scenarios/Test/Integration/Scenario/API/Shelley/StakePools.hs

@@ -34,9 +34,11 @@ import Cardano.Pool.Types
     )
 import Cardano.Wallet.Api.Types
     ( ApiCertificate (JoinPool, QuitPool, RegisterRewardAccount)
+    , ApiConstructTransaction
     , ApiEra (..)
     , ApiHealthCheck
     , ApiPoolSpecifier (..)
+    , ApiSerialisedTransaction (..)
     , ApiStakeKeys
     , ApiT (..)
     , ApiTransaction
@@ -51,7 +53,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 (..)
@@ -158,6 +160,7 @@ import Test.Integration.Framework.DSL
     , babbageOrConway
     , bracketSettings
     , decodeErrorInfo
+    , delegateToPool
     , delegating
     , delegationFee
     , emptyWallet
@@ -169,6 +172,7 @@ import Test.Integration.Framework.DSL
     , expectListField
     , expectListSize
     , expectResponseCode
+    , expectSuccess
     , fixturePassphrase
     , fixtureWallet
     , fixtureWalletWith
@@ -181,14 +185,19 @@ import Test.Integration.Framework.DSL
     , json
     , listAddresses
     , minUTxOValue
+    , noBabbage
+    , noConway
     , notDelegating
     , notRetiringPools
+    , onlyVoting
     , postWallet
     , quitStakePool
     , quitStakePoolUnsigned
     , replaceStakeKey
     , request
     , rewardWallet
+    , signTx
+    , submitTxWithWid
     , triggerMaintenanceAction
     , unsafeRequest
     , unsafeResponse
@@ -575,23 +584,117 @@ spec = describe "SHELLEY_STAKE_POOLS" $ do
                         (`shouldBe` InLedger)
                     ]
 
-    it
-        "STAKE_POOLS_JOIN_02 - \
-        \Cannot join already joined stake pool"
+    it "STAKE_POOLS_JOIN_02 - \
+        \Cannot join already the joined stake pool in Babbage"
         $ \ctx -> runResourceT $ do
+            noConway ctx "re-joining the same pool outlawed before Conway"
             w <- fixtureWallet ctx
             pool : _ <- map (view #id) <$> notRetiringPools ctx
 
             waitForTxStatus ctx w InLedger . getResponse
                 =<< joinStakePool @n ctx (SpecificPool pool) (w, fixturePassphrase)
 
+            let getSrcWallet =
+                    let endpoint = Link.getWallet @'Shelley w
+                     in request @ApiWallet ctx endpoint Default Empty
+            eventually "Wallet is delegating to pool and voting abstain" $ do
+                getSrcWallet >>= flip verify
+                    [ expectField #delegation
+                         (`shouldBe` delegating (ApiT pool) [])
+                    ]
+
+            -- 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)
                     ]
 
+    it "STAKE_POOLS_JOIN_02 - \
+        \Can join already joined stake pool if no voting before in Conway"
+        $ \ctx -> runResourceT $ do
+            noBabbage ctx "re-joining the same pool possible in Conway if no previous voting"
+
+            (w, pool) <- delegateToPool @n ctx
+
+            let getSrcWallet =
+                    let endpoint = Link.getWallet @'Shelley w
+                     in request @ApiWallet ctx endpoint Default Empty
+            eventually "Wallet is delegating to pool and no voting" $ do
+                getSrcWallet >>= flip verify
+                    [ expectField #delegation
+                         (`shouldBe` delegating (ApiT pool) [])
+                    ]
+
+            waitForTxStatus ctx w InLedger . getResponse
+                =<< joinStakePool @n ctx (SpecificPool pool) (w, fixturePassphrase)
+
+            eventually "Wallet is delegating to pool and voting abstain" $ do
+                getSrcWallet >>= flip verify
+                    [ expectField #delegation
+                         (`shouldBe` votingAndDelegating (ApiT pool) (ApiT Abstain) [])
+                    ]
+
+            -- joinStakePool would try once again joining pool and voting Abstain
+            r <- joinStakePool @n ctx (SpecificPool pool) (w, fixturePassphrase)
+            verify r
+                [ expectResponseCode HTTP.status403
+                ]
+            decodeErrorInfo r `shouldBe` PoolAlreadyJoinedSameVote
+
+    it "STAKE_POOLS_JOIN_02 - \
+        \Can join the stake pool if voting was cast before in Conway"
+        $ \ctx -> runResourceT $ do
+            noBabbage ctx "joining the pool possible in Conway if voting was previously cast"
+
+            w <- fixtureWallet ctx
+
+            let voteAbstain = Json [json|{
+                    "vote": "abstain"
+                }|]
+            rTx1 <- request @(ApiConstructTransaction n) ctx
+                (Link.createUnsignedTransaction @'Shelley w) Default voteAbstain
+            verify rTx1
+                [ expectResponseCode HTTP.status202
+                ]
+            let ApiSerialisedTransaction apiTx1 _ = getFromResponse #transaction rTx1
+            signedTx1 <- signTx ctx w apiTx1 [ expectResponseCode HTTP.status202 ]
+            submittedTx1 <- submitTxWithWid ctx w signedTx1
+            verify submittedTx1
+                [ expectSuccess
+                , expectResponseCode HTTP.status202
+                ]
+            let voting = ApiT Abstain
+            let getSrcWallet =
+                    let endpoint = Link.getWallet @'Shelley w
+                     in request @ApiWallet ctx endpoint Default Empty
+
+            waitNumberOfEpochBoundaries 2 ctx
+
+            eventually "Wallet is voting abstain" $ do
+                getSrcWallet >>= flip verify
+                    [ expectField #delegation (`shouldBe` onlyVoting voting [])
+                    ]
+
+            pool : _ <- map (view #id) <$> notRetiringPools ctx
+
+            waitForTxStatus ctx w InLedger . getResponse
+                =<< joinStakePool @n ctx (SpecificPool pool) (w, fixturePassphrase)
+
+            eventually "Wallet is delegating to pool and voting abstain" $ do
+                getSrcWallet >>= flip verify
+                    [ expectField #delegation
+                         (`shouldBe` votingAndDelegating (ApiT pool) (ApiT Abstain) [])
+                    ]
+
+            -- joinStakePool would try once again joining pool and voting Abstain
+            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
         response <- listPools ctx arbitraryStake