diff --git a/app/Commands/Dev/Anoma.hs b/app/Commands/Dev/Anoma.hs index cb0f25b818..0f273d48ed 100644 --- a/app/Commands/Dev/Anoma.hs +++ b/app/Commands/Dev/Anoma.hs @@ -12,6 +12,7 @@ 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.Intents qualified as Intents import Commands.Dev.Anoma.Options import Commands.Dev.Anoma.Prove qualified as Prove import Commands.Dev.Anoma.Start qualified as Start @@ -31,6 +32,7 @@ runCommand g = runAnomaWithHostConfig (addTransaction (opts ^. addTransactionFile)) AnomaCommandIndexer opts -> runAnomaWithHostConfig (Indexer.runCommand opts) + AnomaCommandIntents opts -> runAnomaWithHostConfig (Intents.runCommand opts) where runAnomaWithHostConfig :: (Members (Error SimpleError ': AppEffects) x) => Sem (Anoma ': x) () -> Sem x () runAnomaWithHostConfig eff = do diff --git a/app/Commands/Dev/Anoma/Intents.hs b/app/Commands/Dev/Anoma/Intents.hs new file mode 100644 index 0000000000..6f238073fe --- /dev/null +++ b/app/Commands/Dev/Anoma/Intents.hs @@ -0,0 +1,27 @@ +module Commands.Dev.Anoma.Intents where + +import Anoma.Effect.Base +import Anoma.Effect.Intents.Verify +import Commands.Base +import Commands.Dev.Anoma.Base +import Commands.Dev.Anoma.Intents.Options +import Commands.Dev.Anoma.Intents.Verify.Options +import Juvix.Compiler.Nockma.Pretty hiding (Path) +import Juvix.Compiler.Nockma.Translation.FromSource qualified as Nockma + +runCommand :: forall r. (Members (Anoma ': Error SimpleError ': AppEffects) r) => AnomaIntentsCommand -> Sem r () +runCommand = \case + AnomaIntentsVerify opts -> do + intentFile <- fromAppPathFile (opts ^. intentsVerifyFile) + parsedTerm <- runAppError @JuvixError (Nockma.cueJammedFileOrPretty intentFile) + res <- cellOrFail parsedTerm go + if + | res ^. verifyResultValid -> logInfo "Intent is valid" >> exitSuccess + | otherwise -> logInfo "Intent is invalid" >> exitFailure + where + go :: Term Natural -> Sem r VerifyResult + go t = + verify + VerifyInput + { _verifyIntent = t + } diff --git a/app/Commands/Dev/Anoma/Intents/Options.hs b/app/Commands/Dev/Anoma/Intents/Options.hs new file mode 100644 index 0000000000..40a4d17cc1 --- /dev/null +++ b/app/Commands/Dev/Anoma/Intents/Options.hs @@ -0,0 +1,21 @@ +module Commands.Dev.Anoma.Intents.Options where + +import Commands.Dev.Anoma.Intents.Verify.Options +import CommonOptions + +newtype AnomaIntentsCommand + = AnomaIntentsVerify IntentsVerifyOptions + deriving stock (Data) + +parseAnomaIntentsCommand :: Parser AnomaIntentsCommand +parseAnomaIntentsCommand = + hsubparser commandVerify + where + commandVerify :: Mod CommandFields AnomaIntentsCommand + commandVerify = command "verify" runInfo + where + runInfo :: ParserInfo AnomaIntentsCommand + runInfo = + info + (AnomaIntentsVerify <$> parseIntentsVerifyOptions) + (progDesc "Call the Anoma.Protobuf.IntentsService.Verify endpoint") diff --git a/app/Commands/Dev/Anoma/Intents/Verify/Options.hs b/app/Commands/Dev/Anoma/Intents/Verify/Options.hs new file mode 100644 index 0000000000..b9810703ab --- /dev/null +++ b/app/Commands/Dev/Anoma/Intents/Verify/Options.hs @@ -0,0 +1,14 @@ +module Commands.Dev.Anoma.Intents.Verify.Options where + +import CommonOptions + +newtype IntentsVerifyOptions = IntentsVerifyOptions + {_intentsVerifyFile :: AppPath File} + deriving stock (Data) + +makeLenses ''IntentsVerifyOptions + +parseIntentsVerifyOptions :: Parser IntentsVerifyOptions +parseIntentsVerifyOptions = do + _intentsVerifyFile <- parseInputFile FileExtNockma + pure IntentsVerifyOptions {..} diff --git a/app/Commands/Dev/Anoma/Options.hs b/app/Commands/Dev/Anoma/Options.hs index 58f535f047..3c297fb70b 100644 --- a/app/Commands/Dev/Anoma/Options.hs +++ b/app/Commands/Dev/Anoma/Options.hs @@ -2,6 +2,7 @@ module Commands.Dev.Anoma.Options where import Commands.Dev.Anoma.AddTransaction.Options import Commands.Dev.Anoma.Indexer.Options +import Commands.Dev.Anoma.Intents.Options import Commands.Dev.Anoma.Prove.Options import Commands.Dev.Anoma.Start.Options import CommonOptions @@ -13,6 +14,7 @@ data AnomaCommand | AnomaCommandProve ProveOptions | AnomaCommandAddTransaction AddTransactionOptions | AnomaCommandIndexer AnomaIndexerCommand + | AnomaCommandIntents AnomaIntentsCommand deriving stock (Data) data AnomaCommandGlobal = AnomaCommandGlobal @@ -34,7 +36,8 @@ parseAnomaCommand = commandStop, commandProve, commandAddTransaction, - commandIndexer + commandIndexer, + commandIntents ] ) where @@ -103,3 +106,10 @@ parseAnomaCommand = info (AnomaCommandIndexer <$> parseAnomaIndexerCommand) (progDesc "Subcommands related to the Anoma indexer") + + commandIntents :: Mod CommandFields AnomaCommand + commandIntents = + command "intents" $ + info + (AnomaCommandIntents <$> parseAnomaIntentsCommand) + (progDesc "Subcommands related to the Anoma indexer") diff --git a/src/Anoma/Effect/Intents/Verify.hs b/src/Anoma/Effect/Intents/Verify.hs new file mode 100644 index 0000000000..ce92600b19 --- /dev/null +++ b/src/Anoma/Effect/Intents/Verify.hs @@ -0,0 +1,34 @@ +module Anoma.Effect.Intents.Verify where + +import Anoma.Effect.Base +import Anoma.Rpc.Intents.Verify +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 VerifyInput = VerifyInput + {_verifyIntent :: Nockma.Term Natural} + +newtype VerifyResult = VerifyResult + {_verifyResultValid :: Bool} + +makeLenses ''VerifyInput +makeLenses ''VerifyResult + +verify :: + forall r. + (Members '[Anoma, Error SimpleError, Logger] r) => + VerifyInput -> + Sem r VerifyResult +verify i = do + let intent = encodeJam64 (i ^. verifyIntent) + nodeInfo <- getNodeInfo + let msg = Request {_requestNodeInfo = nodeInfo, _requestIntent = Intent {_intentIntent = intent}} + logMessageValue "Request payload" msg + resVal :: Value <- anomaRpc verifyGrpcUrl (Aeson.toJSON msg) >>= fromJSONErr + logMessageValue "Response Payload" resVal + res :: Response <- fromJSONErr resVal + return VerifyResult {_verifyResultValid = res ^. responseValid} diff --git a/src/Anoma/Rpc/Intents/Verify.hs b/src/Anoma/Rpc/Intents/Verify.hs new file mode 100644 index 0000000000..da796b849a --- /dev/null +++ b/src/Anoma/Rpc/Intents/Verify.hs @@ -0,0 +1,52 @@ +module Anoma.Rpc.Intents.Verify where + +import Anoma.Rpc.Base +import Juvix.Prelude +import Juvix.Prelude.Aeson as Aeson + +verifyGrpcUrl :: GrpcMethodUrl +verifyGrpcUrl = + mkGrpcMethodUrl $ + "Anoma" :| ["Protobuf", "IntentsService", "Verify"] + +newtype Intent = Intent + {_intentIntent :: Text} + +$( deriveJSON + defaultOptions + { fieldLabelModifier = \case + "_intentIntent" -> "intent" + _ -> impossibleError "All fields must be covered" + } + ''Intent + ) + +data Request = Request + { _requestNodeInfo :: NodeInfo, + _requestIntent :: Intent + } + +$( deriveJSON + defaultOptions + { fieldLabelModifier = \case + "_requestNodeInfo" -> "node_info" + "_requestIntent" -> "intent" + _ -> impossibleError "All fields must be covered" + } + ''Request + ) + +newtype Response = Response + {_responseValid :: Bool} + +$( deriveJSON + defaultOptions + { fieldLabelModifier = \case + "_responseValid" -> "valid" + _ -> impossibleError "All fields must be covered" + } + ''Response + ) + +makeLenses ''Request +makeLenses ''Response diff --git a/test/Anoma/Client/Positive.hs b/test/Anoma/Client/Positive.hs index 29d49a0ca5..20eec97418 100644 --- a/test/Anoma/Client/Positive.hs +++ b/test/Anoma/Client/Positive.hs @@ -2,6 +2,7 @@ module Anoma.Client.Positive where import Anoma.Client.Base import Anoma.Effect +import Anoma.Effect.Intents.Verify import Base import Juvix.Compiler.Nockma.Language hiding (Path) import Juvix.Compiler.Nockma.Translation.FromTree (anomaClosure) @@ -33,54 +34,90 @@ fromClientTest t = testCaseSteps (t ^. clientTestTag) assertion p <- envAnomaPath runAnomaEphemeral p ((t ^. clientAssertion) program) --- | Run prove with the given arguements and submit the result to the mempool. +-- | Run prove with the given arguments. -- Returns the traces from the prove endpoint -proveAndSubmit :: +prove :: (Members '[Logger, Error SimpleError, Anoma, EmbedIO, TestStep] r) => Term Natural -> [Term Natural] -> - Sem r [Term Natural] -proveAndSubmit program proveArgs = do + Sem r RunNockmaResult +prove program proveArgs = do step "Proving" - resProve <- - runNockma - RunNockmaInput - { _runNockmaProgram = program, - _runNockmaArgs = proveArgs - } + runNockma + RunNockmaInput + { _runNockmaProgram = program, + _runNockmaArgs = proveArgs + } + +-- | Run prove with the given arguments and submit the result to the mempool. +-- Returns the traces from the prove endpoint +submit :: + (Members '[Logger, Error SimpleError, Anoma, EmbedIO, TestStep] r) => + Term Natural -> + Sem r () +submit provedProgram = do step "Submitting transaction candidate" addTransaction AddTransactionInput - { _addTransactionInputCandidate = resProve ^. runNockmaResult + { _addTransactionInputCandidate = provedProgram } - return (resProve ^. runNockmaTraces) isListUnrevealedCommitsAvailable :: ListUnrevealedCommitsResult -> Bool isListUnrevealedCommitsAvailable l = not (null (l ^. listUnrevealedCommitsResultCommits)) +data SwapProveResult = SwapProveResult + { _swapProveCommitment :: Term Natural, + _swapProveTransaction :: Term Natural, + _swapProveTransactionCandidate :: Term Natural + } + +makeLenses ''SwapProveResult + +proveSwap :: (Members '[Logger, Error SimpleError, Anoma, EmbedIO, TestStep] r) => Term Natural -> Sem r SwapProveResult +proveSwap swapProgram = do + proveRes <- prove swapProgram [] + case proveRes ^. runNockmaTraces of + [commitment, tx] -> + return + SwapProveResult + { _swapProveCommitment = commitment, + _swapProveTransaction = tx, + _swapProveTransactionCandidate = proveRes ^. runNockmaResult + } + _ -> throw (SimpleError "Could not parse output of Swap prove") + clientTests :: [ClientTest] clientTests = [ ClientTest - { _clientTestTag = "Submit swap transaction", + { _clientTestTag = "Submit swap transaction candidate", _clientRelRoot = $(mkRelDir "."), _clientMainFile = $(mkRelFile "Swap.juvix"), _clientAssertion = \program -> do - proveTraces <- proveAndSubmit program [] + resProve <- proveSwap program + submit (resProve ^. swapProveTransactionCandidate) step "fetching unrevealed commits" resList <- pollForOutput 2000 isListUnrevealedCommitsAvailable listUnrevealedCommits - case (proveTraces, resList ^. listUnrevealedCommitsResultCommits) of - ([proveCommitment], [listCommitment]) -> + case resList ^. listUnrevealedCommitsResultCommits of + [listCommitment] -> liftIO $ assertBool "expected commitment from prove and list to be equal" - (nockmaEq proveCommitment listCommitment) + (nockmaEq (resProve ^. swapProveCommitment) listCommitment) _ -> throw - ( SimpleError - ( mkAnsiText @Text - "Expected exactly one commitment to be traced by prove and one commitment to be listed by listUnrevealedCommitments" - ) + ( SimpleError "Expected exactly one commitment to be traced by prove and one commitment to be listed by listUnrevealedCommitments" ) + }, + -- We cannot test invalid intents until https://github.com/anoma/anoma/issues/1676 is fixed + ClientTest + { _clientTestTag = "Verify swap transaction", + _clientRelRoot = $(mkRelDir "."), + _clientMainFile = $(mkRelFile "Swap.juvix"), + _clientAssertion = \program -> do + resProve <- proveSwap program + step "verifying swap transaction" + resVerify <- verify VerifyInput {_verifyIntent = resProve ^. swapProveTransaction} + liftIO $ assertBool "expected swap transaction to be a valid intent" (resVerify ^. verifyResultValid) } ] diff --git a/tests/Anoma/Client/Swap.juvix b/tests/Anoma/Client/Swap.juvix index d8b70234d4..044b26a2aa 100644 --- a/tests/Anoma/Client/Swap.juvix +++ b/tests/Anoma/Client/Swap.juvix @@ -102,6 +102,9 @@ commit_intent : Transaction := }; main : TransactionRequest := - trace trivial_true_commitment >-> - TransactionRequest.fromTransaction - (Transaction.compose nullify_intent_eph commit_intent); + let + swapTransaction : Transaction := + Transaction.compose nullify_intent_eph commit_intent; + in trace trivial_true_commitment + >-> trace swapTransaction + >-> TransactionRequest.fromTransaction swapTransaction;