harbl-cli/src/Main.hs

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