{-# LANGUAGE DuplicateRecordFields #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE OverloadedStrings #-} module RemoteTests where import ChatClient import ChatTests.DBUtils 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 qualified Data.Map.Strict as M import Simplex.Chat.Controller (versionNumber) import qualified Simplex.Chat.Controller as Controller import Simplex.Chat.Mobile.File import Simplex.Chat.Remote (remoteFilesFolder) import Simplex.Chat.Remote.Types import Simplex.Messaging.Crypto.File (CryptoFileArgs (..)) import Simplex.Messaging.Encoding.String (strEncode) import Simplex.Messaging.Util import System.FilePath ((>)) import Test.Hspec hiding (it) import UnliftIO import UnliftIO.Concurrent import UnliftIO.Directory remoteTests :: SpecWith TestParams 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 "connects with stored server bindings" storedBindingsTest 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 -> TestParams -> 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 => TestParams -> 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 => TestParams -> 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 => TestParams -> 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 " 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: this link was used with another controller, please create a new link on the host" -- 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 storedBindingsTest :: HasCallStack => TestParams -> IO () storedBindingsTest = testChat2 aliceProfile aliceDesktopProfile $ \mobile desktop -> do desktop ##> "/set device name My desktop" desktop <## "ok" mobile ##> "/set device name Mobile" mobile <## "ok" desktop ##> "/start remote host new addr=127.0.0.1 iface=\"lo\" port=52230" desktop <##. "new remote host started on 127.0.0.1:52230" -- TODO: show ip? desktop <## "Remote session invitation:" inv <- getTermLine desktop mobile ##> ("/connect remote ctrl " <> inv) mobile <## ("connecting new remote controller: My desktop, v" <> versionNumber) desktop <## "new remote host connecting" mobile <## "new remote controller connected" verifyRemoteCtrl mobile desktop mobile <## "remote controller 1 session started with My desktop" desktop <## "new remote host 1 added: Mobile" desktop <## "remote host 1 connected" desktop ##> "/list remote hosts" desktop <## "Remote hosts:" desktop <##. "1. Mobile (connected) [" stopDesktop mobile desktop desktop ##> "/list remote hosts" desktop <## "Remote hosts:" desktop <##. "1. Mobile [" -- TODO: more parser tests remoteMessageTest :: HasCallStack => TestParams -> 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 => TestParams -> IO () remoteStoreFileTest = testChat3 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 > remoteFilesFolder _ -> 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 [