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

agent store: make create connection methods return ()

Browse Source
This commit is contained in:
Efim Poberezkin
2021-01-08 15:51:33 +04:00
parent 19238c6cc4
commit af5bd101cb
3 changed files with 10 additions and 10 deletions
Download Patch File Download Diff File Expand all files Collapse all files

4
src/Simplex/Messaging/Agent/Store.hs
View File

@@ -95,8 +95,8 @@ type SMPServerId = Int64
class Monad m => MonadAgentStore s m where
addServer :: s -> SMPServer -> m (Either StoreError SMPServerId)
createRcvConn :: s -> ConnAlias -> ReceiveQueue -> m (Either StoreError (Connection CReceive))
createSndConn :: s -> ConnAlias -> SendQueue -> m (Either StoreError (Connection CSend))
createRcvConn :: s -> ConnAlias -> ReceiveQueue -> m (Either StoreError ())
createSndConn :: s -> ConnAlias -> SendQueue -> m (Either StoreError ())
getConn :: s -> ConnAlias -> m (Either StoreError SomeConn)
deleteConn :: s -> ConnAlias -> m (Either StoreError ())
addSndQueue :: s -> ConnAlias -> SendQueue -> m (Either StoreError ())

12
src/Simplex/Messaging/Agent/Store/SQLite.hs
View File

@@ -297,25 +297,25 @@ deleteConnection store connAlias = do
instance MonadUnliftIO m => MonadAgentStore SQLiteStore m where
addServer store smpServer = upsertServer store smpServer
createRcvConn :: SQLiteStore -> ConnAlias -> ReceiveQueue -> m (Either StoreError (Connection CReceive))
createRcvConn :: SQLiteStore -> ConnAlias -> ReceiveQueue -> m (Either StoreError ())
createRcvConn st connAlias rcvQueue =
upsertServer st (server (rcvQueue :: ReceiveQueue))
>>= either (return . Left) (fmap Right . addConnection)
where
addConnection serverId = do
qId <- insertRcvQueue st serverId rcvQueue -- TODO test for duplicate connAlias
insertRcvConnection st connAlias qId
return $ ReceiveConnection connAlias rcvQueue
_ <- insertRcvConnection st connAlias qId
return ()
createSndConn :: SQLiteStore -> ConnAlias -> SendQueue -> m (Either StoreError (Connection CSend))
createSndConn :: SQLiteStore -> ConnAlias -> SendQueue -> m (Either StoreError ())
createSndConn st connAlias sndQueue =
upsertServer st (server (sndQueue :: SendQueue))
>>= either (return . Left) (fmap Right . addConnection)
where
addConnection serverId = do
qId <- insertSndQueue st serverId sndQueue -- TODO test for duplicate connAlias
insertSndConnection st connAlias qId
return $ SendConnection connAlias sndQueue
_ <- insertSndConnection st connAlias qId
return ()
-- TODO refactor ito a single query with join, and parse as `Only connAlias :. rcvQueue :. sndQueue`
getConn :: SQLiteStore -> ConnAlias -> m (Either StoreError SomeConn)

4
tests/AgentTests/SQLite.hs
View File

@@ -46,7 +46,7 @@ testCreateRcvConn = do
ackMode = AckMode On
}
createRcvConn store "conn1" rcvQueue
`shouldReturn` Right (ReceiveConnection "conn1" rcvQueue)
`shouldReturn` Right ()
getConn store "conn1"
`shouldReturn` Right (SomeConn SCReceive $ ReceiveConnection "conn1" rcvQueue)
let sndQueue =
@@ -78,7 +78,7 @@ testCreateSndConn = do
ackMode = AckMode On
}
createSndConn store "conn1" sndQueue
`shouldReturn` Right (SendConnection "conn1" sndQueue)
`shouldReturn` Right ()
getConn store "conn1"
`shouldReturn` Right (SomeConn SCSend $ SendConnection "conn1" sndQueue)
let rcvQueue =