Support traces in the anoma node

.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,38 +10,54 @@ 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
   Aeson.Success r -> return r
   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,20 +43,52 @@ $( 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"
        }
      ''Response
  )
 
 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"