37d05a9431af2bb44e8f862691e936b1f627e8d5
[dead/harbl.git] / harbl-cli / src / OptionalConfiguration.hs
1 {-# LANGUAGE DeriveDataTypeable #-}
2 {-# LANGUAGE FlexibleInstances #-}
3 {-# LANGUAGE OverloadedStrings #-}
4 {-# LANGUAGE StandaloneDeriving #-}
5
6 -- | An OptionalConfiguration is just like a 'Configuration', except
7 -- all of its fields are optional. The user can set options in two
8 -- places: the command-line, and a configuration file. Obviously if
9 -- a parameter is set in one place, it doesn't need to be set in the
10 -- other. Thus, the latter needs to be optional.
11 --
12 module OptionalConfiguration (
13 OptionalConfiguration(..),
14 merge_maybe,
15 merge_monoid,
16 from_rc )
17 where
18
19 -- System imports.
20 import qualified Data.Configurator as DC (
21 Worth(Optional),
22 load,
23 lookup )
24 import Data.Data ( Data )
25 import Data.Maybe ( fromMaybe )
26 import Data.Monoid ( Monoid(..) )
27 import Data.Typeable ( Typeable )
28 import Paths_harbl ( getSysconfDir )
29 import System.Console.CmdArgs.Default ( Default(..) )
30 import System.Directory ( getHomeDirectory )
31 import System.FilePath ( (</>) )
32 import System.IO.Error ( catchIOError )
33 import System.IO ( hPutStrLn, stderr )
34
35 -- Harbl library imports.
36 import Network.DNS.RBL.Weight ( Weight )
37
38 -- Local imports.
39 import Hosts ( Hosts(..) )
40 import Lists ( Lists(..) )
41
42
43 -- | The same as 'Configuration', except everything is optional. It's
44 -- easy to merge two of these by simply dropping the 'Nothing's in
45 -- favor of the 'Just's. The 'xml_files' are left un-maybed so that
46 -- cmdargs can parse more than one of them.
47 --
48 data OptionalConfiguration =
49 OptionalConfiguration {
50 hosts :: Hosts,
51 lists :: Lists,
52 threshold :: Maybe Weight }
53 deriving (Show, Data, Typeable)
54
55
56 -- | Choose a nonempty monoid from our two arguments, preferring the
57 -- second. So if the second monoid is non-'mempty', we'll return
58 -- that. Otherwise the first.
59 --
60 -- ==== _Examples_
61 --
62 -- The second list is preferred if both are nonempty:
63 --
64 -- >>> merge_monoid [1,2] [3,4]
65 -- [3,4]
66 --
67 -- However, if the second list is empty, the first is returned:
68 --
69 -- >>> merge_monoid [1,2] []
70 -- [1,2]
71 --
72 -- And if both are empty, we return the first (i.e. empty) list:
73 --
74 -- >>> merge_monoid [] []
75 -- []
76 --
77 merge_monoid :: (Eq a, Monoid a) => a -> a -> a
78 merge_monoid l1 l2 = if l2 == mempty then l1 else l2
79
80
81 -- | Like 'merge_monoid', except for optional things. We take two
82 -- (potentially 'Nothing') values, and then try to choose a
83 -- non-'Nothing' one, preferring the second argument.
84 --
85 -- ==== _Examples_
86 --
87 -- The second is preferred if it is non-'Nothing':
88 --
89 -- >>> merge_maybes (Just 3) (Just 4)
90 -- Just 4
91 --
92 -- >>> merge_maybes Nothing (Just 4)
93 -- Just 4
94 --
95 -- However, if the second argument is 'Nothing', the first is
96 -- returned:
97 --
98 -- >>> merge_maybes (Just 1) Nothing
99 -- Just 1
100 --
101 -- If both are 'Nothing', we return 'Nothing':
102 --
103 -- >>> merge_maybes Nothing Nothing
104 -- Nothing
105 --
106 merge_maybes :: (Maybe a) -> (Maybe a) -> (Maybe a)
107 merge_maybes _ y@(Just _) = y
108 merge_maybes x@(Just _) Nothing = x
109 merge_maybes Nothing Nothing = Nothing
110
111
112 -- | Return the (thing contained in the) second argument if it is
113 -- non-'Nothing'. Otherwise return the first argument.
114 --
115 -- ==== _Examples_
116 --
117 -- The second is preferred if it is non-'Nothing':
118 --
119 -- >>> merge_maybe 3 (Just 4)
120 -- 4
121 --
122 -- However, if the second argument is 'Nothing', the first is
123 -- returned:
124 --
125 -- >>> merge_maybe 1 Nothing
126 -- 1
127 --
128 merge_maybe :: a -> Maybe a -> a
129 merge_maybe x Nothing = x
130 merge_maybe _ (Just y) = y
131
132
133 -- | The Monoid instance for these lets us \"combine\" two
134 -- OptionalConfigurations. The \"combine\" operation that we'd like to
135 -- perform is, essentially, to mash them together. So if we have two
136 -- OptionalConfigurations, each half full, we could combine them
137 -- into one big one.
138 --
139 -- This is used to merge command-line and config-file settings.
140 --
141 instance Monoid OptionalConfiguration where
142 -- | An empty OptionalConfiguration.
143 mempty = OptionalConfiguration mempty mempty Nothing
144
145 -- | Combine @cfg1@ and @cfg2@, giving precedence to @cfg2@.
146 cfg1 `mappend` cfg2 = OptionalConfiguration hs ls t
147 where
148 hs = merge_monoid (hosts cfg1) (hosts cfg2)
149 ls = merge_monoid (lists cfg1) (lists cfg2)
150 t = merge_maybes (threshold cfg1) (threshold cfg2)
151
152
153 -- | Obtain an OptionalConfiguration from harblrc in either the global
154 -- configuration directory or the user's home directory. The one in
155 -- $HOME is prefixed by a dot so that it is hidden.
156 --
157 -- We make an attempt at cross-platform compatibility; we will try
158 -- to find the correct directory even on Windows. But if the calls
159 -- to getHomeDirectory/getSysconfDir fail for whatever reason, we
160 -- fall back to using the Unix-specific /etc and $HOME.
161 --
162 from_rc :: IO OptionalConfiguration
163 from_rc = do
164 etc <- catchIOError getSysconfDir (\e -> do
165 hPutStrLn stderr (show e)
166 return "/etc")
167 home <- catchIOError getHomeDirectory (\e -> do
168 hPutStrLn stderr (show e)
169 return "$(HOME)")
170 let global_config_path = etc </> "harblrc"
171 let user_config_path = home </> ".harblrc"
172 cfg <- DC.load [ DC.Optional global_config_path,
173 DC.Optional user_config_path ]
174 cfg_lists <- DC.lookup cfg "lists"
175 cfg_hosts <- DC.lookup cfg "hosts"
176 cfg_threshold <- DC.lookup cfg "threshold"
177 return $ OptionalConfiguration
178 (fromMaybe def cfg_hosts)
179 (fromMaybe def cfg_lists)
180 cfg_threshold