email-header 0.2.0 → 0.4.0

raw patch · 8 files changed

+97/−71 lines, 8 filesdep +exceptionsdep ~basePVP ok

version bump matches the API change (PVP)

Dependencies added: exceptions

Dependency ranges changed: base

API changes (from Hackage documentation)

Files

• .gitignore +1/−0
• email-header.cabal +3/−2
• src/Network/Email/Header/Parser.hs +19/−18
• src/Network/Email/Header/Pretty.hs +7/−3
• src/Network/Email/Header/Read.hs +33/−28
• src/Network/Email/Header/Render.hs +1/−5
• src/Network/Email/Header/Types.hs +25/−8
• tests/Tests.hs +8/−7

@@ -1,2 +1,3 @@+.stack-work/ cabal-dev/ dist/

@@ -1,5 +1,5 @@ name:                email-header-version:             0.2.0+version:             0.4.0 synopsis:            Parsing and rendering of email and MIME headers description:         Parsing and rendering of email and MIME headers license:             BSD3@@ -29,11 +29,12 @@    build-depends:     attoparsec        >= 0.9   && < 1,-    base              >= 4.5   && < 5,+    base              >= 4.8   && < 5,     base64-bytestring >= 0.1.2 && < 2,     bytestring        >= 0.10  && < 0.11,     case-insensitive,     containers        >= 0.4   && < 0.6,+    exceptions,     text              >= 0.11  && < 2,     text-icu          >= 0.6.3 && < 1,     time

@@ -1,4 +1,5 @@-{-# LANGUAGE BangPatterns, OverloadedStrings #-}+{-# LANGUAGE BangPatterns      #-}+{-# LANGUAGE OverloadedStrings #-} -- | Header parsers. Most exported parsers (with the exception of 'fws', -- 'cfws', and 'unstructured') are for parsing structured header fields. -- They expect no leading space and will eat an trailing white space.@@ -6,7 +7,7 @@     ( -- * Whitespace       fws     , cfws-     -- * Combinators+      -- * Combinators     , lexeme     , symbol     , commaSep@@ -33,32 +34,32 @@  import           Control.Applicative import           Control.Monad-import           Data.Attoparsec              (Parser)-import qualified Data.Attoparsec              as A-import qualified Data.Attoparsec.Char8        as A8+import           Data.Attoparsec.ByteString       (Parser)+import qualified Data.Attoparsec.ByteString       as A+import qualified Data.Attoparsec.ByteString.Char8 as A8 import           Data.Attoparsec.Combinator import           Data.Bits-import qualified Data.ByteString              as B-import qualified Data.ByteString.Base64       as Base64-import           Data.ByteString.Internal     (w2c)+import qualified Data.ByteString                  as B+import qualified Data.ByteString.Base64           as Base64+import qualified Data.ByteString.Char8            as B8+import           Data.ByteString.Internal         (w2c)+import qualified Data.ByteString.Lazy             as L (toStrict) import           Data.ByteString.Lazy.Builder-import qualified Data.ByteString.Char8        as B8-import qualified Data.ByteString.Lazy         as L (toStrict)-import           Data.CaseInsensitive         (CI)-import qualified Data.CaseInsensitive         as CI+import           Data.CaseInsensitive             (CI)+import qualified Data.CaseInsensitive             as CI import           Data.List-import qualified Data.Map.Strict              as Map+import qualified Data.Map.Strict                  as Map import           Data.Maybe import           Data.Monoid+import qualified Data.Text                        as T+import           Data.Text.Encoding+import qualified Data.Text.Lazy                   as L (Text, fromChunks) import           Data.Time import           Data.Time.Calendar.WeekDate-import qualified Data.Text                    as T-import           Data.Text.Encoding-import qualified Data.Text.Lazy               as L (Text, fromChunks) import           Data.Word  import           Network.Email.Charset-import           Network.Email.Header.Types   hiding (mimeType)+import           Network.Email.Header.Types       hiding (mimeType)  infixl 3 <+> @@ -171,7 +172,7 @@ quotedString = lexeme $     toByteString <$ A8.char '"' <*> concatMany quotedChar <* A8.char '"'   where-    quotedChar = mempty <$ A.string "\r\n" +    quotedChar = mempty <$ A.string "\r\n"              <|> word8 <$ A8.char '\\' <*> A.anyWord8              <|> char8 <$> A8.satisfy (/= '"') 

@@ -34,9 +34,12 @@ import           Data.Char import qualified Data.Map                     as Map import           Data.Monoid-import           Data.Time-import           Data.Time.Calendar.WeekDate import qualified Data.Text.Lazy               as L+import           Data.Time                    (LocalTime (LocalTime),+                                               TimeOfDay (TimeOfDay),+                                               ZonedTime (ZonedTime),+                                               timeZoneMinutes, toGregorian)+import           Data.Time.Calendar.WeekDate import           Data.Word  import           Network.Email.Charset@@ -230,7 +233,8 @@ -- -- * Any word contains illegal characters phrase :: L.Text -> Doc-phrase = renderText (\c -> c > '~' || c < '!' || c `elem` "()<>[]:;@\\\",")+phrase = renderText (\c -> c > '~' || c < '!' || c `elem` punctuation)+  where punctuation = "()<>[]:;@\\\"," :: String  -- | Format a list of phrases. phraseList :: [L.Text] -> Doc

@@ -41,6 +41,7 @@     ) where  import           Control.Applicative+import           Control.Monad.Catch import           Data.Attoparsec.Combinator import           Data.Attoparsec.Lazy import qualified Data.ByteString             as B@@ -52,110 +53,114 @@ import           Network.Email.Header.Types  -- | Lookup and parse a header with a parser.-field :: HeaderName -> Parser a -> Headers -> Maybe a+field :: MonadThrow m => HeaderName -> Parser a -> Headers -> m a field k p hs = do-    body <- lookup k hs-    maybeResult $ parse p body+    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  -- | Lookup and parse a structured header with a parser. This skips initial -- comments and folding white space, and ensures that the entire body is -- consumed by the parser.-structuredField :: HeaderName -> Parser a -> Headers -> Maybe a+structuredField :: MonadThrow m => HeaderName -> Parser a -> Headers -> m a structuredField k p = field k (P.cfws *> p <* endOfInput)  -- | Get the value of the @Date:@ field.-date :: Headers -> Maybe ZonedTime+date :: MonadThrow m => Headers -> m ZonedTime date = structuredField "Date" P.dateTime  -- | Get the value of the @From:@ field.-from :: Headers -> Maybe [Mailbox]+from :: MonadThrow m => Headers -> m [Mailbox] from = structuredField "From" P.mailboxList  -- | Get the value of the @Sender:@ field.-sender :: Headers -> Maybe Mailbox+sender :: MonadThrow m => Headers -> m Mailbox sender = structuredField "Sender" P.mailbox  -- | Get the value of the @Reply-To:@ field.-replyTo :: Headers -> Maybe [Recipient]+replyTo :: MonadThrow m => Headers -> m [Recipient] replyTo = structuredField "Reply-To" P.recipientList  -- | Get the value of the @To:@ field.-to :: Headers -> Maybe [Recipient]+to :: MonadThrow m => Headers -> m [Recipient] to = structuredField "To" P.recipientList  -- | Get the value of the @Cc:@ field.-cc :: Headers -> Maybe [Recipient]+cc :: MonadThrow m => Headers -> m [Recipient] cc = structuredField "Cc" P.recipientList  -- | Get the value of the @Bcc:@ field.-bcc :: Headers -> Maybe (Maybe [Recipient])+bcc :: MonadThrow m => Headers -> m (Maybe [Recipient]) bcc = structuredField "Bcc" (optional P.recipientList)  -- | Get the value of the @Message-ID:@ field.-messageID :: Headers -> Maybe MessageID+messageID :: MonadThrow m => Headers -> m MessageID messageID = structuredField "Message-ID" P.messageID  -- | Get the value of the @In-Reply-To:@ field.-inReplyTo :: Headers -> Maybe [MessageID]+inReplyTo :: MonadThrow m => Headers -> m [MessageID] inReplyTo = structuredField "In-Reply-To" (many1 P.messageID)  -- | Get the value of the @References:@ field.-references :: Headers -> Maybe [MessageID]+references :: MonadThrow m => Headers -> m [MessageID] references = structuredField "References" (many1 P.messageID)  -- | Get the value of the @Subject:@ field.-subject :: Headers -> Maybe L.Text+subject :: MonadThrow m => Headers -> m L.Text subject = field "Subject" P.unstructured  -- | Get the value of the @Comments:@ field.-comments :: Headers -> Maybe L.Text+comments :: MonadThrow m => Headers -> m L.Text comments = field "Comments" P.unstructured  -- | Get the value of the @Keywords:@ field.-keywords :: Headers -> Maybe [L.Text]+keywords :: MonadThrow m => Headers -> m [L.Text] keywords = structuredField "Keywords" P.phraseList  -- | Get the value of the @Resent-Date:@ field.-resentDate :: Headers -> Maybe ZonedTime+resentDate :: MonadThrow m => Headers -> m ZonedTime resentDate = structuredField "Resent-Date" P.dateTime  -- | Get the value of the @Resent-From:@ field.-resentFrom :: Headers -> Maybe [Mailbox]+resentFrom :: MonadThrow m => Headers -> m [Mailbox] resentFrom = structuredField "Resent-From" P.mailboxList  -- | Get the value of the @Resent-Sender:@ field.-resentSender :: Headers -> Maybe Mailbox+resentSender :: MonadThrow m => Headers -> m Mailbox resentSender = structuredField "Resent-Sender" P.mailbox  -- | Get the value of the @Resent-To:@ field.-resentTo :: Headers -> Maybe [Recipient]+resentTo :: MonadThrow m => Headers -> m [Recipient] resentTo = structuredField "Resent-To" P.recipientList  -- | Get the value of the @Resent-Cc:@ field.-resentCc :: Headers -> Maybe [Recipient]+resentCc :: MonadThrow m => Headers -> m [Recipient] resentCc = structuredField "Resent-Cc" P.recipientList  -- | Get the value of the @Resent-Bcc:@ field.-resentBcc :: Headers -> Maybe (Maybe [Recipient])+resentBcc :: MonadThrow m => Headers -> m (Maybe [Recipient]) resentBcc = structuredField "Resent-Bcc" (optional P.recipientList)  -- | Get the value of the @Resent-Message-ID:@ field.-resentMessageID :: Headers -> Maybe MessageID+resentMessageID :: MonadThrow m => Headers -> m MessageID resentMessageID = structuredField "Resent-Message-ID" P.messageID  -- | Get the value of the @MIME-Version:@ field.-mimeVersion :: Headers -> Maybe (Int, Int)+mimeVersion :: MonadThrow m => Headers -> m (Int, Int) mimeVersion = structuredField "MIME-Version" P.mimeVersion  -- | Get the value of the @Content-Type:@ field.-contentType :: Headers -> Maybe (MimeType, Parameters)+contentType :: MonadThrow m => Headers -> m (MimeType, Parameters) contentType = structuredField "Content-Type" P.contentType  -- | Get the value of the @Content-Transfer-Encoding:@ field.-contentTransferEncoding :: Headers -> Maybe (CI B.ByteString)+contentTransferEncoding :: MonadThrow m => Headers -> m (CI B.ByteString) contentTransferEncoding =     structuredField "Content-Transfer-Encoding" P.contentTransferEncoding  -- | Get the value of the @Content-ID:@ field.-contentID :: Headers -> Maybe MessageID+contentID :: MonadThrow m => Headers -> m MessageID contentID = structuredField "Content-ID" P.messageID

@@ -48,7 +48,6 @@ import qualified Data.ByteString.Lazy.Builder as B import           Data.CaseInsensitive         (CI) import qualified Data.CaseInsensitive         as CI-import           Data.Monoid import qualified Data.Text.Lazy               as L import           Data.Time.LocalTime @@ -61,10 +60,7 @@ renderHeaders r = map (renderHeader r)  -- | Render a header.-renderHeader-    :: RenderOptions-    -> (HeaderName, Doc)-    -> (HeaderName, HeaderField)+renderHeader :: RenderOptions -> (HeaderName, Doc) -> Header renderHeader r (k, b) = (k, B.toLazyByteString l)   where     l = render r (B.length (CI.original k) + 2) b

@@ -1,31 +1,38 @@+{-# LANGUAGE DeriveDataTypeable #-} -- | Email header types. module Network.Email.Header.Types-    ( Headers-    , HeaderName-    , HeaderField+    ( -- * Header types+      HeaderName+    , Header+    , Headers+      -- * Email types     , Address(..)     , Mailbox(..)     , Recipient(..)     , MessageID(..)     , MimeType(..)     , Parameters+      -- * Exceptions+    , HeaderException(..)     ) where +import           Control.Exception import qualified Data.ByteString      as B import qualified Data.ByteString.Lazy as L import           Data.CaseInsensitive (CI) import           Data.Map.Strict      (Map) import qualified Data.Text.Lazy       as L---- | A set of email headers.-type Headers = [(HeaderName, HeaderField)]+import           Data.Typeable  -- | An email header name. type HeaderName = CI B.ByteString --- | The email header field.-type HeaderField = L.ByteString+-- | An email header.+type Header = (HeaderName, L.ByteString) +-- | A set of email headers, in order.+type Headers = [Header]+ -- | An email address. newtype Address = Address B.ByteString     deriving (Eq, Ord, Show)@@ -56,3 +63,13 @@  -- | MIME content type parameters. type Parameters = Map (CI B.ByteString) B.ByteString++-- | Email header exceptions.+data HeaderException+      -- | A required header is missing.+    = MissingHeader HeaderName+      -- | A header field could not be parsed.+    | HeaderParseError Header String+    deriving (Show, Typeable)++instance Exception HeaderException

@@ -4,7 +4,7 @@     ( main     ) where -import           Control.Applicative+import           Control.Exception import qualified Data.ByteString.Char8       as B import           Data.CaseInsensitive        (CI) import qualified Data.CaseInsensitive        as CI@@ -13,6 +13,7 @@ import           Data.Time.Calendar import           Data.Time.LocalTime import           Test.QuickCheck+import           Test.QuickCheck.Property import           Test.Tasty import           Test.Tasty.QuickCheck @@ -114,17 +115,17 @@     => String     -> Gen a     -> (a -> (HeaderName, R.Doc))-    -> (Headers -> Maybe a)+    -> (Headers -> Either SomeException a)     -> TestTree roundTrip name gen renderer parser = testProperty name $     forAll gen $ \a opts ->     let hs = R.renderHeaders opts [renderer a]     in  case parser hs of-            Nothing -> False-            Just b  -> b == a+            Left e  -> exception "exception" e+            Right b -> liftBool (b == a) -parsers :: TestTree-parsers = testGroup "round trip"+tests :: TestTree+tests = testGroup "round trip"     [ -- Origination date       roundTrip "Date"     arbitrary R.date H.date       -- Originator@@ -161,4 +162,4 @@     ]  main :: IO ()-main = defaultMain parsers+main = defaultMain tests