module Network.Mail.Postie.Address
  ( Address,
    -- | Represents an email address
    address,
    -- | Returns address from local and domain part
    addressLocalPart,
    -- | Returns local part of address
    addressDomain,
    -- | Retuns domain part of address
    toByteString,
    -- | Resulting ByteString has format localPart\@domainPart.
    toLazyByteString,
    -- | Resulting Lazy.ByteString has format localPart\@domainPart.
    parseAddress,
    -- | Parses a ByteString to Address
    addrSpec,
  )
where

import Control.Applicative
import Control.Monad (void)
import Data.Attoparsec.ByteString.Char8
import qualified Data.ByteString.Char8 as BS
import qualified Data.ByteString.Lazy.Char8 as LBS
import Data.Maybe (fromMaybe)
import Data.String
import Data.Typeable (Typeable)

data Address
  = Address
      { Address -> ByteString
addressLocalPart :: !BS.ByteString,
        Address -> ByteString
addressDomain :: !BS.ByteString
      }
  deriving (Address -> Address -> Bool
(Address -> Address -> Bool)
-> (Address -> Address -> Bool) -> Eq Address
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Address -> Address -> Bool
$c/= :: Address -> Address -> Bool
== :: Address -> Address -> Bool
$c== :: Address -> Address -> Bool
Eq, Eq Address
Eq Address =>
(Address -> Address -> Ordering)
-> (Address -> Address -> Bool)
-> (Address -> Address -> Bool)
-> (Address -> Address -> Bool)
-> (Address -> Address -> Bool)
-> (Address -> Address -> Address)
-> (Address -> Address -> Address)
-> Ord Address
Address -> Address -> Bool
Address -> Address -> Ordering
Address -> Address -> Address
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Address -> Address -> Address
$cmin :: Address -> Address -> Address
max :: Address -> Address -> Address
$cmax :: Address -> Address -> Address
>= :: Address -> Address -> Bool
$c>= :: Address -> Address -> Bool
> :: Address -> Address -> Bool
$c> :: Address -> Address -> Bool
<= :: Address -> Address -> Bool
$c<= :: Address -> Address -> Bool
< :: Address -> Address -> Bool
$c< :: Address -> Address -> Bool
compare :: Address -> Address -> Ordering
$ccompare :: Address -> Address -> Ordering
$cp1Ord :: Eq Address
Ord, Typeable)

instance Show Address where
  show :: Address -> String
show = ByteString -> String
BS.unpack (ByteString -> String)
-> (Address -> ByteString) -> Address -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Address -> ByteString
toByteString

instance IsString Address where
  fromString :: String -> Address
fromString = Address -> Maybe Address -> Address
forall a. a -> Maybe a -> a
fromMaybe (String -> Address
forall a. HasCallStack => String -> a
error "invalid email literal") (Maybe Address -> Address)
-> (String -> Maybe Address) -> String -> Address
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Maybe Address
parseAddress (ByteString -> Maybe Address)
-> (String -> ByteString) -> String -> Maybe Address
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ByteString
BS.pack

address :: BS.ByteString -> BS.ByteString -> Address
address :: ByteString -> ByteString -> Address
address = ByteString -> ByteString -> Address
Address

toByteString :: Address -> BS.ByteString
toByteString :: Address -> ByteString
toByteString (Address l :: ByteString
l d :: ByteString
d) = [ByteString] -> ByteString
BS.concat [ByteString
l, Char -> ByteString
BS.singleton '@', ByteString
d]

toLazyByteString :: Address -> LBS.ByteString
toLazyByteString :: Address -> ByteString
toLazyByteString (Address l :: ByteString
l d :: ByteString
d) = [ByteString] -> ByteString
LBS.fromChunks [ByteString
l, Char -> ByteString
BS.singleton '@', ByteString
d]

parseAddress :: BS.ByteString -> Maybe Address
parseAddress :: ByteString -> Maybe Address
parseAddress = Result Address -> Maybe Address
forall r. Result r -> Maybe r
maybeResult (Result Address -> Maybe Address)
-> (ByteString -> Result Address) -> ByteString -> Maybe Address
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parser Address -> ByteString -> Result Address
forall a. Parser a -> ByteString -> Result a
parse Parser Address
addrSpec

-- | Address Parser. Borrowed form email-validate-2.0.1. Parser for email address.
addrSpec :: Parser Address
addrSpec :: Parser Address
addrSpec = do
  ByteString
localPart <- Parser ByteString
local
  Char
_ <- Char -> Parser Char
char '@'
  ByteString -> ByteString -> Address
Address ByteString
localPart (ByteString -> Address) -> Parser ByteString -> Parser Address
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString
domain

local :: Parser BS.ByteString
local :: Parser ByteString
local = Parser ByteString
dottedAtoms

domain :: Parser BS.ByteString
domain :: Parser ByteString
domain = Parser ByteString
dottedAtoms Parser ByteString -> Parser ByteString -> Parser ByteString
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser ByteString
domainLiteral

dottedAtoms :: Parser BS.ByteString
dottedAtoms :: Parser ByteString
dottedAtoms =
  ByteString -> [ByteString] -> ByteString
BS.intercalate (Char -> ByteString
BS.singleton '.')
    ([ByteString] -> ByteString)
-> Parser ByteString [ByteString] -> Parser ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Parser ByteString () -> Parser ByteString (Maybe ())
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional Parser ByteString ()
cfws Parser ByteString (Maybe ())
-> Parser ByteString -> Parser ByteString
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Parser ByteString
atom Parser ByteString -> Parser ByteString -> Parser ByteString
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser ByteString
quotedString) Parser ByteString
-> Parser ByteString (Maybe ()) -> Parser ByteString
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ByteString () -> Parser ByteString (Maybe ())
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional Parser ByteString ()
cfws) Parser ByteString -> Parser Char -> Parser ByteString [ByteString]
forall (f :: * -> *) a s. Alternative f => f a -> f s -> f [a]
`sepBy1` Char -> Parser Char
char '.'

atom :: Parser BS.ByteString
atom :: Parser ByteString
atom = (Char -> Bool) -> Parser ByteString
takeWhile1 Char -> Bool
isAtomText

isAtomText :: Char -> Bool
isAtomText :: Char -> Bool
isAtomText x :: Char
x = Char -> Bool
isAlphaNum Char
x Bool -> Bool -> Bool
|| String -> Char -> Bool
inClass "!#$%&'*+/=?^_`{|}~-" Char
x

domainLiteral :: Parser BS.ByteString
domainLiteral :: Parser ByteString
domainLiteral =
  Char -> ByteString -> ByteString
BS.cons '[' (ByteString -> ByteString)
-> ([ByteString] -> ByteString) -> [ByteString] -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ByteString -> Char -> ByteString)
-> Char -> ByteString -> ByteString
forall a b c. (a -> b -> c) -> b -> a -> c
flip ByteString -> Char -> ByteString
BS.snoc ']' (ByteString -> ByteString)
-> ([ByteString] -> ByteString) -> [ByteString] -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ByteString] -> ByteString
BS.concat
    ([ByteString] -> ByteString)
-> Parser ByteString [ByteString] -> Parser ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Char
-> Parser Char
-> Parser ByteString [ByteString]
-> Parser ByteString [ByteString]
forall l r x. Parser l -> Parser r -> Parser x -> Parser x
between
      (Parser ByteString () -> Parser ByteString (Maybe ())
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional Parser ByteString ()
cfws Parser ByteString (Maybe ()) -> Parser Char -> Parser Char
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Char -> Parser Char
char '[')
      (Char -> Parser Char
char ']' Parser Char -> Parser ByteString (Maybe ()) -> Parser Char
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ByteString () -> Parser ByteString (Maybe ())
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional Parser ByteString ()
cfws)
      (Parser ByteString -> Parser ByteString [ByteString]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (Parser ByteString () -> Parser ByteString (Maybe ())
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional Parser ByteString ()
fws Parser ByteString (Maybe ())
-> Parser ByteString -> Parser ByteString
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (Char -> Bool) -> Parser ByteString
takeWhile1 Char -> Bool
isDomainText) Parser ByteString [ByteString]
-> Parser ByteString (Maybe ()) -> Parser ByteString [ByteString]
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ByteString () -> Parser ByteString (Maybe ())
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional Parser ByteString ()
fws)

isDomainText :: Char -> Bool
isDomainText :: Char -> Bool
isDomainText x :: Char
x = String -> Char -> Bool
inClass "\33-\90\94-\126" Char
x Bool -> Bool -> Bool
|| Char -> Bool
isObsNoWsCtl Char
x

quotedString :: Parser BS.ByteString
quotedString :: Parser ByteString
quotedString =
  (\x :: [ByteString]
x -> [ByteString] -> ByteString
BS.concat [Char -> ByteString
BS.singleton '"', [ByteString] -> ByteString
BS.concat [ByteString]
x, Char -> ByteString
BS.singleton '"'])
    ([ByteString] -> ByteString)
-> Parser ByteString [ByteString] -> Parser ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Char
-> Parser Char
-> Parser ByteString [ByteString]
-> Parser ByteString [ByteString]
forall l r x. Parser l -> Parser r -> Parser x -> Parser x
between
      (Char -> Parser Char
char '"')
      (Char -> Parser Char
char '"')
      (Parser ByteString -> Parser ByteString [ByteString]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (Parser ByteString () -> Parser ByteString (Maybe ())
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional Parser ByteString ()
fws Parser ByteString (Maybe ())
-> Parser ByteString -> Parser ByteString
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Parser ByteString
quotedContent) Parser ByteString [ByteString]
-> Parser ByteString (Maybe ()) -> Parser ByteString [ByteString]
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ByteString () -> Parser ByteString (Maybe ())
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional Parser ByteString ()
fws)

quotedContent :: Parser BS.ByteString
quotedContent :: Parser ByteString
quotedContent = (Char -> Bool) -> Parser ByteString
takeWhile1 Char -> Bool
isQuotedText Parser ByteString -> Parser ByteString -> Parser ByteString
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser ByteString
quotedPair

isQuotedText :: Char -> Bool
isQuotedText :: Char -> Bool
isQuotedText x :: Char
x = String -> Char -> Bool
inClass "\33\35-\91\93-\126" Char
x Bool -> Bool -> Bool
|| Char -> Bool
isObsNoWsCtl Char
x

quotedPair :: Parser BS.ByteString
quotedPair :: Parser ByteString
quotedPair = Char -> ByteString -> ByteString
BS.cons '\\' (ByteString -> ByteString)
-> (Char -> ByteString) -> Char -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ByteString
BS.singleton (Char -> ByteString) -> Parser Char -> Parser ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Char -> Parser Char
char '\\' Parser Char -> Parser Char -> Parser Char
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Parser Char
vchar Parser Char -> Parser Char -> Parser Char
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Char
wsp Parser Char -> Parser Char -> Parser Char
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Char
lf Parser Char -> Parser Char -> Parser Char
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Char
cr Parser Char -> Parser Char -> Parser Char
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Char
obsNoWsCtl Parser Char -> Parser Char -> Parser Char
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Char
nullChar))

cfws :: Parser ()
cfws :: Parser ByteString ()
cfws = Parser [()] -> Parser ByteString ()
forall a. Parser a -> Parser ByteString ()
ignore (Parser [()] -> Parser ByteString ())
-> Parser [()] -> Parser ByteString ()
forall a b. (a -> b) -> a -> b
$ Parser ByteString () -> Parser [()]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (Parser ByteString ()
comment Parser ByteString ()
-> Parser ByteString () -> Parser ByteString ()
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser ByteString ()
fws)

fws :: Parser ()
fws :: Parser ByteString ()
fws =
  Parser ByteString () -> Parser ByteString ()
forall a. Parser a -> Parser ByteString ()
ignore (Parser ByteString () -> Parser ByteString ())
-> Parser ByteString () -> Parser ByteString ()
forall a b. (a -> b) -> a -> b
$
    Parser ByteString (Maybe ()) -> Parser ByteString ()
forall a. Parser a -> Parser ByteString ()
ignore (Parser ByteString ()
wsp1 Parser ByteString ()
-> Parser ByteString (Maybe ()) -> Parser ByteString (Maybe ())
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Parser ByteString () -> Parser ByteString (Maybe ())
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Parser ByteString ()
crlf Parser ByteString ()
-> Parser ByteString () -> Parser ByteString ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Parser ByteString ()
wsp1))
      Parser ByteString ()
-> Parser ByteString () -> Parser ByteString ()
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser [()] -> Parser ByteString ()
forall a. Parser a -> Parser ByteString ()
ignore (Parser ByteString () -> Parser [()]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many1 (Parser ByteString ()
crlf Parser ByteString ()
-> Parser ByteString () -> Parser ByteString ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Parser ByteString ()
wsp1))

ignore :: Parser a -> Parser ()
ignore :: Parser a -> Parser ByteString ()
ignore = Parser a -> Parser ByteString ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void

between :: Parser l -> Parser r -> Parser x -> Parser x
between :: Parser l -> Parser r -> Parser x -> Parser x
between l :: Parser l
l r :: Parser r
r x :: Parser x
x = Parser l
l Parser l -> Parser x -> Parser x
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser x
x Parser x -> Parser r -> Parser x
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser r
r

comment :: Parser ()
comment :: Parser ByteString ()
comment =
  Parser [()] -> Parser ByteString ()
forall a. Parser a -> Parser ByteString ()
ignore
    ( Parser Char -> Parser Char -> Parser [()] -> Parser [()]
forall l r x. Parser l -> Parser r -> Parser x -> Parser x
between (Char -> Parser Char
char '(') (Char -> Parser Char
char ')') (Parser [()] -> Parser [()]) -> Parser [()] -> Parser [()]
forall a b. (a -> b) -> a -> b
$
        Parser ByteString () -> Parser [()]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (Parser ByteString () -> Parser ByteString ()
forall a. Parser a -> Parser ByteString ()
ignore Parser ByteString ()
commentContent Parser ByteString ()
-> Parser ByteString () -> Parser ByteString ()
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser ByteString ()
fws)
    )

commentContent :: Parser ()
commentContent :: Parser ByteString ()
commentContent = (Char -> Bool) -> Parser ByteString ()
skipWhile1 Char -> Bool
isCommentText Parser ByteString ()
-> Parser ByteString () -> Parser ByteString ()
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser ByteString -> Parser ByteString ()
forall a. Parser a -> Parser ByteString ()
ignore Parser ByteString
quotedPair Parser ByteString ()
-> Parser ByteString () -> Parser ByteString ()
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser ByteString ()
comment

isCommentText :: Char -> Bool
isCommentText :: Char -> Bool
isCommentText x :: Char
x = String -> Char -> Bool
inClass "\33-\39\42-\91\93-\126" Char
x Bool -> Bool -> Bool
|| Char -> Bool
isObsNoWsCtl Char
x

nullChar :: Parser Char
nullChar :: Parser Char
nullChar = Char -> Parser Char
char '\0'

skipWhile1 :: (Char -> Bool) -> Parser ()
skipWhile1 :: (Char -> Bool) -> Parser ByteString ()
skipWhile1 x :: Char -> Bool
x = (Char -> Bool) -> Parser Char
satisfy Char -> Bool
x Parser Char -> Parser ByteString () -> Parser ByteString ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (Char -> Bool) -> Parser ByteString ()
skipWhile Char -> Bool
x

wsp1 :: Parser ()
wsp1 :: Parser ByteString ()
wsp1 = (Char -> Bool) -> Parser ByteString ()
skipWhile1 Char -> Bool
isWsp

wsp :: Parser Char
wsp :: Parser Char
wsp = (Char -> Bool) -> Parser Char
satisfy Char -> Bool
isWsp

isWsp :: Char -> Bool
isWsp :: Char -> Bool
isWsp x :: Char
x = Char
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== ' ' Bool -> Bool -> Bool
|| Char
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== '\t'

isAlphaNum :: Char -> Bool
isAlphaNum :: Char -> Bool
isAlphaNum x :: Char
x = Char -> Bool
isDigit Char
x Bool -> Bool -> Bool
|| Char -> Bool
isAlpha_ascii Char
x

cr :: Parser Char
cr :: Parser Char
cr = Char -> Parser Char
char '\r'

lf :: Parser Char
lf :: Parser Char
lf = Char -> Parser Char
char '\n'

crlf :: Parser ()
crlf :: Parser ByteString ()
crlf = Parser Char
cr Parser Char -> Parser Char -> Parser Char
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Parser Char
lf Parser Char -> Parser ByteString () -> Parser ByteString ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> () -> Parser ByteString ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

isVchar :: Char -> Bool
isVchar :: Char -> Bool
isVchar = String -> Char -> Bool
inClass "\x21-\x7e"

vchar :: Parser Char
vchar :: Parser Char
vchar = (Char -> Bool) -> Parser Char
satisfy Char -> Bool
isVchar

isObsNoWsCtl :: Char -> Bool
isObsNoWsCtl :: Char -> Bool
isObsNoWsCtl = String -> Char -> Bool
inClass "\1-\8\11-\12\14-\31\127"

obsNoWsCtl :: Parser Char
obsNoWsCtl :: Parser Char
obsNoWsCtl = (Char -> Bool) -> Parser Char
satisfy Char -> Bool
isObsNoWsCtl