More strict emails

2020-12-11 17:53:08 +02:00
parent a4da4f73da
commit 7f6b318fcb
2 changed files with 7 additions and 5 deletions
--- a/src/Data/Email/Header.hs
+++ b/src/Data/Email/Header.hs
@ -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)