Register: new form inputs.
This commit is contained in:
parent
c42cbbeb8a
commit
57367168ae
@ -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
|
||||
, messageHistoryLength :: Int
|
||||
, loginInputText :: String
|
||||
, passInputText :: String
|
||||
, wsUrl :: String
|
||||
, wsConnection :: Maybe WS.WebSocket
|
||||
, canReconnect :: Boolean
|
||||
{ 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
|
||||
}
|
||||
|
||||
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 } =
|
||||
HH.div
|
||||
[ HP.style wrapperStyle ]
|
||||
[ HH.h2_ [ HH.text "Authentication!" ]
|
||||
, render_auth_form
|
||||
, render_messages
|
||||
]
|
||||
where
|
||||
render {
|
||||
messages,
|
||||
wsConnection,
|
||||
canReconnect,
|
||||
|
||||
render_auth_form = HH.form
|
||||
[ HE.onSubmit AuthenticationAttempt ]
|
||||
[ HH.p_
|
||||
[ HH.div_
|
||||
[ HH.input
|
||||
[ HP.style "padding: 0.5rem 0.75rem; margin-bottom: 0.25rem;"
|
||||
, HP.type_ HP.InputText
|
||||
, HP.value loginInputText
|
||||
, HE.onValueInput HandleLoginInputUpdate
|
||||
, maybe (HP.disabled true) (\_ -> HP.enabled true) wsConnection
|
||||
]
|
||||
]
|
||||
, HH.div_
|
||||
[ HH.input
|
||||
[ HP.style "padding: 0.5rem 0.75rem; margin-bottom: 0.25rem;"
|
||||
, HP.type_ HP.InputText
|
||||
, 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
|
||||
-- Authentication.
|
||||
loginInputText,
|
||||
passInputText,
|
||||
|
||||
-- Register.
|
||||
loginRegisterInputText,
|
||||
emailRegisterInputText,
|
||||
passRegisterInputText }
|
||||
= HH.div
|
||||
[ HP.style wrapperStyle ]
|
||||
[ render_auth_form
|
||||
, render_register_form
|
||||
, render_messages
|
||||
--, renderMaxHistoryLength messageHistoryLength
|
||||
, renderReconnectButton (isNothing wsConnection && canReconnect)
|
||||
]
|
||||
where
|
||||
|
||||
render_auth_form = HH.form
|
||||
[ HE.onSubmit AuthenticationAttempt ]
|
||||
[ HH.h2_ [ HH.text "Authentication!" ]
|
||||
, HH.p_
|
||||
[ HH.div_
|
||||
[ HH.input
|
||||
[ 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
|
||||
]
|
||||
]
|
||||
--, renderMaxHistoryLength messageHistoryLength
|
||||
, renderReconnectButton (isNothing wsConnection && canReconnect)
|
||||
]
|
||||
|
||||
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"
|
||||
]
|
||||
[ 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))
|
||||
|
||||
Loading…
Reference in New Issue
Block a user