agent store: make newtypes for msg internal Ids (#68)

This commit is contained in:
Efim Poberezkin
2021-03-04 23:19:12 +04:00
committed by GitHub
parent 93e782b874
commit 11c8bee836
4 changed files with 24 additions and 11 deletions
+2 -2
View File
@@ -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
+4 -3
View File
@@ -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
+16 -4
View File
@@ -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
+2 -2
View File
@@ -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