Code in now way clearer.
parent
0bdef754ae
commit
6c69eaea5a
|
@ -132,25 +132,29 @@ type Query :: forall k. k -> Type
|
||||||
type Query = Const Void
|
type Query = Const Void
|
||||||
type Input = String
|
type Input = String
|
||||||
|
|
||||||
|
data AuthenticationInput
|
||||||
|
= AUTH_INP_login String
|
||||||
|
| AUTH_INP_pass String
|
||||||
|
|
||||||
|
data RegisterInput
|
||||||
|
= REG_INP_login String
|
||||||
|
| REG_INP_email String
|
||||||
|
| REG_INP_pass String
|
||||||
|
|
||||||
|
data AddUserInput
|
||||||
|
= ADDUSER_INP_secret String
|
||||||
|
| ADDUSER_INP_login String
|
||||||
|
| ADDUSER_INP_email String
|
||||||
|
| ADDUSER_INP_pass String
|
||||||
|
|
||||||
data Action
|
data Action
|
||||||
= Initialize
|
= Initialize
|
||||||
| WebSocketParseError String
|
| WebSocketParseError String
|
||||||
| ConnectWebSocket
|
| ConnectWebSocket
|
||||||
|
|
||||||
-- Authentication.
|
| HandleAuthenticationInput AuthenticationInput
|
||||||
| HandleLoginInputUpdate String
|
| HandleRegisterInput RegisterInput
|
||||||
| HandlePassInputUpdate String
|
| HandleAddUserInput AddUserInput -- admin operation
|
||||||
|
|
||||||
-- Register.
|
|
||||||
| HandleLoginRegisterInputUpdate String
|
|
||||||
| HandleEmailRegisterInputUpdate String
|
|
||||||
| HandlePassRegisterInputUpdate String
|
|
||||||
|
|
||||||
-- (admin) AddUser.
|
|
||||||
| HandleSecretKeyAddUserInputUpdate String
|
|
||||||
| HandleLoginAddUserInputUpdate String
|
|
||||||
| HandleEmailAddUserInputUpdate String
|
|
||||||
| HandlePassAddUserInputUpdate String
|
|
||||||
|
|
||||||
| AuthenticationAttempt Event
|
| AuthenticationAttempt Event
|
||||||
| RegisterAttempt Event
|
| RegisterAttempt Event
|
||||||
|
@ -158,26 +162,19 @@ data Action
|
||||||
| Finalize
|
| Finalize
|
||||||
| HandleWebSocket (WebSocketEvent WebSocketMessageType)
|
| HandleWebSocket (WebSocketEvent WebSocketMessageType)
|
||||||
|
|
||||||
|
type StateAuthenticationForm = { login :: String, pass :: String }
|
||||||
|
type StateRegistrationForm = { login :: String, email :: String, pass :: String }
|
||||||
|
type StateAddUserForm = { secretKey :: String, login :: String, email :: String, pass :: String }
|
||||||
|
|
||||||
type State =
|
type State =
|
||||||
{ messages :: Array String
|
{ messages :: Array String
|
||||||
, messageHistoryLength :: Int
|
, messageHistoryLength :: Int
|
||||||
|
|
||||||
-- Authentication.
|
, authenticationForm :: StateAuthenticationForm
|
||||||
, loginInputText :: String
|
, registrationForm :: StateRegistrationForm
|
||||||
, passInputText :: String
|
, addUserForm :: StateAddUserForm
|
||||||
|
|
||||||
-- Register.
|
-- TODO: put network stuff in a record.
|
||||||
, loginRegisterInputText :: String
|
|
||||||
, emailRegisterInputText :: String
|
|
||||||
, passRegisterInputText :: String
|
|
||||||
|
|
||||||
-- Admin: AddUser.
|
|
||||||
, secretKeyAddUserInputText :: String
|
|
||||||
, loginAddUserInputText :: String
|
|
||||||
, emailAddUserInputText :: String
|
|
||||||
, passAddUserInputText :: String
|
|
||||||
|
|
||||||
-- Network stuff.
|
|
||||||
, wsUrl :: String
|
, wsUrl :: String
|
||||||
, wsConnection :: Maybe WS.WebSocket
|
, wsConnection :: Maybe WS.WebSocket
|
||||||
, canReconnect :: Boolean
|
, canReconnect :: Boolean
|
||||||
|
@ -200,22 +197,11 @@ initialState input =
|
||||||
{ messages: []
|
{ messages: []
|
||||||
, messageHistoryLength: 10
|
, messageHistoryLength: 10
|
||||||
|
|
||||||
-- Authentication.
|
, authenticationForm: { login: "", pass: "" }
|
||||||
, loginInputText: ""
|
, registrationForm: { login: "", email: "", pass: "" }
|
||||||
, passInputText: ""
|
, addUserForm: { secretKey: "", login: "", email: "", pass: "" }
|
||||||
|
|
||||||
-- Register.
|
-- TODO: put network stuff in a record.
|
||||||
, loginRegisterInputText: ""
|
|
||||||
, emailRegisterInputText: ""
|
|
||||||
, passRegisterInputText: ""
|
|
||||||
|
|
||||||
-- Admin: AddUser.
|
|
||||||
, secretKeyAddUserInputText: ""
|
|
||||||
, loginAddUserInputText: ""
|
|
||||||
, emailAddUserInputText: ""
|
|
||||||
, passAddUserInputText: ""
|
|
||||||
|
|
||||||
-- Network stuff.
|
|
||||||
, wsUrl: input
|
, wsUrl: input
|
||||||
, wsConnection: Nothing
|
, wsConnection: Nothing
|
||||||
, canReconnect: false
|
, canReconnect: false
|
||||||
|
@ -240,20 +226,9 @@ render {
|
||||||
wsConnection,
|
wsConnection,
|
||||||
canReconnect,
|
canReconnect,
|
||||||
|
|
||||||
-- Authentication.
|
authenticationForm,
|
||||||
loginInputText,
|
registrationForm,
|
||||||
passInputText,
|
addUserForm }
|
||||||
|
|
||||||
-- Register.
|
|
||||||
loginRegisterInputText,
|
|
||||||
emailRegisterInputText,
|
|
||||||
passRegisterInputText,
|
|
||||||
|
|
||||||
-- AddUser.
|
|
||||||
secretKeyAddUserInputText,
|
|
||||||
loginAddUserInputText,
|
|
||||||
emailAddUserInputText,
|
|
||||||
passAddUserInputText }
|
|
||||||
= HH.div
|
= HH.div
|
||||||
[ HP.style wrapperStyle ]
|
[ HP.style wrapperStyle ]
|
||||||
[ render_auth_form
|
[ render_auth_form
|
||||||
|
@ -273,8 +248,8 @@ render {
|
||||||
[ HH.input
|
[ HH.input
|
||||||
[ inputCSS
|
[ inputCSS
|
||||||
, HP.type_ HP.InputText
|
, HP.type_ HP.InputText
|
||||||
, HP.value loginInputText
|
, HP.value authenticationForm.login
|
||||||
, HE.onValueInput HandleLoginInputUpdate
|
, HE.onValueInput $ HandleAuthenticationInput <<< AUTH_INP_login
|
||||||
, maybe (HP.disabled true) (\_ -> HP.enabled true) wsConnection
|
, maybe (HP.disabled true) (\_ -> HP.enabled true) wsConnection
|
||||||
]
|
]
|
||||||
]
|
]
|
||||||
|
@ -282,8 +257,8 @@ render {
|
||||||
[ HH.input
|
[ HH.input
|
||||||
[ inputCSS
|
[ inputCSS
|
||||||
, HP.type_ HP.InputPassword
|
, HP.type_ HP.InputPassword
|
||||||
, HP.value passInputText
|
, HP.value authenticationForm.pass
|
||||||
, HE.onValueInput HandlePassInputUpdate
|
, HE.onValueInput $ HandleAuthenticationInput <<< AUTH_INP_pass
|
||||||
, maybe (HP.disabled true) (\_ -> HP.enabled true) wsConnection
|
, maybe (HP.disabled true) (\_ -> HP.enabled true) wsConnection
|
||||||
]
|
]
|
||||||
]
|
]
|
||||||
|
@ -306,8 +281,8 @@ render {
|
||||||
[ HH.input
|
[ HH.input
|
||||||
[ inputCSS
|
[ inputCSS
|
||||||
, HP.type_ HP.InputText
|
, HP.type_ HP.InputText
|
||||||
, HP.value loginRegisterInputText
|
, HP.value registrationForm.login
|
||||||
, HE.onValueInput HandleLoginRegisterInputUpdate
|
, HE.onValueInput $ HandleRegisterInput <<< REG_INP_login
|
||||||
, maybe (HP.disabled true) (\_ -> HP.enabled true) wsConnection
|
, maybe (HP.disabled true) (\_ -> HP.enabled true) wsConnection
|
||||||
]
|
]
|
||||||
]
|
]
|
||||||
|
@ -315,8 +290,8 @@ render {
|
||||||
[ HH.input
|
[ HH.input
|
||||||
[ inputCSS
|
[ inputCSS
|
||||||
, HP.type_ HP.InputText
|
, HP.type_ HP.InputText
|
||||||
, HP.value emailRegisterInputText
|
, HP.value registrationForm.email
|
||||||
, HE.onValueInput HandleEmailRegisterInputUpdate
|
, HE.onValueInput $ HandleRegisterInput <<< REG_INP_email
|
||||||
, maybe (HP.disabled true) (\_ -> HP.enabled true) wsConnection
|
, maybe (HP.disabled true) (\_ -> HP.enabled true) wsConnection
|
||||||
]
|
]
|
||||||
]
|
]
|
||||||
|
@ -324,8 +299,8 @@ render {
|
||||||
[ HH.input
|
[ HH.input
|
||||||
[ inputCSS
|
[ inputCSS
|
||||||
, HP.type_ HP.InputPassword
|
, HP.type_ HP.InputPassword
|
||||||
, HP.value passRegisterInputText
|
, HP.value registrationForm.pass
|
||||||
, HE.onValueInput HandlePassRegisterInputUpdate
|
, HE.onValueInput $ HandleRegisterInput <<< REG_INP_pass
|
||||||
, maybe (HP.disabled true) (\_ -> HP.enabled true) wsConnection
|
, maybe (HP.disabled true) (\_ -> HP.enabled true) wsConnection
|
||||||
]
|
]
|
||||||
]
|
]
|
||||||
|
@ -348,8 +323,8 @@ render {
|
||||||
[ HH.input
|
[ HH.input
|
||||||
[ inputCSS
|
[ inputCSS
|
||||||
, HP.type_ HP.InputText
|
, HP.type_ HP.InputText
|
||||||
, HP.value secretKeyAddUserInputText
|
, HP.value addUserForm.secretKey
|
||||||
, HE.onValueInput HandleSecretKeyAddUserInputUpdate
|
, HE.onValueInput $ HandleAddUserInput <<< ADDUSER_INP_secret
|
||||||
, maybe (HP.disabled true) (\_ -> HP.enabled true) wsConnection
|
, maybe (HP.disabled true) (\_ -> HP.enabled true) wsConnection
|
||||||
]
|
]
|
||||||
]
|
]
|
||||||
|
@ -357,8 +332,8 @@ render {
|
||||||
[ HH.input
|
[ HH.input
|
||||||
[ inputCSS
|
[ inputCSS
|
||||||
, HP.type_ HP.InputText
|
, HP.type_ HP.InputText
|
||||||
, HP.value loginAddUserInputText
|
, HP.value addUserForm.login
|
||||||
, HE.onValueInput HandleLoginAddUserInputUpdate
|
, HE.onValueInput $ HandleAddUserInput <<< ADDUSER_INP_login
|
||||||
, maybe (HP.disabled true) (\_ -> HP.enabled true) wsConnection
|
, maybe (HP.disabled true) (\_ -> HP.enabled true) wsConnection
|
||||||
]
|
]
|
||||||
]
|
]
|
||||||
|
@ -366,8 +341,8 @@ render {
|
||||||
[ HH.input
|
[ HH.input
|
||||||
[ inputCSS
|
[ inputCSS
|
||||||
, HP.type_ HP.InputText
|
, HP.type_ HP.InputText
|
||||||
, HP.value emailAddUserInputText
|
, HP.value addUserForm.email
|
||||||
, HE.onValueInput HandleEmailAddUserInputUpdate
|
, HE.onValueInput $ HandleAddUserInput <<< ADDUSER_INP_email
|
||||||
, maybe (HP.disabled true) (\_ -> HP.enabled true) wsConnection
|
, maybe (HP.disabled true) (\_ -> HP.enabled true) wsConnection
|
||||||
]
|
]
|
||||||
]
|
]
|
||||||
|
@ -375,8 +350,8 @@ render {
|
||||||
[ HH.input
|
[ HH.input
|
||||||
[ inputCSS
|
[ inputCSS
|
||||||
, HP.type_ HP.InputPassword
|
, HP.type_ HP.InputPassword
|
||||||
, HP.value passAddUserInputText
|
, HP.value addUserForm.pass
|
||||||
, HE.onValueInput HandlePassAddUserInputUpdate
|
, HE.onValueInput $ HandleAddUserInput <<< ADDUSER_INP_pass
|
||||||
, maybe (HP.disabled true) (\_ -> HP.enabled true) wsConnection
|
, maybe (HP.disabled true) (\_ -> HP.enabled true) wsConnection
|
||||||
]
|
]
|
||||||
]
|
]
|
||||||
|
@ -440,39 +415,33 @@ handleAction = case _ of
|
||||||
H.modify_ _ { wsConnection = Just webSocket }
|
H.modify_ _ { wsConnection = Just webSocket }
|
||||||
void $ H.subscribe (HandleWebSocket <$> webSocketEmitter webSocket)
|
void $ H.subscribe (HandleWebSocket <$> webSocketEmitter webSocket)
|
||||||
|
|
||||||
-- Authentication.
|
HandleAuthenticationInput authinp -> do
|
||||||
HandleLoginInputUpdate text -> do
|
case authinp of
|
||||||
H.modify_ _ { loginInputText = text }
|
AUTH_INP_login v -> H.modify_ _ { authenticationForm { login = v } }
|
||||||
HandlePassInputUpdate text -> do
|
AUTH_INP_pass v -> H.modify_ _ { authenticationForm { pass = v } }
|
||||||
H.modify_ _ { passInputText = text }
|
|
||||||
|
|
||||||
-- Register.
|
HandleRegisterInput reginp -> do
|
||||||
HandleLoginRegisterInputUpdate text -> do
|
case reginp of
|
||||||
H.modify_ _ { loginRegisterInputText = text }
|
REG_INP_login v -> H.modify_ _ { registrationForm { login = v } }
|
||||||
HandleEmailRegisterInputUpdate text -> do
|
REG_INP_email v -> H.modify_ _ { registrationForm { email = v } }
|
||||||
H.modify_ _ { emailRegisterInputText = text }
|
REG_INP_pass v -> H.modify_ _ { registrationForm { pass = v } }
|
||||||
HandlePassRegisterInputUpdate text -> do
|
|
||||||
H.modify_ _ { passRegisterInputText = text }
|
|
||||||
|
|
||||||
-- (admin) AddUser.
|
HandleAddUserInput adduserinp -> do
|
||||||
HandleSecretKeyAddUserInputUpdate text -> do
|
case adduserinp of
|
||||||
H.modify_ _ { secretKeyAddUserInputText = text }
|
ADDUSER_INP_secret v -> H.modify_ _ { addUserForm { secretKey = v } }
|
||||||
HandleLoginAddUserInputUpdate text -> do
|
ADDUSER_INP_login v -> H.modify_ _ { addUserForm { login = v } }
|
||||||
H.modify_ _ { loginAddUserInputText = text }
|
ADDUSER_INP_email v -> H.modify_ _ { addUserForm { email = v } }
|
||||||
HandleEmailAddUserInputUpdate text -> do
|
ADDUSER_INP_pass v -> H.modify_ _ { addUserForm { pass = v } }
|
||||||
H.modify_ _ { emailAddUserInputText = text }
|
|
||||||
HandlePassAddUserInputUpdate text -> do
|
|
||||||
H.modify_ _ { passAddUserInputText = text }
|
|
||||||
|
|
||||||
RegisterAttempt ev -> do
|
RegisterAttempt ev -> do
|
||||||
H.liftEffect $ Event.preventDefault ev
|
H.liftEffect $ Event.preventDefault ev
|
||||||
|
|
||||||
{ wsConnection
|
{ wsConnection, registrationForm } <- H.get
|
||||||
, loginRegisterInputText
|
let login = registrationForm.login
|
||||||
, emailRegisterInputText
|
email = registrationForm.email
|
||||||
, passRegisterInputText } <- H.get
|
pass = registrationForm.pass
|
||||||
|
|
||||||
case wsConnection, loginRegisterInputText, emailRegisterInputText, passRegisterInputText of
|
case wsConnection, login, email, pass of
|
||||||
Nothing, _, _, _ ->
|
Nothing, _, _, _ ->
|
||||||
unableToSend "Not connected to server."
|
unableToSend "Not connected to server."
|
||||||
|
|
||||||
|
@ -485,7 +454,7 @@ handleAction = case _ of
|
||||||
Just _, _, _, "" ->
|
Just _, _, _, "" ->
|
||||||
unableToSend "Write your password!"
|
unableToSend "Write your password!"
|
||||||
|
|
||||||
Just webSocket, login, email, pass -> do
|
Just webSocket, _, _, _ -> do
|
||||||
H.liftEffect (WS.readyState webSocket) >>= case _ of
|
H.liftEffect (WS.readyState webSocket) >>= case _ of
|
||||||
Connecting ->
|
Connecting ->
|
||||||
unableToSend "Still connecting to server."
|
unableToSend "Still connecting to server."
|
||||||
|
@ -511,17 +480,13 @@ handleAction = case _ of
|
||||||
AddUserAttempt ev -> do
|
AddUserAttempt ev -> do
|
||||||
H.liftEffect $ Event.preventDefault ev
|
H.liftEffect $ Event.preventDefault ev
|
||||||
|
|
||||||
{ wsConnection
|
{ wsConnection, addUserForm } <- H.get
|
||||||
, secretKeyAddUserInputText
|
let secret = addUserForm.secretKey
|
||||||
, loginAddUserInputText
|
login = addUserForm.login
|
||||||
, emailAddUserInputText
|
email = addUserForm.email
|
||||||
, passAddUserInputText } <- H.get
|
pass = addUserForm.pass
|
||||||
|
|
||||||
case wsConnection
|
case wsConnection, secret, login, email, pass of
|
||||||
, secretKeyAddUserInputText
|
|
||||||
, loginAddUserInputText
|
|
||||||
, emailAddUserInputText
|
|
||||||
, passAddUserInputText of
|
|
||||||
Nothing, _, _, _, _ ->
|
Nothing, _, _, _, _ ->
|
||||||
unableToSend "Not connected to server."
|
unableToSend "Not connected to server."
|
||||||
|
|
||||||
|
@ -537,7 +502,7 @@ handleAction = case _ of
|
||||||
Just _, _, _, _, "" ->
|
Just _, _, _, _, "" ->
|
||||||
unableToSend "Write your password!"
|
unableToSend "Write your password!"
|
||||||
|
|
||||||
Just webSocket, secret, login, email, pass -> do
|
Just webSocket, _, _, _, _ -> do
|
||||||
H.liftEffect (WS.readyState webSocket) >>= case _ of
|
H.liftEffect (WS.readyState webSocket) >>= case _ of
|
||||||
Connecting ->
|
Connecting ->
|
||||||
unableToSend "Still connecting to server."
|
unableToSend "Still connecting to server."
|
||||||
|
@ -564,9 +529,9 @@ handleAction = case _ of
|
||||||
AuthenticationAttempt ev -> do
|
AuthenticationAttempt ev -> do
|
||||||
H.liftEffect $ Event.preventDefault ev
|
H.liftEffect $ Event.preventDefault ev
|
||||||
|
|
||||||
{ wsConnection, loginInputText, passInputText } <- H.get
|
{ wsConnection, authenticationForm } <- H.get
|
||||||
|
|
||||||
case wsConnection, loginInputText, passInputText of
|
case wsConnection, authenticationForm.login, authenticationForm.pass of
|
||||||
Nothing, _, _ ->
|
Nothing, _, _ ->
|
||||||
unableToSend "Not connected to server."
|
unableToSend "Not connected to server."
|
||||||
|
|
||||||
|
@ -673,7 +638,7 @@ appendMessageGeneric clearField msg = do
|
||||||
histSize <- H.gets _.messageHistoryLength
|
histSize <- H.gets _.messageHistoryLength
|
||||||
if clearField
|
if clearField
|
||||||
then H.modify_ \st ->
|
then H.modify_ \st ->
|
||||||
st { messages = appendSingle histSize msg st.messages, loginInputText = "" }
|
st { messages = appendSingle histSize msg st.messages, authenticationForm { login = "" }}
|
||||||
else H.modify_ \st ->
|
else H.modify_ \st ->
|
||||||
st { messages = appendSingle histSize msg st.messages }
|
st { messages = appendSingle histSize msg st.messages }
|
||||||
where
|
where
|
||||||
|
|
|
@ -50,7 +50,8 @@ initialState :: forall i. i -> State
|
||||||
initialState _ = { a: Nothing, b: Nothing, c: Nothing, token: Nothing }
|
initialState _ = { a: Nothing, b: Nothing, c: Nothing, token: Nothing }
|
||||||
|
|
||||||
render :: forall m. MonadAff m => State -> H.ComponentHTML Action ChildSlots m
|
render :: forall m. MonadAff m => State -> H.ComponentHTML Action ChildSlots m
|
||||||
render state = HH.div_ $
|
render state
|
||||||
|
= HH.div_ $
|
||||||
[ render_auth_form
|
[ render_auth_form
|
||||||
, div_token
|
, div_token
|
||||||
, render_original_interface
|
, render_original_interface
|
||||||
|
|
|
@ -2,6 +2,8 @@ module App.UserPublic where
|
||||||
|
|
||||||
import Prelude
|
import Prelude
|
||||||
|
|
||||||
|
import Data.Maybe
|
||||||
|
|
||||||
import Data.Codec.Argonaut (JsonCodec)
|
import Data.Codec.Argonaut (JsonCodec)
|
||||||
import Data.Codec.Argonaut as CA
|
import Data.Codec.Argonaut as CA
|
||||||
import Data.Codec.Argonaut.Record as CAR
|
import Data.Codec.Argonaut.Record as CAR
|
||||||
|
@ -11,11 +13,13 @@ import Data.Newtype (class Newtype)
|
||||||
-- | Lacks 'profile' and 'date_registration' attributes.
|
-- | Lacks 'profile' and 'date_registration' attributes.
|
||||||
-- type UserPublic row = { login :: String, uid :: Int | row }
|
-- type UserPublic row = { login :: String, uid :: Int | row }
|
||||||
-- TODO: add profile :: JSON any, date_registration :: Maybe Time
|
-- TODO: add profile :: JSON any, date_registration :: Maybe Time
|
||||||
type UserPublic = { login :: String, uid :: Int, date_registration :: String }
|
type UserPublic = { login :: String, uid :: Int, date_registration :: Maybe String }
|
||||||
|
|
||||||
-- | UserPublic.codec can be used to parse and encode public user info,
|
-- | UserPublic.codec can be used to parse and encode public user info,
|
||||||
-- | which can be exchanged in different messages.
|
-- | which can be exchanged in different messages.
|
||||||
codec :: JsonCodec UserPublic
|
codec :: JsonCodec UserPublic
|
||||||
codec = CA.object "UserPublic" (CAR.record { "login": CA.string
|
codec = CA.object "UserPublic" (CAR.record { "login": CA.string
|
||||||
, "uid": CA.int
|
, "uid": CA.int
|
||||||
, "date_registration": CA.string })
|
, "date_registration": CAR.optional CA.string })
|
||||||
|
|
||||||
|
-- {"user":{"login":"a","uid": 1003,"date_registration":"2023-06-03T03:32:10+02:00"}}
|
||||||
|
|
Loading…
Reference in New Issue