Add a "threshold" to the configuration.
[dead/harbl.git] / harbl / src / Network / DNS / RBL / Weight.hs
1 {-# LANGUAGE DeriveDataTypeable #-}
2 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
3
4 -- | The 'Weight' type, its instances, and a Parsec parser to parse
5 -- one off the end of a 'Site'.
6 --
7 -- This is a simple newtype wrapper around an 'Int', meant to be
8 -- used wherever a weight or an RBL score is intended (to prevent
9 -- integer mixups). For example, the RBLs are all weighted with
10 -- 'Weight's, and when a user supplied a \"badness\" threshold, it
11 -- will be as a 'Weight' as well. The two are then comparable but
12 -- not with other 'Int's.
13 --
14 module Network.DNS.RBL.Weight (
15 Weight(..),
16 weight )
17 where
18
19 import Data.Configurator () -- Needed for predefined instances.
20 import Data.Configurator.Types ( Configured(..), Value( Number ), convert )
21 import Data.Data ( Data )
22 import Data.Ratio ( numerator )
23 import Data.Typeable ( Typeable )
24 import System.Console.CmdArgs.Default ( Default(..) )
25 import Text.Parsec (
26 (<|>),
27 char,
28 digit,
29 many1,
30 option,
31 try,
32 unexpected )
33 import Text.Parsec.String ( Parser )
34 import Text.Read ( readMaybe )
35
36 import Network.DNS.RBL.Pretty ( Pretty(..) )
37
38
39 -- | The 'Weight' wrapper around an 'Int. We use
40 -- GeneralizedNewtypeDeriving to derive num automatically (so that we
41 -- can sum these things).
42 --
43 -- ==== _Examples_
44 --
45 -- >>> let w1 = Weight 1
46 -- >>> w1
47 -- Weight 1
48 -- >>> let w2 = Weight 1
49 -- >>> w1 == w2
50 -- True
51 -- >>> let w3 = Weight 2
52 -- >>> w1 == w3
53 -- False
54 -- >>> sum [w1, w2, w3]
55 -- Weight 4
56 --
57 newtype Weight = Weight Int deriving (Data, Eq, Num, Ord, Show, Typeable)
58
59
60 -- | Pretty-print a 'Weight'. This just shows/prints the underlying 'Int'.
61 --
62 -- ==== _Examples_
63 --
64 -- >>> pretty_print $ Weight 17
65 -- 17
66 --
67 instance Pretty Weight where
68 pretty_show (Weight w) = show w
69
70
71 -- | Set a default value for the weight. We use the 'Default' class
72 -- from the CmdArgs class so that 'Weight's can be easily parsed on
73 -- the command-line.
74 --
75 -- ==== _Examples_
76 --
77 -- >>> def :: Weight
78 -- Weight 1
79 --
80 instance Default Weight where def = 1
81
82
83 -- | Allow the configurator library to parse a 'Weight' from a config
84 -- file.
85 --
86 -- ==== _Examples_
87 --
88 -- >>> import Data.Configurator () -- Get predefined 'Configured' instances.
89 -- >>> import Data.Text ( pack )
90 -- >>> import Data.Configurator.Types ( Value( Number, String ) )
91 -- >>> let n1 = Number 2
92 -- >>> convert n1 :: Maybe Weight
93 -- Just (Weight 2)
94 -- >>> let s = String (pack "foo1")
95 -- >>> convert s :: Maybe Weight
96 -- Nothing
97 --
98 instance Configured Weight where
99 -- Don't give us a fractional weight, we'll ignore the denominator.
100 convert (Number x) = Just (Weight (fromInteger $ numerator x))
101 convert _ = Nothing
102
103
104 -- | Parse the weight multiplier off the end of an input 'Site'. This
105 -- expects there to be a \"multiplier\" character (an asterisk)
106 -- before the integral weight.
107 --
108 -- ==== _Examples_
109 --
110 -- >>> import Text.Parsec ( parseTest )
111 --
112 -- Negative, zero, and positive integers are all supported:
113 --
114 -- >>> parseTest weight "*-5"
115 -- Weight (-5)
116 --
117 -- >>> parseTest weight "*0"
118 -- Weight 0
119 --
120 -- >>> parseTest weight "*17"
121 -- Weight 17
122 --
123 -- If the weight is empty, it defaults to @1@:
124 --
125 -- >>> parseTest weight ""
126 -- Weight 1
127 --
128 -- The default is used whenever parsing fails:
129 --
130 -- >>> parseTest weight "*hello"
131 -- Weight 1
132 --
133 -- The 'Pretty' instance works as intended:
134 --
135 -- >>> import Text.Parsec ( parse )
136 -- >>> pretty_print $ parse weight "" "*3"
137 -- 3
138 --
139 weight :: Parser Weight
140 weight = try parse_weight <|> return (Weight 1)
141 where
142 parse_weight = do
143 _ <- char '*'
144 sign <- (char '-') <|> (option '+' (char '+'))
145 w <- many1 digit
146 case ( readMaybe w :: Maybe Int ) of
147 -- If "many1 digit" gives us a list of digits, we should be able
148 -- to convert that to an Int! It will overflow rather than fail
149 -- if the input is too big/small, so it should really always
150 -- succeed.
151 Nothing -> unexpected "weight: readMaybe failed on a sequence of digits!"
152 Just k -> return $ Weight (if sign == '-' then negate k else k)