further simplification

cardano-foundation · Apr 30, 2024 · 9d7ef3b · 9d7ef3b
1 parent 9548595
commit 9d7ef3b
Show file tree

Hide file tree

Showing 3 changed files with 36 additions and 42 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,22 +2761,23 @@ constructTransaction api argGenChange knownPools poolStatus apiWalletId body = d
                     db
             _ -> pure NoWithdrawal
 
-        (optionalVoteAction, votingSameAgain) <- case (body ^. #vote) of
+        (optionalVoteAction, votingSameAgainM) <- case (body ^. #vote) of
             Just (ApiT action) -> do
-                (voteAction, votingSameAgain) <- liftIO $ IODeleg.voteAction wrk action
-                pure (Just voteAction, votingSameAgain)
+                (voteAction, votingSameAgain) <-
+                    liftIO $ IODeleg.voteAction wrk action
+                pure (Just voteAction, Just votingSameAgain)
             Nothing ->
-                pure (Nothing, False)
+                pure (Nothing, Nothing)
 
         currentEpochSlotting <- liftIO $ getCurrentEpochSlotting netLayer
         optionalDelegationAction <- liftIO $
             forM delegationRequest $
                 IODeleg.handleDelegationRequest
                     wrk
                     currentEpochSlotting knownPools
-                    poolStatus withdrawal votingSameAgain
+                    poolStatus withdrawal votingSameAgainM
 
-        when (isNothing optionalDelegationAction && votingSameAgain) $
+        when (isNothing optionalDelegationAction && votingSameAgainM == Just True) $
             liftHandler $ throwE ErrConstructTxVotingSameAgain
 
         let transactionCtx0 = defaultTransactionCtx
@@ -3315,20 +3316,20 @@ constructSharedTransaction
         when (isNothing delegationTemplateM && isJust delegationRequest) $
             liftHandler $ throwE ErrConstructTxDelegationInvalid
 
-        (optionalVoteAction, votingSameAgain) <- case (body ^. #vote) of
+        (optionalVoteAction, votingSameAgainM) <- case (body ^. #vote) of
             Just (ApiT action) -> do
                 (voteAction, votingSameAgain) <- liftIO $ IODeleg.voteAction wrk action
-                pure (Just voteAction, votingSameAgain)
+                pure (Just voteAction, Just votingSameAgain)
             Nothing ->
-                pure (Nothing, False)
+                pure (Nothing, Nothing)
 
         optionalDelegationAction <- liftIO $
             forM delegationRequest $
                 IODeleg.handleDelegationRequest
                     wrk currentEpochSlotting knownPools
-                    getPoolStatus NoWithdrawal votingSameAgain
+                    getPoolStatus NoWithdrawal votingSameAgainM
 
-        when (isNothing optionalDelegationAction && votingSameAgain) $
+        when (isNothing optionalDelegationAction && votingSameAgainM == Just True) $
             liftHandler $ throwE ErrConstructTxVotingSameAgain
 
         let txCtx = defaultTransactionCtx

diff --git a/lib/wallet/src/Cardano/Wallet/Delegation.hs b/lib/wallet/src/Cardano/Wallet/Delegation.hs
@@ -86,13 +86,13 @@ joinStakePoolDelegationAction
     -> Set PoolId
     -> PoolId
     -> PoolLifeCycleStatus
-    -> Bool
+    -> Maybe Bool
     -> Either
         ErrStakePoolDelegation
         (Tx.DelegationAction, Maybe Tx.VotingAction)
 joinStakePoolDelegationAction
-    era wallet currentEpochSlotting knownPools poolId poolStatus votedTheSame
-  = case guardJoin era knownPools delegation poolId retirementInfo votedTheSame of
+    era wallet currentEpochSlotting knownPools poolId poolStatus votedTheSameM
+  = case guardJoin era knownPools delegation poolId retirementInfo votedTheSameM of
         Left e -> Left $ ErrStakePoolJoin e
         Right () -> Right
             ( if stakeKeyIsRegistered
@@ -124,37 +124,30 @@ guardJoin
     -> WalletDelegation
     -> PoolId
     -> Maybe PoolRetirementEpochInfo
-    -> Bool
+    -> Maybe Bool
     -> Either ErrCannotJoin ()
-guardJoin era knownPools delegation pid mRetirementEpochInfo votedTheSame = do
+guardJoin era knownPools delegation pid mRetirementEpochInfo votedTheSameM = do
     when (pid `Set.notMember` knownPools) $
         Left (ErrNoSuchPool pid)
 
     forM_ mRetirementEpochInfo $ \info ->
         when (currentEpoch info >= retirementEpoch info) $
             Left (ErrNoSuchPool pid)
 
-    when ((null next) && isDelegatingTo (== pid) active) $
-        case era of
-                Write.RecentEraBabbage ->
-                    Left (ErrAlreadyDelegating pid)
-                Write.RecentEraConway ->
-                    if votedTheSame then
-                        Left (ErrAlreadyDelegatingVoting pid)
-                    else
-                        pure ()
+    when ((null next) && isDelegatingTo (== pid) active) eraVotingLogic
 
-    when (not (null next) && isDelegatingTo (== pid) (last next)) $
-        case era of
-                Write.RecentEraBabbage ->
-                    Left (ErrAlreadyDelegating pid)
-                Write.RecentEraConway ->
-                    if votedTheSame then
-                        Left (ErrAlreadyDelegatingVoting pid)
-                    else
-                        pure ()
+    when (not (null next) && isDelegatingTo (== pid) (last next)) eraVotingLogic
   where
     WalletDelegation {active, next} = delegation
+    eraVotingLogic = case (era, votedTheSameM) of
+        (Write.RecentEraBabbage,_) ->
+            Left (ErrAlreadyDelegating pid)
+        (Write.RecentEraConway, Nothing) ->
+            Left (ErrAlreadyDelegating pid)
+        (Write.RecentEraConway, Just True) ->
+            Left (ErrAlreadyDelegatingVoting pid)
+        (Write.RecentEraConway, Just False) ->
+            pure ()
 
 {-----------------------------------------------------------------------------
     Quit stake pool

diff --git a/lib/wallet/src/Cardano/Wallet/IO/Delegation.hs b/lib/wallet/src/Cardano/Wallet/IO/Delegation.hs
@@ -140,11 +140,11 @@ handleDelegationRequest
     -> IO (Set PoolId)
     -> (PoolId -> IO PoolLifeCycleStatus)
     -> Withdrawal
-    -> Bool
+    -> Maybe Bool
     -> WD.DelegationRequest
     -> IO Tx.DelegationAction
 handleDelegationRequest
-    ctx currentEpochSlotting getKnownPools getPoolStatus withdrawal votedTheSame = \case
+    ctx currentEpochSlotting getKnownPools getPoolStatus withdrawal votedTheSameM = \case
     WD.Join poolId -> do
         poolStatus <- getPoolStatus poolId
         pools <- getKnownPools
@@ -154,7 +154,7 @@ handleDelegationRequest
             pools
             poolId
             poolStatus
-            votedTheSame
+            votedTheSameM
     WD.Quit ->
         quitStakePoolDelegationAction
             ctx
@@ -220,7 +220,7 @@ selectCoinsForJoin ctx pools poolId poolStatus = do
         pools
         poolId
         poolStatus
-        False
+        Nothing
 
     let changeAddrGen = W.defaultChangeAddressGen (delegationAddressS @n)
 
@@ -309,10 +309,10 @@ joinStakePoolDelegationAction
     -> Set PoolId
     -> PoolId
     -> PoolLifeCycleStatus
-    -> Bool
+    -> Maybe Bool
     -> IO (Tx.DelegationAction, Maybe Tx.VotingAction)
 joinStakePoolDelegationAction
-    ctx currentEpochSlotting knownPools poolId poolStatus votedTheSame
+    ctx currentEpochSlotting knownPools poolId poolStatus votedTheSameM
   = do
     (wallet, stakeKeyIsRegistered) <-
         db & \DBLayer{atomically,walletState} -> atomically $
@@ -333,7 +333,7 @@ joinStakePoolDelegationAction
             knownPools
             poolId
             poolStatus
-            votedTheSame
+            votedTheSameM
   where
     db = ctx ^. dbLayer
     tr = ctx ^. logger
@@ -370,7 +370,7 @@ joinStakePool ctx wid pools poolId poolStatus passphrase = do
             pools
             poolId
             poolStatus
-            False
+            Nothing
 
     ttl <- W.transactionExpirySlot ti Nothing
     let transactionCtx =