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

Authd admin interface: bulma ftw!

Browse Source
This commit is contained in:
Philippe Pittoli 2023-06-09 01:55:37 +02:00
parent b4bc1f8f77
commit 46de4c6026
1 changed files with 37 additions and 63 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

100
src/App/AuthenticationDaemonAdminInterface.purs
View File

@ -8,6 +8,8 @@ module App.AuthenticationDaemonAdminInterface where
import Prelude (Unit, Void, bind, discard, map, otherwise, pure, show, void, when, ($), (&&), (-), (<), (<$>), (<<<), (<>), (>=>), (>>=))
import Bulma as Bulma
import Control.Monad.Except (runExcept)
import Control.Monad.State (class MonadState)
import Data.Array as A
@ -196,82 +198,56 @@ initialState input =
, canReconnect: false
}
wrapperStyle :: String
wrapperStyle =
"""
display: block;
flex-direction: column;
justify-content: space-between;
height: calc(100vh - 30px);
background: #282c34;
color: #e06c75;
font-family: 'Consolas';
padding: 5px 20px 5px 20px;
"""
render :: forall m. State -> H.ComponentHTML Action () m
render {
messages,
wsConnection,
canReconnect,
addUserForm }
= HH.div
[ HP.style wrapperStyle ]
[ render_adduser_form
= HH.div_
[ Bulma.columns_ [ Bulma.column_ adduser_form ]
, render_messages
--, renderMaxHistoryLength messageHistoryLength
, renderReconnectButton (isNothing wsConnection && canReconnect)
]
where
adduser_form
= [ Bulma.h3 "Add a new user"
, render_adduser_form
]
should_be_disabled = (maybe (HP.disabled true) (\_ -> HP.enabled true) wsConnection)
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 addUserForm.secretKey
, HE.onValueInput $ HandleAddUserInput <<< ADDUSER_INP_secret
, maybe (HP.disabled true) (\_ -> HP.enabled true) wsConnection
]
]
, HH.div_
[ HH.input
[ inputCSS
, HP.type_ HP.InputText
, HP.value addUserForm.login
, HE.onValueInput $ HandleAddUserInput <<< ADDUSER_INP_login
, maybe (HP.disabled true) (\_ -> HP.enabled true) wsConnection
]
]
, HH.div_
[ HH.input
[ inputCSS
, HP.type_ HP.InputText
, HP.value addUserForm.email
, HE.onValueInput $ HandleAddUserInput <<< ADDUSER_INP_email
, maybe (HP.disabled true) (\_ -> HP.enabled true) wsConnection
]
]
, HH.div_
[ HH.input
[ inputCSS
, HP.type_ HP.InputPassword
, HP.value addUserForm.pass
, HE.onValueInput $ HandleAddUserInput <<< ADDUSER_INP_pass
, 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" ]
[ Bulma.box_input "Secret" "shared secret with authd" -- title, placeholder
(HandleAddUserInput <<< ADDUSER_INP_secret) -- action
addUserForm.secretKey -- value
true -- validity (TODO)
should_be_disabled -- condition
, Bulma.box_input "User login" "login" -- title, placeholder
(HandleAddUserInput <<< ADDUSER_INP_login) -- action
addUserForm.login -- value
true -- validity (TODO)
should_be_disabled -- condition
, Bulma.box_input "User email" "email" -- title, placeholder
(HandleAddUserInput <<< ADDUSER_INP_email) -- action
addUserForm.email -- value
true -- validity (TODO)
should_be_disabled -- condition
, Bulma.box_password "User password" "password" -- title, placeholder
(HandleAddUserInput <<< ADDUSER_INP_pass) -- action
addUserForm.pass -- value
true -- validity (TODO)
should_be_disabled -- condition
, 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" ]
]
]
@ -494,8 +470,6 @@ 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))