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