initialize SMP server interactively, CLI options (#566)

* initialize SMP server interactively, CLI options

* correction

Co-authored-by: JRoberts <8711996+jr-simplex@users.noreply.github.com>

* corrections

Co-authored-by: JRoberts <8711996+jr-simplex@users.noreply.github.com>

src/Simplex/Messaging/Notifications/Server/Main.hs

@@ -1,20 +1,27 @@
 {-# LANGUAGE DuplicateRecordFields #-}
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE OverloadedLists #-}
 {-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE PatternSynonyms #-}
 
 module Simplex.Messaging.Notifications.Server.Main where
 
+import Data.Either (fromRight)
 import Data.Functor (($>))
-import Data.Ini (readIniFile)
+import Data.Ini (lookupValue, readIniFile)
 import Data.Maybe (fromMaybe)
+import qualified Data.Text as T
 import Network.Socket (HostName)
 import Options.Applicative
 import Simplex.Messaging.Client.Agent (defaultSMPClientAgentConfig)
+import qualified Simplex.Messaging.Crypto as C
 import Simplex.Messaging.Notifications.Server (runNtfServer)
 import Simplex.Messaging.Notifications.Server.Env (NtfServerConfig (..))
 import Simplex.Messaging.Notifications.Server.Push.APNS (defaultAPNSPushClientConfig)
+import Simplex.Messaging.Protocol (ProtoServerWithAuth (..), pattern NtfServer)
 import Simplex.Messaging.Server.CLI
+import Simplex.Messaging.Transport.Client (TransportHost (..))
 import System.Directory (createDirectoryIfMissing, doesFileExist)
 import System.FilePath (combine)
 import System.IO (BufferMode (..), hSetBuffering, stderr, stdout)
@@ -49,33 +56,36 @@ ntfServerCLI cfgPath logPath =
       createDirectoryIfMissing True logPath
       let x509cfg = defaultX509Config {commonName = fromMaybe ip fqdn, signAlgorithm}
       fp <- createServerX509 cfgPath x509cfg
-      writeFile iniFile iniFileContent
+      let host = fromMaybe (if ip == "127.0.0.1" then "<hostnames>" else ip) fqdn
+          srv = ProtoServerWithAuth (NtfServer [THDomainName host] "" (C.KeyHash fp)) Nothing
+      writeFile iniFile $ iniFileContent host
       putStrLn $ "Server initialized, you can modify configuration in " <> iniFile <> ".\nRun `" <> executableName <> " start` to start server."
-      printServiceInfo serverVersion fp
       warnCAPrivateKeyFile cfgPath x509cfg
+      printServiceInfo serverVersion srv
       where
-        iniFileContent =
+        iniFileContent host =
           "[STORE_LOG]\n\
           \# The server uses STM memory for persistence,\n\
           \# that will be lost on restart (e.g., as with redis).\n\
           \# This option enables saving memory to append only log,\n\
           \# and restoring it when the server is started.\n\
-          \# Log is compacted on start (deleted objects are removed).\n\
-          \enable: "
-            <> (if enableStoreLog then "on" else "off")
-            <> "\n\
-               \log_stats: off\n\n\
-               \[TRANSPORT]\n\
-               \port: "
-            <> defaultServerPort
-            <> "\n\
-               \websockets: off\n"
+          \# Log is compacted on start (deleted objects are removed).\n"
+            <> ("enable: " <> onOff enableStoreLog <> "\n\n")
+            <> "log_stats: off\n\n"
+            <> "[TRANSPORT]\n"
+            <> "# host is only used to print server address on start\n"
+            <> ("host: " <> host <> "\n")
+            <> ("port: " <> defaultServerPort <> "\n")
+            <> "websockets: off\n"
     runServer ini = do
       hSetBuffering stdout LineBuffering
       hSetBuffering stderr LineBuffering
       fp <- checkSavedFingerprint cfgPath defaultX509Config
-      printServiceInfo serverVersion fp
-      let cfg@NtfServerConfig {transports, storeLogFile} = serverConfig
+      let host = fromRight "<hostnames>" $ T.unpack <$> lookupValue "TRANSPORT" "host" ini
+          port = T.unpack $ strictIni "TRANSPORT" "port" ini
+          cfg@NtfServerConfig {transports, storeLogFile} = serverConfig
+          srv = ProtoServerWithAuth (NtfServer [THDomainName host] (if port == "443" then "" else port) (C.KeyHash fp)) Nothing
+      printServiceInfo serverVersion srv
       printServerConfig transports storeLogFile
       runNtfServer cfg
       where

src/Simplex/Messaging/Server/CLI.hs

@@ -2,6 +2,7 @@
 {-# LANGUAGE DuplicateRecordFields #-}
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE GADTs #-}
+{-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE TypeApplications #-}
@@ -19,6 +20,7 @@ import Data.X509.Validation (Fingerprint (..))
 import Network.Socket (HostName, ServiceName)
 import Options.Applicative
 import Simplex.Messaging.Encoding.String
+import Simplex.Messaging.Protocol (ProtoServerWithAuth (..), ProtocolServer (..), ProtocolTypeI)
 import Simplex.Messaging.Transport (ATransport (..), TLS, Transport (..))
 import Simplex.Messaging.Transport.Server (loadFingerprint)
 import Simplex.Messaging.Transport.WebSockets (WS)
@@ -33,12 +35,10 @@ exitError :: String -> IO ()
 exitError msg = putStrLn msg >> exitFailure
 
 confirmOrExit :: String -> IO ()
-confirmOrExit s = do
-  putStrLn s
-  putStr "Continue (Y/n): "
-  hFlush stdout
-  ok <- getLine
-  when (ok /= "Y") exitFailure
+confirmOrExit s =
+  withPrompt (s <> "\nContinue (Y/n): ") $ do
+    ok <- getLine
+    when (ok /= "Y") $ putStrLn "Server NOT deleted" >> exitFailure
 
 data SignAlgorithm = ED448 | ED25519
   deriving (Read, Show)
@@ -174,6 +174,24 @@ iniOnOff section name ini = case lookupValue section name ini of
   Right s -> error . T.unpack $ "invalid INI setting " <> name <> ": " <> s
   _ -> Nothing
 
+withPrompt :: String -> IO a -> IO a
+withPrompt s a = putStr s >> hFlush stdout >> a
+
+onOffPrompt :: String -> Bool -> IO Bool
+onOffPrompt prompt def =
+  withPrompt (prompt <> if def then " (Yn): " else " (yN): ") $
+    getLine >>= \case
+      "" -> pure def
+      "y" -> pure True
+      "Y" -> pure True
+      "n" -> pure False
+      "N" -> pure False
+      _ -> putStrLn "Invalid input, please enter 'y' or 'n'" >> onOffPrompt prompt def
+
+onOff :: Bool -> String
+onOff True = "on"
+onOff _ = "off"
+
 settingIsOn :: Text -> Text -> Ini -> Maybe ()
 settingIsOn section name ini
   | iniOnOff section name ini == Just True = Just ()
@@ -206,7 +224,8 @@ printServerConfig transports logFile = do
 deleteDirIfExists :: FilePath -> IO ()
 deleteDirIfExists path = whenM (doesDirectoryExist path) $ removeDirectoryRecursive path
 
-printServiceInfo :: String -> ByteString -> IO ()
-printServiceInfo serverVersion fpStr = do
+printServiceInfo :: ProtocolTypeI p => String -> ProtoServerWithAuth p -> IO ()
+printServiceInfo serverVersion srv@(ProtoServerWithAuth ProtocolServer {keyHash} _) = do
   putStrLn serverVersion
-  B.putStrLn $ "Fingerprint: " <> strEncode fpStr
+  B.putStrLn $ "Fingerprint: " <> strEncode keyHash
+  B.putStrLn $ "Server address: " <> strEncode srv

src/Simplex/Messaging/Server/Main.hs

@@ -1,22 +1,34 @@
+{-# LANGUAGE ApplicativeDo #-}
 {-# LANGUAGE DuplicateRecordFields #-}
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE OverloadedLists #-}
 {-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE PatternSynonyms #-}
 
 module Simplex.Messaging.Server.Main where
 
+import Control.Monad (void)
+import Crypto.Random (getRandomBytes)
+import qualified Data.ByteString.Char8 as B
+import Data.Either (fromRight)
 import Data.Functor (($>))
 import Data.Ini (lookupValue, readIniFile)
 import Data.Maybe (fromMaybe)
+import qualified Data.Text as T
 import Data.Text.Encoding (encodeUtf8)
 import Network.Socket (HostName)
 import Options.Applicative
+import qualified Simplex.Messaging.Crypto as C
 import Simplex.Messaging.Encoding.String
+import Simplex.Messaging.Protocol (BasicAuth (..), ProtoServerWithAuth (ProtoServerWithAuth), pattern SMPServer)
 import Simplex.Messaging.Server (runSMPServer)
 import Simplex.Messaging.Server.CLI
 import Simplex.Messaging.Server.Env.STM (ServerConfig (..), defaultInactiveClientExpiration, defaultMessageExpiration)
 import Simplex.Messaging.Server.Expiration
 import Simplex.Messaging.Transport (simplexMQVersion, supportedSMPServerVRange)
+import Simplex.Messaging.Transport.Client (TransportHost (..))
+import Simplex.Messaging.Util (safeDecodeUtf8)
 import System.Directory (createDirectoryIfMissing, doesFileExist)
 import System.FilePath (combine)
 import System.IO (BufferMode (..), hSetBuffering, stderr, stdout)
@@ -44,54 +56,92 @@ smpServerCLI cfgPath logPath =
     defaultServerPort = "5223"
     executableName = "smp-server"
     storeLogFilePath = combine logPath "smp-server-store.log"
-    initializeServer InitOptions {enableStoreLog, signAlgorithm, ip, fqdn} = do
-      deleteDirIfExists cfgPath
-      deleteDirIfExists logPath
-      createDirectoryIfMissing True cfgPath
-      createDirectoryIfMissing True logPath
-      let x509cfg = defaultX509Config {commonName = fromMaybe ip fqdn, signAlgorithm}
-      fp <- createServerX509 cfgPath x509cfg
-      writeFile iniFile iniFileContent
-      putStrLn $ "Server initialized, you can modify configuration in " <> iniFile <> ".\nRun `" <> executableName <> " start` to start server."
-      printServiceInfo serverVersion fp
-      warnCAPrivateKeyFile cfgPath x509cfg
+    initializeServer opts
+      | scripted opts = initialize opts
+      | otherwise = do
+        putStrLn "Use `smp-server init -h` for available options."
+        void $ withPrompt "SMP server will be initialized (press Enter)" getLine
+        enableStoreLog <- onOffPrompt "Enable store log to restore queues and messages on server restart" True
+        logStats <- onOffPrompt "Enable logging daily statistics" False
+        putStrLn "Require a password to create new messaging queues?"
+        password <- withPrompt "'r' for random (default), 'n' - no password, or enter password: " serverPassword
+        let host = fromMaybe (ip opts) (fqdn opts)
+        host' <- withPrompt ("Enter server FQDN or IP address for certificate (" <> host <> "): ") getLine
+        initialize opts {enableStoreLog, logStats, fqdn = if null host' then fqdn opts else Just host', password}
       where
-        iniFileContent =
-          "[STORE_LOG]\n\
-          \# The server uses STM memory for persistence,\n\
-          \# that will be lost on restart (e.g., as with redis).\n\
-          \# This option enables saving memory to append only log,\n\
-          \# and restoring it when the server is started.\n\
-          \# Log is compacted on start (deleted objects are removed).\n"
-            <> ("enable: " <> (if enableStoreLog then "on" else "off") <> "\n")
-            <> "# Undelivered messages are optionally saved and restored when the server restarts,\n\
-               \# they are preserved in the .bak file until the next restart.\n"
-            <> ("restore_messages: " <> (if enableStoreLog then "on" else "off") <> "\n")
-            <> "log_stats: off\n\n"
-            <> "[AUTH]\n"
-            <> "# Set new_queues option to off to completely prohibit creating new messaging queues.\n"
-            <> "# This can be useful when you want to decommission the server, but not all connections are switched yet.\n"
-            <> "new_queues: on\n\n"
-            <> "# Use create_password option to enable basic auth to create new messaging queues.\n"
-            <> "# The password should be used as part of server address in client configuration:\n"
-            <> "# smp://fingerprint:password@host1,host2\n"
-            <> "# The password will not be shared with the connecting contacts, you must share it only\n"
-            <> "# with the users who you want to allow creating messaging queues on your server.\n"
-            <> "# create_password: password to create new queues (any printable ASCII characters without whitespace, '@', ':' and '/')\n\n"
-            <> "[TRANSPORT]\n"
-            <> ("port: " <> defaultServerPort <> "\n")
-            <> "websockets: off\n\n"
-            <> "[INACTIVE_CLIENTS]\n\
-               \# TTL and interval to check inactive clients\n\
-               \disconnect: off\n"
-            <> ("# ttl: " <> show (ttl defaultInactiveClientExpiration) <> "\n")
-            <> ("# check_interval: " <> show (checkInterval defaultInactiveClientExpiration) <> "\n")
+        serverPassword =
+          getLine >>= \case
+            "" -> pure $ Just SPRandom
+            "r" -> pure $ Just SPRandom
+            "n" -> pure Nothing
+            s ->
+              case strDecode $ encodeUtf8 $ T.pack s of
+                Right auth -> pure . Just $ ServerPassword auth
+                _ -> putStrLn "Invalid password. Only latin letters, digits and symbols other than '@' and ':' are allowed" >> serverPassword
+        initialize InitOptions {enableStoreLog, logStats, signAlgorithm, ip, fqdn, password} = do
+          deleteDirIfExists cfgPath
+          deleteDirIfExists logPath
+          createDirectoryIfMissing True cfgPath
+          createDirectoryIfMissing True logPath
+          let x509cfg = defaultX509Config {commonName = fromMaybe ip fqdn, signAlgorithm}
+          fp <- createServerX509 cfgPath x509cfg
+          basicAuth <- mapM createServerPassword password
+          let host = fromMaybe (if ip == "127.0.0.1" then "<hostnames>" else ip) fqdn
+              srv = ProtoServerWithAuth (SMPServer [THDomainName host] "" (C.KeyHash fp)) basicAuth
+          writeFile iniFile $ iniFileContent host basicAuth
+          putStrLn $ "Server initialized, you can modify configuration in " <> iniFile <> ".\nRun `" <> executableName <> " start` to start server."
+          warnCAPrivateKeyFile cfgPath x509cfg
+          printServiceInfo serverVersion srv
+          where
+            createServerPassword = \case
+              ServerPassword s -> pure s
+              SPRandom -> BasicAuth . strEncode <$> (getRandomBytes 32 :: IO B.ByteString)
+            iniFileContent host basicAuth =
+              "[STORE_LOG]\n\
+              \# The server uses STM memory for persistence,\n\
+              \# that will be lost on restart (e.g., as with redis).\n\
+              \# This option enables saving memory to append only log,\n\
+              \# and restoring it when the server is started.\n\
+              \# Log is compacted on start (deleted objects are removed).\n"
+                <> ("enable: " <> onOff enableStoreLog <> "\n\n")
+                <> "# Undelivered messages are optionally saved and restored when the server restarts,\n\
+                   \# they are preserved in the .bak file until the next restart.\n"
+                <> ("restore_messages: " <> onOff enableStoreLog <> "\n\n")
+                <> "# Log daily server statistics to CSV file\n"
+                <> ("log_stats: " <> onOff logStats <> "\n\n")
+                <> "[AUTH]\n"
+                <> "# Set new_queues option to off to completely prohibit creating new messaging queues.\n"
+                <> "# This can be useful when you want to decommission the server, but not all connections are switched yet.\n"
+                <> "new_queues: on\n\n"
+                <> "# Use create_password option to enable basic auth to create new messaging queues.\n"
+                <> "# The password should be used as part of server address in client configuration:\n"
+                <> "# smp://fingerprint:password@host1,host2\n"
+                <> "# The password will not be shared with the connecting contacts, you must share it only\n"
+                <> "# with the users who you want to allow creating messaging queues on your server.\n"
+                <> ( case basicAuth of
+                       Just auth -> "create_password: " <> T.unpack (safeDecodeUtf8 $ strEncode auth)
+                       _ -> "# create_password: password to create new queues (any printable ASCII characters without whitespace, '@', ':' and '/')"
+                   )
+                <> "\n\n"
+                <> "[TRANSPORT]\n"
+                <> "# host is only used to print server address on start\n"
+                <> ("host: " <> host <> "\n")
+                <> ("port: " <> defaultServerPort <> "\n")
+                <> "websockets: off\n\n"
+                <> "[INACTIVE_CLIENTS]\n\
+                   \# TTL and interval to check inactive clients\n\
+                   \disconnect: off\n"
+                <> ("# ttl: " <> show (ttl defaultInactiveClientExpiration) <> "\n")
+                <> ("# check_interval: " <> show (checkInterval defaultInactiveClientExpiration) <> "\n")
     runServer ini = do
       hSetBuffering stdout LineBuffering
       hSetBuffering stderr LineBuffering
       fp <- checkSavedFingerprint cfgPath defaultX509Config
-      printServiceInfo serverVersion fp
-      let cfg@ServerConfig {transports, storeLogFile, inactiveClientExpiration} = serverConfig
+      let host = fromRight "<hostnames>" $ T.unpack <$> lookupValue "TRANSPORT" "host" ini
+          port = T.unpack $ strictIni "TRANSPORT" "port" ini
+          cfg@ServerConfig {transports, storeLogFile, newQueueBasicAuth, inactiveClientExpiration} = serverConfig
+          srv = ProtoServerWithAuth (SMPServer [THDomainName host] (if port == "5223" then "" else port) (C.KeyHash fp)) newQueueBasicAuth
+      printServiceInfo serverVersion srv
       printServerConfig transports storeLogFile
       putStrLn $ case inactiveClientExpiration of
         Just ExpirationConfig {ttl, checkInterval} -> "expiring clients inactive for " <> show ttl <> " seconds every " <> show checkInterval <> " seconds"
@@ -99,7 +149,7 @@ smpServerCLI cfgPath logPath =
       putStrLn $
         "creating new queues "
           <> if allowNewQueues cfg
-            then maybe "allowed" (const "requires basic auth") $ newQueueBasicAuth cfg
+            then maybe "allowed" (const "requires password") newQueueBasicAuth
             else "NOT allowed"
       runSMPServer cfg
       where
@@ -151,12 +201,18 @@ data CliCommand
 
 data InitOptions = InitOptions
   { enableStoreLog :: Bool,
+    logStats :: Bool,
     signAlgorithm :: SignAlgorithm,
     ip :: HostName,
-    fqdn :: Maybe HostName
+    fqdn :: Maybe HostName,
+    password :: Maybe ServerPassword,
+    scripted :: Bool
   }
   deriving (Show)
 
+data ServerPassword = ServerPassword BasicAuth | SPRandom
+  deriving (Show)
+
 cliCommandP :: FilePath -> FilePath -> FilePath -> Parser CliCommand
 cliCommandP cfgPath logPath iniFile =
   hsubparser
@@ -166,14 +222,21 @@ cliCommandP cfgPath logPath iniFile =
     )
   where
     initP :: Parser InitOptions
-    initP =
-      InitOptions
-        <$> switch
+    initP = do
+      enableStoreLog <-
+        switch
           ( long "store-log"
               <> short 'l'
               <> help "Enable store log for persistence"
           )
-        <*> option
+      logStats <-
+        switch
+          ( long "daily-stats"
+              <> short 's'
+              <> help "Enable logging daily server statistics"
+          )
+      signAlgorithm <-
+        option
           (maybeReader readMaybe)
           ( long "sign-algorithm"
               <> short 'a'
@@ -182,7 +245,8 @@ cliCommandP cfgPath logPath iniFile =
               <> showDefault
               <> metavar "ALG"
           )
-        <*> strOption
+      ip <-
+        strOption
           ( long "ip"
               <> help
                 "Server IP address, used as Common Name for TLS online certificate if FQDN is not supplied"
@@ -190,10 +254,30 @@ cliCommandP cfgPath logPath iniFile =
               <> showDefault
               <> metavar "IP"
           )
-        <*> (optional . strOption)
+      fqdn <-
+        (optional . strOption)
           ( long "fqdn"
               <> short 'n'
               <> help "Server FQDN used as Common Name for TLS online certificate"
               <> showDefault
               <> metavar "FQDN"
           )
+      password <-
+        flag' Nothing (long "no-password" <> help "Allow creating new queues without password")
+          <|> Just
+            <$> option
+              parseBasicAuth
+              ( long "password"
+                  <> metavar "PASSWORD"
+                  <> help "Set password to create new messaging queues"
+                  <> value SPRandom
+              )
+      scripted <-
+        switch
+          ( long "yes"
+              <> short 'y'
+              <> help "Non-interactive initialization using command-line options"
+          )
+      pure InitOptions {enableStoreLog, logStats, signAlgorithm, ip, fqdn, password, scripted}
+    parseBasicAuth :: ReadM ServerPassword
+    parseBasicAuth = eitherReader $ fmap ServerPassword . strDecode . B.pack

tests/CLITests.hs

@@ -29,15 +29,18 @@ ntfLogPath = "tests/tmp/cli/etc/var/simplex-notifications"
 cliTests :: Spec
 cliTests = do
   describe "SMP server CLI" $ do
-    it "should initialize, start and delete the server (no store log)" $ smpServerTest False
-    it "should initialize, start and delete the server (with store log)" $ smpServerTest True
+    describe "initialize, start and delete the server" $ do
+      it "no store log, random password (default)" $ smpServerTest False True
+      it "with store log, random password (default)" $ smpServerTest True True
+      it "no store log, no password" $ smpServerTest False False
+      it "with store log, no password" $ smpServerTest True False
   describe "Ntf server CLI" $ do
     it "should initialize, start and delete the server (no store log)" $ ntfServerTest False
     it "should initialize, start and delete the server (with store log)" $ ntfServerTest True
 
-smpServerTest :: Bool -> IO ()
-smpServerTest storeLog = do
-  capture_ (withArgs (["init"] <> ["-l" | storeLog]) $ smpServerCLI cfgPath logPath)
+smpServerTest :: Bool -> Bool -> IO ()
+smpServerTest storeLog basicAuth = do
+  capture_ (withArgs (["init", "-y"] <> ["-l" | storeLog] <> ["--no-password" | not basicAuth]) $ smpServerCLI cfgPath logPath)
     >>= (`shouldSatisfy` (("Server initialized, you can modify configuration in " <> cfgPath <> "/smp-server.ini") `isPrefixOf`))
   Right ini <- readIniFile $ cfgPath <> "/smp-server.ini"
   lookupValue "STORE_LOG" "enable" ini `shouldBe` Right (if storeLog then "on" else "off")
@@ -52,7 +55,7 @@ smpServerTest storeLog = do
   r `shouldContain` (if storeLog then ["Store log: " <> logPath <> "/smp-server-store.log"] else ["Store log disabled."])
   r `shouldContain` ["Listening on port 5223 (TLS)..."]
   r `shouldContain` ["not expiring inactive clients"]
-  r `shouldContain` ["creating new queues allowed"]
+  r `shouldContain` (if basicAuth then ["creating new queues requires password"] else ["creating new queues allowed"])
   capture_ (withStdin "Y" . withArgs ["delete"] $ smpServerCLI cfgPath logPath)
     >>= (`shouldSatisfy` ("WARNING: deleting the server will make all queues inaccessible" `isPrefixOf`))
   doesFileExist (cfgPath <> "/ca.key") `shouldReturn` False

tests/Test.hs

@@ -35,5 +35,5 @@ main = do
     describe "SMP server via WebSockets" $ serverTests (transport @WS)
     describe "Notifications server" $ ntfServerTests (transport @TLS)
     describe "SMP client agent" $ agentTests (transport @TLS)
-    describe "Server CLIs" cliTests
+    fdescribe "Server CLIs" cliTests
   removeDirectoryRecursive "tests/tmp"