Add "Protocol" attribute to SRV RR.

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
+-- RRId  Modified  Valid  Priority  Protocol Weight  Port  TTL  Domain  Value
-defaultResourceSRV = mkSRV 0 false true "10" "100" "80" "200" "www" "192.168.10.2"
+defaultResourceSRV = mkSRV 0 false true "10" "_tcp" "100" "80" "200" "www" "192.168.10.2"

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,8 +888,10 @@ fromResourceRecordToLocalRepresentationMXRR new_rr = do
 
 fromResourceRecordToLocalRepresentationSRVRR :: ResourceRecord -> Maybe (SRVRR ())
 fromResourceRecordToLocalRepresentationSRVRR new_rr = do
-  case new_rr.priority, new_rr.weight, new_rr.port of
+  port     <- new_rr.port
-    Just priority, Just weight, Just port ->
+  weight   <- new_rr.weight
+  priority <- new_rr.priority
+  protocol <- new_rr.protocol
   Just { t:         new_rr.rrtype
        , id:        new_rr.rrid
        , modified:  false
@@ -885,9 +902,8 @@ fromResourceRecordToLocalRepresentationSRVRR new_rr = do
        , priority:  show priority
        , port:      show port
        , weight:    show weight
-           -- , protocol:  protocol
+       , protocol:  protocol
        }
-    _, _, _ -> Nothing
 
 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

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