From 0dec506ce6f71fd35f2c157ee4911c37e18aa80e Mon Sep 17 00:00:00 2001 From: Evgeny Poberezkin <2769109+epoberezkin@users.noreply.github.com> Date: Sat, 17 Oct 2020 19:42:15 +0100 Subject: [PATCH] test: duplex communication over 2 SMP connections --- tests/SMPClient.hs | 37 +++++++++++++++---------- tests/Test.hs | 69 ++++++++++++++++++++++++++++++++++++++++++---- 2 files changed, 85 insertions(+), 21 deletions(-) diff --git a/tests/SMPClient.hs b/tests/SMPClient.hs index 57977edef..bde81c9e7 100644 --- a/tests/SMPClient.hs +++ b/tests/SMPClient.hs @@ -1,5 +1,6 @@ {-# LANGUAGE BlockArguments #-} {-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE ScopedTypeVariables #-} module SMPClient where @@ -14,20 +15,20 @@ import UnliftIO.Concurrent import qualified UnliftIO.Exception as E import UnliftIO.IO -testSMPClient :: MonadUnliftIO m => HostName -> ServiceName -> (Handle -> m a) -> m a -testSMPClient host port client = do - threadDelay 1000 -- TODO hack: thread delay for SMP server to start - runTCPClient host port $ \h -> do - line <- getLn h - if line == "Welcome to SMP" - then client h - else error "not connected" +testHost :: HostName +testHost = "localhost" testPort :: ServiceName testPort = "5000" -testHost :: HostName -testHost = "localhost" +testSMPClient :: MonadUnliftIO m => (Handle -> m a) -> m a +testSMPClient client = do + threadDelay 5000 -- TODO hack: thread delay for SMP server to start + runTCPClient testHost testPort $ \h -> do + line <- getLn h + if line == "Welcome to SMP" + then client h + else error "not connected" cfg :: Config cfg = @@ -38,12 +39,18 @@ cfg = msgIdBytes = 6 } +withSmpServer :: (MonadUnliftIO m, MonadRandom m) => m a -> m a +withSmpServer = E.bracket (forkIO $ runSMPServer cfg) (liftIO . killThread) . const + runSmpTest :: (MonadUnliftIO m, MonadRandom m) => (Handle -> m a) -> m a -runSmpTest test = - E.bracket - (forkIO $ runSMPServer cfg) - (liftIO . killThread) - \_ -> testSMPClient "localhost" testPort test +runSmpTest test = withSmpServer $ testSMPClient test + +runSmpTestN :: forall m a. (MonadUnliftIO m, MonadRandom m) => Int -> ([Handle] -> m a) -> m a +runSmpTestN nClients test = withSmpServer $ run [] nClients + where + run :: [Handle] -> Int -> m a + run hs 0 = test hs + run hs n = testSMPClient $ \h -> run (h : hs) (n - 1) smpServerTest :: [RawTransmission] -> IO [RawTransmission] smpServerTest commands = runSmpTest \h -> mapM (sendReceive h) commands diff --git a/tests/Test.hs b/tests/Test.hs index 371ab03e1..c76459f4d 100644 --- a/tests/Test.hs +++ b/tests/Test.hs @@ -22,8 +22,12 @@ main :: IO () main = hspec do describe "SMP syntax" syntaxTests describe "SMP connections" do - testCreateSecure - testCreateDelete + describe "CONN and KEY commands, SEND messages" testCreateSecure + describe "CONN, OFF and DEL commands, SEND messages" testCreateDelete + describe "SMP messages" do + describe "duplex communication over 2 SMP connections" testDuplex + +-- describe "switch subscription to another SMP connection" pattern Resp :: ConnId -> Command 'Broker -> TransmissionOrError pattern Resp connId command = ("", (connId, Right (Cmd SBroker command))) @@ -31,6 +35,9 @@ pattern Resp connId command = ("", (connId, Right (Cmd SBroker command))) smpTest :: (Handle -> IO ()) -> Expectation smpTest test' = runSmpTest test' `shouldReturn` () +smpTestN :: Int -> ([Handle] -> IO ()) -> Expectation +smpTestN n test' = runSmpTestN n test' `shouldReturn` () + sendRecv :: Handle -> RawTransmission -> IO TransmissionOrError sendRecv h (sgn, cId, cmd) = tPutRaw h (fromRight "" $ decode sgn, cId, cmd) >> tGet fromServer h @@ -38,8 +45,8 @@ sendRecv h (sgn, cId, cmd) = tPutRaw h (fromRight "" $ decode sgn, cId, cmd) >> (actual, expected) #== message = assertEqual message expected actual testCreateSecure :: SpecWith () -testCreateSecure = do - it "CONN and KEY commands, SEND messages" $ +testCreateSecure = + it "should create (CONN) and secure (KEY) connection" $ smpTest \h -> do Resp rId1 (IDS rId sId) <- sendRecv h ("", "", "CONN 1234") (rId1, "") #== "creates connection" @@ -84,8 +91,8 @@ testCreateSecure = do (err5, ERR AUTH) #== "rejects unsigned SEND" testCreateDelete :: SpecWith () -testCreateDelete = do - it "CONN, OFF and DEL commands, SEND messages" $ +testCreateDelete = + it "should create (CONN), suspend (OFF) and delete (DEL) connection" $ smpTest \h -> do Resp rId1 (IDS rId sId) <- sendRecv h ("", "", "CONN 1234") (rId1, "") #== "creates connection" @@ -143,6 +150,56 @@ testCreateDelete = do Resp _ err10 <- sendRecv h ("1234", rId, "SUB") (err10, ERR AUTH) #== "rejects SUB when deleted" +testDuplex :: SpecWith () +testDuplex = + it "should create 2 simplex connections and exchange messages" $ + smpTestN 2 _test + where + _test [alice, bob] = duplex alice bob + _test _ = error "expected 2 handles" + + duplex alice bob = do + Resp _ (IDS aRcv aSnd) <- sendRecv alice ("", "", "CONN 1234") + -- aSnd ID is passed to Bob out-of-band + + Resp _ OK <- sendRecv bob ("", aSnd, "SEND :key efgh") + -- "key efgh" is ad-hoc, different from SMP protocol + + Resp _ (MSG _ _ msg1) <- tGet fromServer alice + Resp _ OK <- sendRecv alice ("1234", aRcv, "ACK") + ["key", key1] <- return $ B.words msg1 + (key1, "efgh") #== "key received from Bob" + Resp _ OK <- sendRecv alice ("1234", aRcv, "KEY " <> key1) + + Resp _ (IDS bRcv bSnd) <- sendRecv bob ("", "", "CONN abcd") + Resp _ OK <- sendRecv bob ("efgh", aSnd, "SEND :reply_id " <> encode bSnd) + -- "reply_id ..." is ad-hoc, it is not a part of SMP protocol + + Resp _ (MSG _ _ msg2) <- tGet fromServer alice + Resp _ OK <- sendRecv alice ("1234", aRcv, "ACK") + ["reply_id", bId] <- return $ B.words msg2 + (bId, encode bSnd) #== "reply connection ID received from Bob" + Resp _ OK <- sendRecv alice ("", bSnd, "SEND :key 5678") + -- "key 5678" is ad-hoc, different from SMP protocol + + Resp _ (MSG _ _ msg3) <- tGet fromServer bob + Resp _ OK <- sendRecv bob ("abcd", bRcv, "ACK") + ["key", key2] <- return $ B.words msg3 + (key2, "5678") #== "key received from Alice" + Resp _ OK <- sendRecv bob ("abcd", bRcv, "KEY " <> key2) + + Resp _ OK <- sendRecv bob ("efgh", aSnd, "SEND :hi alice") + + Resp _ (MSG _ _ msg4) <- tGet fromServer alice + Resp _ OK <- sendRecv alice ("1234", aRcv, "ACK") + (msg4, "hi alice") #== "message received from Bob" + + Resp _ OK <- sendRecv alice ("5678", bSnd, "SEND :how are you bob") + + Resp _ (MSG _ _ msg5) <- tGet fromServer bob + Resp _ OK <- sendRecv bob ("abcd", bRcv, "ACK") + (msg5, "how are you bob") #== "message received from alice" + syntaxTests :: SpecWith () syntaxTests = do it "unknown command" $ [("", "1234", "HELLO")] >#> [("", "1234", "ERR UNKNOWN")]