harbl-cli/src/Main.hs

   1 module Main ( main )
   2 where
   3
   4 import Control.Monad ( liftM, when )
   5 import Data.Monoid ( (<>) )
   6 import Text.Parsec ( ParseError, parse )
   7 import System.Console.CmdArgs ( def )
   8 import System.Exit ( exitWith, ExitCode (ExitFailure) )
   9 import System.IO ( hPutStrLn, stderr )
  10
  11 import CommandLine ( get_args )
  12 import Configuration ( Configuration(..), merge_optional )
  13 import ExitCodes (
  14   exit_no_hosts,
  15   exit_no_lists,
  16   exit_unparseable_host,
  17   exit_unparseable_list )
  18 import Hosts ( Hosts(..) )
  19 import Lists ( Lists(..) )
  20 import qualified OptionalConfiguration as OC ( from_rc )
  21 import Network.DNS.RBL (
  22   Host,
  23   Site,
  24   host,
  25   listing_message,
  26   lookup_rbl,
  27   sites )
  28
  29
  30 -- | The 'concatMapM' function generalizes 'concatMap' to arbitrary monads.
  31 --   See e.g. <https://ghc.haskell.org/trac/ghc/ticket/2042>
  32 concatMapM        :: (Monad m) => (a -> m [b]) -> [a] -> m [b]
  33 concatMapM f xs   =  liftM concat (mapM f xs)
  34
  35 -- | Parse a list of RBL sites from the user's input. If he was nice,
  36 --   he would have given us a list of individual RBLs. But we also
  37 --   handle the case where a big comma-separated string is given to
  38 --   us.
  39 --
  40 parse_lists :: Lists -> Either ParseError [Site]
  41 parse_lists (Lists ls) = concatMapM (parse sites "") ls
  42
  43 -- | Parse a list of hosts from the user's input. Each one should be
  44 --   parseable as a 'Host'.
  45 --
  46 parse_hosts :: Hosts -> Either ParseError [Host]
  47 parse_hosts (Hosts hs) = mapM (parse host "") hs
  48
  49
  50 main :: IO ()
  51 main = do
  52   rc_cfg <- OC.from_rc
  53   cmd_cfg <- get_args
  54
  55   -- Merge the config file options with the command-line ones,
  56   -- prefering the command-line ones.
  57   let opt_config = rc_cfg <> cmd_cfg
  58
  59   -- Update a default config with any options that have been set in
  60   -- either the config file or on the command-line.  We initialize
  61   -- logging before the missing parameter checks below so that we can
  62   -- log the errors.
  63   let cfg = (def :: Configuration) `merge_optional` opt_config
  64
  65   when (null $ get_hosts $ hosts cfg) $
  66     exitWith (ExitFailure exit_no_hosts)
  67
  68   when (null $ get_lists $ lists cfg) $
  69     exitWith (ExitFailure exit_no_lists)
  70
  71   case (parse_lists $ lists cfg) of
  72     Left e -> do
  73       hPutStrLn stderr (show e)
  74       exitWith (ExitFailure exit_unparseable_list)
  75     Right ls -> do
  76       case (parse_hosts $ hosts cfg) of
  77         Left e -> do
  78           hPutStrLn stderr (show e)
  79           exitWith (ExitFailure exit_unparseable_host)
  80         Right hs -> do
  81           listings <- concatMapM (lookup_rbl ls) hs
  82           mapM_ (putStrLn . listing_message) listings