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
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

View file

@ -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)

View file

@ -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
})