From f640e71f8276b250154751a8274ee80abb3d5d18 Mon Sep 17 00:00:00 2001 From: Evgeny Poberezkin <2769109+epoberezkin@users.noreply.github.com> Date: Fri, 10 Dec 2021 12:21:54 +0000 Subject: [PATCH] remove BlockArguments extension (#220) --- src/Simplex/Messaging/Transport.hs | 3 +-- tests/AgentTests.hs | 21 ++++++++++---------- tests/AgentTests/SQLiteTests.hs | 31 +++++++++++++++--------------- tests/SMPAgentClient.hs | 1 - tests/SMPClient.hs | 1 - tests/ServerTests.hs | 17 ++++++++-------- 6 files changed, 34 insertions(+), 40 deletions(-) diff --git a/src/Simplex/Messaging/Transport.hs b/src/Simplex/Messaging/Transport.hs index 204adb0fa..99c869f46 100644 --- a/src/Simplex/Messaging/Transport.hs +++ b/src/Simplex/Messaging/Transport.hs @@ -1,5 +1,4 @@ {-# LANGUAGE AllowAmbiguousTypes #-} -{-# LANGUAGE BlockArguments #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE DeriveAnyClass #-} {-# LANGUAGE DeriveGeneric #-} @@ -129,7 +128,7 @@ data ATransport = forall c. Transport c => ATransport (TProxy c) runTransportServer :: (Transport c, MonadUnliftIO m) => TMVar Bool -> ServiceName -> (c -> m ()) -> m () runTransportServer started port server = do clients <- newTVarIO S.empty - E.bracket (liftIO $ startTCPServer started port) (liftIO . closeServer clients) \sock -> forever $ do + E.bracket (liftIO $ startTCPServer started port) (liftIO . closeServer clients) $ \sock -> forever $ do c <- liftIO $ acceptConnection sock tid <- forkFinally (server c) (const $ liftIO $ closeConnection c) atomically . modifyTVar clients $ S.insert tid diff --git a/tests/AgentTests.hs b/tests/AgentTests.hs index 88feb0196..c9aab3a85 100644 --- a/tests/AgentTests.hs +++ b/tests/AgentTests.hs @@ -1,4 +1,3 @@ -{-# LANGUAGE BlockArguments #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE LambdaCase #-} @@ -33,7 +32,7 @@ agentTests (ATransport t) = do describe "Functional API" $ functionalAPITests (ATransport t) describe "SQLite store" storeTests describe "SMP agent protocol syntax" $ syntaxTests t - describe "Establishing duplex connection" do + describe "Establishing duplex connection" $ do it "should connect via one server and one agent" $ smpAgentTest2_1_1 $ testDuplexConnection t it "should connect via one server and one agent (random IDs)" $ @@ -46,19 +45,19 @@ agentTests (ATransport t) = do smpAgentTest2_2_2 $ testDuplexConnection t it "should connect via 2 servers and 2 agents (random IDs)" $ smpAgentTest2_2_2 $ testDuplexConnRandomIds t - describe "Establishing connections via `contact connection`" do + describe "Establishing connections via `contact connection`" $ do it "should connect via contact connection with one server and 3 agents" $ smpAgentTest3 $ testContactConnection t it "should connect via contact connection with one server and 2 agents (random IDs)" $ smpAgentTest2_2_1 $ testContactConnRandomIds t it "should support rejecting contact request" $ smpAgentTest2_2_1 $ testRejectContactRequest t - describe "Connection subscriptions" do + describe "Connection subscriptions" $ do it "should connect via one server and one agent" $ smpAgentTest3_1_1 $ testSubscription t it "should send notifications to client when server disconnects" $ smpAgentServerTest $ testSubscrNotification t - describe "Message delivery" do + describe "Message delivery" $ do it "should deliver messages after losing server connection and re-connecting" $ smpAgentTest2_2_2_needs_server $ testMsgDeliveryServerRestart t it "should deliver pending messages after agent restarting" $ @@ -354,21 +353,21 @@ samplePublicKey = "rsa:MIIBoDANBgkqhkiG9w0BAQEFAAOCAY0AMIIBiAKCAQEAtn1NI2tPoOGSG syntaxTests :: forall c. Transport c => TProxy c -> Spec syntaxTests t = do it "unknown command" $ ("1", "5678", "HELLO") >#> ("1", "5678", "ERR CMD SYNTAX") - describe "NEW" do - describe "valid" do + describe "NEW" $ do + describe "valid" $ do -- TODO: add tests with defined connection alias it "with correct parameter" $ ("211", "", "NEW INV") >#>= \case ("211", _, "INV" : _) -> True; _ -> False - describe "invalid" do + describe "invalid" $ do -- TODO: add tests with defined connection alias it "with incorrect parameter" $ ("222", "", "NEW hi") >#> ("222", "", "ERR CMD SYNTAX") - describe "JOIN" do - describe "valid" do + describe "JOIN" $ do + describe "valid" $ do -- TODO: ERROR no connection alias in the response (it does not generate it yet if not provided) -- TODO: add tests with defined connection alias it "using same server as in invitation" $ ("311", "a", "JOIN https://simpex.chat/invitation#/?smp=smp%3A%2F%2Flocalhost%3A5001%2F1234-w%3D%3D%23&e2e=" <> urlEncode True samplePublicKey <> " 14\nbob's connInfo") >#> ("311", "a", "ERR SMP AUTH") - describe "invalid" do + describe "invalid" $ do -- TODO: JOIN is not merged yet - to be added it "no parameters" $ ("321", "", "JOIN") >#> ("321", "", "ERR CMD SYNTAX") where diff --git a/tests/AgentTests/SQLiteTests.hs b/tests/AgentTests/SQLiteTests.hs index 3e343484d..4662accee 100644 --- a/tests/AgentTests/SQLiteTests.hs +++ b/tests/AgentTests/SQLiteTests.hs @@ -1,4 +1,3 @@ -{-# LANGUAGE BlockArguments #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE DuplicateRecordFields #-} {-# LANGUAGE LambdaCase #-} @@ -71,42 +70,42 @@ action `throwsError` e = runExceptT action `shouldReturn` Left e -- TODO add null port tests storeTests :: Spec storeTests = do - withStore2 do + withStore2 $ do describe "stress test" testConcurrentWrites - withStore do - describe "store setup" do + withStore $ do + describe "store setup" $ do testCompiledThreadsafe testForeignKeysEnabled - describe "store methods" do - describe "Queue and Connection management" do - describe "createRcvConn" do + describe "store methods" $ do + describe "Queue and Connection management" $ do + describe "createRcvConn" $ do testCreateRcvConn testCreateRcvConnRandomId testCreateRcvConnDuplicate - describe "createSndConn" do + describe "createSndConn" $ do testCreateSndConn testCreateSndConnRandomID testCreateSndConnDuplicate describe "getAllConnIds" testGetAllConnIds describe "getRcvConn" testGetRcvConn - describe "deleteConn" do + describe "deleteConn" $ do testDeleteRcvConn testDeleteSndConn testDeleteDuplexConn - describe "upgradeRcvConnToDuplex" do + describe "upgradeRcvConnToDuplex" $ do testUpgradeRcvConnToDuplex - describe "upgradeSndConnToDuplex" do + describe "upgradeSndConnToDuplex" $ do testUpgradeSndConnToDuplex - describe "set Queue status" do - describe "setRcvQueueStatus" do + describe "set Queue status" $ do + describe "setRcvQueueStatus" $ do testSetRcvQueueStatus testSetRcvQueueStatusNoQueue - describe "setSndQueueStatus" do + describe "setSndQueueStatus" $ do testSetSndQueueStatus testSetSndQueueStatusNoQueue testSetQueueStatusDuplex - describe "Msg management" do - describe "create Msg" do + describe "Msg management" $ do + describe "create Msg" $ do testCreateRcvMsg testCreateSndMsg testCreateRcvAndSndMsgs diff --git a/tests/SMPAgentClient.hs b/tests/SMPAgentClient.hs index c20dc5d11..f4570bbe4 100644 --- a/tests/SMPAgentClient.hs +++ b/tests/SMPAgentClient.hs @@ -1,4 +1,3 @@ -{-# LANGUAGE BlockArguments #-} {-# LANGUAGE DuplicateRecordFields #-} {-# LANGUAGE NumericUnderscores #-} {-# LANGUAGE OverloadedStrings #-} diff --git a/tests/SMPClient.hs b/tests/SMPClient.hs index 696de803c..c080641ae 100644 --- a/tests/SMPClient.hs +++ b/tests/SMPClient.hs @@ -1,4 +1,3 @@ -{-# LANGUAGE BlockArguments #-} {-# LANGUAGE DuplicateRecordFields #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE NumericUnderscores #-} diff --git a/tests/ServerTests.hs b/tests/ServerTests.hs index 922636b36..5c4a2e6e8 100644 --- a/tests/ServerTests.hs +++ b/tests/ServerTests.hs @@ -1,4 +1,3 @@ -{-# LANGUAGE BlockArguments #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE LambdaCase #-} @@ -31,10 +30,10 @@ rsaKeySize = 2048 `div` 8 serverTests :: ATransport -> Spec serverTests t = do describe "SMP syntax" $ syntaxTests t - describe "SMP queues" do + describe "SMP queues" $ do describe "NEW and KEY commands, SEND messages" $ testCreateSecure t describe "NEW, OFF and DEL commands, SEND messages" $ testCreateDelete t - describe "SMP messages" do + describe "SMP messages" $ do describe "duplex communication over 2 SMP connections" $ testDuplex t describe "switch subscription to another SMP queue" $ testSwitchSub t describe "Store log" $ testWithStoreLog t @@ -445,12 +444,12 @@ sampleSig = "gM8qn2Vx3GkhIp2hgrji9uhfXKpgtKDmc0maxdP8GvbORUxMCTlLG8Q/gNcl3pQVOzm syntaxTests :: ATransport -> Spec syntaxTests (ATransport t) = do it "unknown command" $ ("", "abcd", "1234", "HELLO") >#> ("", "abcd", "1234", "ERR CMD SYNTAX") - describe "NEW" do + describe "NEW" $ do it "no parameters" $ (sampleSig, "bcda", "", "NEW") >#> ("", "bcda", "", "ERR CMD SYNTAX") it "many parameters" $ (sampleSig, "cdab", "", "NEW 1 " <> samplePubKey) >#> ("", "cdab", "", "ERR CMD SYNTAX") it "no signature" $ ("", "dabc", "", "NEW " <> samplePubKey) >#> ("", "dabc", "", "ERR CMD NO_AUTH") it "queue ID" $ (sampleSig, "abcd", "12345678", "NEW " <> samplePubKey) >#> ("", "abcd", "12345678", "ERR CMD HAS_AUTH") - describe "KEY" do + describe "KEY" $ do it "valid syntax" $ (sampleSig, "bcda", "12345678", "KEY " <> samplePubKey) >#> ("", "bcda", "12345678", "ERR AUTH") it "no parameters" $ (sampleSig, "cdab", "12345678", "KEY") >#> ("", "cdab", "12345678", "ERR CMD SYNTAX") it "many parameters" $ (sampleSig, "dabc", "12345678", "KEY 1 " <> samplePubKey) >#> ("", "dabc", "12345678", "ERR CMD SYNTAX") @@ -460,7 +459,7 @@ syntaxTests (ATransport t) = do noParamsSyntaxTest "ACK" noParamsSyntaxTest "OFF" noParamsSyntaxTest "DEL" - describe "SEND" do + describe "SEND" $ do it "valid syntax 1" $ (sampleSig, "cdab", "12345678", "SEND 5 hello ") >#> ("", "cdab", "12345678", "ERR AUTH") it "valid syntax 2" $ (sampleSig, "dabc", "12345678", "SEND 11 hello there ") >#> ("", "dabc", "12345678", "ERR AUTH") it "no parameters" $ (sampleSig, "abcd", "12345678", "SEND") >#> ("", "abcd", "12345678", "ERR CMD SYNTAX") @@ -468,13 +467,13 @@ syntaxTests (ATransport t) = do it "bad message body 1" $ (sampleSig, "cdab", "12345678", "SEND 11 hello ") >#> ("", "cdab", "12345678", "ERR CMD SYNTAX") it "bad message body 2" $ (sampleSig, "dabc", "12345678", "SEND hello ") >#> ("", "dabc", "12345678", "ERR CMD SYNTAX") it "bigger body" $ (sampleSig, "abcd", "12345678", "SEND 4 hello ") >#> ("", "abcd", "12345678", "ERR CMD SYNTAX") - describe "PING" do + describe "PING" $ do it "valid syntax" $ ("", "abcd", "", "PING") >#> ("", "abcd", "", "PONG") - describe "broker response not allowed" do + describe "broker response not allowed" $ do it "OK" $ (sampleSig, "bcda", "12345678", "OK") >#> ("", "bcda", "12345678", "ERR CMD PROHIBITED") where noParamsSyntaxTest :: ByteString -> Spec - noParamsSyntaxTest cmd = describe (B.unpack cmd) do + noParamsSyntaxTest cmd = describe (B.unpack cmd) $ do it "valid syntax" $ (sampleSig, "abcd", "12345678", cmd) >#> ("", "abcd", "12345678", "ERR AUTH") it "wrong terminator" $ (sampleSig, "bcda", "12345678", cmd <> "=") >#> ("", "bcda", "12345678", "ERR CMD SYNTAX") it "no signature" $ ("", "cdab", "12345678", cmd) >#> ("", "cdab", "12345678", "ERR CMD NO_AUTH")