Delegation now works (yet, domains cannot be later updated).

This commit is contained in:
Philippe Pittoli 2025-07-16 17:10:31 +02:00
parent 7c4c024cd1
commit 88dd3addc5
3 changed files with 42 additions and 10 deletions

View file

@ -973,12 +973,11 @@ decode_message_from_dnsmanagerd arraybuffer = do
DNSManager.MkFoundDomains response -> do DNSManager.MkFoundDomains response -> do
handleAction $ Log $ SuccessLog "Received found domain list." handleAction $ Log $ SuccessLog "Received found domain list."
H.tell _admini unit (PageAdministration.GotFoundDomains response.domains) H.tell _admini unit (PageAdministration.GotFoundDomains response.domains)
DNSManager.MkDomainDelegated response -> do m@(DNSManager.MkDomainDelegated response) -> do
handleAction $ Log $ SuccessLog $ handleAction $ Log $ SuccessLog $
"Domain " <> response.domain "Domain " <> response.domain
<> " is now delegated (to " <> response.nameserver1 <> " and " <> response.nameserver2 <> ")." <> " is now delegated (to " <> response.nameserver1 <> " and " <> response.nameserver2 <> ")."
handleAction $ Log $ SuccessLog $ forward m
"FIXME: remove all RRs from the domain, display recorded nameservers and a revert button."
(DNSManager.GotKeepAlive _) -> do (DNSManager.GotKeepAlive _) -> do
-- handleAction $ Log $ SystemLog $ "KeepAlive." -- handleAction $ Log $ SystemLog $ "KeepAlive."
pure unit pure unit

View file

@ -170,6 +170,8 @@ derive instance genericTab :: Generic Tab _
instance showTab :: Show Tab where instance showTab :: Show Tab where
show = genericShow show = genericShow
type Delegation = { nameserver1 :: String, nameserver2 :: String }
-- FIXME: this state is a mess. -- FIXME: this state is a mess.
type State = type State =
{ _domain :: String { _domain :: String
@ -187,6 +189,8 @@ type State =
-- DelegationForm -- DelegationForm
, _delegation_form :: Delegation.Form , _delegation_form :: Delegation.Form
, delegation :: Maybe Delegation
, current_tab :: Tab , current_tab :: Tab
} }
@ -221,6 +225,8 @@ initialState domain =
, _delegation_form: Delegation.mkEmptyDelegationForm , _delegation_form: Delegation.mkEmptyDelegationForm
, current_tab: Zone , current_tab: Zone
, delegation: Nothing
} }
type SortableRecord l = Record (rrtype :: String, rrid :: Int | l) type SortableRecord l = Record (rrtype :: String, rrid :: Int | l)
@ -257,16 +263,22 @@ render state
NewRRModal _ -> call_to_current_rr_modal NewRRModal _ -> call_to_current_rr_modal
UpdateRRModal -> call_to_current_rr_modal UpdateRRModal -> call_to_current_rr_modal
DelegationModal -> delegation_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.level [ Web.btn_ [C.is_large, C.is_info] "Back to the domain list" ReturnToDomainList
, Web.h1 state._domain , Web.h1 state._domain
] [] ] []
, Web.hr , Web.hr
, Table.resource_records (sorted state._resources) CreateUpdateRRModal DeleteRRModal NewToken ] <> render_zone_records state.delegation
, Web.hr
, render_new_records state -- render_zone_records :: Maybe Delegation -> HH.HTML i Action
, render_zonefile state._rr_form._zonefile 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 :: forall l. Array (SortableRecord (l)) -> Array (SortableRecord (l))
sorted array = sorted array =
@ -509,7 +521,11 @@ handleQuery = case _ of
(DNSManager.MkGeneratedZoneFile response) -> do (DNSManager.MkGeneratedZoneFile response) -> do
H.modify_ _ { _rr_form { _zonefile = Just response.zonefile } } H.modify_ _ { _rr_form { _zonefile = Just response.zonefile } }
(DNSManager.MkZone response) -> do (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." _ -> H.raise $ Log $ ErrorLog $ "Message not handled in Page.Zone."
pure (Just a) pure (Just a)

View file

@ -4,6 +4,19 @@ import Data.Codec.Argonaut (JsonCodec)
import Data.Codec.Argonaut as CA import Data.Codec.Argonaut as CA
import Data.Codec.Argonaut.Record as CAR import Data.Codec.Argonaut.Record as CAR
import App.Type.ResourceRecord as RR 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 type DNSZone
= { domain :: String = { domain :: String
@ -13,6 +26,9 @@ type DNSZone
-- Each resource record has a number, this is the ID to give to a new RR. -- Each resource record has a number, this is the ID to give to a new RR.
, current_rrid :: Int , current_rrid :: Int
-- In case the zone is delegated, it should have two recorded name servers.
, delegation :: Maybe Delegation
} }
codec :: JsonCodec DNSZone codec :: JsonCodec DNSZone
@ -21,4 +37,5 @@ codec = CA.object "DNSZone"
{ domain: CA.string { domain: CA.string
, resources: CA.array RR.codec , resources: CA.array RR.codec
, current_rrid: CA.int , current_rrid: CA.int
, delegation: CAR.optional codecDelegation
}) })