Add weight parsing to DnsblSite.hs.
[dead/harbl.git] / src / DnsblSite.hs
1 -- | This module contains the 'DnsblSite' data type representing one
2 -- blacklist with its associated return codes and weight. For example,
3 -- in Postfix's main.cf you might have,
4 --
5 -- postscreen_dnsbl_sites = bl.mailspike.net=127.0.0.[2;10;11]*2, ...
6 --
7 -- Here, the 'Domain' is \"bl.mailspike.net\", the return code
8 -- pattern is \"127.0.0.[2;10;11]\", and the weight is \"2".
9 --
10 module DnsblSite
11 where
12
13 import Text.Parsec (
14 ParseError,
15 (<|>),
16 char,
17 digit,
18 eof,
19 many1,
20 option,
21 parse,
22 string,
23 try,
24 unexpected )
25 import Text.Parsec.String ( Parser )
26 import Text.Read ( readMaybe )
27
28
29 import IPv4Pattern ( IPv4Pattern )
30
31 newtype Weight = Weight Int deriving (Eq, Show)
32
33 -- | Parse the weight multiplier at the end of a dnsbl_site.
34 --
35 -- ==== _Examples_
36 --
37 -- >>> import Text.Parsec ( parseTest )
38 --
39 -- Negative, zero, and positive integers are all supported:
40 --
41 -- >>> parseTest weight "*-5"
42 -- Weight (-5)
43 --
44 -- >>> parseTest weight "*0"
45 -- Weight 0
46 --
47 -- >>> parseTest weight "*17"
48 -- Weight 17
49 --
50 -- A bare asterisk doesn't work:
51 --
52 -- >>> parseTest weight "*"
53 -- parse error at (line 1, column 2):
54 -- unexpected end of input
55 -- expecting "-", "+" or digit
56 --
57 -- If the weight is empty, it defaults to @1@:
58 --
59 -- >>> parseTest weight ""
60 -- Weight 1
61 --
62 -- But the default is only used if the weight is really empty,
63 -- not if parsing simply fails:
64 --
65 -- >>> parseTest weight "*hello"
66 -- parse error at (line 1, column 2):
67 -- unexpected "h"
68 -- expecting "-", "+" or digit
69 --
70 weight :: Parser Weight
71 weight = try parse_weight <|> (eof >> return (Weight 1))
72 where
73 parse_weight = do
74 _ <- char '*'
75 sign <- (char '-') <|> (option '+' (char '+'))
76 w <- many1 digit
77 case ( readMaybe w :: Maybe Int ) of
78 -- If "many1 digit" gives us a list of digits, we should be able
79 -- to convert that to an Int! It will overflow rather than fail
80 -- if the input is too big/small, so it should really always
81 -- succeed.
82 Nothing -> unexpected "weight: readMaybe failed on a sequence of digits!"
83 Just k -> return $ Weight (if sign == '-' then negate k else k)
84
85 newtype Domain = Domain String
86
87 data DnsblSite = DnsblSite Domain IPv4Pattern Weight
88