{-# LANGUAGE OverloadedStrings #-}
module Network.Email.Header.Read
(
field
, structuredField
, date
, from
, sender
, replyTo
, to
, cc
, bcc
, messageID
, inReplyTo
, references
, subject
, comments
, keywords
, resentDate
, resentFrom
, resentSender
, resentTo
, resentCc
, resentBcc
, resentMessageID
, mimeVersion
, contentType
, contentTransferEncoding
, contentID
) where
import Control.Applicative
import Control.Monad.Catch
import Data.Attoparsec.Combinator
import Data.Attoparsec.Lazy
import qualified Data.ByteString as B
import Data.CaseInsensitive (CI)
import qualified Data.Text.Lazy as L
import Data.Time.LocalTime
import qualified Network.Email.Header.Parser as P
import Network.Email.Header.Types
field :: MonadThrow m => HeaderName -> Parser a -> Headers -> m a
field k p hs = do
body <- case lookup k hs of
Nothing -> throwM $ MissingHeader k
Just b -> return b
case parse p body of
Fail _ _ s -> throwM $ HeaderParseError (k, body) s
Done _ a -> return a
structuredField :: MonadThrow m => HeaderName -> Parser a -> Headers -> m a
structuredField k p = field k (P.cfws *> p <* endOfInput)
date :: MonadThrow m => Headers -> m ZonedTime
date = structuredField "Date" P.dateTime
from :: MonadThrow m => Headers -> m [Mailbox]
from = structuredField "From" P.mailboxList
sender :: MonadThrow m => Headers -> m Mailbox
sender = structuredField "Sender" P.mailbox
replyTo :: MonadThrow m => Headers -> m [Recipient]
replyTo = structuredField "Reply-To" P.recipientList
to :: MonadThrow m => Headers -> m [Recipient]
to = structuredField "To" P.recipientList
cc :: MonadThrow m => Headers -> m [Recipient]
cc = structuredField "Cc" P.recipientList
bcc :: MonadThrow m => Headers -> m (Maybe [Recipient])
bcc = structuredField "Bcc" (optional P.recipientList)
messageID :: MonadThrow m => Headers -> m MessageID
messageID = structuredField "Message-ID" P.messageID
inReplyTo :: MonadThrow m => Headers -> m [MessageID]
inReplyTo = structuredField "In-Reply-To" (many1 P.messageID)
references :: MonadThrow m => Headers -> m [MessageID]
references = structuredField "References" (many1 P.messageID)
subject :: MonadThrow m => Headers -> m L.Text
subject = field "Subject" P.unstructured
comments :: MonadThrow m => Headers -> m L.Text
comments = field "Comments" P.unstructured
keywords :: MonadThrow m => Headers -> m [L.Text]
keywords = structuredField "Keywords" P.phraseList
resentDate :: MonadThrow m => Headers -> m ZonedTime
resentDate = structuredField "Resent-Date" P.dateTime
resentFrom :: MonadThrow m => Headers -> m [Mailbox]
resentFrom = structuredField "Resent-From" P.mailboxList
resentSender :: MonadThrow m => Headers -> m Mailbox
resentSender = structuredField "Resent-Sender" P.mailbox
resentTo :: MonadThrow m => Headers -> m [Recipient]
resentTo = structuredField "Resent-To" P.recipientList
resentCc :: MonadThrow m => Headers -> m [Recipient]
resentCc = structuredField "Resent-Cc" P.recipientList
resentBcc :: MonadThrow m => Headers -> m (Maybe [Recipient])
resentBcc = structuredField "Resent-Bcc" (optional P.recipientList)
resentMessageID :: MonadThrow m => Headers -> m MessageID
resentMessageID = structuredField "Resent-Message-ID" P.messageID
mimeVersion :: MonadThrow m => Headers -> m (Int, Int)
mimeVersion = structuredField "MIME-Version" P.mimeVersion
contentType :: MonadThrow m => Headers -> m (MimeType, Parameters)
contentType = structuredField "Content-Type" P.contentType
contentTransferEncoding :: MonadThrow m => Headers -> m (CI B.ByteString)
contentTransferEncoding =
structuredField "Content-Transfer-Encoding" P.contentTransferEncoding
contentID :: MonadThrow m => Headers -> m MessageID
contentID = structuredField "Content-ID" P.messageID