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