my_summary = program_name ++ "-" ++ (showVersion version)
--- | A description of the "daemonize" option.
+-- | A description of the \"lists\" option.
lists_help :: String
lists_help =
"A list of RBLs to check. See the manual for advanced syntax."
+-- | A description of the \"threshold\" option.
+threshold_help :: String
+threshold_help =
+ "The \"score\" a host must have to be considered blacklisted."
+
+
-- | A data structure representing the possible command-line
-- options. The CmdArgs library is doing heavy magic beneath the
-- hood here.
arg_spec :: OptionalConfiguration
arg_spec =
OptionalConfiguration {
- hosts = def &= typ "HOSTS" &= args,
- lists = def &= typ "RBLs" &= help lists_help }
+ hosts = def &= typ "HOSTS" &= args,
+ lists = def &= typ "RBLs" &= help lists_help,
+ threshold = def &= typ "INTEGER" &= help threshold_help }
&= program program_name
&= summary my_summary
&= details [description]
merge_optional )
where
-import Data.Monoid ( Monoid(..) )
+-- System imports.
import System.Console.CmdArgs.Default ( Default(..) )
--- From the harbl library.
+-- Harbl library imports.
import Network.DNS.RBL.Weight ( Weight )
+-- Local imports.
import qualified OptionalConfiguration as OC (
- OptionalConfiguration(..) )
+ OptionalConfiguration(..),
+ merge_maybe,
+ merge_monoid )
import Hosts ( Hosts(..) )
import Lists ( Lists(..) )
data Configuration =
Configuration {
hosts :: Hosts,
- lists :: Lists }
--- threshold :: Weight }
+ lists :: Lists,
+ threshold :: Weight }
deriving (Show)
--
instance Default Configuration where
def = Configuration { hosts = def,
- lists = def }
--- threshold = def }
+ lists = def,
+ threshold = def }
-- | Merge a 'Configuration' with an 'OptionalConfiguration'. This is
merge_optional :: Configuration
-> OC.OptionalConfiguration
-> Configuration
-merge_optional cfg opt_cfg =
- Configuration all_hosts all_lists
+merge_optional cfg opt_cfg = Configuration hs ls t
where
- all_hosts = (hosts cfg) `mappend` (OC.hosts opt_cfg)
- all_lists = (lists cfg) `mappend` (OC.lists opt_cfg)
+ hs = OC.merge_monoid (hosts cfg) (OC.hosts opt_cfg)
+ ls = OC.merge_monoid (lists cfg) (OC.lists opt_cfg)
+ t = OC.merge_maybe (threshold cfg) (OC.threshold opt_cfg)
--
module OptionalConfiguration (
OptionalConfiguration(..),
+ merge_maybe,
+ merge_monoid,
from_rc )
where
import System.IO.Error ( catchIOError )
import System.IO ( hPutStrLn, stderr )
+-- Harbl library imports.
+import Network.DNS.RBL.Weight ( Weight )
+
-- Local imports.
import Hosts ( Hosts(..) )
import Lists ( Lists(..) )
data OptionalConfiguration =
OptionalConfiguration {
hosts :: Hosts,
- lists :: Lists }
+ lists :: Lists,
+ threshold :: Maybe Weight }
deriving (Show, Data, Typeable)
+-- | Choose a nonempty monoid from our two arguments, preferring the
+-- second. So if the second monoid is non-'mempty', we'll return
+-- that. Otherwise the first.
+--
+-- ==== _Examples_
+--
+-- The second list is preferred if both are nonempty:
+--
+-- >>> merge_monoid [1,2] [3,4]
+-- [3,4]
+--
+-- However, if the second list is empty, the first is returned:
+--
+-- >>> merge_monoid [1,2] []
+-- [1,2]
+--
+-- And if both are empty, we return the first (i.e. empty) list:
+--
+-- >>> merge_monoid [] []
+-- []
+--
+merge_monoid :: (Eq a, Monoid a) => a -> a -> a
+merge_monoid l1 l2 = if l2 == mempty then l1 else l2
+
+
+-- | Like 'merge_monoid', except for optional things. We take two
+-- (potentially 'Nothing') values, and then try to choose a
+-- non-'Nothing' one, preferring the second argument.
+--
+-- ==== _Examples_
+--
+-- The second is preferred if it is non-'Nothing':
+--
+-- >>> merge_maybes (Just 3) (Just 4)
+-- Just 4
+--
+-- >>> merge_maybes Nothing (Just 4)
+-- Just 4
+--
+-- However, if the second argument is 'Nothing', the first is
+-- returned:
+--
+-- >>> merge_maybes (Just 1) Nothing
+-- Just 1
+--
+-- If both are 'Nothing', we return 'Nothing':
+--
+-- >>> merge_maybes Nothing Nothing
+-- Nothing
+--
+merge_maybes :: (Maybe a) -> (Maybe a) -> (Maybe a)
+merge_maybes _ y@(Just _) = y
+merge_maybes x@(Just _) Nothing = x
+merge_maybes Nothing Nothing = Nothing
+
+
+-- | Return the (thing contained in the) second argument if it is
+-- non-'Nothing'. Otherwise return the first argument.
+--
+-- ==== _Examples_
+--
+-- The second is preferred if it is non-'Nothing':
+--
+-- >>> merge_maybe 3 (Just 4)
+-- 4
+--
+-- However, if the second argument is 'Nothing', the first is
+-- returned:
+--
+-- >>> merge_maybe 1 Nothing
+-- 1
+--
+merge_maybe :: a -> Maybe a -> a
+merge_maybe x Nothing = x
+merge_maybe _ (Just y) = y
+
+
-- | The Monoid instance for these lets us \"combine\" two
-- OptionalConfigurations. The \"combine\" operation that we'd like to
-- perform is, essentially, to mash them together. So if we have two
--
instance Monoid OptionalConfiguration where
-- | An empty OptionalConfiguration.
- mempty = OptionalConfiguration (Hosts []) (Lists [])
-
+ mempty = OptionalConfiguration mempty mempty Nothing
-- | Combine @cfg1@ and @cfg2@, giving precedence to @cfg2@.
- -- XML files can only be specified on the command-line, so we
- -- just join them together here.
- cfg1 `mappend` cfg2 =
- OptionalConfiguration all_hosts all_lists
+ cfg1 `mappend` cfg2 = OptionalConfiguration hs ls t
where
- all_hosts = Hosts $ (get_hosts $ hosts cfg1) ++ (get_hosts $ hosts cfg2)
- all_lists = Lists $ (get_lists $ lists cfg1) ++ (get_lists $ lists cfg2)
-
+ hs = merge_monoid (hosts cfg1) (hosts cfg2)
+ ls = merge_monoid (lists cfg1) (lists cfg2)
+ t = merge_maybes (threshold cfg1) (threshold cfg2)
-- | Obtain an OptionalConfiguration from harblrc in either the global
cfg <- DC.load [ DC.Optional global_config_path,
DC.Optional user_config_path ]
cfg_lists <- DC.lookup cfg "lists"
- let cfg_hosts = Hosts [] -- This won't be in the config file.
- return $ OptionalConfiguration cfg_hosts (fromMaybe def cfg_lists)
+ cfg_hosts <- DC.lookup cfg "hosts"
+ cfg_threshold <- DC.lookup cfg "threshold"
+ return $ OptionalConfiguration
+ (fromMaybe def cfg_hosts)
+ (fromMaybe def cfg_lists)
+ cfg_threshold
+{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
-- | The 'Weight' type, its instances, and a Parsec parser to parse
weight )
where
+import Data.Configurator () -- Needed for predefined instances.
+import Data.Configurator.Types ( Configured(..), Value( Number ), convert )
+import Data.Data ( Data )
+import Data.Ratio ( numerator )
+import Data.Typeable ( Typeable )
import System.Console.CmdArgs.Default ( Default(..) )
import Text.Parsec (
(<|>),
-- >>> sum [w1, w2, w3]
-- Weight 4
--
-newtype Weight = Weight Int deriving (Eq, Num, Ord, Show)
+newtype Weight = Weight Int deriving (Data, Eq, Num, Ord, Show, Typeable)
-- | Pretty-print a 'Weight'. This just shows/prints the underlying 'Int'.
instance Default Weight where def = 1
+-- | Allow the configurator library to parse a 'Weight' from a config
+-- file.
+--
+-- ==== _Examples_
+--
+-- >>> import Data.Configurator () -- Get predefined 'Configured' instances.
+-- >>> import Data.Text ( pack )
+-- >>> import Data.Configurator.Types ( Value( Number, String ) )
+-- >>> let n1 = Number 2
+-- >>> convert n1 :: Maybe Weight
+-- Just (Weight 2)
+-- >>> let s = String (pack "foo1")
+-- >>> convert s :: Maybe Weight
+-- Nothing
+--
+instance Configured Weight where
+ -- Don't give us a fractional weight, we'll ignore the denominator.
+ convert (Number x) = Just (Weight (fromInteger $ numerator x))
+ convert _ = Nothing
+
+
-- | Parse the weight multiplier off the end of an input 'Site'. This
-- expects there to be a \"multiplier\" character (an asterisk)
-- before the integral weight.
projects / dead / harbl.git / commitdiff