7b28af57cacfd59327cf7ab7471f32a8eb5a3bc3
[dead/harbl.git] / 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)