-- | The 'Forward' data type, and functions that act thereon. -- module Forward ( Forward(..), address_domain, dropby_goto_domains, fwd, pretty_print, strings_to_forwards ) where import Data.String.Utils ( split, strip ) import DNS ( NormalDomain, normalize_string ) -- | Type synonym to make the signatures below a little more clear. -- WARNING: Also defined in the "Report" module. type Domain = String -- | A type-safe wrapper around an email address that's represented as -- a 'String'. This differs from a 'Goto' in that it should only -- appear on the left-hand-side of a alias -> goto relationship. -- newtype Address = Address String deriving ( Eq, Show ) -- | A type-safe wrapper around an email address that's represented as -- a 'String'. This differs from 'Address' in that 'Goto' addresses -- are the destinations of mail that is forwarded, rather than the -- source. newtype Goto = Goto String deriving ( Eq, Show ) -- | A data type representing a "forward." That is, an email address -- whose mail is sent to some other address. -- -- The 'Address' field represents the alias address, the address to -- which mail is sent. The 'Goto' field is the address to which the -- mail is forwarded. -- data Forward = Forward Address Goto deriving ( Eq, Show ) -- | Shortcut constructor for creating 'Forward' objects. -- -- ==== __Examples__ -- -- >>> pretty_print $ fwd "user1@example.com" "user2@example.net" -- "user1@example.com -> user2@example.net" -- fwd :: String -> String -> Forward fwd addr goto = Forward (Address addr) (Goto goto) -- | Pretty-print a 'Forward'. -- -- ==== __Examples__ -- -- >>> pretty_print (fwd "a@example.com" "b@example.net") -- "a@example.com -> b@example.net" -- pretty_print :: Forward -> String pretty_print ( Forward (Address addr) (Goto goto) ) = addr ++ " -> " ++ goto -- | Convert a list of 'String's into a list of 'Forward's. The list -- of 'String's is assumed to have exactly two elements; the first -- being an address, and the second being a comma-separated list of -- gotos. -- -- We return a list containing one 'Forward' for each (address,goto) -- pair. -- -- ==== __Examples__ -- -- A single address, pointed to itself (common with PostfixAdmin): -- -- >>> let addr = "a@b.test" -- >>> let gotos = "a@b.test" -- >>> strings_to_forwards [addr, gotos] -- [Forward (Address "a@b.test") (Goto "a@b.test")] -- -- One address forwarded to two other addresses: -- -- >>> let addr = "a@b.test" -- >>> let gotos = "a1@b.test,a2@b.test" -- >>> map pretty_print (strings_to_forwards [addr, gotos]) -- ["a@b.test -> a1@b.test","a@b.test -> a2@b.test"] -- -- An address that receives mail itself, but also forwards a copy to -- another address (also common in PostfixAdmin). We've also mangled -- the whitespace a little bit here: -- -- >>> let addr = "a@b.test" -- >>> let gotos = "a@b.test ,a2@b.test " -- >>> map pretty_print (strings_to_forwards [addr, gotos]) -- ["a@b.test -> a@b.test","a@b.test -> a2@b.test"] -- -- And finally, a one-element list, which should return no forwards: -- -- >>> let addr = "a@b.test" -- >>> strings_to_forwards [addr] -- [] -- strings_to_forwards :: [String] -> [Forward] strings_to_forwards (addr:gotos:_) = [Forward (Address addr) (Goto (strip g)) | g <- split "," gotos] strings_to_forwards _ = [] -- | Find the domain of the 'Goto' associated with a 'Forward'. This -- returns the __domain of the goto address__, not the domain of the -- 'Address' itself. -- -- ==== __Examples__ -- -- A normal forward: -- -- >>> let f = fwd "user1@example.com" "user2@example.net" -- >>> goto_domain f -- Just "example.net" -- -- A forward to a subdomain: -- -- >>> let f = fwd "user1@example.com" "user2@sub.example.net" -- >>> goto_domain f -- Just "sub.example.net" -- -- A goto without an '@' character: -- -- >>> let f = fwd "user1@example.com" "example.net" -- >>> goto_domain f -- Nothing -- -- A goto with three '@' characters: -- -- >>> let f = fwd "user1@example.com" "@example@.net@" -- >>> goto_domain f -- Nothing -- goto_domain :: Forward -> Maybe Domain goto_domain (Forward _ (Goto goto)) = domain_part goto -- | Find the domain of the 'Address' associated with a 'Forward'. This -- returns the __domain of the address__, not the domain of the -- 'Goto'. -- -- ==== __Examples__ -- -- A normal forward: -- -- >>> let f = fwd "user1@example.com" "user2@example.net" -- >>> address_domain f -- Just "example.com" -- -- A forward to/from subdomains: -- -- >>> let f = fwd "user1@sub.example.com" "user2@sub.example.net" -- >>> address_domain f -- Just "sub.example.com" -- -- An address/goto without an '@' character: -- -- >>> let f = fwd "example.com" "example.net" -- >>> address_domain f -- Nothing -- -- An address/goto with three '@' characters: -- -- >>> let f = fwd "@example@.com@" "@example@.net@" -- >>> address_domain f -- Nothing -- address_domain :: Forward -> Maybe Domain address_domain (Forward (Address addr) _) = domain_part addr -- | Return the domain part of an email address (represented by a -- 'String'). -- -- The way we determine the domain is simple: we take whatever -- appears after the first '@' character in the address. If there is -- no '@' symbol, or if there's more than one, then we don't know -- what the domain is, so we return 'Nothing' instead. -- -- ==== __Examples__ -- -- A normal address: -- -- >>> domain_part "user2@example.net" -- Just "example.net" -- -- A subdomain: -- -- >>> domain_part "user2@sub.example.net" -- Just "sub.example.net" -- -- An address without an '@' character: -- -- >>> domain_part "example.net" -- Nothing -- -- An address with two '@' characters: -- -- >>> domain_part "@example@.net@" -- Nothing -- domain_part :: String -> Maybe Domain domain_part address = case parts of [_,domain] -> Just domain _ -> Nothing where parts = split "@" address -- | Given a list of 'NormalDomain's @domains@ and a list of 'Forward's -- @forwards@, filter out all elements of @forwards@ that have a -- goto domain in the list of @domains@. -- -- ==== __Examples__ -- -- >>> let ds = map normalize_string ["example.com", "example.net"] -- >>> let f1 = fwd "a@example.com" "a@example.com" -- >>> let f2 = fwd "a@example.com" "a1@example.net" -- >>> let f3 = fwd "a@example.com" "a2@example.org" -- >>> map pretty_print (dropby_goto_domains ds [f1,f2,f3]) -- ["a@example.com -> a2@example.org"] -- dropby_goto_domains :: [NormalDomain] -> [Forward] -> [Forward] dropby_goto_domains normal_domains = filter (not . is_bad) where -- | A 'Forward' is bad if its goto domain appears in the list, or -- if we can't figure out its goto domain. -- is_bad :: Forward -> Bool is_bad f = case (goto_domain f) of Nothing -> True -- Drop these, too. -- Nice, we can't compare unless we normalize @d@! Just d -> (normalize_string d) `elem` normal_domains