WIP: massive code cleaning & _resources array for all RRs.

beta
Philippe Pittoli 2024-02-05 01:12:53 +01:00
parent 2904a0e089
commit 1f4191acba
1 changed files with 101 additions and 68 deletions

View File

@ -88,22 +88,14 @@ type Slot = H.Slot Query Output
type Input = String type Input = String
-- | Possible component's actions are: data Field
-- | - TODO: update the list of resource records = Field_Domain RecordName
-- | - add a resource record | Field_TTL TTL
-- | - TODO: modify a resource record | Field_Target RecordTarget
-- | - remove a resource record | Field_Priority Priority
-- | - handle user inputs | Field_Protocol Protocol
| Field_Weight Weight
-- TODO: rename this. | Field_Port Port
data Update_MODAL_Form
= Update_MODAL_Domain RecordName
| Update_MODAL_TTL TTL
| Update_MODAL_Target RecordTarget
| Update_MODAL_Priority Priority
| Update_MODAL_Protocol Protocol
| Update_MODAL_Weight Weight
| Update_MODAL_Port Port
data Update_SRR_Form data Update_SRR_Form
= Update_SRR_Domain RecordName = Update_SRR_Domain RecordName
@ -130,6 +122,21 @@ data Update_Local_Form
| Update_Local_Form_MXRR Update_MX_Form | Update_Local_Form_MXRR Update_MX_Form
| Update_Local_Form_SRVRR Update_SRV_Form | Update_Local_Form_SRVRR Update_SRV_Form
-- | Steps to create a new RR:
-- | 1. `CreateNewRRModal AcceptedRRTypes`: create a modal with default values based on selected accepted type.
-- | 2. `ValidateRR AcceptedRRTypes`: validate the new RR stored in `_newRR`.
-- | In case it works, automatically call `AddRR` then `CancelModal`.
-- | 3. `AddRR AcceptedRRTypes ResourceRecord`: send a message to `dnsmanagerd`.
-- |
-- | Steps to update an entry:
-- | 1. `CreateUpdateRRModal RRId`: create a modal from the values of the RR in `_resources` to update.
-- | 2. `UpdateCurrentRR RRId Field`: modify the currently displayed RR.
-- | 3. `ValidateLocal RRId AcceptedRRTypes`: validate the RR.
-- | 4. `UpdateRR ResourceRecord`: save the _validated_ RR.
-- |
-- | TODO:
-- | In both cases, once the add (or update) is performed, the resource should be added (updated) in `_resources`.
data Action data Action
-- | Create a modal to ask confirmation before deleting a resource record. -- | Create a modal to ask confirmation before deleting a resource record.
= DeleteRRModal RRId = DeleteRRModal RRId
@ -138,7 +145,10 @@ data Action
| CancelModal | CancelModal
-- | Create a new resource record modal (a form) for a certain type of component. -- | Create a new resource record modal (a form) for a certain type of component.
| NewRRModal AcceptedRRTypes | CreateNewRRModal AcceptedRRTypes
-- | Create modal (a form) for a resource record to update.
| CreateUpdateRRModal RRId
-- | Initiate the component. This means asking the content of the zone to `dnsmanagerd`. -- | Initiate the component. This means asking the content of the zone to `dnsmanagerd`.
| Initialize | Initialize
@ -153,17 +163,18 @@ data Action
| ValidateLocal RRId AcceptedRRTypes | ValidateLocal RRId AcceptedRRTypes
-- | Save the changes done in an already existing resource record. -- | Save the changes done in an already existing resource record.
| SaveLocal ResourceRecord | UpdateRR ResourceRecord
-- | Update new entry form (in the `active_new_rr_modal` modal). -- | Update new entry form (in the `rr_modal` modal).
| UpdateNewRRForm Update_MODAL_Form | UpdateCurrentlyDisplayedRRForm Field
-- TODO: Update an already existing resource record. -- TODO: Update an already existing resource record (update _resources).
| UpdateLocalForm (SRVRR ()) | UpdateCurrentRR RRId Field
-- | Update an already active entry. -- | Update an already active entry.
| UpdateLocalRR RRId Update_Local_Form | UpdateLocalRR RRId Update_Local_Form
-- TODO: Update an already existing resource record (update _resources).
| SaveSRR RRId | SaveSRR RRId
| SaveMXRR RRId | SaveMXRR RRId
| SaveSRVRR RRId | SaveSRVRR RRId
@ -177,10 +188,10 @@ data Action
type State = type State =
{ _domain :: RecordName { _domain :: RecordName
, wsUp :: Boolean , wsUp :: Boolean
, active_modal :: Maybe Int , deletion_modal :: Maybe Int
-- A modal to present a form for adding a new RR. -- A modal to present a form for adding a new RR.
, active_new_rr_modal :: Maybe AcceptedRRTypes , rr_modal :: Maybe AcceptedRRTypes
-- TODO: get all the resources in a single entry. -- TODO: get all the resources in a single entry.
-- Better that way: simpler code. -- Better that way: simpler code.
@ -227,8 +238,8 @@ default_domain = "netlib.re"
initialState :: Input -> State initialState :: Input -> State
initialState domain = initialState domain =
{ wsUp: true { wsUp: true
, active_modal: Nothing , deletion_modal: Nothing
, active_new_rr_modal: Nothing , rr_modal: Nothing
, _domain: domain , _domain: domain
@ -259,7 +270,7 @@ type SortableRecord l = Record (rrtype :: String, rrid :: Int | l)
render :: forall m. State -> H.ComponentHTML Action () m render :: forall m. State -> H.ComponentHTML Action () m
render state render state
= Bulma.section_small = Bulma.section_small
[ case state.wsUp, state.active_modal, state.active_new_rr_modal of [ case state.wsUp, state.deletion_modal, state.rr_modal of
false, _, _ -> Bulma.p "You are disconnected." false, _, _ -> Bulma.p "You are disconnected."
true, Just rr_id, _ -> modal_rr_delete rr_id true, Just rr_id, _ -> modal_rr_delete rr_id
true, Nothing, Just t -> modal_add_new_rr t true, Nothing, Just t -> modal_add_new_rr t
@ -311,7 +322,7 @@ render state
SRV -> template "SRV" content_srv (foot_content SRV) SRV -> template "SRV" content_srv (foot_content SRV)
where where
-- DRY -- DRY
updateForm x = UpdateNewRRForm <<< x updateForm x = UpdateCurrentlyDisplayedRRForm <<< x
render_errors = if A.length state._newRR_errors > 0 render_errors = if A.length state._newRR_errors > 0
then HH.div_ $ [ Bulma.h3 "Errors: " ] <> map error_to_paragraph state._newRR_errors then HH.div_ $ [ Bulma.h3 "Errors: " ] <> map error_to_paragraph state._newRR_errors
else HH.div_ [ ] else HH.div_ [ ]
@ -319,17 +330,17 @@ render state
content_simple t_ = content_simple t_ =
[ render_errors [ render_errors
, Bulma.box_input ("domain" <> t_) "Name" "www" -- id, title, placeholder , Bulma.box_input ("domain" <> t_) "Name" "www" -- id, title, placeholder
(updateForm Update_MODAL_Domain) -- action (updateForm Field_Domain) -- action
state._newRR.name -- value state._newRR.name -- value
state._newRR.valid -- validity (TODO) state._newRR.valid -- validity (TODO)
should_be_disabled -- condition should_be_disabled -- condition
, Bulma.box_input ("ttl" <> t_) "TTL" "600" , Bulma.box_input ("ttl" <> t_) "TTL" "600"
(updateForm Update_MODAL_TTL) (updateForm Field_TTL)
state._newRR.ttl state._newRR.ttl
state._newRR.valid state._newRR.valid
should_be_disabled should_be_disabled
, Bulma.box_input ("target" <> t_) "Target" "198.51.100.5" , Bulma.box_input ("target" <> t_) "Target" "198.51.100.5"
(updateForm Update_MODAL_Target) (updateForm Field_Target)
state._newRR.target state._newRR.target
state._newRR.valid state._newRR.valid
should_be_disabled should_be_disabled
@ -338,22 +349,22 @@ render state
content_mx = content_mx =
[ render_errors [ render_errors
, Bulma.box_input ("domainMX") "Name" "mail" -- id, title, placeholder , Bulma.box_input ("domainMX") "Name" "mail" -- id, title, placeholder
(updateForm Update_MODAL_Domain) -- action (updateForm Field_Domain) -- action
state._newRR.name -- value state._newRR.name -- value
state._newRR.valid -- validity (TODO) state._newRR.valid -- validity (TODO)
should_be_disabled -- condition should_be_disabled -- condition
, Bulma.box_input ("ttlMX") "TTL" "600" , Bulma.box_input ("ttlMX") "TTL" "600"
(updateForm Update_MODAL_TTL) (updateForm Field_TTL)
state._newRR.ttl state._newRR.ttl
state._newRR.valid state._newRR.valid
should_be_disabled should_be_disabled
, Bulma.box_input ("targetMX") "Target" "www" , Bulma.box_input ("targetMX") "Target" "www"
(updateForm Update_MODAL_Target) (updateForm Field_Target)
state._newRR.target state._newRR.target
state._newRR.valid state._newRR.valid
should_be_disabled should_be_disabled
, Bulma.box_input ("priorityMX") "Priority" "10" , Bulma.box_input ("priorityMX") "Priority" "10"
(updateForm Update_MODAL_Priority) (updateForm Field_Priority)
state._newRR.priority state._newRR.priority
state._newRR.valid state._newRR.valid
should_be_disabled should_be_disabled
@ -362,37 +373,37 @@ render state
content_srv = content_srv =
[ render_errors [ render_errors
, Bulma.box_input ("domainSRV") "Name" "_sip._tcp" -- id, title, placeholder , Bulma.box_input ("domainSRV") "Name" "_sip._tcp" -- id, title, placeholder
(updateForm Update_MODAL_Domain) -- action (updateForm Field_Domain) -- action
state._newRR.name -- value state._newRR.name -- value
state._newRR.valid -- validity (TODO) state._newRR.valid -- validity (TODO)
should_be_disabled -- condition should_be_disabled -- condition
, Bulma.box_input ("ttlSRV") "TTL" "600" , Bulma.box_input ("ttlSRV") "TTL" "600"
(updateForm Update_MODAL_TTL) (updateForm Field_TTL)
state._newRR.ttl state._newRR.ttl
state._newRR.valid state._newRR.valid
should_be_disabled should_be_disabled
, Bulma.box_input ("targetSRV") "Target" "www" , Bulma.box_input ("targetSRV") "Target" "www"
(updateForm Update_MODAL_Target) (updateForm Field_Target)
state._newRR.target state._newRR.target
state._newRR.valid state._newRR.valid
should_be_disabled should_be_disabled
, Bulma.box_input ("prioritySRV") "Priority" "10" , Bulma.box_input ("prioritySRV") "Priority" "10"
(updateForm Update_MODAL_Priority) (updateForm Field_Priority)
state._newRR.priority state._newRR.priority
state._newRR.valid state._newRR.valid
should_be_disabled should_be_disabled
, Bulma.box_input ("portSRV") "Port" "5061" , Bulma.box_input ("portSRV") "Port" "5061"
(updateForm Update_MODAL_Port) (updateForm Field_Port)
state._newRR.port state._newRR.port
state._newRR.valid state._newRR.valid
should_be_disabled should_be_disabled
, Bulma.box_input ("weightSRV") "Weight" "100" , Bulma.box_input ("weightSRV") "Weight" "100"
(updateForm Update_MODAL_Weight) (updateForm Field_Weight)
state._newRR.weight state._newRR.weight
state._newRR.valid state._newRR.valid
should_be_disabled should_be_disabled
, Bulma.box_input ("protocolSRV") "Protocol" "tcp" , Bulma.box_input ("protocolSRV") "Protocol" "tcp"
(updateForm Update_MODAL_Protocol) (updateForm Field_Protocol)
state._newRR.protocol state._newRR.protocol
state._newRR.valid state._newRR.valid
should_be_disabled should_be_disabled
@ -412,19 +423,26 @@ render state
handleAction :: forall m. MonadAff m => Action -> H.HalogenM State Action () Output m Unit handleAction :: forall m. MonadAff m => Action -> H.HalogenM State Action () Output m Unit
handleAction = case _ of handleAction = case _ of
-- | Cancel the current modal being presented. -- | Cancel the current modal being presented.
-- | Works for both "remove RR" and "new RR" modals. -- | Works for both "new RR", "update RR" and "remove RR" modals.
CancelModal -> do CancelModal -> do
H.modify_ _ { active_modal = Nothing, active_new_rr_modal = Nothing } H.modify_ _ { deletion_modal = Nothing, rr_modal = Nothing }
H.modify_ _ { _newRR_errors = [] } H.modify_ _ { _newRR_errors = [] }
-- | Create the RR modal. -- | Create the RR modal.
DeleteRRModal rr_id -> do DeleteRRModal rr_id -> do
H.modify_ _ { active_modal = Just rr_id } H.modify_ _ { deletion_modal = Just rr_id }
-- | Create modal (a form) for a resource record to update.
CreateUpdateRRModal rr_id -> do
state <- H.get
case first (\rr -> rr.rrid == rr_id) state._resources of
Nothing -> H.raise $ Log $ SimpleLog $ "RR not found (RR " <> show rr_id <> ")"
Just rr -> H.modify_ _ { _newRR = rr }
-- | Each time a "new RR" button is clicked, the form resets. -- | Each time a "new RR" button is clicked, the form resets.
NewRRModal t -> do CreateNewRRModal t -> do
state <- H.get state <- H.get
H.modify_ _ { active_new_rr_modal = Just t } H.modify_ _ { rr_modal = Just t }
let defaultA = { rrtype: "A", rrid: 0, modified: false, valid: true, ttl: "600", readonly: false let defaultA = { rrtype: "A", rrid: 0, modified: false, valid: true, ttl: "600", readonly: false
, name: "www" , name: "www"
, target: "192.0.2.1" , target: "192.0.2.1"
@ -470,33 +488,33 @@ handleAction = case _ of
H.raise $ MessageToSend message H.raise $ MessageToSend message
-- Update for the new RR form in the new RR modal. -- Update for the new RR form in the new RR modal.
UpdateNewRRForm rr_update -> case rr_update of UpdateCurrentlyDisplayedRRForm rr_update -> case rr_update of
Update_MODAL_Domain val -> do Field_Domain val -> do
-- H.raise $ Log $ SimpleLog ("Update new SRV entry name: " <> val) -- H.raise $ Log $ SimpleLog ("Update new SRV entry name: " <> val)
state <- H.get state <- H.get
H.modify_ _ { _newRR = state._newRR { name = val } } H.modify_ _ { _newRR = state._newRR { name = val } }
Update_MODAL_Target val -> do Field_Target val -> do
-- H.raise $ Log $ SimpleLog ("Update new SRV entry target: " <> val) -- H.raise $ Log $ SimpleLog ("Update new SRV entry target: " <> val)
state <- H.get state <- H.get
H.modify_ _ { _newRR = state._newRR { target = val } } H.modify_ _ { _newRR = state._newRR { target = val } }
-- TODO: FIXME: test all inputs -- TODO: FIXME: test all inputs
Update_MODAL_TTL val -> do Field_TTL val -> do
-- H.raise $ Log $ SimpleLog ("Update new SRV entry ttl: " <> val) -- H.raise $ Log $ SimpleLog ("Update new SRV entry ttl: " <> val)
state <- H.get state <- H.get
H.modify_ _ { _newRR = state._newRR {ttl = val, valid = isInteger val}} H.modify_ _ { _newRR = state._newRR {ttl = val, valid = isInteger val}}
Update_MODAL_Priority val -> do Field_Priority val -> do
-- H.raise $ Log $ SimpleLog ("Update new SRV entry priority: " <> val) -- H.raise $ Log $ SimpleLog ("Update new SRV entry priority: " <> val)
state <- H.get state <- H.get
H.modify_ _ { _newRR = state._newRR { priority = val } } H.modify_ _ { _newRR = state._newRR { priority = val } }
Update_MODAL_Protocol val -> do Field_Protocol val -> do
-- H.raise $ Log $ SimpleLog ("Update new SRV entry protocol: " <> val) -- H.raise $ Log $ SimpleLog ("Update new SRV entry protocol: " <> val)
state <- H.get state <- H.get
H.modify_ _ { _newRR = state._newRR { protocol = val } } H.modify_ _ { _newRR = state._newRR { protocol = val } }
Update_MODAL_Weight val -> do Field_Weight val -> do
-- H.raise $ Log $ SimpleLog ("Update new SRV entry weight: " <> val) -- H.raise $ Log $ SimpleLog ("Update new SRV entry weight: " <> val)
state <- H.get state <- H.get
H.modify_ _ { _newRR = state._newRR { weight = val } } H.modify_ _ { _newRR = state._newRR { weight = val } }
Update_MODAL_Port val -> do Field_Port val -> do
-- H.raise $ Log $ SimpleLog ("Update new SRV entry port: " <> val) -- H.raise $ Log $ SimpleLog ("Update new SRV entry port: " <> val)
state <- H.get state <- H.get
H.modify_ _ { _newRR = state._newRR { port = val } } H.modify_ _ { _newRR = state._newRR { port = val } }
@ -525,11 +543,16 @@ handleAction = case _ of
$ DNSManager.MkAddRR { domain: state._domain, rr: newrr } $ DNSManager.MkAddRR { domain: state._domain, rr: newrr }
H.raise $ MessageToSend message H.raise $ MessageToSend message
UpdateLocalForm entry -> do UpdateCurrentRR rr_id field -> do
state <- H.get state <- H.get
H.raise $ Log $ SimpleLog $ "Let's try to update entry number " <> show entry.rrid H.raise $ Log $ SimpleLog $ "Let's try to update entry number " <> show rr_id
let replaceRR rr1 rr2 | rr1.rrid == rr2.rrid = rr1 let replaceRR rr1 rr2 | rr1.rrid == rr2.rrid = rr1
| otherwise = rr2 | otherwise = rr2
maybeentry = first (\rr -> rr.rrid == rr_id) state._resources
case maybeentry of
Nothing -> H.raise $ Log $ SimpleLog ("Local Update Failed (RR " <> show rr_id <> ")")
Just entry -> do
let new_entry = update_field entry field
H.modify_ _ { _resources = (map (replaceRR entry) state._resources) } H.modify_ _ { _resources = (map (replaceRR entry) state._resources) }
UpdateLocalRR rr_id form -> case form of UpdateLocalRR rr_id form -> case form of
@ -614,9 +637,9 @@ handleAction = case _ of
Right rr -> do Right rr -> do
let new_error_hash = Hash.delete local_rr.rrid state._local_errors let new_error_hash = Hash.delete local_rr.rrid state._local_errors
H.modify_ _ { _local_errors = new_error_hash } H.modify_ _ { _local_errors = new_error_hash }
handleAction $ SaveLocal rr handleAction $ UpdateRR rr
SaveLocal rr -> do UpdateRR rr -> do
state <- H.get state <- H.get
H.raise $ Log $ SimpleLog $ "Updating RR " <> show rr.rrid H.raise $ Log $ SimpleLog $ "Updating RR " <> show rr.rrid
message <- H.liftEffect message <- H.liftEffect
@ -648,7 +671,7 @@ handleAction = case _ of
$ DNSManager.MkDeleteRR { domain: _domain, rrid: rr_id } $ DNSManager.MkDeleteRR { domain: _domain, rrid: rr_id }
H.raise $ MessageToSend message H.raise $ MessageToSend message
-- Modal doesn't need to be active anymore. -- Modal doesn't need to be active anymore.
H.modify_ _ { active_modal = Nothing } H.modify_ _ { deletion_modal = Nothing }
-- TODO: change the state to indicate problems? -- TODO: change the state to indicate problems?
TellSomethingWentWrong rr_id val -> do TellSomethingWentWrong rr_id val -> do
@ -982,13 +1005,13 @@ render_new_records _
, Bulma.hr , Bulma.hr
-- use "level" to get horizontal buttons next to each other (probably vertical on mobile) -- use "level" to get horizontal buttons next to each other (probably vertical on mobile)
, Bulma.level [ , Bulma.level [
Bulma.btn_add_new_rr (NewRRModal A) "A" Bulma.btn_add_new_rr (CreateNewRRModal A) "A"
, Bulma.btn_add_new_rr (NewRRModal AAAA) "AAAA" , Bulma.btn_add_new_rr (CreateNewRRModal AAAA) "AAAA"
, Bulma.btn_add_new_rr (NewRRModal TXT) "TXT" , Bulma.btn_add_new_rr (CreateNewRRModal TXT) "TXT"
, Bulma.btn_add_new_rr (NewRRModal CNAME) "CNAME" , Bulma.btn_add_new_rr (CreateNewRRModal CNAME) "CNAME"
, Bulma.btn_add_new_rr (NewRRModal NS) "NS" , Bulma.btn_add_new_rr (CreateNewRRModal NS) "NS"
, Bulma.btn_add_new_rr (NewRRModal MX) "MX" , Bulma.btn_add_new_rr (CreateNewRRModal MX) "MX"
, Bulma.btn_add_new_rr (NewRRModal SRV) "SRV" , Bulma.btn_add_new_rr (CreateNewRRModal SRV) "SRV"
] [] ] []
] ]
@ -1268,3 +1291,13 @@ show_error_txt e = case e of
Validation.TXTTooLong max n -> Validation.TXTTooLong max n ->
Bulma.p $ "An TXT field is limited to " <> show max <> " characters (currently there are " Bulma.p $ "An TXT field is limited to " <> show max <> " characters (currently there are "
<> show n <> " characters)." <> show n <> " characters)."
update_field :: SRVRR () -> Field -> SRVRR ()
update_field rr updated_field = case updated_field of
Field_Domain val -> rr { name = val }
Field_Target val -> rr { target = val }
Field_TTL val -> rr { ttl = val, valid = isInteger val }
Field_Priority val -> rr { priority = val }
Field_Protocol val -> rr { protocol = val }
Field_Weight val -> rr { weight = val }
Field_Port val -> rr { port = val }