Users can now register (but currently no validation).

master
Philippe Pittoli 2023-06-03 01:53:58 +02:00
parent 57367168ae
commit 17b07ada18
1 changed files with 42 additions and 1 deletions

View File

@ -32,6 +32,7 @@ import Web.Socket.WebSocket as WS
import Effect.Class (class MonadEffect) import Effect.Class (class MonadEffect)
import App.IPC as IPC import App.IPC as IPC
import App.Email as Email
import App.Messages.AuthenticationDaemon as AuthD import App.Messages.AuthenticationDaemon as AuthD
@ -378,7 +379,47 @@ handleAction = case _ of
RegisterAttempt ev -> do RegisterAttempt ev -> do
H.liftEffect $ Event.preventDefault ev H.liftEffect $ Event.preventDefault ev
-- TODO
{ wsConnection
, loginRegisterInputText
, emailRegisterInputText
, passRegisterInputText } <- H.get
case wsConnection, loginRegisterInputText, emailRegisterInputText, passRegisterInputText of
Nothing, _, _, _ ->
unableToSend "Not connected to server."
Just _, "", _, _ ->
unableToSend "Write your login!"
Just _, _, "", _ ->
unableToSend "Write your email!"
Just _, _, _, "" ->
unableToSend "Write your password!"
Just webSocket, login, email, pass -> do
H.liftEffect (WS.readyState webSocket) >>= case _ of
Connecting ->
unableToSend "Still connecting to server."
Closing ->
unableToSend "Connection to server is closing."
Closed -> do
unableToSend "Connection to server has been closed."
maybeCurrentConnection <- H.gets _.wsConnection
when (isJust maybeCurrentConnection) do
H.modify_ _ { wsConnection = Nothing, canReconnect = true }
Open -> do
H.liftEffect $ do
ab <- AuthD.serialize $ AuthD.MkRegister { login: login
, email: Just (Email.Email email)
, password: pass
, phone: Nothing}
sendArrayBuffer webSocket ab
appendMessageReset "[😇] Trying to register"
AuthenticationAttempt ev -> do AuthenticationAttempt ev -> do
H.liftEffect $ Event.preventDefault ev H.liftEffect $ Event.preventDefault ev