diff --git a/src/App/Container.purs b/src/App/Container.purs index 50f6167..d6b54fa 100644 --- a/src/App/Container.purs +++ b/src/App/Container.purs @@ -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 diff --git a/src/App/Message/DNSManagerDaemon.purs b/src/App/Message/DNSManagerDaemon.purs index 5a28dc0..39430bb 100644 --- a/src/App/Message/DNSManagerDaemon.purs +++ b/src/App/Message/DNSManagerDaemon.purs @@ -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 diff --git a/src/App/Page/Zone.purs b/src/App/Page/Zone.purs index e6797eb..f87d496 100644 --- a/src/App/Page/Zone.purs +++ b/src/App/Page/Zone.purs @@ -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. ⚠"] diff --git a/src/App/Templates/Modal.purs b/src/App/Templates/Modal.purs index 7a2feeb..4ea3483 100644 --- a/src/App/Templates/Modal.purs +++ b/src/App/Templates/Modal.purs @@ -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 <> ")" diff --git a/src/App/Type/Delegation.purs b/src/App/Type/Delegation.purs new file mode 100644 index 0000000..a6340bc --- /dev/null +++ b/src/App/Type/Delegation.purs @@ -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 } diff --git a/src/App/Type/RRModal.purs b/src/App/Type/RRModal.purs index c4a1475..a531a34 100644 --- a/src/App/Type/RRModal.purs +++ b/src/App/Type/RRModal.purs @@ -14,3 +14,4 @@ data RRModal | NewRRModal AcceptedRRTypes | UpdateRRModal | RemoveRRModal RRId + | DelegationModal