Validation: parsers for about everything. WIP.

src/App/Validation.purs

@@ -56,6 +56,14 @@ data ValidationError
   | VEName (G.Error DomainParser.DomainError)
   | VETTL (G.Error TTLError)
   | VETXT (G.Error TXTError)
+  | VECNAME (G.Error DomainParser.DomainError)
+  | VENS (G.Error DomainParser.DomainError)
+  | VEMX (G.Error DomainParser.DomainError)
+  | VEPriority (G.Error PriorityError)
+  | VESRV (G.Error DomainParser.DomainError)
+  | VEProtocol (G.Error ProtocolError)
+  | VEPort (G.Error PortError)
+  | VEWeight (G.Error WeightError)
 
 type AVErrors = Array ValidationError
 
@@ -329,7 +337,6 @@ validateSRVRR_ form = case form.rrtype of
   "SRV" -> validateSRV form
   _     -> invalid [Tuple NotAnAttribute $ "invalid type (expected: SRV): " <> form.rrtype]
 
-
 validateSRR :: forall l. SimpleRR (|l) -> Either Errors ResourceRecord
 validateSRR = toEither <<< validateSRR_
 
@@ -421,7 +428,7 @@ toRR_srv rrid readonly rrtype rrname ttl target priority port protocol weight
 
 data TTLError
   = NotInt
-  | NotBetween Int Int Int
+  | NotBetween Int Int Int -- min max value
 ttl_parser :: G.Parser TTLError Int
 ttl_parser = do pos <- G.current_position
                 n <- SomeParsers.nat <|> G.Parser \_ -> G.failureError pos (Just NotInt)
@@ -475,9 +482,91 @@ validationTXT form = ado
   target <- parse txt_parser form.target VETXT
   in toRR_basic form.rrid form.readonly "TXT" name ttl target
 
+validationCNAME :: forall l. SimpleRR (|l) -> V AVErrors ResourceRecord
+validationCNAME form = ado
+  name   <- parse DomainParser.sub_eof form.name VEName
+  ttl    <- parse ttl_parser form.ttl VETTL
+  target <- parse DomainParser.sub_eof form.target VECNAME
+  in toRR_basic form.rrid form.readonly "CNAME" name ttl target
+
+validationNS :: forall l. SimpleRR (|l) -> V AVErrors ResourceRecord
+validationNS form = ado
+  name   <- parse DomainParser.sub_eof form.name VEName
+  ttl    <- parse ttl_parser form.ttl VETTL
+  target <- parse DomainParser.sub_eof form.target VENS
+  in toRR_basic form.rrid form.readonly "NS" name ttl target
+
+data PriorityError
+  = PriorityNotInt
+  | PriorityNotBetween Int Int Int -- min max value
+
+priority_parser :: G.Parser PriorityError Int
+priority_parser = do
+  pos <- G.current_position
+  n <- SomeParsers.nat <|> G.Parser \_ -> G.failureError pos (Just PriorityNotInt)
+  if between min_priority max_priority n
+  then pure n
+  else G.Parser \_ -> G.failureError pos (Just $ PriorityNotBetween min_priority max_priority n)
+
+data ProtocolError
+  = InvalidProtocol
+  | ProtocolNotBetween Int Int Int -- min max value
+
+protocol_parser :: G.Parser ProtocolError String
+protocol_parser = do
+  pos <- G.current_position
+  G.string "tcp" <|> G.string "udp" <|> G.Parser \_ -> G.failureError pos (Just InvalidProtocol)
+
+data PortError
+  = PortNotInt
+  | PortNotBetween Int Int Int -- min max value
+
+port_parser :: G.Parser PortError Int
+port_parser = do
+  pos <- G.current_position
+  n <- SomeParsers.nat <|> G.Parser \_ -> G.failureError pos (Just PortNotInt)
+  if between min_port max_port n
+  then pure n
+  else G.Parser \_ -> G.failureError pos (Just $ PortNotBetween min_port max_port n)
+
+data WeightError
+  = WeightNotInt
+  | WeightNotBetween Int Int Int -- min max value
+
+weight_parser :: G.Parser WeightError Int
+weight_parser = do
+  pos <- G.current_position
+  n <- SomeParsers.nat <|> G.Parser \_ -> G.failureError pos (Just WeightNotInt)
+  if between min_weight max_weight n
+  then pure n
+  else G.Parser \_ -> G.failureError pos (Just $ WeightNotBetween min_weight max_weight n)
+
+validationMX :: forall l. MXRR (|l) -> V AVErrors ResourceRecord
+validationMX form = ado
+  name     <- parse DomainParser.sub_eof form.name     VEName
+  ttl      <- parse ttl_parser           form.ttl      VETTL
+  target   <- parse DomainParser.sub_eof form.target   VEMX
+  priority <- parse priority_parser      form.priority VEPriority
+  in toRR_mx form.rrid form.readonly "MX" name ttl target priority
+
+validationSRV :: forall l. SRVRR (|l) -> V AVErrors ResourceRecord
+validationSRV form = ado
+  name     <- parse DomainParser.sub_eof form.name     VEName
+  ttl      <- parse ttl_parser           form.ttl      VETTL
+  target   <- parse DomainParser.sub_eof form.target   VESRV
+  priority <- parse priority_parser      form.priority VEPriority
+  protocol <- parse protocol_parser      form.protocol VEProtocol
+  port     <- parse port_parser          form.port     VEPort
+  weight   <- parse weight_parser        form.weight   VEWeight
+  in toRR_srv form.rrid form.readonly "SRV" name ttl target priority port protocol weight
+
 validation :: forall l. SRVRR (|l) -> AcceptedRRTypes -> Either AVErrors ResourceRecord
 validation entry t = case t of
   A     -> toEither $ validationA     entry
   AAAA  -> toEither $ validationAAAA  entry
   TXT   -> toEither $ validationTXT   entry
-  _    -> toEither $ invalid [UNKNOWN]
+  CNAME -> toEither $ validationCNAME entry
+  NS    -> toEither $ validationNS    entry
+  MX    -> toEither $ validationMX    entry
+  SRV   -> toEither $ validationSRV   entry
+  --_    -> toEither $ invalid [UNKNOWN]

src/App/ZoneInterface.purs

@@ -306,7 +306,8 @@ render state
            ]
         content_mx :: Array (HH.HTML w Action)
         content_mx =
-           [ Bulma.box_input ("domainMX") "Name" "mail"   -- id, title, placeholder
+           [ render_errors
+           , Bulma.box_input ("domainMX") "Name" "mail"   -- id, title, placeholder
                (updateForm Update_MODAL_Domain)           -- action
                state._newRR.name                          -- value
                state._newRR.valid                         -- validity (TODO)
@@ -329,7 +330,8 @@ render state
            ]
         content_srv :: Array (HH.HTML w Action)
         content_srv =
-           [ Bulma.box_input ("domainSRV") "Name" "_sip._tcp"   -- id, title, placeholder
+           [ render_errors
+           , Bulma.box_input ("domainSRV") "Name" "_sip._tcp"   -- id, title, placeholder
                (updateForm Update_MODAL_Domain)                 -- action
                state._newRR.name                                -- value
                state._newRR.valid                               -- validity (TODO)
@@ -1055,3 +1057,11 @@ show_error v = case v of
   Validation.VEName     err -> "VEName pos: "      <> show err.position
   Validation.VETTL      err -> "VETTL pos: "       <> show err.position
   Validation.VETXT      err -> "VETXT pos: "       <> show err.position
+  Validation.VECNAME    err -> "VECNAME pos: "     <> show err.position
+  Validation.VENS       err -> "VENS pos: "        <> show err.position
+  Validation.VEMX       err -> "VEMX pos: "        <> show err.position
+  Validation.VEPriority err -> "VEPriority pos: "  <> show err.position
+  Validation.VESRV      err -> "VESRV pos: "       <> show err.position
+  Validation.VEProtocol err -> "VEProtocol pos: "  <> show err.position
+  Validation.VEPort     err -> "VEPort pos: "      <> show err.position
+  Validation.VEWeight   err -> "VEWeight pos: "    <> show err.position