Support traces in the anoma node (#3152)

This pr adds support for getting traces from the anoma node.
I've updated the test suite so that tests that were disabled because of
traces are now being run.
There are a few tests that require atention:
1. `test028`: Gives the wrong answer.
2. `test084`: Gives the wrong answer.
4. `test074`: Expected to fail because it uses scry.
5. `test086`: Expected to fail because Anoma representation of prngs is
different than the juvix representation.

.github/workflows/ci.yml

@@ -150,7 +150,7 @@ jobs:
           cd $HOME
           git clone https://github.com/anoma/anoma.git
           cd anoma
-          git checkout 98e3660b91cd55f1d9424dcff9420425ae98f5f8
+          git checkout da44f1881442b4b09f61e20bf503e8c69b03b035
           mix local.hex --force
           mix escript.install hex protobuf --force
           echo "$HOME/.mix/escripts" >> $GITHUB_PATH

app/Commands/Dev/Nockma/Run.hs

@@ -20,7 +20,7 @@ runCommand opts = do
     t@(TermCell {}) -> case opts ^. nockmaRunAnomaDir of
       Just path -> do
         anomaDir <- AnomaPath <$> fromAppPathDir path
-        runInAnoma anomaDir t (fromMaybe [] (unfoldList <$> parsedArgs))
+        runInAnoma anomaDir t (maybe [] unfoldList parsedArgs)
       Nothing -> do
         let formula = anomaCallTuple parsedArgs
         (counts, res) <-
@@ -37,5 +37,15 @@ runCommand opts = do
 
 runInAnoma :: (Members AppEffects r) => AnomaPath -> Term Natural -> [Term Natural] -> Sem r ()
 runInAnoma anoma t args = runAppError @SimpleError . runAnoma anoma $ do
-  res <- runNockma t args
-  putStrLn (ppPrint res)
+  res <-
+    runNockma
+      RunNockmaInput
+        { _runNockmaProgram = t,
+          _runNockmaArgs = args
+        }
+  let traces = res ^. runNockmaTraces
+  renderStdOutLn (annotate AnnImportant $ "Traces (" <> show (length traces) <> "):")
+  forM_ traces $ \tr ->
+    renderStdOutLn (ppPrint tr)
+  renderStdOutLn (annotate AnnImportant "Result:")
+  renderStdOutLn (ppPrint (res ^. runNockmaResult))

src/Anoma/Effect/Base.hs

@@ -155,12 +155,6 @@ grpcCliProcess method = do
         std_out = CreatePipe
       }
 
--- | Assumes the node and client are already running
--- runAnomaTest :: forall r a. (Members '[Reader ListenPort, Logger, EmbedIO, Error SimpleError] r) => AnomaPath -> Sem (Anoma ': r) a -> Sem r a
--- runAnomaTest anomapath body = runReader anomapath . runProcess $
---   (`interpret` inject body) $ \case
---     GetAnomaProcesses -> error "unsupported"
---     AnomaRpc method i -> anomaRpc' method i
 runAnoma :: forall r a. (Members '[Logger, EmbedIO, Error SimpleError] r) => AnomaPath -> Sem (Anoma ': r) a -> Sem r a
 runAnoma anomapath body = runReader anomapath . runProcess $
   withSpawnAnomaNode $ \grpcport _nodeOut nodeH ->

src/Anoma/Effect/RunNockma.hs

@@ -10,15 +10,21 @@ import Juvix.Compiler.Nockma.Encoding
 import Juvix.Compiler.Nockma.Language qualified as Nockma
 import Juvix.Data.CodeAnn
 import Juvix.Prelude
-import Juvix.Prelude.Aeson (Value)
+import Juvix.Prelude.Aeson (ToJSON, Value)
 import Juvix.Prelude.Aeson qualified as Aeson
 
 data RunNockmaInput = RunNockmaInput
-  { _runNockmaProgram :: AnomaResult,
-    _runNockmaInput :: [Nockma.Term Natural]
+  { _runNockmaProgram :: Nockma.Term Natural,
+    _runNockmaArgs :: [Nockma.Term Natural]
+  }
+
+data RunNockmaResult = RunNockmaResult
+  { _runNockmaResult :: Nockma.Term Natural,
+    _runNockmaTraces :: [Nockma.Term Natural]
   }
 
 makeLenses ''RunNockmaInput
+makeLenses ''RunNockmaResult
 
 fromJSON :: (Members '[Error SimpleError, Logger] r) => (Aeson.FromJSON a) => Value -> Sem r a
 fromJSON v = case Aeson.fromJSON v of
@@ -26,22 +32,32 @@ fromJSON v = case Aeson.fromJSON v of
   Aeson.Error err -> throw (SimpleError (mkAnsiText err))
 
 runNockma ::
+  forall r.
   (Members '[Anoma, Error SimpleError, Logger] r) =>
-  Nockma.Term Natural ->
-  [Nockma.Term Natural] ->
-  Sem r (Nockma.Term Natural)
-runNockma prog inputs = do
-  let prog' = encodeJam64 prog
-      args = map (NockInputJammed . encodeJam64) inputs
+  RunNockmaInput ->
+  Sem r RunNockmaResult
+runNockma i = do
+  let prog' = encodeJam64 (i ^. runNockmaProgram)
+      args = map (NockInputJammed . encodeJam64) (i ^. runNockmaArgs)
       msg =
         RunNock
           { _runNockJammedProgram = prog',
             _runNockPrivateInputs = args,
             _runNockPublicInputs = []
           }
-  logVerbose (mkAnsiText ("Request Payload:\n" <> Aeson.jsonEncodeToPrettyText msg))
-  res :: Response <- anomaRpc runNockGrpcUrl (Aeson.toJSON msg) >>= fromJSON
-  logVerbose (mkAnsiText ("Response Payload:\n" <> Aeson.jsonEncodeToPrettyText res))
+  let logValue :: (ToJSON val) => Text -> val -> Sem r ()
+      logValue title val = logVerbose (mkAnsiText (annotate AnnImportant (pretty title <> ":\n") <> pretty (Aeson.jsonEncodeToPrettyText val)))
+  logValue "Request Payload" msg
+  resVal :: Value <- anomaRpc runNockGrpcUrl (Aeson.toJSON msg) >>= fromJSON
+  logValue "Response Payload" resVal
+  res :: Response <- fromJSON resVal
   case res of
-    ResponseProof x -> decodeCue64 x
-    ResponseError err -> throw (SimpleError (mkAnsiText err))
+    ResponseSuccess s -> do
+      result <- decodeCue64 (s ^. successResult)
+      traces <- mapM decodeCue64 (s ^. successTraces)
+      return
+        RunNockmaResult
+          { _runNockmaResult = result,
+            _runNockmaTraces = traces
+          }
+    ResponseError err -> throw (SimpleError (mkAnsiText (err ^. errorError)))

src/Anoma/Rpc/RunNock.hs

@@ -1,13 +1,14 @@
 module Anoma.Rpc.RunNock where
 
 import Anoma.Rpc.Base
+import Anoma.Rpc.RunNock.JsonOptions
 import Juvix.Prelude
-import Juvix.Prelude.Aeson
+import Juvix.Prelude.Aeson as Aeson
 
 runNockGrpcUrl :: GrpcMethodUrl
 runNockGrpcUrl =
   mkGrpcMethodUrl $
-    "Anoma" :| ["Protobuf", "Intents", "Prove"]
+    "Anoma" :| ["Protobuf", "NockService", "Prove"]
 
 data NockInput
   = NockInputText Text
@@ -42,16 +43,46 @@ $( deriveJSON
      ''RunNock
  )
 
+data NockError = NockError
+  { _errorError :: Text,
+    _errorTraces :: [Text]
+  }
+
+$(deriveToJSON nockErrorOptions ''NockError)
+
+instance FromJSON NockError where
+  parseJSON =
+    $(mkParseJSON nockErrorOptions ''NockError)
+      . addDefaultValues' defaultValues
+    where
+      defaultValues :: HashMap Key Value
+      defaultValues = hashMap [("output", Aeson.Array mempty)]
+
+data NockSuccess = NockSuccess
+  { _successResult :: Text,
+    _successTraces :: [Text]
+  }
+
+$(deriveToJSON nockSuccessOptions ''NockSuccess)
+
+instance FromJSON NockSuccess where
+  parseJSON =
+    $(mkParseJSON nockSuccessOptions ''NockSuccess)
+      . addDefaultValues' defaultValues
+    where
+      defaultValues :: HashMap Key Value
+      defaultValues = hashMap [("output", Aeson.Array mempty)]
+
 data Response
-  = ResponseProof Text
-  | ResponseError Text
+  = ResponseSuccess NockSuccess
+  | ResponseError NockError
 
 $( deriveJSON
      defaultOptions
        { unwrapUnaryRecords = True,
          sumEncoding = ObjectWithSingleField,
          constructorTagModifier = \case
-           "ResponseProof" -> "proof"
+           "ResponseSuccess" -> "success"
            "ResponseError" -> "error"
            _ -> impossibleError "All constructors must be covered"
        }
@@ -59,3 +90,5 @@ $( deriveJSON
  )
 
 makeLenses ''Response
+makeLenses ''NockSuccess
+makeLenses ''NockError

src/Anoma/Rpc/RunNock/JsonOptions.hs

@@ -0,0 +1,24 @@
+-- | Options needed to derive JSON instances need to be put in a separate file due to
+-- Template Haskell stage restriction
+module Anoma.Rpc.RunNock.JsonOptions where
+
+import Juvix.Prelude
+import Juvix.Prelude.Aeson as Aeson
+
+nockErrorOptions :: Aeson.Options
+nockErrorOptions =
+  defaultOptions
+    { fieldLabelModifier = \case
+        "_errorError" -> "error"
+        "_errorTraces" -> "output"
+        _ -> impossibleError "All fields must be covered"
+    }
+
+nockSuccessOptions :: Aeson.Options
+nockSuccessOptions =
+  defaultOptions
+    { fieldLabelModifier = \case
+        "_successResult" -> "result"
+        "_successTraces" -> "output"
+        _ -> impossibleError "All fields must be covered"
+    }

src/Juvix/Prelude/Aeson.hs

@@ -3,15 +3,18 @@ module Juvix.Prelude.Aeson
     module Data.Aeson,
     module Data.Aeson.TH,
     module Data.Aeson.Text,
+    module Data.Aeson.KeyMap,
   )
 where
 
 import Data.Aeson
 import Data.Aeson.Encode.Pretty (encodePretty)
+import Data.Aeson.KeyMap
 import Data.Aeson.KeyMap qualified as KeyMap
 import Data.Aeson.TH
 import Data.Aeson.Text
 import Data.ByteString.Lazy qualified as BS
+import Data.HashMap.Strict qualified as HashMap
 import Data.Text.Lazy qualified as Lazy
 import Juvix.Prelude.Base
 
@@ -30,3 +33,14 @@ jsonAppendFields :: [(Key, Value)] -> Value -> Value
 jsonAppendFields keyValues = \case
   Object obj -> Object (KeyMap.fromList keyValues <> obj)
   a -> a
+
+addDefaultValues :: HashMap Key Value -> Object -> Object
+addDefaultValues defVals obj = run . execState obj $
+  forM_ (HashMap.toList defVals) $ \(k, def) -> do
+    modify (insertWith (\_new old -> old) k def)
+
+-- | Fails when the given Value is not an object
+addDefaultValues' :: HashMap Key Value -> Value -> Value
+addDefaultValues' defVals v = case v of
+  Object obj -> Object (addDefaultValues defVals obj)
+  _ -> error "Expected an object"

test/Anoma/Compilation/Positive.hs

@@ -77,20 +77,21 @@ mkAnomaNodeTest a@AnomaTest {..} =
     assertion :: Assertion
     assertion = do
       program :: Term Natural <- (^. anomaClosure) <$> withRootCopy (compileMain False _anomaRelRoot _anomaMainFile)
-      -- For some reason the evaluation fails if no args are given
-      let args'
-            | null _anomaArgs = [toNock (nockVoid @Natural)]
-            | otherwise = _anomaArgs
       testAnomaPath <- envAnomaPath
       runM
         . ignoreLogger
         . runSimpleErrorHUnit
         . runAnoma testAnomaPath
         $ do
-          out <- runNockma program args'
+          let rinput =
+                RunNockmaInput
+                  { _runNockmaProgram = program,
+                    _runNockmaArgs = _anomaArgs
+                  }
+          out <- runNockma rinput
           runM
-            . runReader out
-            . runReader []
+            . runReader (out ^. runNockmaResult)
+            . runReader (out ^. runNockmaTraces)
             $ _anomaCheck
 
 withRootCopy :: (Prelude.Path Abs Dir -> IO a) -> IO a
@@ -146,67 +147,65 @@ checkOutput expected = case unsnoc expected of
 
 data TestClass
   = ClassWorking
-  | -- | The test uses trace, so we need to wait until we update the anoma-node
-    -- and parse the traces from the response
-    ClassTrace
   | -- | The anoma node returns a response with an error
     ClassNodeError
   | -- | The anoma node returns a value but it doesn't match the expected value
     ClassWrong
   | -- | We have no test with this number
     ClassMissing
+  | ClassExpectedFail
   deriving stock (Eq, Show)
 
 classify :: AnomaTest -> TestClass
 classify AnomaTest {..} = case _anomaTestNum of
   1 -> ClassWorking
   2 -> ClassWorking
-  3 -> ClassTrace
+  3 -> ClassWorking
   4 -> ClassMissing
   5 -> ClassWorking
-  6 -> ClassTrace
-  7 -> ClassTrace
+  6 -> ClassWorking
+  7 -> ClassWorking
   8 -> ClassWorking
-  9 -> ClassTrace
+  9 -> ClassWorking
   10 -> ClassWorking
-  11 -> ClassTrace
-  12 -> ClassTrace
-  13 -> ClassTrace
-  14 -> ClassTrace
-  15 -> ClassTrace
+  11 -> ClassWorking
+  12 -> ClassWorking
+  13 -> ClassWorking
+  14 -> ClassWorking
+  15 -> ClassWorking
   16 -> ClassWorking
   17 -> ClassWorking
   18 -> ClassWorking
   19 -> ClassWorking
-  20 -> ClassTrace
-  21 -> ClassTrace
-  22 -> ClassTrace
-  23 -> ClassTrace
+  20 -> ClassWorking
+  21 -> ClassWorking
+  22 -> ClassWorking
+  23 -> ClassWorking
   24 -> ClassWorking
-  25 -> ClassTrace
+  25 -> ClassWorking
   26 -> ClassWorking
   27 -> ClassMissing
-  28 -> ClassTrace
-  29 -> ClassTrace
-  30 -> ClassTrace
+  28 -> ClassWrong
+  29 -> ClassWorking
+  30 -> ClassWorking
   31 -> ClassWorking
-  32 -> ClassTrace
-  33 -> ClassTrace
-  34 -> ClassTrace
-  35 -> ClassTrace
+  32 -> ClassWorking
+  33 -> ClassWorking
+  34 -> ClassWorking
+  35 -> ClassWorking
   36 -> ClassWorking
   37 -> ClassWorking
   38 -> ClassWorking
-  39 -> ClassTrace
+  39 -> ClassWorking
   40 -> ClassWorking
   41 -> ClassWorking
   42 -> ClassMissing
-  43 -> ClassTrace
+  43 -> ClassWorking
   45 -> ClassWorking
   46 -> ClassWorking
   47 -> ClassWorking
   48 -> ClassMissing
-  49 -> ClassTrace
+  49 -> ClassWorking
   50 -> ClassWorking
   51 -> ClassMissing
   52 -> ClassWorking
@@ -218,9 +217,9 @@ classify AnomaTest {..} = case _anomaTestNum of
   58 -> ClassWorking
   59 -> ClassWorking
   60 -> ClassWorking
-  61 -> ClassTrace
+  61 -> ClassWorking
   62 -> ClassWorking
-  63 -> ClassTrace
+  63 -> ClassWorking
   64 -> ClassWorking
   65 -> ClassWorking
   66 -> ClassWorking
@@ -231,19 +230,19 @@ classify AnomaTest {..} = case _anomaTestNum of
   71 -> ClassWorking
   72 -> ClassWorking
   73 -> ClassWorking
-  74 -> ClassTrace
-  75 -> ClassTrace
-  76 -> ClassTrace
+  74 -> ClassExpectedFail
+  75 -> ClassWorking
+  76 -> ClassWorking
   77 -> ClassNodeError
   78 -> ClassNodeError
   79 -> ClassWorking
-  80 -> ClassTrace
-  81 -> ClassTrace
-  82 -> ClassTrace
-  83 -> ClassTrace
-  84 -> ClassTrace
-  85 -> ClassTrace
-  86 -> ClassTrace
+  80 -> ClassWorking
+  81 -> ClassWorking
+  82 -> ClassWorking
+  83 -> ClassWorking
+  84 -> ClassWrong
+  85 -> ClassWorking
+  86 -> ClassExpectedFail
   _ -> error "non-exhaustive test classification"
 
 allTests :: TestTree