dandri/simplexmq
1
0
Fork 0
mirror of https://github.com/simplex-chat/simplexmq.git synced 2026-08-28 05:04:40 +00:00
Code Issues Packages Projects Releases Wiki Activity

change type of agent sendMessage result to AgentMsgId (#183)

Browse Source
This commit is contained in:
Evgeny Poberezkin
2021-08-26 23:25:49 +01:00
committed by GitHub
parent cb950ae2e4
commit 7b5ebf7bd2
2 changed files with 12 additions and 13 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Simplex/Messaging/Agent.hs
+5 -5
View File
@@ -142,7 +142,7 @@ subscribeConnection :: AgentErrorMonad m => AgentClient -> ConnId -> m ()
subscribeConnection c = withAgentClient c . subscribeConnection' c
-- | Send message to the connection (SEND command)
sendMessage :: AgentErrorMonad m => AgentClient -> ConnId -> MsgBody -> m InternalId
sendMessage :: AgentErrorMonad m => AgentClient -> ConnId -> MsgBody -> m AgentMsgId
sendMessage c = withAgentClient c .: sendMessage' c
-- | Suspend SMP agent connection (OFF command)
@@ -231,7 +231,7 @@ processCommand c (connId, cmd) = case cmd of
JOIN smpQueueInfo connInfo -> (,OK) <$> joinConn c connId smpQueueInfo connInfo
ACPT confId ownConnInfo -> acceptConnection' c connId confId ownConnInfo $> (connId, OK)
SUB -> subscribeConnection' c connId $> (connId, OK)
SEND msgBody -> (connId,) . MID . unId <$> sendMessage' c connId msgBody
SEND msgBody -> (connId,) . MID <$> sendMessage' c connId msgBody
OFF -> suspendConnection' c connId $> (connId, OK)
DEL -> deleteConnection' c connId $> (connId, OK)
@@ -327,14 +327,14 @@ subscribeConnection' c connId =
pure r {initialInterval = 5_000_000}
-- | Send message to the connection (SEND command) in Reader monad
sendMessage' :: forall m. AgentMonad m => AgentClient -> ConnId -> MsgBody -> m InternalId
sendMessage' :: forall m. AgentMonad m => AgentClient -> ConnId -> MsgBody -> m AgentMsgId
sendMessage' c connId msg =
withStore (`getConn` connId) >>= \case
SomeConn _ (DuplexConnection _ _ sq) -> enqueueMessage sq
SomeConn _ (SndConnection _ sq) -> enqueueMessage sq
_ -> throwError $ CONN SIMPLEX
where
enqueueMessage :: SndQueue -> m InternalId
enqueueMessage :: SndQueue -> m AgentMsgId
enqueueMessage SndQueue {server} = do
msgId <- storeSentMsg
wasDelivering <- resumeMsgDelivery c connId server
@@ -343,7 +343,7 @@ sendMessage' c connId msg =
then pure [PendingMsg {connId, msgId}]
else withStore (`getPendingMsgs` connId)
queuePendingMsgs c connId pending
pure msgId
pure $ unId msgId
where
storeSentMsg :: m InternalId
storeSentMsg = do
tests/AgentTests/FunctionalAPITests.hs
+7 -8
View File
@@ -14,7 +14,6 @@ import SMPClient (withSmpServer)
import Simplex.Messaging.Agent
import Simplex.Messaging.Agent.Env.SQLite (dbFile)
import Simplex.Messaging.Agent.Protocol
import Simplex.Messaging.Agent.Store (InternalId (..))
import Simplex.Messaging.Protocol (ErrorType (..), MsgBody)
import Simplex.Messaging.Transport (ATransport (..))
import System.Timeout
@@ -61,20 +60,20 @@ testAgentClient = do
get alice ##> ("", bobId, CON)
get bob ##> ("", aliceId, INFO "alice's connInfo")
get bob ##> ("", aliceId, CON)
InternalId 1 <- sendMessage alice bobId "hello"
1 <- sendMessage alice bobId "hello"
get alice ##> ("", bobId, SENT 1)
InternalId 2 <- sendMessage alice bobId "how are you?"
2 <- sendMessage alice bobId "how are you?"
get alice ##> ("", bobId, SENT 2)
get bob =##> \case ("", c, Msg "hello") -> c == aliceId; _ -> False
get bob =##> \case ("", c, Msg "how are you?") -> c == aliceId; _ -> False
InternalId 3 <- sendMessage bob aliceId "hello too"
3 <- sendMessage bob aliceId "hello too"
get bob ##> ("", aliceId, SENT 3)
InternalId 4 <- sendMessage bob aliceId "message 1"
4 <- sendMessage bob aliceId "message 1"
get bob ##> ("", aliceId, SENT 4)
get alice =##> \case ("", c, Msg "hello too") -> c == bobId; _ -> False
get alice =##> \case ("", c, Msg "message 1") -> c == bobId; _ -> False
suspendConnection alice bobId
InternalId 5 <- sendMessage bob aliceId "message 2"
5 <- sendMessage bob aliceId "message 2"
get bob ##> ("", aliceId, MERR 5 (SMP AUTH))
deleteConnection alice bobId
liftIO $ noMessages alice "nothing else should be delivered to alice"
@@ -150,9 +149,9 @@ testAsyncBothOffline = do
exchangeGreetings :: AgentClient -> ConnId -> AgentClient -> ConnId -> ExceptT AgentErrorType IO ()
exchangeGreetings alice bobId bob aliceId = do
InternalId 1 <- sendMessage alice bobId "hello"
1 <- sendMessage alice bobId "hello"
get alice ##> ("", bobId, SENT 1)
get bob =##> \case ("", c, Msg "hello") -> c == aliceId; _ -> False
InternalId 2 <- sendMessage bob aliceId "hello too"
2 <- sendMessage bob aliceId "hello too"
get bob ##> ("", aliceId, SENT 2)
get alice =##> \case ("", c, Msg "hello too") -> c == bobId; _ -> False