An admin can now create an admin user.

This commit is contained in:
Philippe Pittoli 2023-06-13 20:17:27 +02:00
parent 597243a9f5
commit c8c52ea408
2 changed files with 22 additions and 6 deletions

View File

@ -6,7 +6,7 @@ module App.AuthenticationDaemonAdminInterface where
- TODO: raise a user to admin
-}
import Prelude (Unit, Void, bind, discard, map, otherwise, pure, show, void, when, ($), (&&), (-), (<), (<$>), (<<<), (<>), (>=>), (>>=))
import Prelude (Unit, Void, bind, discard, map, otherwise, pure, show, void, when, ($), (&&), (-), (<), (<$>), (<<<), (<>), (>=>), (>>=), not)
import Bulma as Bulma
@ -143,6 +143,7 @@ type Input = String
data AddUserInput
= ADDUSER_INP_login String
| ADDUSER_INP_email String
| ADDUSER_toggle_admin
| ADDUSER_INP_pass String
data Action
@ -150,13 +151,13 @@ data Action
| WebSocketParseError String
| ConnectWebSocket
| HandleAddUserInput AddUserInput
| HandleAddUserInput AddUserInput
| AddUserAttempt Event
-- | Finalize
| HandleWebSocket (WebSocketEvent WebSocketMessageType)
type StateAddUserForm = { login :: String, email :: String, pass :: String }
type StateAddUserForm = { login :: String, admin :: Boolean, email :: String, pass :: String }
type State =
{ messages :: Array String
@ -187,7 +188,7 @@ initialState input =
{ messages: []
, messageHistoryLength: 10
, addUserForm: { login: "", email: "", pass: "" }
, addUserForm: { login: "", admin: false, email: "", pass: "" }
-- TODO: put network stuff in a record.
, wsUrl: input
@ -223,6 +224,12 @@ render {
addUserForm.login -- value
true -- validity (TODO)
should_be_disabled -- condition
, Bulma.btn
(show addUserForm.admin) -- value
(HandleAddUserInput ADDUSER_toggle_admin) -- action1
(HandleAddUserInput ADDUSER_toggle_admin) -- action2
true -- validity (TODO)
-- should_be_disabled -- condition
, Bulma.box_input "User email" "email" -- title, placeholder
(HandleAddUserInput <<< ADDUSER_INP_email) -- action
addUserForm.email -- value
@ -289,9 +296,11 @@ handleAction = case _ of
void $ H.subscribe (HandleWebSocket <$> webSocketEmitter webSocket)
HandleAddUserInput adduserinp -> do
{ addUserForm } <- H.get
case adduserinp of
ADDUSER_INP_login v -> H.modify_ _ { addUserForm { login = v } }
ADDUSER_INP_email v -> H.modify_ _ { addUserForm { email = v } }
ADDUSER_toggle_admin -> H.modify_ _ { addUserForm { admin = not addUserForm.admin } }
ADDUSER_INP_pass v -> H.modify_ _ { addUserForm { pass = v } }
AddUserAttempt ev -> do
@ -332,7 +341,7 @@ handleAction = case _ of
Open -> do
H.liftEffect $ do
ab <- AuthD.serialize $ AuthD.MkAddUser { login: login
, admin: false
, admin: addUserForm.admin
, email: Just (Email.Email email)
, password: pass }
sendArrayBuffer webSocket ab

View File

@ -285,7 +285,7 @@ box_input_password action password validity = HH.label [ ]
-- _ -> HE.onClick \_ -> action2
btn :: forall w i. String -> i -> i -> Boolean -> HH.HTML w i
btn :: forall w action. String -> action -> action -> Boolean -> HH.HTML w action
btn title action1 action2 validity
= HH.button
[ btn_add_action validity
@ -317,6 +317,13 @@ box_inner ispassword title placeholder action value validity cond
box_input = box_inner false
box_password = box_inner true
--box_button action value validity cond
-- = HH.label [ ]
-- [ HH.label [HP.classes class_label ] [ HH.text title ]
-- , HH.div [HP.classes class_control ]
-- [ render_input ispassword placeholder action value validity cond ]
-- ]
p :: forall w i. String -> HH.HTML w i
p str = HH.p_ [ HH.text str ]