xftp-cli: add deprecation notice (#1799)

Co-authored-by: Paul Bottinelli <paul.bottinelli@trailofbits.com>

src/Simplex/FileTransfer/Client/Main.hs

@@ -14,6 +14,7 @@ module Simplex.FileTransfer.Client.Main
   ( SendOptions (..),
     CLIError (..),
     xftpClientCLI,
+    xftpClientDeprecationNotice,
     cliSendFile,
     cliSendFileOpts,
     encodeWebURI,
@@ -69,7 +70,6 @@ import Simplex.Messaging.Encoding
 import Simplex.Messaging.Encoding.String (StrEncoding (..))
 import Simplex.Messaging.Parsers (parseAll)
 import Simplex.Messaging.Protocol (ProtoServerWithAuth (..), ProtocolServer (..), SenderId, SndPrivateAuthKey, XFTPServer, XFTPServerWithAuth)
-import Simplex.Messaging.Server.CLI (getCliCommand')
 import Simplex.Messaging.Util (groupAllOn, ifM, tshow, whenM)
 import System.Exit (exitFailure)
 import System.FilePath (splitFileName, (</>))
@@ -81,6 +81,10 @@ import UnliftIO.Directory
 xftpClientVersion :: String
 xftpClientVersion = "1.0.1"
 
+xftpClientDeprecationNotice :: String
+xftpClientDeprecationNotice =
+  "WARNING: the standalone xftp CLI is experimental and deprecated."
+
 newtype CLIError = CLIError String
   deriving (Eq, Show, Exception)
 
@@ -223,7 +227,13 @@ logCfg = LogConfig {lc_file = Nothing, lc_stderr = True}
 
 xftpClientCLI :: IO ()
 xftpClientCLI =
-  getCliCommand' cliCommandP clientVersion >>= \case
+  customExecParser
+    (prefs showHelpOnEmpty)
+    ( info
+        (helper <*> versionOption <*> cliCommandP)
+        (header (clientVersion <> "\n" <> xftpClientDeprecationNotice) <> fullDesc)
+    )
+    >>= \case
     SendFile opts -> runLogE opts $ cliSendFile opts
     ReceiveFile opts -> runLogE opts $ cliReceiveFile opts
     DeleteFile opts -> runLogE opts $ cliDeleteFile opts
@@ -231,6 +241,7 @@ xftpClientCLI =
     RandomFile opts -> cliRandomFile opts
   where
     clientVersion = "SimpleX XFTP client v" <> xftpClientVersion
+    versionOption = infoOption clientVersion (long "version" <> short 'v' <> help "Show version")
 
 runLogE :: HasField "verbose" a Bool => a -> ExceptT CLIError IO () -> IO ()
 runLogE opts a

tests/XFTPCLI.hs

@@ -1,14 +1,19 @@
 module XFTPCLI (xftpCLIFileTests, xftpCLI, senderFiles, recipientFiles, testBracket) where
 
-import Control.Exception (bracket_)
+import Control.Exception (bracket_, try)
 import qualified Data.ByteString as LB
 import Data.List (isInfixOf, isPrefixOf, isSuffixOf)
-import Simplex.FileTransfer.Client.Main (prepareChunkSizes, xftpClientCLI)
+import Simplex.FileTransfer.Client.Main
+  ( prepareChunkSizes,
+    xftpClientCLI,
+    xftpClientDeprecationNotice,
+  )
 import Simplex.FileTransfer.Description (kb, mb)
 import System.Directory (createDirectoryIfMissing, getFileSize, listDirectory, removeDirectoryRecursive)
 import System.Environment (withArgs)
+import System.Exit (ExitCode (ExitSuccess))
 import System.FilePath ((</>))
-import System.IO.Silently (capture_)
+import System.IO.Silently (capture, capture_)
 import Test.Hspec hiding (fit, it)
 import Util
 import Simplex.FileTransfer.Server.Env (AFStoreType)
@@ -16,6 +21,8 @@ import XFTPClient (cfgFS, cfgFS2, withXFTPServer, withXFTPServerConfigOn, testXF
 
 xftpCLIFileTests :: SpecWith AFStoreType
 xftpCLIFileTests = around_ testBracket $ do
+  it "shows experimental deprecation notice in help" $ \_ ->
+    testXFTPCLIHelpDeprecationNotice
   it "should send and receive file" $ withXFTPServer testXFTPCLISendReceive_
   it "should send and receive file with 2 servers" $ \fsType ->
     withXFTPServerConfigOn (cfgFS fsType) $ \_ -> withXFTPServerConfigOn (cfgFS2 fsType) $ \_ -> testXFTPCLISendReceive2servers_
@@ -40,6 +47,12 @@ recipientFiles = "tests/tmp/xftp-recipient-files"
 xftpCLI :: [String] -> IO [String]
 xftpCLI params = lines <$> capture_ (withArgs params xftpClientCLI)
 
+testXFTPCLIHelpDeprecationNotice :: IO ()
+testXFTPCLIHelpDeprecationNotice = do
+  (output, result) <- capture $ try $ withArgs ["--help"] xftpClientCLI
+  result `shouldBe` (Left ExitSuccess :: Either ExitCode ())
+  unwords (words output) `shouldSatisfy` (xftpClientDeprecationNotice `isInfixOf`)
+
 testXFTPCLISendReceive_ :: IO ()
 testXFTPCLISendReceive_ = do
   let filePath = senderFiles </> "testfile"