packages feed

purebred-email 0.5.1 → 0.6

raw patch · 8 files changed

+202/−53 lines, 8 filesdep −QuickCheck

Dependencies removed: QuickCheck

Files

+ CHANGELOG.md view
@@ -0,0 +1,37 @@+## Version 0.6 (2022-09-13)++- Parameterise the `ContentType` data type over the "parameters"+  field.  The type becomes `ContentTypeWith a`.  The *data+  constructor* name remains `ContentType`.  Reintroduce+  `ContentType` as a *type synonym* for `ContentTypeWith+  Parameters`.  A "bare content type" without parameters can be+  represented as `ContentTypeWith ()`.++- Introduce `emptyParameters :: Parameters`.  It is the same as+  `mempty` but is convenient where `mempty` is ambiguous.++- Accept `Content-Type: multipart/related` without `type` parameter.++  [RFC 2387][] requires the `type` parameter.  Nevertheless some+  producers, including GMail and Fastmail, generate non-conformant+  messages without the `type` parameter.  Wrap the `Related`+  constructor's `ContentType` field in a `Maybe`. ([#68][])++- Introduce the `ContentID` type and use it for the+  `multipart/related` `start` parameter.++- Add missing end-of-input assertions to several "secondary"+  parsers, which could otherwise accept invalid data.++- `defaultCharsets`: recognise `ascii` as an alias of `us-ascii`.+  ([#69][])+++[RFC 2387]: https://datatracker.ietf.org/doc/html/rfc2387#section-3.1+[#68]: https://github.com/purebred-mua/purebred-email/issues/68+[#69]: https://github.com/purebred-mua/purebred-email/issues/69+++## Older versions++See Git commit history
purebred-email.cabal view
@@ -1,6 +1,6 @@ cabal-version:       2.2 name:                purebred-email-version:             0.5.1+version:             0.6 synopsis:            types and parser for email messages (including MIME) description:   The purebred email library.  RFC 5322, MIME, etc.@@ -32,11 +32,12 @@ category:            Data, Email build-type:          Simple extra-source-files:+  CHANGELOG.md   README.rst   test-vectors/*.eml   tests/golden/*.golden tested-with:-  GHC ==8.8.4 || ==8.10.7 || ==9.0.2 || ==9.2.3 || ==9.4.1+  GHC ==8.8.4 || ==8.10.7 || ==9.0.2 || ==9.2.4 || ==9.4.2  homepage:            https://github.com/purebred-mua/purebred-email bug-reports:         https://github.com/purebred-mua/purebred-email/issues@@ -50,7 +51,33 @@  common common   default-language: Haskell2010-  ghc-options: -Wall -Wredundant-constraints+  ghc-options:+    -Wall+    -Wcompat+    -Werror=missing-methods+    -Widentities+    -Wincomplete-record-updates+    -Wincomplete-uni-patterns+    -Wmissing-export-lists+    -Wnoncanonical-monad-instances+    -Wpartial-fields+    -Wredundant-constraints+    -fhide-source-paths+  if impl(ghc >= 8.10)+    ghc-options:+      -Wunused-packages+  if impl(ghc >= 9.0)+    ghc-options:+      -Winvalid-haddock+      -Werror=unicode-bidirectional-format-characters+  if impl(ghc >= 9.2)+    ghc-options:+      -Wimplicit-lift+      -Woperator-whitespace+      -Wredundant-bang-patterns+  if impl(ghc >= 9.4)+    ghc-options:+      -Wredundant-strictness-flags    build-depends:     base >= 4.11 && < 5@@ -117,7 +144,6 @@     , tasty-hunit     , tasty-golden     , hedgehog-    , QuickCheck     , quickcheck-instances  executable purebred-email-parse
src/Data/IMF.hs view
@@ -919,7 +919,7 @@  -- | Parse an @a@. ----- The input is convered to a /lazy/ @ByteString@.+-- Converts the input to a /lazy/ @ByteString@. -- Build with rewrite rules enabled (@-O@, cabal's default) -- to achieve the following conversion overheads: --
src/Data/MIME.hs view
@@ -70,7 +70,8 @@    -- ** Content-Type header   , contentType-  , ContentType(..)+  , ContentTypeWith(..)+  , ContentType   , ctType   , ctSubtype   , matchContentType@@ -102,6 +103,14 @@   , filenameParameter   , renderContentDisposition +  -- *** Content-ID header+  , ContentID+  , makeContentID+  , parseContentID+  , buildContentID+  , renderContentID+  , headerContentID+   -- ** Mail creation   -- *** Common use cases   , createTextPlainMessage@@ -122,6 +131,7 @@   ) where  import Control.Applicative+import Control.Monad (when) import Data.Foldable (fold) import Data.List.NonEmpty (NonEmpty, fromList, intersperse) import Data.Maybe (fromMaybe)@@ -135,6 +145,7 @@ import qualified Data.ByteString as B import qualified Data.ByteString.Char8 as C8 import qualified Data.ByteString.Builder as Builder+import qualified Data.ByteString.Lazy as L import qualified Data.CaseInsensitive as CI import qualified Data.Text as T import qualified Data.Text.Encoding as T@@ -438,19 +449,40 @@   -- Independent body parts, order not significants.  Parts may be   -- displayed in parallel if the system supports it.   | Related-      ContentType {- ^ @type@ -}-      (Maybe B.ByteString) {- ^ @start@ -}-      (Maybe B.ByteString) {- ^ @start-info@ -}-  -- ^ <https://www.rfc-editor.org/rfc/rfc2387.html RFC 2387.>-  -- Aggregate or compound objects.-  | Signed B.ByteString {- ^ protocol -} B.ByteString {- ^ micalg -}+  -- ^ Aggregate or compound objects.  Per+  -- <https://www.rfc-editor.org/rfc/rfc2387.html RFC 2387> the+  -- @type@ parameter is required.  Sadly some major producers omit+  -- it, so this constructor must admit that case.  See+  -- https://github.com/purebred-mua/purebred-email/issues/68.+      (Maybe (ContentTypeWith ()))+      -- ^ The @type@ parameter must be specified and its value is+      -- the MIME media type of the "root" body part.  It permits a+      -- MIME user agent to determine the @Content-Type@ without+      -- reference to the enclosed body part.  If the value of the+      -- @type@ parameter and the root body part's @Content-Type@+      -- differ then the User Agent's behavior is undefined.+      (Maybe ContentID)+      -- ^ The @start@ parameter, if given, points, via a+      -- @Content-ID@, to the body part that contains the object+      -- root.  The default root is the first body part within the+      -- @multipart/related@ body.+      (Maybe B.ByteString)+      -- ^ @start-info@ parameter.  Applications that use+      -- @multipart/related@ must specify the interpretation of+      -- @start-info@.  User Agents shall provide the parameter's+      -- value to the processing application.+  | Signed   -- ^ <https://www.rfc-editor.org/rfc/rfc1847.html#section-2.1 RFC 1847 §2.1.>   -- Signed messages.-  | Encrypted B.ByteString {- protocol -}+      B.ByteString {- ^ protocol -}+      B.ByteString {- ^ micalg -}+  | Encrypted   -- ^ <https://www.rfc-editor.org/rfc/rfc1847.html#section-2.2 RFC 1847 §2.2.>-  | Report B.ByteString {- report-type -}+      B.ByteString {- ^ protocol -}+  | Report   -- ^ <https://www.rfc-editor.org/rfc/rfc6522.html RFC 6522>.   -- Electronic mail reports.+      B.ByteString {- ^ report-type -}   | Multilingual   -- ^ <https://www.rfc-editor.org/rfc/rfc8255.html RFC 8255>.   -- Multilingual messages.  The first part should be a multilingual@@ -523,8 +555,8 @@ {-# INLINE caseInsensitive #-}  --- | Content-Type header (RFC 2183).--- Use 'parameters' to access the parameters.+-- | Content-Type (type and subtype) with explicit parameters type.+-- Use 'parameters' to access the parameters field. -- Example: -- -- @@@ -534,22 +566,21 @@ -- You can also use @-XOverloadedStrings@ but be aware the conversion -- is non-total (throws an error if it cannot parse the string). ---data ContentType = ContentType (CI B.ByteString) (CI B.ByteString) Parameters-  deriving (Show, Generic, NFData)+data ContentTypeWith a = ContentType (CI B.ByteString) (CI B.ByteString) a+  deriving+    ( Show, Generic, NFData,+      Eq  -- ^ Compares type and subtype case-insensitively; parameters+          -- are also compared.  Use 'matchContentType' if you just want+          -- to match on the media type while ignoring parameters.+    ) --- | Equality of Content-Type. Type and subtype are compared--- case-insensitively and parameters are also compared.  Use--- 'matchContentType' if you just want to match on the media type--- while ignoring parameters.----instance Eq ContentType where-  ContentType a b c == ContentType a' b' c' = a == a' && b == b' && c == c'+type ContentType = ContentTypeWith Parameters  -- | __NON-TOTAL__ parses the Content-Type (including parameters) -- and throws an error if the parse fails -- instance IsString ContentType where-  fromString = either err id . parseOnly parseContentType . C8.pack+  fromString = either err id . parseOnly (parseContentType <* endOfInput) . C8.pack     where     err msg = error $ "failed to parse Content-Type: " <> msg @@ -559,26 +590,29 @@ matchContentType   :: CI B.ByteString         -- ^ type   -> Maybe (CI B.ByteString) -- ^ optional subtype-  -> ContentType+  -> ContentTypeWith a   -> Bool matchContentType wantType wantSubtype (ContentType gotType gotSubtype _) =   wantType == gotType && maybe True (== gotSubtype) wantSubtype  renderContentType :: ContentType -> B.ByteString-renderContentType (ContentType typ sub params) =-  CI.original typ <> "/" <> CI.original sub <> printParameters params+renderContentType = renderContentTypeWith printParameters +renderContentTypeWith :: (a -> B.ByteString) -> ContentTypeWith a -> B.ByteString+renderContentTypeWith renderParams (ContentType typ sub params) =+  CI.original typ <> "/" <> CI.original sub <> renderParams params+ printParameters :: Parameters -> B.ByteString printParameters (Parameters xs) =   foldMap (\(k,v) -> "; " <> CI.original k <> "=" <> v) xs -ctType :: Lens' ContentType (CI B.ByteString)+ctType :: Lens' (ContentTypeWith a) (CI B.ByteString) ctType f (ContentType a b c) = fmap (\a' -> ContentType a' b c) (f a) -ctSubtype :: Lens' ContentType (CI B.ByteString)+ctSubtype :: Lens' (ContentTypeWith a) (CI B.ByteString) ctSubtype f (ContentType a b c) = fmap (\b' -> ContentType a b' c) (f b) -ctParameters :: Lens' ContentType Parameters+ctParameters :: Lens (ContentTypeWith a) (ContentTypeWith b) a b ctParameters f (ContentType a b c) = fmap (\c' -> ContentType a b c') (f c) {-# ANN ctParameters ("HLint: ignore Avoid lambda" :: String) #-} @@ -591,16 +625,24 @@  -- | Parser for Content-Type header parseContentType :: Parser ContentType-parseContentType = do+parseContentType = parseContentTypeWith go+  where+  go typ _subtype = do+    params <- parseParameters+    when (typ == "multipart" && "boundary" `notElem` fmap fst params) $+      -- https://tools.ietf.org/html/rfc2046#section-5.1.1+      fail "\"boundary\" parameter is required for multipart content type"+    pure $ Parameters params++parseContentTypeWith+  :: (CI B.ByteString -> CI B.ByteString -> Parser a)+  -> Parser (ContentTypeWith a)+parseContentTypeWith p = do   typ <- ci token   _ <- char8 '/'   subtype <- ci token-  params <- parseParameters-  if typ == "multipart" && "boundary" `notElem` fmap fst params-    then-      -- https://tools.ietf.org/html/rfc2046#section-5.1.1-      fail "\"boundary\" parameter is required for multipart content type"-    else pure $ ContentType typ subtype (Parameters params)+  params <- p typ subtype+  pure $ ContentType typ subtype params  parseParameters :: Parser [(CI B.ByteString, B.ByteString)] parseParameters = many (char8 ';' *> skipWhile (== 32 {-SP-}) *> param)@@ -738,9 +780,9 @@       Encrypted proto -> ("encrypted", setParam "protocol" proto)       Related typ start startInfo ->         ( "related"-        , maybe id (setParam "start") start+        , maybe id (setParam "start" . renderContentID) start           . maybe id (setParam "start-info") startInfo-          . setParam "type" (renderContentType typ)+          . maybe id (setParam "type" . renderContentTypeWith (\() -> "")) typ         )       Unrecognised sub' -> (sub', id) @@ -775,7 +817,8 @@   sa s = case view cte s of     Nothing -> contentTypeApplicationOctetStream     Just _ ->-      fromMaybe defaultContentType $ preview (ct . parsed parseContentType) s+      fromMaybe defaultContentType+      $ preview (ct . parsed (parseContentType <* endOfInput)) s    sbt s b = set (at "Content-Type") (Just (renderContentType b)) s @@ -839,7 +882,7 @@ -- contentDisposition :: HasHeaders a => Lens' a (Maybe ContentDisposition) contentDisposition = headers . at "Content-Disposition" . dimap-  (>>= either (const Nothing) Just . Data.IMF.parse parseContentDisposition)+  (>>= either (const Nothing) Just . Data.IMF.parse (parseContentDisposition <* endOfInput))   (fmap . fmap $ renderContentDisposition)  -- | Traverse the value of the filename parameter (if present).@@ -861,6 +904,43 @@ filenameParameter = parameter "filename"  +-- | The @Content-ID@ value may be used for uniquely identifying+-- MIME entities in several contexts, particularly for caching data+-- referenced by the @message/external-body@ mechanism.  Although+-- the @Content-ID@ header is generally optional, its use is+-- MANDATORY in implementations which generate data of the optional+-- MIME media type @message/external-body@.  That is, each+-- @message/external-body@ entity must have a @Content-ID@ field to+-- permit caching of such data.+--+newtype ContentID = ContentID MessageID+  deriving (Eq)++instance Show ContentID where+  show = C8.unpack . renderContentID++parseContentID :: Parser ContentID+parseContentID = ContentID <$> parseMessageID++buildContentID :: ContentID -> Builder.Builder+buildContentID (ContentID mid) = buildMessageID mid++renderContentID :: ContentID -> B.ByteString+renderContentID = L.toStrict . Builder.toLazyByteString . buildContentID++makeContentID :: B.ByteString -> Either B.ByteString ContentID+makeContentID s =+  either (const $ Left s) Right+  . parseOnly (parseContentID <* endOfInput)+  $ s++headerContentID :: (HasHeaders a) => Lens' a (Maybe ContentID)+headerContentID = headers . at "Content-ID" . iso (>>= f) (fmap g)+  where+  f = either (const Nothing) Just . parseOnly (parseContentID <* endOfInput)+  g = renderContentID++ -- | Traversal of @boundary@ parameter (which may be unspecified) mimeBoundary :: Traversal' ContentType B.ByteString mimeBoundary = parameters . rawParameter "boundary"@@ -914,6 +994,12 @@       maybe (Left $ RequiredParameterMissing k) Right . preview (rawParameter k)     getOptionalParam k =       Right . preview (rawParameter k)+    getOptionalParamParsed k parser ct =+      case preview (rawParameter k) ct of+        Nothing -> Right Nothing+        Just s  -> case Data.IMF.parse (parser <* endOfInput) s of+          Left _  -> Left $ InvalidParameterValue k s+          Right a -> Right $ Just a     parseSubtype ct = case view ctSubtype ct of       "mixed"         -> pure Mixed       "alternative"   -> pure Alternative@@ -926,11 +1012,9 @@                           <*> getRequiredParam "micalg" ct       "encrypted"     -> Encrypted <$> getRequiredParam "protocol" ct       "related"       -> Related-                          <$> ( getRequiredParam "type" ct-                              >>= \s -> maybe (Left $ InvalidParameterValue "type" s) Right-                                          (preview (parsed parseContentType) s)-                              )-                          <*> getOptionalParam "start" ct+                          <$> getOptionalParamParsed "type"+                                (parseContentTypeWith (\_ _ -> pure ())) ct+                          <*> getOptionalParamParsed "start" parseContentID ct                           <*> getOptionalParam "start-info" ct       unrecognised    -> pure $ Unrecognised unrecognised
src/Data/MIME/Charset.hs view
@@ -155,6 +155,7 @@   , ("IBM367", us_ascii)   , ("cp367", us_ascii)   , ("csASCII.4-1968", us_ascii)+  , ("ascii", us_ascii)  -- https://github.com/purebred-mua/purebred-email/issues/69    -- iso-8859-1 aliases   , ("iso-ir-100", iso_8859_1)
src/Data/MIME/Parameter.hs view
@@ -39,6 +39,7 @@ module Data.MIME.Parameter   (     Parameters(..)+  , emptyParameters   , parameterList   , parameter   , rawParameter@@ -106,6 +107,10 @@     l f kv = case getParameter k kv of       Nothing -> pure kv       Just v -> (\v' -> setParam k v' kv) <$> f v++-- | Same as 'mempty', but useful where the type would otherwise be ambiguous.+emptyParameters :: Parameters+emptyParameters = mempty  -- | Set the parameter (which may need to use the parameter -- continuation mechanism).
tests/ContentTransferEncodings.hs view
@@ -63,11 +63,7 @@     encoded = review (clonePrism p) s     prop = all ((<= 76) . B.length) (splitOnCRLF encoded)   in-#if ! MIN_VERSION_QuickCheck(2,12,0)-    cover (B.length encoded > 100) 50 "long output" prop-#else     checkCoverage $ cover 50 (B.length encoded > 100) "long output" prop-#endif  prop_notElem :: EncodedWordEncoding -> Word8 -> B.ByteString -> Bool prop_notElem enc c = B.notElem c . review (clonePrism enc)
tests/MIME.hs view
@@ -188,7 +188,7 @@  testContentTypeOverloadedStrings :: TestTree testContentTypeOverloadedStrings = testGroup "ContentType fromString"-  [ testCase "no params" $ fromString "foo/bar" @?= ContentType "foo" "bar" mempty+  [ testCase "no params" $ fromString "foo/bar" @?= ContentType "foo" "bar" emptyParameters   , testCase "params" $ fromString "foo/bar; baz=quux" @?= ContentType "foo" "bar" (Parameters [("baz", "quux")])   , testCase "bogus" $       (isLeft <$> (try . evaluate $ fromString "foo/; baz=quux" :: IO (Either ErrorCall ContentType)))