From ca56b6b0cd0b3531d8b4518a40c183ba25aa57d5 Mon Sep 17 00:00:00 2001 From: Jan Mas Rovira Date: Fri, 8 Nov 2024 12:54:17 +0100 Subject: [PATCH] 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 | 2 +- app/Commands/Dev/Nockma/Run.hs | 16 ++++- src/Anoma/Effect/Base.hs | 6 -- src/Anoma/Effect/RunNockma.hs | 44 +++++++++----- src/Anoma/Rpc/RunNock.hs | 43 +++++++++++-- src/Anoma/Rpc/RunNock/JsonOptions.hs | 24 ++++++++ src/Juvix/Prelude/Aeson.hs | 14 +++++ test/Anoma/Compilation/Positive.hs | 91 ++++++++++++++-------------- 8 files changed, 165 insertions(+), 75 deletions(-) create mode 100644 src/Anoma/Rpc/RunNock/JsonOptions.hs diff --git a/.github/workflows/ci.yml b/.github/workflows/ci.yml index 8e59af463..ba4da81af 100644 --- a/.github/workflows/ci.yml +++ b/.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 diff --git a/app/Commands/Dev/Nockma/Run.hs b/app/Commands/Dev/Nockma/Run.hs index 0c5c88429..6bb4c595c 100644 --- a/app/Commands/Dev/Nockma/Run.hs +++ b/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)) diff --git a/src/Anoma/Effect/Base.hs b/src/Anoma/Effect/Base.hs index bb1c5941f..8d69d6d89 100644 --- a/src/Anoma/Effect/Base.hs +++ b/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 -> diff --git a/src/Anoma/Effect/RunNockma.hs b/src/Anoma/Effect/RunNockma.hs index 5273ba937..8c1f9f226 100644 --- a/src/Anoma/Effect/RunNockma.hs +++ b/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))) diff --git a/src/Anoma/Rpc/RunNock.hs b/src/Anoma/Rpc/RunNock.hs index c25a8085f..ea145632e 100644 --- a/src/Anoma/Rpc/RunNock.hs +++ b/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 diff --git a/src/Anoma/Rpc/RunNock/JsonOptions.hs b/src/Anoma/Rpc/RunNock/JsonOptions.hs new file mode 100644 index 000000000..5f1ec3441 --- /dev/null +++ b/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" + } diff --git a/src/Juvix/Prelude/Aeson.hs b/src/Juvix/Prelude/Aeson.hs index 333e95ee5..a274e5ba0 100644 --- a/src/Juvix/Prelude/Aeson.hs +++ b/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" diff --git a/test/Anoma/Compilation/Positive.hs b/test/Anoma/Compilation/Positive.hs index 91140924d..748761479 100644 --- a/test/Anoma/Compilation/Positive.hs +++ b/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