karchnu/halogen-websocket-ipc-playzone
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Code in now way clearer.

Browse Source
This commit is contained in:
Philippe Pittoli 2023-06-04 01:24:05 +02:00
parent 0bdef754ae
commit 6c69eaea5a
3 changed files with 95 additions and 125 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

199
src/App/AuthenticationForm.purs
View File

@ -132,25 +132,29 @@ type Query :: forall k. k -> Type
type Query = Const Void
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
= Initialize
| WebSocketParseError String
| ConnectWebSocket
-- Authentication.
| HandleLoginInputUpdate String
| HandlePassInputUpdate String
-- Register.
| HandleLoginRegisterInputUpdate String
| HandleEmailRegisterInputUpdate String
| HandlePassRegisterInputUpdate String
-- (admin) AddUser.
| HandleSecretKeyAddUserInputUpdate String
| HandleLoginAddUserInputUpdate String
| HandleEmailAddUserInputUpdate String
| HandlePassAddUserInputUpdate String
| HandleAuthenticationInput AuthenticationInput
| HandleRegisterInput RegisterInput
| HandleAddUserInput AddUserInput -- admin operation
| AuthenticationAttempt Event
| RegisterAttempt Event
@ -158,26 +162,19 @@ data Action
| Finalize
| 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 =
{ messages :: Array String
, messageHistoryLength :: Int
-- Authentication.
, loginInputText :: String
, passInputText :: String
, authenticationForm :: StateAuthenticationForm
, registrationForm :: StateRegistrationForm
, addUserForm :: StateAddUserForm
-- Register.
, loginRegisterInputText :: String
, emailRegisterInputText :: String
, passRegisterInputText :: String
-- Admin: AddUser.
, secretKeyAddUserInputText :: String
, loginAddUserInputText :: String
, emailAddUserInputText :: String
, passAddUserInputText :: String
-- Network stuff.
-- TODO: put network stuff in a record.
, wsUrl :: String
, wsConnection :: Maybe WS.WebSocket
, canReconnect :: Boolean
@ -200,22 +197,11 @@ initialState input =
{ messages: []
, messageHistoryLength: 10
-- Authentication.
, loginInputText: ""
, passInputText: ""
, authenticationForm: { login: "", pass: "" }
, registrationForm: { login: "", email: "", pass: "" }
, addUserForm: { secretKey: "", login: "", email: "", pass: "" }
-- Register.
, loginRegisterInputText: ""
, emailRegisterInputText: ""
, passRegisterInputText: ""
-- Admin: AddUser.
, secretKeyAddUserInputText: ""
, loginAddUserInputText: ""
, emailAddUserInputText: ""
, passAddUserInputText: ""
-- Network stuff.
-- TODO: put network stuff in a record.
, wsUrl: input
, wsConnection: Nothing
, canReconnect: false
@ -240,20 +226,9 @@ render {
wsConnection,
canReconnect,
-- Authentication.
loginInputText,
passInputText,
-- Register.
loginRegisterInputText,
emailRegisterInputText,
passRegisterInputText,
-- AddUser.
secretKeyAddUserInputText,
loginAddUserInputText,
emailAddUserInputText,
passAddUserInputText }
authenticationForm,
registrationForm,
addUserForm }
= HH.div
[ HP.style wrapperStyle ]
[ render_auth_form
@ -273,8 +248,8 @@ render {
[ HH.input
[ inputCSS
, HP.type_ HP.InputText
, HP.value loginInputText
, HE.onValueInput HandleLoginInputUpdate
, HP.value authenticationForm.login
, HE.onValueInput $ HandleAuthenticationInput <<< AUTH_INP_login
, maybe (HP.disabled true) (\_ -> HP.enabled true) wsConnection
]
]
@ -282,8 +257,8 @@ render {
[ HH.input
[ inputCSS
, HP.type_ HP.InputPassword
, HP.value passInputText
, HE.onValueInput HandlePassInputUpdate
, HP.value authenticationForm.pass
, HE.onValueInput $ HandleAuthenticationInput <<< AUTH_INP_pass
, maybe (HP.disabled true) (\_ -> HP.enabled true) wsConnection
]
]
@ -306,8 +281,8 @@ render {
[ HH.input
[ inputCSS
, HP.type_ HP.InputText
, HP.value loginRegisterInputText
, HE.onValueInput HandleLoginRegisterInputUpdate
, HP.value registrationForm.login
, HE.onValueInput $ HandleRegisterInput <<< REG_INP_login
, maybe (HP.disabled true) (\_ -> HP.enabled true) wsConnection
]
]
@ -315,8 +290,8 @@ render {
[ HH.input
[ inputCSS
, HP.type_ HP.InputText
, HP.value emailRegisterInputText
, HE.onValueInput HandleEmailRegisterInputUpdate
, HP.value registrationForm.email
, HE.onValueInput $ HandleRegisterInput <<< REG_INP_email
, maybe (HP.disabled true) (\_ -> HP.enabled true) wsConnection
]
]
@ -324,8 +299,8 @@ render {
[ HH.input
[ inputCSS
, HP.type_ HP.InputPassword
, HP.value passRegisterInputText
, HE.onValueInput HandlePassRegisterInputUpdate
, HP.value registrationForm.pass
, HE.onValueInput $ HandleRegisterInput <<< REG_INP_pass
, maybe (HP.disabled true) (\_ -> HP.enabled true) wsConnection
]
]
@ -348,8 +323,8 @@ render {
[ HH.input
[ inputCSS
, HP.type_ HP.InputText
, HP.value secretKeyAddUserInputText
, HE.onValueInput HandleSecretKeyAddUserInputUpdate
, HP.value addUserForm.secretKey
, HE.onValueInput $ HandleAddUserInput <<< ADDUSER_INP_secret
, maybe (HP.disabled true) (\_ -> HP.enabled true) wsConnection
]
]
@ -357,8 +332,8 @@ render {
[ HH.input
[ inputCSS
, HP.type_ HP.InputText
, HP.value loginAddUserInputText
, HE.onValueInput HandleLoginAddUserInputUpdate
, HP.value addUserForm.login
, HE.onValueInput $ HandleAddUserInput <<< ADDUSER_INP_login
, maybe (HP.disabled true) (\_ -> HP.enabled true) wsConnection
]
]
@ -366,8 +341,8 @@ render {
[ HH.input
[ inputCSS
, HP.type_ HP.InputText
, HP.value emailAddUserInputText
, HE.onValueInput HandleEmailAddUserInputUpdate
, HP.value addUserForm.email
, HE.onValueInput $ HandleAddUserInput <<< ADDUSER_INP_email
, maybe (HP.disabled true) (\_ -> HP.enabled true) wsConnection
]
]
@ -375,8 +350,8 @@ render {
[ HH.input
[ inputCSS
, HP.type_ HP.InputPassword
, HP.value passAddUserInputText
, HE.onValueInput HandlePassAddUserInputUpdate
, HP.value addUserForm.pass
, HE.onValueInput $ HandleAddUserInput <<< ADDUSER_INP_pass
, maybe (HP.disabled true) (\_ -> HP.enabled true) wsConnection
]
]
@ -440,39 +415,33 @@ 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 }
HandleAuthenticationInput authinp -> do
case authinp of
AUTH_INP_login v -> H.modify_ _ { authenticationForm { login = v } }
AUTH_INP_pass v -> H.modify_ _ { authenticationForm { pass = v } }
-- Register.
HandleLoginRegisterInputUpdate text -> do
H.modify_ _ { loginRegisterInputText = text }
HandleEmailRegisterInputUpdate text -> do
H.modify_ _ { emailRegisterInputText = text }
HandlePassRegisterInputUpdate text -> do
H.modify_ _ { passRegisterInputText = text }
HandleRegisterInput reginp -> do
case reginp of
REG_INP_login v -> H.modify_ _ { registrationForm { login = v } }
REG_INP_email v -> H.modify_ _ { registrationForm { email = v } }
REG_INP_pass v -> H.modify_ _ { registrationForm { pass = v } }
-- (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 }
HandleAddUserInput adduserinp -> do
case adduserinp of
ADDUSER_INP_secret v -> H.modify_ _ { addUserForm { secretKey = v } }
ADDUSER_INP_login v -> H.modify_ _ { addUserForm { login = v } }
ADDUSER_INP_email v -> H.modify_ _ { addUserForm { email = v } }
ADDUSER_INP_pass v -> H.modify_ _ { addUserForm { pass = v } }
RegisterAttempt ev -> do
H.liftEffect $ Event.preventDefault ev
{ wsConnection
, loginRegisterInputText
, emailRegisterInputText
, passRegisterInputText } <- H.get
{ wsConnection, registrationForm } <- H.get
let login = registrationForm.login
email = registrationForm.email
pass = registrationForm.pass
case wsConnection, loginRegisterInputText, emailRegisterInputText, passRegisterInputText of
case wsConnection, login, email, pass of
Nothing, _, _, _ ->
unableToSend "Not connected to server."
@ -485,7 +454,7 @@ handleAction = case _ of
Just _, _, _, "" ->
unableToSend "Write your password!"
Just webSocket, login, email, pass -> do
Just webSocket, _, _, _ -> do
H.liftEffect (WS.readyState webSocket) >>= case _ of
Connecting ->
unableToSend "Still connecting to server."
@ -511,17 +480,13 @@ handleAction = case _ of
AddUserAttempt ev -> do
H.liftEffect $ Event.preventDefault ev
{ wsConnection
, secretKeyAddUserInputText
, loginAddUserInputText
, emailAddUserInputText
, passAddUserInputText } <- H.get
{ wsConnection, addUserForm } <- H.get
let secret = addUserForm.secretKey
login = addUserForm.login
email = addUserForm.email
pass = addUserForm.pass
case wsConnection
, secretKeyAddUserInputText
, loginAddUserInputText
, emailAddUserInputText
, passAddUserInputText of
case wsConnection, secret, login, email, pass of
Nothing, _, _, _, _ ->
unableToSend "Not connected to server."
@ -537,7 +502,7 @@ handleAction = case _ of
Just _, _, _, _, "" ->
unableToSend "Write your password!"
Just webSocket, secret, login, email, pass -> do
Just webSocket, _, _, _, _ -> do
H.liftEffect (WS.readyState webSocket) >>= case _ of
Connecting ->
unableToSend "Still connecting to server."
@ -564,9 +529,9 @@ handleAction = case _ of
AuthenticationAttempt ev -> do
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, _, _ ->
unableToSend "Not connected to server."
@ -673,7 +638,7 @@ appendMessageGeneric clearField msg = do
histSize <- H.gets _.messageHistoryLength
if clearField
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 ->
st { messages = appendSingle histSize msg st.messages }
where

13
src/App/Container.purs
View File

@ -50,12 +50,13 @@ initialState :: forall i. i -> State
initialState _ = { a: Nothing, b: Nothing, c: Nothing, token: Nothing }
render :: forall m. MonadAff m => State -> H.ComponentHTML Action ChildSlots m
render state = HH.div_ $
[ render_auth_form
, div_token
, render_original_interface
--, useless_stuff
]
render state
= HH.div_ $
[ render_auth_form
, div_token
, render_original_interface
--, useless_stuff
]
where
div_token :: forall monad. MonadAff monad => H.ComponentHTML Action ChildSlots monad
div_token =

8
src/App/UserPublic.purs
View File

@ -2,6 +2,8 @@ module App.UserPublic where
import Prelude
import Data.Maybe
import Data.Codec.Argonaut (JsonCodec)
import Data.Codec.Argonaut as CA
import Data.Codec.Argonaut.Record as CAR
@ -11,11 +13,13 @@ 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, 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,
-- | which can be exchanged in different messages.
codec :: JsonCodec UserPublic
codec = CA.object "UserPublic" (CAR.record { "login": CA.string
, "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"}}