Protocol isn't a simple string anymore, but still WIP.

src/App/DisplayErrors.purs

@@ -40,7 +40,6 @@ error_to_paragraph v = Bulma.error_message (Bulma.p $ show_error_title v)
       ValidationDNS.VEPriority min max n -> Bulma.p $ "Priority should have a value between " <> show min <> " and " <> show max
                                          <> ", current value: " <> show n <> "."
       ValidationDNS.VESRV      err       -> maybe default_error show_error_domain err.error
-      ValidationDNS.VEProtocol err       -> maybe protocol_error show_error_protocol err.error
       ValidationDNS.VEPort min max n     -> Bulma.p $ "Port should have a value between " <> show min <> " and " <> show max
                                          <> ", current value: " <> show n <> "."
       ValidationDNS.VEWeight min max n   -> Bulma.p $ "Weight should have a value between " <> show min <> " and " <> show max
@@ -58,7 +57,6 @@ error_to_paragraph v = Bulma.error_message (Bulma.p $ show_error_title v)
       ValidationDNS.DKIMInvalidKeySize min max -> show_error_key_sizes min max
   )
   where default_error = Bulma.p ""
-        protocol_error = Bulma.p "Accepted protocols are: tcp, udp. You need more? Contact us."
 
 show_error_key_sizes :: forall w i. Int -> Int -> HH.HTML w i
 show_error_key_sizes min max
@@ -81,7 +79,6 @@ show_error_title v = case v of
   ValidationDNS.VEMX       _     -> "Invalid MX Target"
   ValidationDNS.VEPriority _ _ _ -> "Invalid Priority"
   ValidationDNS.VESRV      _     -> "Invalid SRV Target"
-  ValidationDNS.VEProtocol _     -> "Invalid Protocol"
   ValidationDNS.VEPort _ _ _     -> "Invalid Port"
   ValidationDNS.VEWeight _ _ _   -> "Invalid Weight"
   ValidationDNS.VECAAflag _ _ _  -> "Invalid CAA Flag"
@@ -109,10 +106,6 @@ show_error_domain e = case e of
            and must finish with either a letter or a digit.
          """
 
-show_error_protocol :: forall w i. ValidationDNS.ProtocolError -> HH.HTML w i
-show_error_protocol e = case e of
-  ValidationDNS.InvalidProtocol -> Bulma.p "Protocol should be a value as 'tcp' or 'udp'."
-
 show_error_ip6 :: forall w i. IPAddress.IPv6Error -> HH.HTML w i
 show_error_ip6 e = case e of
   IPAddress.IP6TooManyHexaDecimalCharacters ->

src/App/Page/Zone.purs

@@ -58,7 +58,8 @@ import App.Type.ResourceRecord (ResourceRecord, emptyRR
                           , show_modifier_type, show_modifier, to_modifier
                           , qualifiers
                           , mechanism_types, qualifier_types, modifier_types)
-import App.Type.ResourceRecord (Mechanism, Modifier, Qualifier(..)) as RR
+import App.Type.ResourceRecord (Mechanism, Modifier, Qualifier(..), SRVProtocol(..)
+                               , srv_protocols_txt, str_to_srv_protocol) as RR
 import App.Type.DKIM as DKIM
 import App.Type.DMARC as DMARC
 
@@ -99,7 +100,6 @@ data Field
   | Field_TTL       String
   | Field_Target    String
   | Field_Priority  String
-  | Field_Protocol  String
   | Field_Weight    String
   | Field_Port      String
   | Field_SPF_v          String
@@ -173,6 +173,8 @@ data Action
 
   | CAA_tag Int
 
+  | SRV_Protocol Int
+
   | SPF_Mechanism_q Int
   | SPF_Mechanism_t Int
   | SPF_Mechanism_v String
@@ -250,6 +252,8 @@ type State =
   , _currentRR_errors :: Array Validation.Error
   , _dmarc_mail_errors :: Array Email.Error
 
+  , srv_protocol    :: String -- :: RR.SRVProtocol
+
   -- SPF details.
   , spf_mechanism_q :: String
   , spf_mechanism_t :: String
@@ -310,6 +314,8 @@ initialState domain =
   , _dmarc_mail_errors: []
   , _zonefile: Nothing
 
+  , srv_protocol: "tcp" -- RR.TCP
+
   , spf_mechanism_q: "pass"
   , spf_mechanism_t: "a"
   , spf_mechanism_v: ""
@@ -478,9 +484,7 @@ render state
           , Bulma.box_input "domainSRV" "Service name" "service name"
               (updateForm Field_Domain)
               state._currentRR.name
-          , Bulma.box_input ("protocolSRV") "Protocol" "tcp"
+          , Bulma.selection_field "protocolSRV" "Protocol" SRV_Protocol RR.srv_protocols_txt state.srv_protocol
-              (updateForm Field_Protocol)
-              (fromMaybe "tcp" state._currentRR.protocol)
           , Bulma.box_input ("targetSRV") "Where the server is" "www"
               (updateForm Field_Target)
               state._currentRR.target
@@ -698,7 +702,8 @@ handleAction = case _ of
         default_rr_MX    = emptyRR { rrtype = "MX", name = "mail", target = "server1", priority = Just 10 }
         default_rr_CAA   = emptyRR { rrtype = "CAA", name = "", caa = Just default_caa }
         default_rr_SRV   = emptyRR { rrtype = "SRV", name = "voip", target = "server1"
-                                   , port = Just 5061, weight = Just 100, priority = Just 10, protocol = Just "tcp" }
+                                   , port = Just 5061, weight = Just 100, priority = Just 10
+                                   , protocol = Just RR.TCP }
         default_mechanisms = maybe [] (\x -> [x]) $ to_mechanism "pass" "mx" ""
         default_rr_SPF   = emptyRR { rrtype = "SPF", name = "", target = ""
                                    , mechanisms = Just default_mechanisms
@@ -746,6 +751,7 @@ handleAction = case _ of
     -- TODO: should the code design change? Would the code be simplified by working only on _currentRR.dkim?
     -- Since _currentRR.dkim isn't modified directly, it is copied from `State`.
     _ <- case t of
+           SRV  -> H.modify_ \state -> state { _currentRR { protocol = RR.str_to_srv_protocol state.srv_protocol }}
            DKIM -> H.modify_ \state -> state { _currentRR { dkim = Just state.dkim } }
            DMARC -> H.modify_ \state -> state { _currentRR { dmarc = Just state.dmarc } }
            _ -> pure unit
@@ -759,6 +765,7 @@ handleAction = case _ of
       Right newrr -> do
         H.modify_ _ { _currentRR_errors = []
                     , _dmarc_mail_errors = []
+                    , srv_protocol = "tcp"
                     , dkim = DKIM.emptyDKIMRR
                     , dmarc = DMARC.emptyDMARCRR
                     }
@@ -790,6 +797,7 @@ handleAction = case _ of
     -- Since _currentRR.dkim isn't modified directly, it is copied from `State`.
     state0 <- H.get
     _ <- case state0._currentRR.rrtype of
+           "SRV"   -> H.modify_ _ { _currentRR { protocol = RR.str_to_srv_protocol state0.srv_protocol }}
            "DKIM"  -> H.modify_ _ { _currentRR { dkim  = Just state0.dkim } }
            "DMARC" -> H.modify_ _ { _currentRR { dmarc = Just state0.dmarc } }
            _      -> pure unit
@@ -806,6 +814,7 @@ handleAction = case _ of
     H.modify_ _ { spf_mechanism_q = "pass"
                 , spf_mechanism_t = "a"
                 , spf_mechanism_v = ""
+                , srv_protocol    = "tcp"
                 , spf_modifier_t = "redirect"
                 , spf_modifier_v = ""
                 , dmarc_mail = ""
@@ -857,6 +866,8 @@ handleAction = case _ of
     let new_caa = (fromMaybe default_caa state._currentRR.caa) { tag = fromMaybe CAA.Issue $ CAA.tags A.!! v }
     H.modify_ _ { _currentRR { caa = Just new_caa } }
 
+  SRV_Protocol v    -> H.modify_ _ { srv_protocol    = maybe "tcp"      id $ RR.srv_protocols_txt A.!! v }
+
   SPF_Mechanism_q v -> H.modify_ _ { spf_mechanism_q = maybe "pass"     id $ qualifier_types A.!! v }
   SPF_Mechanism_t v -> H.modify_ _ { spf_mechanism_t = maybe "a"        id $ mechanism_types A.!! v }
   SPF_Mechanism_v v -> H.modify_ _ { spf_mechanism_v = v                                            }
@@ -1100,7 +1111,7 @@ render_resources records
         ]
       "SRV" ->
         [ HH.td_ [ Bulma.p rr.name ]
-        , HH.td_ [ Bulma.p $ maybe "" id rr.protocol ]
+        , HH.td_ [ Bulma.p $ maybe "tcp" show rr.protocol ]
         , HH.td_ [ Bulma.p rr.target ]
         , HH.td_ [ Bulma.p $ maybe "" show rr.port ]
         , HH.td_ [ Bulma.p $ show rr.ttl ]
@@ -1299,7 +1310,6 @@ update_field rr updated_field = case updated_field of
   Field_Target val           -> rr { target     = val }
   Field_TTL val              -> rr { ttl        = fromMaybe 0 (fromString val) }
   Field_Priority val         -> rr { priority   = fromString val }
-  Field_Protocol val         -> rr { protocol   = Just val }
   Field_Weight val           -> rr { weight     = fromString val }
   Field_Port val             -> rr { port       = fromString val }
   Field_SPF_v val            -> rr { v          = Just val }

src/App/Text/Explanations.purs

@@ -457,7 +457,7 @@ srv_introduction =
   , HH.p_ [ HH.text "For example, for a service named "
           , HH.u_ [HH.text "voip"]
           , HH.text " and given that this service uses the TCP protocol, the target "
-          , HH.u_ [HH.text "server1.example.com."]
+          , HH.u_ [HH.text "\"server1.example.com.\""]
           , HH.text " could be specified."
           ]
   ]

src/App/Type/ResourceRecord.purs

@@ -1,6 +1,10 @@
 module App.Type.ResourceRecord where
 
-import Prelude ((<>), map, bind, pure)
+import Prelude ((<>), map, bind, pure, class Show)
+-- import Data.String (toLower)
+import Data.Generic.Rep (class Generic)
+import App.Type.GenericSerialization (generic_serialization)
+import Data.Show.Generic (genericShow)
 
 import Data.Maybe (Maybe(..), maybe)
 
@@ -25,7 +29,7 @@ type ResourceRecord
 
     -- SRV specific entries.
     , port     :: Maybe Int
-    , protocol :: Maybe String
+    , protocol :: Maybe SRVProtocol
     , weight   :: Maybe Int
 
     -- SOA specific entries.
@@ -65,7 +69,7 @@ codec = CA.object "ResourceRecord"
 
     -- SRV specific entries.
     , port:     CAR.optional CA.int
-    , protocol: CAR.optional CA.string
+    , protocol: CAR.optional codecSRVProtocol
     , weight:   CAR.optional CA.int
 
     -- SOA specific entries.
@@ -257,3 +261,23 @@ show_qualifier = case _ of
   Neutral   -> "neutral"
   SoftFail  -> "soft_fail"
   HardFail  -> "hard_fail"
+
+data SRVProtocol = TCP | UDP
+-- srv_protocols :: Array SRVProtocol
+-- srv_protocols = [TCP, UDP]
+srv_protocols_txt :: Array String
+srv_protocols_txt = ["tcp", "udp"]
+
+derive instance genericSRVProtocol :: Generic SRVProtocol _
+instance showSRVProtocol :: Show SRVProtocol where
+  show = genericShow
+
+-- | Codec for just encoding a single value of type `Qualifier`.
+codecSRVProtocol :: CA.JsonCodec SRVProtocol
+codecSRVProtocol = CA.prismaticCodec "SRVProtocol" str_to_srv_protocol generic_serialization CA.string
+
+str_to_srv_protocol :: String -> Maybe SRVProtocol
+str_to_srv_protocol = case _ of
+  "tcp" -> Just TCP
+  "udp" -> Just UDP
+  _ -> Nothing

src/App/Validation/DNS.purs

@@ -50,7 +50,6 @@ data Error
   | VEMX (G.Error DomainParser.DomainError)
   | VEPriority Int Int Int
   | VESRV (G.Error DomainParser.DomainError)
-  | VEProtocol (G.Error ProtocolError)
   | VEPort Int Int Int
   | VEWeight Int Int Int
   | VEDMARCpct Int Int Int
@@ -84,7 +83,6 @@ max_weight   =  65535 :: Int
 
 type RRPriority = Maybe Int
 type RRPort     = Maybe Int
-type RRProtocol = Maybe String
 type RRWeight   = Maybe Int
 type RRMname    = Maybe String
 type RRRname    = Maybe String
@@ -156,13 +154,6 @@ validationNS form = ado
   target <- parse DomainParser.sub_eof form.target VENS
   in emptyRR { rrid = form.rrid, readonly = form.readonly, rrtype = "NS", name = name, ttl = ttl, target = target }
 
-data ProtocolError
-  = InvalidProtocol
-
-protocol_parser :: G.Parser ProtocolError String
-protocol_parser = do
-  G.string "tcp" <|> G.string "udp" G.<:> \_ -> InvalidProtocol
-
 is_between :: Int -> Int -> Int -> (Int -> Int -> Int -> Error) -> V (Array Error) Int
 is_between min max n ve = if between min max n
                           then pure n
@@ -183,12 +174,11 @@ validationSRV form = ado
   ttl      <- is_between min_ttl max_ttl form.ttl      VETTL
   target   <- parse DomainParser.sub_eof form.target   VESRV
   priority <- is_between min_priority max_priority (maybe 0 id form.priority) VEPriority
-  protocol <- parse protocol_parser      (maybe "" id   form.protocol)  VEProtocol
   port     <- is_between min_port max_port (maybe 0 id form.port)       VEPort
   weight   <- is_between min_weight max_weight (maybe 0 id form.weight) VEWeight
   in emptyRR { rrid = form.rrid, readonly = form.readonly, rrtype = "SRV"
              , name = name, ttl = ttl, target = target
-             , priority = Just priority, port = Just port, protocol = Just protocol, weight = Just weight }
+             , priority = Just priority, port = Just port, protocol = form.protocol, weight = Just weight }
 
 -- My version of "map" lol.
 verification_loop :: forall a e. (a -> V (Array e) a) -> Array a -> V (Array e) (Array a)