Admin: ask for orphan domain list.

src/App/Container.purs

@@ -412,7 +412,9 @@ handleAction = case _ of
       auth_message <- H.liftEffect $ AuthD.serialize      $ AuthD.MkDeleteUser      { user:    Just uid }
       H.tell _ws_dns unit (WS.ToSend dns_message)
       H.tell _ws_auth unit (WS.ToSend auth_message)
-
+    AdminInterface.GetOrphanDomains -> do
+      message  <- H.liftEffect $ DNSManager.serialize $ DNSManager.MkGetOrphanDomains {}
+      H.tell _ws_dns unit (WS.ToSend message)
 
   ZoneInterfaceEvent ev -> case ev of
     ZoneInterface.MessageToSend message  -> H.tell _ws_dns unit (WS.ToSend message)
@@ -680,6 +682,9 @@ handleAction = case _ of
             handleAction $ Log $ ErrorLog $ "Invalid resource record: " <> A.intercalate ", " response.errors
           (DNSManager.MkSuccess _) -> do
             handleAction $ Log $ SuccessLog $ "(generic) Success!"
+          DNSManager.MkOrphanDomainList response -> do
+            handleAction $ Log $ SuccessLog "Received orphan domain list."
+            H.tell _admini unit (AdminInterface.GotOrphanDomainList response.domains)
           (DNSManager.GotKeepAlive _) -> do
             -- handleAction $ Log $ SystemLog $ "KeepAlive!"
             pure unit

src/App/Message/DNSManagerDaemon.purs

@@ -39,6 +39,11 @@ type DeleteUser = { user_id :: Maybe Int }
 codecDeleteUser ∷ CA.JsonCodec DeleteUser
 codecDeleteUser = CA.object "DeleteUser" (CAR.record { user_id: CAR.optional CA.int })
 
+{- 6  -}
+type GetOrphanDomains = { }
+codecGetOrphanDomains ∷ CA.JsonCodec GetOrphanDomains
+codecGetOrphanDomains = CA.object "GetOrphanDomains" (CAR.record { })
+
 {- 7  -}
 type Maintenance = { subject :: MaintenanceSubject.MaintenanceSubject
                    , int :: Maybe Int
@@ -245,6 +250,11 @@ type GeneratedZoneFile = { domain :: String, zonefile :: String }
 codecGeneratedZoneFile ∷ CA.JsonCodec GeneratedZoneFile
 codecGeneratedZoneFile = CA.object "GeneratedZoneFile" (CAR.record { domain: CA.string, zonefile: CA.string })
 
+{- 24  -}
+type OrphanDomainList = { domains :: Array String }
+codecOrphanDomainList ∷ CA.JsonCodec OrphanDomainList
+codecOrphanDomainList = CA.object "OrphanDomainList" (CAR.record { domains: CA.array CA.string })
+
 {- 50  -}
 type UnknownUser = { }
 codecUnknownUser ∷ CA.JsonCodec UnknownUser
@@ -270,6 +280,7 @@ codecInsufficientRights = CA.object "InsufficientRights" (CAR.record { })
 data RequestMessage
   = MkLogin                Login                -- 0
   | MkDeleteUser           DeleteUser           -- 1
+  | MkGetOrphanDomains     GetOrphanDomains     -- 6
   | MkMaintenance          Maintenance          -- 7
   | MkNewDomain            NewDomain            -- 9
   | MkDeleteDomain         DeleteDomain         -- 10
@@ -312,6 +323,7 @@ data AnswerMessage
   | MkRRUpdated           RRUpdated           -- 21
   | MkRRReadOnly          RRReadOnly          -- 22
   | MkGeneratedZoneFile   GeneratedZoneFile   -- 23
+  | MkOrphanDomainList    OrphanDomainList    -- 24
   | MkUnknownUser         UnknownUser         -- 50
   | MkNoOwnership         NoOwnership         -- 51
   | MkInsufficientRights  InsufficientRights  -- 52
@@ -321,6 +333,7 @@ encode ∷ RequestMessage -> Tuple UInt String
 encode m = case m of
     (MkLogin                request) -> get_tuple 0   codecLogin                request
     (MkDeleteUser           request) -> get_tuple 1   codecDeleteUser           request
+    (MkGetOrphanDomains     request) -> get_tuple 6   codecGetOrphanDomains     request
     (MkMaintenance          request) -> get_tuple 7   codecMaintenance          request
     (MkNewDomain            request) -> get_tuple 9   codecNewDomain            request
     (MkDeleteDomain         request) -> get_tuple 10  codecDeleteDomain         request
@@ -372,6 +385,7 @@ decode number string
     21  -> error_management codecRRUpdated           MkRRUpdated
     22  -> error_management codecRRReadOnly          MkRRReadOnly
     23  -> error_management codecGeneratedZoneFile   MkGeneratedZoneFile
+    24  -> error_management codecOrphanDomainList    MkOrphanDomainList
     50  -> error_management codecUnknownUser         MkUnknownUser
     51  -> error_management codecNoOwnership         MkNoOwnership
     52  -> error_management codecInsufficientRights  MkInsufficientRights

src/App/Page/Administration.purs

@@ -47,11 +47,16 @@ data Output
   | AskState
   | StoreState State
   | DeleteUserAccount Int
+  | GetOrphanDomains
+
+  --| DeleteDomain String
+  --| RequestDomain String
 
 data Query a
   = MessageReceived AuthD.AnswerMessage a
   | ConnectionIsDown a
   | ConnectionIsUp a
+  | GotOrphanDomainList (Array String) a
   | ProvideState (Maybe State) a
 
 type Slot = H.Slot Query Output
@@ -76,6 +81,11 @@ data Action
   | ShowUser Int
   | RemoveUser Int
 
+  -- Domains.
+  | ShowOrphanDomains
+  | RemoveDomain String
+  | ShowDomain String
+
   -- | Change the displayed tab.
   | ChangeTab Tab
 
@@ -84,7 +94,7 @@ 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
+data Tab = Home | Search | Add | OrphanDomains
 derive instance eqTab :: Eq Tab
 
 type StateAddUserForm = { login :: String, admin :: Boolean, email :: String, pass :: String }
@@ -96,6 +106,7 @@ type State =
   , current_tab    :: Tab
   , wsUp           :: Boolean
   , matching_users :: Array UserPublic
+  , orphan_domains :: Array String
   }
 
 component :: forall m. MonadAff m => H.Component Query Input Output m
@@ -115,12 +126,13 @@ initialState :: Input -> State
 initialState _ = { addUserForm:    { login: "", admin: false, email: "", pass: "" }
                  , searchUserForm: { regex: "" {-, admin: false, domain: "" -} }
                  , matching_users: []
+                 , orphan_domains: []
                  , current_tab: Home
                  , wsUp: true
                  }
 
 render :: forall m. State -> H.ComponentHTML Action () m
-render { addUserForm, searchUserForm, matching_users, current_tab, wsUp }
+render { addUserForm, searchUserForm, matching_users, current_tab, orphan_domains, wsUp }
   = Bulma.section_small
       [ fancy_tab_bar
       , case current_tab of
@@ -131,6 +143,10 @@ render { addUserForm, searchUserForm, matching_users, current_tab, wsUp }
             ]
           Add -> Bulma.columns_
             [ Bulma.column (C.is 5) [Bulma.article (Bulma.p "Add a new user") render_adduser_form] ]
+          OrphanDomains -> HH.div_
+            [ Bulma.btn_ (C.is_small) "Get orphan domains" ShowOrphanDomains
+            , show_orphan_domains
+            ]
       ]
     where
     fancy_tab_bar =
@@ -138,6 +154,7 @@ render { addUserForm, searchUserForm, matching_users, current_tab, wsUp }
         [ Bulma.tab_entry (is_tab_active Home)          "Home"             (ChangeTab Home)
         , Bulma.tab_entry (is_tab_active Search)        "Search"           (ChangeTab Search)
         , Bulma.tab_entry (is_tab_active Add)           "Add"              (ChangeTab Add)
+        , Bulma.tab_entry (is_tab_active OrphanDomains) "OrphanDomains"    (ChangeTab OrphanDomains)
         ]
     is_tab_active tab = current_tab == tab
 
@@ -145,6 +162,10 @@ render { addUserForm, searchUserForm, matching_users, current_tab, wsUp }
     user_card user = HH.li_ [ Bulma.btn_delete (RemoveUser user.uid)
                             , Bulma.btn_ (C.is_small) user.login (ShowUser user.uid)
                             ]
+    show_orphan_domains = Bulma.box [ HH.ul_ $ map domain_entry orphan_domains ]
+    domain_entry domain = HH.li_ [ Bulma.btn_delete (RemoveDomain domain)
+                                 , Bulma.btn_ (C.is_small) domain (ShowDomain domain)
+                                 ]
     up x = HandleAddUserInput <<< x
     active = (if wsUp then (HP.enabled true) else (HP.disabled true))
 
@@ -185,6 +206,7 @@ handleAction = case _ of
         "Home"          -> handleAction $ ChangeTab Home
         "Search"        -> handleAction $ ChangeTab Search
         "Add"           -> handleAction $ ChangeTab Add
+        "OrphanDomains" -> handleAction $ ChangeTab OrphanDomains
         _               -> H.raise $ Log $ ErrorLog $ "Reload but cannot understand old current_tab: " <> current_tab
 
   Finalize -> do
@@ -205,10 +227,22 @@ handleAction = case _ of
   ShowUser uid -> do
     H.raise $ Log $ SystemLog $ "Show a user details (uid: " <> show uid <> ")"
 
+  ShowOrphanDomains -> do
+    H.raise $ Log $ SystemLog $ "Get orphan domains"
+    H.raise $ GetOrphanDomains
+
   RemoveUser uid -> do
     H.raise $ Log $ SystemLog $ "Remove user " <> show uid
     H.raise $ DeleteUserAccount uid
 
+  RemoveDomain domain -> do
+    H.raise $ Log $ SystemLog $ "TODO: remove domain " <> domain
+    --H.raise $ DeleteDomain domain
+
+  ShowDomain domain -> do
+    H.raise $ Log $ SystemLog $ "TODO: show domain " <> domain
+    -- H.raise $ RequestDomain domain
+
   AddUserAttempt -> do
     { addUserForm } <- H.get
     let login  = addUserForm.login
@@ -236,6 +270,7 @@ handleAction = case _ of
       Home           -> H.liftEffect $ Storage.setItem "current-ada-tab" "Home"          sessionstorage
       Search         -> H.liftEffect $ Storage.setItem "current-ada-tab" "Search"        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 }
 
   SearchUserAttempt -> do
@@ -288,3 +323,8 @@ handleQuery = case _ of
   ConnectionIsUp a -> do
     H.modify_ _ { wsUp = true }
     pure (Just a)
+
+  GotOrphanDomainList domains a -> do
+    H.raise $ Log $ SuccessLog "Got orphan domain list!"
+    H.modify_ _ { orphan_domains = domains }
+    pure (Just a)