karchnu
/
halogen-websocket-ipc-playzone
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Add "Protocol" attribute to SRV RR.

beta
Philippe Pittoli 2023-07-12 01:38:21 +02:00
parent f883dcd27a
commit 437722c323
3 changed files with 56 additions and 21 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

12
src/App/RR.purs
View File

@ -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"

48
src/App/ZoneInterface.purs
View File

@ -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

17
src/Bulma.purs
View File

@ -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