diff --git a/src/App/DisplayErrors.purs b/src/App/DisplayErrors.purs index c016037..72c46a4 100644 --- a/src/App/DisplayErrors.purs +++ b/src/App/DisplayErrors.purs @@ -24,8 +24,15 @@ error_to_paragraph v = Bulma.error_message (Bulma.p $ show_error_title v) ValidationDNS.VEIPv4 err -> maybe default_error show_error_ip4 err.error ValidationDNS.VEIPv6 err -> maybe default_error show_error_ip6 err.error ValidationDNS.VEName err -> maybe default_error show_error_domain err.error - ValidationDNS.VETTL min max n -> Bulma.p $ "TTL should have a value between " <> show min <> " and " <> show max - <> ", current value: " <> show n <> "." + ValidationDNS.VETTL min max n -> + Bulma.p $ "TTL should have a value between " + <> show min <> " and " <> show max <> ", current value: " <> show n <> "." + ValidationDNS.VEDMARCpct min max n -> + Bulma.p $ "DMARC sample rate should have a value between " + <> show min <> " and " <> show max <> ", current value: " <> show n <> "." + ValidationDNS.VEDMARCri min max n -> + Bulma.p $ "DMARC report interval should have a value between " + <> show min <> " and " <> show max <> ", current value: " <> show n <> "." ValidationDNS.VETXT err -> maybe default_error show_error_txt err.error ValidationDNS.VECNAME err -> maybe default_error show_error_domain err.error ValidationDNS.VENS err -> maybe default_error show_error_domain err.error @@ -63,6 +70,8 @@ show_error_title v = case v of ValidationDNS.VEIPv6 _ -> "Invalid IPv6 address" ValidationDNS.VEName _ -> "Invalid Name (domain label)" ValidationDNS.VETTL _ _ _ -> "Invalid TTL" + ValidationDNS.VEDMARCpct _ _ _ -> "Invalid DMARC sample rate" + ValidationDNS.VEDMARCri _ _ _ -> "Invalid DMARC report interval" ValidationDNS.VETXT _ -> "Invalid TXT" ValidationDNS.VECNAME _ -> "Invalid CNAME" ValidationDNS.VENS _ -> "Invalid NS Target" diff --git a/src/App/Validation/DNS.purs b/src/App/Validation/DNS.purs index e3692f3..2283306 100644 --- a/src/App/Validation/DNS.purs +++ b/src/App/Validation/DNS.purs @@ -20,6 +20,7 @@ import GenericParser.IPAddress as IPAddress import GenericParser.RFC5234 as RFC5234 import App.Type.DKIM as DKIM +import App.Type.DMARC as DMARC -- | **History:** -- | The module once used dedicated types for each type of RR. @@ -51,6 +52,8 @@ data Error | VEProtocol (G.Error ProtocolError) | VEPort Int Int Int | VEWeight Int Int Int + | VEDMARCpct Int Int Int + | VEDMARCri Int Int Int -- SPF | VESPFMechanismName (G.Error DomainParser.DomainError) @@ -309,6 +312,20 @@ validationDKIM form = , name = name, ttl = ttl, target = "" -- `target` is discarded! , dkim = Just $ dkim { p = p } } +validationDMARC :: ResourceRecord -> V (Array Error) ResourceRecord +validationDMARC form = + let dmarc = fromMaybe DMARC.emptyDMARCRR form.dmarc + in ado + name <- parse DomainParser.sub_eof form.name VEName + ttl <- is_between min_ttl max_ttl form.ttl VETTL + pct <- is_between 0 100 (fromMaybe 100 dmarc.pct) VEDMARCpct + ri <- is_between 0 1000000 (fromMaybe 86400 dmarc.ri) VEDMARCri + -- No need to validate the target, actually, it will be completely discarded. + -- The different specific entries replace `target` completely. + in emptyRR { rrid = form.rrid, readonly = form.readonly, rrtype = "DMARC" + , name = name, ttl = ttl, target = "" -- `target` is discarded! + , dmarc = Just $ dmarc { pct = Just pct, ri = Just ri } } + validation :: ResourceRecord -> Either (Array Error) ResourceRecord validation entry = case entry.rrtype of "A" -> toEither $ validationA entry @@ -320,6 +337,7 @@ validation entry = case entry.rrtype of "SRV" -> toEither $ validationSRV entry "SPF" -> toEither $ validationSPF entry "DKIM" -> toEither $ validationDKIM entry + "DMARC" -> toEither $ validationDMARC entry _ -> toEither $ invalid [UNKNOWN] id :: forall a. a -> a