mirror of
https://github.com/simplex-chat/simplexmq.git
synced 2026-08-28 05:04:40 +00:00
agent store: make newtypes for msg internal Ids (#68)
This commit is contained in:
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
Reference in New Issue
Block a user