Delegation now works (yet, domains cannot be later updated).
This commit is contained in:
parent
7c4c024cd1
commit
88dd3addc5
3 changed files with 42 additions and 10 deletions
|
@ -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
|
||||
|
|
|
@ -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)
|
||||
|
|
|
@ -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
|
||||
})
|
||||
|
|
Loading…
Add table
Reference in a new issue