From 88dd3addc5800a1a188e1f335e9e95213527b685 Mon Sep 17 00:00:00 2001
From: Philippe Pittoli <karchnu@karchnu.fr>
Date: Wed, 16 Jul 2025 17:10:31 +0200
Subject: [PATCH] Delegation now works (yet, domains cannot be later updated).

---
 src/App/Container.purs    |  5 ++---
 src/App/Page/Zone.purs    | 30 +++++++++++++++++++++++-------
 src/App/Type/DNSZone.purs | 17 +++++++++++++++++
 3 files changed, 42 insertions(+), 10 deletions(-)

diff --git a/src/App/Container.purs b/src/App/Container.purs
index 245b7a0..1a67141 100644
--- a/src/App/Container.purs
+++ b/src/App/Container.purs
@@ -973,12 +973,11 @@ decode_message_from_dnsmanagerd arraybuffer = do
         DNSManager.MkFoundDomains response -> do
           handleAction $ Log $ SuccessLog "Received found domain list."
           H.tell _admini unit (PageAdministration.GotFoundDomains response.domains)
-        DNSManager.MkDomainDelegated response -> do
+        m@(DNSManager.MkDomainDelegated response) -> do
           handleAction $ Log $ SuccessLog $
             "Domain " <> response.domain
             <> " is now delegated (to " <> response.nameserver1 <> " and " <> response.nameserver2 <> ")."
-          handleAction $ Log $ SuccessLog $
-            "FIXME: remove all RRs from the domain, display recorded nameservers and a revert button."
+          forward m
         (DNSManager.GotKeepAlive _) -> do
           -- handleAction $ Log $ SystemLog $ "KeepAlive."
           pure unit
diff --git a/src/App/Page/Zone.purs b/src/App/Page/Zone.purs
index 42d35e9..70f0083 100644
--- a/src/App/Page/Zone.purs
+++ b/src/App/Page/Zone.purs
@@ -170,6 +170,8 @@ derive instance genericTab :: Generic Tab _
 instance showTab :: Show Tab where
   show = genericShow
 
+type Delegation = { nameserver1 :: String, nameserver2 :: String }
+
 -- FIXME: this state is a mess.
 type State =
   { _domain :: String
@@ -187,6 +189,8 @@ type State =
   -- DelegationForm
   , _delegation_form :: Delegation.Form
 
+  , delegation :: Maybe Delegation
+
   , current_tab :: Tab
   }
 
@@ -221,6 +225,8 @@ initialState domain =
   , _delegation_form: Delegation.mkEmptyDelegationForm
 
   , current_tab: Zone
+
+  , delegation: Nothing
   }
 
 type SortableRecord l = Record (rrtype :: String, rrid :: Int | l)
@@ -257,16 +263,22 @@ render state
           NewRRModal _        -> call_to_current_rr_modal
           UpdateRRModal       -> call_to_current_rr_modal
           DelegationModal     -> delegation_modal
-          NoModal -> HH.div_
+          NoModal -> HH.div_ $
             [ Web.level [ Web.btn_ [C.is_large, C.is_info]  "Back to the domain list" ReturnToDomainList
                         , Web.h1 state._domain
                         ] []
             , Web.hr
-            , Table.resource_records (sorted state._resources) CreateUpdateRRModal DeleteRRModal NewToken
-            , Web.hr
-            , render_new_records state
-            , render_zonefile state._rr_form._zonefile
-            ]
+            ] <> render_zone_records state.delegation
+
+    -- render_zone_records :: Maybe Delegation -> HH.HTML i Action
+    render_zone_records (Just delegation) =
+      [ Web.p $ "This domain has been delegated to " <> delegation.nameserver1 <> " and " <> delegation.nameserver2 ]
+    render_zone_records _ =
+      [ Table.resource_records (sorted state._resources) CreateUpdateRRModal DeleteRRModal NewToken
+      , Web.hr
+      , render_new_records state
+      , render_zonefile state._rr_form._zonefile
+      ]
 
     sorted :: forall l. Array (SortableRecord (l)) -> Array (SortableRecord (l))
     sorted array =
@@ -509,7 +521,11 @@ handleQuery = case _ of
       (DNSManager.MkGeneratedZoneFile response) -> do
         H.modify_ _ { _rr_form { _zonefile = Just response.zonefile } }
       (DNSManager.MkZone response) -> do
-        add_entries response.zone.resources
+        case response.zone.delegation of
+          Nothing -> add_entries response.zone.resources
+          Just _  -> H.modify_ _ { delegation = response.zone.delegation }
+      (DNSManager.MkDomainDelegated response) -> do
+        H.modify_ _ { delegation = Just { nameserver1: response.nameserver1, nameserver2: response.nameserver2} }
 
       _ -> H.raise $ Log $ ErrorLog $ "Message not handled in Page.Zone."
     pure (Just a)
diff --git a/src/App/Type/DNSZone.purs b/src/App/Type/DNSZone.purs
index 5e2e691..fdeea65 100644
--- a/src/App/Type/DNSZone.purs
+++ b/src/App/Type/DNSZone.purs
@@ -4,6 +4,19 @@ import Data.Codec.Argonaut (JsonCodec)
 import Data.Codec.Argonaut as CA
 import Data.Codec.Argonaut.Record as CAR
 import App.Type.ResourceRecord as RR
+import Data.Maybe (Maybe)
+
+type Delegation
+  = { nameserver1 :: String
+    , nameserver2 :: String
+    }
+
+codecDelegation :: JsonCodec Delegation
+codecDelegation = CA.object "Delegation"
+  (CAR.record
+    { nameserver1: CA.string
+    , nameserver2: CA.string
+    })
 
 type DNSZone
   = { domain        :: String
@@ -13,6 +26,9 @@ type DNSZone
 
     -- Each resource record has a number, this is the ID to give to a new RR.
     , current_rrid  :: Int
+
+    -- In case the zone is delegated, it should have two recorded name servers.
+    , delegation  :: Maybe Delegation
     }
 
 codec :: JsonCodec DNSZone
@@ -21,4 +37,5 @@ codec = CA.object "DNSZone"
     { domain:        CA.string
     , resources:     CA.array RR.codec
     , current_rrid:  CA.int
+    , delegation:    CAR.optional codecDelegation
     })