From 3c40bbf652edfafee8794228e873f48ec2395fca Mon Sep 17 00:00:00 2001 From: Paul Cadman Date: Fri, 6 Dec 2024 12:28:17 +0000 Subject: [PATCH] Add test scaffolding for Anoma Client --- test/Anoma.hs | 5 +- test/Anoma/Client.hs | 7 + test/Anoma/Client/Positive.hs | 47 +++++++ test/Anoma/Compilation/Negative.hs | 2 +- test/Anoma/Compilation/Positive.hs | 21 +-- test/Base.hs | 25 ++++ tests/Anoma/Client/Package.juvix | 9 ++ tests/Anoma/Client/Swap.juvix | 105 ++++++++++++++ tests/Anoma/Client/Trivial.juvix | 47 +++++++ tests/Anoma/Client/library/ByteArray.juvix | 18 +++ tests/Anoma/Client/library/Package.juvix | 9 ++ .../Client/library/ResourceMachine.juvix | 133 ++++++++++++++++++ .../Client/library/TransactionRequest.juvix | 31 ++++ 13 files changed, 437 insertions(+), 22 deletions(-) create mode 100644 test/Anoma/Client.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/Trivial.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/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/Positive.hs b/test/Anoma/Client/Positive.hs new file mode 100644 index 0000000000..fae4ae19a9 --- /dev/null +++ b/test/Anoma/Client/Positive.hs @@ -0,0 +1,47 @@ +module Anoma.Client.Positive where + +import Anoma.Effect.Base +import Base +import Juvix.Compiler.Nockma.Language hiding (Path) +import Juvix.Compiler.Nockma.Translation.FromTree (anomaClosure) + +root :: Path Abs Dir +root = relToProject $(mkRelDir "tests/Anoma/Client/positive") + +type Check = + Sem + '[ Reader [Term Natural], + EmbedIO + ] + +data ClientTest = ClientTest + { _clientTestNum :: Int, + _clientTestTag :: Text, + _clientRelRoot :: Path Rel Dir, + _clientMainFile :: Path Rel File, + _clientAssertion :: forall r. (Members '[Error SimpleError, Anoma, EmbedIO] 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 + where + assertion :: Assertion + assertion = runM . runProcess . runSimpleErrorHUnit . ignoreLogger $ do + res :: AnomaResult <- liftIO $ withRootCopy (compileMain False (t ^. clientRelRoot) (t ^. clientMainFile)) + let program :: Term Natural = (res ^. anomaClosure) + p <- envAnomaPath + runAnomaEphemeral p ((t ^. clientAssertion) program) + +allTests :: TestTree +allTests = + testGroup + "Anoma Client positive tests" + [] 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..115373cbe4 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 @@ -211,3 +215,24 @@ numberedTestName i str = "Test" <> to3DigitString i <> ": " <> str testCase :: (HasTextBackend str) => str -> Assertion -> TestTree testCase name = HUnit.testCase (toPlainString name) + +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..c2ee58cf4b --- /dev/null +++ b/tests/Anoma/Client/Swap.juvix @@ -0,0 +1,105 @@ +--- 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 : Proof := + let + true_commitment : Nat := commitment trivial_true_resource; + publicInputs : Public-Inputs := + mkPublic-Inputs@{ + commitments := [true_commitment]; + nullifiers := []; + self-tag := 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 := [commitment trivial_true_resource]; + nullifiers := []; + proofs := [trivial_true_commitment]; + app-data := 0; + }; + +commit_intent : Transaction := + mkTransaction@{ + roots := []; + delta := actionDelta trivial_true_commit_action; + actions := [trivial_true_commit_action]; + delta-proof := 0; + }; + +main : TransactionRequest := + TransactionRequest.fromTransaction + (Transaction.compose nullify_intent_eph commit_intent); diff --git a/tests/Anoma/Client/Trivial.juvix b/tests/Anoma/Client/Trivial.juvix new file mode 100644 index 0000000000..70d002fb5b --- /dev/null +++ b/tests/Anoma/Client/Trivial.juvix @@ -0,0 +1,47 @@ +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; 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;