From 23d3458bc90b4a69b27ce43edca4af4259b78e7f Mon Sep 17 00:00:00 2001 From: Paul Cadman Date: Wed, 20 Nov 2024 14:32:19 +0000 Subject: [PATCH 1/5] Support launching the Anoma client in the background --- app/Commands/Dev/Anoma/Node.hs | 6 +- app/Commands/Dev/Anoma/Node/Options.hs | 14 ++++- app/Commands/Dev/Nockma/Run/WithClient.hs | 6 +- src/Anoma/Client.hs | 3 + src/Anoma/Client/Base.hs | 68 ++++++++++++++++++++++ src/Anoma/Effect/Base.hs | 71 +++-------------------- 6 files changed, 100 insertions(+), 68 deletions(-) create mode 100644 src/Anoma/Client.hs create mode 100644 src/Anoma/Client/Base.hs diff --git a/app/Commands/Dev/Anoma/Node.hs b/app/Commands/Dev/Anoma/Node.hs index d0f1444eb7..76f0facbdd 100644 --- a/app/Commands/Dev/Anoma/Node.hs +++ b/app/Commands/Dev/Anoma/Node.hs @@ -9,5 +9,9 @@ runCommand opts = runAppError @SimpleError . runConcurrent . runProcess $ do + let launchMode = opts ^. nodeLaunchMode anomaDir :: AnomaPath <- AnomaPath <$> fromAppPathDir (opts ^. nodeAnomaPath) - launchAnoma anomaDir >>= void . waitForProcess + processH <- launchAnomaClient launchMode anomaDir + case launchMode of + LaunchModeAttached -> void (waitForProcess processH) + LaunchModeDetached -> return () diff --git a/app/Commands/Dev/Anoma/Node/Options.hs b/app/Commands/Dev/Anoma/Node/Options.hs index 1886e30066..d6de83c919 100644 --- a/app/Commands/Dev/Anoma/Node/Options.hs +++ b/app/Commands/Dev/Anoma/Node/Options.hs @@ -1,9 +1,11 @@ module Commands.Dev.Anoma.Node.Options where +import Anoma.Client.Base import CommonOptions -newtype NodeOptions = NodeOptions - { _nodeAnomaPath :: AppPath Dir +data NodeOptions = NodeOptions + { _nodeAnomaPath :: AppPath Dir, + _nodeLaunchMode :: LaunchMode } deriving stock (Data) @@ -12,4 +14,12 @@ makeLenses ''NodeOptions parseNodeOptions :: Parser NodeOptions parseNodeOptions = do _nodeAnomaPath <- anomaDirOpt + _nodeLaunchMode <- + flag + LaunchModeAttached + LaunchModeDetached + ( long "background" + <> short 'b' + <> help "Launch the client in the background" + ) pure NodeOptions {..} 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/src/Anoma/Client.hs b/src/Anoma/Client.hs new file mode 100644 index 0000000000..676ee592b0 --- /dev/null +++ b/src/Anoma/Client.hs @@ -0,0 +1,3 @@ +module Anoma.Client (module Anoma.Client.Base) where + +import Anoma.Client.Base diff --git a/src/Anoma/Client/Base.hs b/src/Anoma/Client/Base.hs new file mode 100644 index 0000000000..a9ac75236a --- /dev/null +++ b/src/Anoma/Client/Base.hs @@ -0,0 +1,68 @@ +module Anoma.Client.Base where + +import Data.Text qualified as T +import Juvix.Data.CodeAnn +import Juvix.Extra.Paths (anomaStartExs) +import Juvix.Prelude + +data AnomaClientInfo = AnomaClientInfo + { _anomaClientInfoPort :: Int, + _anomaClientInfoUrl :: String + } + +newtype AnomaPath = AnomaPath {_anomaPath :: Path Abs Dir} + +newtype AnomaProcess = AnomaProcess + { _anomaProcessHandle :: ProcessHandle + } + +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 + +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 ProcessHandle +launchAnomaClient launchMode anomapath = runReader anomapath . runProcess $ do + cproc <- anomaClientCreateProcess launchMode + (_mstdin, mstdout, _mstderr, procHandle) <- createProcess cproc + let stdoutH = fromJust mstdout + setupAnomaClientProcess stdoutH + hClose stdoutH + return procHandle diff --git a/src/Anoma/Effect/Base.hs b/src/Anoma/Effect/Base.hs index f619851d07..7cb1e96051 100644 --- a/src/Anoma/Effect/Base.hs +++ b/src/Anoma/Effect/Base.hs @@ -5,77 +5,30 @@ module Anoma.Effect.Base ( Anoma, anomaRpc, - AnomaPath (..), - AnomaProcess (..), - AnomaGrpcClientInfo (..), - anomaGrpcClientInfoPort, - anomaGrpcClientInfoUrl, - anomaProcessHandle, - anomaPath, 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 AnomaRpc :: GrpcMethodUrl -> Value -> Anoma m Value 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 +45,10 @@ anomaRpc' method payload = do Right r -> return r Left err -> throw (SimpleError (mkAnsiText err)) -grpcCliProcess :: (Members '[Reader AnomaGrpcClientInfo] r) => GrpcMethodUrl -> Sem r CreateProcess +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" @@ -112,23 +65,17 @@ grpcCliProcess method = do 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 -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 From d17ebc685d1a4e5b582c091f5a14bbd2fca3ee03 Mon Sep 17 00:00:00 2001 From: Paul Cadman Date: Wed, 20 Nov 2024 14:48:00 +0000 Subject: [PATCH 2/5] Rename the `anoma node` command to `anoma start` --- app/Commands/Dev/Anoma.hs | 4 ++-- app/Commands/Dev/Anoma/Node/Options.hs | 25 -------------------- app/Commands/Dev/Anoma/Options.hs | 8 +++---- app/Commands/Dev/Anoma/{Node.hs => Start.hs} | 10 ++++---- app/Commands/Dev/Anoma/Start/Options.hs | 25 ++++++++++++++++++++ app/Commands/Dev/Options.hs | 2 +- 6 files changed, 37 insertions(+), 37 deletions(-) delete mode 100644 app/Commands/Dev/Anoma/Node/Options.hs rename app/Commands/Dev/Anoma/{Node.hs => Start.hs} (62%) create mode 100644 app/Commands/Dev/Anoma/Start/Options.hs diff --git a/app/Commands/Dev/Anoma.hs b/app/Commands/Dev/Anoma.hs index ee5fc97b42..eab50b3c31 100644 --- a/app/Commands/Dev/Anoma.hs +++ b/app/Commands/Dev/Anoma.hs @@ -5,9 +5,9 @@ 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 runCommand :: (Members AppEffects r) => AnomaCommand -> Sem r () runCommand = \case - AnomaCommandNode opts -> Node.runCommand opts + AnomaCommandStart opts -> Start.runCommand opts diff --git a/app/Commands/Dev/Anoma/Node/Options.hs b/app/Commands/Dev/Anoma/Node/Options.hs deleted file mode 100644 index d6de83c919..0000000000 --- a/app/Commands/Dev/Anoma/Node/Options.hs +++ /dev/null @@ -1,25 +0,0 @@ -module Commands.Dev.Anoma.Node.Options where - -import Anoma.Client.Base -import CommonOptions - -data NodeOptions = NodeOptions - { _nodeAnomaPath :: AppPath Dir, - _nodeLaunchMode :: LaunchMode - } - deriving stock (Data) - -makeLenses ''NodeOptions - -parseNodeOptions :: Parser NodeOptions -parseNodeOptions = do - _nodeAnomaPath <- anomaDirOpt - _nodeLaunchMode <- - flag - LaunchModeAttached - LaunchModeDetached - ( long "background" - <> short 'b' - <> help "Launch the client in the background" - ) - pure NodeOptions {..} diff --git a/app/Commands/Dev/Anoma/Options.hs b/app/Commands/Dev/Anoma/Options.hs index df9d05f00e..d8ffe749dd 100644 --- a/app/Commands/Dev/Anoma/Options.hs +++ b/app/Commands/Dev/Anoma/Options.hs @@ -1,10 +1,10 @@ module Commands.Dev.Anoma.Options where -import Commands.Dev.Anoma.Node.Options +import Commands.Dev.Anoma.Start.Options import CommonOptions newtype AnomaCommand - = AnomaCommandNode NodeOptions + = AnomaCommandStart StartOptions deriving stock (Data) parseAnomaCommand :: Parser AnomaCommand @@ -20,5 +20,5 @@ parseAnomaCommand = runInfo :: ParserInfo AnomaCommand runInfo = info - (AnomaCommandNode <$> parseNodeOptions) - (progDesc "Run an Anoma node and client.") + (AnomaCommandStart <$> parseStartOptions) + (progDesc "Start an Anoma node and client.") diff --git a/app/Commands/Dev/Anoma/Node.hs b/app/Commands/Dev/Anoma/Start.hs similarity index 62% rename from app/Commands/Dev/Anoma/Node.hs rename to app/Commands/Dev/Anoma/Start.hs index 76f0facbdd..767a56488f 100644 --- a/app/Commands/Dev/Anoma/Node.hs +++ b/app/Commands/Dev/Anoma/Start.hs @@ -1,16 +1,16 @@ -module Commands.Dev.Anoma.Node where +module Commands.Dev.Anoma.Start where import Anoma.Effect import Commands.Base -import Commands.Dev.Anoma.Node.Options +import Commands.Dev.Anoma.Start.Options -runCommand :: forall r. (Members AppEffects r) => NodeOptions -> Sem r () +runCommand :: forall r. (Members AppEffects r) => StartOptions -> Sem r () runCommand opts = runAppError @SimpleError . runConcurrent . runProcess $ do - let launchMode = opts ^. nodeLaunchMode - anomaDir :: AnomaPath <- AnomaPath <$> fromAppPathDir (opts ^. nodeAnomaPath) + let launchMode = opts ^. startLaunchMode + anomaDir :: AnomaPath <- AnomaPath <$> fromAppPathDir (opts ^. startAnomaPath) processH <- launchAnomaClient launchMode anomaDir case launchMode of LaunchModeAttached -> void (waitForProcess processH) diff --git a/app/Commands/Dev/Anoma/Start/Options.hs b/app/Commands/Dev/Anoma/Start/Options.hs new file mode 100644 index 0000000000..84b604ca80 --- /dev/null +++ b/app/Commands/Dev/Anoma/Start/Options.hs @@ -0,0 +1,25 @@ +module Commands.Dev.Anoma.Start.Options where + +import Anoma.Client.Base +import CommonOptions + +data StartOptions = StartOptions + { _startAnomaPath :: AppPath Dir, + _startLaunchMode :: LaunchMode + } + deriving stock (Data) + +makeLenses ''StartOptions + +parseStartOptions :: Parser StartOptions +parseStartOptions = do + _startAnomaPath <- anomaDirOpt + _startLaunchMode <- + flag + LaunchModeAttached + LaunchModeDetached + ( long "background" + <> short 'b' + <> help "Start the client in the background" + ) + pure StartOptions {..} 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") From f8e2d68d9628958f7a98e931b8d659fcda2aaf01 Mon Sep 17 00:00:00 2001 From: Paul Cadman Date: Thu, 21 Nov 2024 13:29:33 +0000 Subject: [PATCH 3/5] Add anoma {stop, status} commands This PR makes the `juvix dev anoma {start, stop, status}` commands 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. --- app/Commands/Dev/Anoma.hs | 4 ++ app/Commands/Dev/Anoma/Client.hs | 17 +++++++ app/Commands/Dev/Anoma/Options.hs | 33 +++++++++++--- app/Commands/Dev/Anoma/Start.hs | 51 +++++++++++++++++---- app/Commands/Dev/Anoma/Start/Options.hs | 17 ++++--- app/Commands/Dev/Anoma/Status.hs | 12 +++++ app/Commands/Dev/Anoma/Stop.hs | 12 +++++ package.yaml | 1 + src/Anoma/Client/Base.hs | 30 +++++++++++-- src/Anoma/Client/Config.hs | 59 +++++++++++++++++++++++++ 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 | 13 ++++++ 14 files changed, 235 insertions(+), 22 deletions(-) create mode 100644 app/Commands/Dev/Anoma/Client.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/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 eab50b3c31..5652b27840 100644 --- a/app/Commands/Dev/Anoma.hs +++ b/app/Commands/Dev/Anoma.hs @@ -7,7 +7,11 @@ where import Commands.Base 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 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..d75e95527c --- /dev/null +++ b/app/Commands/Dev/Anoma/Client.hs @@ -0,0 +1,17 @@ +module Commands.Dev.Anoma.Client where + +import Anoma.Client.Config +import Commands.Base +import Data.Foldable.Extra qualified as E +import Juvix.Prelude.Posix + +isClientRunning :: (Members '[Files, EmbedIO] r) => ClientConfig -> Sem r Bool +isClientRunning = isProcessRunning . (^. clientConfigPid) + +checkClientRunning :: (Members '[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/Options.hs b/app/Commands/Dev/Anoma/Options.hs index d8ffe749dd..1659b44bdc 100644 --- a/app/Commands/Dev/Anoma/Options.hs +++ b/app/Commands/Dev/Anoma/Options.hs @@ -3,22 +3,45 @@ module Commands.Dev.Anoma.Options where import Commands.Dev.Anoma.Start.Options import CommonOptions -newtype AnomaCommand +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 (AnomaCommandStart <$> parseStartOptions) - (progDesc "Start an Anoma node and client.") + (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 index 767a56488f..dda7610e94 100644 --- a/app/Commands/Dev/Anoma/Start.hs +++ b/app/Commands/Dev/Anoma/Start.hs @@ -1,17 +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 - . runConcurrent . runProcess - $ do - let launchMode = opts ^. startLaunchMode - anomaDir :: AnomaPath <- AnomaPath <$> fromAppPathDir (opts ^. startAnomaPath) - processH <- launchAnomaClient launchMode anomaDir - case launchMode of - LaunchModeAttached -> void (waitForProcess processH) - LaunchModeDetached -> return () + $ 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 index 84b604ca80..b1c44aebd3 100644 --- a/app/Commands/Dev/Anoma/Start/Options.hs +++ b/app/Commands/Dev/Anoma/Start/Options.hs @@ -5,7 +5,8 @@ import CommonOptions data StartOptions = StartOptions { _startAnomaPath :: AppPath Dir, - _startLaunchMode :: LaunchMode + _startLaunchMode :: LaunchMode, + _startForce :: Bool } deriving stock (Data) @@ -16,10 +17,16 @@ parseStartOptions = do _startAnomaPath <- anomaDirOpt _startLaunchMode <- flag - LaunchModeAttached LaunchModeDetached - ( long "background" - <> short 'b' - <> help "Start the client in the background" + 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/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 index a9ac75236a..b34776fb40 100644 --- a/src/Anoma/Client/Base.hs +++ b/src/Anoma/Client/Base.hs @@ -4,18 +4,37 @@ 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 @@ -26,6 +45,7 @@ data LaunchMode makeLenses ''AnomaClientInfo makeLenses ''AnomaPath makeLenses ''AnomaProcess +makeLenses ''AnomaClientLaunchInfo anomaClientCreateProcess :: forall r. (Members '[Reader AnomaPath] r) => LaunchMode -> Sem r CreateProcess anomaClientCreateProcess launchMode = do @@ -58,11 +78,15 @@ setupAnomaClientProcess nodeOut = do } ) -launchAnomaClient :: (Members '[Logger, EmbedIO, Error SimpleError] r) => LaunchMode -> AnomaPath -> Sem r ProcessHandle +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 - setupAnomaClientProcess stdoutH + info <- setupAnomaClientProcess stdoutH hClose stdoutH - return procHandle + 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/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..d7639815cf --- /dev/null +++ b/src/Juvix/Prelude/Posix.hs @@ -0,0 +1,13 @@ +module Juvix.Prelude.Posix where + +import Control.Exception +import Juvix.Prelude.Base +import System.Posix.Signals + +terminateProcessPid :: (MonadIO m, Integral a) => a -> m () +terminateProcessPid = liftIO . signalProcess softwareTermination . fromIntegral + +isProcessRunning :: forall m a. (MonadIO m, Integral a) => a -> m Bool +isProcessRunning pid = do + result <- liftIO (try (signalProcess nullSignal (fromIntegral pid))) :: m (Either SomeException ()) + return (isRight result) From f3555177d780939189d2b0c3011d56ca9eb86330 Mon Sep 17 00:00:00 2001 From: Paul Cadman Date: Thu, 21 Nov 2024 13:47:40 +0000 Subject: [PATCH 4/5] Remove unused module --- src/Anoma/Client.hs | 3 --- 1 file changed, 3 deletions(-) delete mode 100644 src/Anoma/Client.hs diff --git a/src/Anoma/Client.hs b/src/Anoma/Client.hs deleted file mode 100644 index 676ee592b0..0000000000 --- a/src/Anoma/Client.hs +++ /dev/null @@ -1,3 +0,0 @@ -module Anoma.Client (module Anoma.Client.Base) where - -import Anoma.Client.Base From 8f7b6e6291530aa14bfda41e180197820d8e8ed9 Mon Sep 17 00:00:00 2001 From: Paul Cadman Date: Thu, 21 Nov 2024 17:19:53 +0000 Subject: [PATCH 5/5] Make a request to the Anoma client to check if it is running Querying the pid is error-prone because the pid may refer to a different process. --- app/Commands/Dev/Anoma/Client.hs | 10 +++++++--- src/Anoma/Effect/Base.hs | 34 +++++++++++++++++++++++++++++++- src/Juvix/Prelude/Posix.hs | 6 ------ 3 files changed, 40 insertions(+), 10 deletions(-) diff --git a/app/Commands/Dev/Anoma/Client.hs b/app/Commands/Dev/Anoma/Client.hs index d75e95527c..22110d302e 100644 --- a/app/Commands/Dev/Anoma/Client.hs +++ b/app/Commands/Dev/Anoma/Client.hs @@ -1,14 +1,18 @@ 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] r) => ClientConfig -> Sem r Bool -isClientRunning = isProcessRunning . (^. clientConfigPid) +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 '[Files, EmbedIO, Error SimpleError] r) => Sem r (Maybe ClientConfig) +checkClientRunning :: (Members '[Logger, Files, EmbedIO, Error SimpleError] r) => Sem r (Maybe ClientConfig) checkClientRunning = do mconfig <- readConfig E.findM isClientRunning mconfig diff --git a/src/Anoma/Effect/Base.hs b/src/Anoma/Effect/Base.hs index 7cb1e96051..89be357a34 100644 --- a/src/Anoma/Effect/Base.hs +++ b/src/Anoma/Effect/Base.hs @@ -5,6 +5,7 @@ module Anoma.Effect.Base ( Anoma, anomaRpc, + anomaListMethods, runAnomaEphemeral, runAnomaWithClient, module Anoma.Rpc.Base, @@ -16,14 +17,17 @@ 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.Prelude import Juvix.Prelude.Aeson (Value, eitherDecodeStrict, encode) 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 @@ -45,6 +49,19 @@ anomaRpc' method payload = do Right r -> return r Left err -> throw (SimpleError (mkAnsiText err)) +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 (^. anomaClientInfoPort) @@ -63,6 +80,19 @@ 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 <- anomaClientCreateProcess LaunchModeAttached @@ -71,6 +101,7 @@ runAnomaEphemeral anomapath body = runReader anomapath . runProcess $ do 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) => AnomaClientInfo -> Sem (Anoma ': r) a -> Sem r a runAnomaWithClient grpcInfo body = @@ -79,3 +110,4 @@ runAnomaWithClient grpcInfo body = $ (`interpret` inject body) $ \case AnomaRpc method i -> anomaRpc' method i + AnomaListMethods -> anomaListMethods' diff --git a/src/Juvix/Prelude/Posix.hs b/src/Juvix/Prelude/Posix.hs index d7639815cf..9ad66f3fab 100644 --- a/src/Juvix/Prelude/Posix.hs +++ b/src/Juvix/Prelude/Posix.hs @@ -1,13 +1,7 @@ module Juvix.Prelude.Posix where -import Control.Exception import Juvix.Prelude.Base import System.Posix.Signals terminateProcessPid :: (MonadIO m, Integral a) => a -> m () terminateProcessPid = liftIO . signalProcess softwareTermination . fromIntegral - -isProcessRunning :: forall m a. (MonadIO m, Integral a) => a -> m Bool -isProcessRunning pid = do - result <- liftIO (try (signalProcess nullSignal (fromIntegral pid))) :: m (Either SomeException ()) - return (isRight result)