-find_remote_forwards :: [Domain] -> [Forward] -> [Forward]
-find_remote_forwards domains forwards =
- filter is_remote forwards
- where
- is_remote :: Forward -> Bool
- is_remote (Forward _ goto) =
- let parts = split "@" goto
- in
- case parts of
- (_:dp:[]) -> not $ dp `elem` domains
- _ -> True -- Assume it's remote if something is wrong
-
-
-format_forward :: Forward -> String
-format_forward (Forward addr goto) =
- addr ++ " -> " ++ goto
-
-
--- If the MX records for a domain are exactly those contained in the
--- MxList, then we exclude that domain from the report. Splitting on
--- the '@' is a lazy way of obtaining the domain, but if it's good
--- enough for determining that a forward is remote, then it's good
--- enough for this.
-filter_by_mx :: MxList -> [Forward] -> IO [Forward]
--- This special case is necessary! Otherwise if we have an empty
--- exclude list and a domain that has no MX record, it will be
--- excluded.
-filter_by_mx (MxList []) = return
-filter_by_mx (MxList mxs) =
- filterM all_mxs_excluded
+-- | A filter function to remove specific 'Forward's from a list (of
+-- forwards). Its intended usage is to ignore a 'Forward' if its
+-- 'Address' has MX records that are all contained in the given
+-- list. This could be useful if, for example, one MX has strict
+-- spam filtering and remote forwards are not a problem for domains
+-- with that MX.
+--
+-- If the MX records for a domain are contained in the 'MxList',
+-- then we exclude that domain from the report.
+--
+-- For performance reasons, we want to have precomputed the MX
+-- records for all of the address domains in our list of
+-- forwards. We do this so we don't look up the MX records twice for
+-- two addresses within the same domain. We could just as well do
+-- this within this function, but by taking the @domain_mxs@ as a
+-- parameter, we allow ourselves to be a pure function.
+--
+-- If the domain of a forward address can't be determined, it won't
+-- be dropped! This is intentional: the existence of a forward
+-- address without a domain part probably indicates a configuration
+-- error somewhere, and we should report it.
+--
+-- The empty @MxList []@ special case is necessary! Otherwise if we
+-- have an empty exclude list and a domain that has no MX record, it
+-- will be excluded.
+--
+-- ==== __Examples__
+--
+-- Our single forward should be dropped from the list, because its
+-- MX record list, ["mx.example.com"], is contained in the list of
+-- excluded MXs:
+--
+-- >>> import qualified Data.Map as Map ( fromList )
+-- >>> import qualified Data.Set as Set ( fromList )
+-- >>> import Forward ( fwd )
+-- >>> let fwds = [fwd "user1@example.com" "user2@example.net"]
+-- >>> let mx_set = Set.fromList ["mx.example.com"]
+-- >>> let example_mx_pairs = [("example.com.", mx_set)]
+-- >>> let mx_map = Map.fromList example_mx_pairs
+-- >>> let droplist = MxList ["mx.example.com", "mx2.example.com"]
+-- >>> map pretty_print (dropby_mxlist droplist mx_map fwds)
+-- []
+--
+-- Repeat the previous test with the goto domain, to make sure we're
+-- dropping based on the address and not the goto:
+--
+-- >>> import qualified Data.Map as Map ( fromList )
+-- >>> import qualified Data.Set as Set ( fromList )
+-- >>> let fwds = [fwd "user1@example.com" "user2@example.net"]
+-- >>> let mx_set = Set.fromList ["mx.example.net"]
+-- >>> let example_mx_pairs = [("example.net.", mx_set)]
+-- >>> let mx_map = Map.fromList example_mx_pairs
+-- >>> let droplist = MxList ["mx.example.net", "mx2.example.net"]
+-- >>> map pretty_print (dropby_mxlist droplist mx_map fwds)
+-- ["user1@example.com -> user2@example.net"]
+--
+-- Use weird caps, and optional trailing dot all over the place to
+-- make sure everything is handled normalized:
+--
+-- >>> import qualified Data.Set as Set ( fromList )
+-- >>> import Forward ( fwd )
+-- >>> let fwds = [fwd "user1@exAmPle.com." "user2@examPle.net"]
+-- >>> let mx_set = Set.fromList ["mx.EXAMPLE.com"]
+-- >>> let example_mx_pairs = [("Example.com", mx_set)]
+-- >>> let mx_map = Map.fromList example_mx_pairs
+-- >>> let droplist = MxList ["mx.EXAMple.com", "mx2.example.COM"]
+-- >>> map pretty_print (dropby_mxlist droplist mx_map fwds)
+-- []
+--
+-- This time it shouldn't be dropped, because ["mx.example.com"] is
+-- not contained in ["nope.example.com"]:
+--
+-- >>> import qualified Data.Map as Map ( fromList )
+-- >>> import qualified Data.Set as Set ( fromList )
+-- >>> let fwds = [fwd "user1@example.com" "user2@example.net"]
+-- >>> let mx_set = Set.fromList ["mx.example.com"]
+-- >>> let example_mx_pairs = [("example.com.", mx_set)]
+-- >>> let mx_map = Map.fromList example_mx_pairs
+-- >>> let droplist = MxList ["nope.example.com"]
+-- >>> map pretty_print (dropby_mxlist droplist mx_map fwds)
+-- ["user1@example.com -> user2@example.net"]
+--
+-- Now we check that if a forward has two MXes, one of which appears
+-- in the list of excluded MXes, it doesn't get dropped:
+--
+-- >>> import qualified Data.Map as Map ( fromList )
+-- >>> import qualified Data.Set as Set ( fromList )
+-- >>> let fwds = [fwd "user1@example.com" "user2@example.net"]
+-- >>> let mx_set = Set.fromList ["mx1.example.com", "mx2.example.com"]
+-- >>> let example_mx_pairs = [("example.com.", mx_set)]
+-- >>> let mx_map = Map.fromList example_mx_pairs
+-- >>> let droplist = MxList ["mx1.example.com"]
+-- >>> map pretty_print (dropby_mxlist droplist mx_map fwds)
+-- ["user1@example.com -> user2@example.net"]
+--
+dropby_mxlist :: MxList -> MxSetMap -> [Forward] -> [Forward]
+dropby_mxlist (MxList []) _ = id
+dropby_mxlist (MxList mxs) domain_mx_map =
+ filter (not . is_bad)