CAA: seems to work.
This commit is contained in:
		
							parent
							
								
									bf2da895e0
								
							
						
					
					
						commit
						da64f3d2a6
					
				
					 2 changed files with 22 additions and 0 deletions
				
			
		| 
						 | 
				
			
			@ -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"
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -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
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
		Loading…
	
	Add table
		
		Reference in a new issue