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 App.IPC as IPC
import App.Email as Email
import App.Messages.AuthenticationDaemon as AuthD
@ -378,7 +379,47 @@ handleAction = case _ of
RegisterAttempt ev -> do
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
H.liftEffect $ Event.preventDefault ev