dandri/simplexmq
1
0
Fork 0
mirror of https://github.com/simplex-chat/simplexmq.git synced 2026-08-03 15:40:05 +00:00
Code Issues Packages Projects Releases Wiki Activity

remote: add controller address preferences (#905)

Browse Source 
* remote: add controller address preferences

* suppress localhost from breaking multicast discovery w/o prefs

* rewrite findCtrlAddress

* refactor

* refactor2

* add tests

---------

Co-authored-by: Evgeny Poberezkin <2769109+epoberezkin@users.noreply.github.com>
This commit is contained in:
Alexander Bondarenko
2023-11-28 14:12:29 +00:00
committed by GitHub
co-authored by Evgeny Poberezkin
parent 2a6be894e1
commit febf9019e2
5 changed files with 94 additions and 55 deletions
Download Patch File Download Diff File Expand all files Collapse all files
tests/RemoteControl.hs
+38 -2
View File
@@ -1,4 +1,5 @@
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedRecordDot #-}
{-# LANGUAGE OverloadedStrings #-}
@@ -9,7 +10,9 @@ import Control.Logger.Simple
import Crypto.Random (ChaChaDRG, drgNew)
import qualified Data.Aeson as J
import Data.List.NonEmpty (NonEmpty (..))
import Simplex.Messaging.Encoding.String (StrEncoding (..))
import qualified Simplex.RemoteControl.Client as RC
import Simplex.RemoteControl.Discovery (mkLastLocalHost, preferAddress)
import Simplex.RemoteControl.Invitation (RCSignedInvitation, verifySignedInvitation)
import Simplex.RemoteControl.Types
import Test.Hspec
@@ -18,12 +21,45 @@ import UnliftIO.Concurrent
remoteControlTests :: Spec
remoteControlTests = do
describe "preferred bindings should go first" testPreferAddress
describe "New controller/host pairing" $ do
it "should connect to new pairing" testNewPairing
it "should connect to existing pairing" testExistingPairing
describe "Multicast discovery" $ do
it "should find paired host and connect" testMulticast
testPreferAddress :: Spec
testPreferAddress = do
it "suppresses localhost" $
mkLastLocalHost addrs
`shouldBe` [ "10.20.30.40" @ "eth0",
"10.20.30.42" @ "wlan0",
"127.0.0.1" @ "lo"
]
it "finds by address" $ do
preferAddress ("127.0.0.1" @ "lo23") addrs' `shouldBe` addrs -- localhost is back on top
preferAddress ("10.20.30.42" @ "wlp2s0") addrs'
`shouldBe` [ "10.20.30.42" @ "wlan0",
"10.20.30.40" @ "eth0",
"127.0.0.1" @ "lo"
]
it "finds by interface" $ do
preferAddress ("127.1.2.3" @ "lo") addrs' `shouldBe` addrs
preferAddress ("0.0.0.0" @ "eth0") addrs' `shouldBe` addrs'
it "survives duplicates" $ do
preferAddress ("0.0.0.0" @ "eth1") addrsDups `shouldBe` addrsDups
preferAddress ("0.0.0.0" @ "eth0") ifaceDups `shouldBe` ifaceDups
where
th @ interface = RCCtrlAddress {address = either error id $ strDecode th, interface}
addrs =
[ "127.0.0.1" @ "lo", -- localhost may go first and break things
"10.20.30.40" @ "eth0",
"10.20.30.42" @ "wlan0"
]
addrs' = mkLastLocalHost addrs
addrsDups = "10.20.30.40" @ "eth1" : addrs'
ifaceDups = "10.20.30.41" @ "eth0" : addrs'
testNewPairing :: IO ()
testNewPairing = do
drg <- drgNew >>= newTVarIO
@@ -31,7 +67,7 @@ testNewPairing = do
invVar <- newEmptyMVar
ctrlSessId <- async . runRight $ do
logNote "c 1"
(inv, hc, r) <- RC.connectRCHost drg hp (J.String "app") False
(_found, inv, hc, r) <- RC.connectRCHost drg hp (J.String "app") False Nothing Nothing
logNote "c 2"
putMVar invVar (inv, hc)
logNote "c 3"
@@ -123,7 +159,7 @@ testMulticast = do
runCtrl :: TVar ChaChaDRG -> Bool -> RCHostPairing -> MVar RCSignedInvitation -> IO (Async RCHostPairing)
runCtrl drg multicast hp invVar = async . runRight $ do
(inv, hc, r) <- RC.connectRCHost drg hp (J.String "app") multicast
(_found, inv, hc, r) <- RC.connectRCHost drg hp (J.String "app") multicast Nothing Nothing
putMVar invVar inv
Right (_sessId, _tls, r') <- atomically $ takeTMVar r
Right (_rcHostSession, _rcHelloBody, hp') <- atomically $ takeTMVar r'