From 437722c3239ce531c8d77ceb90216b99c7efe8bf Mon Sep 17 00:00:00 2001 From: Philippe Pittoli Date: Wed, 12 Jul 2023 01:38:21 +0200 Subject: [PATCH] Add "Protocol" attribute to SRV RR. --- src/App/RR.purs | 12 ++++++---- src/App/ZoneInterface.purs | 48 +++++++++++++++++++++++++------------- src/Bulma.purs | 17 ++++++++++++++ 3 files changed, 56 insertions(+), 21 deletions(-) diff --git a/src/App/RR.purs b/src/App/RR.purs index afe6738..9e8cdfd 100644 --- a/src/App/RR.purs +++ b/src/App/RR.purs @@ -14,6 +14,7 @@ type TTL = String type Weight = String type Priority = String type Port = String +type Protocol = String type RRId = Int @@ -35,6 +36,7 @@ type SimpleRR l = RecordBase (|l) type MXRR l = RecordBase ( priority :: Priority | l) type SRVRR l = RecordBase ( priority :: Priority + , protocol :: Protocol , weight :: Weight , port :: Port | l) @@ -113,11 +115,11 @@ mkMX i c ok t d v p , ttl: t, priority: p, domain: d, value: v } mkSRV :: RRId -> Modified -> Valid - -> Priority -> Weight -> Port + -> Priority -> Protocol -> Weight -> Port -> TTL -> RecordDomain -> RecordValue -> SRVRR () -mkSRV i c ok p w prt t d v +mkSRV i c ok p prot w prt t d v = { id: i, t: "SRV", modified: c - , valid: ok, priority: p, weight: w, port: prt + , valid: ok, priority: p, protocol: prot, weight: w, port: prt , ttl: t, domain: d, value: v } @@ -143,5 +145,5 @@ defaultResourceMX :: MXRR () defaultResourceMX = mkMX 0 false true "500" "www" "192.168.10.2" "200" defaultResourceSRV :: SRVRR () --- RRId Modified Valid Priority Weight Port TTL Domain Value -defaultResourceSRV = mkSRV 0 false true "10" "100" "80" "200" "www" "192.168.10.2" +-- RRId Modified Valid Priority Protocol Weight Port TTL Domain Value +defaultResourceSRV = mkSRV 0 false true "10" "_tcp" "100" "80" "200" "www" "192.168.10.2" diff --git a/src/App/ZoneInterface.purs b/src/App/ZoneInterface.purs index 59a0838..fa624ad 100644 --- a/src/App/ZoneInterface.purs +++ b/src/App/ZoneInterface.purs @@ -94,6 +94,7 @@ data Update_SRV_Form | Update_SRV_TTL TTL | Update_SRV_Value RecordValue | Update_SRV_Priority Priority + | Update_SRV_Protocol Protocol | Update_SRV_Weight Weight | Update_SRV_Port Port @@ -296,6 +297,10 @@ handleAction = case _ of -- H.raise $ Log $ SimpleLog ("Update new SRV entry priority: " <> val) state <- H.get H.modify_ _ { _current_entry_srv = state._current_entry_srv { priority = val } } + Update_SRV_Protocol val -> do + -- H.raise $ Log $ SimpleLog ("Update new SRV entry protocol: " <> val) + state <- H.get + H.modify_ _ { _current_entry_srv = state._current_entry_srv { protocol = val } } Update_SRV_Weight val -> do -- H.raise $ Log $ SimpleLog ("Update new SRV entry weight: " <> val) state <- H.get @@ -390,6 +395,10 @@ handleAction = case _ of -- H.raise $ Log $ SimpleLog ("Update local SRV " <> show rr_id <> " entry priority: " <> val) state <- H.get H.modify_ _ { _srvrr = (update_priority rr_id val state._srvrr) } + Update_SRV_Protocol val -> do + -- H.raise $ Log $ SimpleLog ("Update new SRV entry protocol: " <> val) + state <- H.get + H.modify_ _ { _srvrr = (update_protocol rr_id val state._srvrr) } Update_SRV_Weight val -> do -- H.raise $ Log $ SimpleLog ("Update local SRV " <> show rr_id <> " entry weight: " <> val) state <- H.get @@ -633,6 +642,7 @@ render_srv_records records [ HH.td_ [ Bulma.input_domain ((UpdateLocalSRVForm rr.id) <<< Update_SRV_Domain ) rr.domain rr.valid ] , HH.td_ [ Bulma.input_ttl ((UpdateLocalSRVForm rr.id) <<< Update_SRV_TTL ) rr.ttl rr.valid ] , HH.td_ [ Bulma.input_priority ((UpdateLocalSRVForm rr.id) <<< Update_SRV_Priority) rr.priority rr.valid ] + , HH.td_ [ Bulma.input_protocol ((UpdateLocalSRVForm rr.id) <<< Update_SRV_Protocol) rr.protocol rr.valid ] , HH.td_ [ Bulma.input_weight ((UpdateLocalSRVForm rr.id) <<< Update_SRV_Weight ) rr.weight rr.valid ] , HH.td_ [ Bulma.input_port ((UpdateLocalSRVForm rr.id) <<< Update_SRV_Port ) rr.port rr.valid ] , HH.td_ [ Bulma.input_value ((UpdateLocalSRVForm rr.id) <<< Update_SRV_Value ) rr.value rr.valid ] @@ -702,6 +712,7 @@ render_srv_new_record rr [ HH.td_ [ Bulma.input_domain (UpdateNewSRVForm <<< Update_SRV_Domain) rr.domain rr.valid ] , HH.td_ [ Bulma.input_ttl (UpdateNewSRVForm <<< Update_SRV_TTL) rr.ttl rr.valid ] , HH.td_ [ Bulma.input_priority (UpdateNewSRVForm <<< Update_SRV_Priority) rr.priority rr.valid ] + , HH.td_ [ Bulma.input_protocol (UpdateNewSRVForm <<< Update_SRV_Protocol) rr.protocol rr.valid ] , HH.td_ [ Bulma.input_weight (UpdateNewSRVForm <<< Update_SRV_Weight) rr.weight rr.valid ] , HH.td_ [ Bulma.input_port (UpdateNewSRVForm <<< Update_SRV_Port) rr.port rr.valid ] , HH.td_ [ Bulma.input_value (UpdateNewSRVForm <<< Update_SRV_Value) rr.value rr.valid ] @@ -769,6 +780,7 @@ render_new_record_colunm_srv rr , Bulma.box_input_domain (UpdateNewSRVForm <<< Update_SRV_Domain) rr.domain rr.valid , Bulma.box_input_ttl (UpdateNewSRVForm <<< Update_SRV_TTL) rr.ttl rr.valid , Bulma.box_input_priority (UpdateNewSRVForm <<< Update_SRV_Priority) rr.priority rr.valid + , Bulma.box_input_protocol (UpdateNewSRVForm <<< Update_SRV_Protocol) rr.protocol rr.valid , Bulma.box_input_weight (UpdateNewSRVForm <<< Update_SRV_Weight) rr.weight rr.valid , Bulma.box_input_port (UpdateNewSRVForm <<< Update_SRV_Port) rr.port rr.valid , Bulma.box_input_value (UpdateNewSRVForm <<< Update_SRV_Value) rr.value rr.valid @@ -823,6 +835,9 @@ update_ttl rr_id val update_priority :: forall (l :: Row Type). Int -> Priority -> Array (MXRR l) -> Array (MXRR l) update_priority rr_id val = update (\rr -> rr { modified = true, priority = val}) rr_id +update_protocol :: forall (l :: Row Type). Int -> Protocol -> Array (SRVRR l) -> Array (SRVRR l) +update_protocol rr_id val = update (\rr -> rr { modified = true, protocol = val}) rr_id + update_weight :: forall (l :: Row Type). Int -> Priority -> Array (SRVRR l) -> Array (SRVRR l) update_weight rr_id val = update (\rr -> rr { modified = true, weight = val}) rr_id @@ -873,21 +888,22 @@ fromResourceRecordToLocalRepresentationMXRR new_rr = do fromResourceRecordToLocalRepresentationSRVRR :: ResourceRecord -> Maybe (SRVRR ()) fromResourceRecordToLocalRepresentationSRVRR new_rr = do - case new_rr.priority, new_rr.weight, new_rr.port of - Just priority, Just weight, Just port -> - Just { t: new_rr.rrtype - , id: new_rr.rrid - , modified: false - , valid: true - , ttl: show new_rr.ttl - , domain: new_rr.name - , value: new_rr.target - , priority: show priority - , port: show port - , weight: show weight - -- , protocol: protocol - } - _, _, _ -> Nothing + port <- new_rr.port + weight <- new_rr.weight + priority <- new_rr.priority + protocol <- new_rr.protocol + Just { t: new_rr.rrtype + , id: new_rr.rrid + , modified: false + , valid: true + , ttl: show new_rr.ttl + , domain: new_rr.name + , value: new_rr.target + , priority: show priority + , port: show port + , weight: show weight + , protocol: protocol + } fromResourceRecordToLocalRepresentationSOARR :: ResourceRecord -> Maybe (SOARR ()) fromResourceRecordToLocalRepresentationSOARR new_rr = do @@ -966,7 +982,7 @@ fromLocalSRVRRepresentationToResourceRecord form , readonly: false , priority: Just $ fromMaybe 10 $ fromString form.priority , port: Just $ fromMaybe 10 $ fromString form.port - , protocol: Just "" -- TODO: 'protocol' seems to have been forgotten. + , protocol: Just form.protocol , weight: Just $ fromMaybe 10 $ fromString form.weight , mname: Nothing , rname: Nothing diff --git a/src/Bulma.purs b/src/Bulma.purs index c25b980..28d195d 100644 --- a/src/Bulma.purs +++ b/src/Bulma.purs @@ -83,6 +83,7 @@ srv_table_header = HH.thead_ [ HH.tr_ [ HH.th_ [ HH.text "Domain" ] , HH.th_ [ HH.text "TTL" ] , HH.th_ [ HH.text "Priority" ] + , HH.th_ [ HH.text "Protocol" ] , HH.th_ [ HH.text "Weight" ] , HH.th_ [ HH.text "Port" ] , HH.th_ [ HH.text "Value" ] @@ -183,6 +184,22 @@ box_input_priority action value validity = HH.label [ ] , HH.div [HP.classes C.control ] [ input_priority action value validity ] ] +input_protocol :: forall w i. (String -> i) -> String -> Boolean -> HH.HTML w i +input_protocol action protocol validity + = HH.input + [ HE.onValueInput action + , HP.value protocol + , MissingProperties.size 6 + , HP.placeholder "_tcp" + , HP.classes $ input_classes validity + ] + +box_input_protocol :: forall w i. (String -> i) -> String -> Boolean -> HH.HTML w i +box_input_protocol action value validity = HH.label [ ] + [ HH.label [HP.classes C.label ] [ HH.text "Protocol" ] + , HH.div [HP.classes C.control ] [ input_protocol action value validity ] + ] + input_value :: forall w i. (String -> i) -> String -> Boolean -> HH.HTML w i input_value action value validity = HH.input