From 19238c6cc47f6950bce12e1cee1a1855cbfaba48 Mon Sep 17 00:00:00 2001 From: Efim Poberezkin Date: Thu, 7 Jan 2021 17:49:32 +0400 Subject: [PATCH] agent store: add deleteConn and tests --- src/Simplex/Messaging/Agent/Store/SQLite.hs | 73 +++++++++++++++++ .../Messaging/Agent/Store/SQLite/Schema.hs | 4 +- tests/AgentTests/SQLite.hs | 81 +++++++++++++++++++ 3 files changed, 156 insertions(+), 2 deletions(-) diff --git a/src/Simplex/Messaging/Agent/Store/SQLite.hs b/src/Simplex/Messaging/Agent/Store/SQLite.hs index 540303772..923ddb393 100644 --- a/src/Simplex/Messaging/Agent/Store/SQLite.hs +++ b/src/Simplex/Messaging/Agent/Store/SQLite.hs @@ -270,6 +270,30 @@ getConnection SQLiteStore {conn} connAlias = liftIO $ do [queueIds] -> Right queueIds _ -> Left SEInternal +deleteRcvQueue :: MonadUnliftIO m => SQLiteStore -> QueueRowId -> m () +deleteRcvQueue store rcvQueueId = do + executeWithLock + store + rcvQueuesLock + "DELETE FROM receive_queues WHERE receive_queue_id = ?" + (Only rcvQueueId) + +deleteSndQueue :: MonadUnliftIO m => SQLiteStore -> QueueRowId -> m () +deleteSndQueue store sndQueueId = do + executeWithLock + store + sndQueuesLock + "DELETE FROM send_queues WHERE send_queue_id = ?" + (Only sndQueueId) + +deleteConnection :: MonadUnliftIO m => SQLiteStore -> ConnAlias -> m () +deleteConnection store connAlias = do + executeWithLock + store + connectionsLock + "DELETE FROM connections WHERE conn_alias = ?" + (Only connAlias) + instance MonadUnliftIO m => MonadAgentStore SQLiteStore m where addServer store smpServer = upsertServer store smpServer @@ -347,3 +371,52 @@ instance MonadUnliftIO m => MonadAgentStore SQLiteStore m where updateConn servId = insertRcvQueue st servId rcvQueue >>= updateSndConnectionWithRcvQueue st connAlias + + -- TODO think about design of one-to-one relationships between connections ans send/receive queues + -- - Make wide `connections` table? -> Leads to inability to constrain queue fields on SQL level + -- - Make bi-directional foreign keys deferred on queue side? + -- * Involves populating foreign keys on queues' tables and reworking store + -- * Enables cascade deletes + -- ? See https://sqlite.org/foreignkeys.html#fk_deferred + -- - Keep as is and just wrap in transaction? + deleteConn :: SQLiteStore -> ConnAlias -> m (Either StoreError ()) + deleteConn st connAlias = + getConnection st connAlias >>= \case + Left e -> return $ Left e + Right (Just rcvQId, Just sndQId) -> do + _ <- deleteRcvQueue st rcvQId + _ <- deleteSndQueue st sndQId + _ <- deleteConnection st connAlias + return $ Right () + Right (Just rcvQId, _) -> do + _ <- deleteRcvQueue st rcvQId + _ <- deleteConnection st connAlias + return $ Right () + Right (_, Just sndQId) -> do + _ <- deleteSndQueue st sndQId + _ <- deleteConnection st connAlias + return $ Right () + Right (_, _) -> return $ Left SEBadConn + +-- ? Need to work around ambiguous occurence of sndId +-- deleteConn :: SQLiteStore -> ConnAlias -> m (Either StoreError ()) +-- deleteConn st connAlias = +-- getConn st connAlias +-- >>= either (return . Left) checkDeleteConn +-- where +-- checkDeleteConn :: SomeConn -> m (Either StoreError ()) +-- checkDeleteConn = \case +-- SomeConn SCDuplex conn -> do +-- _ <- deleteRcvQueue st $ rcvId (ReceiveQueue (conn :: Connection CDuplex)) +-- _ <- deleteSndQueue st $ sndId (SendQueue (conn :: Connection CDuplex)) +-- either (return . Left) (fmap Right . delConn) +-- SomeConn SCReceive conn -> do +-- _ <- deleteRcvQueue st $ rcvId (ReceiveQueue (conn :: Connection CReceive)) +-- either (return . Left) (fmap Right . delConn) +-- SomeConn SCSend conn -> do +-- _ <- deleteSndQueue st $ sndId (SendQueue (conn :: Connection CSend)) +-- either (return . Left) (fmap Right . delConn) + +-- delConn :: ConnAlias -> m () +-- delConn cAlias = +-- deleteConnection st cAlias diff --git a/src/Simplex/Messaging/Agent/Store/SQLite/Schema.hs b/src/Simplex/Messaging/Agent/Store/SQLite/Schema.hs index f17236e9f..698e85770 100644 --- a/src/Simplex/Messaging/Agent/Store/SQLite/Schema.hs +++ b/src/Simplex/Messaging/Agent/Store/SQLite/Schema.hs @@ -60,8 +60,8 @@ connections = CREATE TABLE IF NOT EXISTS connections ( connection_id INTEGER PRIMARY KEY, conn_alias TEXT UNIQUE, - receive_queue_id INTEGER REFERENCES recipient_queues(receive_queue_id), - send_queue_id INTEGER REFERENCES sender_queues(send_queue_id) + receive_queue_id INTEGER REFERENCES recipient_queues(receive_queue_id) UNIQUE, + send_queue_id INTEGER REFERENCES sender_queues(send_queue_id) UNIQUE ) |] diff --git a/tests/AgentTests/SQLite.hs b/tests/AgentTests/SQLite.hs index ba28c02a6..01851e552 100644 --- a/tests/AgentTests/SQLite.hs +++ b/tests/AgentTests/SQLite.hs @@ -26,6 +26,9 @@ storeTests = withStore do describe "createSndConn" testCreateSndConn describe "addSndQueue" testAddSndQueue describe "addRcvQueue" testAddRcvQueue + describe "deleteConnReceive" testDeleteConnReceive + describe "deleteConnSend" testDeleteConnSend + describe "deleteConnDuplex" testDeleteConnDuplex testCreateRcvConn :: SpecWith SQLiteStore testCreateRcvConn = do @@ -180,3 +183,81 @@ testAddRcvQueue = do _ <- addSndQueue store "conn1" sndQueue addRcvQueue store "conn1" anotherRcvQueue `shouldReturn` Left (SEBadConnType CDuplex) + +testDeleteConnReceive :: SpecWith SQLiteStore +testDeleteConnReceive = do + it "should create receive connection and delete it" $ \store -> do + let rcvQueue = + ReceiveQueue + { server = SMPServer "smp.simplex.im" (Just "5223") (Just "1234"), + rcvId = "1234", + rcvPrivateKey = "abcd", + sndId = Just "2345", + sndKey = Nothing, + decryptKey = "dcba", + verifyKey = Nothing, + status = New, + ackMode = AckMode On + } + _ <- createRcvConn store "conn1" rcvQueue + getConn store "conn1" + `shouldReturn` Right (SomeConn SCReceive $ ReceiveConnection "conn1" rcvQueue) + deleteConn store "conn1" + `shouldReturn` Right () + getConn store "conn1" + `shouldReturn` Left SEInternal + +testDeleteConnSend :: SpecWith SQLiteStore +testDeleteConnSend = do + it "should create send connection and delete it" $ \store -> do + let sndQueue = + SendQueue + { server = SMPServer "smp.simplex.im" (Just "5223") (Just "1234"), + sndId = "1234", + sndPrivateKey = "abcd", + encryptKey = "dcba", + signKey = "edcb", + status = New, + ackMode = AckMode On + } + _ <- createSndConn store "conn1" sndQueue + getConn store "conn1" + `shouldReturn` Right (SomeConn SCSend $ SendConnection "conn1" sndQueue) + deleteConn store "conn1" + `shouldReturn` Right () + getConn store "conn1" + `shouldReturn` Left SEInternal + +testDeleteConnDuplex :: SpecWith SQLiteStore +testDeleteConnDuplex = do + it "should create duplex connection and delete it" $ \store -> do + let rcvQueue = + ReceiveQueue + { server = SMPServer "smp.simplex.im" (Just "5223") (Just "1234"), + rcvId = "1234", + rcvPrivateKey = "abcd", + sndId = Just "2345", + sndKey = Nothing, + decryptKey = "dcba", + verifyKey = Nothing, + status = New, + ackMode = AckMode On + } + _ <- createRcvConn store "conn1" rcvQueue + 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 "conn1" sndQueue + getConn store "conn1" + `shouldReturn` Right (SomeConn SCDuplex $ DuplexConnection "conn1" rcvQueue sndQueue) + deleteConn store "conn1" + `shouldReturn` Right () + getConn store "conn1" + `shouldReturn` Left SEInternal