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
|
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
|
||||||
|
|
|
@ -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)
|
||||||
|
|
|
@ -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
|
||||||
})
|
})
|
||||||
|
|
Loading…
Add table
Reference in a new issue