feat: add runGYTxMonadNodeWithStrategy and additional test for stak…

…ing logic

Related to #294

atlas-cardano.cabal

@@ -270,6 +270,7 @@ test-suite atlas-tests
     GeniusYield.Test.Providers.Mashup
     GeniusYield.Test.RefInput
     GeniusYield.Test.SlotConfig
+    GeniusYield.Test.Stake
 
   -- Dependencies inherited from the library. No need to specify bounds.
   build-depends:

src/GeniusYield/TxBuilder/Node.hs

@@ -10,6 +10,7 @@ module GeniusYield.TxBuilder.Node (
     GYTxMonadNode,
     GYTxBuildResult(..),
     runGYTxMonadNode,
+    runGYTxMonadNodeWithStrategy,
     runGYTxMonadNodeC,
     runGYTxMonadNodeF,
     runGYTxMonadNodeParallel,
@@ -179,6 +180,17 @@ runGYTxMonadNode
     -> IO GYTxBody
 runGYTxMonadNode = coerce (runGYTxMonadNodeF @Identity GYRandomImproveMultiAsset)
 
+runGYTxMonadNodeWithStrategy
+    :: GYCoinSelectionStrategy        -- ^ Coin selection strategy.
+    -> GYNetworkId                     -- ^ Network ID.
+    -> GYProviders                     -- ^ Provider.
+    -> [GYAddress]                     -- ^ Addresses belonging to wallet.
+    -> GYAddress                       -- ^ Change address.
+    -> Maybe (GYTxOutRef, Bool)        -- ^ If `Nothing` is provided, framework would pick up a suitable UTxO as collateral and in such case is also free to spend it. If something is given with boolean being `False` then framework will use the given `GYTxOutRef` as collateral and would reserve it as well. But if boolean is `True`, framework would only use it as collateral and reserve it, if value in the given UTxO is exactly 5 ada.
+    -> GYTxMonadNode (GYTxSkeleton v)  -- ^ Skeleton.
+    -> IO GYTxBody
+runGYTxMonadNodeWithStrategy strat = coerce (runGYTxMonadNodeF @Identity strat)
+
 runGYTxMonadNodeParallel
     :: GYNetworkId                     -- ^ Network ID.
     -> GYProviders                     -- ^ Provider.

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

@@ -2,7 +2,6 @@ module GeniusYield.Test.Privnet.Stake (
     tests,
 ) where
 
-import           Control.Concurrent             (threadDelay)
 import           Data.Maybe                     (fromJust)
 import qualified Data.Set                       as Set
 import           GeniusYield.Imports
@@ -13,12 +12,12 @@ import           GeniusYield.TxBuilder          (GYTxQueryMonad (stakeAddressInf
                                                  mustHaveWithdrawal)
 import           GeniusYield.Types
 import           Test.Tasty                     (TestTree, testGroup)
-import           Test.Tasty.HUnit               (testCaseSteps)
+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
-  newUser <- newTempUserCtx ctx (ctxUserF ctx) (valueFromLovelace 100_000_000_000) (CreateUserConfig {cucGenerateCollateral = False, cucGenerateStakeKey = True})
+  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
@@ -47,19 +46,6 @@ userStakeAddress user =  userStakeCredential user & stakeAddressFromCredential G
 userStakeCredential :: User -> GYStakeCredential
 userStakeCredential user = userStakePkh user & fromJust & GYStakeCredentialByKey
 
-waitTillAccumulatedRewards :: User -> (String -> IO ()) -> Ctx -> IO Natural
-waitTillAccumulatedRewards user info ctx = do
-  go
-  where
-    go = do
-      GYStakeAddressInfo {..} <- ctxRunC ctx user $ stakeAddressInfo (userStakeAddress user)
-      if gyStakeAddressInfoAvailableRewards == 0 then do
-        threadDelay 10_000_000
-        go
-      else do
-        info $ "Available rewards: " <> show gyStakeAddressInfoAvailableRewards <> "\n"
-        pure gyStakeAddressInfoAvailableRewards
-
 withdrawRewardsSteps :: User -> Natural -> (String -> IO ()) -> Ctx -> IO ()
 withdrawRewardsSteps user@User{..} rewards info ctx = do
   txBodyWithdraw <- ctxRunI ctx user $ do
@@ -76,11 +62,8 @@ tests setup = testGroup "stake"
     let spId = Set.findMin sps & stakePoolIdFromApi
     info $ "Stake pool id: " <> show spId <> "\n"
     delegateStakeCredentialSteps newUser spId info ctx
-    rewards <- waitTillAccumulatedRewards newUser info ctx
-    withdrawRewardsSteps newUser rewards info ctx
+    GYStakeAddressInfo {..} <- ctxRunC ctx newUser $ stakeAddressInfo (userStakeAddress newUser)
+    assertBool "Delegation failed" $ gyStakeAddressInfoDelegatedPool == Just spId
+    withdrawRewardsSteps newUser gyStakeAddressInfoAvailableRewards info ctx
     deregisterStakeCredentialSteps newUser info ctx
-  -- , testCaseSteps "testing out non-zero withdrawal" $ \info -> withSetup setup info $ \ctx -> do
-  --   let user = ctxUserF ctx
-  --   rewards <- waitTillAccumulatedRewards user info ctx
-  --   withdrawRewardsSteps user rewards info ctx
   ]

tests/GeniusYield/Test/Stake.hs

@@ -0,0 +1,42 @@
+module GeniusYield.Test.Stake
+  ( stakeTests
+  ) where
+
+import           Data.Foldable           (find, for_)
+import           Data.Maybe              (isJust)
+import           GeniusYield.GYConfig
+import           GeniusYield.Transaction (GYCoinSelectionStrategy (GYLegacy, GYRandomImproveMultiAsset))
+import           GeniusYield.TxBuilder
+import           GeniusYield.Types
+import           Test.Tasty              (TestTree, testGroup)
+import           Test.Tasty.HUnit        (assertBool, testCase)
+
+stakeTests :: GYCoreConfig -> TestTree
+stakeTests config =
+  testGroup "stake"
+    [ testCase "able to build balanced transaction involving withdrawal" $ do
+        withCfgProviders config mempty $ \provider@GYProviders {..} -> do
+          -- This stake credential and it's corresponding address was found from net, and in case is not valid anymore, it's easy to replace it with a valid one. This test was written as there was some trouble faced in accumulation of rewards in our private testnet.
+          let addr = unsafeAddressFromText "addr_test1qqynu5d8p9yc7garta6z4g34e2tlzye5ty8uy6ljmffnpnjv7ncp3yppt0gcr50u60y43x32fgadhnl35u9hfqyql2pqepxt0y"
+              stakeAddr = unsafeStakeAddressFromText "stake_test1upx0fuqcjqs4h5vp687d8j2cng4y5wkmelc6wzm5szq04qsm5d0l6"
+          -- Check if there is a UTxO in the given addr, with value greater than 5 ada.
+          utxos <- gyQueryUtxosAtAddress provider addr Nothing
+          assertBool "Not a single UTxO found at given address with value greater than 5 ada" $ isJust $ find (\utxo -> utxoValue utxo `valueGreaterOrEqual` valueFromLovelace 5_000_000) (utxosToList utxos)
+          -- Check if the withdrawal amount is positive.
+          stakeAddrInfo <- gyGetStakeAddressInfo stakeAddr
+          assertBool "No positive rewards available for withdrawal" $ gyStakeAddressInfoAvailableRewards stakeAddrInfo > 0
+          for_ [GYRandomImproveMultiAsset, GYLegacy] $ \strat ->
+            testWithdrawalWithStrategy strat stakeAddrInfo addr stakeAddr config provider
+    ]
+
+testWithdrawalWithStrategy :: GYCoinSelectionStrategy -> GYStakeAddressInfo -> GYAddress -> GYStakeAddress -> GYCoreConfig -> GYProviders -> IO ()
+testWithdrawalWithStrategy strat GYStakeAddressInfo {..} addr stakeAddr config provider = do
+  txBody <- runGYTxMonadNodeWithStrategy strat (cfgNetworkId config) provider [addr] addr Nothing $ pure $ mustHaveWithdrawal (GYTxWdrl stakeAddr gyStakeAddressInfoAvailableRewards GYTxWdrlWitnessKey)
+  -- Check if tx is balanced (sum inputs + withdrawal == sum outputs + tx fees).
+  let inputRefs = txBodyTxIns txBody
+      outputUtxos = txBodyUTxOs txBody
+  inputUtxos <- gyQueryUtxosAtTxOutRefs provider inputRefs
+  let inputVal = foldMapUTxOs utxoValue inputUtxos
+      outputVal = foldMapUTxOs utxoValue outputUtxos
+      txFees = txBodyFee txBody
+  assertBool "Transaction is not balanced" $ inputVal <> valueFromLovelace (fromIntegral gyStakeAddressInfoAvailableRewards) == outputVal <> valueFromLovelace txFees

tests/atlas-tests.hs

@@ -20,6 +20,7 @@ import           GeniusYield.Test.GYTxSkeleton  (gyTxSkeletonTests)
 import           GeniusYield.Test.Providers     (providersTests)
 import           GeniusYield.Test.RefInput      (refInputTests)
 import           GeniusYield.Test.SlotConfig    (slotConversionTests)
+import           GeniusYield.Test.Stake         (stakeTests)
 import           GeniusYield.Types
 
 -------------------------------------------------------------------------------
@@ -69,6 +70,7 @@ main = do
         , configTests
         , gyTxSkeletonTests
         , refInputTests
+        , stakeTests (head configs)
         , providersTests configs providerToken netId
         ]