Add "Protocol" attribute to SRV RR.
This commit is contained in:
parent
f883dcd27a
commit
437722c323
@ -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"
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
Loading…
Reference in New Issue
Block a user