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

Code in now way clearer.

master
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 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

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 } 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
[ render_auth_form = HH.div_ $
, div_token [ render_auth_form
, render_original_interface , div_token
--, useless_stuff , render_original_interface
] --, useless_stuff
]
where where
div_token :: forall monad. MonadAff monad => H.ComponentHTML Action ChildSlots monad div_token :: forall monad. MonadAff monad => H.ComponentHTML Action ChildSlots monad
div_token = div_token =

8
src/App/UserPublic.purs
View File

@ -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"}}