From 74f5718f99149474e3e30a284ccc7e7ee7d87022 Mon Sep 17 00:00:00 2001
From: Philippe Pittoli <karchnu@karchnu.fr>
Date: Thu, 7 Mar 2024 03:46:33 +0100
Subject: [PATCH] SPF: new validations of mechanisms. TODO: CIDR. Domain specs
 maybe someday.

---
 src/App/Validation/DNS.purs | 47 +++++++++++++++++++++++++++----------
 1 file changed, 35 insertions(+), 12 deletions(-)

diff --git a/src/App/Validation/DNS.purs b/src/App/Validation/DNS.purs
index 7c05bf7..8dd661a 100644
--- a/src/App/Validation/DNS.purs
+++ b/src/App/Validation/DNS.purs
@@ -199,21 +199,44 @@ or_nothing p = do v <- G.tryMaybe p
                     _,          Just _  -> pure ""
                     Nothing,    Nothing -> p -- at least give the right error results
 
+-- | `validate_SPF_mechanism` validates the different values for each mechanism.
+-- | A and MX can both either doesn't have a value or a domain name.
+-- | EXISTS requires a domain name.
+-- |
+-- | **What differs from RFC7208**:
+-- | Some features of the mechanisms described in RFC7208 are lacking.
+-- | For instance, INCLUDE, A, MX, PTR and EXISTS accept domain *specs* not simply domain *names*.
+-- | Also, some of them should accept a CIDR, which currently isn't a thing.
+-- |
+-- | TODO: I don't intend to implement the full RFC7208, but accepting CIDR can be done.
 validate_SPF_mechanism :: Mechanism -> V (Array Error) Mechanism
 validate_SPF_mechanism m = case m.t of
-  RR.A -> ado
-    name <- parse (or_nothing DomainParser.sub_eof) m.v VESPFMechanismName
+  -- RFC: `a         = "a"      [ ":" domain-spec ] [ dual-cidr-length ]`
+  RR.A       -> test (or_nothing DomainParser.sub_eof)          VESPFMechanismName
+
+  -- RFC: `mx        = "mx"     [ ":" domain-spec ] [ dual-cidr-length ]`
+  RR.MX      -> test (or_nothing DomainParser.sub_eof)          VESPFMechanismName
+
+  -- RFC: `exists    = "exists"   ":" domain-spec`
+  RR.EXISTS  -> test DomainParser.sub_eof                       VESPFMechanismName
+
+  -- RFC: `ptr       = "ptr"    [ ":" domain-spec ]`
+  RR.PTR     -> test (or_nothing DomainParser.sub_eof)          VESPFMechanismName
+
+  -- RFC: `ip4       = "ip4"      ":" ip4-network   [ ip4-cidr-length ]`
+  RR.IP4     -> test (IPAddress.ipv4_range <|> IPAddress.ipv4)  VESPFMechanismIPv4
+
+  -- RFC: `ip6       = "ip6"      ":" ip6-network   [ ip6-cidr-length ]`
+  RR.IP6     -> test (IPAddress.ipv6_range <|> IPAddress.ipv6)  VESPFMechanismIPv6
+
+  -- RFC: `include   = "include"  ":" domain-spec`
+  RR.INCLUDE -> test DomainParser.sub_eof                       VESPFMechanismName
+
+  where
+  test :: forall e. G.Parser e String -> ((G.Error e) -> Error) -> V (Array Error) Mechanism
+  test p e = ado
+    name <- parse p m.v e
     in first m name -- name is discarded
-  RR.MX -> ado
-    name <- parse (or_nothing DomainParser.sub_eof) m.v VESPFMechanismName
-    in first m name -- name is discarded
-  RR.IP4 -> ado
-    name <- parse (IPAddress.ipv4_range <|> IPAddress.ipv4) m.v VESPFMechanismIPv4
-    in first m name -- name is discarded
-  RR.IP6 -> ado
-    name <- parse (IPAddress.ipv6_range <|> IPAddress.ipv6) m.v VESPFMechanismIPv6
-    in first m name -- name is discarded
-  _ -> pure m
 
 validate_SPF_modifier :: Modifier -> V (Array Error) Modifier
 validate_SPF_modifier m = case m.t of