Preserve raw bytes in IMAP APPEND

src/Network/HaskellNet/IMAP.hs

@@ -260,7 +260,7 @@
     do (c, num) <- sendCommand' conn $ "AUTHENTICATE " ++ show at
        let challenge =
                if BS.take 2 c == BS.pack "+ "
                then A.b64Decode $ BS.unpack $ head $
                     dropWhile (isSpace . BS.last) $ BS.inits $ BS.drop 2 c
                else ""
        bsPutCrLf (stream conn) $ BS.pack $
@@ -332,7 +332,7 @@
                         , fstr, tstr, " {" ++ show len ++ "}"])
        when (BS.null buf || (BS.head buf /= '+')) $
               fail "illegal server response"
-       mapM_ (bsPutCrLf $ stream conn) mailLines
+       bsPut (stream conn) mailData
        bsPutCrLf (stream conn) BS.empty
        buf2 <- getResponse $ stream conn
        let (resp, mboxUp, ()) = eval pNone (show6 num) buf2
@@ -341,8 +341,7 @@
          NO _ msg      -> fail ("NO: "++msg)
          BAD _ msg     -> fail ("BAD: "++msg)
          PREAUTH _ msg -> fail ("PREAUTH: "++msg)
-    where mailLines = BS.lines mailData
-          len       = sum $ map ((2+) . BS.length) mailLines
+    where len       = BS.length mailData
           tstr      = maybe "" ((" "++) . datetimeToStringIMAP) time
           fstr      = maybe "" ((" ("++) . (++")") . unwords . map show) flags'
 

test/IMAPParsersTest.hs

@@ -11,8 +11,6 @@ import Network.HaskellNet.IMAP.Parsers
 import Network.HaskellNet.IMAP.Types
 import System.Exit
 
-import System.Exit
-
 import Test.HUnit
 
 data ReadStep = ReadLine ByteString | ReadBytes ByteString
@@ -297,6 +295,19 @@ imapCommandTest =
           [(MESSAGES, 1)] @=? statusResult
           actual <- written
           commandBytes "000000 STATUS \"foo bar\" (MESSAGES)" @=? actual
+    , "append preserves raw crlf message bytes" ~: TestCase $ do
+          let mailData = BS.pack "Subject: x\r\n\r\nBody\r\n"
+              expectedCommand = "000000 APPEND INBOX {" ++ show (BS.length mailData) ++ "}"
+          (conn, written) <- scriptedConnection
+              [ line "+ Ready for literal"
+              , okLine "APPEND completed"
+              ]
+          IMAP.append conn "INBOX" mailData
+          actual <- written
+          B.concat [ commandBytes expectedCommand
+                   , mailData
+                   , BS.pack "\r\n"
+                   ] @=? actual
     , "append quotes mailbox" ~: TestCase $ do
           let mailData = BS.pack "Body"
           (conn, written) <- scriptedConnection
@@ -305,8 +316,9 @@ imapCommandTest =
               ]
           IMAP.append conn "foo bar" mailData
           actual <- written
-          B.concat [ commandBytes "000000 APPEND \"foo bar\" {6}"
-                   , BS.pack "Body\r\n\r\n"
+          B.concat [ commandBytes ("000000 APPEND \"foo bar\" {" ++ show (BS.length mailData) ++ "}")
+                   , mailData
+                   , BS.pack "\r\n"
                    ] @=? actual
     , assertCommand "copy quotes mailbox"
           (commandBytes "000000 UID COPY 42 \"foo bar\"")