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,20 +135,38 @@ 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
+  { messages               :: Array String
-  , messageHistoryLength :: Int
+  , messageHistoryLength   :: Int
-  , loginInputText       :: String
+
-  , passInputText        :: String
+  -- Authentication.
-  , wsUrl                :: String
+  , loginInputText         :: String
-  , wsConnection         :: Maybe WS.WebSocket
+  , passInputText          :: String
-  , canReconnect         :: Boolean
+
+  -- Register.
+  , loginRegisterInputText :: String
+  , emailRegisterInputText :: String
+  , passRegisterInputText  :: String
+
+  -- Network stuff.
+  , wsUrl                  :: String
+  , wsConnection           :: Maybe WS.WebSocket
+  , canReconnect           :: Boolean
   }
 
 component :: forall m. MonadAff m => H.Component Query Input Output m
@@ -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,74 +215,129 @@ wrapperStyle =
   """
 
 render :: forall m. State -> H.ComponentHTML Action () m
-render { messages, loginInputText, passInputText, wsConnection, canReconnect } =
+render {
-  HH.div
+  messages,
-  [ HP.style wrapperStyle ]
+  wsConnection,
-  [ HH.h2_ [ HH.text "Authentication!" ]
+  canReconnect,
-  , render_auth_form
-  , render_messages
-  ]
-  where
 
-  render_auth_form = HH.form
+  -- Authentication.
-      [ HE.onSubmit AuthenticationAttempt ]
+  loginInputText,
-      [ HH.p_
+  passInputText,
-          [ HH.div_
+
-              [ HH.input
+  -- Register.
-                [ HP.style "padding: 0.5rem 0.75rem; margin-bottom: 0.25rem;"
+  loginRegisterInputText,
-                , HP.type_ HP.InputText
+  emailRegisterInputText,
-                , HP.value loginInputText
+  passRegisterInputText }
-                , HE.onValueInput HandleLoginInputUpdate
+    = HH.div
-                , maybe (HP.disabled true) (\_ -> HP.enabled true) wsConnection
+       [ HP.style wrapperStyle ]
-                ]
+       [ render_auth_form
-              ]
+       , render_register_form
-          , HH.div_
+       , render_messages
-              [ HH.input
+       --, renderMaxHistoryLength messageHistoryLength
-                [ HP.style "padding: 0.5rem 0.75rem; margin-bottom: 0.25rem;"
+       , renderReconnectButton (isNothing wsConnection && canReconnect)
-                , HP.type_ HP.InputText
+       ]
-                , HP.value passInputText
+    where
-                , HE.onValueInput HandlePassInputUpdate
+
-                , maybe (HP.disabled true) (\_ -> HP.enabled true) wsConnection
+      render_auth_form = HH.form
-                ]
+        [ HE.onSubmit AuthenticationAttempt ]
-              ]
+        [ HH.h2_ [ HH.text "Authentication!" ]
-          , HH.div_
+        , HH.p_
-              [ HH.button
+            [ HH.div_
-                  [ HP.style "padding: 0.5rem 1.25rem;"
+                [ HH.input
-                  , HP.type_ HP.ButtonSubmit
+                  [ inputCSS
+                  , HP.type_ HP.InputText
+                  , HP.value loginInputText
+                  , HE.onValueInput HandleLoginInputUpdate
                   , maybe (HP.disabled true) (\_ -> HP.enabled true) wsConnection
                   ]
-                  [ HH.text "Send Message to Server" ]
+                ]
+            , HH.div_
+                [ HH.input
+                  [ inputCSS
+                  , HP.type_ HP.InputPassword
+                  , HP.value passInputText
+                  , HE.onValueInput HandlePassInputUpdate
+                  , 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_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
+
+      renderFootnote :: String -> H.ComponentHTML Action () m
+      renderFootnote txt =
+        HH.div [ HP.style "margin-bottom: 0.125rem; color: grey;" ] [ HH.small_ [ HH.text txt ] ]
+
+      -- renderMaxHistoryLength :: Int -> H.ComponentHTML Action () m
+      -- renderMaxHistoryLength len =
+      --   renderFootnote ("NOTE: Maximum chat history length is " <> show len <> " messages")
+
+      renderReconnectButton :: Boolean -> H.ComponentHTML Action () m
+      renderReconnectButton cond =
+        if cond
+        then
+          HH.p_
+            [ HH.button
+              [ HP.type_ HP.ButtonButton
+              , HE.onClick \_ -> ConnectWebSocket
               ]
-          ]
+              [ HH.text "Reconnect?" ]
-      --, renderMaxHistoryLength messageHistoryLength
+            ]
-      , renderReconnectButton (isNothing wsConnection && canReconnect)
+        else
-      ]
+          HH.p_
-
+            [ renderFootnote "NOTE: A 'Reconnect?' button will appear if the connection drops"
-  render_messages = HH.ul_ $ map (\msg -> HH.li_ [ HH.text msg ]) messages
+            ]
-
-  renderFootnote :: String -> H.ComponentHTML Action () m
-  renderFootnote txt =
-    HH.div [ HP.style "margin-bottom: 0.125rem; color: grey;" ] [ HH.small_ [ HH.text txt ] ]
-
-  -- renderMaxHistoryLength :: Int -> H.ComponentHTML Action () m
-  -- renderMaxHistoryLength len =
-  --   renderFootnote ("NOTE: Maximum chat history length is " <> show len <> " messages")
-
-  renderReconnectButton :: Boolean -> H.ComponentHTML Action () m
-  renderReconnectButton cond =
-    if cond
-    then
-      HH.p_
-        [ HH.button
-          [ HP.type_ HP.ButtonButton
-          , HE.onClick \_ -> ConnectWebSocket
-          ]
-          [ HH.text "Reconnect?" ]
-        ]
-    else
-      HH.p_
-        [ renderFootnote "NOTE: A 'Reconnect?' button will appear if the connection drops"
-        ]
 
 handleAction :: forall m. MonadAff m => Action -> H.HalogenM State Action () Output m Unit
 handleAction = case _ of
@@ -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))