From c2ae59154858118f919205169fff14a98b4aaf24 Mon Sep 17 00:00:00 2001 From: Jan Mas Rovira Date: Thu, 24 Oct 2024 17:00:12 +0200 Subject: [PATCH 01/16] scaffolding --- app/Commands/Dev.hs | 2 ++ app/Commands/Dev/Anoma.hs | 13 +++++++++++++ app/Commands/Dev/Anoma/Node.hs | 8 ++++++++ app/Commands/Dev/Anoma/Node/Options.hs | 20 ++++++++++++++++++++ app/Commands/Dev/Anoma/Options.hs | 24 ++++++++++++++++++++++++ app/Commands/Dev/Options.hs | 10 ++++++++++ 6 files changed, 77 insertions(+) create mode 100644 app/Commands/Dev/Anoma.hs create mode 100644 app/Commands/Dev/Anoma/Node.hs create mode 100644 app/Commands/Dev/Anoma/Node/Options.hs create mode 100644 app/Commands/Dev/Anoma/Options.hs diff --git a/app/Commands/Dev.hs b/app/Commands/Dev.hs index c9910635c0..c4726a5097 100644 --- a/app/Commands/Dev.hs +++ b/app/Commands/Dev.hs @@ -5,6 +5,7 @@ module Commands.Dev where import Commands.Base +import Commands.Dev.Anoma qualified as Anoma import Commands.Dev.Asm qualified as Asm import Commands.Dev.Casm qualified as Casm import Commands.Dev.Core qualified as Core @@ -45,3 +46,4 @@ runCommand = \case JuvixDevRepl opts -> Repl.runCommand opts MigrateJuvixYaml opts -> runFilesIO $ MigrateJuvixYaml.runCommand opts Nockma opts -> Nockma.runCommand opts + Anoma opts -> Anoma.runCommand opts diff --git a/app/Commands/Dev/Anoma.hs b/app/Commands/Dev/Anoma.hs new file mode 100644 index 0000000000..b723f0cef0 --- /dev/null +++ b/app/Commands/Dev/Anoma.hs @@ -0,0 +1,13 @@ +module Commands.Dev.Anoma + ( module Commands.Dev.Anoma, + module Commands.Dev.Anoma.Options, + ) +where + +import Commands.Base +import Commands.Dev.Anoma.Node qualified as Node +import Commands.Dev.Anoma.Options + +runCommand :: (Members AppEffects r) => AnomaCommand -> Sem r () +runCommand = \case + Node opts -> Node.runCommand opts diff --git a/app/Commands/Dev/Anoma/Node.hs b/app/Commands/Dev/Anoma/Node.hs new file mode 100644 index 0000000000..e1f3256cba --- /dev/null +++ b/app/Commands/Dev/Anoma/Node.hs @@ -0,0 +1,8 @@ +module Commands.Dev.Anoma.Node where + +import Commands.Base +import Commands.Dev.Anoma.Node.Options + +runCommand :: forall r. (Members AppEffects r) => NodeOptions -> Sem r () +runCommand opts = do + return () diff --git a/app/Commands/Dev/Anoma/Node/Options.hs b/app/Commands/Dev/Anoma/Node/Options.hs new file mode 100644 index 0000000000..6f2466e331 --- /dev/null +++ b/app/Commands/Dev/Anoma/Node/Options.hs @@ -0,0 +1,20 @@ +module Commands.Dev.Anoma.Node.Options where + +import CommonOptions + +newtype NodeOptions = NodeOptions + { _nodeAnomaPath :: AppPath Dir + } + deriving stock (Data) + +makeLenses ''NodeOptions + +parseNodeOptions :: Parser NodeOptions +parseNodeOptions = do + _nodeAnomaPath <- + parseGenericOutputDir + ( help "Anoma repository directory" + <> action "directory" + ) + + pure NodeOptions {..} diff --git a/app/Commands/Dev/Anoma/Options.hs b/app/Commands/Dev/Anoma/Options.hs new file mode 100644 index 0000000000..d58c6e5506 --- /dev/null +++ b/app/Commands/Dev/Anoma/Options.hs @@ -0,0 +1,24 @@ +module Commands.Dev.Anoma.Options where + +import Commands.Dev.Anoma.Node.Options +import CommonOptions + +newtype AnomaCommand + = Node NodeOptions + deriving stock (Data) + +parseAnomaCommand :: Parser AnomaCommand +parseAnomaCommand = + hsubparser + ( mconcat + [commandNode] + ) + where + commandNode :: Mod CommandFields AnomaCommand + commandNode = command "node" runInfo + where + runInfo :: ParserInfo AnomaCommand + runInfo = + info + (Node <$> parseNodeOptions) + (progDesc "Run an Anoma node and client.") diff --git a/app/Commands/Dev/Options.hs b/app/Commands/Dev/Options.hs index f68a579789..f0892cffd9 100644 --- a/app/Commands/Dev/Options.hs +++ b/app/Commands/Dev/Options.hs @@ -12,6 +12,7 @@ module Commands.Dev.Options ) where +import Commands.Dev.Anoma.Options import Commands.Dev.Asm.Options hiding (Compile) import Commands.Dev.Casm.Options import Commands.Dev.Core.Options @@ -52,6 +53,7 @@ data DevCommand | JuvixDevRepl ReplOptions | MigrateJuvixYaml MigrateJuvixYamlOptions | Nockma NockmaCommand + | Anoma AnomaCommand deriving stock (Data) parseDevCommand :: Parser DevCommand @@ -75,6 +77,7 @@ parseDevCommand = commandJuvixDevRepl, commandMigrateJuvixYaml, commandLatex, + commandAnoma, commandNockma ] ) @@ -206,3 +209,10 @@ commandNockma = info (Nockma <$> parseNockmaCommand) (progDesc "Subcommands related to the nockma backend") + +commandAnoma :: Mod CommandFields DevCommand +commandAnoma = + command "anoma" $ + info + (Anoma <$> parseAnomaCommand) + (progDesc "Subcommands related to the anoma") From fcab714840254d96395a3c435980639476be00d7 Mon Sep 17 00:00:00 2001 From: Jan Mas Rovira Date: Thu, 24 Oct 2024 18:51:33 +0200 Subject: [PATCH 02/16] add command `dev anoma node` --- app/Commands/Dev/Anoma/Node.hs | 82 ++++++++++++++++++++++++- app/Commands/Dev/Anoma/Node/Options.hs | 20 ++++-- app/Commands/Dev/Core/Repl.hs | 2 +- app/CommonOptions.hs | 4 +- include/anoma/start.exs | 1 + src/Juvix/Compiler/Pipeline.hs | 4 +- src/Juvix/Compiler/Reg/Interpreter.hs | 4 +- src/Juvix/Compiler/Tree/Evaluator.hs | 4 +- src/Juvix/Compiler/Tree/EvaluatorEff.hs | 4 +- src/Juvix/Data/Effect/Git/Process.hs | 28 ++++----- src/Juvix/Data/Effect/Process/Base.hs | 8 +-- src/Juvix/Data/Effect/Process/IO.hs | 2 +- src/Juvix/Extra/Paths.hs | 3 + src/Juvix/Extra/Paths/Base.hs | 3 + src/Juvix/Prelude/Base/Foundation.hs | 17 ++++- src/Juvix/Prelude/Effects/Base.hs | 2 + 16 files changed, 150 insertions(+), 38 deletions(-) create mode 100644 include/anoma/start.exs diff --git a/app/Commands/Dev/Anoma/Node.hs b/app/Commands/Dev/Anoma/Node.hs index e1f3256cba..587c943d56 100644 --- a/app/Commands/Dev/Anoma/Node.hs +++ b/app/Commands/Dev/Anoma/Node.hs @@ -2,7 +2,85 @@ module Commands.Dev.Anoma.Node where import Commands.Base import Commands.Dev.Anoma.Node.Options +import Data.ByteString qualified as B +import Juvix.Extra.Paths (anomaStartExs) +import Prelude (read) + +-- | Returns (stdout, processHandle) +withSapwnAnomaNode :: + (Members '[EmbedIO, Process] r) => + Path Abs File -> + Handle -> + (Handle -> ProcessHandle -> Sem r a) -> + Sem r a +withSapwnAnomaNode tmpFp tmpHandle body = do + liftIO (B.hPutStr tmpHandle anomaStartExs) + hFlush tmpHandle + withCreateProcess (cprocess (toFilePath tmpFp)) $ \_stdin mstdout _stderr procHandle -> do + body (fromJust mstdout) procHandle + where + cprocess :: FilePath -> CreateProcess + cprocess exs = + (proc "mix" ["run", "--no-halt", exs]) + { std_out = CreatePipe, + -- This needs to be set to True so that Ctrl+c is handled by the + -- elixir shell. If set to False, the elixir shell will be kept alive + -- even if juvix is terminated + delegate_ctlc = True + } + +-- | Echoes elixir output. Useful to see the help message when Ctrl+c is issued +echoHandle :: (Members '[EmbedIO] r) => Handle -> Sem r () +echoHandle h = do + theEnd <- hIsEOF h + if + | theEnd -> return () + | otherwise -> do + ln <- hGetLine h + putStrLn ln + echoHandle h + +listenPort :: Int +listenPort = 50051 + +withSpawnAnomaClient :: (Members '[Process, EmbedIO] r) => Int -> (ProcessHandle -> Sem r ()) -> Sem r () +withSpawnAnomaClient grpcPort body = + withCreateProcess cprocess $ \_stdin mstdout _stderr procHandle -> do + let out = fromJust mstdout + txt <- hGetLine out + case takeWhile (/= '.') (unpack txt) of + "Connected to node" -> do + putStrLn "anoma client successfully started" + body procHandle + _ -> error "Something went wrong when starting the anoma client" + where + cprocess :: CreateProcess + cprocess = + ( proc + (toFilePath clientRelFile) + [ "--listen-port", + show listenPort, + "--node-host", + "localhost", + "--node-port", + show grpcPort + ] + ) + { std_out = CreatePipe + } + + -- Relative to the anoma repository + clientRelFile :: Path Rel File + clientRelFile = $(mkRelFile "apps/anoma_client/anoma_client") runCommand :: forall r. (Members AppEffects r) => NodeOptions -> Sem r () -runCommand opts = do - return () +runCommand opts = runConcurrent . runProcess $ do + anomaDir :: Path Abs Dir <- fromAppPathDir (opts ^. nodeAnomaPath) + withCurrentDir anomaDir $ do + withSystemTempFile "start.exs" $ \fp tmpHandle -> + withSapwnAnomaNode fp tmpHandle $ \nodeOut nodeH -> do + grpcNode :: Int <- read . unpack <$> hGetLine nodeOut + putStrLn ("grpc_node = " <> prettyText grpcNode) + withAsync (echoHandle nodeOut) $ \_asyncH -> + withSpawnAnomaClient grpcNode $ \_clientH -> do + void (waitForProcess nodeH) diff --git a/app/Commands/Dev/Anoma/Node/Options.hs b/app/Commands/Dev/Anoma/Node/Options.hs index 6f2466e331..1e30ced44f 100644 --- a/app/Commands/Dev/Anoma/Node/Options.hs +++ b/app/Commands/Dev/Anoma/Node/Options.hs @@ -11,10 +11,20 @@ makeLenses ''NodeOptions parseNodeOptions :: Parser NodeOptions parseNodeOptions = do - _nodeAnomaPath <- - parseGenericOutputDir - ( help "Anoma repository directory" + path <- + option + somePreDirOpt + ( long "anoma-dir" + <> metavar "ANOMA_DIR" + <> help "Path to anoma repository" <> action "directory" ) - - pure NodeOptions {..} + pure + NodeOptions + { _nodeAnomaPath = + AppPath + { _pathIsInput = False, + _pathPath = path + }, + .. + } diff --git a/app/Commands/Dev/Core/Repl.hs b/app/Commands/Dev/Core/Repl.hs index 650d8d81bf..b04eb381ff 100644 --- a/app/Commands/Dev/Core/Repl.hs +++ b/app/Commands/Dev/Core/Repl.hs @@ -28,7 +28,7 @@ parseText = Core.runParser replPath defaultModuleId runRepl :: forall r. (Members '[EmbedIO, App] r) => CoreReplOptions -> Core.InfoTable -> Sem r () runRepl opts tab = do putStr "> " - liftIO (hFlush stdout) + hFlush stdout done <- liftIO isEOF unless done $ do s <- getLine diff --git a/app/CommonOptions.hs b/app/CommonOptions.hs index 2682bfd0e8..d39484248a 100644 --- a/app/CommonOptions.hs +++ b/app/CommonOptions.hs @@ -28,7 +28,7 @@ import Juvix.Prelude.Pretty hiding (group, list) import Options.Applicative hiding (helpDoc) import Options.Applicative qualified as Opt import Prettyprinter.Render.Terminal hiding (renderIO, renderStrict) -import System.Process +import System.Process as System import Text.Read (readMaybe) import Prelude qualified @@ -209,7 +209,7 @@ enumCompleter _ = listCompleter [Juvix.show e | e <- allElements @a] extCompleter :: FileExt -> Completer extCompleter ext = mkCompleter $ \word -> do let cmd = unwords ["compgen", "-o", "plusdirs", "-f", "-X", "!*" <> Prelude.show ext, "--", requote word] - result <- GHC.try @GHC.SomeException $ readProcess "bash" ["-c", cmd] "" + result <- GHC.try @GHC.SomeException $ System.readProcess "bash" ["-c", cmd] "" return . lines . fromRight [] $ result requote :: String -> String diff --git a/include/anoma/start.exs b/include/anoma/start.exs new file mode 100644 index 0000000000..f2beab944c --- /dev/null +++ b/include/anoma/start.exs @@ -0,0 +1 @@ + IO.puts(Anoma.Node.Examples.ENode.start_node().grpc_port) diff --git a/src/Juvix/Compiler/Pipeline.hs b/src/Juvix/Compiler/Pipeline.hs index 4f957b11b6..c76f29f97b 100644 --- a/src/Juvix/Compiler/Pipeline.hs +++ b/src/Juvix/Compiler/Pipeline.hs @@ -52,7 +52,7 @@ import Juvix.Compiler.Reg.Translation.FromAsm qualified as Reg import Juvix.Compiler.Store.Language qualified as Store import Juvix.Compiler.Tree qualified as Tree import Juvix.Data.Effect.Git -import Juvix.Data.Effect.Process +import Juvix.Data.Effect.Process.Base (ProcessE) import Juvix.Data.Field import Parallel.ProgressLog @@ -73,7 +73,7 @@ type PipelineLocalEff = Error DependencyError, GitClone, Error GitProcessError, - Process, + ProcessE, Log, Reader EntryPoint, Files, diff --git a/src/Juvix/Compiler/Reg/Interpreter.hs b/src/Juvix/Compiler/Reg/Interpreter.hs index 0961c72f8b..66181269de 100644 --- a/src/Juvix/Compiler/Reg/Interpreter.hs +++ b/src/Juvix/Compiler/Reg/Interpreter.hs @@ -352,8 +352,8 @@ runIO hin hout infoTable = \case hPutStr hout (ppPrint infoTable arg) return ValVoid ValConstr (Constr (BuiltinTag TagReadLn) []) -> do - liftIO $ hFlush hout - s <- liftIO $ hGetLine hin + hFlush hout + s <- hGetLine hin return (ValString s) val -> return val diff --git a/src/Juvix/Compiler/Tree/Evaluator.hs b/src/Juvix/Compiler/Tree/Evaluator.hs index e8dc8797f0..a104021613 100644 --- a/src/Juvix/Compiler/Tree/Evaluator.hs +++ b/src/Juvix/Compiler/Tree/Evaluator.hs @@ -296,8 +296,8 @@ hRunIO hin hout infoTable = \case hPutStr hout (ppPrint infoTable arg) return ValVoid ValConstr (Constr (BuiltinTag TagReadLn) []) -> do - liftIO $ hFlush hout - s <- liftIO $ hGetLine hin + hFlush hout + s <- hGetLine hin return (ValString s) val -> return val diff --git a/src/Juvix/Compiler/Tree/EvaluatorEff.hs b/src/Juvix/Compiler/Tree/EvaluatorEff.hs index 859b38f50b..83f812bab8 100644 --- a/src/Juvix/Compiler/Tree/EvaluatorEff.hs +++ b/src/Juvix/Compiler/Tree/EvaluatorEff.hs @@ -334,8 +334,8 @@ hRunIO hin hout infoTable = \case hPutStr hout (ppPrint infoTable arg) return ValVoid ValConstr (Constr (BuiltinTag TagReadLn) []) -> do - liftIO $ hFlush hout - s <- liftIO $ hGetLine hin + hFlush hout + s <- hGetLine hin return (ValString s) val -> return val diff --git a/src/Juvix/Data/Effect/Git/Process.hs b/src/Juvix/Data/Effect/Git/Process.hs index 209339385a..1dba21c5df 100644 --- a/src/Juvix/Data/Effect/Git/Process.hs +++ b/src/Juvix/Data/Effect/Git/Process.hs @@ -13,7 +13,7 @@ newtype CloneEnv = CloneEnv makeLenses ''CloneEnv -- | Run a git command in the current working directory of the parent process. -runGitCmd :: (Members '[Process, Error GitProcessError] r) => [Text] -> Sem r Text +runGitCmd :: (Members '[ProcessE, Error GitProcessError] r) => [Text] -> Sem r Text runGitCmd args = do mcmd <- findExecutable' $(mkRelFile "git") case mcmd of @@ -35,53 +35,53 @@ runGitCmd args = do ExitSuccess -> return (res ^. processResultStdout) -- | Run a git command within a directory, throws an error if the directory is not a valid clone -runGitCmdInDir :: (Members '[Process, Error GitProcessError, Reader CloneEnv] r) => [Text] -> Sem r Text +runGitCmdInDir :: (Members '[ProcessE, Error GitProcessError, Reader CloneEnv] r) => [Text] -> Sem r Text runGitCmdInDir args = do checkValidGitClone runGitCmdInDir' args -- | Run a git command within a directory -runGitCmdInDir' :: (Members '[Process, Error GitProcessError, Reader CloneEnv] r) => [Text] -> Sem r Text +runGitCmdInDir' :: (Members '[ProcessE, Error GitProcessError, Reader CloneEnv] r) => [Text] -> Sem r Text runGitCmdInDir' args = do p <- asks (^. cloneEnvDir) runGitCmd (["--git-dir", ".git", "-C", T.pack (toFilePath p)] <> args) -- | Throws an error if the directory is not a valid git clone -checkValidGitClone :: (Members '[Process, Error GitProcessError, Reader CloneEnv] r) => Sem r () +checkValidGitClone :: (Members '[ProcessE, Error GitProcessError, Reader CloneEnv] r) => Sem r () checkValidGitClone = void gitHeadRef -isValidGitClone :: (Members '[Process, Reader CloneEnv] r) => Sem r Bool +isValidGitClone :: (Members '[ProcessE, Reader CloneEnv] r) => Sem r Bool isValidGitClone = isRight <$> runError @GitProcessError checkValidGitClone -- | Return the normal form of the passed git reference -gitNormalizeRef :: forall r. (Members '[Process, Error GitProcessError, Reader CloneEnv] r) => Text -> Sem r Text +gitNormalizeRef :: forall r. (Members '[ProcessE, Error GitProcessError, Reader CloneEnv] r) => Text -> Sem r Text gitNormalizeRef ref = T.strip <$> runGitCmdInDir' ["rev-parse", "--verify", ref <> "^{commit}"] -- | Return the HEAD ref of the clone -gitHeadRef :: (Members '[Process, Error GitProcessError, Reader CloneEnv] r) => Sem r Text +gitHeadRef :: (Members '[ProcessE, Error GitProcessError, Reader CloneEnv] r) => Sem r Text gitHeadRef = gitNormalizeRef "HEAD" -- | Checkout the clone at a particular ref -gitCheckout :: (Members '[TaggedLock, Process, Error GitProcessError, Reader CloneEnv] r) => Text -> Sem r () +gitCheckout :: (Members '[TaggedLock, ProcessE, Error GitProcessError, Reader CloneEnv] r) => Text -> Sem r () gitCheckout ref = withTaggedLockDir' (void (runGitCmdInDir ["checkout", ref])) -- | Fetch in the clone -gitFetch :: (Members '[TaggedLock, Process, Error GitProcessError, Reader CloneEnv, Internet] r) => Sem r () +gitFetch :: (Members '[TaggedLock, ProcessE, Error GitProcessError, Reader CloneEnv, Internet] r) => Sem r () gitFetch = whenHasInternet gitFetchOnline -gitFetchOnline :: (Members '[TaggedLock, Reader CloneEnv, Error GitProcessError, Process, Online] r) => Sem r () +gitFetchOnline :: (Members '[TaggedLock, Reader CloneEnv, Error GitProcessError, ProcessE, Online] r) => Sem r () gitFetchOnline = withTaggedLockDir' (void (runGitCmdInDir ["fetch"])) -gitCloneOnline :: (Members '[Log, Error GitProcessError, Process, Online, Reader CloneEnv] r) => Text -> Sem r () +gitCloneOnline :: (Members '[Log, Error GitProcessError, ProcessE, Online, Reader CloneEnv] r) => Text -> Sem r () gitCloneOnline url = do p <- asks (^. cloneEnvDir) log ("Cloning " <> url <> " to " <> pack (toFilePath p)) void (runGitCmd ["clone", url, T.pack (toFilePath p)]) -cloneGitRepo :: (Members '[Log, Files, Process, Error GitProcessError, Reader CloneEnv, Internet] r) => Text -> Sem r () +cloneGitRepo :: (Members '[Log, Files, ProcessE, Error GitProcessError, Reader CloneEnv, Internet] r) => Text -> Sem r () cloneGitRepo = whenHasInternet . gitCloneOnline -initGitRepo :: (Members '[TaggedLock, Log, Files, Process, Error GitProcessError, Reader CloneEnv, Internet] r) => Text -> Sem r (Path Abs Dir) +initGitRepo :: (Members '[TaggedLock, Log, Files, ProcessE, Error GitProcessError, Reader CloneEnv, Internet] r) => Text -> Sem r (Path Abs Dir) initGitRepo url = do p <- asks (^. cloneEnvDir) withTaggedLockDir' (unlessM (directoryExists' p) (cloneGitRepo url)) @@ -112,7 +112,7 @@ withTaggedLockDir' ma = do runGitProcess :: forall r a. - (Members '[TaggedLock, Log, Files, Process, Error GitProcessError, Internet] r) => + (Members '[TaggedLock, Log, Files, ProcessE, Error GitProcessError, Internet] r) => Sem (GitClone ': r) a -> Sem r a runGitProcess = runProvider_ helper diff --git a/src/Juvix/Data/Effect/Process/Base.hs b/src/Juvix/Data/Effect/Process/Base.hs index f22f37063b..4aaf52a181 100644 --- a/src/Juvix/Data/Effect/Process/Base.hs +++ b/src/Juvix/Data/Effect/Process/Base.hs @@ -13,10 +13,10 @@ data ProcessCall = ProcessCall _processCallArgs :: [Text] } -data Process :: Effect where - FindExecutable' :: Path Rel File -> Process m (Maybe (Path Abs File)) - ReadProcess' :: ProcessCall -> Process m ProcessResult +data ProcessE :: Effect where + FindExecutable' :: Path Rel File -> ProcessE m (Maybe (Path Abs File)) + ReadProcess' :: ProcessCall -> ProcessE m ProcessResult -makeSem ''Process +makeSem ''ProcessE makeLenses ''ProcessResult makeLenses ''ProcessCall diff --git a/src/Juvix/Data/Effect/Process/IO.hs b/src/Juvix/Data/Effect/Process/IO.hs index fe61277f34..03420258a7 100644 --- a/src/Juvix/Data/Effect/Process/IO.hs +++ b/src/Juvix/Data/Effect/Process/IO.hs @@ -10,7 +10,7 @@ import System.Process.Typed qualified as P runProcessIO :: forall r a. (Members '[EmbedIO] r) => - Sem (Process ': r) a -> + Sem (ProcessE ': r) a -> Sem r a runProcessIO = interpret $ \case FindExecutable' n -> findExecutable n diff --git a/src/Juvix/Extra/Paths.hs b/src/Juvix/Extra/Paths.hs index d127e1eb86..84dbbb432f 100644 --- a/src/Juvix/Extra/Paths.hs +++ b/src/Juvix/Extra/Paths.hs @@ -21,6 +21,9 @@ cssDir = map (first relFile) $(cssDirQ) juvixSty :: ByteString juvixSty = $(juvixStyQ) +anomaStartExs :: ByteString +anomaStartExs = $(anomaStartExsQ) + jsDir :: [(Path Rel File, ByteString)] jsDir = map (first relFile) $(jsDirQ) diff --git a/src/Juvix/Extra/Paths/Base.hs b/src/Juvix/Extra/Paths/Base.hs index dee0093307..d359069e1f 100644 --- a/src/Juvix/Extra/Paths/Base.hs +++ b/src/Juvix/Extra/Paths/Base.hs @@ -15,6 +15,9 @@ cssDirQ = FE.makeRelativeToProject "assets/css" >>= FE.embedDir juvixStyQ :: Q Exp juvixStyQ = FE.embedFileRelative "include/latex/juvix.sty" +anomaStartExsQ :: Q Exp +anomaStartExsQ = FE.embedFileRelative "include/anoma/start.exs" + jsDirQ :: Q Exp jsDirQ = FE.makeRelativeToProject "assets/js" >>= FE.embedDir diff --git a/src/Juvix/Prelude/Base/Foundation.hs b/src/Juvix/Prelude/Base/Foundation.hs index 204e25905a..25d5506d51 100644 --- a/src/Juvix/Prelude/Base/Foundation.hs +++ b/src/Juvix/Prelude/Base/Foundation.hs @@ -180,7 +180,7 @@ import Data.Text qualified as Text import Data.Text.Encoding import Data.Text.IO hiding (appendFile, getContents, getLine, hGetContents, hGetLine, hPutStr, hPutStrLn, interact, putStr, putStrLn, readFile, writeFile) import Data.Text.IO qualified as Text -import Data.Text.IO.Utf8 hiding (getLine, hPutStr, hPutStrLn, putStr, putStrLn, readFile, writeFile) +import Data.Text.IO.Utf8 hiding (getLine, hGetLine, hPutStr, hPutStrLn, putStr, putStrLn, readFile, writeFile) import Data.Text.IO.Utf8 qualified as Utf8 import Data.Text.Lazy.Builder qualified as LazyText import Data.Traversable @@ -213,8 +213,11 @@ import System.IO hiding ( appendFile, getContents, getLine, + hClose, + hFlush, hGetContents, hGetLine, + hIsEOF, hPutStr, hPutStrLn, interact, @@ -559,6 +562,18 @@ indexFrom i = zipWith Indexed [i ..] makeLenses ''Indexed +hClose :: (MonadIO m) => Handle -> m () +hClose = liftIO . IO.hClose + +hGetLine :: (MonadIO m) => Handle -> m Text +hGetLine = liftIO . Utf8.hGetLine + +hIsEOF :: (MonadIO m) => Handle -> m Bool +hIsEOF = liftIO . IO.hIsEOF + +hFlush :: (MonadIO m) => Handle -> m () +hFlush = liftIO . IO.hFlush + toTuple :: Indexed a -> (Int, a) toTuple i = (i ^. indexedIx, i ^. indexedThing) diff --git a/src/Juvix/Prelude/Effects/Base.hs b/src/Juvix/Prelude/Effects/Base.hs index 7afde7b547..827c815342 100644 --- a/src/Juvix/Prelude/Effects/Base.hs +++ b/src/Juvix/Prelude/Effects/Base.hs @@ -10,6 +10,7 @@ module Juvix.Prelude.Effects.Base module Effectful.Dispatch.Static, module Effectful.Provider, module Effectful.Concurrent.Async, + module Effectful.Process, ) where @@ -23,6 +24,7 @@ import Effectful.Dispatch.Dynamic qualified as E import Effectful.Dispatch.Static import Effectful.Error.Static hiding (runError, runErrorWith) import Effectful.Internal.Env (getEnv, putEnv) +import Effectful.Process hiding (env) import Effectful.Provider import Effectful.Reader.Static import Effectful.State.Static.Local hiding (runState, state) From c599333b0db3c2c8b7cfbd47d293c0c24e6d9519 Mon Sep 17 00:00:00 2001 From: Jan Mas Rovira Date: Fri, 25 Oct 2024 09:06:38 +0200 Subject: [PATCH 03/16] add Anoma effect --- app/Commands/Compile/Anoma.hs | 20 +++- app/Commands/Compile/CommonOptions.hs | 10 ++ app/Commands/Dev/Anoma/Node.hs | 83 +-------------- src/Anoma/Effect.hs | 19 ++++ src/Anoma/Effect/Base.hs | 141 ++++++++++++++++++++++++++ src/Anoma/Rpc/Base.hs | 45 ++++++++ src/Juvix/Prelude/Aeson.hs | 10 +- src/Juvix/Prelude/Base/Foundation.hs | 5 +- 8 files changed, 245 insertions(+), 88 deletions(-) create mode 100644 src/Anoma/Effect.hs create mode 100644 src/Anoma/Effect/Base.hs create mode 100644 src/Anoma/Rpc/Base.hs diff --git a/app/Commands/Compile/Anoma.hs b/app/Commands/Compile/Anoma.hs index b6b62da809..e86b7132df 100644 --- a/app/Commands/Compile/Anoma.hs +++ b/app/Commands/Compile/Anoma.hs @@ -12,19 +12,31 @@ runCommand opts = do let opts' = opts ^. anomaCompileCommonOptions inputFile = opts' ^. compileInputFile moutputFile = opts' ^. compileOutputFile + nockmaFile :: Path Abs File <- getOutputFile FileExtNockma inputFile moutputFile + res <- compileAnomaOpts opts' + outputAnomaResult (opts' ^. compileDebug) nockmaFile res + +compileAnoma :: (Members AppEffects r) => Maybe (AppPath File) -> Sem r Nockma.AnomaResult +compileAnoma inputFile = do + let opts' = + defaultCompileCommonOptionsMain + { _compileInputFile = inputFile + } + compileAnomaOpts opts' + +compileAnomaOpts :: (Members AppEffects r) => CompileCommonOptions 'InputMain -> Sem r Nockma.AnomaResult +compileAnomaOpts opts' = do coreRes <- fromCompileCommonOptionsMain opts' >>= compileToCore entryPoint <- - applyOptions opts + applyOptions opts' <$> getEntryPoint (opts' ^. compileInputFile) - nockmaFile :: Path Abs File <- getOutputFile FileExtNockma inputFile moutputFile r <- runReader entryPoint . runError @JuvixError . coreToAnoma $ coreRes ^. coreResultModule - res <- getRight r - outputAnomaResult (opts' ^. compileDebug) nockmaFile res + getRight r outputAnomaResult :: (Members '[EmbedIO, App, Files] r) => Bool -> Path Abs File -> Nockma.AnomaResult -> Sem r () outputAnomaResult debugOutput nockmaFile Nockma.AnomaResult {..} = do diff --git a/app/Commands/Compile/CommonOptions.hs b/app/Commands/Compile/CommonOptions.hs index 07883e4eaf..99730cd899 100644 --- a/app/Commands/Compile/CommonOptions.hs +++ b/app/Commands/Compile/CommonOptions.hs @@ -27,6 +27,16 @@ deriving stock instance (Typeable k, Data (InputFileType k)) => Data (CompileCom makeLenses ''CompileCommonOptions +defaultCompileCommonOptionsMain :: CompileCommonOptions 'InputMain +defaultCompileCommonOptionsMain = + CompileCommonOptions + { _compileInputFile = Nothing, + _compileOutputFile = Nothing, + _compileDebug = False, + _compileInliningDepth = defaultInliningDepth, + _compileOptimizationLevel = Just defaultOptimizationLevel + } + instance EntryPointOptions (CompileCommonOptions b) where applyOptions opts e = e diff --git a/app/Commands/Dev/Anoma/Node.hs b/app/Commands/Dev/Anoma/Node.hs index 587c943d56..c6f95ff4f8 100644 --- a/app/Commands/Dev/Anoma/Node.hs +++ b/app/Commands/Dev/Anoma/Node.hs @@ -1,86 +1,11 @@ module Commands.Dev.Anoma.Node where +import Anoma.Effect import Commands.Base import Commands.Dev.Anoma.Node.Options -import Data.ByteString qualified as B -import Juvix.Extra.Paths (anomaStartExs) -import Prelude (read) - --- | Returns (stdout, processHandle) -withSapwnAnomaNode :: - (Members '[EmbedIO, Process] r) => - Path Abs File -> - Handle -> - (Handle -> ProcessHandle -> Sem r a) -> - Sem r a -withSapwnAnomaNode tmpFp tmpHandle body = do - liftIO (B.hPutStr tmpHandle anomaStartExs) - hFlush tmpHandle - withCreateProcess (cprocess (toFilePath tmpFp)) $ \_stdin mstdout _stderr procHandle -> do - body (fromJust mstdout) procHandle - where - cprocess :: FilePath -> CreateProcess - cprocess exs = - (proc "mix" ["run", "--no-halt", exs]) - { std_out = CreatePipe, - -- This needs to be set to True so that Ctrl+c is handled by the - -- elixir shell. If set to False, the elixir shell will be kept alive - -- even if juvix is terminated - delegate_ctlc = True - } - --- | Echoes elixir output. Useful to see the help message when Ctrl+c is issued -echoHandle :: (Members '[EmbedIO] r) => Handle -> Sem r () -echoHandle h = do - theEnd <- hIsEOF h - if - | theEnd -> return () - | otherwise -> do - ln <- hGetLine h - putStrLn ln - echoHandle h - -listenPort :: Int -listenPort = 50051 - -withSpawnAnomaClient :: (Members '[Process, EmbedIO] r) => Int -> (ProcessHandle -> Sem r ()) -> Sem r () -withSpawnAnomaClient grpcPort body = - withCreateProcess cprocess $ \_stdin mstdout _stderr procHandle -> do - let out = fromJust mstdout - txt <- hGetLine out - case takeWhile (/= '.') (unpack txt) of - "Connected to node" -> do - putStrLn "anoma client successfully started" - body procHandle - _ -> error "Something went wrong when starting the anoma client" - where - cprocess :: CreateProcess - cprocess = - ( proc - (toFilePath clientRelFile) - [ "--listen-port", - show listenPort, - "--node-host", - "localhost", - "--node-port", - show grpcPort - ] - ) - { std_out = CreatePipe - } - - -- Relative to the anoma repository - clientRelFile :: Path Rel File - clientRelFile = $(mkRelFile "apps/anoma_client/anoma_client") runCommand :: forall r. (Members AppEffects r) => NodeOptions -> Sem r () runCommand opts = runConcurrent . runProcess $ do - anomaDir :: Path Abs Dir <- fromAppPathDir (opts ^. nodeAnomaPath) - withCurrentDir anomaDir $ do - withSystemTempFile "start.exs" $ \fp tmpHandle -> - withSapwnAnomaNode fp tmpHandle $ \nodeOut nodeH -> do - grpcNode :: Int <- read . unpack <$> hGetLine nodeOut - putStrLn ("grpc_node = " <> prettyText grpcNode) - withAsync (echoHandle nodeOut) $ \_asyncH -> - withSpawnAnomaClient grpcNode $ \_clientH -> do - void (waitForProcess nodeH) + anomaDir :: AnomaPath <- AnomaPath <$> fromAppPathDir (opts ^. nodeAnomaPath) + runAnoma anomaDir $ do + void noHalt diff --git a/src/Anoma/Effect.hs b/src/Anoma/Effect.hs new file mode 100644 index 0000000000..81af36bb4b --- /dev/null +++ b/src/Anoma/Effect.hs @@ -0,0 +1,19 @@ +module Anoma.Effect + ( module Anoma.Effect, + module Anoma.Effect.Base, + ) +where + +import Anoma.Effect.Base +import Juvix.Compiler.Nockma.Language qualified as Nockma +import Juvix.Prelude + +data RunNockmaInput = RunNockmaInput + { _runNockmaProgram :: AnomaResult, + _runNockmaInput :: [Nockma.Term Natural] + } + +makeLenses ''RunNockmaInput + +runNockma :: (Members '[Anoma] r) => Nockma.Term Natural -> [Nockma.Term Natural] -> Sem r (Nockma.Term Natural) +runNockma prog inputs = undefined diff --git a/src/Anoma/Effect/Base.hs b/src/Anoma/Effect/Base.hs new file mode 100644 index 0000000000..156d082f6a --- /dev/null +++ b/src/Anoma/Effect/Base.hs @@ -0,0 +1,141 @@ +module Anoma.Effect.Base + ( Anoma, + noHalt, + anomaRpc, + AnomaPath (..), + anomaPath, + runAnoma, + module Juvix.Prelude.Aeson, + module Juvix.Compiler.Nockma.Translation.FromTree, + ) +where + +import Data.ByteString qualified as B +import Juvix.Compiler.Nockma.Translation.FromTree (AnomaResult) +import Juvix.Data.CodeAnn +import Juvix.Extra.Paths (anomaStartExs) +import Juvix.Prelude +import Juvix.Prelude.Aeson (Value, eitherDecodeStrict, encode) + +data Anoma :: Effect where + -- | Keep the node and client running + NoHalt :: Anoma m ExitCode + -- | Blocking rpc call + AnomaRpc :: Value -> Anoma m Value + +makeSem ''Anoma + +newtype AnomaPath = AnomaPath {_anomaPath :: Path Abs Dir} + +newtype GrpcPort = GrpcPort {_grpcPort :: Int} + +makeLenses ''AnomaPath +makeLenses ''GrpcPort + +listenPort :: Int +listenPort = 50051 + +withSpawnAnomaClient :: + (Members '[Process, Logger, EmbedIO, Reader AnomaPath, Reader GrpcPort] r) => + (ProcessHandle -> Sem r a) -> + Sem r a +withSpawnAnomaClient body = do + cprocess <- mkProcess + withCreateProcess cprocess $ \_stdin mstdout _stderr procHandle -> do + let out = fromJust mstdout + txt <- hGetLine out + case takeWhile (/= '.') (unpack txt) of + "Connected to node" -> do + logInfo "Anoma client successfully started" + logInfo (mkAnsiText ("Listening on port " <> annotate AnnImportant (pretty listenPort))) + body procHandle + _ -> error "Something went wrong when starting the anoma client" + where + mkProcess :: (Members '[Reader AnomaPath, Reader GrpcPort] r') => Sem r' CreateProcess + mkProcess = do + p <- asks (^. anomaPath) + grpcport <- asks (^. grpcPort) + return + ( proc + (toFilePath (p clientRelFile)) + [ "--listen-port", + show listenPort, + "--node-host", + "localhost", + "--node-port", + show grpcport + ] + ) + { std_out = CreatePipe + } + + -- Relative to the anoma repository + clientRelFile :: Path Rel File + clientRelFile = $(mkRelFile "apps/anoma_client/anoma_client") + +withSapwnAnomaNode :: + (Members '[EmbedIO, Logger, Process, Reader AnomaPath] r) => + (Int -> Handle -> ProcessHandle -> Sem r a) -> + Sem r a +withSapwnAnomaNode body = withSystemTempFile "start.exs" $ \fp tmpHandle -> do + liftIO (B.hPutStr tmpHandle anomaStartExs) + hFlush tmpHandle + curDir <- getCurrentDir + asks (^. anomaPath) >>= setCurrentDir + withCreateProcess (cprocess (toFilePath fp)) $ \_stdin mstdout _stderr procHandle -> do + setCurrentDir curDir + let nodeOut = fromJust mstdout + grpcNode :: Int <- either (error . pack) id . readEither . unpack <$> hGetLine nodeOut + logInfo "Anoma node successfully started" + body grpcNode (fromJust mstdout) procHandle + where + cprocess :: FilePath -> CreateProcess + cprocess exs = + (proc "mix" ["run", "--no-halt", exs]) + { std_out = CreatePipe + } + +anomaRpc' :: (Members '[Reader AnomaPath, Process, EmbedIO] r) => Value -> Sem r Value +anomaRpc' msg = do + cproc <- grpcCliProcess + withCreateProcess cproc $ \mstdin mstdout _stderr _procHandle -> do + let stdinH = fromJust mstdin + stdoutH = fromJust mstdout + inputbs = B.toStrict (encode msg) + liftIO (B.hPutStr stdinH inputbs) + hFlush stdinH + res <- eitherDecodeStrict <$> liftIO (B.hGetContents stdoutH) + case res of + Right r -> return r + Left err -> error (pack err) + +grpcCliProcess :: (Members '[Reader AnomaPath] r) => Sem r CreateProcess +grpcCliProcess = do + p <- asks (^. anomaPath) + return + ( proc + "grpc_cli" + [ "call", + "--json_input", + "--json_output", + "--protofiles", + toFilePath (p relProtoFile), + "localhost:" <> show listenPort, + "Anoma.Protobuf.Intents.Prove" + ] + ) + { std_in = CreatePipe, + std_out = CreatePipe + } + where + relProtoFile :: Path Rel File + relProtoFile = $(mkRelFile "apps/anoma_protobuf/priv/protobuf/anoma.proto") + +runAnoma :: forall r a. (Members '[Logger, EmbedIO] r) => AnomaPath -> Sem (Anoma ': r) a -> Sem r a +runAnoma anomapath body = runReader anomapath . runConcurrent . runProcess $ + withSapwnAnomaNode $ \grpcport _nodeOut nodeH -> + runReader (GrpcPort grpcport) $ + withSpawnAnomaClient $ \_clientH -> do + (`interpret` inject body) $ \case + NoHalt -> waitForProcess nodeH + AnomaRpc i -> anomaRpc' i diff --git a/src/Anoma/Rpc/Base.hs b/src/Anoma/Rpc/Base.hs new file mode 100644 index 0000000000..944ebd17c3 --- /dev/null +++ b/src/Anoma/Rpc/Base.hs @@ -0,0 +1,45 @@ +module Anoma.Rpc.Base where + +import Juvix.Prelude +import Juvix.Prelude.Aeson + +data NockInput + = NockInputText Text + | NockInputJammed Text + +$( deriveJSON + defaultOptions + { constructorTagModifier = \case + "NockInputText" -> "text" + "NockInputJammed" -> "jammed" + _ -> impossibleError "All constructors must be covered", + sumEncoding = ObjectWithSingleField + } + ''NockInput + ) + +data RunNock = RunNock + { _runNockJammedProgram :: Text, + _runNockPrivateInputs :: [NockInput], + _runNockPublicInputs :: [NockInput] + } + +$( deriveJSON + defaultOptions + { unwrapUnaryRecords = True, + fieldLabelModifier = \case + "_runNockJammedProgram" -> "jammed_program" + "_runNockPrivateInputs" -> "private_inputs" + "_runNockPublicInputs" -> "public_inputs" + _ -> impossibleError "All fields must be covered" + } + ''RunNock + ) + +example :: RunNock +example = + RunNock + { _runNockJammedProgram = "jamjam", + _runNockPrivateInputs = [NockInputText "input"], + _runNockPublicInputs = [NockInputJammed "public"] + } diff --git a/src/Juvix/Prelude/Aeson.hs b/src/Juvix/Prelude/Aeson.hs index d33959149a..26f1d8300e 100644 --- a/src/Juvix/Prelude/Aeson.hs +++ b/src/Juvix/Prelude/Aeson.hs @@ -1,12 +1,14 @@ module Juvix.Prelude.Aeson ( module Juvix.Prelude.Aeson, module Data.Aeson, + module Data.Aeson.TH, module Data.Aeson.Text, ) where import Data.Aeson import Data.Aeson.KeyMap qualified as KeyMap +import Data.Aeson.TH import Data.Aeson.Text import Data.ByteString.Lazy qualified as BS import Data.Text.Lazy qualified as Lazy @@ -17,10 +19,10 @@ readJSONFile f = do bs <- BS.readFile f return $ decode bs -encodeToText :: (ToJSON a) => a -> Text -encodeToText = Lazy.toStrict . encodeToLazyText +jsonEncodeToText :: (ToJSON a) => a -> Text +jsonEncodeToText = Lazy.toStrict . encodeToLazyText -appendFields :: [(Key, Value)] -> Value -> Value -appendFields keyValues = \case +jsonAppendFields :: [(Key, Value)] -> Value -> Value +jsonAppendFields keyValues = \case Object obj -> Object (KeyMap.fromList keyValues <> obj) a -> a diff --git a/src/Juvix/Prelude/Base/Foundation.hs b/src/Juvix/Prelude/Base/Foundation.hs index 25d5506d51..630dd41845 100644 --- a/src/Juvix/Prelude/Base/Foundation.hs +++ b/src/Juvix/Prelude/Base/Foundation.hs @@ -232,7 +232,7 @@ import System.IO hiding ) import System.IO qualified as IO import System.IO.Error -import Text.Read (readEither) +import Text.Read (Read, readEither) import Text.Read qualified as Text import Text.Show (Show) import Text.Show qualified as Show @@ -251,6 +251,9 @@ type SimpleFold s a = forall r. (Monoid r) => Getting r s a type SimpleGetter s a = forall r. Getting r s a +readJust :: (Read a) => String -> a +readJust = Text.read + traverseM :: (Monad m, Traversable m, Applicative f) => (a1 -> f (m a2)) -> From f6f1936acad2a79d60320a77104ea384cd6550b2 Mon Sep 17 00:00:00 2001 From: Jan Mas Rovira Date: Fri, 25 Oct 2024 21:09:14 +0200 Subject: [PATCH 04/16] Rpc --- package.yaml | 1 + src/Anoma/Effect.hs | 17 ++----- src/Anoma/Effect/RunNockma.hs | 60 +++++++++++++++++++++++ src/Anoma/Rpc/{Base.hs => RunNock.hs} | 17 ++++++- src/Juvix/Compiler/Nockma/Encoding/Cue.hs | 17 ++++++- src/Juvix/Compiler/Nockma/Encoding/Jam.hs | 6 ++- src/Juvix/Data/CodeAnn.hs | 3 ++ src/Juvix/Data/Error/GenericError.hs | 13 +++++ src/Juvix/Data/FiniteField/PrimeField.hs | 2 +- src/Juvix/Prelude/Effects/Base.hs | 2 +- 10 files changed, 118 insertions(+), 20 deletions(-) create mode 100644 src/Anoma/Effect/RunNockma.hs rename src/Anoma/Rpc/{Base.hs => RunNock.hs} (78%) diff --git a/package.yaml b/package.yaml index faeee7bcb3..cd61a2ac62 100644 --- a/package.yaml +++ b/package.yaml @@ -52,6 +52,7 @@ dependencies: - ansi-terminal == 1.1.* - base == 4.19.* - base16-bytestring == 1.0.* + - base64-bytestring == 1.2.* - bitvec == 1.1.* - blaze-html == 0.9.* - bytestring == 0.12.* diff --git a/src/Anoma/Effect.hs b/src/Anoma/Effect.hs index 81af36bb4b..4720d4da49 100644 --- a/src/Anoma/Effect.hs +++ b/src/Anoma/Effect.hs @@ -1,19 +1,8 @@ module Anoma.Effect - ( module Anoma.Effect, - module Anoma.Effect.Base, + ( module Anoma.Effect.Base, + module Anoma.Effect.RunNockma, ) where import Anoma.Effect.Base -import Juvix.Compiler.Nockma.Language qualified as Nockma -import Juvix.Prelude - -data RunNockmaInput = RunNockmaInput - { _runNockmaProgram :: AnomaResult, - _runNockmaInput :: [Nockma.Term Natural] - } - -makeLenses ''RunNockmaInput - -runNockma :: (Members '[Anoma] r) => Nockma.Term Natural -> [Nockma.Term Natural] -> Sem r (Nockma.Term Natural) -runNockma prog inputs = undefined +import Anoma.Effect.RunNockma diff --git a/src/Anoma/Effect/RunNockma.hs b/src/Anoma/Effect/RunNockma.hs new file mode 100644 index 0000000000..040664eccb --- /dev/null +++ b/src/Anoma/Effect/RunNockma.hs @@ -0,0 +1,60 @@ +module Anoma.Effect.RunNockma + ( module Anoma.Effect.RunNockma, + module Anoma.Rpc.RunNock, + ) +where + +import Anoma.Effect.Base +import Anoma.Rpc.RunNock (RunNock (_runNockJammedProgram)) +import Anoma.Rpc.RunNock qualified as Rpc +import Data.ByteString.Base64 qualified as Base64 +import Juvix.Compiler.Nockma.Encoding.Cue (DecodingError, cueFromByteString'') +import Juvix.Compiler.Nockma.Encoding.Jam (jamToByteString) +import Juvix.Compiler.Nockma.Language (NockNaturalNaturalError) +import Juvix.Compiler.Nockma.Language qualified as Nockma +import Juvix.Data.CodeAnn (simpleErrorCodeAnn) +import Juvix.Prelude +import Juvix.Prelude.Aeson qualified as Aeson +import Juvix.Prelude.Pretty + +data RunNockmaInput = RunNockmaInput + { _runNockmaProgram :: AnomaResult, + _runNockmaInput :: [Nockma.Term Natural] + } + +makeLenses ''RunNockmaInput + +decodeJam64 :: (Members '[Error SimpleError] r) => Text -> Sem r (Nockma.Term Natural) +decodeJam64 encoded = + case Base64.decode (encodeUtf8 encoded) of + Left err -> throw (SimpleError (mkAnsiText err)) + Right bs' -> + case cueFromByteString'' bs' of + Left (err :: NockNaturalNaturalError) -> throw (simpleErrorCodeAnn err) + Right (Left (err :: DecodingError)) -> throw (simpleErrorCodeAnn err) + Right (Right r) -> return r + +encodeJam64 :: Nockma.Term Natural -> Text +encodeJam64 = decodeUtf8 . Base64.encode . jamToByteString + +fromJSON :: (Members '[Error SimpleError] 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 :: + (Members '[Anoma, Error SimpleError] r) => + Nockma.Term Natural -> + [Nockma.Term Natural] -> + Sem r (Nockma.Term Natural) +runNockma prog inputs = do + let prog' = encodeJam64 prog + args = map (Rpc.NockInputJammed . encodeJam64) inputs + msg = + Rpc.RunNock + { _runNockJammedProgram = prog', + _runNockPrivateInputs = args, + _runNockPublicInputs = [] + } + res :: Rpc.Response <- anomaRpc (Aeson.toJSON msg) >>= fromJSON + decodeJam64 (res ^. Rpc.proof) diff --git a/src/Anoma/Rpc/Base.hs b/src/Anoma/Rpc/RunNock.hs similarity index 78% rename from src/Anoma/Rpc/Base.hs rename to src/Anoma/Rpc/RunNock.hs index 944ebd17c3..7d5923ec2b 100644 --- a/src/Anoma/Rpc/Base.hs +++ b/src/Anoma/Rpc/RunNock.hs @@ -1,4 +1,4 @@ -module Anoma.Rpc.Base where +module Anoma.Rpc.RunNock where import Juvix.Prelude import Juvix.Prelude.Aeson @@ -36,6 +36,21 @@ $( deriveJSON ''RunNock ) +newtype Response = Response + { _proof :: Text + } + +$( deriveJSON + defaultOptions + { fieldLabelModifier = \case + "_proof" -> "proof" + _ -> impossibleError "All fields must be covered" + } + ''Response + ) + +makeLenses ''Response + example :: RunNock example = RunNock diff --git a/src/Juvix/Compiler/Nockma/Encoding/Cue.hs b/src/Juvix/Compiler/Nockma/Encoding/Cue.hs index 1d92d82ce4..8faad322d2 100644 --- a/src/Juvix/Compiler/Nockma/Encoding/Cue.hs +++ b/src/Juvix/Compiler/Nockma/Encoding/Cue.hs @@ -69,7 +69,7 @@ registerElementStart sem = do -- | Convert a BitReadError to a DecodingError handleBitError :: (Member (Error DecodingError) r) => DecodingError -> Sem (Error BitReadError ': r) x -> Sem r x -handleBitError e = mapError @_ @_ @BitReadError (const e) +handleBitError e = mapError @BitReadError (const e) -- | Consume the encoded length from the input bits consumeLength' :: forall r. (Members '[BitReader, Error DecodingError] r) => Sem r Int @@ -174,6 +174,19 @@ cueFromBits :: Sem r (Term a) cueFromBits v = evalBitReader v (evalState (initCueState @a) (runReader initCueEnv cueFromBitsSem)) +cueFromByteStringNatural :: + forall r. + ( Members + '[ Error DecodingError, + Error NockNaturalNaturalError, + Error (ErrNockNatural' Natural) + ] + r + ) => + ByteString -> + Sem r (Term Natural) +cueFromByteStringNatural = cueFromByteString' + cueFromByteString' :: forall a r. ( NockNatural a, @@ -324,7 +337,7 @@ When handling an error with `runError` before `a` is resolved, the compiler cannot distinguish between `Error (ErrNockNatural a)` and `Error DecodingError`. For some `a` it's possible that `ErrNockNatural a` is equal to `DecodingError`. -} -newtype ErrNockNatural' a = ErrNockNatural' (ErrNockNatural a) +newtype ErrNockNatural' a = ErrNockNatural' {_unErrNocknatural' :: ErrNockNatural a} fromNatural' :: forall a r. (NockNatural a, Member (Error (ErrNockNatural' a)) r) => Natural -> Sem r a fromNatural' = mapError (ErrNockNatural' @a) . fromNatural diff --git a/src/Juvix/Compiler/Nockma/Encoding/Jam.hs b/src/Juvix/Compiler/Nockma/Encoding/Jam.hs index 0a7facaf6e..74ec69c11e 100644 --- a/src/Juvix/Compiler/Nockma/Encoding/Jam.hs +++ b/src/Juvix/Compiler/Nockma/Encoding/Jam.hs @@ -100,7 +100,11 @@ jamToByteString :: forall a. (Integral a, Hashable a) => Term a -> ByteString jamToByteString = vectorBitsToByteString . jamToBits -- | jam encode a Nock term to an atom -jam :: forall a r. (Integral a, Hashable a, NockNatural a, Member (Error (ErrNockNatural a)) r) => Term a -> Sem r (Atom a) +jam :: + forall a r. + (Integral a, Hashable a, NockNatural a, Member (Error (ErrNockNatural a)) r) => + Term a -> + Sem r (Atom a) jam t = do let i = fromInteger . vectorBitsToInteger . jamToBits $ t ai <- fromNatural i diff --git a/src/Juvix/Data/CodeAnn.hs b/src/Juvix/Data/CodeAnn.hs index c2256fe336..eda39034f6 100644 --- a/src/Juvix/Data/CodeAnn.hs +++ b/src/Juvix/Data/CodeAnn.hs @@ -66,6 +66,9 @@ instance HasAnsiBackend (Doc CodeAnn) where toAnsiDoc = fmap stylize toAnsiStream = fmap stylize . layoutPretty defaultLayoutOptions +simpleErrorCodeAnn :: (PrettyCodeAnn msg) => msg -> SimpleError +simpleErrorCodeAnn = SimpleError . mkAnsiText . ppCodeAnn + kwTypeAnn :: KeywordType -> CodeAnn kwTypeAnn = \case KeywordTypeDelimiter -> AnnDelimiter diff --git a/src/Juvix/Data/Error/GenericError.hs b/src/Juvix/Data/Error/GenericError.hs index 2b27218dd3..7dac8376e9 100644 --- a/src/Juvix/Data/Error/GenericError.hs +++ b/src/Juvix/Data/Error/GenericError.hs @@ -20,8 +20,13 @@ newtype GenericOptions = GenericOptions } deriving stock (Eq, Show) +newtype SimpleError = SimpleError + { _simpleErrorMessage :: AnsiText + } + makeLenses ''GenericError makeLenses ''GenericOptions +makeLenses ''SimpleError defaultGenericOptions :: GenericOptions defaultGenericOptions = @@ -36,6 +41,14 @@ instance Pretty GenericError where instance HasLoc GenericError where getLoc = (^. genericErrorLoc) +instance HasAnsiBackend SimpleError where + toAnsiDoc (SimpleError msg) = toAnsiDoc msg + toAnsiStream (SimpleError msg) = toAnsiStream msg + +instance HasTextBackend SimpleError where + toTextStream (SimpleError msg) = toTextStream msg + toTextDoc (SimpleError msg) = toTextDoc msg + genericErrorHeader :: GenericError -> Doc a genericErrorHeader g = pretty (g ^. genericErrorLoc) diff --git a/src/Juvix/Data/FiniteField/PrimeField.hs b/src/Juvix/Data/FiniteField/PrimeField.hs index ee8cf6bb91..b22f34e32b 100644 --- a/src/Juvix/Data/FiniteField/PrimeField.hs +++ b/src/Juvix/Data/FiniteField/PrimeField.hs @@ -33,7 +33,7 @@ import GHC.TypeLits.Singletons () import Juvix.Data.FiniteField.Base import Juvix.Prelude.Base.Foundation hiding (toInteger) import Language.Haskell.TH qualified as TH -import Prelude (Read, readsPrec, showsPrec) +import Prelude (readsPrec, showsPrec) -- | Finite field of prime order p, Fp = Z/pZ. -- diff --git a/src/Juvix/Prelude/Effects/Base.hs b/src/Juvix/Prelude/Effects/Base.hs index 827c815342..5fc441e399 100644 --- a/src/Juvix/Prelude/Effects/Base.hs +++ b/src/Juvix/Prelude/Effects/Base.hs @@ -111,7 +111,7 @@ modifyShared = Shared.modify modify' :: (Member (State s) r) => (s -> s) -> Sem r () modify' = State.modify -mapError :: (Member (Error b) r) => (a -> b) -> Sem (Error a ': r) x -> Sem r x +mapError :: forall a b r x. (Member (Error b) r) => (a -> b) -> Sem (Error a ': r) x -> Sem r x mapError f = runErrorWith (throwError . f) runM :: (MonadIO m) => Sem '[EmbedIO] a -> m a From 7e3263935ba4e77906ba46e366e0a1a48e46c556 Mon Sep 17 00:00:00 2001 From: Jan Mas Rovira Date: Mon, 28 Oct 2024 13:17:34 +0100 Subject: [PATCH 05/16] nockma run in anoma --- app/App.hs | 3 ++ app/Commands/Dev/Anoma/Node/Options.hs | 19 ++---------- app/Commands/Dev/Nockma/Run.hs | 41 ++++++++++++++++++-------- app/Commands/Dev/Nockma/Run/Options.hs | 8 +++++ app/CommonOptions.hs | 19 ++++++++++++ src/Juvix/Compiler/Nockma/Language.hs | 12 ++++++++ 6 files changed, 72 insertions(+), 30 deletions(-) diff --git a/app/App.hs b/app/App.hs index 0f61308be5..2bf3965352 100644 --- a/app/App.hs +++ b/app/App.hs @@ -321,5 +321,8 @@ instance AppError Text where instance AppError JuvixError where appError = exitJuvixError +instance AppError SimpleError where + appError = exitFailMsg . toPlainText + class AppError e where appError :: (Members '[App] r) => e -> Sem r a diff --git a/app/Commands/Dev/Anoma/Node/Options.hs b/app/Commands/Dev/Anoma/Node/Options.hs index 1e30ced44f..1886e30066 100644 --- a/app/Commands/Dev/Anoma/Node/Options.hs +++ b/app/Commands/Dev/Anoma/Node/Options.hs @@ -11,20 +11,5 @@ makeLenses ''NodeOptions parseNodeOptions :: Parser NodeOptions parseNodeOptions = do - path <- - option - somePreDirOpt - ( long "anoma-dir" - <> metavar "ANOMA_DIR" - <> help "Path to anoma repository" - <> action "directory" - ) - pure - NodeOptions - { _nodeAnomaPath = - AppPath - { _pathIsInput = False, - _pathPath = path - }, - .. - } + _nodeAnomaPath <- anomaDirOpt + pure NodeOptions {..} diff --git a/app/Commands/Dev/Nockma/Run.hs b/app/Commands/Dev/Nockma/Run.hs index 7350f3f376..e80ceea522 100644 --- a/app/Commands/Dev/Nockma/Run.hs +++ b/app/Commands/Dev/Nockma/Run.hs @@ -1,5 +1,6 @@ module Commands.Dev.Nockma.Run where +import Anoma.Effect import Commands.Base hiding (Atom) import Commands.Dev.Nockma.Run.Options import Juvix.Compiler.Nockma.Anoma @@ -13,22 +14,36 @@ runCommand opts = do afile <- fromAppPathFile inputFile argsFile <- mapM fromAppPathFile (opts ^. nockmaRunArgs) parsedArgs <- runAppError @JuvixError (mapM Nockma.cueJammedFileOrPretty argsFile) - parsedTerm <- checkCued (Nockma.cueJammedFileOrPretty afile) + parsedTerm <- runAppError @JuvixError (Nockma.cueJammedFileOrPretty afile) case parsedTerm of - t@(TermCell {}) -> do - let formula = anomaCallTuple parsedArgs - (counts, res) <- - runOpCounts - . runReader defaultEvalOptions - . runOutputSem @(Term Natural) (logInfo . mkAnsiText . ppTrace) - $ evalCompiledNock' t formula - putStrLn (ppPrint res) - let statsFile = replaceExtension' ".profile" afile - writeFileEnsureLn statsFile (prettyText counts) TermAtom {} -> exitFailMsg "Expected nockma input to be a cell" + t@(TermCell {}) + | opts ^. nockmaRunAnoma -> do + anomaDir <- getAnomaPath + runInAnoma anomaDir t (unfoldTuple parsedArgs) + | otherwise -> do + let formula = anomaCallTuple parsedArgs + (counts, res) <- + runOpCounts + . runReader defaultEvalOptions + . runOutputSem @(Term Natural) (logInfo . mkAnsiText . ppTrace) + $ evalCompiledNock' t formula + putStrLn (ppPrint res) + let statsFile = replaceExtension' ".profile" afile + writeFileEnsureLn statsFile (prettyText counts) where + getAnomaPath :: Sem r AnomaPath + getAnomaPath = do + apppath <- maybe err return (opts ^. nockmaRunAnomaDir) + AnomaPath <$> fromAppPathDir apppath + where + err :: Sem r x + err = exitFailMsg ("The --" <> anomaDirOptLongStr <> " must be provided") + inputFile :: AppPath File inputFile = opts ^. nockmaRunFile - checkCued :: Sem (Error JuvixError ': r) a -> Sem r a - checkCued = runErrorNoCallStackWith exitJuvixError +runInAnoma :: (Members AppEffects r) => AnomaPath -> Term Natural -> [Term Natural] -> Sem r () +runInAnoma anoma t args = runAnoma anoma $ do + res <- runAppError @SimpleError (runNockma t args) + putStrLn (ppPrint res) diff --git a/app/Commands/Dev/Nockma/Run/Options.hs b/app/Commands/Dev/Nockma/Run/Options.hs index 2133bedb87..cf2fd7e2cc 100644 --- a/app/Commands/Dev/Nockma/Run/Options.hs +++ b/app/Commands/Dev/Nockma/Run/Options.hs @@ -4,7 +4,9 @@ import CommonOptions data NockmaRunOptions = NockmaRunOptions { _nockmaRunFile :: AppPath File, + _nockmaRunAnomaDir :: Maybe (AppPath Dir), _nockmaRunProfile :: Bool, + _nockmaRunAnoma :: Bool, _nockmaRunArgs :: Maybe (AppPath File) } deriving stock (Data) @@ -24,6 +26,12 @@ parseNockmaRunOptions = do <> action "file" ) pure AppPath {_pathIsInput = True, ..} + _nockmaRunAnoma <- + switch + ( long "anoma" + <> help ("Run in Anoma node (makes --" <> anomaDirOptLongStr <> " mandatory)") + ) + _nockmaRunAnomaDir <- optional anomaDirOpt _nockmaRunProfile <- switch ( long "profile" diff --git a/app/CommonOptions.hs b/app/CommonOptions.hs index d39484248a..7a5a225d2e 100644 --- a/app/CommonOptions.hs +++ b/app/CommonOptions.hs @@ -76,6 +76,25 @@ parseInputFile = parseInputFiles . NonEmpty.singleton numThreadsOpt :: ReadM NumThreads numThreadsOpt = eitherReader readNumThreads +anomaDirOptLongStr :: forall str. (IsString str) => str +anomaDirOptLongStr = "anoma-dir" + +anomaDirOpt :: Parser (AppPath Dir) +anomaDirOpt = do + path <- + option + somePreDirOpt + ( long anomaDirOptLongStr + <> metavar "ANOMA_DIR" + <> help "Path to anoma repository" + <> action "directory" + ) + return + AppPath + { _pathIsInput = False, + _pathPath = path + } + parseNumThreads :: Parser NumThreads parseNumThreads = do option diff --git a/src/Juvix/Compiler/Nockma/Language.hs b/src/Juvix/Compiler/Nockma/Language.hs index 207ea33cca..024e35efc2 100644 --- a/src/Juvix/Compiler/Nockma/Language.hs +++ b/src/Juvix/Compiler/Nockma/Language.hs @@ -560,3 +560,15 @@ instance (NockmaEq a) => NockmaEq (Term a) where instance (NockmaEq a) => NockmaEq (Cell a) where nockmaEq (Cell l r) (Cell l' r') = nockmaEq l l' && nockmaEq r r' + +unfoldTuple :: Maybe (Term Natural) -> [Term Natural] +unfoldTuple = maybe [] (toList . unfoldTuple1) + +unfoldTuple1 :: Term Natural -> NonEmpty (Term Natural) +unfoldTuple1 = nonEmpty' . run . execOutputList . go + where + go :: (Members '[Output (Term Natural)] r) => Term Natural -> Sem r () + go t = + case t of + TermAtom {} -> output t + TermCell (Cell l r) -> output l >> go r From 4e44306b60c4c131291201c809d88cb8617e7baf Mon Sep 17 00:00:00 2001 From: Jan Mas Rovira Date: Mon, 28 Oct 2024 13:24:54 +0100 Subject: [PATCH 06/16] refactor --- src/Anoma/Effect/Base.hs | 13 +++++++++---- 1 file changed, 9 insertions(+), 4 deletions(-) diff --git a/src/Anoma/Effect/Base.hs b/src/Anoma/Effect/Base.hs index 156d082f6a..01a6cc6e7b 100644 --- a/src/Anoma/Effect/Base.hs +++ b/src/Anoma/Effect/Base.hs @@ -35,6 +35,11 @@ makeLenses ''GrpcPort listenPort :: Int listenPort = 50051 +relativeToAnomaDir :: (Members '[Reader AnomaPath] r) => Path Rel x -> Sem r (Path Abs x) +relativeToAnomaDir p = do + anoma <- asks (^. anomaPath) + return (anoma p) + withSpawnAnomaClient :: (Members '[Process, Logger, EmbedIO, Reader AnomaPath, Reader GrpcPort] r) => (ProcessHandle -> Sem r a) -> @@ -53,11 +58,11 @@ withSpawnAnomaClient body = do where mkProcess :: (Members '[Reader AnomaPath, Reader GrpcPort] r') => Sem r' CreateProcess mkProcess = do - p <- asks (^. anomaPath) grpcport <- asks (^. grpcPort) + anomaClient <- relativeToAnomaDir clientRelFile return ( proc - (toFilePath (p clientRelFile)) + (toFilePath anomaClient) [ "--listen-port", show listenPort, "--node-host", @@ -111,7 +116,7 @@ anomaRpc' msg = do grpcCliProcess :: (Members '[Reader AnomaPath] r) => Sem r CreateProcess grpcCliProcess = do - p <- asks (^. anomaPath) + protoFile <- relativeToAnomaDir relProtoFile return ( proc "grpc_cli" @@ -119,7 +124,7 @@ grpcCliProcess = do "--json_input", "--json_output", "--protofiles", - toFilePath (p relProtoFile), + toFilePath protoFile, "localhost:" <> show listenPort, "Anoma.Protobuf.Intents.Prove" ] From 4e4876c0ba6c9357fc4fe9899aab889a986aae0d Mon Sep 17 00:00:00 2001 From: Jan Mas Rovira Date: Mon, 28 Oct 2024 15:55:52 +0100 Subject: [PATCH 07/16] proto_path --- app/Commands/Dev/Nockma/Options.hs | 2 +- app/Commands/Dev/Nockma/Run.hs | 36 ++++++++++---------------- app/Commands/Dev/Nockma/Run/Options.hs | 6 ----- src/Anoma/Effect/Base.hs | 15 +++++++---- src/Anoma/Effect/RunNockma.hs | 3 ++- src/Anoma/Rpc/RunNock.hs | 8 ------ src/Juvix/Prelude/Trace.hs | 4 +-- 7 files changed, 29 insertions(+), 45 deletions(-) diff --git a/app/Commands/Dev/Nockma/Options.hs b/app/Commands/Dev/Nockma/Options.hs index 4b4f87431d..9937351e45 100644 --- a/app/Commands/Dev/Nockma/Options.hs +++ b/app/Commands/Dev/Nockma/Options.hs @@ -30,7 +30,7 @@ parseNockmaCommand = runInfo = info (NockmaRun <$> parseNockmaRunOptions) - (progDesc "Run an Anoma program. It should be used with artefacts obtained from compilation with the anoma target.") + (progDesc ("Run an Anoma program. It should be used with artefacts obtained from compilation with the anoma target. If the --" <> anomaDirOptLongStr <> " is given, then it runs the code in an anoma node")) commandFromAsm :: Mod CommandFields NockmaCommand commandFromAsm = command "eval" fromAsmInfo diff --git a/app/Commands/Dev/Nockma/Run.hs b/app/Commands/Dev/Nockma/Run.hs index e80ceea522..c6ceb2fc93 100644 --- a/app/Commands/Dev/Nockma/Run.hs +++ b/app/Commands/Dev/Nockma/Run.hs @@ -17,29 +17,21 @@ runCommand opts = do parsedTerm <- runAppError @JuvixError (Nockma.cueJammedFileOrPretty afile) case parsedTerm of TermAtom {} -> exitFailMsg "Expected nockma input to be a cell" - t@(TermCell {}) - | opts ^. nockmaRunAnoma -> do - anomaDir <- getAnomaPath - runInAnoma anomaDir t (unfoldTuple parsedArgs) - | otherwise -> do - let formula = anomaCallTuple parsedArgs - (counts, res) <- - runOpCounts - . runReader defaultEvalOptions - . runOutputSem @(Term Natural) (logInfo . mkAnsiText . ppTrace) - $ evalCompiledNock' t formula - putStrLn (ppPrint res) - let statsFile = replaceExtension' ".profile" afile - writeFileEnsureLn statsFile (prettyText counts) + t@(TermCell {}) -> case opts ^. nockmaRunAnomaDir of + Just path -> do + anomaDir <- AnomaPath <$> fromAppPathDir path + runInAnoma anomaDir t (unfoldTuple parsedArgs) + Nothing -> do + let formula = anomaCallTuple parsedArgs + (counts, res) <- + runOpCounts + . runReader defaultEvalOptions + . runOutputSem @(Term Natural) (logInfo . mkAnsiText . ppTrace) + $ evalCompiledNock' t formula + putStrLn (ppPrint res) + let statsFile = replaceExtension' ".profile" afile + writeFileEnsureLn statsFile (prettyText counts) where - getAnomaPath :: Sem r AnomaPath - getAnomaPath = do - apppath <- maybe err return (opts ^. nockmaRunAnomaDir) - AnomaPath <$> fromAppPathDir apppath - where - err :: Sem r x - err = exitFailMsg ("The --" <> anomaDirOptLongStr <> " must be provided") - inputFile :: AppPath File inputFile = opts ^. nockmaRunFile diff --git a/app/Commands/Dev/Nockma/Run/Options.hs b/app/Commands/Dev/Nockma/Run/Options.hs index cf2fd7e2cc..f3236e11e8 100644 --- a/app/Commands/Dev/Nockma/Run/Options.hs +++ b/app/Commands/Dev/Nockma/Run/Options.hs @@ -6,7 +6,6 @@ data NockmaRunOptions = NockmaRunOptions { _nockmaRunFile :: AppPath File, _nockmaRunAnomaDir :: Maybe (AppPath Dir), _nockmaRunProfile :: Bool, - _nockmaRunAnoma :: Bool, _nockmaRunArgs :: Maybe (AppPath File) } deriving stock (Data) @@ -26,11 +25,6 @@ parseNockmaRunOptions = do <> action "file" ) pure AppPath {_pathIsInput = True, ..} - _nockmaRunAnoma <- - switch - ( long "anoma" - <> help ("Run in Anoma node (makes --" <> anomaDirOptLongStr <> " mandatory)") - ) _nockmaRunAnomaDir <- optional anomaDirOpt _nockmaRunProfile <- switch diff --git a/src/Anoma/Effect/Base.hs b/src/Anoma/Effect/Base.hs index 01a6cc6e7b..e0af2ea3ad 100644 --- a/src/Anoma/Effect/Base.hs +++ b/src/Anoma/Effect/Base.hs @@ -84,7 +84,7 @@ withSapwnAnomaNode :: Sem r a withSapwnAnomaNode body = withSystemTempFile "start.exs" $ \fp tmpHandle -> do liftIO (B.hPutStr tmpHandle anomaStartExs) - hFlush tmpHandle + hClose tmpHandle curDir <- getCurrentDir asks (^. anomaPath) >>= setCurrentDir withCreateProcess (cprocess (toFilePath fp)) $ \_stdin mstdout _stderr procHandle -> do @@ -108,7 +108,7 @@ anomaRpc' msg = do stdoutH = fromJust mstdout inputbs = B.toStrict (encode msg) liftIO (B.hPutStr stdinH inputbs) - hFlush stdinH + hClose stdinH res <- eitherDecodeStrict <$> liftIO (B.hGetContents stdoutH) case res of Right r -> return r @@ -116,15 +116,17 @@ anomaRpc' msg = do grpcCliProcess :: (Members '[Reader AnomaPath] r) => Sem r CreateProcess grpcCliProcess = do - protoFile <- relativeToAnomaDir relProtoFile + paths <- relativeToAnomaDir relProtoDir return ( proc "grpc_cli" [ "call", "--json_input", "--json_output", + "--proto_path", + toFilePath paths, "--protofiles", - toFilePath protoFile, + toFilePath relProtoFile, "localhost:" <> show listenPort, "Anoma.Protobuf.Intents.Prove" ] @@ -133,8 +135,11 @@ grpcCliProcess = do std_out = CreatePipe } where + relProtoDir :: Path Rel Dir + relProtoDir = $(mkRelDir "apps/anoma_protobuf/priv/protobuf") + relProtoFile :: Path Rel File - relProtoFile = $(mkRelFile "apps/anoma_protobuf/priv/protobuf/anoma.proto") + relProtoFile = $(mkRelFile "anoma.proto") runAnoma :: forall r a. (Members '[Logger, EmbedIO] r) => AnomaPath -> Sem (Anoma ': r) a -> Sem r a runAnoma anomapath body = runReader anomapath . runConcurrent . runProcess $ diff --git a/src/Anoma/Effect/RunNockma.hs b/src/Anoma/Effect/RunNockma.hs index 040664eccb..8219b00513 100644 --- a/src/Anoma/Effect/RunNockma.hs +++ b/src/Anoma/Effect/RunNockma.hs @@ -56,5 +56,6 @@ runNockma prog inputs = do _runNockPrivateInputs = args, _runNockPublicInputs = [] } - res :: Rpc.Response <- anomaRpc (Aeson.toJSON msg) >>= fromJSON + let json = Aeson.toJSON msg + res :: Rpc.Response <- anomaRpc json >>= fromJSON decodeJam64 (res ^. Rpc.proof) diff --git a/src/Anoma/Rpc/RunNock.hs b/src/Anoma/Rpc/RunNock.hs index 7d5923ec2b..5baa4c3657 100644 --- a/src/Anoma/Rpc/RunNock.hs +++ b/src/Anoma/Rpc/RunNock.hs @@ -50,11 +50,3 @@ $( deriveJSON ) makeLenses ''Response - -example :: RunNock -example = - RunNock - { _runNockJammedProgram = "jamjam", - _runNockPrivateInputs = [NockInputText "input"], - _runNockPublicInputs = [NockInputJammed "public"] - } diff --git a/src/Juvix/Prelude/Trace.hs b/src/Juvix/Prelude/Trace.hs index c926ba1aa0..5643a45ed4 100644 --- a/src/Juvix/Prelude/Trace.hs +++ b/src/Juvix/Prelude/Trace.hs @@ -46,6 +46,6 @@ traceToFile fpath t a = return a {-# WARNING traceToFile "Using traceToFile" #-} -traceToFileM :: (Applicative m) => Path Abs File -> Text -> a -> m () -traceToFileM fpath t a = pure (traceToFile fpath t a) $> () +traceToFileM :: (Applicative m) => Path Abs File -> Text -> m () +traceToFileM fpath t = pure (traceToFile fpath t ()) $> () {-# WARNING traceToFileM "Using traceFileM" #-} From c81bc5a6deb1717ef2bdc31552c1de5c36bb7ac5 Mon Sep 17 00:00:00 2001 From: Jan Mas Rovira Date: Mon, 28 Oct 2024 17:51:45 +0100 Subject: [PATCH 08/16] refactor --- app/Commands/Dev/Anoma/Node.hs | 11 ++++++---- app/Commands/Dev/Nockma/Run.hs | 4 ++-- src/Anoma/Effect/Base.hs | 40 ++++++++++++++-------------------- src/Anoma/Effect/Paths.hs | 12 ++++++++++ src/Anoma/Effect/RunNockma.hs | 12 +++++----- src/Anoma/Rpc/Base.hs | 6 +++++ src/Anoma/Rpc/GrpcMethodUrl.hs | 23 +++++++++++++++++++ src/Anoma/Rpc/RunNock.hs | 6 +++++ 8 files changed, 78 insertions(+), 36 deletions(-) create mode 100644 src/Anoma/Effect/Paths.hs create mode 100644 src/Anoma/Rpc/Base.hs create mode 100644 src/Anoma/Rpc/GrpcMethodUrl.hs diff --git a/app/Commands/Dev/Anoma/Node.hs b/app/Commands/Dev/Anoma/Node.hs index c6f95ff4f8..f885c82967 100644 --- a/app/Commands/Dev/Anoma/Node.hs +++ b/app/Commands/Dev/Anoma/Node.hs @@ -5,7 +5,10 @@ import Commands.Base import Commands.Dev.Anoma.Node.Options runCommand :: forall r. (Members AppEffects r) => NodeOptions -> Sem r () -runCommand opts = runConcurrent . runProcess $ do - anomaDir :: AnomaPath <- AnomaPath <$> fromAppPathDir (opts ^. nodeAnomaPath) - runAnoma anomaDir $ do - void noHalt +runCommand opts = runAppError @SimpleError + . runConcurrent + . runProcess + $ do + anomaDir :: AnomaPath <- AnomaPath <$> fromAppPathDir (opts ^. nodeAnomaPath) + runAnoma anomaDir $ do + void noHalt diff --git a/app/Commands/Dev/Nockma/Run.hs b/app/Commands/Dev/Nockma/Run.hs index c6ceb2fc93..50f90c369b 100644 --- a/app/Commands/Dev/Nockma/Run.hs +++ b/app/Commands/Dev/Nockma/Run.hs @@ -36,6 +36,6 @@ runCommand opts = do inputFile = opts ^. nockmaRunFile runInAnoma :: (Members AppEffects r) => AnomaPath -> Term Natural -> [Term Natural] -> Sem r () -runInAnoma anoma t args = runAnoma anoma $ do - res <- runAppError @SimpleError (runNockma t args) +runInAnoma anoma t args = runAppError @SimpleError . runAnoma anoma $ do + res <- runNockma t args putStrLn (ppPrint res) diff --git a/src/Anoma/Effect/Base.hs b/src/Anoma/Effect/Base.hs index e0af2ea3ad..853958b1eb 100644 --- a/src/Anoma/Effect/Base.hs +++ b/src/Anoma/Effect/Base.hs @@ -5,11 +5,13 @@ module Anoma.Effect.Base AnomaPath (..), anomaPath, runAnoma, - module Juvix.Prelude.Aeson, + module Anoma.Rpc.Base, module Juvix.Compiler.Nockma.Translation.FromTree, ) where +import Anoma.Effect.Paths +import Anoma.Rpc.Base import Data.ByteString qualified as B import Juvix.Compiler.Nockma.Translation.FromTree (AnomaResult) import Juvix.Data.CodeAnn @@ -21,7 +23,7 @@ data Anoma :: Effect where -- | Keep the node and client running NoHalt :: Anoma m ExitCode -- | Blocking rpc call - AnomaRpc :: Value -> Anoma m Value + AnomaRpc :: GrpcMethodUrl -> Value -> Anoma m Value makeSem ''Anoma @@ -41,7 +43,7 @@ relativeToAnomaDir p = do return (anoma p) withSpawnAnomaClient :: - (Members '[Process, Logger, EmbedIO, Reader AnomaPath, Reader GrpcPort] r) => + (Members '[Process, Logger, EmbedIO, Reader AnomaPath, Reader GrpcPort, Error SimpleError] r) => (ProcessHandle -> Sem r a) -> Sem r a withSpawnAnomaClient body = do @@ -54,7 +56,7 @@ withSpawnAnomaClient body = do logInfo "Anoma client successfully started" logInfo (mkAnsiText ("Listening on port " <> annotate AnnImportant (pretty listenPort))) body procHandle - _ -> error "Something went wrong when starting the anoma client" + _ -> throw (SimpleError (mkAnsiText @Text "Something went wrong when starting the anoma client")) where mkProcess :: (Members '[Reader AnomaPath, Reader GrpcPort] r') => Sem r' CreateProcess mkProcess = do @@ -74,10 +76,6 @@ withSpawnAnomaClient body = do { std_out = CreatePipe } - -- Relative to the anoma repository - clientRelFile :: Path Rel File - clientRelFile = $(mkRelFile "apps/anoma_client/anoma_client") - withSapwnAnomaNode :: (Members '[EmbedIO, Logger, Process, Reader AnomaPath] r) => (Int -> Handle -> ProcessHandle -> Sem r a) -> @@ -100,22 +98,22 @@ withSapwnAnomaNode body = withSystemTempFile "start.exs" $ \fp tmpHandle -> do { std_out = CreatePipe } -anomaRpc' :: (Members '[Reader AnomaPath, Process, EmbedIO] r) => Value -> Sem r Value -anomaRpc' msg = do - cproc <- grpcCliProcess +anomaRpc' :: (Members '[Reader AnomaPath, Process, EmbedIO, Error SimpleError] r) => GrpcMethodUrl -> Value -> Sem r Value +anomaRpc' method payload = do + cproc <- grpcCliProcess method withCreateProcess cproc $ \mstdin mstdout _stderr _procHandle -> do let stdinH = fromJust mstdin stdoutH = fromJust mstdout - inputbs = B.toStrict (encode msg) + inputbs = B.toStrict (encode payload) liftIO (B.hPutStr stdinH inputbs) hClose stdinH res <- eitherDecodeStrict <$> liftIO (B.hGetContents stdoutH) case res of Right r -> return r - Left err -> error (pack err) + Left err -> throw (SimpleError (mkAnsiText err)) -grpcCliProcess :: (Members '[Reader AnomaPath] r) => Sem r CreateProcess -grpcCliProcess = do +grpcCliProcess :: (Members '[Reader AnomaPath] r) => GrpcMethodUrl -> Sem r CreateProcess +grpcCliProcess method = do paths <- relativeToAnomaDir relProtoDir return ( proc @@ -128,24 +126,18 @@ grpcCliProcess = do "--protofiles", toFilePath relProtoFile, "localhost:" <> show listenPort, - "Anoma.Protobuf.Intents.Prove" + show method ] ) { std_in = CreatePipe, std_out = CreatePipe } - where - relProtoDir :: Path Rel Dir - relProtoDir = $(mkRelDir "apps/anoma_protobuf/priv/protobuf") - - relProtoFile :: Path Rel File - relProtoFile = $(mkRelFile "anoma.proto") -runAnoma :: forall r a. (Members '[Logger, EmbedIO] r) => AnomaPath -> Sem (Anoma ': r) a -> Sem r a +runAnoma :: forall r a. (Members '[Logger, EmbedIO, Error SimpleError] r) => AnomaPath -> Sem (Anoma ': r) a -> Sem r a runAnoma anomapath body = runReader anomapath . runConcurrent . runProcess $ withSapwnAnomaNode $ \grpcport _nodeOut nodeH -> runReader (GrpcPort grpcport) $ withSpawnAnomaClient $ \_clientH -> do (`interpret` inject body) $ \case NoHalt -> waitForProcess nodeH - AnomaRpc i -> anomaRpc' i + AnomaRpc method i -> anomaRpc' method i diff --git a/src/Anoma/Effect/Paths.hs b/src/Anoma/Effect/Paths.hs new file mode 100644 index 0000000000..663a7a104c --- /dev/null +++ b/src/Anoma/Effect/Paths.hs @@ -0,0 +1,12 @@ +module Anoma.Effect.Paths where + +import Juvix.Prelude + +clientRelFile :: Path Rel File +clientRelFile = $(mkRelFile "apps/anoma_client/anoma_client") + +relProtoDir :: Path Rel Dir +relProtoDir = $(mkRelDir "apps/anoma_protobuf/priv/protobuf") + +relProtoFile :: Path Rel File +relProtoFile = $(mkRelFile "anoma.proto") diff --git a/src/Anoma/Effect/RunNockma.hs b/src/Anoma/Effect/RunNockma.hs index 8219b00513..cb19921661 100644 --- a/src/Anoma/Effect/RunNockma.hs +++ b/src/Anoma/Effect/RunNockma.hs @@ -5,8 +5,7 @@ module Anoma.Effect.RunNockma where import Anoma.Effect.Base -import Anoma.Rpc.RunNock (RunNock (_runNockJammedProgram)) -import Anoma.Rpc.RunNock qualified as Rpc +import Anoma.Rpc.RunNock import Data.ByteString.Base64 qualified as Base64 import Juvix.Compiler.Nockma.Encoding.Cue (DecodingError, cueFromByteString'') import Juvix.Compiler.Nockma.Encoding.Jam (jamToByteString) @@ -14,6 +13,7 @@ import Juvix.Compiler.Nockma.Language (NockNaturalNaturalError) import Juvix.Compiler.Nockma.Language qualified as Nockma import Juvix.Data.CodeAnn (simpleErrorCodeAnn) import Juvix.Prelude +import Juvix.Prelude.Aeson (Value) import Juvix.Prelude.Aeson qualified as Aeson import Juvix.Prelude.Pretty @@ -49,13 +49,13 @@ runNockma :: Sem r (Nockma.Term Natural) runNockma prog inputs = do let prog' = encodeJam64 prog - args = map (Rpc.NockInputJammed . encodeJam64) inputs + args = map (NockInputJammed . encodeJam64) inputs msg = - Rpc.RunNock + RunNock { _runNockJammedProgram = prog', _runNockPrivateInputs = args, _runNockPublicInputs = [] } let json = Aeson.toJSON msg - res :: Rpc.Response <- anomaRpc json >>= fromJSON - decodeJam64 (res ^. Rpc.proof) + res :: Response <- anomaRpc runNockGrpcUrl json >>= fromJSON + decodeJam64 (res ^. proof) diff --git a/src/Anoma/Rpc/Base.hs b/src/Anoma/Rpc/Base.hs new file mode 100644 index 0000000000..dc116e07e8 --- /dev/null +++ b/src/Anoma/Rpc/Base.hs @@ -0,0 +1,6 @@ +module Anoma.Rpc.Base + ( module Anoma.Rpc.GrpcMethodUrl, + ) +where + +import Anoma.Rpc.GrpcMethodUrl diff --git a/src/Anoma/Rpc/GrpcMethodUrl.hs b/src/Anoma/Rpc/GrpcMethodUrl.hs new file mode 100644 index 0000000000..ec6acaf19d --- /dev/null +++ b/src/Anoma/Rpc/GrpcMethodUrl.hs @@ -0,0 +1,23 @@ +module Anoma.Rpc.GrpcMethodUrl + ( GrpcMethodUrl, + mkGrpcMethodUrl, + grpcMethodUrlToText, + ) +where + +import Data.Text qualified as Text +import Juvix.Prelude +import Prelude (show) + +newtype GrpcMethodUrl = GrpcMethodUrl + { _grpcMethodUrl :: NonEmpty Text + } + +mkGrpcMethodUrl :: NonEmpty Text -> GrpcMethodUrl +mkGrpcMethodUrl = GrpcMethodUrl + +grpcMethodUrlToText :: GrpcMethodUrl -> Text +grpcMethodUrlToText (GrpcMethodUrl u) = Text.intercalate "." (toList u) + +instance Show GrpcMethodUrl where + show = unpack . grpcMethodUrlToText diff --git a/src/Anoma/Rpc/RunNock.hs b/src/Anoma/Rpc/RunNock.hs index 5baa4c3657..c249a24088 100644 --- a/src/Anoma/Rpc/RunNock.hs +++ b/src/Anoma/Rpc/RunNock.hs @@ -1,8 +1,14 @@ module Anoma.Rpc.RunNock where +import Anoma.Rpc.Base import Juvix.Prelude import Juvix.Prelude.Aeson +runNockGrpcUrl :: GrpcMethodUrl +runNockGrpcUrl = + mkGrpcMethodUrl $ + "Anoma" :| ["Protobuf", "Intents", "Prove"] + data NockInput = NockInputText Text | NockInputJammed Text From ca8911cbc7f1c725e090dd0a536e9da44545f176 Mon Sep 17 00:00:00 2001 From: Jan Mas Rovira Date: Mon, 28 Oct 2024 18:02:02 +0100 Subject: [PATCH 09/16] add comment --- src/Anoma/Effect/Base.hs | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/src/Anoma/Effect/Base.hs b/src/Anoma/Effect/Base.hs index 853958b1eb..1b85d0dc2d 100644 --- a/src/Anoma/Effect/Base.hs +++ b/src/Anoma/Effect/Base.hs @@ -1,3 +1,7 @@ +-- | This module assumes that the following external dependencies are installed: +-- 1. mix +-- +-- 2. grpc_cli module Anoma.Effect.Base ( Anoma, noHalt, @@ -22,7 +26,7 @@ import Juvix.Prelude.Aeson (Value, eitherDecodeStrict, encode) data Anoma :: Effect where -- | Keep the node and client running NoHalt :: Anoma m ExitCode - -- | Blocking rpc call + -- | grpc call AnomaRpc :: GrpcMethodUrl -> Value -> Anoma m Value makeSem ''Anoma From f479d1082225ef36ae4b8aaee9f85ea8269225fa Mon Sep 17 00:00:00 2001 From: Jan Mas Rovira Date: Mon, 28 Oct 2024 19:42:13 +0100 Subject: [PATCH 10/16] hide readProcess --- test/Base.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/test/Base.hs b/test/Base.hs index 01758b7249..68eaded81d 100644 --- a/test/Base.hs +++ b/test/Base.hs @@ -21,7 +21,7 @@ import Juvix.Compiler.Pipeline.Loader.PathResolver import Juvix.Compiler.Pipeline.Run import Juvix.Data.Effect.TaggedLock import Juvix.Extra.Paths hiding (rootBuildDir) -import Juvix.Prelude hiding (assert) +import Juvix.Prelude hiding (assert, readProcess) import Juvix.Prelude.Env import Juvix.Prelude.Pretty (prettyString) import System.Process qualified as P From 82e38ebe371d0418d06cd03c1bfe3ca62697850b Mon Sep 17 00:00:00 2001 From: Jan Mas Rovira Date: Tue, 29 Oct 2024 12:04:24 +0100 Subject: [PATCH 11/16] parse error --- src/Anoma/Effect/Base.hs | 9 ++++++--- 1 file changed, 6 insertions(+), 3 deletions(-) diff --git a/src/Anoma/Effect/Base.hs b/src/Anoma/Effect/Base.hs index 1b85d0dc2d..a329bea463 100644 --- a/src/Anoma/Effect/Base.hs +++ b/src/Anoma/Effect/Base.hs @@ -81,7 +81,8 @@ withSpawnAnomaClient body = do } withSapwnAnomaNode :: - (Members '[EmbedIO, Logger, Process, Reader AnomaPath] r) => + forall r a. + (Members '[EmbedIO, Logger, Error SimpleError, Process, Reader AnomaPath] r) => (Int -> Handle -> ProcessHandle -> Sem r a) -> Sem r a withSapwnAnomaNode body = withSystemTempFile "start.exs" $ \fp tmpHandle -> do @@ -92,9 +93,11 @@ withSapwnAnomaNode body = withSystemTempFile "start.exs" $ \fp tmpHandle -> do withCreateProcess (cprocess (toFilePath fp)) $ \_stdin mstdout _stderr procHandle -> do setCurrentDir curDir let nodeOut = fromJust mstdout - grpcNode :: Int <- either (error . pack) id . readEither . unpack <$> hGetLine nodeOut + ln <- hGetLine nodeOut + let parseError = throw (SimpleError (mkAnsiText ("Failed to parse the grpc port when starting the anoma client.\nExpected a number but got " <> ln))) + nodeport :: Int <- either (const parseError) return . readEither . unpack $ ln logInfo "Anoma node successfully started" - body grpcNode (fromJust mstdout) procHandle + body nodeport (fromJust mstdout) procHandle where cprocess :: FilePath -> CreateProcess cprocess exs = From f8db38f8ec904b5086c5fdc9db5abedf7cd755a5 Mon Sep 17 00:00:00 2001 From: Jan Mas Rovira Date: Tue, 29 Oct 2024 12:11:36 +0100 Subject: [PATCH 12/16] use grpcurl instead --- src/Anoma/Effect/Base.hs | 18 +++++++++--------- 1 file changed, 9 insertions(+), 9 deletions(-) diff --git a/src/Anoma/Effect/Base.hs b/src/Anoma/Effect/Base.hs index a329bea463..290095e269 100644 --- a/src/Anoma/Effect/Base.hs +++ b/src/Anoma/Effect/Base.hs @@ -1,7 +1,7 @@ -- | This module assumes that the following external dependencies are installed: -- 1. mix -- --- 2. grpc_cli +-- 2. grpcurl module Anoma.Effect.Base ( Anoma, noHalt, @@ -121,17 +121,17 @@ anomaRpc' method payload = do grpcCliProcess :: (Members '[Reader AnomaPath] r) => GrpcMethodUrl -> Sem r CreateProcess grpcCliProcess method = do - paths <- relativeToAnomaDir relProtoDir + importPath <- relativeToAnomaDir relProtoDir return ( proc - "grpc_cli" - [ "call", - "--json_input", - "--json_output", - "--proto_path", - toFilePath paths, - "--protofiles", + "grpcurl" + [ "-import-path", + toFilePath importPath, + "-proto", toFilePath relProtoFile, + "-d", + "@", + "-plaintext", "localhost:" <> show listenPort, show method ] From faab4f7b936e915b4476d8927b093ae28d39a883 Mon Sep 17 00:00:00 2001 From: Jan Mas Rovira Date: Tue, 29 Oct 2024 13:09:51 +0100 Subject: [PATCH 13/16] allow error in response --- src/Anoma/Effect/RunNockma.hs | 4 +++- src/Anoma/Rpc/RunNock.hs | 15 +++++++++------ 2 files changed, 12 insertions(+), 7 deletions(-) diff --git a/src/Anoma/Effect/RunNockma.hs b/src/Anoma/Effect/RunNockma.hs index cb19921661..1007b7a36e 100644 --- a/src/Anoma/Effect/RunNockma.hs +++ b/src/Anoma/Effect/RunNockma.hs @@ -58,4 +58,6 @@ runNockma prog inputs = do } let json = Aeson.toJSON msg res :: Response <- anomaRpc runNockGrpcUrl json >>= fromJSON - decodeJam64 (res ^. proof) + case res of + ResponseProof x -> decodeJam64 x + ResponseError err -> throw (SimpleError (mkAnsiText err)) diff --git a/src/Anoma/Rpc/RunNock.hs b/src/Anoma/Rpc/RunNock.hs index c249a24088..c25a8085f3 100644 --- a/src/Anoma/Rpc/RunNock.hs +++ b/src/Anoma/Rpc/RunNock.hs @@ -42,15 +42,18 @@ $( deriveJSON ''RunNock ) -newtype Response = Response - { _proof :: Text - } +data Response + = ResponseProof Text + | ResponseError Text $( deriveJSON defaultOptions - { fieldLabelModifier = \case - "_proof" -> "proof" - _ -> impossibleError "All fields must be covered" + { unwrapUnaryRecords = True, + sumEncoding = ObjectWithSingleField, + constructorTagModifier = \case + "ResponseProof" -> "proof" + "ResponseError" -> "error" + _ -> impossibleError "All constructors must be covered" } ''Response ) From 7f4e4348b6f691cecaefdbd77985da92be3d16ae Mon Sep 17 00:00:00 2001 From: Jan Mas Rovira Date: Tue, 29 Oct 2024 13:14:14 +0100 Subject: [PATCH 14/16] remove redundant comment --- tests/Anoma/Compilation/positive/test003.juvix | 8 -------- tests/Casm/Compilation/positive/test003.juvix | 8 -------- tests/Compilation/positive/test003.juvix | 8 -------- tests/Rust/Compilation/positive/test003.juvix | 8 -------- 4 files changed, 32 deletions(-) diff --git a/tests/Anoma/Compilation/positive/test003.juvix b/tests/Anoma/Compilation/positive/test003.juvix index 8e0005ad59..f9d007a091 100644 --- a/tests/Anoma/Compilation/positive/test003.juvix +++ b/tests/Anoma/Compilation/positive/test003.juvix @@ -1,14 +1,6 @@ -- Integer arithmetic module test003; -{- - -Multiline comment - -{- nested comments work -} - --} - import Stdlib.Prelude open; import Stdlib.Debug.Trace open; diff --git a/tests/Casm/Compilation/positive/test003.juvix b/tests/Casm/Compilation/positive/test003.juvix index 535c119129..59edd8773d 100644 --- a/tests/Casm/Compilation/positive/test003.juvix +++ b/tests/Casm/Compilation/positive/test003.juvix @@ -1,14 +1,6 @@ -- Integer arithmetic module test003; -{- - -Multiline comment - -{- nested comments work -} - --} - import Stdlib.Prelude open; main : Nat := mod 3 2 + div 18 4 + mod 18 4 + div 16 4 + mod 16 4; diff --git a/tests/Compilation/positive/test003.juvix b/tests/Compilation/positive/test003.juvix index 015fc6aa64..2b7247e005 100644 --- a/tests/Compilation/positive/test003.juvix +++ b/tests/Compilation/positive/test003.juvix @@ -1,14 +1,6 @@ -- Integer arithmetic module test003; -{- - -Multiline comment - -{- nested comments work -} - --} - import Stdlib.Prelude open; main : IO := diff --git a/tests/Rust/Compilation/positive/test003.juvix b/tests/Rust/Compilation/positive/test003.juvix index 535c119129..59edd8773d 100644 --- a/tests/Rust/Compilation/positive/test003.juvix +++ b/tests/Rust/Compilation/positive/test003.juvix @@ -1,14 +1,6 @@ -- Integer arithmetic module test003; -{- - -Multiline comment - -{- nested comments work -} - --} - import Stdlib.Prelude open; main : Nat := mod 3 2 + div 18 4 + mod 18 4 + div 16 4 + mod 16 4; From 332134f11ca40141a5c8d2ec5924c15760e49872 Mon Sep 17 00:00:00 2001 From: Jan Mas Rovira Date: Tue, 29 Oct 2024 15:32:14 +0100 Subject: [PATCH 15/16] set cwd for the process --- src/Anoma/Effect/Base.hs | 19 ++++++++++--------- 1 file changed, 10 insertions(+), 9 deletions(-) diff --git a/src/Anoma/Effect/Base.hs b/src/Anoma/Effect/Base.hs index 290095e269..7cdf2424ec 100644 --- a/src/Anoma/Effect/Base.hs +++ b/src/Anoma/Effect/Base.hs @@ -88,10 +88,8 @@ withSapwnAnomaNode :: withSapwnAnomaNode body = withSystemTempFile "start.exs" $ \fp tmpHandle -> do liftIO (B.hPutStr tmpHandle anomaStartExs) hClose tmpHandle - curDir <- getCurrentDir - asks (^. anomaPath) >>= setCurrentDir - withCreateProcess (cprocess (toFilePath fp)) $ \_stdin mstdout _stderr procHandle -> do - setCurrentDir curDir + cproc <- cprocess (toFilePath fp) + withCreateProcess cproc $ \_stdin mstdout _stderr procHandle -> do let nodeOut = fromJust mstdout ln <- hGetLine nodeOut let parseError = throw (SimpleError (mkAnsiText ("Failed to parse the grpc port when starting the anoma client.\nExpected a number but got " <> ln))) @@ -99,11 +97,14 @@ withSapwnAnomaNode body = withSystemTempFile "start.exs" $ \fp tmpHandle -> do logInfo "Anoma node successfully started" body nodeport (fromJust mstdout) procHandle where - cprocess :: FilePath -> CreateProcess - cprocess exs = - (proc "mix" ["run", "--no-halt", exs]) - { std_out = CreatePipe - } + cprocess :: (Members '[Reader AnomaPath] r') => FilePath -> Sem r' CreateProcess + cprocess exs = do + anomapath <- asks (^. anomaPath) + return + (proc "mix" ["run", "--no-halt", exs]) + { std_out = CreatePipe, + cwd = Just (toFilePath anomapath) + } anomaRpc' :: (Members '[Reader AnomaPath, Process, EmbedIO, Error SimpleError] r) => GrpcMethodUrl -> Value -> Sem r Value anomaRpc' method payload = do From bd74621d7610ae1ef2a969cefbcbd6635d47cb88 Mon Sep 17 00:00:00 2001 From: Jan Mas Rovira Date: Tue, 29 Oct 2024 15:32:39 +0100 Subject: [PATCH 16/16] fix typo --- src/Anoma/Effect/Base.hs | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/src/Anoma/Effect/Base.hs b/src/Anoma/Effect/Base.hs index 7cdf2424ec..f35781c1f6 100644 --- a/src/Anoma/Effect/Base.hs +++ b/src/Anoma/Effect/Base.hs @@ -80,12 +80,12 @@ withSpawnAnomaClient body = do { std_out = CreatePipe } -withSapwnAnomaNode :: +withSpawnAnomaNode :: forall r a. (Members '[EmbedIO, Logger, Error SimpleError, Process, Reader AnomaPath] r) => (Int -> Handle -> ProcessHandle -> Sem r a) -> Sem r a -withSapwnAnomaNode body = withSystemTempFile "start.exs" $ \fp tmpHandle -> do +withSpawnAnomaNode body = withSystemTempFile "start.exs" $ \fp tmpHandle -> do liftIO (B.hPutStr tmpHandle anomaStartExs) hClose tmpHandle cproc <- cprocess (toFilePath fp) @@ -143,7 +143,7 @@ grpcCliProcess method = do runAnoma :: forall r a. (Members '[Logger, EmbedIO, Error SimpleError] r) => AnomaPath -> Sem (Anoma ': r) a -> Sem r a runAnoma anomapath body = runReader anomapath . runConcurrent . runProcess $ - withSapwnAnomaNode $ \grpcport _nodeOut nodeH -> + withSpawnAnomaNode $ \grpcport _nodeOut nodeH -> runReader (GrpcPort grpcport) $ withSpawnAnomaClient $ \_clientH -> do (`interpret` inject body) $ \case