diff --git a/src/App/AuthenticationDaemonAdminInterface.purs b/src/App/AuthenticationDaemonAdminInterface.purs index 9ffc3a2..5a98e2a 100644 --- a/src/App/AuthenticationDaemonAdminInterface.purs +++ b/src/App/AuthenticationDaemonAdminInterface.purs @@ -7,7 +7,7 @@ -} 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 @@ -27,12 +27,14 @@ import Web.HTML (window) as HTML import Web.HTML.Window (sessionStorage) as Window import Web.Storage.Storage as Storage +import App.UserPublic (UserPublic) import Data.ArrayBuffer.Types (ArrayBuffer) import App.LogMessage -- import App.IPC as IPC import App.Email as Email +-- import App.Messages.DNSManagerDaemon as DNSManager import App.Messages.AuthenticationDaemon as AuthD data Output @@ -42,7 +44,7 @@ data Output | StoreState State data Query a - = MessageReceived ArrayBuffer a + = MessageReceived AuthD.AnswerMessage a | ConnectionIsDown a | ConnectionIsUp a | ProvideState (Maybe State) a @@ -56,16 +58,12 @@ data AddUserInput | ADDUSER_INP_email String | ADDUSER_toggle_admin | ADDUSER_INP_pass String - | SEARCHUSER_INP_login String - | SEARCHUSER_INP_email String - | SEARCHUSER_toggle_admin - --| SEARCHUSER_INP_domain + | SEARCHUSER_INP_regex String + --| SEARCHUSER_INP_domain String data Action = HandleAddUserInput AddUserInput - | CancelModal - | AddUserAttempt | SearchUserAttempt | PreventSubmit Event @@ -81,13 +79,14 @@ data Action data Page = Home | Search | Add 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 = { addUserForm :: StateAddUserForm , searchUserForm :: StateSearchUserForm , page :: Page , wsUp :: Boolean + , matching_users :: Array UserPublic } component :: forall m. MonadAff m => H.Component Query Input Output m @@ -105,26 +104,29 @@ component = initialState :: Input -> State initialState _ = { addUserForm: { login: "", admin: false, email: "", pass: "" } - , searchUserForm: { login: "", admin: false, email: "", domain: "" } + , searchUserForm: { regex: "" {-, admin: false, domain: "" -} } + , matching_users: [] , page: Home , wsUp: true } render :: forall m. State -> H.ComponentHTML Action () m -render { addUserForm, searchUserForm, page, wsUp } +render { addUserForm, searchUserForm, matching_users, page, wsUp } = HH.div_ [ Bulma.box [routing_search_button, routing_add_button] , case page of Home -> Bulma.section_small [Bulma.h3 "Select an action"] Search -> Bulma.columns_ [ 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_ [ Bulma.column (C.is_size 5) [Bulma.article (Bulma.p "Add a new user") render_adduser_form] ] ] 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)) render_adduser_form = @@ -137,49 +139,53 @@ render { addUserForm, searchUserForm, page, wsUp } , Bulma.btn "Send" AddUserAttempt ] - up x = HandleAddUserInput <<< x - render_searchuser_form = HH.form [ HE.onSubmit PreventSubmit ] - [ Bulma.box_input "login" "Login" "login" (up SEARCHUSER_INP_login) searchUserForm.login active - , Bulma.btn_labeled "adminbtn" "Admin" (show searchUserForm.admin) (HandleAddUserInput SEARCHUSER_toggle_admin) - , Bulma.box_input "email" "Email" "email" (up SEARCHUSER_INP_email) searchUserForm.email active + [ Bulma.p """ + Following input accepts any regex. + 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." - -- (up SEARCHUSER_INP_domain) searchUserForm.email active + -- (up SEARCHUSER_INP_domain) searchUserForm.domain active , Bulma.btn "Send" SearchUserAttempt ] routing_search_button = Bulma.btn "Search" $ Routing Search 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 = case _ of Initialize -> do 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 state <- H.get H.raise $ StoreState state HandleAddUserInput adduserinp -> do - { addUserForm, searchUserForm } <- H.get + { 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 } } - SEARCHUSER_INP_login v -> H.modify_ _ { searchUserForm { login = 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 } } + SEARCHUSER_INP_regex v -> H.modify_ _ { searchUserForm { regex = v } } PreventSubmit ev -> H.liftEffect $ Event.preventDefault ev - CancelModal -> do - handleAction $ Routing Search - AddUserAttempt -> do { addUserForm } <- H.get let login = addUserForm.login @@ -209,18 +215,19 @@ handleAction = case _ of H.modify_ _ { page = page } SearchUserAttempt -> do - --{ searchUserForm } <- H.get - --let login = searchUserForm.login - -- email = searchUserForm.email - -- -- domain = searchUserForm.domain - -- admin = searchUserForm.admin - --ab <- H.liftEffect $ AuthD.serialize $ AuthD.MkSearchUser { login: - -- , admin: - -- , email: Just (Email.Email email) - -- , domain: - -- } - --H.raise $ MessageToSend ab - H.raise $ Log $ SimpleLog "[😇] TODO: Trying to add a user" + { searchUserForm } <- H.get + let regex = searchUserForm.regex + -- domain = searchUserForm.domain + -- admin = searchUserForm.admin + ab <- H.liftEffect $ AuthD.serialize $ + AuthD.MkSearchUser { regex: not_empty_string regex, offset: Just 0 } + H.raise $ MessageToSend ab + H.modify_ _ { matching_users = [] } + H.raise $ Log $ SimpleLog "[😇] Trying to search 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 = case _ of @@ -233,32 +240,20 @@ handleQuery = case _ of pure (Just a) MessageReceived message a -> do - receivedMessage <- H.liftEffect $ AuthD.deserialize message - 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") + case message of + (AuthD.GotError errmsg) -> do + H.raise $ Log $ SimpleLog $ "[😈] Failed: " <> maybe "server didn't tell why" (\v -> v) errmsg.reason + (AuthD.GotUserAdded msg) -> do + H.raise $ Log $ SimpleLog $ "[🎉] Success! Server added user: " <> show msg.user - -- Cases where we understood the message. - Right response -> do - case response of - (AuthD.GotError errmsg) -> do - H.raise $ Log $ SimpleLog $ "[😈] Failed: " <> maybe "server didn't tell why" (\v -> v) errmsg.reason - pure (Just a) - (AuthD.GotUserAdded msg) -> do - H.raise $ Log $ SimpleLog $ "[😈] Success! Server added user: " <> show msg.user - pure (Just a) - -- WTH?! - _ -> do - H.raise $ Log $ SimpleLog $ "[😈] Failed! Authentication server didn't send a valid message." - pure (Just a) + (AuthD.GotMatchingUsers msg) -> do + H.raise $ Log $ SimpleLog "[🎉] Received a list of users." + H.modify_ _ { matching_users = msg.users } + + -- Unexpected message. + _ -> do + H.raise $ Log $ SimpleLog $ "[😈] Failed! Authentication server didn't send a valid message." + pure (Just a) ConnectionIsDown a -> do H.modify_ _ { wsUp = false } @@ -267,12 +262,3 @@ handleQuery = case _ of ConnectionIsUp a -> do H.modify_ _ { wsUp = true } 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 diff --git a/src/App/Container.purs b/src/App/Container.purs index 4d54e0e..6e88a31 100644 --- a/src/App/Container.purs +++ b/src/App/Container.purs @@ -368,11 +368,15 @@ handleAction = case _ of case response of (AuthD.GotUser _) -> do handleAction $ Log $ SimpleLog "[😈] TODO: received a GotUser message." - (AuthD.GotUserAdded _) -> do - handleAction $ Log $ SimpleLog """ - [🎉] you are now registered, copy the token we sent you by email to finish your registration. - """ - handleAction $ Routing MailValidation + m@(AuthD.GotUserAdded _) -> do + { current_page } <- H.get + case current_page of + Registration -> do + handleAction $ Log $ SimpleLog """ + [🎉] you are now registered, copy the token we sent you by email to finish your registration. + """ + handleAction $ Routing MailValidation + _ -> handleAction $ DispatchAuthDaemonMessage m (AuthD.GotUserEdited _) -> do handleAction $ Log $ SimpleLog "[😈] TODO: received a GotUserEdited message." (AuthD.GotUserValidated _) -> do @@ -386,8 +390,12 @@ handleAction = case _ of handleAction $ Log $ SimpleLog "[😈] Received a GotPermissionSet message." (AuthD.GotPasswordRecovered _) -> do handleAction $ Log $ SimpleLog "[😈] TODO: received a GotPasswordRecovered message." - (AuthD.GotMatchingUsers _) -> do - handleAction $ Log $ SimpleLog "[😈] TODO: received a GotMatchingUsers message." + m@(AuthD.GotMatchingUsers _) -> do + { 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 handleAction $ Log $ SimpleLog "[😈] Received a GotUserDeleted message." (AuthD.GotErrorMustBeAuthenticated _) -> do @@ -447,19 +455,12 @@ handleAction = case _ of -- | 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 _ -> do - handleAction $ Log $ SimpleLog "[😈] DispatchAuthDaemonMessage action, called for no reason!" + DispatchAuthDaemonMessage message -> do + { current_page } <- H.get + case current_page of + AuthAdmin -> H.tell _aai unit (AAI.MessageReceived message) + _ -> handleAction $ Log $ SystemLog "unexpected message from authd" 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 H.put $ initialState unit