dandri/simplexmq
1
0
Fork 0
mirror of https://github.com/simplex-chat/simplexmq.git synced 2026-03-31 20:36:22 +00:00
Code Issues Packages Projects Releases Wiki Activity

test: update tests to include correclation ID in the tests themselves

Browse Source
This commit is contained in:
Evgeny Poberezkin
2020-12-28 15:39:28 +00:00
parent 4b8f6417f8
commit e7581a91a8
1 changed files with 69 additions and 77 deletions
Download Patch File Download Diff File Expand all files Collapse all files

146
tests/Test.hs
View File

@@ -5,11 +5,9 @@
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PatternSynonyms #-}
import Crypto.Random
import Data.ByteString.Base64
import Data.ByteString.Char8 (ByteString)
import qualified Data.ByteString.Char8 as B
import Data.Either
import SMPClient
import Simplex.Messaging.Server.Transmission
import Simplex.Messaging.Transport
@@ -28,17 +26,11 @@ main = hspec do
describe "duplex communication over 2 SMP connections" testDuplex
describe "switch subscription to another SMP queue" testSwitchSub
pattern Resp :: QueueId -> Command 'Broker -> TransmissionOrError
pattern Resp queueId command <- ("", (_, queueId, Right (Cmd SBroker command)))
pattern Resp :: CorrelationId -> QueueId -> Command 'Broker -> TransmissionOrError
pattern Resp corrId queueId command <- ("", (corrId, queueId, Right (Cmd SBroker command)))
sendRecv :: Handle -> (ByteString, ByteString, ByteString) -> IO TransmissionOrError
sendRecv h (sgn, qId, cmd) = do
corrId <- encode <$> getRandomBytes 3
tPutRaw h (sgn, corrId, encode qId, cmd)
t@(_, (corrId', _, _)) <- tGet fromServer h
if corrId == corrId'
then return t
else error "response correlation ID does not match request"
sendRecv :: Handle -> (ByteString, ByteString, ByteString, ByteString) -> IO TransmissionOrError
sendRecv h (sgn, corrId, qId, cmd) = tPutRaw h (sgn, corrId, encode qId, cmd) >> tGet fromServer h
(>#>) :: [RawTransmission] -> [RawTransmission] -> Expectation
commands >#> responses = smpServerTest commands `shouldReturn` responses
@@ -50,193 +42,193 @@ testCreateSecure :: SpecWith ()
testCreateSecure =
it "should create (NEW) and secure (KEY) queue" $
smpTest \h -> do
Resp rId1 (IDS rId sId) <- sendRecv h ("", "", "NEW 1234")
Resp "abcd" rId1 (IDS rId sId) <- sendRecv h ("", "abcd", "", "NEW 1234")
(rId1, "") #== "creates queue"
Resp sId1 ok1 <- sendRecv h ("", sId, "SEND :hello")
Resp "bcda" sId1 ok1 <- sendRecv h ("", "bcda", sId, "SEND :hello")
(ok1, OK) #== "accepts unsigned SEND"
(sId1, sId) #== "same queue ID in response 1"
Resp _ (MSG _ _ msg1) <- tGet fromServer h
Resp "" _ (MSG _ _ msg1) <- tGet fromServer h
(msg1, "hello") #== "delivers message"
Resp _ ok4 <- sendRecv h ("1234", rId, "ACK")
Resp "cdab" _ ok4 <- sendRecv h ("1234", "cdab", rId, "ACK")
(ok4, OK) #== "replies OK when message acknowledged if no more messages"
Resp _ err6 <- sendRecv h ("1234", rId, "ACK")
Resp "dabc" _ err6 <- sendRecv h ("1234", "dabc", rId, "ACK")
(err6, ERR PROHIBITED) #== "replies ERR when message acknowledged without messages"
Resp sId2 err1 <- sendRecv h ("4567", sId, "SEND :hello")
Resp "abcd" sId2 err1 <- sendRecv h ("4567", "abcd", sId, "SEND :hello")
(err1, ERR AUTH) #== "rejects signed SEND"
(sId2, sId) #== "same queue ID in response 2"
Resp _ err2 <- sendRecv h ("12345678", rId, "KEY 4567")
Resp "bcda" _ err2 <- sendRecv h ("12345678", "bcda", rId, "KEY 4567")
(err2, ERR AUTH) #== "rejects KEY with wrong signature (password atm)"
Resp _ err3 <- sendRecv h ("1234", sId, "KEY 4567")
Resp "cdab" _ err3 <- sendRecv h ("1234", "cdab", sId, "KEY 4567")
(err3, ERR AUTH) #== "rejects KEY with sender's ID"
Resp rId2 ok2 <- sendRecv h ("1234", rId, "KEY 4567")
Resp "dabc" rId2 ok2 <- sendRecv h ("1234", "dabc", rId, "KEY 4567")
(ok2, OK) #== "secures queue"
(rId2, rId) #== "same queue ID in response 3"
Resp _ err4 <- sendRecv h ("1234", rId, "KEY 4567")
Resp "abcd" _ err4 <- sendRecv h ("1234", "abcd", rId, "KEY 4567")
(err4, ERR AUTH) #== "rejects KEY if already secured"
Resp _ ok3 <- sendRecv h ("4567", sId, "SEND 11\nhello again")
Resp "bcda" _ ok3 <- sendRecv h ("4567", "bcda", sId, "SEND 11\nhello again")
(ok3, OK) #== "accepts signed SEND"
Resp _ (MSG _ _ msg) <- tGet fromServer h
Resp "" _ (MSG _ _ msg) <- tGet fromServer h
(msg, "hello again") #== "delivers message 2"
Resp _ ok5 <- sendRecv h ("1234", rId, "ACK")
Resp "cdab" _ ok5 <- sendRecv h ("1234", "cdab", rId, "ACK")
(ok5, OK) #== "replies OK when message acknowledged 2"
Resp _ err5 <- sendRecv h ("", sId, "SEND :hello")
Resp "dabc" _ err5 <- sendRecv h ("", "dabc", sId, "SEND :hello")
(err5, ERR AUTH) #== "rejects unsigned SEND"
testCreateDelete :: SpecWith ()
testCreateDelete =
it "should create (NEW), suspend (OFF) and delete (DEL) queue" $
smpTest2 \rh sh -> do
Resp rId1 (IDS rId sId) <- sendRecv rh ("", "", "NEW 1234")
Resp "abcd" rId1 (IDS rId sId) <- sendRecv rh ("", "abcd", "", "NEW 1234")
(rId1, "") #== "creates queue"
Resp _ ok1 <- sendRecv rh ("1234", rId, "KEY 4567")
Resp "bcda" _ ok1 <- sendRecv rh ("1234", "bcda", rId, "KEY 4567")
(ok1, OK) #== "secures queue"
Resp _ ok2 <- sendRecv sh ("4567", sId, "SEND :hello")
Resp "cdab" _ ok2 <- sendRecv sh ("4567", "cdab", sId, "SEND :hello")
(ok2, OK) #== "accepts signed SEND"
Resp _ ok7 <- sendRecv sh ("4567", sId, "SEND :hello 2")
Resp "dabc" _ ok7 <- sendRecv sh ("4567", "dabc", sId, "SEND :hello 2")
(ok7, OK) #== "accepts signed SEND 2 - this message is not delivered because the first is not ACKed"
Resp _ (MSG _ _ msg1) <- tGet fromServer rh
Resp "" _ (MSG _ _ msg1) <- tGet fromServer rh
(msg1, "hello") #== "delivers message"
Resp _ err1 <- sendRecv rh ("12345678", rId, "OFF")
Resp "abcd" _ err1 <- sendRecv rh ("12345678", "abcd", rId, "OFF")
(err1, ERR AUTH) #== "rejects OFF with wrong signature (password atm)"
Resp _ err2 <- sendRecv rh ("1234", sId, "OFF")
Resp "bcda" _ err2 <- sendRecv rh ("1234", "bcda", sId, "OFF")
(err2, ERR AUTH) #== "rejects OFF with sender's ID"
Resp rId2 ok3 <- sendRecv rh ("1234", rId, "OFF")
Resp "cdab" rId2 ok3 <- sendRecv rh ("1234", "cdab", rId, "OFF")
(ok3, OK) #== "suspends queue"
(rId2, rId) #== "same queue ID in response 2"
Resp _ err3 <- sendRecv sh ("4567", sId, "SEND :hello")
Resp "dabc" _ err3 <- sendRecv sh ("4567", "dabc", sId, "SEND :hello")
(err3, ERR AUTH) #== "rejects signed SEND"
Resp _ err4 <- sendRecv sh ("", sId, "SEND :hello")
Resp "abcd" _ err4 <- sendRecv sh ("", "abcd", sId, "SEND :hello")
(err4, ERR AUTH) #== "reject unsigned SEND too"
Resp _ ok4 <- sendRecv rh ("1234", rId, "OFF")
Resp "bcda" _ ok4 <- sendRecv rh ("1234", "bcda", rId, "OFF")
(ok4, OK) #== "accepts OFF when suspended"
Resp _ (MSG _ _ msg) <- sendRecv rh ("1234", rId, "SUB")
Resp "cdab" _ (MSG _ _ msg) <- sendRecv rh ("1234", "cdab", rId, "SUB")
(msg, "hello") #== "accepts SUB when suspended and delivers the message again (because was not ACKed)"
Resp _ err5 <- sendRecv rh ("12345678", rId, "DEL")
Resp "dabc" _ err5 <- sendRecv rh ("12345678", "dabc", rId, "DEL")
(err5, ERR AUTH) #== "rejects DEL with wrong signature (password atm)"
Resp _ err6 <- sendRecv rh ("1234", sId, "DEL")
Resp "abcd" _ err6 <- sendRecv rh ("1234", "abcd", sId, "DEL")
(err6, ERR AUTH) #== "rejects DEL with sender's ID"
Resp rId3 ok6 <- sendRecv rh ("1234", rId, "DEL")
Resp "bcda" rId3 ok6 <- sendRecv rh ("1234", "bcda", rId, "DEL")
(ok6, OK) #== "deletes queue"
(rId3, rId) #== "same queue ID in response 3"
Resp _ err7 <- sendRecv sh ("4567", sId, "SEND :hello")
Resp "cdab" _ err7 <- sendRecv sh ("4567", "cdab", sId, "SEND :hello")
(err7, ERR AUTH) #== "rejects signed SEND when deleted"
Resp _ err8 <- sendRecv sh ("", sId, "SEND :hello")
Resp "dabc" _ err8 <- sendRecv sh ("", "dabc", sId, "SEND :hello")
(err8, ERR AUTH) #== "rejects unsigned SEND too when deleted"
Resp _ err11 <- sendRecv rh ("1234", rId, "ACK")
Resp "abcd" _ err11 <- sendRecv rh ("1234", "abcd", rId, "ACK")
(err11, ERR AUTH) #== "rejects ACK when conn deleted - the second message is deleted"
Resp _ err9 <- sendRecv rh ("1234", rId, "OFF")
Resp "bcda" _ err9 <- sendRecv rh ("1234", "bcda", rId, "OFF")
(err9, ERR AUTH) #== "rejects OFF when deleted"
Resp _ err10 <- sendRecv rh ("1234", rId, "SUB")
Resp "cdab" _ err10 <- sendRecv rh ("1234", "cdab", rId, "SUB")
(err10, ERR AUTH) #== "rejects SUB when deleted"
testDuplex :: SpecWith ()
testDuplex =
it "should create 2 simplex connections and exchange messages" $
smpTest2 \alice bob -> do
Resp _ (IDS aRcv aSnd) <- sendRecv alice ("", "", "NEW 1234")
Resp "abcd" _ (IDS aRcv aSnd) <- sendRecv alice ("", "abcd", "", "NEW 1234")
-- aSnd ID is passed to Bob out-of-band
Resp _ OK <- sendRecv bob ("", aSnd, "SEND :key efgh")
Resp "bcda" _ OK <- sendRecv bob ("", "bcda", 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")
Resp "" _ (MSG _ _ msg1) <- tGet fromServer alice
Resp "cdab" _ OK <- sendRecv alice ("1234", "cdab", aRcv, "ACK")
["key", key1] <- return $ B.words msg1
(key1, "efgh") #== "key received from Bob"
Resp _ OK <- sendRecv alice ("1234", aRcv, "KEY " <> key1)
Resp "dabc" _ OK <- sendRecv alice ("1234", "dabc", aRcv, "KEY " <> key1)
Resp _ (IDS bRcv bSnd) <- sendRecv bob ("", "", "NEW abcd")
Resp _ OK <- sendRecv bob ("efgh", aSnd, "SEND :reply_id " <> encode bSnd)
Resp "abcd" _ (IDS bRcv bSnd) <- sendRecv bob ("", "abcd", "", "NEW abcd")
Resp "bcda" _ OK <- sendRecv bob ("efgh", "bcda", 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")
Resp "" _ (MSG _ _ msg2) <- tGet fromServer alice
Resp "cdab" _ OK <- sendRecv alice ("1234", "cdab", aRcv, "ACK")
["reply_id", bId] <- return $ B.words msg2
(bId, encode bSnd) #== "reply queue ID received from Bob"
Resp _ OK <- sendRecv alice ("", bSnd, "SEND :key 5678")
Resp "dabc" _ OK <- sendRecv alice ("", "dabc", 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")
Resp "" _ (MSG _ _ msg3) <- tGet fromServer bob
Resp "abcd" _ OK <- sendRecv bob ("abcd", "abcd", bRcv, "ACK")
["key", key2] <- return $ B.words msg3
(key2, "5678") #== "key received from Alice"
Resp _ OK <- sendRecv bob ("abcd", bRcv, "KEY " <> key2)
Resp "bcda" _ OK <- sendRecv bob ("abcd", "bcda", bRcv, "KEY " <> key2)
Resp _ OK <- sendRecv bob ("efgh", aSnd, "SEND :hi alice")
Resp "cdab" _ OK <- sendRecv bob ("efgh", "cdab", aSnd, "SEND :hi alice")
Resp _ (MSG _ _ msg4) <- tGet fromServer alice
Resp _ OK <- sendRecv alice ("1234", aRcv, "ACK")
Resp "" _ (MSG _ _ msg4) <- tGet fromServer alice
Resp "dabc" _ OK <- sendRecv alice ("1234", "dabc", aRcv, "ACK")
(msg4, "hi alice") #== "message received from Bob"
Resp _ OK <- sendRecv alice ("5678", bSnd, "SEND :how are you bob")
Resp "abcd" _ OK <- sendRecv alice ("5678", "abcd", bSnd, "SEND :how are you bob")
Resp _ (MSG _ _ msg5) <- tGet fromServer bob
Resp _ OK <- sendRecv bob ("abcd", bRcv, "ACK")
Resp "" _ (MSG _ _ msg5) <- tGet fromServer bob
Resp "bcda" _ OK <- sendRecv bob ("abcd", "bcda", bRcv, "ACK")
(msg5, "how are you bob") #== "message received from alice"
testSwitchSub :: SpecWith ()
testSwitchSub =
it "should create simplex connections and switch subscription to another TCP connection" $
smpTest3 \rh1 rh2 sh -> do
Resp _ (IDS rId sId) <- sendRecv rh1 ("", "", "NEW 1234")
Resp _ ok1 <- sendRecv sh ("", sId, "SEND :test1")
Resp "abcd" _ (IDS rId sId) <- sendRecv rh1 ("", "abcd", "", "NEW 1234")
Resp "bcda" _ ok1 <- sendRecv sh ("", "bcda", sId, "SEND :test1")
(ok1, OK) #== "sent test message 1"
Resp _ ok2 <- sendRecv sh ("", sId, "SEND :test2, no ACK")
Resp "cdab" _ ok2 <- sendRecv sh ("", "cdab", sId, "SEND :test2, no ACK")
(ok2, OK) #== "sent test message 2"
Resp _ (MSG _ _ msg1) <- tGet fromServer rh1
Resp "" _ (MSG _ _ msg1) <- tGet fromServer rh1
(msg1, "test1") #== "test message 1 delivered to the 1st TCP connection"
Resp _ (MSG _ _ msg2) <- sendRecv rh1 ("1234", rId, "ACK")
Resp "abcd" _ (MSG _ _ msg2) <- sendRecv rh1 ("1234", "abcd", rId, "ACK")
(msg2, "test2, no ACK") #== "test message 2 delivered, no ACK"
Resp _ (MSG _ _ msg2') <- sendRecv rh2 ("1234", rId, "SUB")
Resp "bcda" _ (MSG _ _ msg2') <- sendRecv rh2 ("1234", "bcda", rId, "SUB")
(msg2', "test2, no ACK") #== "same simplex queue via another TCP connection, tes2 delivered again (no ACK in 1st queue)"
Resp _ OK <- sendRecv rh2 ("1234", rId, "ACK")
Resp "cdab" _ OK <- sendRecv rh2 ("1234", "cdab", rId, "ACK")
Resp _ end <- tGet fromServer rh1
Resp "" _ end <- tGet fromServer rh1
(end, END) #== "unsubscribed the 1st TCP connection"
Resp _ OK <- sendRecv sh ("", sId, "SEND :test3")
Resp "dabc" _ OK <- sendRecv sh ("", "dabc", sId, "SEND :test3")
Resp _ (MSG _ _ msg3) <- tGet fromServer rh2
Resp "" _ (MSG _ _ msg3) <- tGet fromServer rh2
(msg3, "test3") #== "delivered to the 2nd TCP connection"
Resp _ err <- sendRecv rh1 ("1234", rId, "ACK")
Resp "abcd" _ err <- sendRecv rh1 ("1234", "abcd", rId, "ACK")
(err, ERR PROHIBITED) #== "rejects ACK from the 1st TCP connection"
Resp _ ok3 <- sendRecv rh2 ("1234", rId, "ACK")
Resp "bcda" _ ok3 <- sendRecv rh2 ("1234", "bcda", rId, "ACK")
(ok3, OK) #== "accepts ACK from the 2nd TCP connection"
timeout 1000 (tGet fromServer rh1) >>= \case