-- | The 'Forward' data type, and functions that act thereon.
--
module Forward (
  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
