Merge pull request #337 from mlabs-haskell/euonymos/clean-unified-tests

chore: clean up unified tests

.envrc

@@ -1,6 +1 @@
-# https://github.com/nix-community/nix-direnv A fast, persistent use_nix/use_flake implementation for direnv:
-if ! has nix_direnv_version || ! nix_direnv_version 2.3.0; then
-  source_url "https://raw.githubusercontent.com/nix-community/nix-direnv/2.3.0/direnvrc" "sha256-Dmd+j63L84wuzgyjITIfSxSD57Tx7v51DMxVZOsiUD8="
-fi
-# https://github.com/input-output-hk/devx Slightly opinionated shared GitHub Action for Cardano-Haskell projects
-use flake "github:input-output-hk/devx?rev=086bfa55b40dfdaeb3c0381d876d50081b37c9a3#ghc96-iog-full"
+use flake

atlas-cardano.cabal

@@ -15,7 +15,9 @@ category:           Blockchain, Cardano, Framework
 homepage:           https://github.com/geniusyield/atlas#readme
 bug-reports:        https://github.com/geniusyield/atlas/issues
 extra-source-files: README.md
-tested-with:        GHC ==9.6.5
+tested-with:
+  GHC ==9.6.5
+   || ==9.6.6
 
 source-repository head
   type:     git
@@ -376,10 +378,11 @@ test-suite atlas-unified-tests
     atlas-cardano,
     base,
     containers,
-    tasty,
-    text,
+    extra,
     mtl,
     plutus-core,
     plutus-ledger-api,
+    plutus-tx-plugin,
     plutus-tx,
-    plutus-tx-plugin
+    tasty,
+    text,

cabal.project

@@ -78,6 +78,9 @@ source-repository-package
     lib/wallet-benchmarks/
     lib/wallet/
 
+package postgresql-libpq
+  flags: +use-pkg-config
+
 ------ Following is mostly from @cardano-wallet@'s @cabal.project@ file. -------
 
 --------------------------------------------------------------------------------
@@ -173,7 +176,7 @@ package cardano-node
   flags: -systemd
 
 package bitvec
-   flags: -simd
+  flags: -simd
 
 -- -------------------------------------------------------------------------
 

flake.nix

@@ -30,7 +30,7 @@
             hixProject =
               final.haskell-nix.project' {
                 src = ./.;
-                compiler-nix-name = "ghc964";
+                compiler-nix-name = "ghc966";
                 # This is used by `nix develop .` to open a shell for use with
                 # `cabal`, `hlint` and `haskell-language-server`
                 shell.tools = {
@@ -42,7 +42,7 @@
                 shell.buildInputs = with pkgs; [
                   nixpkgs-fmt
                 ];
-                inputMap = { "https://input-output-hk.github.io/cardano-haskell-packages" = CHaP; };
+                inputMap = { "https://chap.intersectmbo.org/" = CHaP; };
               };
           })
           overlay

src/GeniusYield/Test/Privnet/Setup.hs

@@ -94,7 +94,7 @@ withSetup' targetSev putLog (Setup cokont) kont = do
 
 -- | Given a test name, runs the test under privnet.
 mkPrivnetTestFor :: TestName -> Setup -> (TestInfo -> GYTxGameMonadIO ()) -> TestTree
-mkPrivnetTestFor name = mkPrivnetTestFor' name GYInfo
+mkPrivnetTestFor name = mkPrivnetTestFor' name GYDebug
 
 -- | Given a test name, runs the test under privnet with target logging severity.
 mkPrivnetTestFor' :: TestName -> GYLogSeverity -> Setup -> (TestInfo -> GYTxGameMonadIO ()) -> TestTree

src/GeniusYield/Test/Utils.hs

@@ -107,7 +107,10 @@ TL;DR: Remove all user creation code from test setups and point Atlas users to u
 -- TODO (simplify-genesis): Remove 'TestInfo'. The only thing test setup should do is to make one or more genesis/funder user(s)
 -- and pass that 'User' onto the tests.
 -- | General information about the test environment to help in running polymorphic tests.
-data TestInfo = TestInfo { testGoldAsset :: !GYAssetClass, testIronAsset :: !GYAssetClass, testWallets :: !Wallets }
+data TestInfo = TestInfo
+  { testGoldAsset :: !GYAssetClass
+  , testIronAsset :: !GYAssetClass
+  , testWallets :: !Wallets }
 
 -- TODO (simplify-genesis): Remove this type once user creation logic is removed from test setup.
 -- | Available wallets.

tests-unified/GeniusYield/Test/Unified/BetRef/Operations.hs

@@ -1,5 +1,6 @@
 module GeniusYield.Test.Unified.BetRef.Operations
-  ( betRefValidator'
+  ( mkScript
+  , mkBetRefValidator
   , betRefAddress
   , placeBet
   , takeBets
@@ -11,13 +12,37 @@ import           GeniusYield.Types
 
 import           GeniusYield.Test.Unified.OnChain.BetRef.Compiled
 
+-- | Queries the cuurent slot, calculates parameters and builds
+-- a script that is ready to be deployed.
+mkScript
+  :: GYTxQueryMonad m
+  => Integer        -- ^ How many slots betting should be open
+  -> Integer        -- ^ How many slots should pass before oracle reveals answer
+  -> GYPubKeyHash   -- ^ Oracle PKH
+  -> GYValue        -- ^ Bet step value
+  -> m (BetRefParams, GYScript PlutusV2)
+mkScript betUntil betReveal oraclePkh betStep = do
+  currSlot <- slotToInteger <$> slotOfCurrentBlock
+  -- Calculate params for the script
+  let betUntil' = slotFromApi $ fromInteger $ currSlot + betUntil
+  let betReveal' = slotFromApi $ fromInteger $ currSlot + betReveal
+  betUntilTime <- slotToBeginTime betUntil'
+  betRevealTime <- slotToBeginTime betReveal'
+  let params = BetRefParams
+        (pubKeyHashToPlutus oraclePkh)
+        (timeToPlutus betUntilTime)
+        (timeToPlutus betRevealTime)
+        (valueToPlutus betStep)
+  gyLogDebug' "" $ printf "Parameters: %s" (show params)
+  pure (params, validatorToScript $ mkBetRefValidator params)
+
 -- | Validator in question, obtained after giving required parameters.
-betRefValidator' :: BetRefParams -> GYValidator 'PlutusV2
-betRefValidator' brp = validatorFromPlutus $ betRefValidator brp
+mkBetRefValidator :: BetRefParams -> GYValidator 'PlutusV2
+mkBetRefValidator brp = validatorFromPlutus $ betRefValidator brp
 
 -- | Address of the validator, given params.
 betRefAddress :: (HasCallStack, GYTxQueryMonad m) => BetRefParams -> m GYAddress
-betRefAddress brp = scriptAddress $ betRefValidator' brp
+betRefAddress brp = scriptAddress $ mkBetRefValidator brp
 
 -- | Operation to place bet.
 placeBet :: (HasCallStack, GYTxQueryMonad m)
@@ -66,7 +91,7 @@ placeBet refScript brp guess bet ownAddr mPreviousBetsUtxoRef = do
         <> mustBeSignedBy pkh
 
 -- | Operation to take UTxO corresponding to previous bets.
-takeBets :: (HasCallStack, GYTxUserQueryMonad m)
+takeBets :: (HasCallStack, GYTxQueryMonad m)
               => GYTxOutRef    -- ^ Reference Script.
               -> BetRefParams  -- ^ Validator params.
               -> GYTxOutRef    -- ^ Script UTxO to consume.
@@ -89,9 +114,8 @@ input :: BetRefParams -> GYTxOutRef -> GYTxOutRef -> BetRefDatum -> BetRefAction
 input brp refScript inputRef dat red =
   mustHaveInput GYTxIn
     { gyTxInTxOutRef = inputRef
-    -- , gyTxInWitness = GYTxInWitnessKey
     , gyTxInWitness  = GYTxInWitnessScript
-        (GYInReference refScript $ validatorToScript $ betRefValidator' brp)
+        (GYInReference refScript $ validatorToScript $ mkBetRefValidator brp)
         (datumFromPlutusData dat)
         (redeemerFromPlutusData red)
     }