Unified testing mechanism for Privnet <-> CLB

atlas-cardano.cabal

@@ -84,11 +84,13 @@ library
     GeniusYield.ReadJSON
     GeniusYield.Scripts.TestToken
     GeniusYield.Swagger.Utils
-    GeniusYield.Test.Address
+    GeniusYield.Test.Clb
     GeniusYield.Test.FakeCoin
+    GeniusYield.Test.FeeTracker
     GeniusYield.Test.Privnet.Asserts
     GeniusYield.Test.Privnet.Ctx
     GeniusYield.Test.Privnet.Examples
+    GeniusYield.Test.Privnet.Examples.Common
     GeniusYield.Test.Privnet.Examples.Gift
     GeniusYield.Test.Privnet.Examples.Misc
     GeniusYield.Test.Privnet.Examples.Oracle
@@ -103,7 +105,6 @@ library
     GeniusYield.Transaction.Common
     GeniusYield.TxBuilder
     GeniusYield.TxBuilder.Class
-    GeniusYield.TxBuilder.Clb
     GeniusYield.TxBuilder.Common
     GeniusYield.TxBuilder.Errors
     GeniusYield.TxBuilder.IO
@@ -352,3 +353,32 @@ test-suite atlas-privnet-tests
     , tasty
     , tasty-hunit
 
+test-suite atlas-unified-tests
+  import:         common, plutus-ghc-options
+  type:           exitcode-stdio-1.0
+  main-is:        atlas-unified-tests.hs
+  hs-source-dirs: tests-unified
+  ghc-options:    -threaded -rtsopts -Wall
+
+  -- set target plutus-core version
+  ghc-options:    -fplugin-opt PlutusTx.Plugin:target-version=1.0.0
+  other-modules:
+    GeniusYield.Test.Unified.OnChain.BetRef
+    GeniusYield.Test.Unified.OnChain.BetRef.Compiled
+    GeniusYield.Test.Unified.BetRef.Operations
+    GeniusYield.Test.Unified.BetRef.PlaceBet
+    GeniusYield.Test.Unified.BetRef.TakePot
+  -- Dependencies inherited from the library. No need to specify bounds.
+  build-depends:
+    , atlas-cardano
+    , base
+    , containers
+    , tasty
+    , tasty-hunit
+    , text
+    , mtl
+    -- OnChain
+    , plutus-core
+    , plutus-ledger-api
+    , plutus-tx
+    , plutus-tx-plugin

src/GeniusYield/Examples/Limbo.hs

@@ -8,21 +8,12 @@ Stability   : develop
 
 -}
 module GeniusYield.Examples.Limbo (
-    -- * Scripts
     limboValidatorV1,
     limboValidatorV2,
-    -- * API
-    getRefInfos,
-    addRefScript,
-    addRefScript',
-    findRefScriptsInBody,
 ) where
 
-import           GeniusYield.Imports
-import           GeniusYield.TxBuilder.Class
 import           GeniusYield.Types
 
-import qualified Data.Map.Strict             as Map
 import           GeniusYield.Examples.Common (toDeBruijn)
 import qualified PlutusCore.Version          as PLC
 import qualified PlutusLedgerApi.Common      as Plutus
@@ -58,52 +49,3 @@ limboValidatorV2 = validatorFromSerialisedScript limboValidatorPlutusSerialised
 limboValidatorPlutusSerialised :: Plutus.SerialisedScript
 limboValidatorPlutusSerialised = Plutus.serialiseUPLC $
     UPLC.Program () PLC.plcVersion100 limboScript'
-
--------------------------------------------------------------------------------
--- API
--------------------------------------------------------------------------------
-
-utxoToRefMap :: GYUTxOs ->  Map (Some GYScript) GYTxOutRef
-utxoToRefMap utxo = Map.fromList
-    [ (sc, ref)
-    | GYUTxO { utxoRef = ref, utxoRefScript = Just sc} <- utxosToList utxo
-    ]
-
--- | Find reference scripts at 'limboValidatorV2' address.
---
-getRefInfos :: GYTxQueryMonad m => m (Map (Some GYScript) GYTxOutRef)
-getRefInfos = do
-    addr <- scriptAddress limboValidatorV2
-    utxo <- utxosAtAddress addr Nothing
-    return $ utxoToRefMap utxo
-
--- | Create UTxO with a reference script.
---
--- This is optimized version.
--- First it checks whether there is an UTxO already with a script.
--- Only if there aren't the new transaction skeleton is constructed.
---
-addRefScript :: GYTxQueryMonad m => GYScript 'PlutusV2 -> m (Either GYTxOutRef (GYTxSkeleton v))
-addRefScript sc = do
-    addr <- scriptAddress limboValidatorV2
-    utxo <- utxosAtAddress addr Nothing
-
-    let refs :: Map (Some GYScript) GYTxOutRef
-        refs = utxoToRefMap utxo
-
-    case Map.lookup (Some sc) refs of
-        Just ref -> return $ Left ref
-        Nothing  -> return $ Right $ mustHaveOutput (mkGYTxOut addr mempty (datumFromPlutusData ())) { gyTxOutRefS = Just $ GYPlutusScript sc }
-
--- | Create UTxO with a reference script.
---
-addRefScript' :: GYTxQueryMonad m => GYScript 'PlutusV2 -> m (GYTxSkeleton v)
-addRefScript' sc = do
-    addr <- scriptAddress limboValidatorV2
-    return $ mustHaveOutput (mkGYTxOut addr mempty (datumFromPlutusData ())) { gyTxOutRefS = Just $ GYPlutusScript sc }
-
--- | Find reference scripts in transaction body.
-findRefScriptsInBody :: GYTxBody -> Map (Some GYScript) GYTxOutRef
-findRefScriptsInBody body = do
-    let utxo = txBodyUTxOs body
-    utxoToRefMap utxo