Timestamp and uuid for chat messages
This commit is contained in:
parent
19ce9fd219
commit
635e3f408b
|
@ -62,6 +62,7 @@ library
|
|||
, lifted-base
|
||||
, mtl
|
||||
, text
|
||||
, time
|
||||
, uuid
|
||||
, wai
|
||||
, warp
|
||||
|
@ -87,6 +88,7 @@ executable jitsi-rooms-exe
|
|||
, lifted-base
|
||||
, mtl
|
||||
, text
|
||||
, time
|
||||
, uuid
|
||||
, wai
|
||||
, warp
|
||||
|
|
|
@ -32,6 +32,7 @@ dependencies:
|
|||
- uuid
|
||||
- lifted-base
|
||||
- mtl
|
||||
- time
|
||||
|
||||
ghc-options:
|
||||
- -Wall
|
||||
|
|
|
@ -19,6 +19,8 @@ import Data.Aeson
|
|||
defaultOptions,
|
||||
genericParseJSON,
|
||||
)
|
||||
import Data.Time.Clock.POSIX (POSIXTime)
|
||||
import Data.UUID (UUID)
|
||||
import Types.User (User)
|
||||
|
||||
data WebSocketMessage = ClientInfoMessage SetClientInfo | JoinRoomMessage JoinRoom | AllChatMessageIncomingMessage AllChatMessageIncoming
|
||||
|
@ -50,7 +52,9 @@ instance FromJSON AllChatMessageIncoming
|
|||
|
||||
data AllChatMessageOutgoing = AllChatMessageOutgoing
|
||||
{ content :: Text,
|
||||
sender :: User
|
||||
sender :: User,
|
||||
uuid :: UUID,
|
||||
timestamp :: POSIXTime
|
||||
}
|
||||
deriving (Generic, Show)
|
||||
|
||||
|
|
|
@ -1,18 +1,33 @@
|
|||
{-# LANGUAGE FlexibleInstances #-}
|
||||
{-# LANGUAGE LambdaCase #-}
|
||||
|
||||
module WebSocket.AllChat (broadCastAllChatMessage) where
|
||||
module WebSocket.AllChat (broadCastAllChatMessage, MonadAllChat) where
|
||||
|
||||
import BroadcastUserData (MonadBroadcast (..))
|
||||
import ClassyPrelude
|
||||
import Data.Aeson (encode)
|
||||
import Data.Time.Clock.POSIX
|
||||
import Data.UUID (UUID)
|
||||
import Data.UUID.V4 (nextRandom)
|
||||
import Types.User (clientToUser)
|
||||
import Types.WebSocketMessages.WebSocketMessages (AllChatMessageIncoming (..), AllChatMessageOutgoing (AllChatMessageOutgoing))
|
||||
import WebSocket.MonadWebSocketSession (MonadWebSocketSession (getClient))
|
||||
import WebSocket.WSReaderTApp
|
||||
|
||||
broadCastAllChatMessage :: (MonadBroadcast m, MonadWebSocketSession m) => AllChatMessageIncoming -> m ()
|
||||
class (Monad m) => MonadAllChat m where
|
||||
getMessageId :: m UUID
|
||||
getTimestamp :: m POSIXTime
|
||||
|
||||
instance MonadAllChat (WSApp WSEnv) where
|
||||
getMessageId = liftIO nextRandom
|
||||
getTimestamp = liftIO getPOSIXTime
|
||||
|
||||
broadCastAllChatMessage :: (MonadBroadcast m, MonadWebSocketSession m, MonadAllChat m) => AllChatMessageIncoming -> m ()
|
||||
broadCastAllChatMessage AllChatMessageIncoming {content = message} = do
|
||||
getClient >>= \case
|
||||
Nothing -> return ()
|
||||
Just client -> do
|
||||
let broadCastValue = AllChatMessageOutgoing message (clientToUser client)
|
||||
uuid <- getMessageId
|
||||
timestamp <- getTimestamp
|
||||
let broadCastValue = AllChatMessageOutgoing message (clientToUser client) uuid timestamp
|
||||
broadCastToClients $ (decodeUtf8 . toStrict . encode) broadCastValue
|
||||
|
|
|
@ -13,7 +13,7 @@ import Types.WebSocketMessages.WebSocketMessages
|
|||
( SetClientInfo (displayName),
|
||||
WebSocketMessage (..),
|
||||
)
|
||||
import WebSocket.AllChat (broadCastAllChatMessage)
|
||||
import WebSocket.AllChat (MonadAllChat, broadCastAllChatMessage)
|
||||
import WebSocket.MonadWebSocketSession
|
||||
import WebSocket.WSReaderTApp
|
||||
|
||||
|
@ -22,7 +22,8 @@ wsApp ::
|
|||
MonadWebSocketSessionInit m,
|
||||
MonadConnectedClientsModify m,
|
||||
MonadRoomDataStateRead m,
|
||||
MonadBroadcast m
|
||||
MonadBroadcast m,
|
||||
MonadAllChat m
|
||||
) =>
|
||||
m ()
|
||||
wsApp = do
|
||||
|
@ -37,7 +38,8 @@ wsApp = do
|
|||
handleWSAction ::
|
||||
( MonadWebSocketSession m,
|
||||
MonadConnectedClientsModify m,
|
||||
MonadBroadcast m
|
||||
MonadBroadcast m,
|
||||
MonadAllChat m
|
||||
) =>
|
||||
m ()
|
||||
handleWSAction = do
|
||||
|
|
Loading…
Reference in a new issue