From 11c8bee83615d4b7946da8584134282031dae42d Mon Sep 17 00:00:00 2001
From: Efim Poberezkin <efim.poberezkin@gmail.com>
Date: Thu, 4 Mar 2021 23:19:12 +0400
Subject: [PATCH] agent store: make newtypes for msg internal Ids (#68)

---
 src/Simplex/Messaging/Agent.hs              |  4 ++--
 src/Simplex/Messaging/Agent/Store.hs        |  7 ++++---
 src/Simplex/Messaging/Agent/Store/SQLite.hs | 20 ++++++++++++++++----
 tests/AgentTests/SQLiteTests.hs             |  4 ++--
 4 files changed, 24 insertions(+), 11 deletions(-)

diff --git a/src/Simplex/Messaging/Agent.hs b/src/Simplex/Messaging/Agent.hs
index 50652d9f0..9d3a650cb 100644
--- a/src/Simplex/Messaging/Agent.hs
+++ b/src/Simplex/Messaging/Agent.hs
@@ -170,7 +170,7 @@ processCommand c@AgentClient {sndQ} st (corrId, connAlias, cmd) =
           senderTs <- liftIO getCurrentTime
           senderId <- withStore $ createSndMsg st connAlias msgBody senderTs
           sendAgentMessage c sq senderTs $ A_MSG msgBody
-          respond $ SENT senderId
+          respond $ SENT (unId senderId)
 
     suspendConnection :: m ()
     suspendConnection =
@@ -259,7 +259,7 @@ processSMPTransmission c@AgentClient {sndQ} st (srv, rId, cmd) = do
               notify connAlias $
                 MSG
                   { m_status = MsgOk,
-                    m_recipient = (recipientId, recipientTs),
+                    m_recipient = (unId recipientId, recipientTs),
                     m_sender,
                     m_broker,
                     m_body = body
diff --git a/src/Simplex/Messaging/Agent/Store.hs b/src/Simplex/Messaging/Agent/Store.hs
index 1aa90b5e9..8b57a2a72 100644
--- a/src/Simplex/Messaging/Agent/Store.hs
+++ b/src/Simplex/Messaging/Agent/Store.hs
@@ -152,7 +152,8 @@ data RcvMsg = RcvMsg
   }
   deriving (Eq, Show)
 
-type InternalRcvId = Int64
+-- internal Ids are newtypes to prevent mixing them up
+newtype InternalRcvId = InternalRcvId {unRcvId :: Int64} deriving (Eq, Show)
 
 type ExternalSndId = Int64
 
@@ -185,7 +186,7 @@ data SndMsg = SndMsg
   }
   deriving (Eq, Show)
 
-type InternalSndId = Int64
+newtype InternalSndId = InternalSndId {unSndId :: Int64} deriving (Eq, Show)
 
 data SndMsgStatus
   = Created
@@ -211,7 +212,7 @@ data MsgBase = MsgBase
   }
   deriving (Eq, Show)
 
-type InternalId = Int64
+newtype InternalId = InternalId {unId :: Int64} deriving (Eq, Show)
 
 type InternalTs = UTCTime
 
diff --git a/src/Simplex/Messaging/Agent/Store/SQLite.hs b/src/Simplex/Messaging/Agent/Store/SQLite.hs
index 54586352d..bd6bcd4b7 100644
--- a/src/Simplex/Messaging/Agent/Store/SQLite.hs
+++ b/src/Simplex/Messaging/Agent/Store/SQLite.hs
@@ -153,6 +153,18 @@ instance ToField QueueStatus where toField = toField . show
 
 instance FromField QueueStatus where fromField = fromFieldToReadable_
 
+instance ToField InternalRcvId where toField (InternalRcvId x) = toField x
+
+instance FromField InternalRcvId where fromField x = InternalRcvId <$> fromField x
+
+instance ToField InternalSndId where toField (InternalSndId x) = toField x
+
+instance FromField InternalSndId where fromField x = InternalSndId <$> fromField x
+
+instance ToField InternalId where toField (InternalId x) = toField x
+
+instance FromField InternalId where fromField x = InternalId <$> fromField x
+
 instance ToField RcvMsgStatus where toField = toField . show
 
 instance ToField SndMsgStatus where toField = toField . show
@@ -472,8 +484,8 @@ insertRcvMsg dbConn connAlias msgBody internalTs (externalSndId, externalSndTs)
     case queues of
       (Just _rcvQ, _) -> do
         (lastInternalId, lastInternalRcvId) <- retrieveLastInternalIdsRcv_ dbConn connAlias
-        let internalId = lastInternalId + 1
-        let internalRcvId = lastInternalRcvId + 1
+        let internalId = InternalId $ unId lastInternalId + 1
+        let internalRcvId = InternalRcvId $ unRcvId lastInternalRcvId + 1
         insertRcvMsgBase_ dbConn connAlias internalId internalTs internalRcvId msgBody
         insertRcvMsgDetails_ dbConn connAlias internalRcvId internalId (externalSndId, externalSndTs) (brokerId, brokerTs)
         updateLastInternalIdsRcv_ dbConn connAlias internalId internalRcvId
@@ -563,8 +575,8 @@ insertSndMsg dbConn connAlias msgBody internalTs =
     case queues of
       (_, Just _sndQ) -> do
         (lastInternalId, lastInternalSndId) <- retrieveLastInternalIdsSnd_ dbConn connAlias
-        let internalId = lastInternalId + 1
-        let internalSndId = lastInternalSndId + 1
+        let internalId = InternalId $ unId lastInternalId + 1
+        let internalSndId = InternalSndId $ unSndId lastInternalSndId + 1
         insertSndMsgBase_ dbConn connAlias internalId internalTs internalSndId msgBody
         insertSndMsgDetails_ dbConn connAlias internalSndId internalId
         updateLastInternalIdsSnd_ dbConn connAlias internalId internalSndId
diff --git a/tests/AgentTests/SQLiteTests.hs b/tests/AgentTests/SQLiteTests.hs
index f46d27156..000cccc75 100644
--- a/tests/AgentTests/SQLiteTests.hs
+++ b/tests/AgentTests/SQLiteTests.hs
@@ -304,7 +304,7 @@ testCreateRcvMsg = do
     -- TODO getMsg to check message
     let ts = UTCTime (fromGregorian 2021 02 24) (secondsToDiffTime 0)
     createRcvMsg store "conn1" (encodeUtf8 "Hello world!") ts (1, ts) ("1", ts)
-      `returnsResult` (1 :: InternalId)
+      `returnsResult` InternalId 1
 
 testCreateRcvMsgNoQueue :: SpecWith SQLiteStore
 testCreateRcvMsgNoQueue = do
@@ -325,7 +325,7 @@ testCreateSndMsg = do
     -- TODO getMsg to check message
     let ts = UTCTime (fromGregorian 2021 02 24) (secondsToDiffTime 0)
     createSndMsg store "conn1" (encodeUtf8 "Hello world!") ts
-      `returnsResult` (1 :: InternalId)
+      `returnsResult` InternalId 1
 
 testCreateSndMsgNoQueue :: SpecWith SQLiteStore
 testCreateSndMsgNoQueue = do