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

Authd admin interface: bulma ftw!

master
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

88
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 Prelude (Unit, Void, bind, discard, map, otherwise, pure, show, void, when, ($), (&&), (-), (<), (<$>), (<<<), (<>), (>=>), (>>=))
import Bulma as Bulma
import Control.Monad.Except (runExcept) import Control.Monad.Except (runExcept)
import Control.Monad.State (class MonadState) import Control.Monad.State (class MonadState)
import Data.Array as A import Data.Array as A
@ -196,74 +198,49 @@ initialState input =
, canReconnect: false , 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 :: forall m. State -> H.ComponentHTML Action () m
render { render {
messages, messages,
wsConnection, wsConnection,
canReconnect, canReconnect,
addUserForm } addUserForm }
= HH.div = HH.div_
[ HP.style wrapperStyle ] [ Bulma.columns_ [ Bulma.column_ adduser_form ]
[ render_adduser_form
, render_messages , render_messages
--, renderMaxHistoryLength messageHistoryLength --, renderMaxHistoryLength messageHistoryLength
, renderReconnectButton (isNothing wsConnection && canReconnect) , renderReconnectButton (isNothing wsConnection && canReconnect)
] ]
where 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 render_adduser_form = HH.form
[ HE.onSubmit AddUserAttempt ] [ HE.onSubmit AddUserAttempt ]
[ HH.h2_ [ HH.text "(admin) Add User!" ] [ Bulma.box_input "Secret" "shared secret with authd" -- title, placeholder
, HH.p_ (HandleAddUserInput <<< ADDUSER_INP_secret) -- action
[ HH.div_ addUserForm.secretKey -- value
[ HH.input true -- validity (TODO)
[ inputCSS should_be_disabled -- condition
, HP.type_ HP.InputText , Bulma.box_input "User login" "login" -- title, placeholder
, HP.value addUserForm.secretKey (HandleAddUserInput <<< ADDUSER_INP_login) -- action
, HE.onValueInput $ HandleAddUserInput <<< ADDUSER_INP_secret addUserForm.login -- value
, maybe (HP.disabled true) (\_ -> HP.enabled true) wsConnection true -- validity (TODO)
] should_be_disabled -- condition
] , Bulma.box_input "User email" "email" -- title, placeholder
, HH.div_ (HandleAddUserInput <<< ADDUSER_INP_email) -- action
[ HH.input addUserForm.email -- value
[ inputCSS true -- validity (TODO)
, HP.type_ HP.InputText should_be_disabled -- condition
, HP.value addUserForm.login , Bulma.box_password "User password" "password" -- title, placeholder
, HE.onValueInput $ HandleAddUserInput <<< ADDUSER_INP_login (HandleAddUserInput <<< ADDUSER_INP_pass) -- action
, maybe (HP.disabled true) (\_ -> HP.enabled true) wsConnection addUserForm.pass -- value
] true -- validity (TODO)
] should_be_disabled -- condition
, 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.div_
[ HH.button [ HH.button
[ HP.style "padding: 0.5rem 1.25rem;" [ HP.style "padding: 0.5rem 1.25rem;"
@ -273,7 +250,6 @@ render {
[ HH.text "Send Message to Server" ] [ HH.text "Send Message to Server" ]
] ]
] ]
]
render_messages = HH.ul_ $ map (\msg -> HH.li_ [ HH.text msg ]) messages render_messages = HH.ul_ $ map (\msg -> HH.li_ [ HH.text msg ]) messages
@ -494,8 +470,6 @@ foreignToArrayBuffer
renderForeignErrors = renderForeignErrors =
String.joinWith "; " <<< A.fromFoldable <<< map F.renderForeignError 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 :: forall m. MonadEffect m => MonadState State m => ArrayBuffer -> m Unit
print_json_string arraybuffer = do print_json_string arraybuffer = do
-- fromTypedIPC :: ArrayBuffer -> Effect (Either ParseError (Tuple UInt String)) -- fromTypedIPC :: ArrayBuffer -> Effect (Either ParseError (Tuple UInt String))