X-Git-Url: https://gitweb.michael.orlitzky.com/?a=blobdiff_plain;f=src%2FForward.hs;fp=src%2FForward.hs;h=7de53b858375287049f4e1c692f56316e28b18c6;hb=f75845314598408bce3a1b972f2ba274d93d0e8d;hp=0000000000000000000000000000000000000000;hpb=bf367c0d7450fbe148a0a22681384954978bde21;p=list-remote-forwards.git diff --git a/src/Forward.hs b/src/Forward.hs new file mode 100644 index 0000000..7de53b8 --- /dev/null +++ b/src/Forward.hs @@ -0,0 +1,251 @@ +-- | 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 ( normalize_string_domain ) + +-- | 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 ( 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 ( 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 (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 'Domain'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 = ["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 :: [Domain] -> [Forward] -> [Forward] +dropby_goto_domains domains = + filter (not . is_bad) + where + -- If we don't normalize these first, comparison (i.e. `elem`) + -- doesn't work so great. + normalized_domains = map normalize_string_domain domains + + -- | 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. + Just d -> (normalize_string_domain d) `elem` normalized_domains