{-# LANGUAGE FlexibleContexts #-}
module Text.Parsec.Rfc2822 where
import Text.Parsec.Rfc2234 hiding ( quoted_pair, quoted_string )
import Control.Monad ( replicateM, guard )
import Data.Char ( ord )
import Data.Functor
import Data.List ( intercalate )
import Data.Maybe ( catMaybes )
import Data.Monoid ( Monoid, mempty )
import Data.Time.Calendar
import Data.Time.LocalTime
import Text.Parsec hiding ( crlf )
{-# ANN module "HLint: ignore Use camelCase" #-}
maybeOption :: Stream s m Char => ParsecT s u m a -> ParsecT s u m (Maybe a)
maybeOption p = option Nothing (fmap Just p)
unfold :: Stream s m Char => ParsecT s u m a -> ParsecT s u m a
unfold = between (optional cfws) (optional cfws)
header :: Stream s m Char => String -> ParsecT s u m a -> ParsecT s u m a
header n p = let nameString = caseString (n ++ ":")
in
between nameString crlf p <?> (n ++ " header line")
obs_header :: Stream s m Char => String -> ParsecT s u m a -> ParsecT s u m a
obs_header n p = let nameString = caseString n >> many wsp >> char ':'
in
between nameString crlf p <?> ("obsolete " ++ n ++ " header line")
no_ws_ctl :: Stream s m Char => ParsecT s u m Char
no_ws_ctl = satisfy (\c -> ord c `elem` ([1..8] ++ [11,12] ++ [14..31] ++ [127]))
<?> "US-ASCII non-whitespace control character"
text :: Stream s m Char => ParsecT s u m Char
text = satisfy (\c -> ord c `elem` ([1..9] ++ [11,12] ++ [14..127]))
<?> "US-ASCII character (excluding CR and LF)"
specials :: Stream s m Char => ParsecT s u m Char
specials = oneOf "()<>[]:;@,.\\\"" <?> "one of ()<>[]:;@,.\\\""
quoted_pair :: Stream s m Char => ParsecT s u m String
quoted_pair = try obs_qp <|> do { _ <- char '\\'; r <- text; return ['\\',r] }
<?> "quoted pair"
fws :: Stream s m Char => ParsecT s u m String
fws = do r <- many1 $ choice [ blanks, linebreak]
return (concat r)
where
blanks = many1 wsp
linebreak = try $ do { r1 <- crlf; r2 <- blanks; return (r1 ++ r2) }
ctext :: Stream s m Char => ParsecT s u m Char
ctext = no_ws_ctl <|> satisfy (\c -> ord c `elem` ([33..39] ++ [42..91] ++ [93..126] ++ [128..255]))
<?> "any regular character (excluding '(', ')', and '\\')"
comment :: Stream s m Char => ParsecT s u m String
comment = do _ <- char '('
r1 <- many ccontent
r2 <- option [] fws
_ <- char ')'
return ("(" ++ concat r1 ++ r2 ++ ")")
<?> "comment"
where
ccontent = try $ do r1 <- option [] fws
r2 <- choice [many1 ctext, quoted_pair, comment]
return (r1 ++ r2)
cfws :: Stream s m Char => ParsecT s u m String
cfws = do r <- many1 $ choice [ fws, comment ]
return (concat r)
atext :: Stream s m Char => ParsecT s u m Char
atext = alpha <|> digit <|> oneOf "!#$%&'*+-/=?^_`{|}~"
<?> "US-ASCII character (excluding controls, space, and specials)"
atom :: Stream s m Char => ParsecT s u m String
atom = unfold (many1 atext <?> "atom")
dot_atom :: Stream s m Char => ParsecT s u m String
dot_atom = unfold (dot_atom_text <?> "dot atom")
dot_atom_text :: Stream s m Char => ParsecT s u m String
dot_atom_text = fmap (intercalate ".") (sepBy1 (many1 atext) (char '.'))
<?> "dot atom content"
qtext :: Stream s m Char => ParsecT s u m Char
qtext = no_ws_ctl <|> satisfy (\c -> ord c `elem` ([33] ++ [35..91] ++ [93..126]))
<?> "US-ASCII character (excluding '\\', and '\"')"
qcontent :: Stream s m Char => ParsecT s u m String
qcontent = many1 qtext <|> quoted_pair
<?> "quoted string content"
quoted_string :: Stream s m Char => ParsecT s u m String
quoted_string = unfold (do _ <- dquote
r1 <- many (do r1 <- option [] fws
r2 <- qcontent
return (r1 ++ r2))
r2 <- option [] fws
_ <- dquote
return ("\"" ++ concat r1 ++ r2 ++ "\""))
<?> "quoted string"
word :: Stream s m Char => ParsecT s u m String
word = unfold (atom <|> quoted_string) <?> "word"
phrase :: Stream s m Char => ParsecT s u m [String]
phrase = obs_phrase
utext :: Stream s m Char => ParsecT s u m Char
utext = no_ws_ctl <|> satisfy (\c -> ord c `elem` [33..126])
<?> "regular US-ASCII character (excluding '\\', and '\"')"
unstructured :: Stream s m Char => ParsecT s u m String
unstructured = do r1 <- option [] fws
r2 <- many (do r3 <- utext
r4 <- option [] fws
return (r3 : r4))
return (r1 ++ concat r2)
<?> "unstructured text"
date_time :: Stream s m Char => ParsecT s u m ZonedTime
date_time = do optional (try (day_of_week >> char ','))
day <- date
_ <- fws
(td,z) <- time
optional cfws
return (ZonedTime (LocalTime day td) z)
<?> "date/time specification"
day_of_week :: Stream s m Char => ParsecT s u m String
day_of_week = try (between (optional fws) (optional fws) day_name <?> "name of a day-of-the-week")
<|> obs_day_of_week
day_name :: Stream s m Char => ParsecT s u m String
day_name = caseString "Mon"
<|> try (caseString "Tue")
<|> caseString "Wed"
<|> caseString "Thu"
<|> caseString "Fri"
<|> try (caseString "Sat")
<|> caseString "Sun"
<?> "name of a day-of-the-week"
date :: Stream s m Char => ParsecT s u m Day
date = do d <- day
m <- month
y <- year
return (fromGregorian (fromIntegral y) m d)
<?> "date specification"
year :: Stream s m Char => ParsecT s u m Int
year = do y <- manyN 4 digit
return (read y :: Int)
<?> "year"
month :: Stream s m Char => ParsecT s u m Int
month = try (between (optional fws) (optional fws) month_name <?> "month name")
<|> obs_month
month_name :: Stream s m Char => ParsecT s u m Int
month_name = (try (caseString "Jan") $> 1)
<|> (caseString "Feb" $> 2)
<|> (try (caseString "Mar") $> 3)
<|> (try (caseString "Apr") $> 4)
<|> (caseString "May" $> 5)
<|> (try (caseString "Jun") $> 6)
<|> (caseString "Jul" $> 7)
<|> (caseString "Aug" $> 8)
<|> (caseString "Sep" $> 9)
<|> (caseString "Oct" $> 10)
<|> (caseString "Nov" $> 11)
<|> (caseString "Dec" $> 12)
<?> "month name"
day_of_month :: Stream s m Char => ParsecT s u m Int
day_of_month = do r <- fmap read (manyNtoM 1 2 digit)
guard (r >= 1 && r < 31)
return r
day :: Stream s m Char => ParsecT s u m Int
day = try obs_day <|> day_of_month <?> "day"
time :: Stream s m Char => ParsecT s u m (TimeOfDay, TimeZone)
time = do t <- time_of_day
_ <- fws
z <- zone
return (t,z)
<?> "time and zone specification"
time_of_day :: Stream s m Char => ParsecT s u m TimeOfDay
time_of_day = do h <- hour
_ <- char ':'
m <- minute
s <- option 0 (do { _ <- char ':'; second } )
return (TimeOfDay h m (fromIntegral s))
<?> "time specification"
hour :: Stream s m Char => ParsecT s u m Int
hour = do r <- fmap read (replicateM 2 digit)
guard (r >= 0 && r <= 24)
return r
<?> "hour"
minute :: Stream s m Char => ParsecT s u m Int
minute = do r <- fmap read (replicateM 2 digit)
guard (r >= 0 && r <= 60)
return r
<?> "minute"
second :: Stream s m Char => ParsecT s u m Int
second = minute <?> "second"
zone :: Stream s m Char => ParsecT s u m TimeZone
zone = do sign <- choice [char '+' $> 1, char '-' $> (-1) ]
h <- hour
m <- minute
return (minutesToTimeZone (sign*((h*60)+m)))
<|> obs_zone
data NameAddr = NameAddr { nameAddr_name :: Maybe String
, nameAddr_addr :: String
}
deriving (Show,Eq)
address :: Stream s m Char => ParsecT s u m [NameAddr]
address = try (do { r <- mailbox; return [r] }) <|> group
<?> "address"
mailbox :: Stream s m Char => ParsecT s u m NameAddr
mailbox = try name_addr <|> fmap (NameAddr Nothing) addr_spec
<?> "mailbox"
name_addr :: Stream s m Char => ParsecT s u m NameAddr
name_addr = (NameAddr <$> maybeOption display_name <*> angle_addr) <?> "name address"
angle_addr :: Stream s m Char => ParsecT s u m String
angle_addr = try (unfold (do _ <- char '<'
r <- addr_spec
_ <- char '>'
return r)
<?> "angle address"
)
<|> obs_angle_addr
group :: Stream s m Char => ParsecT s u m [NameAddr]
group = do _ <- display_name
_ <- char ':'
r <- option [] mailbox_list
_ <- unfold $ char ';'
return r
<?> "address group"
display_name :: Stream s m Char => ParsecT s u m String
display_name = fmap unwords phrase
<?> "display name"
mailbox_list :: Stream s m Char => ParsecT s u m [NameAddr]
mailbox_list = sepBy mailbox (char ',') <?> "mailbox list"
address_list :: Stream s m Char => ParsecT s u m [NameAddr]
address_list = do { r <-sepBy address (char ','); return (concat r) }
<?> "address list"
addr_spec :: Stream s m Char => ParsecT s u m String
addr_spec = do r1 <- local_part
_ <- char '@'
r2 <- domain
return (r1 ++ "@" ++ r2)
<?> "address specification"
local_part :: Stream s m Char => ParsecT s u m String
local_part = try obs_local_part <|> dot_atom <|> quoted_string
<?> "address' local part"
domain :: Stream s m Char => ParsecT s u m String
domain = try obs_domain <|> dot_atom <|> domain_literal
<?> "address' domain part"
domain_literal :: Stream s m Char => ParsecT s u m String
domain_literal = unfold (do _ <- char '['
r <- many (optional fws >> dcontent)
optional fws
_ <- char ']'
return ("[" ++ concat r ++ "]"))
<?> "domain literal"
dcontent :: Stream s m Char => ParsecT s u m String
dcontent = many1 dtext <|> quoted_pair
<?> "domain literal content"
dtext :: Stream s m Char => ParsecT s u m Char
dtext = no_ws_ctl
<|> satisfy (\c -> ord c `elem` ([33..90] ++ [94..126]))
<?> "any ASCII character (excluding '[', ']', and '\\')"
data GenericMessage a = Message [Field] a deriving Show
message :: (Monoid s, Stream s m Char) => ParsecT s u m (GenericMessage s)
message = do f <- fields
b <- option mempty (do _ <- crlf; body)
return (Message f b)
body :: (Monoid s, Monad m) => ParsecT s u m s
body = do v <- getInput
setInput mempty
return v
data Field = OptionalField String String
| From [NameAddr]
| Sender NameAddr
| ReturnPath String
| ReplyTo [NameAddr]
| To [NameAddr]
| Cc [NameAddr]
| Bcc [NameAddr]
| MessageID String
| InReplyTo [String]
| References [String]
| Subject String
| Comments String
| Keywords [[String]]
| Date ZonedTime
| ResentDate ZonedTime
| ResentFrom [NameAddr]
| ResentSender NameAddr
| ResentTo [NameAddr]
| ResentCc [NameAddr]
| ResentBcc [NameAddr]
| ResentMessageID String
| ResentReplyTo [NameAddr]
| Received ([(String,String)], ZonedTime)
| ObsReceived [(String,String)]
deriving (Show)
fields :: Stream s m Char => ParsecT s u m [Field]
fields = many $ choice
[ try (From <$> from)
, try (Sender <$> sender)
, try (ReturnPath <$> return_path)
, try (ReplyTo <$> reply_to)
, try (To <$> to)
, try (Cc <$> cc)
, try (Bcc <$> bcc)
, try (MessageID <$> message_id)
, try (InReplyTo <$> in_reply_to)
, try (References <$> references)
, try (Subject <$> subject)
, try (Comments <$> comments)
, try (Keywords <$> keywords)
, try (Date <$> orig_date)
, try (ResentDate <$> resent_date)
, try (ResentFrom <$> resent_from)
, try (ResentSender <$> resent_sender)
, try (ResentTo <$> resent_to)
, try (ResentCc <$> resent_cc)
, try (ResentBcc <$> resent_bcc)
, try (ResentMessageID <$> resent_msg_id)
, try (Received <$> received)
, uncurry OptionalField <$> optional_field
]
orig_date :: Stream s m Char => ParsecT s u m ZonedTime
orig_date = header "Date" date_time
from :: Stream s m Char => ParsecT s u m [NameAddr]
from = header "From" mailbox_list
sender :: Stream s m Char => ParsecT s u m NameAddr
sender = header "Sender" mailbox
reply_to :: Stream s m Char => ParsecT s u m [NameAddr]
reply_to = header "Reply-To" address_list
to :: Stream s m Char => ParsecT s u m [NameAddr]
to = header "To" address_list
cc :: Stream s m Char => ParsecT s u m [NameAddr]
cc = header "Cc" address_list
bcc :: Stream s m Char => ParsecT s u m [NameAddr]
bcc = header "Bcc" (try address_list <|> do { optional cfws; return [] })
message_id :: Stream s m Char => ParsecT s u m String
message_id = header "Message-ID" msg_id
in_reply_to :: Stream s m Char => ParsecT s u m [String]
in_reply_to = header "In-Reply-To" (many1 msg_id)
references :: Stream s m Char => ParsecT s u m [String]
references = header "References" (many1 msg_id)
msg_id :: Stream s m Char => ParsecT s u m String
msg_id = unfold (do _ <- char '<'
idl <- id_left
_ <- char '@'
idr <- id_right
_ <- char '>'
return ("<" ++ idl ++ "@" ++ idr ++ ">"))
<?> "message ID"
id_left :: Stream s m Char => ParsecT s u m String
id_left = dot_atom_text <|> no_fold_quote
<?> "left part of an message ID"
id_right :: Stream s m Char => ParsecT s u m String
id_right = dot_atom_text <|> no_fold_literal
<?> "right part of an message ID"
no_fold_quote :: Stream s m Char => ParsecT s u m String
no_fold_quote = do _ <- dquote
r <- many (many1 qtext <|> quoted_pair)
_ <- dquote
return ("\"" ++ concat r ++ "\"")
<?> "non-folding quoted string"
no_fold_literal :: Stream s m Char => ParsecT s u m String
no_fold_literal = do _ <- char '['
r <- many (many1 dtext <|> quoted_pair)
_ <- char ']'
return ("[" ++ concat r ++ "]")
<?> "non-folding domain literal"
subject :: Stream s m Char => ParsecT s u m String
subject = header "Subject" unstructured
comments :: Stream s m Char => ParsecT s u m String
comments = header "Comments" unstructured
keywords :: Stream s m Char => ParsecT s u m [[String]]
keywords = header "Keywords" (do r1 <- phrase
r2 <- many (do _ <- char ','; phrase)
return (r1:r2))
resent_date :: Stream s m Char => ParsecT s u m ZonedTime
resent_date = header "Resent-Date" date_time
resent_from :: Stream s m Char => ParsecT s u m [NameAddr]
resent_from = header "Resent-From" mailbox_list
resent_sender :: Stream s m Char => ParsecT s u m NameAddr
resent_sender = header "Resent-Sender" mailbox
resent_to :: Stream s m Char => ParsecT s u m [NameAddr]
resent_to = header "Resent-To" address_list
resent_cc :: Stream s m Char => ParsecT s u m [NameAddr]
resent_cc = header "Resent-Cc" address_list
resent_bcc :: Stream s m Char => ParsecT s u m [NameAddr]
resent_bcc = header "Resent-Bcc" ( try address_list
<|> do optional cfws
return []
)
<?> "Resent-Bcc: header line"
resent_msg_id :: Stream s m Char => ParsecT s u m String
resent_msg_id = header "Resent-Message-ID" msg_id
return_path :: Stream s m Char => ParsecT s u m String
return_path = header "Return-Path" path
path :: Stream s m Char => ParsecT s u m String
path = unfold ( try (do _ <- char '<'
r <- option "" addr_spec
_ <- char '>'
return ("<" ++ r ++ ">")
)
<|> obs_path
)
<?> "return path spec"
received :: Stream s m Char => ParsecT s u m ([(String,String)], ZonedTime)
received = header "Received" (do r1 <- name_val_list
_ <- char ';'
r2 <- date_time
return (r1,r2))
name_val_list :: Stream s m Char => ParsecT s u m [(String,String)]
name_val_list = do optional cfws
many1 name_val_pair
<?> "list of name/value pairs"
name_val_pair :: Stream s m Char => ParsecT s u m (String,String)
name_val_pair = do r1 <- item_name
_ <- cfws
r2 <- item_value
return (r1,r2)
<?> "a name/value pair"
item_name :: Stream s m Char => ParsecT s u m String
item_name = do r1 <- alpha
r2 <- many $ choice [ char '-', alpha, digit ]
return (r1 : r2)
<?> "name of a name/value pair"
item_value :: Stream s m Char => ParsecT s u m String
item_value = choice [ try (do { r <- many1 angle_addr; return (concat r) })
, try addr_spec
, try domain
, msg_id
, try atom
]
<?> "value of a name/value pair"
{-# ANN optional_field "HLint: ignore Reduce duplication" #-}
optional_field :: Stream s m Char => ParsecT s u m (String,String)
optional_field = do n <- field_name
_ <- char ':'
b <- unstructured
_ <- crlf
return (n,b)
<?> "optional (unspecified) header line"
field_name :: Stream s m Char => ParsecT s u m String
field_name = many1 ftext <?> "header line name"
ftext :: Stream s m Char => ParsecT s u m Char
ftext = satisfy (\c -> ord c `elem` ([33..57] ++ [59..126]))
<?> "character (excluding controls, space, and ':')"
obs_qp :: Stream s m Char => ParsecT s u m String
obs_qp = do _ <- char '\\'
c <- satisfy (\c -> ord c `elem` [0..127])
return ['\\',c]
<?> "any quoted US-ASCII character"
obs_text :: Stream s m Char => ParsecT s u m String
obs_text = do r1 <- many lf
r2 <- many cr
r3 <- many (do r4 <- obs_char
r5 <- many lf
r6 <- many cr
return (r4 : (r5 ++ r6)))
return (r1 ++ r2 ++ concat r3)
obs_char :: Stream s m Char => ParsecT s u m Char
obs_char = satisfy (\c -> ord c `elem` ([0..9] ++ [11,12] ++ [14..127]))
<?> "any ASCII character except CR and LF"
obs_utext :: Stream s m Char => ParsecT s u m String
obs_utext = obs_text
obs_phrase :: Stream s m Char => ParsecT s u m [String]
obs_phrase = do r1 <- word
r2 <- many $ choice [ word
, string "."
, do { _ <- cfws; return [] }
]
return (r1 : filter (/=[]) r2)
obs_phrase_list :: Stream s m Char => ParsecT s u m [String]
obs_phrase_list = do r1 <- many1 (do r <- option [] phrase
_ <- unfold $ char ','
return (filter (/=[]) r))
r2 <- option [] phrase
return (concat r1 ++ r2)
<|> phrase
obs_fws :: Stream s m Char => ParsecT s u m String
obs_fws = do r1 <- many1 wsp
r2 <- many (do r3 <- crlf
r4 <- many1 wsp
return (r3 ++ r4))
return (r1 ++ concat r2)
obs_day_of_week :: Stream s m Char => ParsecT s u m String
obs_day_of_week = unfold day_name <?> "day-of-the-week name"
obs_year :: Stream s m Char => ParsecT s u m Int
obs_year = unfold (do r <- manyN 2 digit
return (normalize (read r :: Int)))
<?> "year"
where
normalize n
| n <= 49 = 2000 + n
| n <= 999 = 1900 + n
| otherwise = n
obs_month :: Stream s m Char => ParsecT s u m Int
obs_month = between cfws cfws month_name <?> "month name"
obs_day :: Stream s m Char => ParsecT s u m Int
obs_day = unfold day_of_month <?> "day"
obs_hour :: Stream s m Char => ParsecT s u m Int
obs_hour = unfold hour <?> "hour"
obs_minute :: Stream s m Char => ParsecT s u m Int
obs_minute = unfold minute <?> "minute"
obs_second :: Stream s m Char => ParsecT s u m Int
obs_second = unfold second <?> "second"
obs_zone :: Stream s m Char => ParsecT s u m TimeZone
obs_zone = choice [ parseZone "UT" 0
, parseZone "GMT" 0
, parseZone "EST" (-5)
, parseZone "EDT" (-4)
, parseZone "CST" (-6)
, parseZone "CDT" (-5)
, parseZone "MST" (-7)
, parseZone "MDT" (-6)
, parseZone "PST" (-8)
, parseZone "PDT" (-7)
, do { r <- oneOf ['A'..'I']; mkZone (ord r - 64) } <?> "military zone spec"
, do { r <- oneOf ['K'..'M']; mkZone (ord r - 65) } <?> "military zone spec"
, do { r <- oneOf ['N'..'Y']; mkZone (-(ord r - 77)) } <?> "military zone spec"
, parseZone "Z" 0 <?> "military zone spec"
]
where parseZone n o = try (string n *> mkZone o)
mkZone = pure . hoursToTimeZone
obs_angle_addr :: Stream s m Char => ParsecT s u m String
obs_angle_addr = unfold (do _ <- char '<'
_ <- option [] obs_route
addr <- addr_spec
_ <- char '>'
return ("<" ++ addr ++ ">")
)
<?> "obsolete angle address"
obs_route :: Stream s m Char => ParsecT s u m [String]
obs_route = unfold (do { r <- obs_domain_list; _ <- char ':'; return r })
<?> "route of an obsolete angle address"
obs_domain_list :: Stream s m Char => ParsecT s u m [String]
obs_domain_list = do _ <- char '@'
r1 <- domain
r2 <- many (do _ <- cfws <|> string ","
optional cfws
_ <- char '@'
domain)
return (r1 : r2)
<?> "route of an obsolete angle address"
obs_local_part :: Stream s m Char => ParsecT s u m String
obs_local_part = do r1 <- word
r2 <- many (do _ <- string "."
r <- word
return ('.' : r))
return (r1 ++ concat r2)
<?> "local part of an address"
obs_domain :: Stream s m Char => ParsecT s u m String
obs_domain = do r1 <- atom
r2 <- many (do _ <- string "."
r <- atom
return ('.' : r))
return (r1 ++ concat r2)
<?> "domain part of an address"
obs_mbox_list :: Stream s m Char => ParsecT s u m [NameAddr]
obs_mbox_list = do r1 <- many1 (try (do r <- maybeOption mailbox
_ <- unfold $ char ','
return r))
r2 <- maybeOption mailbox
return (catMaybes (r1 ++ [r2]))
<?> "obsolete syntax for a list of mailboxes"
obs_addr_list :: Stream s m Char => ParsecT s u m [NameAddr]
obs_addr_list = do r1 <- many1 (try (do r <- maybeOption address
optional cfws
_ <- char ','
optional cfws
return r))
r2 <- maybeOption address
return (concat (catMaybes (r1 ++ [r2])))
<?> "obsolete syntax for a list of addresses"
obs_fields :: Stream s m Char => ParsecT s u m [Field]
obs_fields = many $ choice
[ try (From <$> obs_from)
, try (Sender <$> obs_sender)
, try (ReturnPath <$> obs_return)
, try (ReplyTo <$> obs_reply_to)
, try (To <$> obs_to)
, try (Cc <$> obs_cc)
, try (Bcc <$> obs_bcc)
, try (MessageID <$> obs_message_id)
, try (InReplyTo <$> obs_in_reply_to)
, try (References <$> obs_references)
, try (Subject <$> obs_subject)
, try (Comments <$> obs_comments)
, try (Keywords . return <$> obs_keywords)
, try (Date <$> obs_orig_date)
, try (ResentDate <$> obs_resent_date)
, try (ResentFrom <$> obs_resent_from)
, try (ResentSender <$> obs_resent_send)
, try (ResentTo <$> obs_resent_to)
, try (ResentCc <$> obs_resent_cc)
, try (ResentBcc <$> obs_resent_bcc)
, try (ResentMessageID <$> obs_resent_mid)
, try (ResentReplyTo <$> obs_resent_reply)
, try (ObsReceived <$> obs_received)
, uncurry OptionalField <$> obs_optional
]
obs_orig_date :: Stream s m Char => ParsecT s u m ZonedTime
obs_orig_date = obs_header "Date" date_time
obs_from :: Stream s m Char => ParsecT s u m [NameAddr]
obs_from = obs_header "From" mailbox_list
obs_sender :: Stream s m Char => ParsecT s u m NameAddr
obs_sender = obs_header "Sender" mailbox
obs_reply_to :: Stream s m Char => ParsecT s u m [NameAddr]
obs_reply_to = obs_header "Reply-To" mailbox_list
obs_to :: Stream s m Char => ParsecT s u m [NameAddr]
obs_to = obs_header "To" address_list
obs_cc :: Stream s m Char => ParsecT s u m [NameAddr]
obs_cc = obs_header "Cc" address_list
obs_bcc :: Stream s m Char => ParsecT s u m [NameAddr]
obs_bcc = header "Bcc" ( try address_list
<|> do { optional cfws; return [] }
)
obs_message_id :: Stream s m Char => ParsecT s u m String
obs_message_id = obs_header "Message-ID" msg_id
obs_in_reply_to :: Stream s m Char => ParsecT s u m [String]
obs_in_reply_to = obs_header "In-Reply-To" (do r <- many ( do {_ <- phrase; return [] }
<|> msg_id
)
return (filter (/=[]) r))
obs_references :: Stream s m Char => ParsecT s u m [String]
obs_references = obs_header "References" (do r <- many ( do { _ <- phrase; return [] }
<|> msg_id
)
return (filter (/=[]) r))
obs_id_left :: Stream s m Char => ParsecT s u m String
obs_id_left = local_part <?> "left part of an message ID"
obs_id_right :: Stream s m Char => ParsecT s u m String
obs_id_right = domain <?> "right part of an message ID"
obs_subject :: Stream s m Char => ParsecT s u m String
obs_subject = obs_header "Subject" unstructured
obs_comments :: Stream s m Char => ParsecT s u m String
obs_comments = obs_header "Comments" unstructured
obs_keywords :: Stream s m Char => ParsecT s u m [String]
obs_keywords = obs_header "Keywords" obs_phrase_list
obs_resent_from :: Stream s m Char => ParsecT s u m [NameAddr]
obs_resent_from = obs_header "Resent-From" mailbox_list
obs_resent_send :: Stream s m Char => ParsecT s u m NameAddr
obs_resent_send = obs_header "Resent-Sender" mailbox
obs_resent_date :: Stream s m Char => ParsecT s u m ZonedTime
obs_resent_date = obs_header "Resent-Date" date_time
obs_resent_to :: Stream s m Char => ParsecT s u m [NameAddr]
obs_resent_to = obs_header "Resent-To" mailbox_list
obs_resent_cc :: Stream s m Char => ParsecT s u m [NameAddr]
obs_resent_cc = obs_header "Resent-Cc" mailbox_list
obs_resent_bcc :: Stream s m Char => ParsecT s u m [NameAddr]
obs_resent_bcc = obs_header "Bcc" ( try address_list
<|> do { optional cfws; return [] }
)
obs_resent_mid :: Stream s m Char => ParsecT s u m String
obs_resent_mid = obs_header "Resent-Message-ID" msg_id
obs_resent_reply :: Stream s m Char => ParsecT s u m [NameAddr]
obs_resent_reply = obs_header "Resent-Reply-To" address_list
obs_return :: Stream s m Char => ParsecT s u m String
obs_return = obs_header "Return-Path" path
obs_received :: Stream s m Char => ParsecT s u m [(String, String)]
obs_received = obs_header "Received" name_val_list
obs_path :: Stream s m Char => ParsecT s u m String
obs_path = obs_angle_addr
obs_optional :: Stream s m Char => ParsecT s u m (String,String)
obs_optional = do n <- field_name
_ <- many wsp
_ <- char ':'
b <- unstructured
_ <- crlf
return (n,b)
<?> "optional (unspecified) header line"