summaryrefslogtreecommitdiffstats
path: root/krebs/5pkgs/haskell/purebred-email/untweak-mime-version-header.patch
blob: 97baf7ac17b077b3610a4cc057e197b2a485b301 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
diff --git a/src/Data/MIME.hs b/src/Data/MIME.hs
index 19af53e..be8cbd4 100644
--- a/src/Data/MIME.hs
+++ b/src/Data/MIME.hs
@@ -810,7 +810,6 @@ multipart takeTillEnd boundary =
 -- | Sets the @MIME-Version: 1.0@ header.
 --
 instance RenderMessage MIME where
-  tweakHeaders = set (headers . at "MIME-Version") (Just "1.0")
   buildBody h z = Just $ case z of
     Part partbody -> Builder.byteString partbody
     Encapsulated msg -> buildMessage msg
diff --git a/tests/Generator.hs b/tests/Generator.hs
index 9e1f166..23bd122 100644
--- a/tests/Generator.hs
+++ b/tests/Generator.hs
@@ -64,7 +64,7 @@ exampleMailsParseSuccessfully =
 textPlain7bit :: MIMEMessage
 textPlain7bit =
     let m = createTextPlainMessage "This is a simple mail."
-    in over headers (\(Headers xs) -> Headers $ (CI.mk "Subject", "Hello there") : xs) m
+    in over headers (\(Headers xs) -> Headers $ (CI.mk "MIME-Version", "1.0") : (CI.mk "Subject", "Hello there") : xs) m
 
 multiPartMail :: MIMEMessage
 multiPartMail =
@@ -72,13 +72,16 @@ multiPartMail =
         to' = Single $ Mailbox Nothing (AddrSpec "bar" (DomainDotAtom $ pure "bar.com"))
         subject = "Hello there"
         p = createTextPlainMessage "This is a simple mail."
+             & set (headers . at "MIME-Version") (Just "1.0")
         a = createAttachment
                 contentTypeApplicationOctetStream
                 (Just "foo.bin")
                 "fileContentsASDF"
+             & set (headers . at "MIME-Version") (Just "1.0")
         now = UTCTime (ModifiedJulianDay 123) (secondsToDiffTime 123)
     in createMultipartMixedMessage "asdf" (fromList [p, a])
-       & set (headers . at "From") (Just $ renderMailboxes [from'])
+       & set (headers . at "MIME-Version") (Just "1.0")
+       . set (headers . at "From") (Just $ renderMailboxes [from'])
        . set (headers . at "To") (Just $ renderAddresses [to'])
        . set (headers . at "Date") (Just $ renderRFC5422Date now)
        . set (headers . at "Subject") (Just $ T.encodeUtf8 subject)
diff --git a/tests/Message.hs b/tests/Message.hs
index 6711519..3e40397 100644
--- a/tests/Message.hs
+++ b/tests/Message.hs
@@ -29,7 +29,7 @@ import Data.Char (isPrint)
 import Data.Foldable (fold)
 import Data.List.NonEmpty (NonEmpty(..), intersperse)
 
-import Control.Lens (set, view)
+import Control.Lens ((&), at, set, view)
 import qualified Data.ByteString as B
 import qualified Data.Text as T
 
@@ -99,7 +99,7 @@ genMessage = Gen.choice [ genTextPlain, genMultipart, encapsulate <$> genMessage
 prop_messageRoundTrip :: Property
 prop_messageRoundTrip = property $ do
   msg <- forAll genMessage
-  parse (message mime) (renderMessage msg) === Right msg
+  parse (message mime) (renderMessage $ msg & set (headers . at "MIME-Version") (Just "1.0")) === Right msg
 
 prop_messageFromRoundTrip :: Property
 prop_messageFromRoundTrip = property $ do