SMP server CLI commands (#144)

SMP server CLI commands
2026-03-30 14:16:00 +00:00 · 2021-05-23 11:10:00 +01:00
parent 5b39f51203
commit 5962c1bb3e
2 changed files with 185 additions and 86 deletions
--- a/apps/smp-server/Main.hs
+++ b/apps/smp-server/Main.hs
@@ -7,36 +7,41 @@

 module Main where

-import Control.Monad (forM_, unless, when)
+import Control.Monad.Except
+import Control.Monad.Trans.Except
 import qualified Crypto.Store.PKCS8 as S
 import Data.ByteString.Base64 (encode)
 import qualified Data.ByteString.Char8 as B
 import Data.Char (toLower)
-import Data.Functor (($>))
-import Data.Ini (lookupValue, readIniFile)
+import Data.Ini (Ini, lookupValue, readIniFile)
+import Data.Text (Text)
 import qualified Data.Text as T
 import Data.X509 (PrivKey (PrivKeyRSA))
+import Network.Socket (ServiceName)
 import Options.Applicative
 import qualified Simplex.Messaging.Crypto as C
 import Simplex.Messaging.Server (runSMPServer)
 import Simplex.Messaging.Server.Env.STM
-import Simplex.Messaging.Server.StoreLog (StoreLog, openReadStoreLog)
+import Simplex.Messaging.Server.StoreLog (StoreLog, openReadStoreLog, storeLogFilePath)
 import Simplex.Messaging.Transport (ATransport (..), TCP, Transport (..))
 import Simplex.Messaging.Transport.WebSockets (WS)
-import System.Directory (createDirectoryIfMissing, doesFileExist)
+import System.Directory (createDirectoryIfMissing, doesFileExist, removeFile)
 import System.Exit (exitFailure)
 import System.FilePath (combine)
 import System.IO (IOMode (..), hFlush, stdout)

-cfg :: ServerConfig
-cfg =
+defaultServerPort :: ServiceName
+defaultServerPort = "5223"
+
+serverConfig :: ServerConfig
+serverConfig =
  ServerConfig
-    { transports = [("5223", transport @TCP), ("80", transport @WS)],
-      tbqSize = 16,
+    { tbqSize = 16,
      queueIdBytes = 12,
      msgIdBytes = 6,
-      storeLog = Nothing,
-      -- key is loaded from the file server_key in /etc/opt/simplex directory
+      -- below parameters are set based on ini file /etc/opt/simplex/smp-server.ini
+      transports = undefined,
+      storeLog = undefined,
      serverPrivateKey = undefined
    }

@@ -52,77 +57,162 @@ logDir = "/var/opt/simplex"
 defaultStoreLogFile :: FilePath
 defaultStoreLogFile = combine logDir "smp-server-store.log"

+iniFile :: FilePath
+iniFile = combine cfgDir "smp-server.ini"
+
+defaultKeyFile :: FilePath
+defaultKeyFile = combine cfgDir "server_key"
+
 main :: IO ()
 main = do
  opts <- getServerOpts
-  putStrLn "SMP Server (-h for help)"
-  ini <- readCreateIni opts
-  storeLog <- openStoreLog ini
-  pk <- readCreateKey
-  B.putStrLn $ "transport key hash: " <> serverKeyHash pk
+  case serverCommand opts of
+    ServerInit ->
+      runExceptT (getConfig opts) >>= \case
+        Right cfg -> do
+          putStrLn "Error: server is already initialized. Start it with `smp-server start` command"
+          printConfig cfg
+          exitFailure
+        Left _ -> do
+          cfg <- initializeServer opts
+          putStrLn "Server was initialized. Start it with `smp-server start` command"
+          printConfig cfg
+    ServerStart ->
+      runExceptT (getConfig opts) >>= \case
+        Right cfg -> runServer cfg
+        Left e -> do
+          putStrLn $ "Server is not initialized: " <> e
+          putStrLn "Initialize server with `smp-server init` command"
+          exitFailure
+    ServerDelete -> do
+      deleteServer
+      putStrLn "Server key, config file and store log deleted"
+
+getConfig :: ServerOpts -> ExceptT String IO ServerConfig
+getConfig opts = do
+  ini <- readIni
+  pk <- readKey ini
+  storeLog <- liftIO $ openStoreLog opts ini
+  pure $ makeConfig ini pk storeLog
+
+makeConfig :: IniOpts -> C.FullPrivateKey -> Maybe (StoreLog 'ReadMode) -> ServerConfig
+makeConfig IniOpts {serverPort, enableWebsockets} pk storeLog =
+  let transports = (serverPort, transport @TCP) : [("80", transport @WS) | enableWebsockets]
+   in serverConfig {serverPrivateKey = pk, storeLog, transports}
+
+printConfig :: ServerConfig -> IO ()
+printConfig ServerConfig {serverPrivateKey, storeLog} = do
+  B.putStrLn $ "transport key hash: " <> serverKeyHash serverPrivateKey
+  putStrLn $ case storeLog of
+    Just s -> "store log: " <> storeLogFilePath s
+    Nothing -> "store log disabled"
+
+initializeServer :: ServerOpts -> IO ServerConfig
+initializeServer opts = do
+  ini <- createIni opts
+  pk <- createKey ini
+  storeLog <- openStoreLog opts ini
+  pure $ makeConfig ini pk storeLog
+
+runServer :: ServerConfig -> IO ()
+runServer cfg = do
+  printConfig cfg
  forM_ (transports cfg) $ \(port, ATransport t) ->
    putStrLn $ "listening on port " <> port <> " (" <> transportName t <> ")"
-  runSMPServer cfg {serverPrivateKey = pk, storeLog}
+  runSMPServer cfg
+
+deleteServer :: IO ()
+deleteServer = do
+  ini <- runExceptT readIni
+  deleteIfExists iniFile
+  case ini of
+    Right IniOpts {storeLogFile, serverKeyFile} -> do
+      deleteIfExists storeLogFile
+      deleteIfExists serverKeyFile
+    Left _ -> do
+      deleteIfExists defaultKeyFile
+      deleteIfExists defaultStoreLogFile

 data IniOpts = IniOpts
  { enableStoreLog :: Bool,
-    storeLogFile :: FilePath
+    storeLogFile :: FilePath,
+    serverKeyFile :: FilePath,
+    serverPort :: ServiceName,
+    enableWebsockets :: Bool
  }

-readCreateIni :: ServerOpts -> IO IniOpts
-readCreateIni ServerOpts {configFile} = do
-  createDirectoryIfMissing True cfgDir
-  doesFileExist configFile >>= (`unless` createIni)
-  readIni
+readIni :: ExceptT String IO IniOpts
+readIni = do
+  fileExists iniFile
+  ini <- ExceptT $ readIniFile iniFile
+  let enableStoreLog = (== Right "on") $ lookupValue "STORE_LOG" "enable" ini
+      storeLogFile = opt defaultStoreLogFile "STORE_LOG" "file" ini
+      serverKeyFile = opt defaultKeyFile "TRANSPORT" "key_file" ini
+      serverPort = opt defaultServerPort "TRANSPORT" "port" ini
+      enableWebsockets = (== Right "on") $ lookupValue "TRANSPORT" "websockets" ini
+  pure IniOpts {enableStoreLog, storeLogFile, serverKeyFile, serverPort, enableWebsockets}
  where
-    readIni :: IO IniOpts
-    readIni = do
-      ini <- either exitError pure =<< readIniFile configFile
-      let enableStoreLog = (== Right "on") $ lookupValue "STORE_LOG" "enable" ini
-          storeLogFile = either (const defaultStoreLogFile) T.unpack $ lookupValue "STORE_LOG" "file" ini
-      pure IniOpts {enableStoreLog, storeLogFile}
-    exitError e = do
-      putStrLn $ "error reading config file " <> configFile <> ": " <> e
-      exitFailure
-    createIni :: IO ()
-    createIni = do
-      confirm $ "Save default ini file to " <> configFile
-      writeFile
-        configFile
-        "[STORE_LOG]\n\
-        \# The server uses STM memory to store SMP queues and messages,\n\
-        \# that will be lost on restart (e.g., as with redis).\n\
-        \# This option enables saving SMP queues to append only log,\n\
-        \# and restoring them when the server is started.\n\
-        \# Log is compacted on start (deleted queues are removed).\n\
-        \# The messages in the queues are not logged.\n\
-        \\n\
-        \# enable: on\n\
-        \# file: /var/opt/simplex/smp-server-store.log\n"
+    opt :: String -> Text -> Text -> Ini -> String
+    opt def section key ini = either (const def) T.unpack $ lookupValue section key ini

-readCreateKey :: IO C.FullPrivateKey
-readCreateKey = do
-  createDirectoryIfMissing True cfgDir
-  let path = combine cfgDir "server_key"
-  hasKey <- doesFileExist path
-  (if hasKey then readKey else createKey) path
+createIni :: ServerOpts -> IO IniOpts
+createIni ServerOpts {enableStoreLog} = do
+  writeFile iniFile $
+    "[STORE_LOG]\n\
+    \# The server uses STM memory to store SMP queues and messages,\n\
+    \# that will be lost on restart (e.g., as with redis).\n\
+    \# This option enables saving SMP queues to append only log,\n\
+    \# and restoring them when the server is started.\n\
+    \# Log is compacted on start (deleted queues are removed).\n\
+    \# The messages in the queues are not logged.\n\n"
+      <> (if enableStoreLog then "" else "# ")
+      <> "enable: on\n\
+         \# file: "
+      <> defaultStoreLogFile
+      <> "\n\n\
+         \[TRANSPORT]\n\n\
+         \# key_file: "
+      <> defaultKeyFile
+      <> "\n\
+         \# port: "
+      <> defaultServerPort
+      <> "\n\
+         \websockets: on\n"
+  pure
+    IniOpts
+      { enableStoreLog,
+        storeLogFile = defaultStoreLogFile,
+        serverKeyFile = defaultKeyFile,
+        serverPort = defaultServerPort,
+        enableWebsockets = True
+      }
+
+readKey :: IniOpts -> ExceptT String IO C.FullPrivateKey
+readKey IniOpts {serverKeyFile} = do
+  fileExists serverKeyFile
+  liftIO (S.readKeyFile serverKeyFile) >>= \case
+    [S.Unprotected (PrivKeyRSA pk)] -> pure $ C.FullPrivateKey pk
+    [_] -> err "not RSA key"
+    [] -> err "invalid key file format"
+    _ -> err "more than one key"
  where
-    createKey :: FilePath -> IO C.FullPrivateKey
-    createKey path = do
-      confirm "Generate new server key pair"
-      (_, pk) <- C.generateKeyPair newKeySize
-      S.writeKeyFile S.TraditionalFormat path [PrivKeyRSA $ C.rsaPrivateKey pk]
-      pure pk
-    readKey :: FilePath -> IO C.FullPrivateKey
-    readKey path = do
-      S.readKeyFile path >>= \case
-        [S.Unprotected (PrivKeyRSA pk)] -> pure $ C.FullPrivateKey pk
-        [_] -> errorExit "not RSA key"
-        [] -> errorExit "invalid key file format"
-        _ -> errorExit "more than one key"
-      where
-        errorExit :: String -> IO b
-        errorExit e = putStrLn (e <> ": " <> path) >> exitFailure
+    err :: String -> ExceptT String IO b
+    err e = throwE $ e <> ": " <> serverKeyFile
+
+createKey :: IniOpts -> IO C.FullPrivateKey
+createKey IniOpts {serverKeyFile} = do
+  createDirectoryIfMissing True cfgDir
+  (_, pk) <- C.generateKeyPair newKeySize
+  S.writeKeyFile S.TraditionalFormat serverKeyFile [PrivKeyRSA $ C.rsaPrivateKey pk]
+  pure pk
+
+fileExists :: FilePath -> ExceptT String IO ()
+fileExists path = do
+  exists <- liftIO $ doesFileExist path
+  unless exists . throwE $ "file " <> path <> " not found"
+
+deleteIfExists :: FilePath -> IO ()
+deleteIfExists path = doesFileExist path >>= (`when` removeFile path)

 confirm :: String -> IO ()
 confirm msg = do
@@ -134,38 +224,41 @@ confirm msg = do
 serverKeyHash :: C.FullPrivateKey -> B.ByteString
 serverKeyHash = encode . C.unKeyHash . C.publicKeyHash . C.publicKey

-openStoreLog :: IniOpts -> IO (Maybe (StoreLog 'ReadMode))
-openStoreLog IniOpts {enableStoreLog, storeLogFile = f}
-  | enableStoreLog = do
+openStoreLog :: ServerOpts -> IniOpts -> IO (Maybe (StoreLog 'ReadMode))
+openStoreLog ServerOpts {enableStoreLog = l} IniOpts {enableStoreLog = l', storeLogFile = f}
+  | l || l' = do
    createDirectoryIfMissing True logDir
-    putStrLn ("store log: " <> f)
    Just <$> openReadStoreLog f
-  | otherwise = putStrLn "store log disabled" $> Nothing
+  | otherwise = pure Nothing

-newtype ServerOpts = ServerOpts
-  { configFile :: FilePath
+data ServerOpts = ServerOpts
+  { serverCommand :: ServerCommand,
+    enableStoreLog :: Bool
  }

+data ServerCommand = ServerInit | ServerStart | ServerDelete
+
 serverOpts :: Parser ServerOpts
 serverOpts =
  ServerOpts
-    <$> strOption
-      ( long "config"
-          <> short 'c'
-          <> metavar "INI_FILE"
-          <> help ("config file (" <> defaultIniFile <> ")")
-          <> value defaultIniFile
+    <$> subparser
+      ( command "init" (info (pure ServerInit) (progDesc "Initialize server: generate server key and ini file"))
+          <> command "start" (info (pure ServerStart) (progDesc "Start server (ini: /etc/opt/simplex/smp-server.ini)"))
+          <> command "delete" (info (pure ServerDelete) (progDesc "Delete server key, ini file and store log"))
+      )
+    <*> switch
+      ( long "store-log"
+          <> short 'l'
+          <> help "enable store log for SMP queues persistence"
      )
-  where
-    defaultIniFile = combine cfgDir "smp-server.ini"

 getServerOpts :: IO ServerOpts
-getServerOpts = execParser opts
+getServerOpts = customExecParser p opts
  where
+    p = prefs showHelpOnEmpty
    opts =
      info
        (serverOpts <**> helper)
        ( fullDesc
            <> header "Simplex Messaging Protocol (SMP) Server"
-            <> progDesc "Start server with INI_FILE (created on first run)"
        )
--- a/src/Simplex/Messaging/Server/StoreLog.hs
+++ b/src/Simplex/Messaging/Server/StoreLog.hs
@@ -10,6 +10,7 @@ module Simplex.Messaging.Server.StoreLog
  ( StoreLog, -- constructors are not exported
    openWriteStoreLog,
    openReadStoreLog,
+    storeLogFilePath,
    closeStoreLog,
    logCreateQueue,
    logSecureQueue,
@@ -88,6 +89,11 @@ openReadStoreLog f = do
  doesFileExist f >>= (`unless` writeFile f "")
  ReadStoreLog f <$> openFile f ReadMode

+storeLogFilePath :: StoreLog a -> FilePath
+storeLogFilePath = \case
+  WriteStoreLog f _ -> f
+  ReadStoreLog f _ -> f
+
 closeStoreLog :: StoreLog a -> IO ()
 closeStoreLog = \case
  WriteStoreLog _ h -> hClose h