{-# LANGUAGE DuplicateRecordFields #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE OverloadedStrings #-} module RemoteTests where import ChatClient import ChatTests.Utils import Control.Logger.Simple import qualified Data.Aeson as J import qualified Data.ByteString as B import qualified Data.ByteString.Lazy.Char8 as LB import Data.List.NonEmpty (NonEmpty (..)) import qualified Data.Map.Strict as M import qualified Network.TLS as TLS import Simplex.Chat.Archive (archiveFilesFolder) import Simplex.Chat.Controller (ChatConfig (..), XFTPFileConfig (..), versionNumber) import qualified Simplex.Chat.Controller as Controller import Simplex.Chat.Mobile.File import Simplex.Chat.Remote.Types import qualified Simplex.Messaging.Crypto as C import Simplex.Messaging.Crypto.File (CryptoFileArgs (..)) import Simplex.Messaging.Encoding.String (strEncode) import Simplex.Messaging.Transport.Credentials (genCredentials, tlsCredentials) import Simplex.Messaging.Util import System.FilePath ((>)) import Test.Hspec import UnliftIO import UnliftIO.Concurrent import UnliftIO.Directory remoteTests :: SpecWith FilePath remoteTests = describe "Remote" $ do describe "protocol handshake" $ do it "connects with new pairing (stops mobile)" $ remoteHandshakeTest False it "connects with new pairing (stops desktop)" $ remoteHandshakeTest True it "connects with stored pairing" remoteHandshakeStoredTest it "connects with multicast discovery" remoteHandshakeDiscoverTest it "refuses invalid client cert" remoteHandshakeRejectTest it "sends messages" remoteMessageTest describe "remote files" $ do it "store/get/send/receive files" remoteStoreFileTest it "should send files from CLI without /store" remoteCLIFileTest it "switches remote hosts" switchRemoteHostTest it "indicates remote hosts" indicateRemoteHostTest it "works with multiple profiles" multipleProfilesTest -- * Chat commands remoteHandshakeTest :: HasCallStack => Bool -> FilePath -> IO () remoteHandshakeTest viaDesktop = testChat2 aliceProfile aliceDesktopProfile $ \mobile desktop -> do desktop ##> "/list remote hosts" desktop <## "No remote hosts" mobile ##> "/list remote ctrls" mobile <## "No remote controllers" startRemote mobile desktop desktop ##> "/list remote hosts" desktop <## "Remote hosts:" desktop <## "1. Mobile (connected)" mobile ##> "/list remote ctrls" mobile <## "Remote controllers:" mobile <## "1. My desktop (connected)" if viaDesktop then stopDesktop mobile desktop else stopMobile mobile desktop desktop ##> "/delete remote host 1" desktop <## "ok" desktop ##> "/list remote hosts" desktop <## "No remote hosts" mobile ##> "/delete remote ctrl 1" mobile <## "ok" mobile ##> "/list remote ctrls" mobile <## "No remote controllers" remoteHandshakeStoredTest :: HasCallStack => FilePath -> IO () remoteHandshakeStoredTest = testChat2 aliceProfile aliceDesktopProfile $ \mobile desktop -> do logNote "Starting new session" startRemote mobile desktop stopMobile mobile desktop `catchAny` (logError . tshow) logNote "Starting stored session" startRemoteStored mobile desktop stopDesktop mobile desktop `catchAny` (logError . tshow) desktop ##> "/list remote hosts" desktop <## "Remote hosts:" desktop <## "1. Mobile" mobile ##> "/list remote ctrls" mobile <## "Remote controllers:" mobile <## "1. My desktop" logNote "Starting stored session again" startRemoteStored mobile desktop stopMobile mobile desktop `catchAny` (logError . tshow) remoteHandshakeDiscoverTest :: HasCallStack => FilePath -> IO () remoteHandshakeDiscoverTest = testChat2 aliceProfile aliceDesktopProfile $ \mobile desktop -> do logNote "Preparing new session" startRemote mobile desktop stopMobile mobile desktop `catchAny` (logError . tshow) logNote "Starting stored session with multicast" startRemoteDiscover mobile desktop stopMobile mobile desktop `catchAny` (logError . tshow) remoteHandshakeRejectTest :: HasCallStack => FilePath -> IO () remoteHandshakeRejectTest = testChat3 aliceProfile aliceDesktopProfile bobProfile $ \mobile desktop mobileBob -> do logNote "Starting new session" startRemote mobile desktop stopMobile mobile desktop mobileBob ##> "/set device name MobileBob" mobileBob <## "ok" desktop ##> "/start remote host 1" desktop <##. "remote host 1 started on port " desktop <## "Remote session invitation:" inv <- getTermLine desktop mobileBob ##> ("/connect remote ctrl " <> inv) mobileBob <## ("connecting new remote controller: My desktop, v" <> versionNumber) mobileBob <## "remote controller stopped" -- the server remains active after rejecting invalid client mobile ##> ("/connect remote ctrl " <> inv) mobile <## ("connecting remote controller 1: My desktop, v" <> versionNumber) desktop <## "remote host 1 connecting" desktop <## "Compare session code with host:" sessId <- getTermLine desktop mobile <## "remote controller 1 connected" mobile <## "Compare session code with controller and use:" mobile <## ("/verify remote ctrl " <> sessId) mobile ##> ("/verify remote ctrl " <> sessId) mobile <## "remote controller 1 session started with My desktop" desktop <## "remote host 1 connected" stopMobile mobile desktop remoteMessageTest :: HasCallStack => FilePath -> IO () remoteMessageTest = testChat3 aliceProfile aliceDesktopProfile bobProfile $ \mobile desktop bob -> do startRemote mobile desktop contactBob desktop bob logNote "sending messages" desktop #> "@bob hello there 🙂" bob <# "alice> hello there 🙂" bob #> "@alice hi" desktop <# "bob> hi" logNote "post-remote checks" stopMobile mobile desktop mobile ##> "/contacts" mobile <## "bob (Bob)" bob ##> "/contacts" bob <## "alice (Alice)" desktop ##> "/contacts" -- empty contact list on desktop-local threadDelay 1000000 logNote "done" remoteStoreFileTest :: HasCallStack => FilePath -> IO () remoteStoreFileTest = testChatCfg3 cfg aliceProfile aliceDesktopProfile bobProfile $ \mobile desktop bob -> withXFTPServer $ do let mobileFiles = "./tests/tmp/mobile_files" mobile ##> ("/_files_folder " <> mobileFiles) mobile <## "ok" let desktopFiles = "./tests/tmp/desktop_files" desktop ##> ("/_files_folder " <> desktopFiles) desktop <## "ok" let desktopHostFiles = "./tests/tmp/remote_hosts_data" desktop ##> ("/remote_hosts_folder " <> desktopHostFiles) desktop <## "ok" let bobFiles = "./tests/tmp/bob_files" bob ##> ("/_files_folder " <> bobFiles) bob <## "ok" startRemote mobile desktop contactBob desktop bob rhs <- readTVarIO (Controller.remoteHostSessions $ chatController desktop) desktopHostStore <- case M.lookup (RHId 1) rhs of Just (_, RHSessionConnected {storePath}) -> pure $ desktopHostFiles > storePath > archiveFilesFolder _ -> fail "Host session 1 should be started" desktop ##> "/store remote file 1 tests/fixtures/test.pdf" desktop <## "file test.pdf stored on remote host 1" src <- B.readFile "tests/fixtures/test.pdf" B.readFile (mobileFiles > "test.pdf") `shouldReturn` src B.readFile (desktopHostStore > "test.pdf") `shouldReturn` src desktop ##> "/store remote file 1 tests/fixtures/test.pdf" desktop <## "file test_1.pdf stored on remote host 1" B.readFile (mobileFiles > "test_1.pdf") `shouldReturn` src B.readFile (desktopHostStore > "test_1.pdf") `shouldReturn` src desktop ##> "/store remote file 1 encrypt=on tests/fixtures/test.pdf" desktop <## "file test_2.pdf stored on remote host 1" Just cfArgs@(CFArgs key nonce) <- J.decode . LB.pack <$> getTermLine desktop chatReadFile (mobileFiles > "test_2.pdf") (strEncode key) (strEncode nonce) `shouldReturn` Right (LB.fromStrict src) chatReadFile (desktopHostStore > "test_2.pdf") (strEncode key) (strEncode nonce) `shouldReturn` Right (LB.fromStrict src) removeFile (desktopHostStore > "test_1.pdf") removeFile (desktopHostStore > "test_2.pdf") -- cannot get file before it is used desktop ##> "/get remote file 1 {\"userId\": 1, \"fileId\": 1, \"sent\": true, \"fileSource\": {\"filePath\": \"test_1.pdf\"}}" hostError desktop "SEFileNotFound" -- send file not encrypted locally on mobile host desktop ##> "/_send @2 json {\"filePath\": \"test_1.pdf\", \"msgContent\": {\"type\": \"file\", \"text\": \"sending a file\"}}" desktop <# "@bob sending a file" desktop <# "/f @bob test_1.pdf" desktop <## "use /fc 1 to cancel sending" bob <# "alice> sending a file" bob <# "alice> sends file test_1.pdf (266.0 KiB / 272376 bytes)" bob <## "use /fr 1 [