From da64f3d2a604bcd9032ee3947f713a54e5f3853c Mon Sep 17 00:00:00 2001
From: Philippe PITTOLI <karchnu@karchnu.fr>
Date: Sat, 8 Jun 2024 04:04:26 +0200
Subject: [PATCH] CAA: seems to work.

---
 src/App/DisplayErrors.purs  |  4 ++++
 src/App/Validation/DNS.purs | 18 ++++++++++++++++++
 2 files changed, 22 insertions(+)

diff --git a/src/App/DisplayErrors.purs b/src/App/DisplayErrors.purs
index 01965a5..581cc30 100644
--- a/src/App/DisplayErrors.purs
+++ b/src/App/DisplayErrors.purs
@@ -46,6 +46,9 @@ error_to_paragraph v = Bulma.error_message (Bulma.p $ show_error_title v)
       ValidationDNS.VEWeight min max n   -> Bulma.p $ "Weight should have a value between " <> show min <> " and " <> show max
                                          <> ", current value: " <> show n <> "."
 
+      ValidationDNS.VECAAflag min max n  -> Bulma.p $ "CAA flag should have a value between " <> show min <> " and " <> show max
+                                         <> ", current value: " <> show n <> "."
+
       -- SPF dedicated RR
       ValidationDNS.VESPFMechanismName err -> maybe default_error show_error_domain err.error
       ValidationDNS.VESPFMechanismIPv4 err -> maybe default_error show_error_ip4 err.error
@@ -81,6 +84,7 @@ show_error_title v = case v of
   ValidationDNS.VEProtocol _     -> "Invalid Protocol"
   ValidationDNS.VEPort _ _ _     -> "Invalid Port"
   ValidationDNS.VEWeight _ _ _   -> "Invalid Weight"
+  ValidationDNS.VECAAflag _ _ _  -> "Invalid CAA Flag"
 
   -- SPF dedicated RR
   ValidationDNS.VESPFMechanismName _ -> "The domain name in a SPF mechanism is wrong"
diff --git a/src/App/Validation/DNS.purs b/src/App/Validation/DNS.purs
index 209a964..637c6bd 100644
--- a/src/App/Validation/DNS.purs
+++ b/src/App/Validation/DNS.purs
@@ -21,6 +21,7 @@ import GenericParser.RFC5234 as RFC5234
 
 import App.Type.DKIM as DKIM
 import App.Type.DMARC as DMARC
+import App.Type.CAA as CAA
 
 -- | **History:**
 -- | The module once used dedicated types for each type of RR.
@@ -55,6 +56,8 @@ data Error
   | VEDMARCpct Int Int Int
   | VEDMARCri  Int Int Int
 
+  | VECAAflag  Int Int Int -- CAA flag should be between 0 and 255 (1 byte).
+
   -- SPF
   | VESPFMechanismName (G.Error DomainParser.DomainError)
   | VESPFMechanismIPv4 (G.Error IPAddress.IPv4Error)
@@ -326,6 +329,20 @@ validationDMARC form =
                , name = name, ttl = ttl, target = "" -- `target` is discarded!
                , dmarc = Just $ dmarc { pct = Just pct, ri = Just ri } }
 
+validationCAA :: ResourceRecord -> V (Array Error) ResourceRecord
+validationCAA form =
+  let caa = fromMaybe CAA.emptyCAARR form.caa
+  in ado
+    name     <- parse DomainParser.sub_eof form.name  VEName
+    ttl      <- is_between min_ttl max_ttl form.ttl   VETTL
+    flag     <- is_between 0 255           caa.flag   VECAAflag
+    -- TODO: verify the `value` field.
+    -- 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 = "CAA"
+               , name = name, ttl = ttl, target = "" -- `target` is discarded!
+               , caa = Just $ caa { flag = flag } }
+
 validation :: ResourceRecord -> Either (Array Error) ResourceRecord
 validation entry = case entry.rrtype of
   "A"     -> toEither $ validationA     entry
@@ -334,6 +351,7 @@ validation entry = case entry.rrtype of
   "CNAME" -> toEither $ validationCNAME entry
   "NS"    -> toEither $ validationNS    entry
   "MX"    -> toEither $ validationMX    entry
+  "CAA"   -> toEither $ validationCAA   entry
   "SRV"   -> toEither $ validationSRV   entry
   "SPF"   -> toEither $ validationSPF   entry
   "DKIM"  -> toEither $ validationDKIM  entry