From a1c4ce6448bb297e33d9a4435949f45b0b56274b Mon Sep 17 00:00:00 2001 From: Evgeny Poberezkin <2769109+epoberezkin@users.noreply.github.com> Date: Sat, 9 Jan 2021 13:04:13 +0000 Subject: [PATCH] refactor store: simplify --- src/Simplex/Messaging/Agent/Store/SQLite.hs | 83 ++++++++------------- 1 file changed, 32 insertions(+), 51 deletions(-) diff --git a/src/Simplex/Messaging/Agent/Store/SQLite.hs b/src/Simplex/Messaging/Agent/Store/SQLite.hs index d9ed22e75..3ea272ac8 100644 --- a/src/Simplex/Messaging/Agent/Store/SQLite.hs +++ b/src/Simplex/Messaging/Agent/Store/SQLite.hs @@ -19,6 +19,7 @@ import Control.Monad import Control.Monad.Except import Control.Monad.IO.Unlift import Data.Int (Int64) +import Data.Maybe import qualified Data.Text as T import Database.SQLite.Simple hiding (Connection) import qualified Database.SQLite.Simple as DB @@ -30,7 +31,6 @@ import Multiline (s) import Simplex.Messaging.Agent.Store import Simplex.Messaging.Agent.Store.SQLite.Schema import Simplex.Messaging.Agent.Transmission -import Simplex.Messaging.Server.Transmission (PublicKey, QueueId) import Simplex.Messaging.Util import Text.Read import qualified UnliftIO.Exception as E @@ -308,38 +308,34 @@ instance (MonadUnliftIO m, MonadError StoreError m) => MonadAgentStore SQLiteSto addServer store smpServer = upsertServer store smpServer createRcvConn :: SQLiteStore -> ConnAlias -> ReceiveQueue -> m () - createRcvConn st connAlias rcvQueue = + createRcvConn st connAlias rcvQueue = do -- TODO test for duplicate connAlias - upsertServer st (server (rcvQueue :: ReceiveQueue)) - >>= addConnection - where - addConnection serverId = - insertRcvQueue st serverId rcvQueue - >>= insertRcvConnection st connAlias + srvId <- upsertServer st (server (rcvQueue :: ReceiveQueue)) + rcvQId <- insertRcvQueue st srvId rcvQueue + insertRcvConnection st connAlias rcvQId createSndConn :: SQLiteStore -> ConnAlias -> SendQueue -> m () - createSndConn st connAlias sndQueue = - upsertServer st (server (sndQueue :: SendQueue)) - >>= addConnection - where - addConnection serverId = - -- TODO test for duplicate connAlias - insertSndQueue st serverId sndQueue - >>= insertSndConnection st connAlias + createSndConn st connAlias sndQueue = do + -- TODO test for duplicate connAlias + srvId <- upsertServer st (server (sndQueue :: SendQueue)) + sndQ <- insertSndQueue st srvId sndQueue + insertSndConnection st connAlias sndQ -- TODO refactor ito a single query with join, and parse as `Only connAlias :. rcvQueue :. sndQueue` getConn :: SQLiteStore -> ConnAlias -> m SomeConn - getConn st connAlias = + getConn st connAlias = do getConnection st connAlias >>= \case (Just rcvQId, Just sndQId) -> do rcvQ <- getRcvQueue st rcvQId sndQ <- getSndQueue st sndQId return $ SomeConn SCDuplex (DuplexConnection connAlias rcvQ sndQ) - (Just rcvQId, _) -> - SomeConn SCReceive . ReceiveConnection connAlias <$> getRcvQueue st rcvQId - (_, Just sndQId) -> - SomeConn SCSend . SendConnection connAlias <$> getSndQueue st sndQId - (_, _) -> throwError SEBadConn + (Just rcvQId, _) -> do + rcvQ <- getRcvQueue st rcvQId + return $ SomeConn SCReceive (ReceiveConnection connAlias rcvQ) + (_, Just sndQId) -> do + sndQ <- getSndQueue st sndQId + return $ SomeConn SCSend (SendConnection connAlias sndQ) + _ -> throwError SEBadConn -- TODO make transactional addSndQueue :: SQLiteStore -> ConnAlias -> SendQueue -> m () @@ -348,14 +344,10 @@ instance (MonadUnliftIO m, MonadError StoreError m) => MonadAgentStore SQLiteSto >>= \case SomeConn SCDuplex _ -> throwError (SEBadConnType CDuplex) SomeConn SCSend _ -> throwError (SEBadConnType CSend) - SomeConn SCReceive _ -> - upsertServer st (server (sndQueue :: SendQueue)) - >>= updateConn - where - updateConn :: SMPServerId -> m () - updateConn servId = - insertSndQueue st servId sndQueue - >>= updateRcvConnectionWithSndQueue st connAlias + SomeConn SCReceive _ -> do + srvId <- upsertServer st (server (sndQueue :: SendQueue)) + sndQ <- insertSndQueue st srvId sndQueue + updateRcvConnectionWithSndQueue st connAlias sndQ -- TODO make transactional addRcvQueue :: SQLiteStore -> ConnAlias -> ReceiveQueue -> m () @@ -364,14 +356,10 @@ instance (MonadUnliftIO m, MonadError StoreError m) => MonadAgentStore SQLiteSto >>= \case SomeConn SCDuplex _ -> throwError (SEBadConnType CDuplex) SomeConn SCReceive _ -> throwError (SEBadConnType CReceive) - SomeConn SCSend _ -> - upsertServer st (server (rcvQueue :: ReceiveQueue)) - >>= updateConn - where - updateConn :: SMPServerId -> m () - updateConn servId = - insertRcvQueue st servId rcvQueue - >>= updateSndConnectionWithRcvQueue st connAlias + SomeConn SCSend _ -> do + srvId <- upsertServer st (server (rcvQueue :: ReceiveQueue)) + rcvQ <- insertRcvQueue st srvId rcvQueue + updateSndConnectionWithRcvQueue st connAlias rcvQ -- 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 @@ -381,16 +369,9 @@ instance (MonadUnliftIO m, MonadError StoreError m) => MonadAgentStore SQLiteSto -- ? See https://sqlite.org/foreignkeys.html#fk_deferred -- - Keep as is and just wrap in transaction? deleteConn :: SQLiteStore -> ConnAlias -> m () - deleteConn st connAlias = - getConnection st connAlias >>= \case - (Just rcvQId, Just sndQId) -> do - deleteRcvQueue st rcvQId - deleteSndQueue st sndQId - deleteConnection st connAlias - (Just rcvQId, _) -> do - deleteRcvQueue st rcvQId - deleteConnection st connAlias - (_, Just sndQId) -> do - deleteSndQueue st sndQId - deleteConnection st connAlias - (_, _) -> throwError SEBadConn + deleteConn st connAlias = do + (rcvQId, sndQId) <- getConnection st connAlias + forM_ rcvQId $ deleteRcvQueue st + forM_ sndQId $ deleteSndQueue st + deleteConnection st connAlias + when (isNothing rcvQId && isNothing sndQId) $ throwError SEBadConn