Add RPC and dev command for Anoma.Protobuf.IntentsService.Verify

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

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
+            }

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")

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 {..}

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")

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}

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

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)
       }
   ]
 

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;