diff --git a/tests/Test.hs b/tests/Test.hs index 4d5f43732..ca27be2bf 100644 --- a/tests/Test.hs +++ b/tests/Test.hs @@ -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