An admin can now create an admin user.

src/App/AuthenticationDaemonAdminInterface.purs

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

src/Bulma.purs

@@ -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 ]