agent: add context to CMD error (#1167)

* agent: add context to CMD error

* tests, more warnings

* fix tests

* log TBQueue sizes

* log locks

* more logs

* log sendMessagesB

* fix test

* log length

* refactor

* remove logging

* revert lock scope change

* cleanup

* add string error to A_PROHIBITED

* remove

* remove test limitations

* language
This commit is contained in:
Evgeny Poberezkin
2024-05-24 14:13:01 +01:00
committed by GitHub
parent e7a73a4c89
commit 2ff5f5a832
16 changed files with 131 additions and 113 deletions
+6 -7
View File
@@ -7,7 +7,6 @@
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# OPTIONS_GHC -fno-warn-incomplete-uni-patterns #-}
module AgentTests (agentTests) where
@@ -358,7 +357,7 @@ testRejectContactRequest _ alice bob = do
-- RJCT must use correct contact connection
alice #: ("2a", "bob", "RJCT " <> aInvId) #> ("2a", "bob", ERR $ CONN NOT_FOUND)
alice #: ("2b", "a_contact", "RJCT " <> aInvId) #> ("2b", "a_contact", OK)
alice #: ("3", "bob", "ACPT " <> aInvId <> " 12\nalice's info") #> ("3", "bob", ERR $ A.CMD PROHIBITED)
alice #: ("3", "bob", "ACPT " <> aInvId <> " 12\nalice's info") =#> \case ("3", "bob", ERR (A.CMD PROHIBITED _)) -> True; _ -> False
bob #:# "nothing should be delivered to bob"
testSubscription :: Transport c => TProxy c -> c -> c -> c -> IO ()
@@ -430,8 +429,8 @@ testServerConnectionAfterError t _ = do
withAgent1 $ \bob -> do
withAgent2 $ \alice -> do
bob #:! ("1", "alice", "SUB") =#> \("1", "alice", ERR (BROKER _ e)) -> e == NETWORK || e == TIMEOUT
alice #:! ("1", "bob", "SUB") =#> \("1", "bob", ERR (BROKER _ e)) -> e == NETWORK || e == TIMEOUT
bob #:! ("1", "alice", "SUB") =#> \case ("1", "alice", ERR (BROKER _ e)) -> e == NETWORK || e == TIMEOUT; _ -> False
alice #:! ("1", "bob", "SUB") =#> \case ("1", "bob", ERR (BROKER _ e)) -> e == NETWORK || e == TIMEOUT; _ -> False
withServer $ do
alice <#=? \case ("", "bob", APC SAEConn (SENT 4)) -> True; ("", "", APC _ (UP s ["bob"])) -> s == server; _ -> False
alice <#=? \case ("", "bob", APC SAEConn (SENT 4)) -> True; ("", "", APC _ (UP s ["bob"])) -> s == server; _ -> False
@@ -613,12 +612,12 @@ sampleDhKey = "MCowBQYDK2VuAyEAjiswwI3O_NlS8Fk3HJUW870EY2bAwmttMBsvRB9eV3o="
syntaxTests :: forall c. Transport c => TProxy c -> Spec
syntaxTests t = do
it "unknown command" $ ("1", "5678", "HELLO") >#> ("1", "5678", "ERR CMD SYNTAX")
it "unknown command" $ ("1", "5678", "HELLO") >#> ("1", "5678", "ERR CMD SYNTAX parseCommand")
describe "NEW" $ do
describe "valid" $ do
it "with correct parameter" $ ("211", "", "NEW T INV subscribe") >#>= \case ("211", _, "INV" : _) -> True; _ -> False
describe "invalid" $ do
it "with incorrect parameter" $ ("222", "", "NEW T hi subscribe") >#> ("222", "", "ERR CMD SYNTAX")
it "with incorrect parameter" $ ("222", "", "NEW T hi subscribe") >#> ("222", "", "ERR CMD SYNTAX parseCommand")
describe "JOIN" $ do
describe "valid" $ do
@@ -636,7 +635,7 @@ syntaxTests t = do
)
>#> ("311", "a", "ERR SMP smp://LcJUMfVhwD8yxjAiSaDzzGF3-kLG4Uh0Fl_ZIjrRwjI=@localhost:5001 AUTH")
describe "invalid" $ do
it "no parameters" $ ("321", "", "JOIN") >#> ("321", "", "ERR CMD SYNTAX")
it "no parameters" $ ("321", "", "JOIN") >#> ("321", "", "ERR CMD SYNTAX parseCommand")
where
-- simple test for one command with the expected response
(>#>) :: ARawTransmission -> ARawTransmission -> Expectation
+5 -6
View File
@@ -14,7 +14,6 @@
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# OPTIONS_GHC -Wno-orphans #-}
{-# OPTIONS_GHC -fno-warn-incomplete-uni-patterns #-}
module AgentTests.FunctionalAPITests
( functionalAPITests,
@@ -575,13 +574,13 @@ testEnablePQEncryption =
-- switched to smaller envelopes (before reporting PQ encryption enabled)
sml <- largeMsg g PQSupportOn
-- fail because of message size
Left (A.CMD LARGE) <- tryError $ A.sendMessage ca bId PQEncOn SMP.noMsgFlags lrg
Left (A.CMD LARGE _) <- tryError $ A.sendMessage ca bId PQEncOn SMP.noMsgFlags lrg
(9, PQEncOff) <- A.sendMessage ca bId PQEncOn SMP.noMsgFlags sml
get ca =##> \case ("", connId, SENT 9) -> connId == bId; _ -> False
get cb =##> \case ("", connId, MsgErr' 8 MsgSkipped {} PQEncOff msg') -> connId == aId && msg' == sml; _ -> False
ackMessage cb aId 8 Nothing
-- -- fail in reply to sync IDss
Left (A.CMD LARGE) <- tryError $ A.sendMessage cb aId PQEncOn SMP.noMsgFlags lrg
Left (A.CMD LARGE _) <- tryError $ A.sendMessage cb aId PQEncOn SMP.noMsgFlags lrg
(10, PQEncOff) <- A.sendMessage cb aId PQEncOn SMP.noMsgFlags sml
get cb =##> \case ("", connId, SENT 10) -> connId == aId; _ -> False
get ca =##> \case ("", connId, MsgErr' 10 MsgSkipped {} PQEncOff msg') -> connId == bId && msg' == sml; _ -> False
@@ -608,8 +607,8 @@ testEnablePQEncryption =
(b, 26, sml) \#>\ a
(a, 27, sml) \#>\ b
-- PQ encryption is now disabled, but support remained enabled, so we still cannot send larger messages
Left (A.CMD LARGE) <- tryError $ A.sendMessage ca bId PQEncOff SMP.noMsgFlags (sml <> "123456")
Left (A.CMD LARGE) <- tryError $ A.sendMessage cb aId PQEncOff SMP.noMsgFlags (sml <> "123456")
Left (A.CMD LARGE _) <- tryError $ A.sendMessage ca bId PQEncOff SMP.noMsgFlags (sml <> "123456")
Left (A.CMD LARGE _) <- tryError $ A.sendMessage cb aId PQEncOff SMP.noMsgFlags (sml <> "123456")
pure ()
where
(\#>\) = PQEncOff `sndRcv` PQEncOff
@@ -2480,7 +2479,7 @@ testDeliveryReceipts =
get a =##> \case ("", c, Msg "hello too") -> c == bId; _ -> False
ackMessage a bId 6 $ Just ""
get b =##> \case ("", c, Rcvd 6) -> c == aId; _ -> False
ackMessage b aId 7 (Just "") `catchError` \e -> liftIO $ e `shouldBe` A.CMD PROHIBITED
ackMessage b aId 7 (Just "") `catchError` \case (A.CMD PROHIBITED _) -> pure (); e -> liftIO $ expectationFailure ("unexpected error " <> show e)
ackMessage b aId 7 Nothing
testDeliveryReceiptsVersion :: HasCallStack => ATransport -> IO ()
+2 -3
View File
@@ -7,7 +7,6 @@
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE TypeApplications #-}
{-# OPTIONS_GHC -fno-warn-ambiguous-fields #-}
{-# OPTIONS_GHC -fno-warn-incomplete-uni-patterns #-}
module AgentTests.NotificationTests where
@@ -182,7 +181,7 @@ testNotificationToken APNSMockServer {apnsQ} = do
NTActive <- checkNtfToken a tkn
deleteNtfToken a tkn
-- agent deleted this token
Left (CMD PROHIBITED) <- tryE $ checkNtfToken a tkn
Left (CMD PROHIBITED _) <- tryE $ checkNtfToken a tkn
pure ()
(.->) :: J.Value -> J.Key -> ExceptT AgentErrorType IO ByteString
@@ -375,7 +374,7 @@ testNotificationSubscriptionExistingConnection APNSMockServer {apnsQ} alice@Agen
pure (bobId, aliceId, nonce, message)
-- alice client already has subscription for the connection
Left (CMD PROHIBITED) <- runExceptT $ getNotificationMessage alice nonce message
Left (CMD PROHIBITED _) <- runExceptT $ getNotificationMessage alice nonce message
-- aliceNtf client doesn't have subscription and is allowed to get notification message
withAgent 3 aliceCfg initAgentServers testDB $ \aliceNtf -> runRight_ $ do