]> gitweb.michael.orlitzky.com - list-remote-forwards.git/blob - src/Forward.hs
d4936eda5c2169fbbcdc3130689125cb111195cd
[list-remote-forwards.git] / src / Forward.hs
1 -- | The 'Forward' data type, and functions that act thereon.
2 --
3 module Forward (
4 Forward(..),
5 address_domain,
6 dropby_goto_domains,
7 fwd,
8 pretty_print,
9 strings_to_forwards )
10 where
11
12 import Data.String.Utils ( split, strip )
13
14 import DNS ( NormalDomain, normalize_string )
15
16 -- | Type synonym to make the signatures below a little more clear.
17 -- WARNING: Also defined in the "Report" module.
18 type Domain = String
19
20
21 -- | A type-safe wrapper around an email address that's represented as
22 -- a 'String'. This differs from a 'Goto' in that it should only
23 -- appear on the left-hand-side of a alias -> goto relationship.
24 --
25 newtype Address = Address String deriving ( Eq, Show )
26
27
28 -- | A type-safe wrapper around an email address that's represented as
29 -- a 'String'. This differs from 'Address' in that 'Goto' addresses
30 -- are the destinations of mail that is forwarded, rather than the
31 -- source.
32 newtype Goto = Goto String deriving ( Eq, Show )
33
34
35 -- | A data type representing a "forward." That is, an email address
36 -- whose mail is sent to some other address.
37 --
38 -- The 'Address' field represents the alias address, the address to
39 -- which mail is sent. The 'Goto' field is the address to which the
40 -- mail is forwarded.
41 --
42 data Forward =
43 Forward Address Goto
44 deriving ( Eq, Show )
45
46
47 -- | Shortcut constructor for creating 'Forward' objects.
48 --
49 -- ==== __Examples__
50 --
51 -- >>> pretty_print $ fwd "user1@example.com" "user2@example.net"
52 -- "user1@example.com -> user2@example.net"
53 --
54 fwd :: String -> String -> Forward
55 fwd addr goto = Forward (Address addr) (Goto goto)
56
57
58 -- | Pretty-print a 'Forward'.
59 --
60 -- ==== __Examples__
61 --
62 -- >>> pretty_print (fwd "a@example.com" "b@example.net")
63 -- "a@example.com -> b@example.net"
64 --
65 pretty_print :: Forward -> String
66 pretty_print ( Forward (Address addr) (Goto goto) ) =
67 addr ++ " -> " ++ goto
68
69
70
71 -- | Convert a list of 'String's into a list of 'Forward's. The list
72 -- of 'String's is assumed to have exactly two elements; the first
73 -- being an address, and the second being a comma-separated list of
74 -- gotos.
75 --
76 -- We return a list containing one 'Forward' for each (address,goto)
77 -- pair.
78 --
79 -- ==== __Examples__
80 --
81 -- A single address, pointed to itself (common with PostfixAdmin):
82 --
83 -- >>> let addr = "a@b.test"
84 -- >>> let gotos = "a@b.test"
85 -- >>> strings_to_forwards [addr, gotos]
86 -- [Forward (Address "a@b.test") (Goto "a@b.test")]
87 --
88 -- One address forwarded to two other addresses:
89 --
90 -- >>> let addr = "a@b.test"
91 -- >>> let gotos = "a1@b.test,a2@b.test"
92 -- >>> map pretty_print (strings_to_forwards [addr, gotos])
93 -- ["a@b.test -> a1@b.test","a@b.test -> a2@b.test"]
94 --
95 -- An address that receives mail itself, but also forwards a copy to
96 -- another address (also common in PostfixAdmin). We've also mangled
97 -- the whitespace a little bit here:
98 --
99 -- >>> let addr = "a@b.test"
100 -- >>> let gotos = "a@b.test ,a2@b.test "
101 -- >>> map pretty_print (strings_to_forwards [addr, gotos])
102 -- ["a@b.test -> a@b.test","a@b.test -> a2@b.test"]
103 --
104 -- And finally, a one-element list, which should return no forwards:
105 --
106 -- >>> let addr = "a@b.test"
107 -- >>> strings_to_forwards [addr]
108 -- []
109 --
110 strings_to_forwards :: [String] -> [Forward]
111 strings_to_forwards (addr:gotos:_) =
112 [Forward (Address addr) (Goto (strip g)) | g <- split "," gotos]
113 strings_to_forwards _ = []
114
115
116 -- | Find the domain of the 'Goto' associated with a 'Forward'. This
117 -- returns the __domain of the goto address__, not the domain of the
118 -- 'Address' itself.
119 --
120 -- ==== __Examples__
121 --
122 -- A normal forward:
123 --
124 -- >>> let f = fwd "user1@example.com" "user2@example.net"
125 -- >>> goto_domain f
126 -- Just "example.net"
127 --
128 -- A forward to a subdomain:
129 --
130 -- >>> let f = fwd "user1@example.com" "user2@sub.example.net"
131 -- >>> goto_domain f
132 -- Just "sub.example.net"
133 --
134 -- A goto without an '@' character:
135 --
136 -- >>> let f = fwd "user1@example.com" "example.net"
137 -- >>> goto_domain f
138 -- Nothing
139 --
140 -- A goto with three '@' characters:
141 --
142 -- >>> let f = fwd "user1@example.com" "@example@.net@"
143 -- >>> goto_domain f
144 -- Nothing
145 --
146 goto_domain :: Forward -> Maybe Domain
147 goto_domain (Forward _ (Goto goto)) = domain_part goto
148
149
150 -- | Find the domain of the 'Address' associated with a 'Forward'. This
151 -- returns the __domain of the address__, not the domain of the
152 -- 'Goto'.
153 --
154 -- ==== __Examples__
155 --
156 -- A normal forward:
157 --
158 -- >>> let f = fwd "user1@example.com" "user2@example.net"
159 -- >>> address_domain f
160 -- Just "example.com"
161 --
162 -- A forward to/from subdomains:
163 --
164 -- >>> let f = fwd "user1@sub.example.com" "user2@sub.example.net"
165 -- >>> address_domain f
166 -- Just "sub.example.com"
167 --
168 -- An address/goto without an '@' character:
169 --
170 -- >>> let f = fwd "example.com" "example.net"
171 -- >>> address_domain f
172 -- Nothing
173 --
174 -- An address/goto with three '@' characters:
175 --
176 -- >>> let f = fwd "@example@.com@" "@example@.net@"
177 -- >>> address_domain f
178 -- Nothing
179 --
180 address_domain :: Forward -> Maybe Domain
181 address_domain (Forward (Address addr) _) = domain_part addr
182
183
184 -- | Return the domain part of an email address (represented by a
185 -- 'String').
186 --
187 -- The way we determine the domain is simple: we take whatever
188 -- appears after the first '@' character in the address. If there is
189 -- no '@' symbol, or if there's more than one, then we don't know
190 -- what the domain is, so we return 'Nothing' instead.
191 --
192 -- ==== __Examples__
193 --
194 -- A normal address:
195 --
196 -- >>> domain_part "user2@example.net"
197 -- Just "example.net"
198 --
199 -- A subdomain:
200 --
201 -- >>> domain_part "user2@sub.example.net"
202 -- Just "sub.example.net"
203 --
204 -- An address without an '@' character:
205 --
206 -- >>> domain_part "example.net"
207 -- Nothing
208 --
209 -- An address with two '@' characters:
210 --
211 -- >>> domain_part "@example@.net@"
212 -- Nothing
213 --
214 domain_part :: String -> Maybe Domain
215 domain_part address =
216 case parts of
217 [_,domain] -> Just domain
218 _ -> Nothing
219 where
220 parts = split "@" address
221
222
223 -- | Given a list of 'NormalDomain's @domains@ and a list of 'Forward's
224 -- @forwards@, filter out all elements of @forwards@ that have a
225 -- goto domain in the list of @domains@.
226 --
227 -- ==== __Examples__
228 --
229 -- >>> let ds = map normalize_string ["example.com", "example.net"]
230 -- >>> let f1 = fwd "a@example.com" "a@example.com"
231 -- >>> let f2 = fwd "a@example.com" "a1@example.net"
232 -- >>> let f3 = fwd "a@example.com" "a2@example.org"
233 -- >>> map pretty_print (dropby_goto_domains ds [f1,f2,f3])
234 -- ["a@example.com -> a2@example.org"]
235 --
236 dropby_goto_domains :: [NormalDomain] -> [Forward] -> [Forward]
237 dropby_goto_domains normal_domains =
238 filter (not . is_bad)
239 where
240 -- | A 'Forward' is bad if its goto domain appears in the list, or
241 -- if we can't figure out its goto domain.
242 --
243 is_bad :: Forward -> Bool
244 is_bad f =
245 case (goto_domain f) of
246 Nothing -> True -- Drop these, too.
247 -- Nice, we can't compare unless we normalize @d@!
248 Just d -> (normalize_string d) `elem` normal_domains