diff --git a/atlas-cardano.cabal b/atlas-cardano.cabal index fdb699b7..38185fcc 100644 --- a/atlas-cardano.cabal +++ b/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: diff --git a/src/GeniusYield/TxBuilder/Node.hs b/src/GeniusYield/TxBuilder/Node.hs index ad93bb22..f4d41485 100644 --- a/src/GeniusYield/TxBuilder/Node.hs +++ b/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. diff --git a/tests-privnet/GeniusYield/Test/Privnet/Stake.hs b/tests-privnet/GeniusYield/Test/Privnet/Stake.hs index d781ca17..709ebbf0 100644 --- a/tests-privnet/GeniusYield/Test/Privnet/Stake.hs +++ b/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 ] diff --git a/tests/GeniusYield/Test/Stake.hs b/tests/GeniusYield/Test/Stake.hs new file mode 100644 index 00000000..924851e3 --- /dev/null +++ b/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 diff --git a/tests/atlas-tests.hs b/tests/atlas-tests.hs index 6a2322fa..373d27a6 100644 --- a/tests/atlas-tests.hs +++ b/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 ]