Authentication Daemon Administration Interface: search for a user!

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_regex    String
-  | SEARCHUSER_INP_email    String
+  --| SEARCHUSER_INP_domain String
-  | SEARCHUSER_toggle_admin
-  --| SEARCHUSER_INP_domain
 
 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.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."
-          --    (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_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
 
-  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
+    { 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 $
-    --ab <- H.liftEffect $ AuthD.serialize $ AuthD.MkSearchUser { login: 
+      AuthD.MkSearchUser { regex: not_empty_string regex, offset: Just 0 }
-    --                                                          , admin: 
+    H.raise $ MessageToSend ab
-    --                                                          , email: Just (Email.Email email)
+    H.modify_ _ { matching_users = [] }
-    --                                                          , domain:
+    H.raise $ Log $ SimpleLog "[😇] Trying to search a user"
-    --                                                          }
+
-    --H.raise $ MessageToSend ab
+not_empty_string :: String -> Maybe String
-    H.raise $ Log $ SimpleLog "[😇] TODO: Trying to add a user"
+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 message of
-    case receivedMessage of
+      (AuthD.GotError errmsg) -> do
-        -- Cases where we didn't understand the message.
+        H.raise $ Log $ SimpleLog $ "[😈] Failed: " <> maybe "server didn't tell why" (\v -> v) errmsg.reason
-        Left _ -> do
+      (AuthD.GotUserAdded msg) -> do
-          H.raise $ Log $ SystemLog $ "Received a message that could not be deserialized."
+        H.raise $ Log $ SimpleLog $ "[🎉] Success! Server added user: " <> show msg.user
-          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.
+      (AuthD.GotMatchingUsers msg) -> do
-        Right response -> do
+        H.raise $ Log $ SimpleLog "[🎉] Received a list of users."
-          case response of
+        H.modify_ _ { matching_users = msg.users }
-            (AuthD.GotError errmsg) -> do
+
-              H.raise $ Log $ SimpleLog $ "[😈] Failed: " <> maybe "server didn't tell why" (\v -> v) errmsg.reason
+      -- Unexpected message.
-              pure (Just a)
+      _ -> do
-            (AuthD.GotUserAdded msg) -> do
+        H.raise $ Log $ SimpleLog $ "[😈] Failed! Authentication server didn't send a valid message."
-              H.raise $ Log $ SimpleLog $ "[😈] Success! Server added user: " <> show msg.user
+    pure (Just a)
-              pure (Just a)
-            -- WTH?!
-            _ -> 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

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
+          m@(AuthD.GotUserAdded _) -> do
-            handleAction $ Log $ SimpleLog """
+            { current_page } <- H.get
-              [🎉] you are now registered, copy the token we sent you by email to finish your registration.
+            case current_page of
-            """
+              Registration -> do
-            handleAction $ Routing MailValidation
+                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
+          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
             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 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
-  --   { 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