From 59ce971e96ab36bfb0099b0f6ec9d26e028cc667 Mon Sep 17 00:00:00 2001 From: Philippe Pittoli Date: Tue, 30 Jan 2024 01:47:06 +0100 Subject: [PATCH] WIP: RFC5322. --- src/GenericParser/EmailAddress.purs | 169 +++++++++++++++++++--------- 1 file changed, 113 insertions(+), 56 deletions(-) diff --git a/src/GenericParser/EmailAddress.purs b/src/GenericParser/EmailAddress.purs index 5aa7ace..f0909f3 100644 --- a/src/GenericParser/EmailAddress.purs +++ b/src/GenericParser/EmailAddress.purs @@ -8,7 +8,7 @@ import Control.Alt ((<|>)) import Data.Array as A import Data.Char as C import Data.Either (Either(..)) -import Data.Maybe (Maybe(..)) +import Data.Maybe (Maybe(..), maybe) import Data.String.CodeUnits as CU import GenericParser.Parser (Parser(..) @@ -24,6 +24,9 @@ data EmailError = InvalidCharacter | InvalidDomain (Maybe DomainError) +id :: forall a. a -> a +id x = x + -- | obs-FWS: obsolete folding white space. -- | -- | obs-FWS = 1*WSP *(CRLF 1*WSP) @@ -95,44 +98,45 @@ cfws = do void $ many1 $ do _ <- tryMaybe fws -- | TODO: `address`: email address. -- | -- | address = mailbox / group ---address :: forall e. Parser e String ---address = mailbox <|> group +address :: forall e. Parser e String +address = mailbox <|> group -- | TODO: `mailbox`: mail address. -- | -- | mailbox = name-addr / addr-spec ---mailbox :: forall e. Parser e String ---mailbox = name_addr <|> addr_spec +mailbox :: forall e. Parser e String +mailbox = name_addr <|> addr_spec -- | TODO: `name_addr`: address name. -- | -- | name-addr = [display-name] angle-addr ---name_addr :: forall e. Parser e String ---name_addr = do _ <- tryMaybe display_name --- angle_addr +name_addr :: forall e. Parser e String +name_addr = do _ <- tryMaybe display_name + angle_addr -- | TODO: `angle_addr` address specification between '<' and '>' characters. -- | -- | angle-addr = [CFWS] "<" addr-spec ">" [CFWS] / obs-angle-addr ---angle_addr :: forall e. Parser e String ---angle_addr = do _ <- tryMaybe cfws --- _ <- char '<' --- a <- addr_spec --- _ <- char '>' --- _ <- tryMaybe cfws --- pure a --- <|> obs_angle_addr +angle_addr :: forall e. Parser e String +angle_addr = do _ <- tryMaybe cfws + _ <- char '<' + a <- addr_spec + _ <- char '>' + _ <- tryMaybe cfws + pure a + <|> obs_angle_addr -- | TODO: `group`: a list of email addresses. -- | -- | group = display-name ":" [group-list] ";" [CFWS] ---group :: forall e. Parser e (Array String) ---group = do _ <- display_name --- _ <- char ':' --- mg <- tryMaybe group_list --- _ <- char ';' --- _ <- tryMaybe cfws --- pure $ maybe [] xs +group :: forall e. Parser e String +group = do _ <- display_name + _ <- char ':' + xs <- tryMaybe group_list + _ <- char ';' + _ <- tryMaybe cfws + let res = ":" <> maybe "" id xs <> ";" + pure res -- | `display_name`: displayed name, not the actual email address. -- | @@ -140,11 +144,25 @@ cfws = do void $ many1 $ do _ <- tryMaybe fws display_name :: forall e. Parser e String display_name = phrase ---mailbox-list = (mailbox *("," mailbox)) / obs-mbox-list --- +-- | `mailbox_list` +-- | +-- | mailbox-list = (mailbox *("," mailbox)) / obs-mbox-list +mailbox_list :: forall e. Parser e String +mailbox_list = do mb <- mailbox + xs <- A.many $ do _ <- char ',' + mx <- mailbox + pure $ "," <> mx + pure $ mb <> A.fold xs + <|> obs_mbox_list + --address-list = (address *("," address)) / obs-addr-list --- ---group-list = mailbox-list / CFWS / obs-group-list + +-- | `group_list` +-- | +-- | group-list = mailbox-list / CFWS / obs-group-list +group_list :: forall e. Parser e String +group_list = mailbox_list <|> do _ <- cfws <|> obs_group_list + pure "" -- | `atext`: atom accepted characters. @@ -221,9 +239,21 @@ specials = char '(' <|> char '"' --- addr-spec = local-part "@" domain --- --- local-part = dot-atom / quoted-string / obs-local-part +-- | `addr_spec` +-- | +-- | addr-spec = local-part "@" domain +addr_spec :: forall e. Parser e String +addr_spec = do lpart <- local_part + _ <- char '@' + dom <- domain + pure $ lpart <> "@" <> dom + +-- | `local_part` +-- | +-- | local-part = dot-atom / quoted-string / obs-local-part +local_part :: forall e. Parser e String +local_part = dot_atom <|> quoted_string <|> obs_local_part + -- | `domain` -- | @@ -258,14 +288,14 @@ dtext = CU.singleton <$> sat cond <|> obs_dtext -- | TODO: `obs_angle_addr`: obsolete address specification between '<' and '>' characters. -- | -- | obs-angle-addr = [CFWS] "<" obs-route addr-spec ">" [CFWS] ---obs_angle_addr :: forall e. Parser e String ---obs_angle_addr = do _ <- tryMaybe cfws --- _ <- char '<' --- r <- obs_route --- a <- addr_spec --- _ <- char '>' --- _ <- tryMaybe cfws --- pure $ r <> a +obs_angle_addr :: forall e. Parser e String +obs_angle_addr = do _ <- tryMaybe cfws + _ <- char '<' + r <- obs_route + a <- addr_spec + _ <- char '>' + _ <- tryMaybe cfws + pure $ r <> a -- | `obs_route` -- | @@ -285,14 +315,41 @@ obs_domain_list = do _ <- A.many $ cfws <|> do _ <- char ',' _ <- char '@' domain ---obs-mbox-list = *([CFWS] ",") mailbox *("," [mailbox / CFWS]) --- +-- | `obs_mbox_list` +-- | +-- | obs-mbox-list = *([CFWS] ",") mailbox *("," [mailbox / CFWS]) +obs_mbox_list :: forall e. Parser e String +obs_mbox_list = do _ <- A.many $ do _ <- cfws + _ <- char ',' + pure unit + mb <- mailbox + xs <- A.many $ do _ <- char ',' + x <- mailbox <|> do _ <- cfws + pure "" + pure x + pure $ mb <> A.fold xs + --obs-addr-list = *([CFWS] ",") address *("," [address / CFWS]) --- ---obs-group-list = 1*([CFWS] ",") [CFWS] --- ---obs-local-part = word *("." word) --- + +-- | `obs_group_list` +-- | +-- | obs-group-list = 1*([CFWS] ",") [CFWS] +obs_group_list :: forall e. Parser e Unit +obs_group_list = do _ <- many1 $ do _ <- tryMaybe cfws + char ',' + _ <- tryMaybe cfws + pure unit + +-- | `obs_local_part` +-- | +-- | obs-local-part = word *("." word) +obs_local_part :: forall e. Parser e String +obs_local_part = do w <- word + ws <- A.many $ do _ <- char '.' + w1 <- word + pure $ "." <> w1 + pure $ w <> A.fold ws + -- | `obs_domain` -- | -- | obs-domain = atom *("." atom) @@ -476,20 +533,20 @@ quoted_string = do _ <- tryMaybe cfws -- | (a) the first character is a letter, -- | (b) the last character is either a letter or a digit. -- | The rest can be any letter, digit, '-' or '.'. -local_part :: Parser EmailError String -local_part = do firstchar <- letter - rest <- until end (letter <|> digit <|> char '-' <|> char '.') - lastchar <- letter <|> digit - pure $ CU.fromCharArray $ [firstchar] <> rest <> [lastchar] - where - end :: forall e. Parser e Char - end = do c <- item - _ <- char '@' - pure c +local_part' :: Parser EmailError String +local_part' = do firstchar <- letter + rest <- until end (letter <|> digit <|> char '-' <|> char '.') + lastchar <- letter <|> digit + pure $ CU.fromCharArray $ [firstchar] <> rest <> [lastchar] + where + end :: forall e. Parser e Char + end = do c <- item + _ <- char '@' + pure c -- | `email` is the parser for email addresses. email :: Parser EmailError String -email = do login <- local_part +email = do login <- local_part' _ <- char '@' input <- current_input case parse sub_eof input of