WIP: search for domains.

src/App/Container.purs

@@ -799,7 +799,6 @@ handleAction = case _ of
           (AuthD.GotKeepAlive _) -> pure unit
     pure unit
 
-  -- TODO
   EventPageMigration ev -> case ev of
     PageMigration.MessageToSend message  -> H.tell _ws_auth unit (WS.ToSend message)
     PageMigration.Log message            -> handleAction $ Log message
@@ -963,6 +962,9 @@ handleAction = case _ of
           DNSManager.MkOrphanDomainList response -> do
             handleAction $ Log $ SuccessLog "Received orphan domain list."
             H.tell _admini unit (PageAdministration.GotOrphanDomainList response.domains)
+          DNSManager.MkFoundDomains response -> do
+            handleAction $ Log $ SuccessLog "Received found domain list."
+            H.tell _admini unit (PageAdministration.GotFoundDomains response.domains)
           (DNSManager.GotKeepAlive _) -> do
             -- handleAction $ Log $ SystemLog $ "KeepAlive."
             pure unit

src/App/Message/DNSManagerDaemon.purs

@@ -128,6 +128,11 @@ type GainOwnership = { uuid :: String }
 codecGainOwnership ∷ CA.JsonCodec GainOwnership
 codecGainOwnership = CA.object "GainOwnership" (CAR.record { uuid: CA.string })
 
+{- 24  -}
+type SearchDomain = { domain :: String, offset :: Maybe Int }
+codecSearchDomain ∷ CA.JsonCodec SearchDomain
+codecSearchDomain = CA.object "SearchDomain" (CAR.record { domain: CA.string, offset: CAR.optional CA.int })
+
 {- 100 -}
 type GenerateAllZoneFiles = {}
 codecGenerateAllZoneFiles ∷ CA.JsonCodec GenerateAllZoneFiles
@@ -322,6 +327,7 @@ data RequestMessage
   | MkAskTransferToken     AskTransferToken     -- 21
   | MkAskUnShareDomain     AskUnShareDomain     -- 22
   | MkGainOwnership        GainOwnership        -- 23
+  | MkSearchDomain         SearchDomain         -- 24
   | MkGenerateAllZoneFiles GenerateAllZoneFiles -- 100
   | MkGenerateZoneFile     GenerateZoneFile     -- 101
   | MkKeepAlive            KeepAlive            -- 250
@@ -353,6 +359,7 @@ data AnswerMessage
   | MkRRReadOnly          RRReadOnly          -- 22
   | MkGeneratedZoneFile   GeneratedZoneFile   -- 23
   | MkOrphanDomainList    OrphanDomainList    -- 24
+  | MkFoundDomains        DomainList          -- 25
   | MkUnknownUser         UnknownUser         -- 50
   | MkNoOwnership         NoOwnership         -- 51
   | MkInsufficientRights  InsufficientRights  -- 52
@@ -379,6 +386,7 @@ encode m = case m of
     (MkAskTransferToken     request) -> get_tuple 21  codecAskTransferToken     request
     (MkAskUnShareDomain     request) -> get_tuple 22  codecAskUnShareDomain     request
     (MkGainOwnership        request) -> get_tuple 23  codecGainOwnership        request
+    (MkSearchDomain         request) -> get_tuple 24  codecSearchDomain         request
     (MkGenerateAllZoneFiles request) -> get_tuple 100 codecGenerateAllZoneFiles request
     (MkGenerateZoneFile     request) -> get_tuple 101 codecGenerateZoneFile     request
     (MkKeepAlive            request) -> get_tuple 250 codecKeepAlive            request
@@ -419,6 +427,7 @@ decode number string
     22  -> error_management codecRRReadOnly          MkRRReadOnly
     23  -> error_management codecGeneratedZoneFile   MkGeneratedZoneFile
     24  -> error_management codecOrphanDomainList    MkOrphanDomainList
+    25  -> error_management codecDomainList          MkFoundDomains
     50  -> error_management codecUnknownUser         MkUnknownUser
     51  -> error_management codecNoOwnership         MkNoOwnership
     52  -> error_management codecInsufficientRights  MkInsufficientRights

src/App/Page/Administration.purs

@@ -1,9 +1,10 @@
 {- Administration interface.
    Enables to:
-     - add, remove, search users
+     - add, remove, search for users
      - TODO: validate users
      - TODO: change user password
      - TODO: show user details (list of owned domains)
+     - TODO: search for domains
      - TODO: show user domain details (zone content) and to modify users' zone
      - TODO: raise a user to admin (and vice versa)
      - TODO: list users (getting them slowly, otherwise it will cause problems with thousands of logins)
@@ -37,7 +38,7 @@ import App.Type.LogMessage
 -- import App.IPC as IPC
 import App.Type.Email as Email
 
--- import App.Message.DNSManagerDaemon as DNSManager
+import App.Message.DNSManagerDaemon as DNSManager
 import App.Message.AuthenticationDaemon as AuthD
 
 data Output
@@ -54,6 +55,7 @@ data Output
 data Query a
   = MessageReceived AuthD.AnswerMessage a
   | GotOrphanDomainList (Array String) a
+  | GotFoundDomains (Array String) a
   | ProvideState (Maybe State) a
 
 type Slot = H.Slot Query Output
@@ -65,14 +67,22 @@ data AddUserInput
   | ADDUSER_INP_email       String
   | ADDUSER_toggle_admin
   | ADDUSER_INP_pass        String
-  | SEARCHUSER_INP_regex    String
+
-  --| SEARCHUSER_INP_domain String
+data SearchUserInput
+  = SEARCHUSER_INP_regex    String
+  --| SEARCHUSER_toggle_admin Boolean
+
+data SearchDomainInput
+  = SEARCHDOMAIN_INP_domain String
 
 data Action
-  = HandleAddUserInput AddUserInput
+  = ActionOnAddUserForm AddUserInput
+  | ActionOnSearchUserForm SearchUserInput
+  | ActionOnSearchDomainForm SearchDomainInput
 
   | AddUserAttempt
   | SearchUserAttempt
+  | SearchDomainAttempt
   | PreventSubmit Event
 
   | ShowUser Int
@@ -91,17 +101,20 @@ data Action
 
 -- | There are different tabs in the administration page.
 -- | For example, users can be searched (`authd`) and a list is provided.
-data Tab = Home | Search | Add | OrphanDomains
+data Tab = Home | SearchUser | SearchDomain | Add | OrphanDomains
 derive instance eqTab :: Eq Tab
 
 type StateAddUserForm = { login :: String, admin :: Boolean, email :: String, pass :: String }
-type StateSearchUserForm = { regex :: String {-, admin :: Boolean, domain :: String -} }
+type StateSearchUserForm = { regex :: String {- , admin :: Boolean -} }
+type StateSearchDomainForm = { domain :: String }
 
 type State =
   { addUserForm    :: StateAddUserForm
   , searchUserForm :: StateSearchUserForm
+  , searchDomainForm :: StateSearchDomainForm
   , current_tab    :: Tab
   , matching_users :: Array UserPublic
+  , matching_domains :: Array String
   , orphan_domains :: Array String
   }
 
@@ -120,22 +133,30 @@ component =
 
 initialState :: Input -> State
 initialState _ = { addUserForm:    { login: "", admin: false, email: "", pass: "" }
-                 , searchUserForm: { regex: "" {-, admin: false, domain: "" -} }
+                 , searchUserForm: { regex: "" {- , admin: false -} }
+                 , searchDomainForm: { domain: "" }
                  , matching_users: []
+                 , matching_domains: []
                  , orphan_domains: []
                  , current_tab: Home
                  }
 
 render :: forall m. State -> H.ComponentHTML Action () m
-render { addUserForm, searchUserForm, matching_users, current_tab, orphan_domains }
+render { addUserForm, searchUserForm, searchDomainForm
+       , matching_users, matching_domains
+       , current_tab, orphan_domains }
   = Web.section_small
       [ fancy_tab_bar
       , case current_tab of
           Home -> Web.h3 "Select an action"
-          Search -> Web.columns_
+          SearchUser -> Web.columns_
             [ Web.column [C.is 3] [Web.article (Web.p "Search users") render_searchuser_form]
             , Web.column_ [ Web.h3 "Result", show_found_users ]
             ]
+          SearchDomain -> Web.columns_
+            [ Web.column [C.is 3] [Web.article (Web.p "Search domains") render_searchdomain_form]
+            , Web.column_ [ Web.h3 "Result", show_found_domains ]
+            ]
           Add -> Web.columns_
             [ Web.column [C.is 5] [Web.article (Web.p "Add a new user") render_adduser_form] ]
           OrphanDomains -> HH.div_
@@ -147,7 +168,8 @@ render { addUserForm, searchUserForm, matching_users, current_tab, orphan_domain
     fancy_tab_bar =
       Web.fancy_tabs
         [ Web.tab_entry (is_tab_active Home)          "Home"             (ChangeTab Home)
-        , Web.tab_entry (is_tab_active Search)        "Search"           (ChangeTab Search)
+        , Web.tab_entry (is_tab_active SearchUser)    "SearchUser"       (ChangeTab SearchUser)
+        , Web.tab_entry (is_tab_active SearchDomain)  "SearchDomain"     (ChangeTab SearchDomain)
         , Web.tab_entry (is_tab_active Add)           "Add"              (ChangeTab Add)
         , Web.tab_entry (is_tab_active OrphanDomains) "OrphanDomains"    (ChangeTab OrphanDomains)
         ]
@@ -157,19 +179,24 @@ render { addUserForm, searchUserForm, matching_users, current_tab, orphan_domain
     user_card user = HH.li_ [ Web.btn_delete (RemoveUser user.uid)
                             , Web.btn_ [C.is_small] user.login (ShowUser user.uid)
                             ]
+
+    show_found_domains = Web.box [ HH.ul_ $ map domain_card matching_domains ]
+    domain_card domain_ = HH.li_ [ Web.p domain_
+                                 -- , Web.btn_delete (RemoveUser domain_)
+                                 -- , Web.btn_ [C.is_small] user.login (ShowUser user.uid)
+                                 ]
     show_orphan_domains = Web.box [ HH.ul_ $ map domain_entry orphan_domains ]
     domain_entry domain = HH.li_ [ Web.btn_delete (RemoveDomain domain)
                                  , Web.btn_ [C.is_small] domain (ShowDomain domain)
                                  ]
-    up x = HandleAddUserInput <<< x
 
     render_adduser_form =
       HH.form
         [ HE.onSubmit PreventSubmit ]
-        [ Web.box_input "login" "User login" "login" (up ADDUSER_INP_login) addUserForm.login
+        [ Web.box_input "login" "User login" "login" (ActionOnAddUserForm <<< ADDUSER_INP_login) addUserForm.login
-        , Web.btn_labeled "adminbtn" "Admin" (show addUserForm.admin) (HandleAddUserInput ADDUSER_toggle_admin)
+        , Web.btn_labeled "adminbtn" "Admin" (show addUserForm.admin) (ActionOnAddUserForm ADDUSER_toggle_admin)
-        , Web.box_input "email" "User email" "email" (up ADDUSER_INP_email) addUserForm.email
+        , Web.box_input "email" "User email" "email" (ActionOnAddUserForm <<< ADDUSER_INP_email) addUserForm.email
-        , Web.box_password "password" "User password" "password" (up ADDUSER_INP_pass) addUserForm.pass
+        , Web.box_password "password" "User password" "password" (ActionOnAddUserForm <<< ADDUSER_INP_pass) addUserForm.pass
         , Web.btn "Send" AddUserAttempt
         ]
 
@@ -180,14 +207,21 @@ render { addUserForm, searchUserForm, matching_users, current_tab, orphan_domain
                   Following input accepts any regex.
                   This is used to search for a user based on their login, full name or email address.
                   """
-        , Web.box_input "regex" "Regex" "regex" (up SEARCHUSER_INP_regex) searchUserForm.regex
+        , Web.box_input "regex" "Regex" "regex" (ActionOnSearchUserForm <<< SEARCHUSER_INP_regex) searchUserForm.regex
         --, Web.btn_labeled "adminbtn" "Admin" (show searchUserForm.admin)
-        --    (HandleAddUserInput SEARCHUSER_toggle_admin)
+        --    (ActionOnSearchUserForm <<< SEARCHUSER_toggle_admin)
-        --, Web.box_input "domain" "Domain owned" "blah.netlib.re."
-        --    (up SEARCHUSER_INP_domain) searchUserForm.domain
         , Web.btn "Send" SearchUserAttempt
         ]
 
+    render_searchdomain_form =
+      HH.form
+        [ HE.onSubmit PreventSubmit ]
+        [ Web.p "Following input accepts any regex to search for a domain."
+        , Web.box_input "domain" "Domain owned" "blah.netlib.re."
+            (ActionOnSearchDomainForm <<< SEARCHDOMAIN_INP_domain) searchDomainForm.domain
+        , Web.btn "Send" SearchDomainAttempt
+        ]
+
 handleAction :: forall m. MonadAff m => Action -> H.HalogenM State Action () Output m Unit
 handleAction = case _ of
   Initialize -> do
@@ -198,7 +232,8 @@ handleAction = case _ of
       Nothing -> pure unit
       Just current_tab -> case current_tab of
         "Home"          -> handleAction $ ChangeTab Home
-        "Search"        -> handleAction $ ChangeTab Search
+        "SearchUser"    -> handleAction $ ChangeTab SearchUser
+        "SearchDomain"  -> handleAction $ ChangeTab SearchDomain
         "Add"           -> handleAction $ ChangeTab Add
         "OrphanDomains" -> handleAction $ ChangeTab OrphanDomains
         _               -> H.raise $ Log $ ErrorLog $ "Reload but cannot understand old current_tab: " <> current_tab
@@ -207,14 +242,21 @@ handleAction = case _ of
     state <- H.get
     H.raise $ StoreState state
 
-  HandleAddUserInput adduserinp -> do
+  ActionOnAddUserForm adduserinp -> do
     { addUserForm } <- H.get
     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_regex  v -> H.modify_ _ { searchUserForm { regex = v                     } }
+
+  ActionOnSearchUserForm searchuserinp -> do
+    case searchuserinp of
+      SEARCHUSER_INP_regex  v   -> H.modify_ _ { searchUserForm { regex  = v                     } }
+
+  ActionOnSearchDomainForm searchdomaininp -> do
+    case searchdomaininp of
+      SEARCHDOMAIN_INP_domain v   -> H.modify_ _ { searchDomainForm { domain = v                 } }
 
   PreventSubmit ev -> H.liftEffect $ Event.preventDefault ev
 
@@ -262,7 +304,8 @@ handleAction = case _ of
     sessionstorage <- H.liftEffect $ Window.sessionStorage =<< HTML.window
     _ <- case current_tab of
       Home           -> H.liftEffect $ Storage.setItem "current-ada-tab" "Home"          sessionstorage
-      Search         -> H.liftEffect $ Storage.setItem "current-ada-tab" "Search"        sessionstorage
+      SearchUser     -> H.liftEffect $ Storage.setItem "current-ada-tab" "SearchUser"    sessionstorage
+      SearchDomain   -> H.liftEffect $ Storage.setItem "current-ada-tab" "SearchDomain"  sessionstorage
       Add            -> H.liftEffect $ Storage.setItem "current-ada-tab" "Add"           sessionstorage
       OrphanDomains  -> H.liftEffect $ Storage.setItem "current-ada-tab" "OrphanDomains" sessionstorage
     H.modify_ _ { current_tab = current_tab }
@@ -270,13 +313,19 @@ handleAction = case _ of
   SearchUserAttempt -> do
     { 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 = [] }
 
+  SearchDomainAttempt -> do
+    { searchDomainForm } <- H.get
+    let domain  = searchDomainForm.domain
+    H.raise $ Log $ SystemLog $ "TODO: search for this domain: " <> domain
+    ab <- H.liftEffect $ DNSManager.serialize $ DNSManager.MkSearchDomain { domain, offset: Just 0 }
+    -- H.raise $ MessageToSend ab
+    H.modify_ _ { matching_domains = [] }
+
 not_empty_string :: String -> Maybe String
 not_empty_string "" = Nothing
 not_empty_string v = Just v
@@ -312,3 +361,7 @@ handleQuery = case _ of
   GotOrphanDomainList domains a -> do
     H.modify_ _ { orphan_domains = domains }
     pure (Just a)
+
+  GotFoundDomains domains a -> do
+    H.modify_ _ { matching_domains = domains }
+    pure (Just a)