Add unit test

j-mueller · Feb 19, 2024 · 84e6ce4 · 84e6ce4
1 parent 03379c2
commit 84e6ce4
Show file tree

Hide file tree

Showing 3 changed files with 78 additions and 6 deletions.
diff --git a/src/plutarch/convex-plutarch.cabal b/src/plutarch/convex-plutarch.cabal
@@ -39,3 +39,33 @@ library
     build-depends:
       cardano-api,
       plutus-ledger-api
+
+test-suite convex-plutarch-test
+  import: lang
+  type: exitcode-stdio-1.0
+  hs-source-dirs:     test
+  main-is:
+    Spec.hs
+  build-depends:
+    base >= 4.14.0,
+    tasty,
+    tasty-hunit,
+    tasty-quickcheck,
+    QuickCheck,
+    lens,
+    cardano-ledger-alonzo,
+    cardano-ledger-babbage,
+    cardano-ledger-shelley,
+    convex-plutarch,
+    plutarch,
+    convex-coin-selection,
+    convex-mockchain,
+    convex-base,
+    convex-wallet,
+    cardano-api,
+    containers,
+    plutus-ledger-api:{plutus-ledger-api, plutus-ledger-api-testlib},
+    plutus-ledger-api,
+    mtl,
+    transformers,
+    text
diff --git a/src/plutarch/lib/Convex/Plutarch.hs b/src/plutarch/lib/Convex/Plutarch.hs
@@ -1,5 +1,5 @@
-{-# LANGUAGE OverloadedStrings   #-}
-{-# LANGUAGE TypeOperators       #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE TypeOperators     #-}
 {-| Plutarch / cardano-api interop
 -}
 module Convex.Plutarch(
@@ -13,10 +13,9 @@ import           Data.Text              (Text)
 import           Plutarch               (pcon, popaque, (#))
 import           Plutarch.Api.V1        (PScriptContext)
 import           Plutarch.Internal      (punsafeCoerce)
-import           Plutarch.Prelude       (PBool, PData, PIsData,
-                                         POpaque, PUnit (..), Term,
-                                         pfromData, pif, plam, ptraceError,
-                                         type (:-->))
+import           Plutarch.Prelude       (PBool, PData, PIsData, POpaque,
+                                         PUnit (..), Term, pfromData, pif, plam,
+                                         ptraceError, type (:-->))
 import           Plutarch.Script        (Script (..))
 import           PlutusLedgerApi.Common (serialiseUPLC)
 

diff --git a/src/plutarch/test/Spec.hs b/src/plutarch/test/Spec.hs
@@ -0,0 +1,43 @@
+{-# LANGUAGE TypeOperators #-}
+{-| Testing plutarch scripts in the emulator
+-}
+module Main where
+
+import qualified Cardano.Api.Shelley            as C
+import           Control.Monad                  (void)
+import           Convex.BuildTx                 (execBuildTx', payToPlutusV2,
+                                                 spendPlutusV2)
+import           Convex.Class                   (MonadMockchain)
+import           Convex.MockChain.CoinSelection (balanceAndSubmit)
+import qualified Convex.MockChain.Defaults      as Defaults
+import           Convex.MockChain.Utils         (mockchainSucceeds)
+import           Convex.Plutarch                (plutarchScriptToCapiScript)
+import           Convex.Utils                   (failOnError)
+import qualified Convex.Wallet.MockWallet       as Wallet
+import qualified Data.Text                      as Text
+import           Plutarch                       (Config (..),
+                                                 TracingMode (NoTracing),
+                                                 compile)
+import           Plutarch.Prelude               (PData, PUnit (..), Term,
+                                                 pconstant, plam, type (:-->))
+import           Test.Tasty                     (TestTree, defaultMain,
+                                                 testGroup)
+import           Test.Tasty.HUnit               (testCase)
+
+main :: IO ()
+main = defaultMain tests
+
+alwaysSucceedsP :: Term s (PData :--> PData :--> PData :--> PUnit)
+alwaysSucceedsP = plam $ \_datm _redm _ctx -> pconstant ()
+
+tests :: TestTree
+tests = testGroup "plutarch"
+  [ testCase "run the always-succeeds script" (mockchainSucceeds alwaysSucceeds)
+  ]
+
+alwaysSucceeds :: (MonadFail m, MonadMockchain m) => m ()
+alwaysSucceeds = failOnError $ do
+  k <- either (fail . Text.unpack) (pure . plutarchScriptToCapiScript) (compile (Config NoTracing) alwaysSucceedsP)
+  ref <- fmap (C.getTxId . C.getTxBody) $ balanceAndSubmit mempty Wallet.w1 $ execBuildTx' $ do
+          payToPlutusV2 Defaults.networkId k () C.NoStakeAddress (C.lovelaceToValue 10_000_000)
+  void $ balanceAndSubmit mempty Wallet.w1 $ execBuildTx' (spendPlutusV2 (C.TxIn ref (C.TxIx 0)) k () ())