Register: new form inputs.

src/App/AuthenticationForm.purs

@@ -7,9 +7,6 @@ import Control.Monad.State (class MonadState)
 import Data.Array as A
 import Data.Tuple (Tuple(..))
 import Data.Bifunctor (lmap)
--- import Data.Codec.Argonaut (JsonCodec, JsonDecodeError)
--- import Data.Argonaut.Core as J
--- import Data.Codec.Argonaut as CA
 import Data.Const (Const)
 import Data.Either (Either(..))
 import Data.Maybe (Maybe(..), isJust, isNothing, maybe)
@@ -138,17 +135,35 @@ data Action
   = Initialize
   | WebSocketParseError String
   | ConnectWebSocket
+
+  -- Authentication.
   | HandleLoginInputUpdate String
   | HandlePassInputUpdate String
+
+  -- Register.
+  | HandleLoginRegisterInputUpdate String
+  | HandleEmailRegisterInputUpdate String
+  | HandlePassRegisterInputUpdate String
+
   | AuthenticationAttempt Event
+  | RegisterAttempt Event
   | Finalize
   | HandleWebSocket (WebSocketEvent WebSocketMessageType)
 
 type State =
   { messages               :: Array String
   , messageHistoryLength   :: Int
+
+  -- Authentication.
   , loginInputText         :: String
   , passInputText          :: String
+
+  -- Register.
+  , loginRegisterInputText :: String
+  , emailRegisterInputText :: String
+  , passRegisterInputText  :: String
+
+  -- Network stuff.
   , wsUrl                  :: String
   , wsConnection           :: Maybe WS.WebSocket
   , canReconnect           :: Boolean
@@ -170,8 +185,17 @@ initialState :: Input -> State
 initialState input =
   { messages: []
   , messageHistoryLength: 10
+
+  -- Authentication.
   , loginInputText: ""
   , passInputText: ""
+
+  -- Register.
+  , loginRegisterInputText: ""
+  , emailRegisterInputText: ""
+  , passRegisterInputText: ""
+
+  -- Network stuff.
   , wsUrl: input
   , wsConnection: Nothing
   , canReconnect: false
@@ -191,21 +215,36 @@ wrapperStyle =
   """
 
 render :: forall m. State -> H.ComponentHTML Action () m
-render { messages, loginInputText, passInputText, wsConnection, canReconnect } =
+render {
-  HH.div
+  messages,
+  wsConnection,
+  canReconnect,
+
+  -- Authentication.
+  loginInputText,
+  passInputText,
+
+  -- Register.
+  loginRegisterInputText,
+  emailRegisterInputText,
+  passRegisterInputText }
+    = HH.div
        [ HP.style wrapperStyle ]
-  [ HH.h2_ [ HH.text "Authentication!" ]
+       [ render_auth_form
-  , render_auth_form
+       , render_register_form
        , render_messages
+       --, renderMaxHistoryLength messageHistoryLength
+       , renderReconnectButton (isNothing wsConnection && canReconnect)
        ]
     where
 
       render_auth_form = HH.form
         [ HE.onSubmit AuthenticationAttempt ]
-      [ HH.p_
+        [ HH.h2_ [ HH.text "Authentication!" ]
+        , HH.p_
             [ HH.div_
                 [ HH.input
-                [ HP.style "padding: 0.5rem 0.75rem; margin-bottom: 0.25rem;"
+                  [ inputCSS
                   , HP.type_ HP.InputText
                   , HP.value loginInputText
                   , HE.onValueInput HandleLoginInputUpdate
@@ -214,8 +253,8 @@ render { messages, loginInputText, passInputText, wsConnection, canReconnect } =
                 ]
             , HH.div_
                 [ HH.input
-                [ HP.style "padding: 0.5rem 0.75rem; margin-bottom: 0.25rem;"
+                  [ inputCSS
-                , HP.type_ HP.InputText
+                  , HP.type_ HP.InputPassword
                   , HP.value passInputText
                   , HE.onValueInput HandlePassInputUpdate
                   , maybe (HP.disabled true) (\_ -> HP.enabled true) wsConnection
@@ -230,8 +269,48 @@ render { messages, loginInputText, passInputText, wsConnection, canReconnect } =
                     [ HH.text "Send Message to Server" ]
                 ]
             ]
-      --, renderMaxHistoryLength messageHistoryLength
+        ]
-      , renderReconnectButton (isNothing wsConnection && canReconnect)
+
+      render_register_form = HH.form
+        [ HE.onSubmit RegisterAttempt ]
+        [ HH.h2_ [ HH.text "Register!" ]
+        , HH.p_
+            [ HH.div_
+                [ HH.input
+                  [ inputCSS
+                  , HP.type_ HP.InputText
+                  , HP.value loginRegisterInputText
+                  , HE.onValueInput HandleLoginRegisterInputUpdate
+                  , maybe (HP.disabled true) (\_ -> HP.enabled true) wsConnection
+                  ]
+                ]
+            , HH.div_
+                [ HH.input
+                  [ inputCSS
+                  , HP.type_ HP.InputText
+                  , HP.value emailRegisterInputText
+                  , HE.onValueInput HandleEmailRegisterInputUpdate
+                  , maybe (HP.disabled true) (\_ -> HP.enabled true) wsConnection
+                  ]
+                ]
+            , HH.div_
+                [ HH.input
+                  [ inputCSS
+                  , HP.type_ HP.InputPassword
+                  , HP.value passRegisterInputText
+                  , HE.onValueInput HandlePassRegisterInputUpdate
+                  , maybe (HP.disabled true) (\_ -> HP.enabled true) wsConnection
+                  ]
+                ]
+            , HH.div_
+                [ HH.button
+                    [ HP.style "padding: 0.5rem 1.25rem;"
+                    , HP.type_ HP.ButtonSubmit
+                    , maybe (HP.disabled true) (\_ -> HP.enabled true) wsConnection
+                    ]
+                    [ HH.text "Send Message to Server" ]
+                ]
+            ]
         ]
 
       render_messages = HH.ul_ $ map (\msg -> HH.li_ [ HH.text msg ]) messages
@@ -283,12 +362,24 @@ handleAction = case _ of
     H.modify_ _ { wsConnection = Just webSocket }
     void $ H.subscribe (HandleWebSocket <$> webSocketEmitter webSocket)
 
+  -- Authentication.
   HandleLoginInputUpdate text -> do
     H.modify_ _ { loginInputText = text }
-
   HandlePassInputUpdate text -> do
     H.modify_ _ { passInputText = text }
 
+  -- Register.
+  HandleLoginRegisterInputUpdate text -> do
+    H.modify_ _ { loginRegisterInputText = text }
+  HandleEmailRegisterInputUpdate text -> do
+    H.modify_ _ { emailRegisterInputText = text }
+  HandlePassRegisterInputUpdate text -> do
+    H.modify_ _ { passRegisterInputText = text }
+
+  RegisterAttempt ev -> do
+    H.liftEffect $ Event.preventDefault ev
+    -- TODO
+
   AuthenticationAttempt ev -> do
     H.liftEffect $ Event.preventDefault ev
 
@@ -350,7 +441,7 @@ handleAction = case _ of
                   H.raise $ AuthToken msg.token
                 -- WTH?!
                 _ -> do
-                  appendMessage $ "[😈] Failed! Don't understand the answer received!"
+                  appendMessage $ "[😈] Failed! Authentication server didn't send a valid message."
 
       WebSocketOpen -> do
         { wsUrl } <- H.get
@@ -444,6 +535,8 @@ foreignToArrayBuffer
   renderForeignErrors =
     String.joinWith "; " <<< A.fromFoldable <<< map F.renderForeignError
 
+inputCSS = HP.style "padding: 0.5rem 0.75rem; margin-bottom: 0.25rem;"
+
 print_json_string :: forall m. MonadEffect m => MonadState State m => ArrayBuffer -> m Unit
 print_json_string arraybuffer = do
   -- fromTypedIPC :: ArrayBuffer -> Effect (Either ParseError (Tuple UInt String))