1 -- | The 'Forward' data type, and functions that act thereon.
12 import Data.String.Utils ( split, strip )
14 import DNS ( NormalDomain, normalize_string )
16 -- | Type synonym to make the signatures below a little more clear.
17 -- WARNING: Also defined in the "Report" module.
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.
25 newtype Address = Address String deriving ( Eq, Show )
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
32 newtype Goto = Goto String deriving ( Eq, Show )
35 -- | A data type representing a "forward." That is, an email address
36 -- whose mail is sent to some other address.
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
47 -- | Shortcut constructor for creating 'Forward' objects.
51 -- >>> pretty_print $ fwd "user1@example.com" "user2@example.net"
52 -- "user1@example.com -> user2@example.net"
54 fwd :: String -> String -> Forward
55 fwd addr goto = Forward (Address addr) (Goto goto)
58 -- | Pretty-print a 'Forward'.
62 -- >>> pretty_print (fwd "a@example.com" "b@example.net")
63 -- "a@example.com -> b@example.net"
65 pretty_print :: Forward -> String
66 pretty_print ( Forward (Address addr) (Goto goto) ) =
67 addr ++ " -> " ++ goto
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
76 -- We return a list containing one 'Forward' for each (address,goto)
81 -- A single address, pointed to itself (common with PostfixAdmin):
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")]
88 -- One address forwarded to two other addresses:
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"]
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:
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"]
104 -- And finally, a one-element list, which should return no forwards:
106 -- >>> let addr = "a@b.test"
107 -- >>> strings_to_forwards [addr]
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 _ = []
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
124 -- >>> let f = fwd "user1@example.com" "user2@example.net"
126 -- Just "example.net"
128 -- A forward to a subdomain:
130 -- >>> let f = fwd "user1@example.com" "user2@sub.example.net"
132 -- Just "sub.example.net"
134 -- A goto without an '@' character:
136 -- >>> let f = fwd "user1@example.com" "example.net"
140 -- A goto with three '@' characters:
142 -- >>> let f = fwd "user1@example.com" "@example@.net@"
146 goto_domain :: Forward -> Maybe Domain
147 goto_domain (Forward _ (Goto goto)) = domain_part goto
150 -- | Find the domain of the 'Address' associated with a 'Forward'. This
151 -- returns the __domain of the address__, not the domain of the
158 -- >>> let f = fwd "user1@example.com" "user2@example.net"
159 -- >>> address_domain f
160 -- Just "example.com"
162 -- A forward to/from subdomains:
164 -- >>> let f = fwd "user1@sub.example.com" "user2@sub.example.net"
165 -- >>> address_domain f
166 -- Just "sub.example.com"
168 -- An address/goto without an '@' character:
170 -- >>> let f = fwd "example.com" "example.net"
171 -- >>> address_domain f
174 -- An address/goto with three '@' characters:
176 -- >>> let f = fwd "@example@.com@" "@example@.net@"
177 -- >>> address_domain f
180 address_domain :: Forward -> Maybe Domain
181 address_domain (Forward (Address addr) _) = domain_part addr
184 -- | Return the domain part of an email address (represented by a
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.
196 -- >>> domain_part "user2@example.net"
197 -- Just "example.net"
201 -- >>> domain_part "user2@sub.example.net"
202 -- Just "sub.example.net"
204 -- An address without an '@' character:
206 -- >>> domain_part "example.net"
209 -- An address with two '@' characters:
211 -- >>> domain_part "@example@.net@"
214 domain_part :: String -> Maybe Domain
215 domain_part address =
217 [_,domain] -> Just domain
220 parts = split "@" address
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@.
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"]
236 dropby_goto_domains :: [NormalDomain] -> [Forward] -> [Forward]
237 dropby_goto_domains normal_domains =
238 filter (not . is_bad)
240 -- | A 'Forward' is bad if its goto domain appears in the list, or
241 -- if we can't figure out its goto domain.
243 is_bad :: Forward -> Bool
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