Add RPC call and dev command for Anoma.Protobuf.IndexerService.ListUn…

…revealedCommits (#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

@@ -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

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)

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

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

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

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

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

src/Anoma/Effect/Indexer.hs

@@ -0,0 +1,6 @@
+module Anoma.Effect.Indexer
+  ( module Anoma.Effect.Indexer.ListUnrevealedCommits,
+  )
+where
+
+import Anoma.Effect.Indexer.ListUnrevealedCommits

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

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

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

test/Anoma.hs

@@ -1,10 +1,13 @@
 module Anoma where
 
+import Anoma.Client qualified as Client
 import Anoma.Compilation qualified as Compilation
 import Base
 
 allTests :: TestTree
 allTests =
   testGroup
     "Anoma tests"
-    [Compilation.allTests]
+    [ Compilation.allTests,
+      Client.allTests
+    ]

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]

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

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)

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