From 8272ee32c12ac53413860165c9bb48d7e6f8256d Mon Sep 17 00:00:00 2001 From: Paul Cadman Date: Sat, 7 Dec 2024 16:51:10 +0000 Subject: [PATCH] Add RPC call and dev command for Anoma.Protobuf.IndexerService.ListUnrevealedCommits (#3239) This PR adds support for `Anoma.Protobuf.IndexerService.ListUnrevealedCommits` via the CLI: ``` $ juvix dev anoma indexer list-unrevealed-commits --help Usage: juvix dev anoma indexer list-unrevealed-commits [-o|--output OUTPUT_FILE] Call the Anoma.Protobuf.IndexerService.ListUnrevealedCommits endpoint Available options: -o,--output OUTPUT_FILE Path to output file -h,--help Show this help text ``` It also adds a test suite for Anoma client transaction submissions / verification. The Swap example using the Resource Machine API is tested with the following flow: 1. Compile the Swap example 2. Submit the compiled output to the prove endpoint - capture the expected commitment in a trace 3. Submit the proved output to add-transaction 4. Poll ListUnrevealedCommits until a commit appears and compare it with the commitment we captured in 2. --- app/Commands/Dev/Anoma.hs | 2 + app/Commands/Dev/Anoma/Indexer.hs | 21 +++ .../Indexer/ListUnrevealedCommits/Options.hs | 14 ++ app/Commands/Dev/Anoma/Indexer/Options.hs | 21 +++ app/Commands/Dev/Anoma/Options.hs | 12 +- include/anoma/start.exs | 2 +- src/Anoma/Effect.hs | 2 + src/Anoma/Effect/Indexer.hs | 6 + .../Effect/Indexer/ListUnrevealedCommits.hs | 39 +++++ .../Rpc/Indexer/ListUnrevealedCommits.hs | 39 +++++ .../ListUnrevealedCommits/JsonOptions.hs | 14 ++ test/Anoma.hs | 5 +- test/Anoma/Client.hs | 7 + test/Anoma/Client/Base.hs | 30 ++++ test/Anoma/Client/Positive.hs | 91 ++++++++++++ test/Anoma/Compilation/Negative.hs | 2 +- test/Anoma/Compilation/Positive.hs | 21 +-- test/Base.hs | 32 ++++- tests/Anoma/Client/Package.juvix | 9 ++ tests/Anoma/Client/Swap.juvix | 107 ++++++++++++++ tests/Anoma/Client/library/ByteArray.juvix | 18 +++ tests/Anoma/Client/library/Package.juvix | 9 ++ .../Client/library/ResourceMachine.juvix | 133 ++++++++++++++++++ .../Client/library/TransactionRequest.juvix | 31 ++++ 24 files changed, 641 insertions(+), 26 deletions(-) create mode 100644 app/Commands/Dev/Anoma/Indexer.hs create mode 100644 app/Commands/Dev/Anoma/Indexer/ListUnrevealedCommits/Options.hs create mode 100644 app/Commands/Dev/Anoma/Indexer/Options.hs create mode 100644 src/Anoma/Effect/Indexer.hs create mode 100644 src/Anoma/Effect/Indexer/ListUnrevealedCommits.hs create mode 100644 src/Anoma/Rpc/Indexer/ListUnrevealedCommits.hs create mode 100644 src/Anoma/Rpc/Indexer/ListUnrevealedCommits/JsonOptions.hs create mode 100644 test/Anoma/Client.hs create mode 100644 test/Anoma/Client/Base.hs create mode 100644 test/Anoma/Client/Positive.hs create mode 100644 tests/Anoma/Client/Package.juvix create mode 100644 tests/Anoma/Client/Swap.juvix create mode 100644 tests/Anoma/Client/library/ByteArray.juvix create mode 100644 tests/Anoma/Client/library/Package.juvix create mode 100644 tests/Anoma/Client/library/ResourceMachine.juvix create mode 100644 tests/Anoma/Client/library/TransactionRequest.juvix diff --git a/app/Commands/Dev/Anoma.hs b/app/Commands/Dev/Anoma.hs index 944f297b43..cb0f25b818 100644 --- a/app/Commands/Dev/Anoma.hs +++ b/app/Commands/Dev/Anoma.hs @@ -11,6 +11,7 @@ import Commands.Base import Commands.Dev.Anoma.AddTransaction.Options import Commands.Dev.Anoma.Base import Commands.Dev.Anoma.Client +import Commands.Dev.Anoma.Indexer qualified as Indexer import Commands.Dev.Anoma.Options import Commands.Dev.Anoma.Prove qualified as Prove import Commands.Dev.Anoma.Start qualified as Start @@ -29,6 +30,7 @@ runCommand g = AnomaCommandAddTransaction opts -> runAnomaWithHostConfig (addTransaction (opts ^. addTransactionFile)) + AnomaCommandIndexer opts -> runAnomaWithHostConfig (Indexer.runCommand opts) where runAnomaWithHostConfig :: (Members (Error SimpleError ': AppEffects) x) => Sem (Anoma ': x) () -> Sem x () runAnomaWithHostConfig eff = do diff --git a/app/Commands/Dev/Anoma/Indexer.hs b/app/Commands/Dev/Anoma/Indexer.hs new file mode 100644 index 0000000000..1397072ffa --- /dev/null +++ b/app/Commands/Dev/Anoma/Indexer.hs @@ -0,0 +1,21 @@ +module Commands.Dev.Anoma.Indexer where + +import Anoma.Effect.Base +import Anoma.Effect.Indexer.ListUnrevealedCommits +import Commands.Base +import Commands.Dev.Anoma.Indexer.ListUnrevealedCommits.Options +import Commands.Dev.Anoma.Indexer.Options +import Data.Text qualified as T +import Juvix.Compiler.Nockma.Pretty hiding (Path) + +runCommand :: forall r. (Members (Anoma ': Error SimpleError ': AppEffects) r) => AnomaIndexerCommand -> Sem r () +runCommand = \case + AnomaIndexerListUnrevealedCommits opts -> do + res <- listUnrevealedCommits + case opts ^. indexerListUnrevealedCommitsOutputFile of + Just out -> do + f <- fromAppFile out + let cs = T.unlines (ppPrint <$> res ^. listUnrevealedCommitsResultCommits) + writeFileEnsureLn' f cs + Nothing -> do + forM_ (res ^. listUnrevealedCommitsResultCommits) (renderStdOutLn . ppOutDefault) diff --git a/app/Commands/Dev/Anoma/Indexer/ListUnrevealedCommits/Options.hs b/app/Commands/Dev/Anoma/Indexer/ListUnrevealedCommits/Options.hs new file mode 100644 index 0000000000..ee5a3ebd2c --- /dev/null +++ b/app/Commands/Dev/Anoma/Indexer/ListUnrevealedCommits/Options.hs @@ -0,0 +1,14 @@ +module Commands.Dev.Anoma.Indexer.ListUnrevealedCommits.Options where + +import CommonOptions + +newtype IndexerListUnrevealedCommitsOptions = IndexerListUnrevealedCommitsOptions + {_indexerListUnrevealedCommitsOutputFile :: Maybe (AppPath File)} + deriving stock (Data) + +parseUnrevealedCommitsOptions :: Parser IndexerListUnrevealedCommitsOptions +parseUnrevealedCommitsOptions = do + _indexerListUnrevealedCommitsOutputFile <- optional parseGenericOutputFile + pure IndexerListUnrevealedCommitsOptions {..} + +makeLenses ''IndexerListUnrevealedCommitsOptions diff --git a/app/Commands/Dev/Anoma/Indexer/Options.hs b/app/Commands/Dev/Anoma/Indexer/Options.hs new file mode 100644 index 0000000000..f91f258fef --- /dev/null +++ b/app/Commands/Dev/Anoma/Indexer/Options.hs @@ -0,0 +1,21 @@ +module Commands.Dev.Anoma.Indexer.Options where + +import Commands.Dev.Anoma.Indexer.ListUnrevealedCommits.Options +import CommonOptions + +newtype AnomaIndexerCommand + = AnomaIndexerListUnrevealedCommits IndexerListUnrevealedCommitsOptions + deriving stock (Data) + +parseAnomaIndexerCommand :: Parser AnomaIndexerCommand +parseAnomaIndexerCommand = + hsubparser commandListUnrevealedCommits + where + commandListUnrevealedCommits :: Mod CommandFields AnomaIndexerCommand + commandListUnrevealedCommits = command "list-unrevealed-commits" runInfo + where + runInfo :: ParserInfo AnomaIndexerCommand + runInfo = + info + (AnomaIndexerListUnrevealedCommits <$> parseUnrevealedCommitsOptions) + (progDesc "Call the Anoma.Protobuf.IndexerService.ListUnrevealedCommits endpoint") diff --git a/app/Commands/Dev/Anoma/Options.hs b/app/Commands/Dev/Anoma/Options.hs index 197e2100f2..58f535f047 100644 --- a/app/Commands/Dev/Anoma/Options.hs +++ b/app/Commands/Dev/Anoma/Options.hs @@ -1,6 +1,7 @@ module Commands.Dev.Anoma.Options where import Commands.Dev.Anoma.AddTransaction.Options +import Commands.Dev.Anoma.Indexer.Options import Commands.Dev.Anoma.Prove.Options import Commands.Dev.Anoma.Start.Options import CommonOptions @@ -11,6 +12,7 @@ data AnomaCommand | AnomaCommandStop | AnomaCommandProve ProveOptions | AnomaCommandAddTransaction AddTransactionOptions + | AnomaCommandIndexer AnomaIndexerCommand deriving stock (Data) data AnomaCommandGlobal = AnomaCommandGlobal @@ -31,7 +33,8 @@ parseAnomaCommand = commandStatus, commandStop, commandProve, - commandAddTransaction + commandAddTransaction, + commandIndexer ] ) where @@ -93,3 +96,10 @@ parseAnomaCommand = info (AnomaCommandAddTransaction <$> parseAddTransactionOptions) (progDesc "Submit a Nockma transaction candidate to Anoma.Protobuf.Mempool.AddTransaction") + + commandIndexer :: Mod CommandFields AnomaCommand + commandIndexer = + command "indexer" $ + info + (AnomaCommandIndexer <$> parseAnomaIndexerCommand) + (progDesc "Subcommands related to the Anoma indexer") diff --git a/include/anoma/start.exs b/include/anoma/start.exs index 2edadf2364..d2b0941590 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: 500) ) 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 new file mode 100644 index 0000000000..5bb312b54b --- /dev/null +++ b/src/Anoma/Effect/Indexer/ListUnrevealedCommits.hs @@ -0,0 +1,39 @@ +module Anoma.Effect.Indexer.ListUnrevealedCommits where + +import Anoma.Effect.Base +import Anoma.Rpc.Indexer.ListUnrevealedCommits +import Data.ByteString.Base64 qualified as Base64 +import Juvix.Compiler.Nockma.Encoding +import Juvix.Compiler.Nockma.Language qualified as Nockma +import Juvix.Compiler.Nockma.Pretty +import Juvix.Prelude +import Juvix.Prelude.Aeson (Value) +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) => + Sem r ListUnrevealedCommitsResult +listUnrevealedCommits = do + nodeInfo <- getNodeInfo + let msg = Request {_requestNodeInfo = nodeInfo} + logMessageValue "Request payload" msg + resVal :: Value <- anomaRpc listUnrevealedCommitsGrpcUrl (Aeson.toJSON msg) >>= fromJSONErr + logMessageValue "Response Payload" resVal + res :: Response <- fromJSONErr resVal + commitBs :: [ByteString] <- mapM decodeCommit (res ^. responseCommits) + commits :: [Atom Natural] <- + mapError @NockNaturalNaturalError + (SimpleError . mkAnsiText @Text . show) + (mapM byteStringToAtom commitBs) + return ListUnrevealedCommitsResult {_listUnrevealedCommitsResultCommits = TermAtom <$> commits} + where + decodeCommit :: Text -> Sem r ByteString + decodeCommit t = case (Base64.decode (encodeUtf8 t)) of + Left e -> throw (SimpleError (mkAnsiText ("Failed to decode commitment: " <> pack e))) + Right bs -> return bs diff --git a/src/Anoma/Rpc/Indexer/ListUnrevealedCommits.hs b/src/Anoma/Rpc/Indexer/ListUnrevealedCommits.hs new file mode 100644 index 0000000000..ed4b6c11f3 --- /dev/null +++ b/src/Anoma/Rpc/Indexer/ListUnrevealedCommits.hs @@ -0,0 +1,39 @@ +module Anoma.Rpc.Indexer.ListUnrevealedCommits where + +import Anoma.Rpc.Base +import Anoma.Rpc.Indexer.ListUnrevealedCommits.JsonOptions +import Juvix.Prelude +import Juvix.Prelude.Aeson as Aeson + +listUnrevealedCommitsGrpcUrl :: GrpcMethodUrl +listUnrevealedCommitsGrpcUrl = + mkGrpcMethodUrl $ + "Anoma" :| ["Protobuf", "IndexerService", "ListUnrevealedCommits"] + +newtype Request = Request + {_requestNodeInfo :: NodeInfo} + +$( deriveJSON + defaultOptions + { fieldLabelModifier = \case + "_requestNodeInfo" -> "node_info" + _ -> impossibleError "All fields must be covered" + } + ''Request + ) + +newtype Response = Response + {_responseCommits :: [Text]} + +$(deriveToJSON responseOptions ''Response) + +instance FromJSON Response where + parseJSON = + $(mkParseJSON responseOptions ''Response) + . addDefaultValues' defaultValues + where + defaultValues :: HashMap Key Value + defaultValues = hashMap [("commits", Aeson.Array mempty)] + +makeLenses ''Request +makeLenses ''Response diff --git a/src/Anoma/Rpc/Indexer/ListUnrevealedCommits/JsonOptions.hs b/src/Anoma/Rpc/Indexer/ListUnrevealedCommits/JsonOptions.hs new file mode 100644 index 0000000000..d4c9f12d2e --- /dev/null +++ b/src/Anoma/Rpc/Indexer/ListUnrevealedCommits/JsonOptions.hs @@ -0,0 +1,14 @@ +-- | Options needed to derive JSON instances need to be put in a separate file due to +-- Template Haskell stage restriction +module Anoma.Rpc.Indexer.ListUnrevealedCommits.JsonOptions where + +import Juvix.Prelude +import Juvix.Prelude.Aeson as Aeson + +responseOptions :: Aeson.Options +responseOptions = + defaultOptions + { fieldLabelModifier = \case + "_responseCommits" -> "commits" + _ -> impossibleError "All fields must be covered" + } diff --git a/test/Anoma.hs b/test/Anoma.hs index 6ad7eb968d..f9d14c8e16 100644 --- a/test/Anoma.hs +++ b/test/Anoma.hs @@ -1,5 +1,6 @@ module Anoma where +import Anoma.Client qualified as Client import Anoma.Compilation qualified as Compilation import Base @@ -7,4 +8,6 @@ allTests :: TestTree allTests = testGroup "Anoma tests" - [Compilation.allTests] + [ Compilation.allTests, + Client.allTests + ] diff --git a/test/Anoma/Client.hs b/test/Anoma/Client.hs new file mode 100644 index 0000000000..34a86bc039 --- /dev/null +++ b/test/Anoma/Client.hs @@ -0,0 +1,7 @@ +module Anoma.Client where + +import Anoma.Client.Positive qualified as P +import Base + +allTests :: TestTree +allTests = testGroup "Execution with the Anoma client" [P.allTests] 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 new file mode 100644 index 0000000000..29d49a0ca5 --- /dev/null +++ b/test/Anoma/Client/Positive.hs @@ -0,0 +1,91 @@ +module Anoma.Client.Positive where + +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") + +data ClientTest = ClientTest + { _clientTestTag :: Text, + _clientRelRoot :: Path Rel Dir, + _clientMainFile :: Path Rel File, + _clientAssertion :: forall r. (Members '[Logger, Error SimpleError, Anoma, EmbedIO, TestStep] r) => Term Natural -> Sem r () + } + +makeLenses ''ClientTest + +withRootCopy :: (Path Abs Dir -> IO a) -> IO a +withRootCopy = withRootTmpCopy root + +fromClientTest :: ClientTest -> TestTree +fromClientTest t = testCaseSteps (t ^. clientTestTag) assertion + where + 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/Anoma/Compilation/Negative.hs b/test/Anoma/Compilation/Negative.hs index 0c32d48a2c..1507b79678 100644 --- a/test/Anoma/Compilation/Negative.hs +++ b/test/Anoma/Compilation/Negative.hs @@ -1,6 +1,6 @@ module Anoma.Compilation.Negative where -import Base +import Base hiding (compileMain) import Juvix.Compiler.Backend (Target (TargetAnoma)) import Juvix.Compiler.Core.Error import Juvix.Prelude qualified as Prelude diff --git a/test/Anoma/Compilation/Positive.hs b/test/Anoma/Compilation/Positive.hs index fb3affd259..80fd95238e 100644 --- a/test/Anoma/Compilation/Positive.hs +++ b/test/Anoma/Compilation/Positive.hs @@ -3,7 +3,6 @@ module Anoma.Compilation.Positive (allTests) where import Anoma.Effect.Base import Anoma.Effect.RunNockma import Base -import Juvix.Compiler.Backend (Target (TargetAnoma)) import Juvix.Compiler.Nockma.Anoma import Juvix.Compiler.Nockma.Evaluator import Juvix.Compiler.Nockma.Language @@ -87,9 +86,6 @@ mkAnomaTest' _anomaTestMode _anomaProgramStorage _anomaTestNum _anomaTestTag _an { .. } -envAnomaPath :: (MonadIO m) => m AnomaPath -envAnomaPath = AnomaPath <$> getAnomaPathAbs - mkAnomaNodeTest :: AnomaTest -> TestTree mkAnomaNodeTest a@AnomaTest {..} = testCase (anomaTestName a <> " - node") assertion @@ -115,22 +111,7 @@ mkAnomaNodeTest a@AnomaTest {..} = $ _anomaCheck withRootCopy :: (Prelude.Path Abs Dir -> IO a) -> IO a -withRootCopy action = withSystemTempDir "test" $ \tmpRootDir -> do - copyDirRecur root tmpRootDir - action tmpRootDir - -compileMain :: Bool -> Prelude.Path Rel Dir -> Prelude.Path Rel File -> Prelude.Path Abs Dir -> IO AnomaResult -compileMain enableDebug relRoot mainFile rootCopyDir = do - let testRootDir = rootCopyDir relRoot - entryPoint <- - set entryPointTarget (Just TargetAnoma) . set entryPointDebug enableDebug - <$> testDefaultEntryPointIO testRootDir (testRootDir mainFile) - (over anomaClosure removeInfoUnlessDebug) . (^. pipelineResult) . snd <$> testRunIO entryPoint upToAnoma - where - removeInfoUnlessDebug :: Term Natural -> Term Natural - removeInfoUnlessDebug - | enableDebug = id - | otherwise = removeInfoRec +withRootCopy = withRootTmpCopy root mkAnomaTest :: Int -> diff --git a/test/Base.hs b/test/Base.hs index e4515e1fc0..f41c5b662c 100644 --- a/test/Base.hs +++ b/test/Base.hs @@ -10,12 +10,16 @@ module Base ) where +import Anoma.Effect.Base import Control.Exception qualified as E import Control.Monad.Extra as Monad import Data.Algorithm.Diff import Data.Algorithm.DiffOutput import GHC.Generics qualified as GHC +import Juvix.Compiler.Backend (Target (TargetAnoma)) import Juvix.Compiler.Internal.Translation.FromInternal.Analysis.Termination +import Juvix.Compiler.Nockma.Language hiding (Path) +import Juvix.Compiler.Nockma.Translation.FromTree (anomaClosure) import Juvix.Compiler.Pipeline.EntryPoint.IO import Juvix.Compiler.Pipeline.Loader.PathResolver import Juvix.Compiler.Pipeline.Run @@ -26,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 @@ -58,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 @@ -211,3 +215,27 @@ 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 + action tmpRootDir + +compileMain :: Bool -> Path Rel Dir -> Path Rel File -> Path Abs Dir -> IO AnomaResult +compileMain enableDebug relRoot mainFile rootCopyDir = do + let testRootDir = rootCopyDir relRoot + entryPoint <- + set entryPointTarget (Just TargetAnoma) . set entryPointDebug enableDebug + <$> testDefaultEntryPointIO testRootDir (testRootDir mainFile) + (over anomaClosure removeInfoUnlessDebug) . (^. pipelineResult) . snd <$> testRunIO entryPoint upToAnoma + where + removeInfoUnlessDebug :: Term Natural -> Term Natural + removeInfoUnlessDebug + | enableDebug = id + | otherwise = removeInfoRec + +envAnomaPath :: (MonadIO m) => m AnomaPath +envAnomaPath = AnomaPath <$> getAnomaPathAbs diff --git a/tests/Anoma/Client/Package.juvix b/tests/Anoma/Client/Package.juvix new file mode 100644 index 0000000000..9e6662fcfc --- /dev/null +++ b/tests/Anoma/Client/Package.juvix @@ -0,0 +1,9 @@ +module Package; + +import PackageDescription.V2 open; + +package : Package := + defaultPackage@{ + name := "client-test"; + dependencies := [defaultStdlib; path "library/"]; + }; diff --git a/tests/Anoma/Client/Swap.juvix b/tests/Anoma/Client/Swap.juvix new file mode 100644 index 0000000000..d8b70234d4 --- /dev/null +++ b/tests/Anoma/Client/Swap.juvix @@ -0,0 +1,107 @@ +--- translated from https://github.com/anoma/anoma/blob/61413dfc6460b7bf96e9207ce3b9d22b9c678f09/apps/anoma_node/lib/examples/e_transaction.ex#L309 +module Swap; + +import Stdlib.Prelude open; +import ResourceMachine open; +import TransactionRequest open; +import Stdlib.Debug.Trace open; +import ByteArray open; + +trivial_true_resource_eph : Resource := + mkResource@{ + label := 0; + logic := \{_ _ := true}; + ephemeral := true; + quantity := 1; + data := 0; + nullifier-key := replicate 32 0x0 |> mkByteArray |> toAnomaContents; + rseed := 0; + nonce := 0; + }; + +trivial_true_nullifier_eph : Nat := nullifier trivial_true_resource_eph; + +trivial_true_eph_nullifier : Proof := + let + publicInputs : Public-Inputs := + mkPublic-Inputs@{ + commitments := []; + nullifiers := [trivial_true_nullifier_eph]; + self-tag := trivial_true_nullifier_eph; + other-public := 0; + }; + privateInputs : Private-Inputs := + mkPrivate-Inputs@{ + committed-resources := []; + nullified-resources := [trivial_true_resource_eph]; + other-private := 0; + }; + in mkProofLogic trivial_true_resource_eph publicInputs privateInputs; + +trivial_true_eph_nullifier_action : Action := + mkAction@{ + commitments := []; + nullifiers := [trivial_true_nullifier_eph]; + proofs := [trivial_true_eph_nullifier]; + app-data := 0; + }; + +nullify_intent_eph : Transaction := + mkTransaction@{ + roots := []; + delta := actionDelta trivial_true_eph_nullifier_action; + actions := [trivial_true_eph_nullifier_action]; + delta-proof := 0; + }; + +trivial_true_resource : Resource := + mkResource@{ + label := 0; + logic := \{_ _ := true}; + ephemeral := true; + quantity := 1; + data := 0; + nullifier-key := replicate 32 0x0 |> mkByteArray |> toAnomaContents; + rseed := 0; + nonce := 2; + }; + +trivial_true_commitment : Nat := commitment trivial_true_resource; + +trivial_true_proof : Proof := + let + publicInputs : Public-Inputs := + mkPublic-Inputs@{ + commitments := [trivial_true_commitment]; + nullifiers := []; + self-tag := trivial_true_commitment; + other-public := 0; + }; + privateInputs : Private-Inputs := + mkPrivate-Inputs@{ + committed-resources := [trivial_true_resource]; + nullified-resources := []; + other-private := 0; + }; + in mkProofLogic trivial_true_resource publicInputs privateInputs; + +trivial_true_commit_action : Action := + mkAction@{ + commitments := [trivial_true_commitment]; + nullifiers := []; + proofs := [trivial_true_proof]; + app-data := 0; + }; + +commit_intent : Transaction := + mkTransaction@{ + roots := []; + delta := actionDelta trivial_true_commit_action; + actions := [trivial_true_commit_action]; + delta-proof := 0; + }; + +main : TransactionRequest := + trace trivial_true_commitment >-> + TransactionRequest.fromTransaction + (Transaction.compose nullify_intent_eph commit_intent); diff --git a/tests/Anoma/Client/library/ByteArray.juvix b/tests/Anoma/Client/library/ByteArray.juvix new file mode 100644 index 0000000000..18a50f8c1a --- /dev/null +++ b/tests/Anoma/Client/library/ByteArray.juvix @@ -0,0 +1,18 @@ +module ByteArray; + +import Stdlib.Prelude open; + +builtin bytearray +axiom ByteArray : Type; + +builtin bytearray-from-list-byte +axiom mkByteArray : List Byte -> ByteArray; + +builtin bytearray-length +axiom size : ByteArray -> Nat; + +builtin anoma-bytearray-to-anoma-contents +axiom toAnomaContents : ByteArray -> Nat; + +builtin anoma-bytearray-from-anoma-contents +axiom fromAnomaContents : Nat -> Nat -> ByteArray; diff --git a/tests/Anoma/Client/library/Package.juvix b/tests/Anoma/Client/library/Package.juvix new file mode 100644 index 0000000000..e3dd656e71 --- /dev/null +++ b/tests/Anoma/Client/library/Package.juvix @@ -0,0 +1,9 @@ +module Package; + +import PackageDescription.V2 open; + +package : Package := + defaultPackage@{ + name := "anoma-client-library"; + dependencies := [defaultStdlib]; + }; diff --git a/tests/Anoma/Client/library/ResourceMachine.juvix b/tests/Anoma/Client/library/ResourceMachine.juvix new file mode 100644 index 0000000000..f45f8f3d5e --- /dev/null +++ b/tests/Anoma/Client/library/ResourceMachine.juvix @@ -0,0 +1,133 @@ +--- A rendering of https://github.com/anoma/anoma/blob/f52cd44235f35a907c22c428ce1fdf3237c97927/hoon/resource-machine.hoon +module ResourceMachine; + +import Stdlib.Prelude open; + +Resource-Logic : Type := Public-Inputs -> Private-Inputs -> Bool; + +builtin anoma-resource +type Resource := + mkResource@{ + label : Nat; + logic : Resource-Logic; + ephemeral : Bool; + quantity : Nat; + data : Nat; + --- 256 bits + nullifier-key : Nat; + --- nonce for commitments 256 bits + nonce : Nat; + rseed : Nat; + }; + +positive +type Public-Inputs := + mkPublic-Inputs@{ + commitments : List Nat; + nullifiers : List Nat; + --- exactly one commitment or nullifier + self-tag : Nat; + other-public : Nat; + }; + +positive +type Private-Inputs := + mkPrivate-Inputs@{ + committed-resources : List Resource; + nullified-resources : List Resource; + other-private : Nat; + }; + +builtin anoma-delta +axiom Delta : Type; + +builtin anoma-kind +axiom Kind : Type; + +builtin anoma-resource-commitment +axiom commitment : Resource -> Nat; + +builtin anoma-resource-nullifier +axiom nullifier : Resource -> Nat; + +builtin anoma-resource-kind +axiom kind : Resource -> Kind; + +builtin anoma-resource-delta +axiom resource-delta : Resource -> Delta; + +type Logic-Proof : Type := + mkLogicProof@{ + resource : Resource; + inputs : Pair Public-Inputs Private-Inputs; + }; + +Compliance-Proof : Type := Nat; + +type Proof := + | proofCompliance + | proofLogic Resource (Pair Public-Inputs Private-Inputs); + +mkProofCompliance (_ : Compliance-Proof) : Proof := proofCompliance; + +mkProofLogic + (resource : Resource) + (publicInputs : Public-Inputs) + (privateInputs : Private-Inputs): Proof := + proofLogic resource (publicInputs, privateInputs); + +builtin anoma-action +type Action := + mkAction@{ + commitments : List Nat; + nullifiers : List Nat; + proofs : List Proof; + app-data : Nat; + }; + +builtin anoma-action-delta +axiom actionDelta : Action -> Delta; + +builtin anoma-actions-delta +axiom actionsDelta : List Action -> Delta; + +builtin anoma-prove-action +axiom proveAction : Action -> Nat; + +builtin anoma-prove-delta +axiom proveDelta : Delta -> Nat; + +builtin anoma-zero-delta +axiom zeroDelta : Delta; + +builtin anoma-add-delta +axiom addDelta : Delta -> Delta -> Delta; + +builtin anoma-sub-delta +axiom subDelta : Delta -> Delta -> Delta; + +Commitment-Root : Type := Nat; + +module Transaction; + type Transaction := + mkTransaction@{ + --- root set for spent resources + roots : List Commitment-Root; + actions : List Action; + delta : Delta; + delta-proof : Nat; + }; + + open Transaction public; + + compose (tx1 tx2 : Transaction) : Transaction := + mkTransaction@{ + roots := roots tx1 ++ roots tx2; + actions := actions tx1 ++ actions tx2; + delta := addDelta (delta tx1) (delta tx2); + delta-proof := 0; + }; + +end; + +open Transaction using {Transaction; mkTransaction} public; diff --git a/tests/Anoma/Client/library/TransactionRequest.juvix b/tests/Anoma/Client/library/TransactionRequest.juvix new file mode 100644 index 0000000000..21b5e1e14a --- /dev/null +++ b/tests/Anoma/Client/library/TransactionRequest.juvix @@ -0,0 +1,31 @@ +module TransactionRequest; + +import Stdlib.Prelude open; +import ResourceMachine open; + +type TransactionCandidate := + mkTransactionCandidate@{ + --- keyspace is unused + keyspace : Nat; + transactionFunction : Unit -> Transaction; + }; + +module TransactionRequest; + + type TransactionRequest := + mkTransactionRequest@{ + payload : Unit -> TransactionCandidate; + }; + + fromTransaction (tx : Transaction) : TransactionRequest := + mkTransactionRequest@{ + payload := + const + mkTransactionCandidate@{ + keyspace := 0; + transactionFunction := const tx; + }; + }; +end; + +open TransactionRequest using {TransactionRequest; mkTransactionRequest} public;