diff --git a/src/App/AuthenticationForm.purs b/src/App/AuthenticationForm.purs index f5db757..612457b 100644 --- a/src/App/AuthenticationForm.purs +++ b/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 - , 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))