gdritter repos courriel / 00ea186
Added message IDs, both spec-conformant and not Getty Ritter 6 years ago
2 changed file(s) with 52 addition(s) and 14 deletion(s). Collapse all Expand all
77 import qualified Data.Attoparsec.ByteString as Atto
88 import Data.ByteString (ByteString)
99 import qualified Data.ByteString as B
10 import qualified Data.ByteString.Char8 as B8
1011 import qualified Data.ByteString.Lazy as BL
1112 import qualified Data.ByteString.Builder as BB
1213 import qualified Data.Char as Char
1314 import qualified Data.Foldable as Fold
15 import Data.Monoid ((<>))
1416 import Data.Sequence (Seq)
1517 import qualified Data.Sequence as Seq
1618 import Data.Time.Clock (UTCTime)
2123
2224 -- The comments here are taken directly from RFC 5322
2325
26 w8 :: Char -> Word8
27 w8 = fromIntegral . Char.ord
28
29 char :: Char -> Parser ()
30 char n = void (Atto.word8 (fromIntegral (Char.ord n)))
31
32 pSeq :: Parser a -> Parser (Seq a)
33 pSeq p = Seq.fromList <$> Atto.many' p
34
35 pMsgId :: Parser MessageId
36 pMsgId = do
37 pCfwsMb
38 char '<'
39 left <- pDotAtom
40 char '@'
41 right <- pDotAtom <|> pDtext
42 char '>'
43 return (MessageId (left <> "@" <> right))
44
45 pMsgIdLiberal :: Parser MessageId
46 pMsgIdLiberal = do
47 pCfwsMb
48 char '<'
49 bs <- Atto.takeWhile (/= (w8 '>'))
50 char '>'
51 return (MessageId bs)
52
53 pDtext :: Parser ByteString
54 pDtext = do
55 void (Atto.word8 91)
56 rs <- Atto.takeWhile (\ c -> (c >= 33 && c <= 90) || (c >= 94 && c <= 128))
57 void (Atto.word8 93)
58 return rs
2459
2560 -- word = atom / quoted-string
2661 -- phrase = 1*word / obs-phrase
114149 pHeader = do
115150 name <- Atto.takeWhile1 (\ c -> c /= 58 && not (isSpace c))
116151 void $ Atto.word8 58
117 case name of
118 "OrigDate" -> HeaderOther "arglbargl" <$> foldingHeader
119 "Subject" -> HeaderSubject <$> foldingHeader
120 "Comments" -> HeaderComments <$> foldingHeader
121 "Keywords" -> HeaderKeywords <$> foldingHeader
122 "Sender" -> HeaderSender <$> pMailbox <* pCrlf
123 "From" -> HeaderFrom <$> pMailboxList <* pCrlf
124 "Reply-To" -> HeaderReplyTo <$> pAddressList <* pCrlf
125 "To" -> HeaderTo <$> pAddressList <* pCrlf
126 "Cc" -> HeaderCc <$> pAddressList <* pCrlf
127 "Bcc" -> HeaderBcc <$> pAddressList <* pCrlf
128 _ -> HeaderOther name <$> foldingHeader
152 case B8.map Char.toLower name of
153 "origdate" -> HeaderOther "arglbargl" <$> foldingHeader
154 "subject" -> HeaderSubject <$> foldingHeader
155 "comments" -> HeaderComments <$> foldingHeader
156 "keywords" -> HeaderKeywords <$> foldingHeader
157 "sender" -> HeaderSender <$> pMailbox <* pCrlf
158 "from" -> HeaderFrom <$> pMailboxList <* pCrlf
159 "reply-to" -> HeaderReplyTo <$> pAddressList <* pCrlf
160 "to" -> HeaderTo <$> pAddressList <* pCrlf
161 "cc" -> HeaderCc <$> pAddressList <* pCrlf
162 "bcc" -> HeaderBcc <$> pAddressList <* pCrlf
163 "message-id" -> HeaderMessageId <$> pMsgId <* pCrlf
164 "in-reply-to" -> HeaderInReplyTo <$> pSeq pMsgIdLiberal <* pCrlf
165 "references" -> HeaderReferences <$> pSeq pMsgIdLiberal <* pCrlf
166 _ -> HeaderOther name <$> foldingHeader
129167
130168 pDateTime :: Parser UTCTime
131169 pDateTime = undefined
3131 | HeaderCc (Seq MBGroup)
3232 | HeaderBcc (Seq MBGroup)
3333 | HeaderMessageId MessageId
34 | HeaderInReplyTo MessageId
35 | HeaderReferences MessageId
34 | HeaderInReplyTo (Seq MessageId)
35 | HeaderReferences (Seq MessageId)
3636 | HeaderSubject ByteString
3737 | HeaderComments ByteString
3838 | HeaderKeywords ByteString