Administration page: can search for domains and see users' zones.

src/App/Container.purs

@@ -582,10 +582,12 @@ handleAction = case _ of
     PageSetup.Log message -> handleAction $ Log message
 
   EventPageAdministration ev     -> case ev of
-    PageAdministration.MessageToSend message -> H.tell _ws_auth unit (WS.ToSend message)
+    PageAdministration.SendToAuthd message      -> H.tell _ws_auth unit (WS.ToSend message)
-    PageAdministration.Log message           -> handleAction $ Log message
+    PageAdministration.SendToDNSManager message -> H.tell _ws_dns  unit (WS.ToSend message)
-    PageAdministration.StoreState s          -> H.modify_ _ { childstates { administration = Just s } }
+    PageAdministration.ShowZone domain          -> handleAction $ Routing $ Zone domain
-    PageAdministration.AskState              -> do
+    PageAdministration.Log message              -> handleAction $ Log message
+    PageAdministration.StoreState s             -> H.modify_ _ { childstates { administration = Just s } }
+    PageAdministration.AskState                 -> do
       state <- H.get
       H.tell _admini unit (PageAdministration.ProvideState state.childstates.administration)
     PageAdministration.DeleteUserAccount uid -> do

src/App/Page/Administration.purs

@@ -14,7 +14,9 @@ module App.Page.Administration where
 import Prelude (Unit, bind, discard, not, pure, show, ($), (<<<), (<>), (=<<), map, (/=), (==), unit)
 import Data.Eq (class Eq)
 
+import Utils (not_empty_string)
 import Web as Web
+import App.Templates.Table as Templates
 
 import Data.Maybe (Maybe(..))
 import Data.Array as A
@@ -35,23 +37,21 @@ import App.Type.UserPublic (UserPublic)
 import Data.ArrayBuffer.Types (ArrayBuffer)
 
 import App.Type.LogMessage
--- import App.IPC as IPC
 import App.Type.Email as Email
 
 import App.Message.DNSManagerDaemon as DNSManager
 import App.Message.AuthenticationDaemon as AuthD
 
 data Output
-  = MessageToSend ArrayBuffer
+  = SendToAuthd ArrayBuffer
+  | SendToDNSManager ArrayBuffer
+  | ShowZone String
   | Log LogMessage
   | AskState
   | StoreState State
   | DeleteUserAccount Int
   | GetOrphanDomains
 
-  --| DeleteDomain String
-  --| RequestDomain String
-
 data Query a
   = MessageReceived AuthD.AnswerMessage a
   | GotOrphanDomainList (Array String) a
@@ -85,13 +85,15 @@ data Action
   | SearchDomainAttempt
   | PreventSubmit Event
 
+  -- Users.
   | ShowUser Int
   | RemoveUser Int
 
   -- Domains.
-  | ShowOrphanDomains
   | RemoveDomain String
-  | ShowDomain String
+  | EnterDomain String
+
+  | ShowOrphanDomains
 
   -- | Change the displayed tab.
   | ChangeTab Tab
@@ -151,11 +153,11 @@ render { addUserForm, searchUserForm, searchDomainForm
           Home -> Web.h3 "Select an action"
           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 ]
+            , Web.column_ [ Templates.found_users ShowUser matching_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 ]
+            , Web.column_ [ Templates.found_domains EnterDomain RemoveDomain matching_domains ]
             ]
           Add -> Web.columns_
             [ Web.column [C.is 5] [Web.article (Web.p "Add a new user") render_adduser_form] ]
@@ -175,19 +177,9 @@ render { addUserForm, searchUserForm, searchDomainForm
         ]
     is_tab_active tab = current_tab == tab
 
-    show_found_users = Web.box [ HH.ul_ $ map user_card matching_users ]
-    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)
+                                 , Web.btn_ [C.is_small] domain (EnterDomain domain)
                                  ]
 
     render_adduser_form =
@@ -245,18 +237,18 @@ handleAction = case _ of
   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                     } }
 
   ActionOnSearchUserForm searchuserinp -> do
     case searchuserinp of
-      SEARCHUSER_INP_regex  v   -> H.modify_ _ { searchUserForm { regex  = v                     } }
+      SEARCHUSER_INP_regex v -> H.modify_ _ { searchUserForm { regex  = v } }
 
   ActionOnSearchDomainForm searchdomaininp -> do
     case searchdomaininp of
-      SEARCHDOMAIN_INP_domain v   -> H.modify_ _ { searchDomainForm { domain = v                 } }
+      SEARCHDOMAIN_INP_domain v -> H.modify_ _ { searchDomainForm { domain = v } }
 
   PreventSubmit ev -> H.liftEffect $ Event.preventDefault ev
 
@@ -275,9 +267,9 @@ handleAction = case _ of
     H.raise $ Log $ SystemLog $ "TODO: remove domain " <> domain
     --H.raise $ DeleteDomain domain
 
-  ShowDomain domain -> do
+  EnterDomain domain -> do
-    H.raise $ Log $ SystemLog $ "TODO: show domain " <> domain
+    H.raise $ Log $ SystemLog $ "show domain " <> domain
-    -- H.raise $ RequestDomain domain
+    H.raise $ ShowZone domain
 
   AddUserAttempt -> do
     { addUserForm } <- H.get
@@ -296,7 +288,7 @@ handleAction = case _ of
                           , admin: addUserForm.admin
                           , email: Just (Email.Email email)
                           , password: pass }
-        H.raise $ MessageToSend ab
+        H.raise $ SendToAuthd ab
         H.raise $ Log $ SystemLog "Add a user"
 
   ChangeTab current_tab -> do
@@ -315,7 +307,7 @@ handleAction = case _ of
     let regex  = searchUserForm.regex
     ab <- H.liftEffect $ AuthD.serialize $
       AuthD.MkSearchUser { regex: not_empty_string regex, offset: Just 0 }
-    H.raise $ MessageToSend ab
+    H.raise $ SendToAuthd ab
     H.modify_ _ { matching_users = [] }
 
   SearchDomainAttempt -> do
@@ -323,13 +315,9 @@ handleAction = case _ of
     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.raise $ SendToDNSManager ab
     H.modify_ _ { matching_domains = [] }
 
-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
 

src/App/Templates/Table.purs

@@ -8,12 +8,15 @@ module App.Templates.Table
   , display_dmarc_mail_addresses
   , display_modifiers
   , display_mechanisms
+  , found_users
+  , found_domains
   ) where
 
 import Prelude (comparing, map, not, show, (#), ($), (&&), (<<<), (<>), (==), (>))
 
 import CSSClasses as C
 
+import App.Type.UserPublic (UserPublic)
 import Data.Array.NonEmpty as NonEmpty
 import Data.Array as A
 import Data.Maybe (Maybe(..), fromMaybe, maybe)
@@ -551,19 +554,57 @@ display_modifiers action_remove_modifier ms =
                 ]
 
 display_dmarc_mail_addresses :: forall w i. (Int -> i) -> Array DMARC.DMARCURI -> HH.HTML w i
-display_dmarc_mail_addresses f ms =
+display_dmarc_mail_addresses f ms = Web.table [] [ header, HH.tbody_ $ map row $ attach_id 0 ms]
-    Web.table [] [ dmarc_dmarcuri_table_header, HH.tbody_ $ map render_dmarcuri_row $ attach_id 0 ms]
   where
-  render_dmarcuri_row :: (Tuple Int DMARC.DMARCURI) -> HH.HTML w i
+  header :: HH.HTML w i
-  render_dmarcuri_row (Tuple i m) = HH.tr_
+  header
-    [ HH.td_ [ Web.p m.mail ]
-    , HH.td_ [ Web.p $ maybe "(no size limit)" show m.limit ]
-    , HH.td_ [ Button.alert_btn "x" (f i) ]
-    ]
-  dmarc_dmarcuri_table_header :: HH.HTML w i
-  dmarc_dmarcuri_table_header
     = HH.thead_ [ HH.tr_ [ HH.th_ [ HH.text "Email address" ]
                          , HH.th_ [ HH.text "Report size limit" ]
                          , HH.th_ [ HH.text "" ]
                          ]
                 ]
+  row :: (Tuple Int DMARC.DMARCURI) -> HH.HTML w i
+  row (Tuple i m) = HH.tr_
+    [ HH.td_ [ Web.p m.mail ]
+    , HH.td_ [ Web.p $ maybe "(no size limit)" show m.limit ]
+    , HH.td_ [ Button.alert_btn "x" (f i) ]
+    ]
+
+found_users :: forall w i. (Int -> i) -> Array UserPublic -> HH.HTML w i
+found_users f users = Web.table [] [ header, HH.tbody_ $ map row users ]
+  where
+  header :: HH.HTML w i
+  header
+    = HH.thead_ [ HH.tr_ [ HH.th_ [ HH.text "Username" ]
+                         , HH.th_ [ HH.text "UID" ]
+                         , HH.th_ [ HH.text "Date of registration" ]
+                         , HH.th_ [ HH.text "" ]
+                         ]
+                ]
+  row :: UserPublic -> HH.HTML w i
+  row user = HH.tr_
+    [ HH.td_ [ Web.p user.login ]
+    , HH.td_ [ Web.p $ show user.uid ]
+    , HH.td_ [ Web.p $ fromMaybe "" user.date_registration ]
+    , HH.td_ [ Button.alert_btn "x" (f user.uid) ]
+    ]
+
+type ActionEnterDomain i = (String -> i)
+type ActionDeleteDomain i = (String -> i)
+found_domains :: forall w i.
+  ActionEnterDomain i -> ActionDeleteDomain i -> Array String -> HH.HTML w i
+found_domains action_enter_domain action_delete_domain domains = Web.table [] [ header, HH.tbody_ $ map row domains ]
+  where
+  row :: String -> HH.HTML w i
+  row dom = HH.tr_
+    [ HH.td_ [ Button.btn dom (action_enter_domain dom) ]
+    , HH.td_ [ Web.p "" ]
+    , HH.td_ [ Button.alert_btn "x" (action_delete_domain  dom) ]
+    ]
+  header :: HH.HTML w i
+  header
+    = HH.thead_ [ HH.tr_ [ HH.th_ [ HH.text "Domain name" ]
+                         , HH.th_ [ HH.text "" ]
+                         , HH.th_ [ HH.text "" ]
+                         ]
+                ]

src/Utils.purs

@@ -21,3 +21,7 @@ remove_id i arr = case A.head arr of
 
 id :: forall a. a -> a
 id x = x
+
+not_empty_string :: String -> Maybe String
+not_empty_string "" = Nothing
+not_empty_string v = Just v