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