From 9cdc97c5a1981e725c695d579006f216b922d1af Mon Sep 17 00:00:00 2001 From: Paul Cadman Date: Fri, 6 Dec 2024 18:53:48 +0000 Subject: [PATCH] Add test for Swap example --- include/anoma/start.exs | 2 +- src/Anoma/Effect.hs | 2 + src/Anoma/Effect/Indexer.hs | 6 ++ .../Effect/Indexer/ListUnrevealedCommits.hs | 4 +- test/Anoma/Client/Base.hs | 30 +++++++ test/Anoma/Client/Positive.hs | 80 ++++++++++++++----- test/Base.hs | 7 +- tests/Anoma/Client/Swap.juvix | 14 ++-- tests/Anoma/Client/Trivial.juvix | 47 ----------- 9 files changed, 116 insertions(+), 76 deletions(-) create mode 100644 src/Anoma/Effect/Indexer.hs create mode 100644 test/Anoma/Client/Base.hs delete mode 100644 tests/Anoma/Client/Trivial.juvix diff --git a/include/anoma/start.exs b/include/anoma/start.exs index 2edadf2364..e907cd21ed 100644 --- a/include/anoma/start.exs +++ b/include/anoma/start.exs @@ -2,5 +2,5 @@ Logger.configure(level: :none) eclient = Anoma.Client.Examples.EClient.create_example_client IO.puts("#{eclient.client.grpc_port} #{eclient.node.node_id}") - Anoma.Node.Utility.Consensus.start_link(node_id: eclient.node.node_id, interval: 10000) + Anoma.Node.Utility.Consensus.start_link(node_id: eclient.node.node_id, interval: 5000) ) diff --git a/src/Anoma/Effect.hs b/src/Anoma/Effect.hs index 15af7f76cf..85525af007 100644 --- a/src/Anoma/Effect.hs +++ b/src/Anoma/Effect.hs @@ -2,9 +2,11 @@ module Anoma.Effect ( module Anoma.Effect.Base, module Anoma.Effect.RunNockma, module Anoma.Effect.AddTransaction, + module Anoma.Effect.Indexer, ) where import Anoma.Effect.AddTransaction import Anoma.Effect.Base +import Anoma.Effect.Indexer import Anoma.Effect.RunNockma diff --git a/src/Anoma/Effect/Indexer.hs b/src/Anoma/Effect/Indexer.hs new file mode 100644 index 0000000000..24d83ba454 --- /dev/null +++ b/src/Anoma/Effect/Indexer.hs @@ -0,0 +1,6 @@ +module Anoma.Effect.Indexer + ( module Anoma.Effect.Indexer.ListUnrevealedCommits, + ) +where + +import Anoma.Effect.Indexer.ListUnrevealedCommits diff --git a/src/Anoma/Effect/Indexer/ListUnrevealedCommits.hs b/src/Anoma/Effect/Indexer/ListUnrevealedCommits.hs index 2d630dcb38..5bb312b54b 100644 --- a/src/Anoma/Effect/Indexer/ListUnrevealedCommits.hs +++ b/src/Anoma/Effect/Indexer/ListUnrevealedCommits.hs @@ -13,6 +13,8 @@ import Juvix.Prelude.Aeson qualified as Aeson newtype ListUnrevealedCommitsResult = ListUnrevealedCommitsResult {_listUnrevealedCommitsResultCommits :: [Nockma.Term Natural]} +makeLenses ''ListUnrevealedCommitsResult + listUnrevealedCommits :: forall r. (Members '[Anoma, Error SimpleError, Logger] r) => @@ -35,5 +37,3 @@ listUnrevealedCommits = do decodeCommit t = case (Base64.decode (encodeUtf8 t)) of Left e -> throw (SimpleError (mkAnsiText ("Failed to decode commitment: " <> pack e))) Right bs -> return bs - -makeLenses ''ListUnrevealedCommitsResult diff --git a/test/Anoma/Client/Base.hs b/test/Anoma/Client/Base.hs new file mode 100644 index 0000000000..aec0e1299d --- /dev/null +++ b/test/Anoma/Client/Base.hs @@ -0,0 +1,30 @@ +module Anoma.Client.Base where + +import Base +import Juvix.Prelude.Pretty + +data TestStep :: Effect where + Step :: Text -> TestStep m () + +makeSem ''TestStep + +runStep :: (Member EmbedIO r) => (Text -> IO ()) -> Sem (TestStep ': r) a -> Sem r a +runStep f = interpret $ \case + Step t -> liftIO $ f t + +pollForOutput :: forall r a. (Members '[Error SimpleError, EmbedIO] r) => Int -> (a -> Bool) -> Sem r a -> Sem r a +pollForOutput timeoutMillis isDataAvailable action = runConcurrent $ do + raceResult <- race timeoutAction go + case raceResult of + Left {} -> throw (SimpleError (mkAnsiText @Text "Operation timed out")) + Right xs -> return xs + where + go :: Sem (Concurrent ': r) a + go = do + res <- inject action + if + | isDataAvailable res -> return res + | otherwise -> threadDelay (50 * 1000) >> go + + timeoutAction :: (Member Concurrent x) => Sem x () + timeoutAction = void (threadDelay (timeoutMillis * 1000)) diff --git a/test/Anoma/Client/Positive.hs b/test/Anoma/Client/Positive.hs index fae4ae19a9..29d49a0ca5 100644 --- a/test/Anoma/Client/Positive.hs +++ b/test/Anoma/Client/Positive.hs @@ -1,47 +1,91 @@ module Anoma.Client.Positive where -import Anoma.Effect.Base +import Anoma.Client.Base +import Anoma.Effect import Base import Juvix.Compiler.Nockma.Language hiding (Path) import Juvix.Compiler.Nockma.Translation.FromTree (anomaClosure) +import Juvix.Prelude.Pretty root :: Path Abs Dir -root = relToProject $(mkRelDir "tests/Anoma/Client/positive") - -type Check = - Sem - '[ Reader [Term Natural], - EmbedIO - ] +root = relToProject $(mkRelDir "tests/Anoma/Client") data ClientTest = ClientTest - { _clientTestNum :: Int, - _clientTestTag :: Text, + { _clientTestTag :: Text, _clientRelRoot :: Path Rel Dir, _clientMainFile :: Path Rel File, - _clientAssertion :: forall r. (Members '[Error SimpleError, Anoma, EmbedIO] r) => Term Natural -> Sem r () + _clientAssertion :: forall r. (Members '[Logger, Error SimpleError, Anoma, EmbedIO, TestStep] r) => Term Natural -> Sem r () } makeLenses ''ClientTest -clientTestName :: ClientTest -> Text -clientTestName t = numberedTestName (t ^. clientTestNum) (t ^. clientTestTag) - withRootCopy :: (Path Abs Dir -> IO a) -> IO a withRootCopy = withRootTmpCopy root fromClientTest :: ClientTest -> TestTree -fromClientTest t = testCase (clientTestName t) assertion +fromClientTest t = testCaseSteps (t ^. clientTestTag) assertion where - assertion :: Assertion - assertion = runM . runProcess . runSimpleErrorHUnit . ignoreLogger $ do + assertion :: (Text -> IO ()) -> Assertion + assertion stepFun = runM . runProcess . runSimpleErrorHUnit . ignoreLogger . runStep stepFun $ do + step "Compiling" res :: AnomaResult <- liftIO $ withRootCopy (compileMain False (t ^. clientRelRoot) (t ^. clientMainFile)) let program :: Term Natural = (res ^. anomaClosure) p <- envAnomaPath runAnomaEphemeral p ((t ^. clientAssertion) program) +-- | Run prove with the given arguements and submit the result to the mempool. +-- Returns the traces from the prove endpoint +proveAndSubmit :: + (Members '[Logger, Error SimpleError, Anoma, EmbedIO, TestStep] r) => + Term Natural -> + [Term Natural] -> + Sem r [Term Natural] +proveAndSubmit program proveArgs = do + step "Proving" + resProve <- + runNockma + RunNockmaInput + { _runNockmaProgram = program, + _runNockmaArgs = proveArgs + } + step "Submitting transaction candidate" + addTransaction + AddTransactionInput + { _addTransactionInputCandidate = resProve ^. runNockmaResult + } + return (resProve ^. runNockmaTraces) + +isListUnrevealedCommitsAvailable :: ListUnrevealedCommitsResult -> Bool +isListUnrevealedCommitsAvailable l = not (null (l ^. listUnrevealedCommitsResultCommits)) + +clientTests :: [ClientTest] +clientTests = + [ ClientTest + { _clientTestTag = "Submit swap transaction", + _clientRelRoot = $(mkRelDir "."), + _clientMainFile = $(mkRelFile "Swap.juvix"), + _clientAssertion = \program -> do + proveTraces <- proveAndSubmit program [] + step "fetching unrevealed commits" + resList <- pollForOutput 2000 isListUnrevealedCommitsAvailable listUnrevealedCommits + case (proveTraces, resList ^. listUnrevealedCommitsResultCommits) of + ([proveCommitment], [listCommitment]) -> + liftIO $ + assertBool + "expected commitment from prove and list to be equal" + (nockmaEq proveCommitment listCommitment) + _ -> + throw + ( SimpleError + ( mkAnsiText @Text + "Expected exactly one commitment to be traced by prove and one commitment to be listed by listUnrevealedCommitments" + ) + ) + } + ] + allTests :: TestTree allTests = testGroup "Anoma Client positive tests" - [] + (map fromClientTest clientTests) diff --git a/test/Base.hs b/test/Base.hs index 115373cbe4..f41c5b662c 100644 --- a/test/Base.hs +++ b/test/Base.hs @@ -30,7 +30,7 @@ import Juvix.Prelude.Env import Juvix.Prelude.Pretty import System.Process qualified as P import Test.Tasty -import Test.Tasty.HUnit hiding (assertFailure, testCase) +import Test.Tasty.HUnit hiding (assertFailure, testCase, testCaseSteps) import Test.Tasty.HUnit qualified as HUnit data AssertionDescr @@ -62,7 +62,7 @@ data CompileMode mkTest :: TestDescr -> TestTree mkTest TestDescr {..} = case _testAssertion of Single assertion -> testCase _testName (withCurrentDir _testRoot assertion) - Steps steps -> testCaseSteps _testName (withCurrentDir _testRoot . steps) + Steps steps -> HUnit.testCaseSteps _testName (withCurrentDir _testRoot . steps) withPrecondition :: Assertion -> IO TestTree -> IO TestTree withPrecondition assertion ifSuccess = do @@ -216,6 +216,9 @@ numberedTestName i str = "Test" <> to3DigitString i <> ": " <> str testCase :: (HasTextBackend str) => str -> Assertion -> TestTree testCase name = HUnit.testCase (toPlainString name) +testCaseSteps :: (HasTextBackend str) => str -> ((Text -> IO ()) -> Assertion) -> TestTree +testCaseSteps name f = HUnit.testCaseSteps (toPlainString name) (\sf -> f (sf . unpack)) + withRootTmpCopy :: Path Abs Dir -> (Path Abs Dir -> IO a) -> IO a withRootTmpCopy root action = withSystemTempDir "test" $ \tmpRootDir -> do copyDirRecur root tmpRootDir diff --git a/tests/Anoma/Client/Swap.juvix b/tests/Anoma/Client/Swap.juvix index c2ee58cf4b..d8b70234d4 100644 --- a/tests/Anoma/Client/Swap.juvix +++ b/tests/Anoma/Client/Swap.juvix @@ -66,14 +66,15 @@ trivial_true_resource : Resource := nonce := 2; }; -trivial_true_commitment : Proof := +trivial_true_commitment : Nat := commitment trivial_true_resource; + +trivial_true_proof : Proof := let - true_commitment : Nat := commitment trivial_true_resource; publicInputs : Public-Inputs := mkPublic-Inputs@{ - commitments := [true_commitment]; + commitments := [trivial_true_commitment]; nullifiers := []; - self-tag := true_commitment; + self-tag := trivial_true_commitment; other-public := 0; }; privateInputs : Private-Inputs := @@ -86,9 +87,9 @@ trivial_true_commitment : Proof := trivial_true_commit_action : Action := mkAction@{ - commitments := [commitment trivial_true_resource]; + commitments := [trivial_true_commitment]; nullifiers := []; - proofs := [trivial_true_commitment]; + proofs := [trivial_true_proof]; app-data := 0; }; @@ -101,5 +102,6 @@ commit_intent : Transaction := }; main : TransactionRequest := + trace trivial_true_commitment >-> TransactionRequest.fromTransaction (Transaction.compose nullify_intent_eph commit_intent); diff --git a/tests/Anoma/Client/Trivial.juvix b/tests/Anoma/Client/Trivial.juvix deleted file mode 100644 index 70d002fb5b..0000000000 --- a/tests/Anoma/Client/Trivial.juvix +++ /dev/null @@ -1,47 +0,0 @@ -module Trivial; - -import Stdlib.Prelude open; -import ResourceMachine open; -import TransactionRequest open; - -logic (pub : Public-Inputs) (priv : Private-Inputs) : Bool := false; - -r1 : Resource := - mkResource@{ - label := 1; - logic; - ephemeral := true; - data := 0; - quantity := 0; - nullifier-key := 0; - nonce := 0; - rseed := 0; - }; - -a1 : Action := - mkAction@{ - commitments := []; - nullifiers := []; - proofs := - [mkProofLogic r1 (mkPublic-Inputs [] [] 0 0) (mkPrivate-Inputs [] [] 0)]; - app-data := 0; - }; - -trivialTransaction : Transaction := - mkTransaction@{ - roots := []; - actions := [a1]; - delta := zeroDelta; - delta-proof := 0; - }; - -emptyTransaction : Transaction := - mkTransaction@{ - roots := []; - actions := []; - delta := zeroDelta; - delta-proof := 0; - }; - -main : TransactionRequest := - TransactionRequest.fromTransaction emptyTransaction;