AddUser (WIP: working but UserAdded answer isn't parsed properly).
This commit is contained in:
parent
17b07ada18
commit
0bdef754ae
@ -146,8 +146,15 @@ data Action
|
||||
| HandleEmailRegisterInputUpdate String
|
||||
| HandlePassRegisterInputUpdate String
|
||||
|
||||
-- (admin) AddUser.
|
||||
| HandleSecretKeyAddUserInputUpdate String
|
||||
| HandleLoginAddUserInputUpdate String
|
||||
| HandleEmailAddUserInputUpdate String
|
||||
| HandlePassAddUserInputUpdate String
|
||||
|
||||
| AuthenticationAttempt Event
|
||||
| RegisterAttempt Event
|
||||
| AddUserAttempt Event
|
||||
| Finalize
|
||||
| HandleWebSocket (WebSocketEvent WebSocketMessageType)
|
||||
|
||||
@ -164,6 +171,12 @@ type State =
|
||||
, emailRegisterInputText :: String
|
||||
, passRegisterInputText :: String
|
||||
|
||||
-- Admin: AddUser.
|
||||
, secretKeyAddUserInputText :: String
|
||||
, loginAddUserInputText :: String
|
||||
, emailAddUserInputText :: String
|
||||
, passAddUserInputText :: String
|
||||
|
||||
-- Network stuff.
|
||||
, wsUrl :: String
|
||||
, wsConnection :: Maybe WS.WebSocket
|
||||
@ -196,6 +209,12 @@ initialState input =
|
||||
, emailRegisterInputText: ""
|
||||
, passRegisterInputText: ""
|
||||
|
||||
-- Admin: AddUser.
|
||||
, secretKeyAddUserInputText: ""
|
||||
, loginAddUserInputText: ""
|
||||
, emailAddUserInputText: ""
|
||||
, passAddUserInputText: ""
|
||||
|
||||
-- Network stuff.
|
||||
, wsUrl: input
|
||||
, wsConnection: Nothing
|
||||
@ -228,11 +247,18 @@ render {
|
||||
-- Register.
|
||||
loginRegisterInputText,
|
||||
emailRegisterInputText,
|
||||
passRegisterInputText }
|
||||
passRegisterInputText,
|
||||
|
||||
-- AddUser.
|
||||
secretKeyAddUserInputText,
|
||||
loginAddUserInputText,
|
||||
emailAddUserInputText,
|
||||
passAddUserInputText }
|
||||
= HH.div
|
||||
[ HP.style wrapperStyle ]
|
||||
[ render_auth_form
|
||||
, render_register_form
|
||||
, render_adduser_form
|
||||
, render_messages
|
||||
--, renderMaxHistoryLength messageHistoryLength
|
||||
, renderReconnectButton (isNothing wsConnection && canReconnect)
|
||||
@ -314,6 +340,57 @@ render {
|
||||
]
|
||||
]
|
||||
|
||||
render_adduser_form = HH.form
|
||||
[ HE.onSubmit AddUserAttempt ]
|
||||
[ HH.h2_ [ HH.text "(admin) Add User!" ]
|
||||
, HH.p_
|
||||
[ HH.div_
|
||||
[ HH.input
|
||||
[ inputCSS
|
||||
, HP.type_ HP.InputText
|
||||
, HP.value secretKeyAddUserInputText
|
||||
, HE.onValueInput HandleSecretKeyAddUserInputUpdate
|
||||
, maybe (HP.disabled true) (\_ -> HP.enabled true) wsConnection
|
||||
]
|
||||
]
|
||||
, HH.div_
|
||||
[ HH.input
|
||||
[ inputCSS
|
||||
, HP.type_ HP.InputText
|
||||
, HP.value loginAddUserInputText
|
||||
, HE.onValueInput HandleLoginAddUserInputUpdate
|
||||
, maybe (HP.disabled true) (\_ -> HP.enabled true) wsConnection
|
||||
]
|
||||
]
|
||||
, HH.div_
|
||||
[ HH.input
|
||||
[ inputCSS
|
||||
, HP.type_ HP.InputText
|
||||
, HP.value emailAddUserInputText
|
||||
, HE.onValueInput HandleEmailAddUserInputUpdate
|
||||
, maybe (HP.disabled true) (\_ -> HP.enabled true) wsConnection
|
||||
]
|
||||
]
|
||||
, HH.div_
|
||||
[ HH.input
|
||||
[ inputCSS
|
||||
, HP.type_ HP.InputPassword
|
||||
, HP.value passAddUserInputText
|
||||
, HE.onValueInput HandlePassAddUserInputUpdate
|
||||
, 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
|
||||
@ -377,6 +454,16 @@ handleAction = case _ of
|
||||
HandlePassRegisterInputUpdate text -> do
|
||||
H.modify_ _ { passRegisterInputText = text }
|
||||
|
||||
-- (admin) AddUser.
|
||||
HandleSecretKeyAddUserInputUpdate text -> do
|
||||
H.modify_ _ { secretKeyAddUserInputText = text }
|
||||
HandleLoginAddUserInputUpdate text -> do
|
||||
H.modify_ _ { loginAddUserInputText = text }
|
||||
HandleEmailAddUserInputUpdate text -> do
|
||||
H.modify_ _ { emailAddUserInputText = text }
|
||||
HandlePassAddUserInputUpdate text -> do
|
||||
H.modify_ _ { passAddUserInputText = text }
|
||||
|
||||
RegisterAttempt ev -> do
|
||||
H.liftEffect $ Event.preventDefault ev
|
||||
|
||||
@ -421,6 +508,59 @@ handleAction = case _ of
|
||||
sendArrayBuffer webSocket ab
|
||||
appendMessageReset "[😇] Trying to register"
|
||||
|
||||
AddUserAttempt ev -> do
|
||||
H.liftEffect $ Event.preventDefault ev
|
||||
|
||||
{ wsConnection
|
||||
, secretKeyAddUserInputText
|
||||
, loginAddUserInputText
|
||||
, emailAddUserInputText
|
||||
, passAddUserInputText } <- H.get
|
||||
|
||||
case wsConnection
|
||||
, secretKeyAddUserInputText
|
||||
, loginAddUserInputText
|
||||
, emailAddUserInputText
|
||||
, passAddUserInputText of
|
||||
Nothing, _, _, _, _ ->
|
||||
unableToSend "Not connected to server."
|
||||
|
||||
Just _, "", _, _, _ ->
|
||||
unableToSend "Write your secret key!"
|
||||
|
||||
Just _, _, "", _, _ ->
|
||||
unableToSend "Write your login!"
|
||||
|
||||
Just _, _, _, "", _ ->
|
||||
unableToSend "Write your email!"
|
||||
|
||||
Just _, _, _, _, "" ->
|
||||
unableToSend "Write your password!"
|
||||
|
||||
Just webSocket, secret, login, email, pass -> do
|
||||
H.liftEffect (WS.readyState webSocket) >>= case _ of
|
||||
Connecting ->
|
||||
unableToSend "Still connecting to server."
|
||||
|
||||
Closing ->
|
||||
unableToSend "Connection to server is closing."
|
||||
|
||||
Closed -> do
|
||||
unableToSend "Connection to server has been closed."
|
||||
maybeCurrentConnection <- H.gets _.wsConnection
|
||||
when (isJust maybeCurrentConnection) do
|
||||
H.modify_ _ { wsConnection = Nothing, canReconnect = true }
|
||||
|
||||
Open -> do
|
||||
H.liftEffect $ do
|
||||
ab <- AuthD.serialize $ AuthD.MkAddUser { shared_key: secret
|
||||
, login: login
|
||||
, email: Just (Email.Email email)
|
||||
, password: pass
|
||||
, phone: Nothing}
|
||||
sendArrayBuffer webSocket ab
|
||||
appendMessageReset "[😇] Trying to add a user"
|
||||
|
||||
AuthenticationAttempt ev -> do
|
||||
H.liftEffect $ Event.preventDefault ev
|
||||
|
||||
|
@ -11,9 +11,11 @@ import Data.Newtype (class Newtype)
|
||||
-- | Lacks 'profile' and 'date_registration' attributes.
|
||||
-- type UserPublic row = { login :: String, uid :: Int | row }
|
||||
-- TODO: add profile :: JSON any, date_registration :: Maybe Time
|
||||
type UserPublic = { login :: String, uid :: Int }
|
||||
type UserPublic = { login :: String, uid :: Int, date_registration :: String }
|
||||
|
||||
-- | UserPublic.codec can be used to parse and encode public user info,
|
||||
-- | which can be exchanged in different messages.
|
||||
codec :: JsonCodec UserPublic
|
||||
codec = CA.object "UserPublic" (CAR.record { "login": CA.string, "uid": CA.int })
|
||||
codec = CA.object "UserPublic" (CAR.record { "login": CA.string
|
||||
, "uid": CA.int
|
||||
, "date_registration": CA.string })
|
||||
|
Loading…
Reference in New Issue
Block a user