feat: add privnet test related to staking for GYLegacy coin selecti…

…on strategy as well

Related to #294

src/GeniusYield/Test/Privnet/Ctx.hs

@@ -21,8 +21,11 @@ module GeniusYield.Test.Privnet.Ctx (
     userStakeVKey,
     -- * Operations
     ctxRunI,
+    ctxRunIWithStrategy,
     ctxRunC,
+    ctxRunCWithStrategy,
     ctxRunF,
+    ctxRunFWithStrategy,
     ctxRunFWithCollateral,
     ctxSlotOfCurrentBlock,
     ctxWaitNextBlock,
@@ -146,6 +149,9 @@ newTempUserCtx ctx fundUser fundValue CreateUserConfig {..} = do
 ctxRunF :: forall t v. Traversable t => Ctx -> User -> GYTxMonadNode (t (GYTxSkeleton v)) -> IO (t GYTxBody)
 ctxRunF ctx User {..} =  runGYTxMonadNodeF GYRandomImproveMultiAsset GYPrivnet (ctxProviders ctx) [userAddr] userAddr Nothing
 
+ctxRunFWithStrategy :: forall t v. Traversable t => GYCoinSelectionStrategy -> Ctx -> User -> GYTxMonadNode (t (GYTxSkeleton v)) -> IO (t GYTxBody)
+ctxRunFWithStrategy strat ctx User {..} =  runGYTxMonadNodeF strat GYPrivnet (ctxProviders ctx) [userAddr] userAddr Nothing
+
 -- | Variant of `ctxRunF` where caller can also give the UTxO to be used as collateral.
 ctxRunFWithCollateral :: forall t v. Traversable t
                       => Ctx
@@ -159,9 +165,15 @@ ctxRunFWithCollateral ctx User {..} coll toCheck5Ada =  runGYTxMonadNodeF GYRand
 ctxRunC :: forall a. Ctx -> User -> GYTxMonadNode a -> IO a
 ctxRunC = coerce (ctxRunF @(Const a))
 
+ctxRunCWithStrategy :: forall a. GYCoinSelectionStrategy -> Ctx -> User -> GYTxMonadNode a -> IO a
+ctxRunCWithStrategy = coerce (ctxRunFWithStrategy @(Const a))
+
 ctxRunI :: Ctx -> User -> GYTxMonadNode (GYTxSkeleton v) -> IO GYTxBody
 ctxRunI = coerce (ctxRunF @Identity)
 
+ctxRunIWithStrategy :: GYCoinSelectionStrategy -> Ctx -> User -> GYTxMonadNode (GYTxSkeleton v) -> IO GYTxBody
+ctxRunIWithStrategy = coerce (ctxRunFWithStrategy @Identity)
+
 ctxSlotOfCurrentBlock :: Ctx -> IO GYSlot
 ctxSlotOfCurrentBlock (ctxProviders -> providers) =
     gyGetSlotOfCurrentBlock providers

tests-privnet/GeniusYield/Test/Privnet/Stake.hs

@@ -2,11 +2,13 @@ module GeniusYield.Test.Privnet.Stake (
     tests,
 ) where
 
+import           Data.Foldable                  (for_)
 import           Data.Maybe                     (fromJust)
 import qualified Data.Set                       as Set
 import           GeniusYield.Imports
 import           GeniusYield.Test.Privnet.Ctx
 import           GeniusYield.Test.Privnet.Setup
+import           GeniusYield.Transaction        (GYCoinSelectionStrategy (..))
 import           GeniusYield.TxBuilder          (GYTxQueryMonad (stakeAddressInfo),
                                                  mustHaveCertificate,
                                                  mustHaveWithdrawal)
@@ -15,27 +17,27 @@ import           Test.Tasty                     (TestTree, testGroup)
 import           Test.Tasty.HUnit               (assertBool, testCaseSteps)
 
 -- This will check if we are able to register a stake credential without it's signature.
-registerStakeCredentialSteps :: (String -> IO ()) -> Ctx -> IO User
-registerStakeCredentialSteps info ctx = do
+registerStakeCredentialSteps :: GYCoinSelectionStrategy -> (String -> IO ()) -> Ctx -> IO User
+registerStakeCredentialSteps strat info ctx = do
   newUser <- newTempUserCtx ctx (ctxUserF ctx) (valueFromLovelace 1_000_000_000) (CreateUserConfig {cucGenerateCollateral = False, cucGenerateStakeKey = True})
   pp <- ctxGetParams ctx & gyGetProtocolParameters'
   info $ "-- Protocol parameters --\n" <> show pp <> "\n-- x --\n"
-  txBodyReg <- ctxRunI ctx newUser $ do
+  txBodyReg <- ctxRunIWithStrategy strat ctx newUser $ do
     return $ mustHaveCertificate (mkStakeAddressRegistrationCertificate (userStakeCredential newUser))
   info $ "-- Registration tx body --\n" <> show txBodyReg <> "\n-- x --\n"
   void $ submitTx ctx newUser txBodyReg
   pure newUser
 
-delegateStakeCredentialSteps :: User -> GYStakePoolId -> (String -> IO ()) -> Ctx -> IO ()
-delegateStakeCredentialSteps user@User{..} spId info ctx = do
-  txBodyDel <- ctxRunI ctx user $ do
+delegateStakeCredentialSteps :: GYCoinSelectionStrategy -> User -> GYStakePoolId -> (String -> IO ()) -> Ctx -> IO ()
+delegateStakeCredentialSteps strat user@User{..} spId info ctx = do
+  txBodyDel <- ctxRunIWithStrategy strat ctx user $ do
     return $ mustHaveCertificate (mkStakeAddressPoolDelegationCertificate (userStakePkh user & fromJust & GYStakeCredentialByKey) spId GYTxCertWitnessKey)
   info $ "-- Delegation tx body --\n" <> show txBodyDel <> "\n-- x --\n"
   void $ submitTx' ctx $ signGYTxBody txBodyDel [GYSomeSigningKey userPaymentSKey, userStakeSKey & fromJust & GYSomeSigningKey]
 
-deregisterStakeCredentialSteps :: User -> (String -> IO ()) -> Ctx -> IO ()
-deregisterStakeCredentialSteps user@User{..} info ctx = do
-  txBodyDereg <- ctxRunI ctx user $ do
+deregisterStakeCredentialSteps :: GYCoinSelectionStrategy -> User -> (String -> IO ()) -> Ctx -> IO ()
+deregisterStakeCredentialSteps strat user@User{..} info ctx = do
+  txBodyDereg <- ctxRunIWithStrategy strat ctx user $ do
     return $ mustHaveCertificate (mkStakeAddressDeregistrationCertificate (userStakePkh user & fromJust & GYStakeCredentialByKey) GYTxCertWitnessKey)
   info $ "-- Deregistration tx body --\n" <> show txBodyDereg <> "\n-- x --\n"
   void $ submitTx' ctx $ signGYTxBody txBodyDereg [GYSomeSigningKey userPaymentSKey, userStakeSKey & fromJust & GYSomeSigningKey]
@@ -46,24 +48,25 @@ userStakeAddress user =  userStakeCredential user & stakeAddressFromCredential G
 userStakeCredential :: User -> GYStakeCredential
 userStakeCredential user = userStakePkh user & fromJust & GYStakeCredentialByKey
 
-withdrawRewardsSteps :: User -> Natural -> (String -> IO ()) -> Ctx -> IO ()
-withdrawRewardsSteps user@User{..} rewards info ctx = do
-  txBodyWithdraw <- ctxRunI ctx user $ do
+withdrawRewardsSteps :: GYCoinSelectionStrategy -> User -> Natural -> (String -> IO ()) -> Ctx -> IO ()
+withdrawRewardsSteps strat user@User{..} rewards info ctx = do
+  txBodyWithdraw <- ctxRunIWithStrategy strat ctx user $ do
     return $ mustHaveWithdrawal (GYTxWdrl (userStakeAddress user) rewards GYTxWdrlWitnessKey)
   info $ "-- Withdrawal tx body --\n" <> show txBodyWithdraw <> "\n-- x --\n"
   void $ submitTx' ctx $ signGYTxBody txBodyWithdraw [GYSomeSigningKey userPaymentSKey, userStakeSKey & fromJust & GYSomeSigningKey]
 
 tests :: IO Setup -> TestTree
 tests setup = testGroup "stake"
   [ testCaseSteps "exercising stake credential registration, delegation, rewards claiming & de-registration" $ \info -> withSetup setup info $ \ctx -> do
-    newUser <- registerStakeCredentialSteps info ctx
-    sps <- ctx & ctxGetParams & gyGetStakePools'
-    info $ "Total stake pools: " <> show sps <> "\n"
-    let spId = Set.findMin sps & stakePoolIdFromApi
-    info $ "Stake pool id: " <> show spId <> "\n"
-    delegateStakeCredentialSteps newUser spId info ctx
-    GYStakeAddressInfo {..} <- ctxRunC ctx newUser $ stakeAddressInfo (userStakeAddress newUser)
-    assertBool "Delegation failed" $ gyStakeAddressInfoDelegatedPool == Just spId
-    withdrawRewardsSteps newUser gyStakeAddressInfoAvailableRewards info ctx
-    deregisterStakeCredentialSteps newUser info ctx
+    for_ [GYRandomImproveMultiAsset, GYLegacy] $ \strat -> do
+      newUser <- registerStakeCredentialSteps strat info ctx
+      sps <- ctx & ctxGetParams & gyGetStakePools'
+      info $ "Total stake pools: " <> show sps <> "\n"
+      let spId = Set.findMin sps & stakePoolIdFromApi
+      info $ "Stake pool id: " <> show spId <> "\n"
+      delegateStakeCredentialSteps strat newUser spId info ctx
+      GYStakeAddressInfo {..} <- ctxRunC ctx newUser $ stakeAddressInfo (userStakeAddress newUser)
+      assertBool "Delegation failed" $ gyStakeAddressInfoDelegatedPool == Just spId
+      withdrawRewardsSteps strat newUser gyStakeAddressInfoAvailableRewards info ctx
+      deregisterStakeCredentialSteps strat newUser info ctx
   ]