Add juvix dev anoma {start, stop, status} to manage an Anoma client

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

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)

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")

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
+              }

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 {..}

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

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

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

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")

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.*

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
+      }