refactor server Main.hs (#248)

apps/smp-server/Main.hs

@@ -8,12 +8,11 @@
 module Main where
 
 import Control.Monad.Except
-import Control.Monad.Trans.Except
 import qualified Data.ByteString.Char8 as B
-import Data.Char (toLower)
+import Data.Composition ((.:))
+import Data.Either (fromRight)
 import Data.Ini (Ini, lookupValue, readIniFile)
 import Data.List (dropWhileEnd)
-import Data.Text (Text)
 import qualified Data.Text as T
 import Network.Socket (ServiceName)
 import Options.Applicative
@@ -22,147 +21,254 @@ import Simplex.Messaging.Server.Env.STM
 import Simplex.Messaging.Server.StoreLog (StoreLog, openReadStoreLog, storeLogFilePath)
 import Simplex.Messaging.Transport (ATransport (..), TLS, Transport (..), encodeFingerprint, loadFingerprint, simplexMQVersion)
 import Simplex.Messaging.Transport.WebSockets (WS)
-import System.Directory (createDirectoryIfMissing, doesDirectoryExist, doesFileExist, removeDirectoryRecursive, removeFile)
+import System.Directory (createDirectoryIfMissing, doesDirectoryExist, doesFileExist, removeDirectoryRecursive)
 import System.Exit (exitFailure)
 import System.FilePath (combine)
-import System.IO (IOMode (..), hFlush, stdout)
+import System.IO (IOMode (..))
 import System.Process (readCreateProcess, shell)
 
-defaultServerPort :: ServiceName
-defaultServerPort = "5223"
-
-serverConfig :: ServerConfig
-serverConfig =
-  ServerConfig
-    { tbqSize = 16,
-      serverTbqSize = 128,
-      msgQueueQuota = 256,
-      queueIdBytes = 24,
-      msgIdBytes = 24, -- must be at least 24 bytes, it is used as 192-bit nonce for XSalsa20
-      -- below parameters are set based on ini file /etc/opt/simplex/smp-server.ini
-      transports = undefined,
-      storeLog = undefined,
-      caCertificateFile = undefined,
-      serverPrivateKeyFile = undefined,
-      serverCertificateFile = undefined
-    }
-
-newKeySize :: Int
-newKeySize = 2048 `div` 8
-
 cfgDir :: FilePath
 cfgDir = "/etc/opt/simplex"
 
 logDir :: FilePath
 logDir = "/var/opt/simplex"
 
--- TODO remove file paths from ini
-defaultStoreLogFile :: FilePath
-defaultStoreLogFile = combine logDir "smp-server-store.log"
-
 iniFile :: FilePath
 iniFile = combine cfgDir "smp-server.ini"
 
-caPrivateKeyFile :: FilePath
-caPrivateKeyFile = combine cfgDir "ca.key"
+storeLogFile :: FilePath
+storeLogFile = combine logDir "smp-server-store.log"
 
-defaultCACertificateFile :: FilePath
-defaultCACertificateFile = combine cfgDir "ca.crt"
+caKeyFile :: FilePath
+caKeyFile = combine cfgDir "ca.key"
 
-defaultPrivateKeyFile :: FilePath
-defaultPrivateKeyFile = combine cfgDir "server.key"
+caCrtFile :: FilePath
+caCrtFile = combine cfgDir "ca.crt"
 
-defaultCertificateFile :: FilePath
-defaultCertificateFile = combine cfgDir "server.crt"
+serverKeyFile :: FilePath
+serverKeyFile = combine cfgDir "server.key"
+
+serverCrtFile :: FilePath
+serverCrtFile = combine cfgDir "server.crt"
 
 fingerprintFile :: FilePath
 fingerprintFile = combine cfgDir "fingerprint"
 
 main :: IO ()
 main = do
-  opts <- getServerOpts
-  checkPubkeyAlgorihtm $ pubkeyAlgorihtm opts
-  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"
-          fingerprint <- loadSavedFingerprint
-          printConfig cfg fingerprint
-          checkCAPrivateKeyFile
-          exitFailure
-        Left _ -> do
-          cfg <- initializeServer opts
-          putStrLn "Server was initialized. Start it with `smp-server start` command"
-          fingerprint <- loadSavedFingerprint
-          printConfig cfg fingerprint
-          warnCAPrivateKeyFile
-    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 configuration and log files deleted"
+  getCliOptions >>= \opts -> case optCommand opts of
+    Init initOptions@InitOptions {pubkeyAlgorithm} -> do
+      -- TODO check during parsing
+      checkPubkeyAlgorithm pubkeyAlgorithm
+      doesFileExist iniFile >>= \case
+        True -> iniAlreadyExistsErr >> exitFailure
+        False -> initializeServer initOptions
+    Start -> do
+      doesFileExist iniFile >>= \case
+        False -> iniDoesNotExistErr >> exitFailure
+        True -> readIniFile iniFile >>= either (\e -> putStrLn e >> exitFailure) (runServer . mkIniOptions)
+    Delete -> cleanup >> putStrLn "Deleted configuration and log files"
   where
-    checkPubkeyAlgorihtm :: String -> IO ()
-    checkPubkeyAlgorihtm alg
+    checkPubkeyAlgorithm alg
       | alg == "ED448" || alg == "ED25519" = pure ()
-      | otherwise = putStrLn ("unsupported public-key algorithm " <> alg) >> exitFailure
+      | otherwise = putStrLn ("Unsupported public key algorithm " <> alg) >> exitFailure
+    iniAlreadyExistsErr = putStrLn $ "Error: server is already initialized (" <> iniFile <> " exists).\nRun `smp-server start`."
+    iniDoesNotExistErr = putStrLn $ "Error: server is not initialized (" <> iniFile <> " does not exist).\nRun `smp-server init`."
 
-getConfig :: ServerOpts -> ExceptT String IO ServerConfig
-getConfig opts = do
-  ini <- readIni
-  storeLog <- liftIO $ openStoreLog opts ini
-  pure $ makeConfig ini storeLog
+newtype CliOptions = CliOptions {optCommand :: Command}
 
-makeConfig :: IniOpts -> Maybe (StoreLog 'ReadMode) -> ServerConfig
-makeConfig IniOpts {serverPort, enableWebsockets, caCertificateFile, serverPrivateKeyFile, serverCertificateFile} storeLog =
-  let transports = (serverPort, transport @TLS) : [("80", transport @WS) | enableWebsockets]
-   in serverConfig {transports, storeLog, caCertificateFile, serverPrivateKeyFile, serverCertificateFile}
+data Command
+  = Init InitOptions
+  | Start
+  | Delete
 
-printConfig :: ServerConfig -> String -> IO ()
-printConfig ServerConfig {storeLog} fingerprint = do
-  putStrLn $ "SMP server v" <> simplexMQVersion
-  putStrLn $ "fingerprint: " <> fingerprint
-  putStrLn $ case storeLog of
-    Just s -> "store log: " <> storeLogFilePath s
-    Nothing -> "store log disabled"
+data InitOptions = InitOptions
+  { enableStoreLog :: Bool,
+    pubkeyAlgorithm :: String
+  }
 
-initializeServer :: ServerOpts -> IO ServerConfig
-initializeServer opts = do
+getCliOptions :: IO CliOptions
+getCliOptions =
+  customExecParser
+    (prefs showHelpOnEmpty)
+    ( info
+        (helper <*> versionOption <*> cliOptionsP)
+        (header version <> fullDesc)
+    )
+  where
+    versionOption = infoOption version (long "version" <> short 'v' <> help "Show version")
+
+cliOptionsP :: Parser CliOptions
+cliOptionsP =
+  CliOptions
+    <$> hsubparser
+      ( command "init" (info initP (progDesc $ "Initialize server - creates " <> cfgDir <> " and " <> logDir <> " directories and configuration files"))
+          <> command "start" (info (pure Start) (progDesc $ "Start server (configuration: " <> iniFile <> ")"))
+          <> command "delete" (info (pure Delete) (progDesc "Delete configuration and log files"))
+      )
+  where
+    initP :: Parser Command
+    initP =
+      Init .: InitOptions
+        <$> switch
+          ( long "store-log"
+              <> short 'l'
+              <> help "Enable store log for SMP queues persistence"
+          )
+        <*> strOption
+          ( long "pubkey-algorithm"
+              <> short 'a'
+              <> help "Public key algorithm used for certificate generation: ED25519, ED448"
+              <> value "ED448"
+              <> showDefault
+              <> metavar "ALG"
+          )
+
+initializeServer :: InitOptions -> IO ()
+initializeServer InitOptions {enableStoreLog, pubkeyAlgorithm} = do
+  cleanup
   createDirectoryIfMissing True cfgDir
-  ini <- createIni opts
-  createX509 ini opts
-  saveFingerprint $ caCertificateFile (ini :: IniOpts)
-  storeLog <- openStoreLog opts ini
-  pure $ makeConfig ini storeLog
+  createDirectoryIfMissing True logDir
+  createX509
+  saveFingerprint
+  createIni
+  putStrLn $ "Server initialized, you can modify configuration in " <> iniFile <> ".\nRun `smp-server start` to start server."
+  printServiceInfo
+  warnCAPrivateKeyFile
+  where
+    createX509 = do
+      createOpensslConf
+      -- CA certificate (identity/offline)
+      run $ "openssl genpkey -algorithm " <> pubkeyAlgorithm <> " -out " <> caKeyFile
+      run $ "openssl req -new -x509 -days 999999 -config " <> opensslCnfFile <> " -extensions v3_ca -key " <> caKeyFile <> " -out " <> caCrtFile
+      -- server certificate (online)
+      run $ "openssl genpkey -algorithm " <> pubkeyAlgorithm <> " -out " <> serverKeyFile
+      run $ "openssl req -new -config " <> opensslCnfFile <> " -reqexts v3_req -key " <> serverKeyFile <> " -out " <> serverCsrFile
+      run $ "openssl x509 -req -days 999999 -copy_extensions copy -in " <> serverCsrFile <> " -CA " <> caCrtFile <> " -CAkey " <> caKeyFile <> " -out " <> serverCrtFile
+      where
+        run cmd = void $ readCreateProcess (shell cmd) ""
+        opensslCnfFile = combine cfgDir "openssl.cnf"
+        serverCsrFile = combine cfgDir "server.csr"
+        createOpensslConf =
+          -- TODO revise https://www.rfc-editor.org/rfc/rfc5280#section-4.2.1.3, https://www.rfc-editor.org/rfc/rfc3279#section-2.3.5
+          writeFile
+            opensslCnfFile
+            "[req]\n\
+            \distinguished_name = req_distinguished_name\n\
+            \prompt = no\n\n\
+            \[req_distinguished_name]\n\
+            \CN = localhost\n\n\
+            \[v3_ca]\n\
+            \subjectKeyIdentifier = hash\n\
+            \authorityKeyIdentifier = keyid:always\n\
+            \basicConstraints = critical,CA:true\n\n\
+            \[v3_req]\n\
+            \basicConstraints = CA:FALSE\n\
+            \keyUsage = digitalSignature, nonRepudiation, keyAgreement\n\
+            \extendedKeyUsage = serverAuth\n"
 
-runServer :: ServerConfig -> IO ()
-runServer cfg = do
-  savedFingerprint <- loadSavedFingerprint
-  checkSavedFingerprint savedFingerprint
-  printConfig cfg savedFingerprint
+    saveFingerprint = do
+      fingerprint <- loadFingerprint caCrtFile
+      writeFile fingerprintFile $ (B.unpack . encodeFingerprint) fingerprint <> "\n"
+
+    createIni = 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"
+          <> ("enable: " <> (if enableStoreLog then "on" else "off # on") <> "\n\n")
+          <> "[TRANSPORT]\n\
+             \port: 5223\n\
+             \websockets: on\n"
+
+data IniOptions = IniOptions
+  { enableStoreLog :: Bool,
+    port :: ServiceName,
+    enableWebsockets :: Bool
+  }
+
+-- TODO ? properly parse ini as a whole
+mkIniOptions :: Ini -> IniOptions
+mkIniOptions ini =
+  IniOptions
+    { enableStoreLog = (== "on") $ strict "STORE_LOG" "enable",
+      port = T.unpack $ strict "TRANSPORT" "port",
+      enableWebsockets = (== "on") $ strict "TRANSPORT" "websockets"
+    }
+  where
+    strict :: String -> String -> T.Text
+    strict section key =
+      fromRight (error ("no key " <> key <> " in section " <> section)) $
+        lookupValue (T.pack section) (T.pack key) ini
+
+runServer :: IniOptions -> IO ()
+runServer IniOptions {enableStoreLog, port, enableWebsockets} = do
+  checkSavedFingerprint
+  printServiceInfo
   checkCAPrivateKeyFile
-  forM_ (transports cfg) $ \(port, ATransport t) ->
-    putStrLn $ "listening on port " <> port <> " (" <> transportName t <> ")"
+  cfg <- setupServerConfig
+  printServerConfig cfg
   runSMPServer cfg
   where
-    checkSavedFingerprint :: String -> IO ()
-    checkSavedFingerprint savedFingerprint = do
-      fingerprint <- loadFingerprint $ caCertificateFile (cfg :: ServerConfig)
-      if savedFingerprint == (B.unpack . encodeFingerprint) fingerprint
-        then putStrLn "stored fingerprint is valid"
-        else putStrLn "stored fingerprint is invalid" >> exitFailure
+    checkSavedFingerprint = do
+      savedFingerprint <- loadSavedFingerprint
+      fingerprint <- loadFingerprint caCrtFile
+      when (savedFingerprint /= (B.unpack . encodeFingerprint) fingerprint) $
+        putStrLn "Stored fingerprint is invalid." >> exitFailure
 
-checkCAPrivateKeyFile :: IO ()
-checkCAPrivateKeyFile =
-  doesFileExist caPrivateKeyFile >>= (`when` (alert >> warnCAPrivateKeyFile))
+    checkCAPrivateKeyFile =
+      doesFileExist caKeyFile >>= (`when` (alert >> warnCAPrivateKeyFile))
+      where
+        alert = putStrLn $ "WARNING: " <> caKeyFile <> " is present on the server!"
+
+    setupServerConfig = do
+      storeLog <- openStoreLog
+      let transports = (port, transport @TLS) : [("80", transport @WS) | enableWebsockets]
+      pure
+        ServerConfig
+          { tbqSize = 16,
+            serverTbqSize = 128,
+            msgQueueQuota = 256,
+            queueIdBytes = 24,
+            msgIdBytes = 24, -- must be at least 24 bytes, it is used as 192-bit nonce for XSalsa20
+            caCertificateFile = caCrtFile,
+            privateKeyFile = serverKeyFile,
+            certificateFile = serverCrtFile,
+            transports,
+            storeLog
+          }
+      where
+        openStoreLog :: IO (Maybe (StoreLog 'ReadMode))
+        openStoreLog
+          | enableStoreLog = Just <$> openReadStoreLog storeLogFile
+          | otherwise = pure Nothing
+
+    printServerConfig ServerConfig {storeLog, transports} = do
+      putStrLn $ case storeLog of
+        Just s -> "Store log: " <> storeLogFilePath s
+        Nothing -> "Store log disabled."
+      forM_ transports $ \(p, ATransport t) ->
+        putStrLn $ "Listening on port " <> p <> " (" <> transportName t <> ")..."
+
+cleanup :: IO ()
+cleanup = do
+  deleteDirIfExists cfgDir
+  deleteDirIfExists logDir
   where
-    alert = putStrLn $ "WARNING: " <> caPrivateKeyFile <> " is present on the server!"
+    deleteDirIfExists path = doesDirectoryExist path >>= (`when` removeDirectoryRecursive path)
+
+printServiceInfo :: IO ()
+printServiceInfo = do
+  putStrLn version
+  fingerprint <- loadSavedFingerprint
+  putStrLn $ "Fingerprint: " <> fingerprint
+
+version :: String
+version = "SMP server v" <> simplexMQVersion
 
 warnCAPrivateKeyFile :: IO ()
 warnCAPrivateKeyFile =
@@ -171,200 +277,10 @@ warnCAPrivateKeyFile =
     \We highly recommend to remove CA private key file from the server and keep it securely in place of your choosing.\n\
     \In case server's TLS credential is compromised you will be able to regenerate it using this key,\n\
     \thus keeping server's identity and allowing clients to keep established connections. Key location:\n"
-      <> caPrivateKeyFile
+      <> caKeyFile
       <> "\n----------"
 
-deleteServer :: IO ()
-deleteServer = do
-  ini <- runExceptT readIni
-  deleteIfExists iniFile
-  case ini of
-    -- TODO delete only cfgDir and logDir once file paths are removed from ini
-    Right IniOpts {storeLogFile, caCertificateFile, serverPrivateKeyFile, serverCertificateFile} -> do
-      deleteDirIfExists cfgDir
-      deleteIfExists storeLogFile
-      deleteIfExists caCertificateFile
-      deleteIfExists serverPrivateKeyFile
-      deleteIfExists serverCertificateFile
-    Left _ -> do
-      deleteDirIfExists cfgDir
-      deleteIfExists defaultStoreLogFile
-      deleteIfExists defaultCACertificateFile
-      deleteIfExists defaultPrivateKeyFile
-      deleteIfExists defaultCertificateFile
-
-data IniOpts = IniOpts
-  { enableStoreLog :: Bool,
-    storeLogFile :: FilePath,
-    serverPort :: ServiceName,
-    enableWebsockets :: Bool,
-    caCertificateFile :: FilePath,
-    serverPrivateKeyFile :: FilePath,
-    serverCertificateFile :: FilePath
-  }
-
-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
-      serverPort = opt defaultServerPort "TRANSPORT" "port" ini
-      enableWebsockets = (== Right "on") $ lookupValue "TRANSPORT" "websockets" ini
-      caCertificateFile = opt defaultCACertificateFile "TRANSPORT" "ca_certificate_file" ini
-      serverPrivateKeyFile = opt defaultPrivateKeyFile "TRANSPORT" "private_key_file" ini
-      serverCertificateFile = opt defaultCertificateFile "TRANSPORT" "certificate_file" ini
-  pure IniOpts {enableStoreLog, storeLogFile, serverPort, enableWebsockets, caCertificateFile, serverPrivateKeyFile, serverCertificateFile}
-  where
-    opt :: String -> Text -> Text -> Ini -> String
-    opt def section key ini = either (const def) T.unpack $ lookupValue section key ini
-
-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\
-         \# ca_certificate_file: "
-      <> defaultCACertificateFile
-      <> "\n\
-         \# private_key_file: "
-      <> defaultPrivateKeyFile
-      <> "\n\
-         \# certificate_file: "
-      <> defaultCertificateFile
-      <> "\n\
-         \# port: "
-      <> defaultServerPort
-      <> "\n\
-         \websockets: on\n"
-  pure
-    IniOpts
-      { enableStoreLog,
-        storeLogFile = defaultStoreLogFile,
-        serverPort = defaultServerPort,
-        enableWebsockets = True,
-        caCertificateFile = defaultCACertificateFile,
-        serverPrivateKeyFile = defaultPrivateKeyFile,
-        serverCertificateFile = defaultCertificateFile
-      }
-
-createX509 :: IniOpts -> ServerOpts -> IO ()
-createX509 IniOpts {caCertificateFile, serverPrivateKeyFile, serverCertificateFile} ServerOpts {pubkeyAlgorihtm} = do
-  createOpensslConf
-  -- CA certificate (identity/offline)
-  run $ "openssl genpkey -algorithm " <> pubkeyAlgorihtm <> " -out " <> caPrivateKeyFile
-  run $ "openssl req -new -x509 -days 999999 -config " <> opensslConfFile <> " -extensions v3_ca -key " <> caPrivateKeyFile <> " -out " <> caCertificateFile
-  -- server certificate (online)
-  run $ "openssl genpkey -algorithm " <> pubkeyAlgorihtm <> " -out " <> serverPrivateKeyFile
-  run $ "openssl req -new -config " <> opensslConfFile <> " -reqexts v3_req -key " <> serverPrivateKeyFile <> " -out " <> serverCsrFile
-  run $ "openssl x509 -req -days 999999 -copy_extensions copy -in " <> serverCsrFile <> " -CA " <> caCertificateFile <> " -CAkey " <> caPrivateKeyFile <> " -out " <> serverCertificateFile
-  where
-    run cmd = void $ readCreateProcess (shell cmd) ""
-    opensslConfFile = combine cfgDir "openssl.cnf"
-    serverCsrFile = combine cfgDir "server.csr"
-    createOpensslConf :: IO ()
-    createOpensslConf =
-      -- TODO revise https://www.rfc-editor.org/rfc/rfc5280#section-4.2.1.3, https://www.rfc-editor.org/rfc/rfc3279#section-2.3.5
-      writeFile
-        opensslConfFile
-        "[req]\n\
-        \distinguished_name = req_distinguished_name\n\
-        \prompt = no\n\n\
-        \[req_distinguished_name]\n\
-        \CN = localhost\n\n\
-        \[v3_ca]\n\
-        \subjectKeyIdentifier = hash\n\
-        \authorityKeyIdentifier = keyid:always\n\
-        \basicConstraints = critical,CA:true\n\n\
-        \[v3_req]\n\
-        \basicConstraints = CA:FALSE\n\
-        \keyUsage = digitalSignature, nonRepudiation, keyAgreement\n\
-        \extendedKeyUsage = serverAuth\n"
-
-saveFingerprint :: FilePath -> IO ()
-saveFingerprint caCertificateFile = do
-  fingerprint <- loadFingerprint caCertificateFile
-  writeFile fingerprintFile $ (B.unpack . encodeFingerprint) fingerprint <> "\n"
-
 loadSavedFingerprint :: IO String
 loadSavedFingerprint = do
-  fingerpint <- readFile fingerprintFile
-  pure $ dropWhileEnd (== '\n') fingerpint
-
-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)
-
-deleteDirIfExists :: FilePath -> IO ()
-deleteDirIfExists path = doesDirectoryExist path >>= (`when` removeDirectoryRecursive path)
-
-confirm :: String -> IO ()
-confirm msg = do
-  putStr $ msg <> " (y/N): "
-  hFlush stdout
-  ok <- getLine
-  when (map toLower ok /= "y") exitFailure
-
-openStoreLog :: ServerOpts -> IniOpts -> IO (Maybe (StoreLog 'ReadMode))
-openStoreLog ServerOpts {enableStoreLog = l} IniOpts {enableStoreLog = l', storeLogFile = f}
-  | l || l' = do
-    createDirectoryIfMissing True logDir
-    Just <$> openReadStoreLog f
-  | otherwise = pure Nothing
-
-data ServerOpts = ServerOpts
-  { serverCommand :: ServerCommand,
-    enableStoreLog :: Bool,
-    pubkeyAlgorihtm :: String
-  }
-
-data ServerCommand = ServerInit | ServerStart | ServerDelete
-
-serverOpts :: Parser ServerOpts
-serverOpts =
-  ServerOpts
-    <$> 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"
-      )
-    <*> strOption
-      ( long "pubkey-algorithm"
-          <> short 'a'
-          <> help
-            ( "public-key algorithm used for certificate generation,"
-                <> "\nsupported algorithms: ED448 (default) and ED25519"
-            )
-          <> value "ED448"
-      )
-
-getServerOpts :: IO ServerOpts
-getServerOpts = customExecParser p opts
-  where
-    p = prefs showHelpOnEmpty
-    opts =
-      info
-        (serverOpts <**> helper)
-        ( fullDesc
-            <> header "Simplex Messaging Protocol (SMP) Server"
-        )
+  fingerprint <- readFile fingerprintFile
+  pure $ dropWhileEnd (== '\n') fingerprint

scripts/smp-server-digitalocean-droplet/scripts/03-init-start.sh

@@ -2,10 +2,8 @@
 
 bin_dir="/opt/simplex/bin"
 conf_dir="/etc/opt/simplex"
-var_dir="/var/opt/simplex"
+
 mkdir -p $bin_dir
-mkdir -p $conf_dir
-mkdir -p $var_dir
 
 echo "downloading the latest SMP server release"
 curl -s https://api.github.com/repos/simplex-chat/simplexmq/releases/latest > release.json

scripts/smp-server-linode.sh

@@ -23,10 +23,8 @@ ufw allow 5223
 
 bin_dir="/opt/simplex/bin"
 conf_dir="/etc/opt/simplex"
-var_dir="/var/opt/simplex"
+
 mkdir -p $bin_dir
-mkdir -p $conf_dir
-mkdir -p $var_dir
 
 # retrieve latest release info and download smp-server executable
 curl -s https://api.github.com/repos/simplex-chat/simplexmq/releases/latest > release.json

src/Simplex/Messaging/Agent.hs

@@ -108,13 +108,13 @@ runSMPAgent t cfg = do
 -- This function uses passed TMVar to signal when the server is ready to accept TCP requests (True)
 -- and when it is disconnected from the TCP socket once the server thread is killed (False).
 runSMPAgentBlocking :: (MonadRandom m, MonadUnliftIO m) => ATransport -> TMVar Bool -> AgentConfig -> m ()
-runSMPAgentBlocking (ATransport t) started cfg@AgentConfig {tcpPort, caCertificateFile, agentCertificateFile, agentPrivateKeyFile} = do
+runSMPAgentBlocking (ATransport t) started cfg@AgentConfig {tcpPort, caCertificateFile, certificateFile, privateKeyFile} = do
   runReaderT (smpAgent t) =<< newSMPAgentEnv cfg
   where
     smpAgent :: forall c m'. (Transport c, MonadUnliftIO m', MonadReader Env m') => TProxy c -> m' ()
     smpAgent _ = do
-      -- tlsServerParams not in env to avoid breaking functional api w/t key and certificate generation
-      tlsServerParams <- liftIO $ loadTLSServerParams caCertificateFile agentCertificateFile agentPrivateKeyFile
+      -- tlsServerParams is not in Env to avoid breaking functional API w/t key and certificate generation
+      tlsServerParams <- liftIO $ loadTLSServerParams caCertificateFile certificateFile privateKeyFile
       runTransportServer started tcpPort tlsServerParams $ \(h :: c) -> do
         liftIO . putLn h $ "Welcome to SMP agent v" <> B.pack simplexMQVersion
         c <- getAgentClient

src/Simplex/Messaging/Agent/Env/SQLite.hs

@@ -32,8 +32,8 @@ data AgentConfig = AgentConfig
     retryInterval :: RetryInterval,
     reconnectInterval :: RetryInterval,
     caCertificateFile :: FilePath,
-    agentPrivateKeyFile :: FilePath,
-    agentCertificateFile :: FilePath
+    privateKeyFile :: FilePath,
+    certificateFile :: FilePath
   }
 
 minute :: Int
@@ -62,10 +62,11 @@ defaultAgentConfig =
             increaseAfter = 10_000_000,
             maxInterval = 10_000_000
           },
+      -- CA certificate private key is not needed for initialization
       -- ! we do not generate these
       caCertificateFile = "/etc/opt/simplex-agent/ca.crt",
-      agentPrivateKeyFile = "/etc/opt/simplex-agent/agent.key",
-      agentCertificateFile = "/etc/opt/simplex-agent/agent.crt"
+      privateKeyFile = "/etc/opt/simplex-agent/agent.key",
+      certificateFile = "/etc/opt/simplex-agent/agent.crt"
     }
 
 data Env = Env

src/Simplex/Messaging/Server/Env/STM.hs

@@ -31,9 +31,10 @@ data ServerConfig = ServerConfig
     queueIdBytes :: Int,
     msgIdBytes :: Int,
     storeLog :: Maybe (StoreLog 'ReadMode),
+    -- CA certificate private key is not needed for initialization
     caCertificateFile :: FilePath,
-    serverPrivateKeyFile :: FilePath,
-    serverCertificateFile :: FilePath
+    privateKeyFile :: FilePath,
+    certificateFile :: FilePath
   }
 
 data Env = Env
@@ -92,13 +93,13 @@ newSubscription = do
   return Sub {subThread = NoSub, delivered}
 
 newEnv :: forall m. (MonadUnliftIO m, MonadRandom m) => ServerConfig -> m Env
-newEnv config@ServerConfig {caCertificateFile, serverCertificateFile, serverPrivateKeyFile} = do
+newEnv config@ServerConfig {caCertificateFile, certificateFile, privateKeyFile} = do
   server <- atomically $ newServer (serverTbqSize config)
   queueStore <- atomically newQueueStore
   msgStore <- atomically newMsgStore
   idsDrg <- drgNew >>= newTVarIO
   s' <- restoreQueues queueStore `mapM` storeLog (config :: ServerConfig)
-  tlsServerParams <- liftIO $ loadTLSServerParams caCertificateFile serverCertificateFile serverPrivateKeyFile
+  tlsServerParams <- liftIO $ loadTLSServerParams caCertificateFile certificateFile privateKeyFile
   return Env {config, server, queueStore, msgStore, idsDrg, storeLog = s', tlsServerParams}
   where
     restoreQueues :: QueueStore -> StoreLog 'ReadMode -> m (StoreLog 'WriteMode)

tests/SMPAgentClient.hs

@@ -167,8 +167,8 @@ cfg =
           },
       retryInterval = (retryInterval defaultAgentConfig) {initialInterval = 50_000},
       caCertificateFile = "tests/fixtures/ca.crt",
-      agentPrivateKeyFile = "tests/fixtures/server.key",
-      agentCertificateFile = "tests/fixtures/server.crt"
+      privateKeyFile = "tests/fixtures/server.key",
+      certificateFile = "tests/fixtures/server.crt"
     }
 
 withSmpAgentThreadOn_ :: (MonadUnliftIO m, MonadRandom m) => ATransport -> (ServiceName, ServiceName, String) -> m () -> (ThreadId -> m a) -> m a

tests/SMPClient.hs

@@ -63,8 +63,8 @@ cfg =
       msgIdBytes = 24,
       storeLog = Nothing,
       caCertificateFile = "tests/fixtures/ca.crt",
-      serverPrivateKeyFile = "tests/fixtures/server.key",
-      serverCertificateFile = "tests/fixtures/server.crt"
+      privateKeyFile = "tests/fixtures/server.key",
+      certificateFile = "tests/fixtures/server.crt"
     }
 
 withSmpServerStoreLogOn :: (MonadUnliftIO m, MonadRandom m) => ATransport -> ServiceName -> (ThreadId -> m a) -> m a