some backend refactoring
continuous-integration/drone/push Build is failing Details

This commit is contained in:
qvalentin 2023-08-13 12:06:23 +02:00
parent 8c82cd81bd
commit 2159e273fa
13 changed files with 56 additions and 42 deletions

View File

@ -29,12 +29,13 @@ library
Lib
RoomDataHandler
State.ConnectedClientsState
State.GenericTVarState
State.RoomDataState
State.RoomsState
Types.AppTypes
Types.ConnectionState
Types.Participant
Types.RoomData
Types.RoomsState
Types.User
Types.UsersData
Types.WebEnv

View File

@ -8,9 +8,9 @@ where
import ClassyPrelude
import Data.Aeson (encode)
import Network.WebSockets qualified as WS
import State.ConnectedClientsState (MonadConnectedClientsRead (getConnctedClients))
import State.ConnectedClientsState (ConnectedClients, MonadConnectedClientsRead (getConnctedClients))
import State.RoomDataState (MonadRoomDataStateRead (getRoomDataState))
import Types.ConnectionState (Client (..), ConnectedClients)
import Types.ConnectionState (Client (..))
import Types.User (User, clientToUser)
import Types.UsersData (UsersData (..))

View File

@ -6,9 +6,9 @@ module Lib
where
import ClassyPrelude
import State.ConnectedClientsState (initConnectionsState)
import State.RoomsState (initRoomsState)
import Types.AppTypes
import Types.ConnectionState (initConnectionsState)
import Types.RoomsState (initRoomsState)
import WebServer (runWebServer)
import WebSocket.Server (runWebSocketServer)

View File

@ -20,7 +20,7 @@ import State.RoomDataState
( MonadRoomDataStateModify (setRoomDataState),
MonadRoomDataStateRead,
)
import Types.RoomsState
import State.RoomsState
( roomStateDiffers,
)
import Types.WebEnv

View File

@ -1,6 +1,10 @@
module State.ConnectedClientsState
( MonadConnectedClientsModify (..),
MonadConnectedClientsRead (..),
ConnectedClients,
ConnectedClientsState,
HasConnectedClientState (..),
initConnectionsState,
addWSClientGeneric,
updateWSClientGeneric,
removeWSClientGeneric,
@ -10,14 +14,24 @@ where
import ClassyPrelude
import Data.UUID
import Types.AppTypes
import Types.ConnectionState
type ConnectedClientsState = TVar ConnectedClients
initConnectionsState :: IO ConnectedClientsState
initConnectionsState = newTVarIO newConnectedClients
newConnectedClients :: ConnectedClients
newConnectedClients = []
class Monad m => MonadConnectedClientsModify m where
addWSClient :: Client -> m ()
removeWSClient :: UUID -> m ()
updateWSClient :: UUID -> (Client -> Client) -> m ()
class HasConnectedClientState a where
getConnectedClientState :: a -> ConnectedClientsState
addWSClientGeneric ::
( HasConnectedClientState env,
MonadReader env m,

View File

@ -0,0 +1,11 @@
module State.GenericTVarState (GenericTVarState, updateGenericTVarState, getGenericTVarState) where
import ClassyPrelude
type GenericTVarState a = TVar a
updateGenericTVarState :: (MonadIO m) => GenericTVarState a -> a -> m ()
updateGenericTVarState tv a = atomically $ writeTVar tv a
getGenericTVarState :: (MonadIO m) => GenericTVarState a -> m a
getGenericTVarState = readTVarIO

View File

@ -1,4 +1,4 @@
module Types.RoomsState
module State.RoomsState
( RoomsState,
initRoomsState,
HasRoomsState (..),
@ -9,10 +9,11 @@ module Types.RoomsState
where
import ClassyPrelude
import State.GenericTVarState
import State.RoomDataState (MonadRoomDataStateRead (getRoomDataState))
import Types.RoomData (RoomsData)
type RoomsState = TVar RoomsData
type RoomsState = GenericTVarState RoomsData
initRoomsState :: IO RoomsState
initRoomsState = newTVarIO []
@ -30,7 +31,7 @@ updateRoomState ::
updateRoomState newData = do
state <- getRoomsState <$> ask
liftIO $ putStrLn "Upating room state"
atomically $ writeTVar state newData
updateGenericTVarState state newData
liftIO $ putStrLn "Done Upating room state"
getRoomState ::
@ -41,7 +42,7 @@ getRoomState ::
m RoomsData
getRoomState = do
state <- getRoomsState <$> ask
readTVarIO state
getGenericTVarState state
roomStateDiffers ::
( MonadRoomDataStateRead m

View File

@ -1,10 +1,10 @@
{-# LANGUAGE DerivingVia #-}
module Types.AppTypes (Env (..), App (..), getConnectedClientState, HasConnectedClientState, AppProfile (Prod, Dev)) where
module Types.AppTypes (Env (..), App (..), getConnectedClientState, AppProfile (Prod, Dev)) where
import ClassyPrelude
import Types.ConnectionState (ConnectedClientsState)
import Types.RoomsState
import State.ConnectedClientsState
import State.RoomsState
( HasRoomsState (getRoomsState),
RoomsState,
)
@ -17,9 +17,6 @@ data Env = Env
profile :: AppProfile
}
class HasConnectedClientState a where
getConnectedClientState :: a -> ConnectedClientsState
instance HasConnectedClientState Env where
getConnectedClientState = connectedClientsState

View File

@ -1,8 +1,6 @@
module Types.ConnectionState
( Client (..),
ConnectedClientsState,
ConnectedClients,
initConnectionsState,
)
where
@ -17,12 +15,4 @@ data Client = Client
joinedRoom :: Bool
}
type ConnectedClientsState = TVar ConnectedClients
type ConnectedClients = [Client]
initConnectionsState :: IO ConnectedClientsState
initConnectionsState = newTVarIO newConnectedClients
newConnectedClients :: ConnectedClients
newConnectedClients = []

View File

@ -6,11 +6,11 @@ where
import ClassyPrelude
import Network.Wai (Request, Response, ResponseReceived)
import State.ConnectedClientsState (HasConnectedClientState (getConnectedClientState))
import State.RoomsState (HasRoomsState (getRoomsState))
import Types.AppTypes
( Env (..),
HasConnectedClientState (getConnectedClientState),
)
import Types.RoomsState (HasRoomsState (getRoomsState))
class HasWebEnv a where
getRequest :: a -> Request

View File

@ -29,23 +29,22 @@ data WebSocketMessage = ClientInfoMessage SetClientInfo | JoinRoomMessage JoinRo
instance FromJSON WebSocketMessage where
parseJSON = genericParseJSON defaultOptions {sumEncoding = UntaggedValue}
data SetClientInfo = SetClientInfo
{ displayName :: Text
}
data SetClientInfo where
SetClientInfo :: {displayName :: Text} -> SetClientInfo
deriving (Generic, Show)
instance FromJSON SetClientInfo
data JoinRoom = JoinRoom
{ roomName :: Text
}
data JoinRoom where
JoinRoom :: {roomName :: Text} -> JoinRoom
deriving (Generic, Show)
instance FromJSON JoinRoom
data AllChatMessageIncoming = AllChatMessageIncoming
{ content :: Text
}
data AllChatMessageIncoming where
AllChatMessageIncoming ::
{content :: Text} ->
AllChatMessageIncoming
deriving (Generic, Show)
instance FromJSON AllChatMessageIncoming

View File

@ -25,11 +25,11 @@ import State.RoomDataState
( MonadRoomDataStateModify (..),
MonadRoomDataStateRead (getRoomDataState),
)
import Types.AppTypes (Env (..))
import Types.RoomsState
import State.RoomsState
( getRoomState,
updateRoomState,
)
import Types.AppTypes (Env (..))
import Types.WebEnv
newtype ExceptTApp e a = E {unExceptTApp :: IO (Either e a)}

View File

@ -17,7 +17,8 @@ import ClassyPrelude
import Data.UUID
import Network.WebSockets qualified as WS
import State.ConnectedClientsState
( MonadConnectedClientsModify (..),
( HasConnectedClientState,
MonadConnectedClientsModify (..),
MonadConnectedClientsRead (..),
addWSClientGeneric,
getConnctedClientsGeneric,
@ -25,8 +26,8 @@ import State.ConnectedClientsState
updateWSClientGeneric,
)
import State.RoomDataState
import State.RoomsState (HasRoomsState (..), getRoomState)
import Types.AppTypes
import Types.RoomsState (HasRoomsState (..), getRoomState)
data WSEnv = WSEnv
{ appEnv :: Env,