More strict emails

This commit is contained in:
Mats Rauhala 2020-12-11 17:53:08 +02:00
parent a4da4f73da
commit 7f6b318fcb
2 changed files with 7 additions and 5 deletions

View File

@ -38,13 +38,13 @@ decode = parseOnly parseHeader
bracketEmail :: Parser Text
bracketEmail = do
_ <- manyTill anyChar (char '<')
T.pack <$> manyTill anyChar (char '>')
email
email :: Parser Text
email = do
_ <- many' space
name <- T.pack <$> many' (notChar '@')
name <- T.pack <$> many' (satisfy (\c -> not (isSpace c) && c /= '@'))
_ <- char '@'
rest <- T.pack <$> many' (satisfy (\c -> not (isSpace c) && c /= ','))
rest <- T.pack <$> many' (satisfy (\c -> not (isSpace c) && c /= ',' && c /= '>'))
_ <- many' (notChar ',')
pure (name <> "@" <> rest)

View File

@ -17,9 +17,11 @@ sample :: ByteString
sample =
"Subject: Hello worldddd\n\
\From: me@example.com\n\
\Dkim: asd\n\
\To: you <you@example.com>\n\
\ \n\n \
\foo"
\\n\n\
\From: foo bar <a mailto=\"me2@example.com\" />\n\
\asd\n"
parseToList :: ByteString -> IO [Header]
parseToList _ = runConduit (CB.sourceLbs sample .| parseEmail .| CL.consume)