+-- | 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
projects / list-remote-forwards.git / commitdiff