agent store: add deleteConn and tests

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

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
       )
   |]
 

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