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)