Authentication Daemon Administration Interface: search for a user!
parent
98a30b6c1d
commit
f53c265114
|
@ -7,7 +7,7 @@
|
||||||
-}
|
-}
|
||||||
module App.AuthenticationDaemonAdminInterface where
|
module App.AuthenticationDaemonAdminInterface where
|
||||||
|
|
||||||
import Prelude (Unit, bind, discard, not, pure, show, ($), (<<<), (<>), (=<<))
|
import Prelude (Unit, bind, discard, not, pure, show, ($), (<<<), (<>), (=<<), map)
|
||||||
|
|
||||||
import Bulma as Bulma
|
import Bulma as Bulma
|
||||||
|
|
||||||
|
@ -27,12 +27,14 @@ import Web.HTML (window) as HTML
|
||||||
import Web.HTML.Window (sessionStorage) as Window
|
import Web.HTML.Window (sessionStorage) as Window
|
||||||
import Web.Storage.Storage as Storage
|
import Web.Storage.Storage as Storage
|
||||||
|
|
||||||
|
import App.UserPublic (UserPublic)
|
||||||
import Data.ArrayBuffer.Types (ArrayBuffer)
|
import Data.ArrayBuffer.Types (ArrayBuffer)
|
||||||
|
|
||||||
import App.LogMessage
|
import App.LogMessage
|
||||||
-- import App.IPC as IPC
|
-- import App.IPC as IPC
|
||||||
import App.Email as Email
|
import App.Email as Email
|
||||||
|
|
||||||
|
-- import App.Messages.DNSManagerDaemon as DNSManager
|
||||||
import App.Messages.AuthenticationDaemon as AuthD
|
import App.Messages.AuthenticationDaemon as AuthD
|
||||||
|
|
||||||
data Output
|
data Output
|
||||||
|
@ -42,7 +44,7 @@ data Output
|
||||||
| StoreState State
|
| StoreState State
|
||||||
|
|
||||||
data Query a
|
data Query a
|
||||||
= MessageReceived ArrayBuffer a
|
= MessageReceived AuthD.AnswerMessage a
|
||||||
| ConnectionIsDown a
|
| ConnectionIsDown a
|
||||||
| ConnectionIsUp a
|
| ConnectionIsUp a
|
||||||
| ProvideState (Maybe State) a
|
| ProvideState (Maybe State) a
|
||||||
|
@ -56,16 +58,12 @@ data AddUserInput
|
||||||
| ADDUSER_INP_email String
|
| ADDUSER_INP_email String
|
||||||
| ADDUSER_toggle_admin
|
| ADDUSER_toggle_admin
|
||||||
| ADDUSER_INP_pass String
|
| ADDUSER_INP_pass String
|
||||||
| SEARCHUSER_INP_login String
|
| SEARCHUSER_INP_regex String
|
||||||
| SEARCHUSER_INP_email String
|
--| SEARCHUSER_INP_domain String
|
||||||
| SEARCHUSER_toggle_admin
|
|
||||||
--| SEARCHUSER_INP_domain
|
|
||||||
|
|
||||||
data Action
|
data Action
|
||||||
= HandleAddUserInput AddUserInput
|
= HandleAddUserInput AddUserInput
|
||||||
|
|
||||||
| CancelModal
|
|
||||||
|
|
||||||
| AddUserAttempt
|
| AddUserAttempt
|
||||||
| SearchUserAttempt
|
| SearchUserAttempt
|
||||||
| PreventSubmit Event
|
| PreventSubmit Event
|
||||||
|
@ -81,13 +79,14 @@ data Action
|
||||||
data Page = Home | Search | Add
|
data Page = Home | Search | Add
|
||||||
|
|
||||||
type StateAddUserForm = { login :: String, admin :: Boolean, email :: String, pass :: String }
|
type StateAddUserForm = { login :: String, admin :: Boolean, email :: String, pass :: String }
|
||||||
type StateSearchUserForm = { login :: String, admin :: Boolean, email :: String, domain :: String }
|
type StateSearchUserForm = { regex :: String {-, admin :: Boolean, domain :: String -} }
|
||||||
|
|
||||||
type State =
|
type State =
|
||||||
{ addUserForm :: StateAddUserForm
|
{ addUserForm :: StateAddUserForm
|
||||||
, searchUserForm :: StateSearchUserForm
|
, searchUserForm :: StateSearchUserForm
|
||||||
, page :: Page
|
, page :: Page
|
||||||
, wsUp :: Boolean
|
, wsUp :: Boolean
|
||||||
|
, matching_users :: Array UserPublic
|
||||||
}
|
}
|
||||||
|
|
||||||
component :: forall m. MonadAff m => H.Component Query Input Output m
|
component :: forall m. MonadAff m => H.Component Query Input Output m
|
||||||
|
@ -105,26 +104,29 @@ component =
|
||||||
|
|
||||||
initialState :: Input -> State
|
initialState :: Input -> State
|
||||||
initialState _ = { addUserForm: { login: "", admin: false, email: "", pass: "" }
|
initialState _ = { addUserForm: { login: "", admin: false, email: "", pass: "" }
|
||||||
, searchUserForm: { login: "", admin: false, email: "", domain: "" }
|
, searchUserForm: { regex: "" {-, admin: false, domain: "" -} }
|
||||||
|
, matching_users: []
|
||||||
, page: Home
|
, page: Home
|
||||||
, wsUp: true
|
, wsUp: true
|
||||||
}
|
}
|
||||||
|
|
||||||
render :: forall m. State -> H.ComponentHTML Action () m
|
render :: forall m. State -> H.ComponentHTML Action () m
|
||||||
render { addUserForm, searchUserForm, page, wsUp }
|
render { addUserForm, searchUserForm, matching_users, page, wsUp }
|
||||||
= HH.div_
|
= HH.div_
|
||||||
[ Bulma.box [routing_search_button, routing_add_button]
|
[ Bulma.box [routing_search_button, routing_add_button]
|
||||||
, case page of
|
, case page of
|
||||||
Home -> Bulma.section_small [Bulma.h3 "Select an action"]
|
Home -> Bulma.section_small [Bulma.h3 "Select an action"]
|
||||||
Search -> Bulma.columns_
|
Search -> Bulma.columns_
|
||||||
[ Bulma.column (C.is_size 3) [Bulma.article (Bulma.p "Search users") render_searchuser_form]
|
[ Bulma.column (C.is_size 3) [Bulma.article (Bulma.p "Search users") render_searchuser_form]
|
||||||
, Bulma.column_ [ Bulma.h3 "Result", Bulma.subtitle "TODO" ]
|
, Bulma.column_ [ Bulma.h3 "Result", show_found_users ]
|
||||||
]
|
]
|
||||||
Add -> Bulma.columns_
|
Add -> Bulma.columns_
|
||||||
[ Bulma.column (C.is_size 5) [Bulma.article (Bulma.p "Add a new user") render_adduser_form] ]
|
[ Bulma.column (C.is_size 5) [Bulma.article (Bulma.p "Add a new user") render_adduser_form] ]
|
||||||
]
|
]
|
||||||
where
|
where
|
||||||
|
show_found_users = HH.div_ $ map user_card matching_users
|
||||||
|
user_card user = Bulma.box [Bulma.p user.login]
|
||||||
|
up x = HandleAddUserInput <<< x
|
||||||
active = (if wsUp then (HP.enabled true) else (HP.disabled true))
|
active = (if wsUp then (HP.enabled true) else (HP.disabled true))
|
||||||
|
|
||||||
render_adduser_form =
|
render_adduser_form =
|
||||||
|
@ -137,49 +139,53 @@ render { addUserForm, searchUserForm, page, wsUp }
|
||||||
, Bulma.btn "Send" AddUserAttempt
|
, Bulma.btn "Send" AddUserAttempt
|
||||||
]
|
]
|
||||||
|
|
||||||
up x = HandleAddUserInput <<< x
|
|
||||||
|
|
||||||
render_searchuser_form =
|
render_searchuser_form =
|
||||||
HH.form
|
HH.form
|
||||||
[ HE.onSubmit PreventSubmit ]
|
[ HE.onSubmit PreventSubmit ]
|
||||||
[ Bulma.box_input "login" "Login" "login" (up SEARCHUSER_INP_login) searchUserForm.login active
|
[ Bulma.p """
|
||||||
, Bulma.btn_labeled "adminbtn" "Admin" (show searchUserForm.admin) (HandleAddUserInput SEARCHUSER_toggle_admin)
|
Following input accepts any regex.
|
||||||
, Bulma.box_input "email" "Email" "email" (up SEARCHUSER_INP_email) searchUserForm.email active
|
This will be used to search an user based on his login, full name or email address.
|
||||||
|
"""
|
||||||
|
, Bulma.box_input "regex" "Regex" "regex" (up SEARCHUSER_INP_regex) searchUserForm.regex active
|
||||||
|
--, Bulma.btn_labeled "adminbtn" "Admin" (show searchUserForm.admin)
|
||||||
|
-- (HandleAddUserInput SEARCHUSER_toggle_admin)
|
||||||
--, Bulma.box_input "domain" "Domain owned" "blah.netlib.re."
|
--, Bulma.box_input "domain" "Domain owned" "blah.netlib.re."
|
||||||
-- (up SEARCHUSER_INP_domain) searchUserForm.email active
|
-- (up SEARCHUSER_INP_domain) searchUserForm.domain active
|
||||||
, Bulma.btn "Send" SearchUserAttempt
|
, Bulma.btn "Send" SearchUserAttempt
|
||||||
]
|
]
|
||||||
|
|
||||||
routing_search_button = Bulma.btn "Search" $ Routing Search
|
routing_search_button = Bulma.btn "Search" $ Routing Search
|
||||||
routing_add_button = Bulma.btn "Add" $ Routing Add
|
routing_add_button = Bulma.btn "Add" $ Routing Add
|
||||||
cancel_button = Bulma.cancel_button CancelModal
|
|
||||||
|
|
||||||
handleAction :: forall m. MonadAff m => Action -> H.HalogenM State Action () Output m Unit
|
handleAction :: forall m. MonadAff m => Action -> H.HalogenM State Action () Output m Unit
|
||||||
handleAction = case _ of
|
handleAction = case _ of
|
||||||
Initialize -> do
|
Initialize -> do
|
||||||
H.raise $ AskState
|
H.raise $ AskState
|
||||||
|
sessionstorage <- H.liftEffect $ Window.sessionStorage =<< HTML.window
|
||||||
|
old_page <- H.liftEffect $ Storage.getItem "current-ada-page" sessionstorage
|
||||||
|
case old_page of
|
||||||
|
Nothing -> H.raise $ Log $ SimpleLog "we hadn't changed page before reload apparently."
|
||||||
|
Just page -> case page of
|
||||||
|
"Home" -> handleAction $ Routing Home
|
||||||
|
"Search" -> handleAction $ Routing Search
|
||||||
|
"Add" -> handleAction $ Routing Add
|
||||||
|
_ -> H.raise $ Log $ SimpleLog $ "reload but cannot understand old page: " <> page
|
||||||
|
|
||||||
Finalize -> do
|
Finalize -> do
|
||||||
state <- H.get
|
state <- H.get
|
||||||
H.raise $ StoreState state
|
H.raise $ StoreState state
|
||||||
|
|
||||||
HandleAddUserInput adduserinp -> do
|
HandleAddUserInput adduserinp -> do
|
||||||
{ addUserForm, searchUserForm } <- H.get
|
{ addUserForm } <- H.get
|
||||||
case adduserinp of
|
case adduserinp of
|
||||||
ADDUSER_INP_login v -> H.modify_ _ { addUserForm { login = v } }
|
ADDUSER_INP_login v -> H.modify_ _ { addUserForm { login = v } }
|
||||||
ADDUSER_INP_email v -> H.modify_ _ { addUserForm { email = v } }
|
ADDUSER_INP_email v -> H.modify_ _ { addUserForm { email = v } }
|
||||||
ADDUSER_toggle_admin -> H.modify_ _ { addUserForm { admin = not addUserForm.admin } }
|
ADDUSER_toggle_admin -> H.modify_ _ { addUserForm { admin = not addUserForm.admin } }
|
||||||
ADDUSER_INP_pass v -> H.modify_ _ { addUserForm { pass = v } }
|
ADDUSER_INP_pass v -> H.modify_ _ { addUserForm { pass = v } }
|
||||||
SEARCHUSER_INP_login v -> H.modify_ _ { searchUserForm { login = v } }
|
SEARCHUSER_INP_regex v -> H.modify_ _ { searchUserForm { regex = v } }
|
||||||
SEARCHUSER_INP_email v -> H.modify_ _ { searchUserForm { email = v } }
|
|
||||||
SEARCHUSER_toggle_admin -> H.modify_ _ { searchUserForm { admin = not searchUserForm.admin } }
|
|
||||||
-- SEARCHUSER_INP_domain v -> H.modify_ _ { searchUserForm { domain = v } }
|
|
||||||
|
|
||||||
PreventSubmit ev -> H.liftEffect $ Event.preventDefault ev
|
PreventSubmit ev -> H.liftEffect $ Event.preventDefault ev
|
||||||
|
|
||||||
CancelModal -> do
|
|
||||||
handleAction $ Routing Search
|
|
||||||
|
|
||||||
AddUserAttempt -> do
|
AddUserAttempt -> do
|
||||||
{ addUserForm } <- H.get
|
{ addUserForm } <- H.get
|
||||||
let login = addUserForm.login
|
let login = addUserForm.login
|
||||||
|
@ -209,18 +215,19 @@ handleAction = case _ of
|
||||||
H.modify_ _ { page = page }
|
H.modify_ _ { page = page }
|
||||||
|
|
||||||
SearchUserAttempt -> do
|
SearchUserAttempt -> do
|
||||||
--{ searchUserForm } <- H.get
|
{ searchUserForm } <- H.get
|
||||||
--let login = searchUserForm.login
|
let regex = searchUserForm.regex
|
||||||
-- email = searchUserForm.email
|
-- domain = searchUserForm.domain
|
||||||
-- -- domain = searchUserForm.domain
|
|
||||||
-- admin = searchUserForm.admin
|
-- admin = searchUserForm.admin
|
||||||
--ab <- H.liftEffect $ AuthD.serialize $ AuthD.MkSearchUser { login:
|
ab <- H.liftEffect $ AuthD.serialize $
|
||||||
-- , admin:
|
AuthD.MkSearchUser { regex: not_empty_string regex, offset: Just 0 }
|
||||||
-- , email: Just (Email.Email email)
|
H.raise $ MessageToSend ab
|
||||||
-- , domain:
|
H.modify_ _ { matching_users = [] }
|
||||||
-- }
|
H.raise $ Log $ SimpleLog "[😇] Trying to search a user"
|
||||||
--H.raise $ MessageToSend ab
|
|
||||||
H.raise $ Log $ SimpleLog "[😇] TODO: Trying to add a user"
|
not_empty_string :: String -> Maybe String
|
||||||
|
not_empty_string "" = Nothing
|
||||||
|
not_empty_string v = Just v
|
||||||
|
|
||||||
handleQuery :: forall a m. MonadAff m => Query a -> H.HalogenM State Action () Output m (Maybe a)
|
handleQuery :: forall a m. MonadAff m => Query a -> H.HalogenM State Action () Output m (Maybe a)
|
||||||
handleQuery = case _ of
|
handleQuery = case _ of
|
||||||
|
@ -233,29 +240,17 @@ handleQuery = case _ of
|
||||||
pure (Just a)
|
pure (Just a)
|
||||||
|
|
||||||
MessageReceived message a -> do
|
MessageReceived message a -> do
|
||||||
receivedMessage <- H.liftEffect $ AuthD.deserialize message
|
case message of
|
||||||
case receivedMessage of
|
|
||||||
-- Cases where we didn't understand the message.
|
|
||||||
Left _ -> do
|
|
||||||
H.raise $ Log $ SystemLog $ "Received a message that could not be deserialized."
|
|
||||||
pure Nothing
|
|
||||||
--case err of
|
|
||||||
-- (AuthD.JSONERROR jerr) -> do
|
|
||||||
-- print_json_string messageEvent.message
|
|
||||||
-- handleAction $ WebSocketParseError ("JSON parsing error: " <> jerr <> " JSON is: " <> jerr)
|
|
||||||
-- (AuthD.UnknownError unerr) -> handleAction $ WebSocketParseError ("Parsing error: AuthD.UnknownError" <> (show unerr))
|
|
||||||
-- (AuthD.UnknownNumber ) -> handleAction $ WebSocketParseError ("Parsing error: AuthD.UnknownNumber")
|
|
||||||
|
|
||||||
-- Cases where we understood the message.
|
|
||||||
Right response -> do
|
|
||||||
case response of
|
|
||||||
(AuthD.GotError errmsg) -> do
|
(AuthD.GotError errmsg) -> do
|
||||||
H.raise $ Log $ SimpleLog $ "[😈] Failed: " <> maybe "server didn't tell why" (\v -> v) errmsg.reason
|
H.raise $ Log $ SimpleLog $ "[😈] Failed: " <> maybe "server didn't tell why" (\v -> v) errmsg.reason
|
||||||
pure (Just a)
|
|
||||||
(AuthD.GotUserAdded msg) -> do
|
(AuthD.GotUserAdded msg) -> do
|
||||||
H.raise $ Log $ SimpleLog $ "[😈] Success! Server added user: " <> show msg.user
|
H.raise $ Log $ SimpleLog $ "[🎉] Success! Server added user: " <> show msg.user
|
||||||
pure (Just a)
|
|
||||||
-- WTH?!
|
(AuthD.GotMatchingUsers msg) -> do
|
||||||
|
H.raise $ Log $ SimpleLog "[🎉] Received a list of users."
|
||||||
|
H.modify_ _ { matching_users = msg.users }
|
||||||
|
|
||||||
|
-- Unexpected message.
|
||||||
_ -> do
|
_ -> do
|
||||||
H.raise $ Log $ SimpleLog $ "[😈] Failed! Authentication server didn't send a valid message."
|
H.raise $ Log $ SimpleLog $ "[😈] Failed! Authentication server didn't send a valid message."
|
||||||
pure (Just a)
|
pure (Just a)
|
||||||
|
@ -267,12 +262,3 @@ handleQuery = case _ of
|
||||||
ConnectionIsUp a -> do
|
ConnectionIsUp a -> do
|
||||||
H.modify_ _ { wsUp = true }
|
H.modify_ _ { wsUp = true }
|
||||||
pure (Just a)
|
pure (Just a)
|
||||||
|
|
||||||
|
|
||||||
----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))
|
|
||||||
-- value <- H.liftEffect $ IPC.fromTypedIPC arraybuffer
|
|
||||||
-- H.raise $ Log $ SimpleLog $ case (value) of
|
|
||||||
-- Left _ -> "Cannot even fromTypedIPC the message."
|
|
||||||
-- Right (Tuple messageTypeNumber string) -> "Number is: " <> show messageTypeNumber <> ", received string: " <> string
|
|
||||||
|
|
|
@ -368,11 +368,15 @@ handleAction = case _ of
|
||||||
case response of
|
case response of
|
||||||
(AuthD.GotUser _) -> do
|
(AuthD.GotUser _) -> do
|
||||||
handleAction $ Log $ SimpleLog "[😈] TODO: received a GotUser message."
|
handleAction $ Log $ SimpleLog "[😈] TODO: received a GotUser message."
|
||||||
(AuthD.GotUserAdded _) -> do
|
m@(AuthD.GotUserAdded _) -> do
|
||||||
|
{ current_page } <- H.get
|
||||||
|
case current_page of
|
||||||
|
Registration -> do
|
||||||
handleAction $ Log $ SimpleLog """
|
handleAction $ Log $ SimpleLog """
|
||||||
[🎉] you are now registered, copy the token we sent you by email to finish your registration.
|
[🎉] you are now registered, copy the token we sent you by email to finish your registration.
|
||||||
"""
|
"""
|
||||||
handleAction $ Routing MailValidation
|
handleAction $ Routing MailValidation
|
||||||
|
_ -> handleAction $ DispatchAuthDaemonMessage m
|
||||||
(AuthD.GotUserEdited _) -> do
|
(AuthD.GotUserEdited _) -> do
|
||||||
handleAction $ Log $ SimpleLog "[😈] TODO: received a GotUserEdited message."
|
handleAction $ Log $ SimpleLog "[😈] TODO: received a GotUserEdited message."
|
||||||
(AuthD.GotUserValidated _) -> do
|
(AuthD.GotUserValidated _) -> do
|
||||||
|
@ -386,8 +390,12 @@ handleAction = case _ of
|
||||||
handleAction $ Log $ SimpleLog "[😈] Received a GotPermissionSet message."
|
handleAction $ Log $ SimpleLog "[😈] Received a GotPermissionSet message."
|
||||||
(AuthD.GotPasswordRecovered _) -> do
|
(AuthD.GotPasswordRecovered _) -> do
|
||||||
handleAction $ Log $ SimpleLog "[😈] TODO: received a GotPasswordRecovered message."
|
handleAction $ Log $ SimpleLog "[😈] TODO: received a GotPasswordRecovered message."
|
||||||
(AuthD.GotMatchingUsers _) -> do
|
m@(AuthD.GotMatchingUsers _) -> do
|
||||||
handleAction $ Log $ SimpleLog "[😈] TODO: received a GotMatchingUsers message."
|
{ current_page } <- H.get
|
||||||
|
case current_page of
|
||||||
|
AuthAdmin -> handleAction $ DispatchAuthDaemonMessage m
|
||||||
|
_ -> handleAction $ Log $ SimpleLog
|
||||||
|
"[😈] received a GotMatchingUsers message while not on authd admin page."
|
||||||
(AuthD.GotUserDeleted _) -> do
|
(AuthD.GotUserDeleted _) -> do
|
||||||
handleAction $ Log $ SimpleLog "[😈] Received a GotUserDeleted message."
|
handleAction $ Log $ SimpleLog "[😈] Received a GotUserDeleted message."
|
||||||
(AuthD.GotErrorMustBeAuthenticated _) -> do
|
(AuthD.GotErrorMustBeAuthenticated _) -> do
|
||||||
|
@ -447,19 +455,12 @@ handleAction = case _ of
|
||||||
|
|
||||||
|
|
||||||
-- | Send a received authentication daemon message `AuthD.AnswerMessage` to a component.
|
-- | Send a received authentication daemon message `AuthD.AnswerMessage` to a component.
|
||||||
-- | TODO: **CURRENTLY** this dispatch function is useless since no component require `authd` messages directly.
|
DispatchAuthDaemonMessage message -> do
|
||||||
DispatchAuthDaemonMessage _ -> do
|
{ current_page } <- H.get
|
||||||
handleAction $ Log $ SimpleLog "[😈] DispatchAuthDaemonMessage action, called for no reason!"
|
case current_page of
|
||||||
|
AuthAdmin -> H.tell _aai unit (AAI.MessageReceived message)
|
||||||
|
_ -> handleAction $ Log $ SystemLog "unexpected message from authd"
|
||||||
pure unit
|
pure unit
|
||||||
-- { token } <- H.get
|
|
||||||
-- case token of
|
|
||||||
-- Nothing -> H.tell _ai unit (AI.MessageReceived message)
|
|
||||||
-- Just _ -> H.tell _aai unit (AAI.MessageReceived message)
|
|
||||||
-- case current_page of
|
|
||||||
-- DomainList -> H.tell _dli unit (DomainListInterface.MessageReceived message)
|
|
||||||
-- Zone _ -> H.tell _zi unit (ZoneInterface.MessageReceived message)
|
|
||||||
-- _ -> H.tell _log unit (AppLog.Log $ SystemLog "unexpected message from authd")
|
|
||||||
-- pure unit
|
|
||||||
|
|
||||||
Disconnection -> do
|
Disconnection -> do
|
||||||
H.put $ initialState unit
|
H.put $ initialState unit
|
||||||
|
|
Loading…
Reference in New Issue