dandri/simplexmq
1
0
Fork 0
mirror of https://github.com/simplex-chat/simplexmq.git synced 2026-07-21 09:02:05 +00:00
Code Issues Packages Projects Releases Wiki Activity

add addRcvQueue and tests

Browse Source
This commit is contained in:
Efim Poberezkin
2021-01-07 14:00:53 +04:00
parent 51cc602bdb
commit e692cb0119
4 changed files with 114 additions and 7 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Simplex/Messaging/Agent/Store.hs
+1 -1
View File
@@ -100,7 +100,7 @@ class Monad m => MonadAgentStore s m where
getConn :: s -> ConnAlias -> m (Either StoreError SomeConn)
deleteConn :: s -> ConnAlias -> m (Either StoreError ())
addSndQueue :: s -> ConnAlias -> SendQueue -> m (Either StoreError ())
addRcvQueue :: s -> ConnAlias -> SendQueue -> m (Either StoreError ())
addRcvQueue :: s -> ConnAlias -> ReceiveQueue -> m (Either StoreError ())
removeSndAuth :: s -> ConnAlias -> m (Either StoreError ())
updateQueueStatus :: s -> ConnAlias -> QueueDirection -> QueueStatus -> m (Either StoreError ())
createMsg :: s -> ConnAlias -> QueueDirection -> AMessage -> m (Either StoreError MessageDelivery)
src/Simplex/Messaging/Agent/Store/SQLite.hs
+34 -3
View File
@@ -96,8 +96,8 @@ insertWithLock st tableLock queryStr q = do
DB.execute c queryStr q
DB.lastInsertRowId c
updateWithLock :: (MonadUnliftIO m, ToRow q) => SQLiteStore -> (SQLiteStore -> TMVar ()) -> DB.Query -> q -> m ()
updateWithLock st tableLock queryStr q = do
executeWithLock :: (MonadUnliftIO m, ToRow q) => SQLiteStore -> (SQLiteStore -> TMVar ()) -> DB.Query -> q -> m ()
executeWithLock st tableLock queryStr q = do
withLock st tableLock $ \c -> liftIO $ do
DB.execute c queryStr q
@@ -210,7 +210,7 @@ insertRcvConnection store connAlias rcvQueueId =
updateRcvConnectionWithSndQueue :: MonadUnliftIO m => SQLiteStore -> ConnAlias -> QueueRowId -> m ()
updateRcvConnectionWithSndQueue store connAlias sndQueueId =
updateWithLock
executeWithLock
store
connectionsLock
[s|
@@ -247,6 +247,18 @@ insertSndConnection store connAlias sndQueueId =
"INSERT INTO connections (conn_alias, receive_queue_id, send_queue_id) VALUES (?,NULL,?);"
(Only connAlias :. Only sndQueueId)
updateSndConnectionWithRcvQueue :: MonadUnliftIO m => SQLiteStore -> ConnAlias -> QueueRowId -> m ()
updateSndConnectionWithRcvQueue store connAlias rcvQueueId =
executeWithLock
store
connectionsLock
[s|
UPDATE connections
SET receive_queue_id = ?
WHERE conn_alias = ?;
|]
(Only rcvQueueId :. Only connAlias)
getConnection :: MonadUnliftIO m => SQLiteStore -> ConnAlias -> m (Either StoreError (Maybe QueueRowId, Maybe QueueRowId))
getConnection SQLiteStore {conn} connAlias = liftIO $ do
r <-
@@ -316,3 +328,22 @@ instance MonadUnliftIO m => MonadAgentStore SQLiteStore m where
updateConn servId =
insertSndQueue st servId sndQueue
>>= updateRcvConnectionWithSndQueue st connAlias
-- TODO make transactional
addRcvQueue :: SQLiteStore -> ConnAlias -> ReceiveQueue -> m (Either StoreError ())
addRcvQueue st connAlias rcvQueue =
getConn st connAlias
>>= either (return . Left) checkUpdateConn
where
checkUpdateConn :: SomeConn -> m (Either StoreError ())
checkUpdateConn = \case
SomeConn SCDuplex _ -> return $ Left (SEBadConnType CDuplex)
SomeConn SCReceive _ -> return $ Left (SEBadConnType CReceive)
SomeConn SCSend _ ->
upsertServer st (server (rcvQueue :: ReceiveQueue))
>>= either (return . Left) (fmap Right . updateConn)
updateConn :: SMPServerId -> m ()
updateConn servId =
insertRcvQueue st servId rcvQueue
>>= updateSndConnectionWithRcvQueue st connAlias
src/Simplex/Messaging/Agent/Store/SQLite/Schema.hs
+2 -2
View File
@@ -19,7 +19,6 @@ servers =
)
|]
-- TODO unique constraints on (server_id, rcv_id) and (server_id, snd_id)
receiveQueues :: Query
receiveQueues =
[s|
@@ -50,7 +49,8 @@ sendQueues =
encrypt_key BLOB NOT NULL,
sign_key BLOB NOT NULL,
status TEXT NOT NULL,
ack_mode INTEGER NOT NULL
ack_mode INTEGER NOT NULL,
UNIQUE (server_id, snd_id)
)
|]
tests/AgentTests/SQLite.hs
+77 -1
View File
@@ -25,6 +25,7 @@ storeTests = withStore do
describe "createRcvConn" testCreateRcvConn
describe "createSndConn" testCreateSndConn
describe "addSndQueue" testAddSndQueue
describe "addRcvQueue" testAddRcvQueue
testCreateRcvConn :: SpecWith SQLiteStore
testCreateRcvConn = do
@@ -62,7 +63,7 @@ testCreateRcvConn = do
testCreateSndConn :: SpecWith SQLiteStore
testCreateSndConn = do
it "should create and get send connection" $ \store -> do
it "should create send connection and add receive queue" $ \store -> do
let sndQueue =
SendQueue
{ server = SMPServer "smp.simplex.im" (Just "5223") (Just "1234"),
@@ -77,6 +78,22 @@ testCreateSndConn = do
`shouldReturn` Right (SendConnection "2" sndQueue)
getConn store "2"
`shouldReturn` Right (SomeConn SCSend $ SendConnection "2" sndQueue)
let rcvQueue =
ReceiveQueue
{ server = SMPServer "smp.simplex.im" (Just "5223") (Just "1234"),
rcvId = "2345",
rcvPrivateKey = "abcd",
sndId = Just "2345",
sndKey = Nothing,
decryptKey = "dcba",
verifyKey = Nothing,
status = New,
ackMode = AckMode On
}
addRcvQueue store "2" rcvQueue
`shouldReturn` Right ()
getConn store "2"
`shouldReturn` Right (SomeConn SCDuplex $ DuplexConnection "2" rcvQueue sndQueue)
testAddSndQueue :: SpecWith SQLiteStore
testAddSndQueue = do
@@ -104,3 +121,62 @@ testAddSndQueue = do
}
addSndQueue store "3" anotherSndQueue
`shouldReturn` Left (SEBadConnType CSend)
let rcvQueue =
ReceiveQueue
{ server = SMPServer "smp.simplex.im" (Just "5223") (Just "1234"),
rcvId = "6789",
rcvPrivateKey = "abcd",
sndId = Just "6789",
sndKey = Nothing,
decryptKey = "dcba",
verifyKey = Nothing,
status = New,
ackMode = AckMode On
}
_ <- addRcvQueue store "3" rcvQueue
addSndQueue store "3" anotherSndQueue
`shouldReturn` Left (SEBadConnType CDuplex)
testAddRcvQueue :: SpecWith SQLiteStore
testAddRcvQueue = do
it "should return error on attempts to add receive queue to ReceiveConnection or DuplexConnection" $ \store -> do
let rcvQueue =
ReceiveQueue
{ server = SMPServer "smp.simplex.im" (Just "5223") (Just "1234"),
rcvId = "3456",
rcvPrivateKey = "abcd",
sndId = Just "3456",
sndKey = Nothing,
decryptKey = "dcba",
verifyKey = Nothing,
status = New,
ackMode = AckMode On
}
_ <- createRcvConn store "4" rcvQueue
let anotherRcvQueue =
ReceiveQueue
{ server = SMPServer "smp.simplex.im" (Just "5223") (Just "1234"),
rcvId = "4567",
rcvPrivateKey = "abcd",
sndId = Just "4567",
sndKey = Nothing,
decryptKey = "dcba",
verifyKey = Nothing,
status = New,
ackMode = AckMode On
}
addRcvQueue store "4" anotherRcvQueue
`shouldReturn` Left (SEBadConnType CReceive)
let sndQueue =
SendQueue
{ server = SMPServer "smp.simplex.im" (Just "5223") (Just "1234"),
sndId = "3456",
sndPrivateKey = "abcd",
encryptKey = "dcba",
signKey = "edcb",
status = New,
ackMode = AckMode On
}
_ <- addSndQueue store "4" sndQueue
addRcvQueue store "4" anotherRcvQueue
`shouldReturn` Left (SEBadConnType CDuplex)