From 669474f3457c736eac525ad46c20bd197862a559 Mon Sep 17 00:00:00 2001 From: Paul Cadman Date: Fri, 22 Nov 2024 16:03:30 +0000 Subject: [PATCH] Add `juvix dev anoma {start, stop, status}` to manage an Anoma client (#3183) This PR adds the `juvix dev anoma {start, stop, status}` commands to manage a running Anoma client. The motivation for this is that we can add additional commands (e.g `indexer`, `prove`, `(mempool)-submit`) which interact with the persistent Anoma client. `juvix dev anoma start` now writes a configuration file in `/anoma-client/config.yaml` which contains the host URL and port of the started Anoma client and the pid of the Anoma client process. For example: config.yaml ``` host: port: 58922 url: localhost pid: 75299 ``` The `anoma stop` command kills the Anoma client and the `anoma status` command shows the config of the currently running client. There can be at most one Anoma client running when using this mechanism. ## Dependency This PR adds a new dependency on the `unix` package. This is used for APIs to send signals to processes. ## CLI docs ### `juvix dev anoma` ``` Usage: juvix dev anoma COMMAND Subcommands related to the Anoma client Available options: -h,--help Show this help text Available commands: start Start an Anoma client status Show the status of the Anoma client stop Stop the Anoma client ``` ### `juvix dev anoma start` ``` Usage: juvix dev anoma start --anoma-dir ANOMA_DIR [-g|--foreground] [-f|--force] Start an Anoma client Available options: --anoma-dir ANOMA_DIR Path to anoma repository -g,--foreground Start the client in the foreground -f,--force Forcefully start a client, terminating any currently running client if necessary -h,--help Show this help text ``` ### `juvix dev anoma status` ``` Usage: juvix dev anoma status Show the status of the Anoma client Available options: -h,--help Show this help text ``` ### `juvix dev anoma stop` ``` Usage: juvix dev anoma stop Stop the Anoma client Available options: -h,--help Show this help text ``` --- app/Commands/Dev/Anoma.hs | 8 +- app/Commands/Dev/Anoma/Client.hs | 21 +++++ app/Commands/Dev/Anoma/Node.hs | 13 --- app/Commands/Dev/Anoma/Node/Options.hs | 15 ---- app/Commands/Dev/Anoma/Options.hs | 39 ++++++-- app/Commands/Dev/Anoma/Start.hs | 52 +++++++++++ app/Commands/Dev/Anoma/Start/Options.hs | 32 +++++++ app/Commands/Dev/Anoma/Status.hs | 12 +++ app/Commands/Dev/Anoma/Stop.hs | 12 +++ app/Commands/Dev/Nockma/Run/WithClient.hs | 6 +- app/Commands/Dev/Options.hs | 2 +- package.yaml | 1 + src/Anoma/Client/Base.hs | 92 +++++++++++++++++++ src/Anoma/Client/Config.hs | 59 +++++++++++++ src/Anoma/Effect/Base.hs | 103 +++++++++------------- src/Juvix/Data/Effect/Files.hs | 3 + src/Juvix/Data/Yaml.hs | 2 +- src/Juvix/Extra/Paths/Base.hs | 3 + src/Juvix/Prelude/Posix.hs | 7 ++ 19 files changed, 377 insertions(+), 105 deletions(-) create mode 100644 app/Commands/Dev/Anoma/Client.hs delete mode 100644 app/Commands/Dev/Anoma/Node.hs delete mode 100644 app/Commands/Dev/Anoma/Node/Options.hs create mode 100644 app/Commands/Dev/Anoma/Start.hs create mode 100644 app/Commands/Dev/Anoma/Start/Options.hs create mode 100644 app/Commands/Dev/Anoma/Status.hs create mode 100644 app/Commands/Dev/Anoma/Stop.hs create mode 100644 src/Anoma/Client/Base.hs create mode 100644 src/Anoma/Client/Config.hs create mode 100644 src/Juvix/Prelude/Posix.hs diff --git a/app/Commands/Dev/Anoma.hs b/app/Commands/Dev/Anoma.hs index ee5fc97b42..5652b27840 100644 --- a/app/Commands/Dev/Anoma.hs +++ b/app/Commands/Dev/Anoma.hs @@ -5,9 +5,13 @@ module Commands.Dev.Anoma where import Commands.Base -import Commands.Dev.Anoma.Node qualified as Node import Commands.Dev.Anoma.Options +import Commands.Dev.Anoma.Start qualified as Start +import Commands.Dev.Anoma.Status qualified as Status +import Commands.Dev.Anoma.Stop qualified as Stop runCommand :: (Members AppEffects r) => AnomaCommand -> Sem r () runCommand = \case - AnomaCommandNode opts -> Node.runCommand opts + AnomaCommandStart opts -> Start.runCommand opts + AnomaCommandStatus -> Status.runCommand + AnomaCommandStop -> Stop.runCommand diff --git a/app/Commands/Dev/Anoma/Client.hs b/app/Commands/Dev/Anoma/Client.hs new file mode 100644 index 0000000000..22110d302e --- /dev/null +++ b/app/Commands/Dev/Anoma/Client.hs @@ -0,0 +1,21 @@ +module Commands.Dev.Anoma.Client where + +import Anoma.Client.Config +import Anoma.Effect.Base +import Commands.Base +import Data.Foldable.Extra qualified as E +import Juvix.Prelude.Posix + +isClientRunning :: (Members '[Files, EmbedIO, Error SimpleError, Logger] r) => ClientConfig -> Sem r Bool +isClientRunning c = + runAnomaWithClient + (c ^. clientConfigHost) + (catchError @SimpleError (anomaListMethods >> return True) (\_ _ -> return False)) + +checkClientRunning :: (Members '[Logger, Files, EmbedIO, Error SimpleError] r) => Sem r (Maybe ClientConfig) +checkClientRunning = do + mconfig <- readConfig + E.findM isClientRunning mconfig + +stopClient :: (Members '[Files, EmbedIO] r) => ClientConfig -> Sem r () +stopClient = terminateProcessPid . (^. clientConfigPid) diff --git a/app/Commands/Dev/Anoma/Node.hs b/app/Commands/Dev/Anoma/Node.hs deleted file mode 100644 index d0f1444eb7..0000000000 --- a/app/Commands/Dev/Anoma/Node.hs +++ /dev/null @@ -1,13 +0,0 @@ -module Commands.Dev.Anoma.Node where - -import Anoma.Effect -import Commands.Base -import Commands.Dev.Anoma.Node.Options - -runCommand :: forall r. (Members AppEffects r) => NodeOptions -> Sem r () -runCommand opts = runAppError @SimpleError - . runConcurrent - . runProcess - $ do - anomaDir :: AnomaPath <- AnomaPath <$> fromAppPathDir (opts ^. nodeAnomaPath) - launchAnoma anomaDir >>= void . waitForProcess diff --git a/app/Commands/Dev/Anoma/Node/Options.hs b/app/Commands/Dev/Anoma/Node/Options.hs deleted file mode 100644 index 1886e30066..0000000000 --- a/app/Commands/Dev/Anoma/Node/Options.hs +++ /dev/null @@ -1,15 +0,0 @@ -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 <- anomaDirOpt - pure NodeOptions {..} diff --git a/app/Commands/Dev/Anoma/Options.hs b/app/Commands/Dev/Anoma/Options.hs index df9d05f00e..1659b44bdc 100644 --- a/app/Commands/Dev/Anoma/Options.hs +++ b/app/Commands/Dev/Anoma/Options.hs @@ -1,24 +1,47 @@ module Commands.Dev.Anoma.Options where -import Commands.Dev.Anoma.Node.Options +import Commands.Dev.Anoma.Start.Options import CommonOptions -newtype AnomaCommand - = AnomaCommandNode NodeOptions +data AnomaCommand + = AnomaCommandStart StartOptions + | AnomaCommandStatus + | AnomaCommandStop deriving stock (Data) parseAnomaCommand :: Parser AnomaCommand parseAnomaCommand = hsubparser ( mconcat - [commandNode] + [ commandStart, + commandStatus, + commandStop + ] ) where - commandNode :: Mod CommandFields AnomaCommand - commandNode = command "node" runInfo + commandStart :: Mod CommandFields AnomaCommand + commandStart = command "start" runInfo where runInfo :: ParserInfo AnomaCommand runInfo = info - (AnomaCommandNode <$> parseNodeOptions) - (progDesc "Run an Anoma node and client.") + (AnomaCommandStart <$> parseStartOptions) + (progDesc "Start an Anoma client") + + commandStatus :: Mod CommandFields AnomaCommand + commandStatus = command "status" runInfo + where + runInfo :: ParserInfo AnomaCommand + runInfo = + info + (pure AnomaCommandStatus) + (progDesc "Show the status of the Anoma client") + + commandStop :: Mod CommandFields AnomaCommand + commandStop = command "stop" runInfo + where + runInfo :: ParserInfo AnomaCommand + runInfo = + info + (pure AnomaCommandStop) + (progDesc "Stop the Anoma client") diff --git a/app/Commands/Dev/Anoma/Start.hs b/app/Commands/Dev/Anoma/Start.hs new file mode 100644 index 0000000000..dda7610e94 --- /dev/null +++ b/app/Commands/Dev/Anoma/Start.hs @@ -0,0 +1,52 @@ +module Commands.Dev.Anoma.Start where + +import Anoma.Client.Config +import Anoma.Effect +import Commands.Base +import Commands.Dev.Anoma.Client +import Commands.Dev.Anoma.Start.Options +import Juvix.Data.CodeAnn + +runCommand :: forall r. (Members AppEffects r) => StartOptions -> Sem r () +runCommand opts = runAppError @SimpleError + . runProcess + $ case opts ^. startLaunchMode of + LaunchModeAttached -> go >>= void . waitForProcess >> removeConfig + LaunchModeDetached -> void go + where + go :: forall x. (Members (Process ': Error SimpleError ': AppEffects) x) => Sem x ProcessHandle + go = do + whenJustM checkClientRunning $ \config -> + if + | (opts ^. startForce) -> stopClient config + | otherwise -> + throw + ( SimpleError + ( mkAnsiText + ( "An Anoma client is already running" + <> line + <> line + <> ppCodeAnn config + ) + ) + ) + i <- startClient + let processH = i ^. anomaClientLaunchInfoProcess . anomaProcessHandle + mpid <- getPid processH + case mpid of + Just pid -> updateConfig pid (i ^. anomaClientLaunchInfoInfo) >> return processH + Nothing -> throw (SimpleError "The Anoma client did not start sucessfully") + where + startClient :: Sem x AnomaClientLaunchInfo + startClient = do + let launchMode = opts ^. startLaunchMode + anomaDir :: AnomaPath <- AnomaPath <$> fromAppPathDir (opts ^. startAnomaPath) + launchAnomaClient launchMode anomaDir + + updateConfig :: Pid -> AnomaClientInfo -> Sem x () + updateConfig pid clientInfo = + writeConfig + ClientConfig + { _clientConfigHost = clientInfo, + _clientConfigPid = fromIntegral pid + } diff --git a/app/Commands/Dev/Anoma/Start/Options.hs b/app/Commands/Dev/Anoma/Start/Options.hs new file mode 100644 index 0000000000..b1c44aebd3 --- /dev/null +++ b/app/Commands/Dev/Anoma/Start/Options.hs @@ -0,0 +1,32 @@ +module Commands.Dev.Anoma.Start.Options where + +import Anoma.Client.Base +import CommonOptions + +data StartOptions = StartOptions + { _startAnomaPath :: AppPath Dir, + _startLaunchMode :: LaunchMode, + _startForce :: Bool + } + deriving stock (Data) + +makeLenses ''StartOptions + +parseStartOptions :: Parser StartOptions +parseStartOptions = do + _startAnomaPath <- anomaDirOpt + _startLaunchMode <- + flag + LaunchModeDetached + LaunchModeAttached + ( long "foreground" + <> short 'g' + <> help "Start the client in the foreground" + ) + _startForce <- + switch + ( long "force" + <> short 'f' + <> help "Forcefully start a client, terminating any currently running client if necessary" + ) + pure StartOptions {..} diff --git a/app/Commands/Dev/Anoma/Status.hs b/app/Commands/Dev/Anoma/Status.hs new file mode 100644 index 0000000000..76bed23f05 --- /dev/null +++ b/app/Commands/Dev/Anoma/Status.hs @@ -0,0 +1,12 @@ +module Commands.Dev.Anoma.Status where + +import Commands.Base +import Commands.Dev.Anoma.Client +import Juvix.Data.CodeAnn + +runCommand :: forall r. (Members AppEffects r) => Sem r () +runCommand = runAppError @SimpleError $ do + mconfig <- checkClientRunning + case mconfig of + Just config -> renderStdOutLn (ppCodeAnn config) + Nothing -> logInfo "The Anoma client is not running" >> exitFailure diff --git a/app/Commands/Dev/Anoma/Stop.hs b/app/Commands/Dev/Anoma/Stop.hs new file mode 100644 index 0000000000..28f75ec9c4 --- /dev/null +++ b/app/Commands/Dev/Anoma/Stop.hs @@ -0,0 +1,12 @@ +module Commands.Dev.Anoma.Stop where + +import Anoma.Client.Config +import Commands.Base +import Commands.Dev.Anoma.Client + +runCommand :: forall r. (Members AppEffects r) => Sem r () +runCommand = runAppError @SimpleError $ do + mconfig <- checkClientRunning + case mconfig of + Just config -> stopClient config >> removeConfig + Nothing -> logInfo "The Anoma client is not running" >> exitFailure diff --git a/app/Commands/Dev/Nockma/Run/WithClient.hs b/app/Commands/Dev/Nockma/Run/WithClient.hs index 58fcdd73e6..6821ea33f5 100644 --- a/app/Commands/Dev/Nockma/Run/WithClient.hs +++ b/app/Commands/Dev/Nockma/Run/WithClient.hs @@ -12,9 +12,9 @@ runCommand opts = $ runInAnoma runArgs where grpcInfo = - AnomaGrpcClientInfo - { _anomaGrpcClientInfoUrl = opts ^. nockmaRunWithClientUrl, - _anomaGrpcClientInfoPort = opts ^. nockmaRunWithClientGrpcPort + AnomaClientInfo + { _anomaClientInfoUrl = opts ^. nockmaRunWithClientUrl, + _anomaClientInfoPort = opts ^. nockmaRunWithClientGrpcPort } runArgs = RunCommandArgs diff --git a/app/Commands/Dev/Options.hs b/app/Commands/Dev/Options.hs index f0892cffd9..fb5b426d0d 100644 --- a/app/Commands/Dev/Options.hs +++ b/app/Commands/Dev/Options.hs @@ -215,4 +215,4 @@ commandAnoma = command "anoma" $ info (Anoma <$> parseAnomaCommand) - (progDesc "Subcommands related to the anoma") + (progDesc "Subcommands related to the Anoma client") diff --git a/package.yaml b/package.yaml index b53b3e09ed..2702683257 100644 --- a/package.yaml +++ b/package.yaml @@ -112,6 +112,7 @@ dependencies: - unicode-show == 0.1.* - uniplate == 1.6.* - unix-compat == 0.7.* + - unix == 2.8.* - unordered-containers == 0.2.* - utf8-string == 1.0.* - vector == 0.13.* diff --git a/src/Anoma/Client/Base.hs b/src/Anoma/Client/Base.hs new file mode 100644 index 0000000000..b34776fb40 --- /dev/null +++ b/src/Anoma/Client/Base.hs @@ -0,0 +1,92 @@ +module Anoma.Client.Base where + +import Data.Text qualified as T +import Juvix.Data.CodeAnn +import Juvix.Extra.Paths (anomaStartExs) +import Juvix.Prelude +import Juvix.Prelude.Aeson as Aeson + +data AnomaClientInfo = AnomaClientInfo + { _anomaClientInfoPort :: Int, + _anomaClientInfoUrl :: String + } + +$( deriveJSON + Aeson.defaultOptions + { unwrapUnaryRecords = True, + allowOmittedFields = False, + rejectUnknownFields = True, + fieldLabelModifier = \case + "_anomaClientInfoUrl" -> "url" + "_anomaClientInfoPort" -> "port" + _ -> impossibleError "All fields must be covered" + } + ''AnomaClientInfo + ) + +newtype AnomaPath = AnomaPath {_anomaPath :: Path Abs Dir} + +newtype AnomaProcess = AnomaProcess + { _anomaProcessHandle :: ProcessHandle + } + +data AnomaClientLaunchInfo = AnomaClientLaunchInfo + { _anomaClientLaunchInfoInfo :: AnomaClientInfo, + _anomaClientLaunchInfoProcess :: AnomaProcess + } + +data LaunchMode + = -- | Launch the client process attached to the parent + LaunchModeAttached + | -- | Launch the client process detached from the parent + LaunchModeDetached + deriving stock (Data) + +makeLenses ''AnomaClientInfo +makeLenses ''AnomaPath +makeLenses ''AnomaProcess +makeLenses ''AnomaClientLaunchInfo + +anomaClientCreateProcess :: forall r. (Members '[Reader AnomaPath] r) => LaunchMode -> Sem r CreateProcess +anomaClientCreateProcess launchMode = do + p <- baseProc + return $ case launchMode of + LaunchModeAttached -> p + LaunchModeDetached -> p {new_session = True, std_err = NoStream} + where + baseProc :: Sem r CreateProcess + baseProc = do + anomapath <- asks (^. anomaPath) + return + (proc "mix" ["run", "--no-halt", "-e", unpack (T.strip (decodeUtf8 anomaStartExs))]) + { std_out = CreatePipe, + cwd = Just (toFilePath anomapath), + std_in = NoStream + } + +setupAnomaClientProcess :: (Members '[EmbedIO, Logger, Error SimpleError] r) => Handle -> Sem r AnomaClientInfo +setupAnomaClientProcess nodeOut = do + ln <- hGetLine nodeOut + let parseError = throw (SimpleError (mkAnsiText ("Failed to parse the client grpc port when starting the anoma node and client.\nExpected a number but got " <> ln))) + grpcPort :: Int <- either (const parseError) return . readEither . unpack $ ln + logInfo "Anoma node and client successfully started" + logInfo (mkAnsiText ("Listening on port " <> annotate AnnImportant (pretty grpcPort))) + return + ( AnomaClientInfo + { _anomaClientInfoPort = grpcPort, + _anomaClientInfoUrl = "localhost" + } + ) + +launchAnomaClient :: (Members '[Logger, EmbedIO, Error SimpleError] r) => LaunchMode -> AnomaPath -> Sem r AnomaClientLaunchInfo +launchAnomaClient launchMode anomapath = runReader anomapath . runProcess $ do + cproc <- anomaClientCreateProcess launchMode + (_mstdin, mstdout, _mstderr, procHandle) <- createProcess cproc + let stdoutH = fromJust mstdout + info <- setupAnomaClientProcess stdoutH + hClose stdoutH + return + AnomaClientLaunchInfo + { _anomaClientLaunchInfoInfo = info, + _anomaClientLaunchInfoProcess = AnomaProcess procHandle + } diff --git a/src/Anoma/Client/Config.hs b/src/Anoma/Client/Config.hs new file mode 100644 index 0000000000..6c689e913e --- /dev/null +++ b/src/Anoma/Client/Config.hs @@ -0,0 +1,59 @@ +module Anoma.Client.Config where + +import Anoma.Client.Base +import Data.Text qualified as T +import Juvix.Data.CodeAnn +import Juvix.Data.Yaml qualified as Y +import Juvix.Extra.Paths.Base (clientConfigPath) +import Juvix.Prelude +import Juvix.Prelude.Aeson as Aeson + +data ClientConfig = ClientConfig + { _clientConfigPid :: Int, + _clientConfigHost :: AnomaClientInfo + } + +makeLenses ''ClientConfig + +$( deriveJSON + Aeson.defaultOptions + { unwrapUnaryRecords = True, + allowOmittedFields = False, + rejectUnknownFields = True, + fieldLabelModifier = \case + "_clientConfigPid" -> "pid" + "_clientConfigHost" -> "host" + _ -> impossibleError "All fields must be covered" + } + ''ClientConfig + ) + +instance PrettyCodeAnn ClientConfig where + ppCodeAnn c = + "Anoma client info:" + <> line + -- The output of YAML encoding has a trailing newline + <> pretty (T.dropWhileEnd (== '\n') (decodeUtf8 (Y.encode c))) + +configPath :: (Member Files r) => Sem r (Path Abs File) +configPath = ( clientConfigPath) <$> globalAnomaClient + +writeConfig :: (Member Files r) => ClientConfig -> Sem r () +writeConfig conf = do + cp <- configPath + ensureDir' (parent cp) + writeFileBS cp (Y.encode conf) + +readConfig :: (Members '[Files, Error SimpleError] r) => Sem r (Maybe ClientConfig) +readConfig = do + cp <- configPath + whenMaybeM (fileExists' cp) $ do + bs <- readFileBS' cp + case Y.decodeEither bs of + Left err -> throw (SimpleError (mkAnsiText (Y.prettyPrintParseException err <> "\n" <> toFilePath cp))) + Right a -> return a + +removeConfig :: (Members '[Files] r) => Sem r () +removeConfig = do + cp <- configPath + whenM (fileExists' cp) (removeFile' cp) diff --git a/src/Anoma/Effect/Base.hs b/src/Anoma/Effect/Base.hs index f619851d07..89be357a34 100644 --- a/src/Anoma/Effect/Base.hs +++ b/src/Anoma/Effect/Base.hs @@ -5,77 +5,34 @@ module Anoma.Effect.Base ( Anoma, anomaRpc, - AnomaPath (..), - AnomaProcess (..), - AnomaGrpcClientInfo (..), - anomaGrpcClientInfoPort, - anomaGrpcClientInfoUrl, - anomaProcessHandle, - anomaPath, + anomaListMethods, runAnomaEphemeral, runAnomaWithClient, - launchAnoma, module Anoma.Rpc.Base, + module Anoma.Client.Base, module Juvix.Compiler.Nockma.Translation.FromTree, ) where +import Anoma.Client.Base import Anoma.Rpc.Base import Data.ByteString qualified as B import Data.Text qualified as T 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) -newtype AnomaProcess = AnomaProcess - { _anomaProcessHandle :: ProcessHandle - } - -data AnomaGrpcClientInfo = AnomaGrpcClientInfo - { _anomaGrpcClientInfoPort :: Int, - _anomaGrpcClientInfoUrl :: String - } - data Anoma :: Effect where - -- | grpc call + -- | gRPC call AnomaRpc :: GrpcMethodUrl -> Value -> Anoma m Value + -- | List all gRPC methods using server reflection + AnomaListMethods :: Anoma m [GrpcMethodUrl] makeSem ''Anoma -makeLenses ''AnomaProcess - -newtype AnomaPath = AnomaPath {_anomaPath :: Path Abs Dir} - -makeLenses ''AnomaPath -makeLenses ''AnomaGrpcClientInfo - -anomaCreateProcess :: (Members '[Reader AnomaPath] r') => Sem r' CreateProcess -anomaCreateProcess = do - anomapath <- asks (^. anomaPath) - return - (proc "mix" ["run", "--no-halt", "-e", unpack (T.strip (decodeUtf8 anomaStartExs))]) - { std_out = CreatePipe, - std_in = NoStream, - cwd = Just (toFilePath anomapath) - } - -setupAnomaProcess :: (Members '[EmbedIO, Logger, Error SimpleError] r) => Handle -> Sem r AnomaGrpcClientInfo -setupAnomaProcess nodeOut = do - ln <- hGetLine nodeOut - let parseError = throw (SimpleError (mkAnsiText ("Failed to parse the client grpc port when starting the anoma node and client.\nExpected a number but got " <> ln))) - grpcPort :: Int <- either (const parseError) return . readEither . unpack $ ln - logInfo "Anoma node and client successfully started" - logInfo (mkAnsiText ("Listening on port " <> annotate AnnImportant (pretty grpcPort))) - return - ( AnomaGrpcClientInfo - { _anomaGrpcClientInfoPort = grpcPort, - _anomaGrpcClientInfoUrl = "localhost" - } - ) anomaRpc' :: - (Members '[Reader AnomaGrpcClientInfo, Process, EmbedIO, Error SimpleError] r) => + (Members '[Reader AnomaClientInfo, Process, EmbedIO, Error SimpleError] r) => GrpcMethodUrl -> Value -> Sem r Value @@ -92,10 +49,23 @@ anomaRpc' method payload = do Right r -> return r Left err -> throw (SimpleError (mkAnsiText err)) -grpcCliProcess :: (Members '[Reader AnomaGrpcClientInfo] r) => GrpcMethodUrl -> Sem r CreateProcess +anomaListMethods' :: + (Members '[Reader AnomaClientInfo, Process, Error SimpleError] r) => + Sem r [GrpcMethodUrl] +anomaListMethods' = do + cproc <- grpcCliListProcess + (exitCode, stdOut, stdErr) <- readCreateProcessWithExitCode cproc "" + case exitCode of + ExitFailure {} -> throw (SimpleError (mkAnsiText ("gRPC list failed: " <> stdErr))) + ExitSuccess -> return (mapMaybe parseMethod (lines stdOut)) + where + parseMethod :: String -> Maybe GrpcMethodUrl + parseMethod = fmap mkGrpcMethodUrl . nonEmpty . T.split (== '.') . pack + +grpcCliProcess :: (Members '[Reader AnomaClientInfo] r) => GrpcMethodUrl -> Sem r CreateProcess grpcCliProcess method = do - grpcPort <- asks (^. anomaGrpcClientInfoPort) - grpcUrl <- asks (^. anomaGrpcClientInfoUrl) + grpcPort <- asks (^. anomaClientInfoPort) + grpcUrl <- asks (^. anomaClientInfoUrl) return ( proc "grpcurl" @@ -110,25 +80,34 @@ grpcCliProcess method = do std_out = CreatePipe } +grpcCliListProcess :: (Members '[Reader AnomaClientInfo] r) => Sem r CreateProcess +grpcCliListProcess = do + grpcPort <- asks (^. anomaClientInfoPort) + grpcUrl <- asks (^. anomaClientInfoUrl) + return + ( proc + "grpcurl" + [ "-plaintext", + grpcUrl <> ":" <> show grpcPort, + "list" + ] + ) + runAnomaEphemeral :: forall r a. (Members '[Logger, EmbedIO, Error SimpleError] r) => AnomaPath -> Sem (Anoma ': r) a -> Sem r a runAnomaEphemeral anomapath body = runReader anomapath . runProcess $ do - cproc <- anomaCreateProcess + cproc <- anomaClientCreateProcess LaunchModeAttached withCreateProcess cproc $ \_stdin mstdout _stderr _procHandle -> do - grpcServer <- setupAnomaProcess (fromJust mstdout) + grpcServer <- setupAnomaClientProcess (fromJust mstdout) runReader grpcServer $ do (`interpret` inject body) $ \case AnomaRpc method i -> anomaRpc' method i + AnomaListMethods -> anomaListMethods' -runAnomaWithClient :: forall r a. (Members '[Logger, EmbedIO, Error SimpleError] r) => AnomaGrpcClientInfo -> Sem (Anoma ': r) a -> Sem r a +runAnomaWithClient :: forall r a. (Members '[Logger, EmbedIO, Error SimpleError] r) => AnomaClientInfo -> Sem (Anoma ': r) a -> Sem r a runAnomaWithClient grpcInfo body = runProcess . runReader grpcInfo $ (`interpret` inject body) $ \case AnomaRpc method i -> anomaRpc' method i - -launchAnoma :: (Members '[Logger, EmbedIO, Error SimpleError] r) => AnomaPath -> Sem r ProcessHandle -launchAnoma anomapath = runReader anomapath . runProcess $ do - cproc <- anomaCreateProcess - (_stdin, mstdout, _stderr, procHandle) <- createProcess cproc - setupAnomaProcess (fromJust mstdout) >> return procHandle + AnomaListMethods -> anomaListMethods' diff --git a/src/Juvix/Data/Effect/Files.hs b/src/Juvix/Data/Effect/Files.hs index bf0340a77c..af4db605dd 100644 --- a/src/Juvix/Data/Effect/Files.hs +++ b/src/Juvix/Data/Effect/Files.hs @@ -123,3 +123,6 @@ globalPackageBaseRoot = ( $(mkRelDir "package-base")) <$> juvixConfigDir globalGitCache :: (Members '[Files] r) => Sem r (Path Abs Dir) globalGitCache = ( $(mkRelDir "git-cache")) <$> juvixConfigDir + +globalAnomaClient :: (Members '[Files] r) => Sem r (Path Abs Dir) +globalAnomaClient = ( $(mkRelDir "anoma-client")) <$> juvixConfigDir diff --git a/src/Juvix/Data/Yaml.hs b/src/Juvix/Data/Yaml.hs index 7bc2ef5927..8cb9a83ef4 100644 --- a/src/Juvix/Data/Yaml.hs +++ b/src/Juvix/Data/Yaml.hs @@ -7,7 +7,7 @@ where import Data.Aeson.BetterErrors hiding (mapError, (<|>)) import Data.Aeson.Types (formatError) -import Data.Yaml (FromJSON (..), ParseException (..), prettyPrintParseException) +import Data.Yaml (FromJSON (..), ParseException (..), encode, prettyPrintParseException) import Data.Yaml.Internal (Warning (..), decodeHelper) import GHC.IO (unsafePerformIO) import Juvix.Prelude.Base diff --git a/src/Juvix/Extra/Paths/Base.hs b/src/Juvix/Extra/Paths/Base.hs index d359069e1f..c6bb9f3e99 100644 --- a/src/Juvix/Extra/Paths/Base.hs +++ b/src/Juvix/Extra/Paths/Base.hs @@ -86,3 +86,6 @@ preludePath = $(mkRelFile "Stdlib/Prelude.juvix") defaultStdlibPath :: Path Abs Dir -> Path Abs Dir defaultStdlibPath buildDir = buildDir $(mkRelDir "stdlib") + +clientConfigPath :: Path Rel File +clientConfigPath = $(mkRelFile "config.yaml") diff --git a/src/Juvix/Prelude/Posix.hs b/src/Juvix/Prelude/Posix.hs new file mode 100644 index 0000000000..9ad66f3fab --- /dev/null +++ b/src/Juvix/Prelude/Posix.hs @@ -0,0 +1,7 @@ +module Juvix.Prelude.Posix where + +import Juvix.Prelude.Base +import System.Posix.Signals + +terminateProcessPid :: (MonadIO m, Integral a) => a -> m () +terminateProcessPid = liftIO . signalProcess softwareTermination . fromIntegral