From 17b07ada18a9306f50c8f39f3b449e827c7eb41c Mon Sep 17 00:00:00 2001
From: Philippe Pittoli <karchnu@karchnu.fr>
Date: Sat, 3 Jun 2023 01:53:58 +0200
Subject: [PATCH] Users can now register (but currently no validation).

---
 src/App/AuthenticationForm.purs | 43 ++++++++++++++++++++++++++++++++-
 1 file changed, 42 insertions(+), 1 deletion(-)

diff --git a/src/App/AuthenticationForm.purs b/src/App/AuthenticationForm.purs
index 612457b..44f93cc 100644
--- a/src/App/AuthenticationForm.purs
+++ b/src/App/AuthenticationForm.purs
@@ -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