Accept wildcards.
This commit is contained in:
		
							parent
							
								
									b500679444
								
							
						
					
					
						commit
						0296f27e27
					
				
					 1 changed files with 18 additions and 12 deletions
				
			
		|  | @ -15,7 +15,7 @@ import App.Type.ResourceRecord (MechanismType(..), ModifierType(..)) as RR | ||||||
| import GenericParser.SomeParsers as SomeParsers | import GenericParser.SomeParsers as SomeParsers | ||||||
| import GenericParser.Parser as G | import GenericParser.Parser as G | ||||||
| import GenericParser.DomainParser.Common (DomainError) as DomainParser | import GenericParser.DomainParser.Common (DomainError) as DomainParser | ||||||
| import GenericParser.DomainParser (sub_eof) as DomainParser | import GenericParser.DomainParser (wildcard, wildcard_eof, sub_eof) as DomainParser | ||||||
| import GenericParser.IPAddress as IPAddress | import GenericParser.IPAddress as IPAddress | ||||||
| import GenericParser.RFC5234 as RFC5234 | import GenericParser.RFC5234 as RFC5234 | ||||||
| 
 | 
 | ||||||
|  | @ -23,6 +23,10 @@ import App.Type.DKIM as DKIM | ||||||
| import App.Type.DMARC as DMARC | import App.Type.DMARC as DMARC | ||||||
| import App.Type.CAA as CAA | import App.Type.CAA as CAA | ||||||
| 
 | 
 | ||||||
|  | -- | `name_parser` parses `name` attributes of RRs. | ||||||
|  | name_parser :: G.Parser DomainParser.DomainError String | ||||||
|  | name_parser = DomainParser.wildcard <|> DomainParser.wildcard_eof <|> DomainParser.sub_eof | ||||||
|  | 
 | ||||||
| -- | **History:** | -- | **History:** | ||||||
| -- | The module once used dedicated types for each type of RR. | -- | The module once used dedicated types for each type of RR. | ||||||
| -- | That comes with several advantages. | -- | That comes with several advantages. | ||||||
|  | @ -118,7 +122,7 @@ parse (G.Parser p) str c = case p { string: str, position: 0 } of | ||||||
| 
 | 
 | ||||||
| validationA :: ResourceRecord -> V (Array Error) ResourceRecord | validationA :: ResourceRecord -> V (Array Error) ResourceRecord | ||||||
| validationA form = ado | validationA form = ado | ||||||
|   name   <- parse DomainParser.sub_eof form.name   VEName |   name   <- parse name_parser form.name   VEName | ||||||
|   ttl    <- is_between min_ttl max_ttl form.ttl    VETTL |   ttl    <- is_between min_ttl max_ttl form.ttl    VETTL | ||||||
|   target <- parse IPAddress.ipv4       form.target VEIPv4 |   target <- parse IPAddress.ipv4       form.target VEIPv4 | ||||||
|   in emptyRR { rrid = form.rrid, readonly = form.readonly, rrtype = "A", name = name, ttl = ttl, target = target |   in emptyRR { rrid = form.rrid, readonly = form.readonly, rrtype = "A", name = name, ttl = ttl, target = target | ||||||
|  | @ -126,7 +130,7 @@ validationA form = ado | ||||||
| 
 | 
 | ||||||
| validationAAAA :: ResourceRecord -> V (Array Error) ResourceRecord | validationAAAA :: ResourceRecord -> V (Array Error) ResourceRecord | ||||||
| validationAAAA form = ado | validationAAAA form = ado | ||||||
|   name   <- parse DomainParser.sub_eof form.name VEName |   name   <- parse name_parser form.name VEName | ||||||
|   ttl    <- is_between min_ttl max_ttl form.ttl  VETTL |   ttl    <- is_between min_ttl max_ttl form.ttl  VETTL | ||||||
|   -- use read_input to get unaltered input (the IPv6 parser expands the input) |   -- use read_input to get unaltered input (the IPv6 parser expands the input) | ||||||
|   target <- parse (G.read_input IPAddress.ipv6) form.target VEIPv6 |   target <- parse (G.read_input IPAddress.ipv6) form.target VEIPv6 | ||||||
|  | @ -135,21 +139,21 @@ validationAAAA form = ado | ||||||
| 
 | 
 | ||||||
| validationTXT :: ResourceRecord -> V (Array Error) ResourceRecord | validationTXT :: ResourceRecord -> V (Array Error) ResourceRecord | ||||||
| validationTXT form = ado | validationTXT form = ado | ||||||
|   name   <- parse DomainParser.sub_eof form.name   VEName |   name   <- parse name_parser form.name   VEName | ||||||
|   ttl    <- is_between min_ttl max_ttl form.ttl    VETTL |   ttl    <- is_between min_ttl max_ttl form.ttl    VETTL | ||||||
|   target <- parse txt_parser           form.target VETXT |   target <- parse txt_parser           form.target VETXT | ||||||
|   in emptyRR { rrid = form.rrid, readonly = form.readonly, rrtype = "TXT", name = name, ttl = ttl, target = target } |   in emptyRR { rrid = form.rrid, readonly = form.readonly, rrtype = "TXT", name = name, ttl = ttl, target = target } | ||||||
| 
 | 
 | ||||||
| validationCNAME :: ResourceRecord -> V (Array Error) ResourceRecord | validationCNAME :: ResourceRecord -> V (Array Error) ResourceRecord | ||||||
| validationCNAME form = ado | validationCNAME form = ado | ||||||
|   name   <- parse DomainParser.sub_eof form.name VEName |   name   <- parse name_parser form.name VEName | ||||||
|   ttl    <- is_between min_ttl max_ttl form.ttl      VETTL |   ttl    <- is_between min_ttl max_ttl form.ttl      VETTL | ||||||
|   target <- parse DomainParser.sub_eof form.target VECNAME |   target <- parse DomainParser.sub_eof form.target VECNAME | ||||||
|   in emptyRR { rrid = form.rrid, readonly = form.readonly, rrtype = "CNAME", name = name, ttl = ttl, target = target } |   in emptyRR { rrid = form.rrid, readonly = form.readonly, rrtype = "CNAME", name = name, ttl = ttl, target = target } | ||||||
| 
 | 
 | ||||||
| validationNS :: ResourceRecord -> V (Array Error) ResourceRecord | validationNS :: ResourceRecord -> V (Array Error) ResourceRecord | ||||||
| validationNS form = ado | validationNS form = ado | ||||||
|   name   <- parse DomainParser.sub_eof form.name   VEName |   name   <- parse name_parser form.name   VEName | ||||||
|   ttl    <- is_between min_ttl max_ttl form.ttl    VETTL |   ttl    <- is_between min_ttl max_ttl form.ttl    VETTL | ||||||
|   target <- parse DomainParser.sub_eof form.target VENS |   target <- parse DomainParser.sub_eof form.target VENS | ||||||
|   in emptyRR { rrid = form.rrid, readonly = form.readonly, rrtype = "NS", name = name, ttl = ttl, target = target } |   in emptyRR { rrid = form.rrid, readonly = form.readonly, rrtype = "NS", name = name, ttl = ttl, target = target } | ||||||
|  | @ -161,7 +165,7 @@ is_between min max n ve = if between min max n | ||||||
| 
 | 
 | ||||||
| validationMX :: ResourceRecord -> V (Array Error) ResourceRecord | validationMX :: ResourceRecord -> V (Array Error) ResourceRecord | ||||||
| validationMX form = ado | validationMX form = ado | ||||||
|   name     <- parse DomainParser.sub_eof form.name     VEName |   name     <- parse name_parser form.name     VEName | ||||||
|   ttl      <- is_between min_ttl max_ttl form.ttl      VETTL |   ttl      <- is_between min_ttl max_ttl form.ttl      VETTL | ||||||
|   target   <- parse DomainParser.sub_eof form.target   VEMX |   target   <- parse DomainParser.sub_eof form.target   VEMX | ||||||
|   priority <- is_between min_priority max_priority (maybe 0 id form.priority) VEPriority |   priority <- is_between min_priority max_priority (maybe 0 id form.priority) VEPriority | ||||||
|  | @ -170,7 +174,7 @@ validationMX form = ado | ||||||
| 
 | 
 | ||||||
| validationSRV :: ResourceRecord -> V (Array Error) ResourceRecord | validationSRV :: ResourceRecord -> V (Array Error) ResourceRecord | ||||||
| validationSRV form = ado | validationSRV form = ado | ||||||
|   name     <- parse DomainParser.sub_eof form.name     VEName |   name     <- parse name_parser form.name     VEName | ||||||
|   ttl      <- is_between min_ttl max_ttl form.ttl      VETTL |   ttl      <- is_between min_ttl max_ttl form.ttl      VETTL | ||||||
|   target   <- parse DomainParser.sub_eof form.target   VESRV |   target   <- parse DomainParser.sub_eof form.target   VESRV | ||||||
|   priority <- is_between min_priority max_priority (maybe 0 id form.priority) VEPriority |   priority <- is_between min_priority max_priority (maybe 0 id form.priority) VEPriority | ||||||
|  | @ -252,7 +256,7 @@ validate_SPF_modifier m = case m.t of | ||||||
| 
 | 
 | ||||||
| validationSPF :: ResourceRecord -> V (Array Error) ResourceRecord | validationSPF :: ResourceRecord -> V (Array Error) ResourceRecord | ||||||
| validationSPF form = ado | validationSPF form = ado | ||||||
|   name     <- parse DomainParser.sub_eof form.name     VEName |   name     <- parse name_parser form.name     VEName | ||||||
|   ttl      <- is_between min_ttl max_ttl form.ttl      VETTL |   ttl      <- is_between min_ttl max_ttl form.ttl      VETTL | ||||||
|   mechanisms <- verification_loop validate_SPF_mechanism (maybe [] id form.mechanisms) |   mechanisms <- verification_loop validate_SPF_mechanism (maybe [] id form.mechanisms) | ||||||
|   modifiers  <- verification_loop validate_SPF_modifier  (maybe [] id form.modifiers) |   modifiers  <- verification_loop validate_SPF_modifier  (maybe [] id form.modifiers) | ||||||
|  | @ -295,7 +299,7 @@ validationDKIM :: ResourceRecord -> V (Array Error) ResourceRecord | ||||||
| validationDKIM form = | validationDKIM form = | ||||||
|   let dkim = fromMaybe DKIM.emptyDKIMRR form.dkim |   let dkim = fromMaybe DKIM.emptyDKIMRR form.dkim | ||||||
|   in ado |   in ado | ||||||
|     name     <- parse DomainParser.sub_eof form.name     VEName |     name     <- parse name_parser form.name     VEName | ||||||
|     ttl      <- is_between min_ttl max_ttl form.ttl      VETTL |     ttl      <- is_between min_ttl max_ttl form.ttl      VETTL | ||||||
|     -- TODO: v n |     -- TODO: v n | ||||||
|     p        <- verify_public_key (fromMaybe DKIM.RSA dkim.k) dkim.p |     p        <- verify_public_key (fromMaybe DKIM.RSA dkim.k) dkim.p | ||||||
|  | @ -309,7 +313,7 @@ validationDMARC :: ResourceRecord -> V (Array Error) ResourceRecord | ||||||
| validationDMARC form = | validationDMARC form = | ||||||
|   let dmarc = fromMaybe DMARC.emptyDMARCRR form.dmarc |   let dmarc = fromMaybe DMARC.emptyDMARCRR form.dmarc | ||||||
|   in ado |   in ado | ||||||
|     name     <- parse DomainParser.sub_eof form.name     VEName |     name     <- parse name_parser form.name     VEName | ||||||
|     ttl      <- is_between min_ttl max_ttl form.ttl      VETTL |     ttl      <- is_between min_ttl max_ttl form.ttl      VETTL | ||||||
|     pct      <- is_between 0 100      (fromMaybe 100   dmarc.pct) VEDMARCpct |     pct      <- is_between 0 100      (fromMaybe 100   dmarc.pct) VEDMARCpct | ||||||
|     ri       <- is_between 0 1000000  (fromMaybe 86400 dmarc.ri)  VEDMARCri |     ri       <- is_between 0 1000000  (fromMaybe 86400 dmarc.ri)  VEDMARCri | ||||||
|  | @ -323,7 +327,7 @@ validationCAA :: ResourceRecord -> V (Array Error) ResourceRecord | ||||||
| validationCAA form = | validationCAA form = | ||||||
|   let caa = fromMaybe CAA.emptyCAARR form.caa |   let caa = fromMaybe CAA.emptyCAARR form.caa | ||||||
|   in ado |   in ado | ||||||
|     name     <- parse DomainParser.sub_eof form.name  VEName |     name     <- parse name_parser form.name  VEName | ||||||
|     ttl      <- is_between min_ttl max_ttl form.ttl   VETTL |     ttl      <- is_between min_ttl max_ttl form.ttl   VETTL | ||||||
|     flag     <- is_between 0 255           caa.flag   VECAAflag |     flag     <- is_between 0 255           caa.flag   VECAAflag | ||||||
|     -- TODO: verify the `value` field. |     -- TODO: verify the `value` field. | ||||||
|  | @ -333,6 +337,8 @@ validationCAA form = | ||||||
|                , name = name, ttl = ttl, target = "" -- `target` is discarded! |                , name = name, ttl = ttl, target = "" -- `target` is discarded! | ||||||
|                , caa = Just $ caa { flag = flag } } |                , caa = Just $ caa { flag = flag } } | ||||||
| 
 | 
 | ||||||
|  | 
 | ||||||
|  | -- | `validation` provides a way to validate the content of a RR. | ||||||
| validation :: ResourceRecord -> Either (Array Error) ResourceRecord | validation :: ResourceRecord -> Either (Array Error) ResourceRecord | ||||||
| validation entry = case entry.rrtype of | validation entry = case entry.rrtype of | ||||||
|   "A"     -> toEither $ validationA     entry |   "A"     -> toEither $ validationA     entry | ||||||
|  |  | ||||||
		Loading…
	
	Add table
		
		Reference in a new issue