Baguette/dnsmanager-webclient
2
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

WIP: delegation.

Browse source
This commit is contained in:
Philippe Pittoli 2025-07-07 22:53:37 +02:00
parent 37ebd5566a
commit 32aba841f4
6 changed files with 106 additions and 0 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

6
src/App/Container.purs
View file

@ -970,6 +970,12 @@ 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
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."
(DNSManager.GotKeepAlive _) -> do
-- handleAction $ Log $ SystemLog $ "KeepAlive."
pure unit

20
src/App/Message/DNSManagerDaemon.purs
View file

@ -133,6 +133,13 @@ type SearchDomain = { domain :: String, offset :: Maybe Int }
codecSearchDomain ∷ CA.JsonCodec SearchDomain
codecSearchDomain = CA.object "SearchDomain" (CAR.record { domain: CA.string, offset: CAR.optional CA.int })
{- 25 -}
type DelegateDomain = { domain :: String, nameserver1 :: String, nameserver2 :: String }
codecDelegateDomain ∷ CA.JsonCodec DelegateDomain
codecDelegateDomain = CA.object "DelegateDomain" (CAR.record { domain: CA.string
, nameserver1: CA.string
, nameserver2: CA.string })
{- 100 -}
type GenerateAllZoneFiles = {}
codecGenerateAllZoneFiles ∷ CA.JsonCodec GenerateAllZoneFiles
@ -285,6 +292,15 @@ type OrphanDomainList = { domains :: Array String }
codecOrphanDomainList ∷ CA.JsonCodec OrphanDomainList
codecOrphanDomainList = CA.object "OrphanDomainList" (CAR.record { domains: CA.array CA.string })
{- 25 same as 14 -}
{- 26 -}
type DomainDelegated = { domain :: String, nameserver1 :: String, nameserver2 :: String }
codecDomainDelegated ∷ CA.JsonCodec DomainDelegated
codecDomainDelegated = CA.object "DomainDelegated" (CAR.record { domain: CA.string
, nameserver1: CA.string
, nameserver2: CA.string })
{- 50 -}
type UnknownUser = { }
codecUnknownUser ∷ CA.JsonCodec UnknownUser
@ -328,6 +344,7 @@ data RequestMessage
| MkAskUnShareDomain AskUnShareDomain -- 22
| MkGainOwnership GainOwnership -- 23
| MkSearchDomain SearchDomain -- 24
| MkDelegateDomain DelegateDomain -- 25
| MkGenerateAllZoneFiles GenerateAllZoneFiles -- 100
| MkGenerateZoneFile GenerateZoneFile -- 101
| MkKeepAlive KeepAlive -- 250
@ -360,6 +377,7 @@ data AnswerMessage
| MkGeneratedZoneFile GeneratedZoneFile -- 23
| MkOrphanDomainList OrphanDomainList -- 24
| MkFoundDomains DomainList -- 25
| MkDomainDelegated DomainDelegated -- 26
| MkUnknownUser UnknownUser -- 50
| MkNoOwnership NoOwnership -- 51
| MkInsufficientRights InsufficientRights -- 52
@ -387,6 +405,7 @@ encode m = case m of
(MkAskUnShareDomain request) -> get_tuple 22 codecAskUnShareDomain request
(MkGainOwnership request) -> get_tuple 23 codecGainOwnership request
(MkSearchDomain request) -> get_tuple 24 codecSearchDomain request
(MkDelegateDomain request) -> get_tuple 25 codecDelegateDomain request
(MkGenerateAllZoneFiles request) -> get_tuple 100 codecGenerateAllZoneFiles request
(MkGenerateZoneFile request) -> get_tuple 101 codecGenerateZoneFile request
(MkKeepAlive request) -> get_tuple 250 codecKeepAlive request
@ -428,6 +447,7 @@ decode number string
23 -> error_management codecGeneratedZoneFile MkGeneratedZoneFile
24 -> error_management codecOrphanDomainList MkOrphanDomainList
25 -> error_management codecDomainList MkFoundDomains
26 -> error_management codecDomainDelegated MkDomainDelegated
50 -> error_management codecUnknownUser MkUnknownUser
51 -> error_management codecNoOwnership MkNoOwnership
52 -> error_management codecInsufficientRights MkInsufficientRights

33
src/App/Page/Zone.purs
View file

@ -42,6 +42,7 @@ import App.Text.Explanations as Explanations
import App.Type.RRId (RRId)
import App.Type.Field as Field
import App.Type.Delegation (mkEmptyDelegationForm, update_delegation_field, Form, Field) as Delegation
import App.Type.RRModal (RRModal(..))
import App.Type.AcceptedRRTypes (AcceptedRRTypes(..))
import App.Type.ResourceRecord (ResourceRecord)
@ -105,6 +106,9 @@ data Action
-- | Create a new resource record modal (a form) for a certain type of component.
| CreateNewRRModal AcceptedRRTypes
-- | Delegation modal.
| CreateDelegationModal
-- | Create modal (a form) for a resource record to update.
| CreateUpdateRRModal RRId
@ -120,6 +124,9 @@ data Action
-- | Update new entry form (in the `rr_modal` modal).
| UpdateCurrentRR Field.Field
-- | Update a delegation form field (new nameservers for the domain).
| UpdateDelegationForm Delegation.Field
-- | Validate a new resource record before adding it.
| ValidateRR AcceptedRRTypes
@ -169,6 +176,9 @@ type State =
-- Unique RR form.
, _rr_form :: RRForm
-- DelegationForm
, _delegation_form :: Delegation.Form
, current_tab :: Tab
}
@ -200,6 +210,8 @@ initialState domain =
, _rr_form: mkEmptyRRForm
, _delegation_form: Delegation.mkEmptyDelegationForm
, current_tab: Zone
}
@ -227,11 +239,16 @@ render state
= Modal.current_rr_modal state._domain state._rr_form state.rr_modal
UpdateCurrentRR NewToken RRUpdate ValidateRR ValidateLocal CancelModal
delegation_modal
= Modal.delegation_modal state._domain state._delegation_form
UpdateDelegationForm CancelModal
render_zone =
case state.rr_modal of
RemoveRRModal rr_id -> Modal.modal_rr_delete rr_id RemoveRR CancelModal
NewRRModal _ -> call_to_current_rr_modal
UpdateRRModal -> call_to_current_rr_modal
DelegationModal -> delegation_modal
NoModal -> HH.div_
[ Web.level [ Web.btn_ [C.is_large, C.is_info] "Back to the domain list" ReturnToDomainList
, Web.h1 state._domain
@ -296,6 +313,10 @@ handleAction = case _ of
state <- H.get
H.modify_ _ { rr_modal = NewRRModal t, _rr_form { _rr = default_rr t state._domain } }
-- | Delegation modal presents a simple form with two entries (chosen nameservers).
CreateDelegationModal -> do
H.modify_ _ { rr_modal = DelegationModal, _delegation_form = Delegation.mkEmptyDelegationForm }
-- | Initialize the Zone component: ask for the domain zone to `dnsmanagerd`.
Initialize -> do
{ _domain } <- H.get
@ -356,6 +377,12 @@ handleAction = case _ of
let newRR = update_field state._rr_form._rr field
H.modify_ _ { _rr_form { _rr = newRR } }
-- | Update the delegation form.
UpdateDelegationForm field -> do
state <- H.get
let newDelegationForm = Delegation.update_delegation_field state._delegation_form field
H.modify_ _ { _delegation_form = newDelegationForm }
-- | Validate any local RR with the new `_resources` and `_local_errors`.
ValidateLocal -> do
-- In case the `name` part of the resource record is empty, consider the name to be the domain itself.
@ -501,6 +528,12 @@ render_new_records _
, Web.btn "DMARC" (CreateNewRRModal DMARC)
] []
, Web.hr
, Web.h1 "Delegation"
-- use "level" to get horizontal buttons next to each other (probably vertical on mobile)
, Web.level [
Web.btn "Delegate your domain to different name servers" CreateDelegationModal
] []
, Web.hr
, Web.level [
Web.btn "Get the final zone file" AskGeneratedZoneFile
] [HH.text "For debug purposes. ⚠"]

31
src/App/Templates/Modal.purs
View file

@ -21,6 +21,7 @@ import App.Type.RRId (RRId)
import App.Type.DMARC as DMARC
import App.Type.DKIM as DKIM
import App.Type.Field as Field
import App.Type.Delegation as Delegation
import App.Templates.Table as Table
import Data.String (toLower)
@ -51,6 +52,35 @@ modal_rr_delete rr_id action_remove_rr action_cancel_modal = Web.modal "Deleting
zip_nullable :: forall a. Array a -> Array String -> Array (Tuple a String)
zip_nullable txt raw = A.zip txt ([""] <> raw)
type ActionUpdateDelegationForm i = (Delegation.Field -> i)
delegation_modal :: forall w i.
Domain -> Delegation.Form -> ActionUpdateDelegationForm i -> ActionCancelModal i -> HH.HTML w i
delegation_modal selected_domain form action_update_form action_cancel_modal =
Web.modal modal_title modal_content modal_foot
where
modal_title = "Delegation for " <> selected_domain
modal_content :: Array (HH.HTML w i)
modal_content =
[ HH.div [HP.classes [C.notification, C.is_warning]]
[ Web.p "⚠️​ You are about to delegate your domain to another server, you won't be able to manage entries from netlibre."
]
, Web.box_input "nameserver1" "name server 1" "ns0.example.com"
(action_update_form <<< Delegation.NameServer1)
form.nameserver1
, Web.box_input "nameserver2" "name server 2" "ns1.example.com"
(action_update_form <<< Delegation.NameServer2)
form.nameserver2
]
modal_foot :: Array (HH.HTML w i)
modal_foot =
[ Web.p "should be a button here mdr"
--[ Web.btn_add action_update_form
, Web.cancel_button action_cancel_modal
]
side_text_for_name_input name_id
= Web.side_text_above_input name_id "Name" (HH.text $ "Empty name = root domain (" <> selected_domain <> ".)")
type Domain = String
type ActionUpdateForm i = (Field.Field -> i)
type ActionNewToken i = (RRId -> i)
@ -371,6 +401,7 @@ current_rr_modal selected_domain form rr_modal
where
title = case rr_modal of
NoModal -> "Error: no modal should be displayed"
DelegationModal -> "Error: the delegation modal should be displayed"
NewRRModal t_ -> "New " <> show t_ <> " resource record"
UpdateRRModal -> "Update " <> form._rr.rrtype <> " Resource Record"
RemoveRRModal rr_id -> "Error: should display removal modal instead (for resource record " <> show rr_id <> ")"

15
src/App/Type/Delegation.purs Normal file
View file

@ -0,0 +1,15 @@
module App.Type.Delegation where
type Form = { nameserver1 :: String, nameserver2 :: String }
data Field
= NameServer1 String
| NameServer2 String
mkEmptyDelegationForm :: Form
mkEmptyDelegationForm = { nameserver1: "ns0.example.com", nameserver2: "ns1.example.com" }
update_delegation_field :: Form -> Field -> Form
update_delegation_field form updated_field = case updated_field of
NameServer1 val -> form { nameserver1 = val }
NameServer2 val -> form { nameserver2 = val }

1
src/App/Type/RRModal.purs
View file

@ -14,3 +14,4 @@ data RRModal
| NewRRModal AcceptedRRTypes
| UpdateRRModal
| RemoveRRModal RRId
| DelegationModal