From e89946f0e51365969cb2097a4a31205806475f80 Mon Sep 17 00:00:00 2001
From: tv <tv@krebsco.de>
Date: Sun, 28 Aug 2022 23:58:14 +0200
Subject: properly render untweaked MIME messages

---
 src/Data/MIME/Untweaked.hs | 31 +++++++++++++++++++++++++++++++
 1 file changed, 31 insertions(+)
 create mode 100644 src/Data/MIME/Untweaked.hs

(limited to 'src/Data/MIME/Untweaked.hs')

diff --git a/src/Data/MIME/Untweaked.hs b/src/Data/MIME/Untweaked.hs
new file mode 100644
index 0000000..56acd43
--- /dev/null
+++ b/src/Data/MIME/Untweaked.hs
@@ -0,0 +1,31 @@
+{-# LANGUAGE OverloadedStrings #-}
+module Data.MIME.Untweaked where
+
+import Data.Foldable (fold)
+import Data.List.NonEmpty (intersperse)
+import Data.MIME
+import qualified Data.ByteString.Builder as Builder
+
+
+
+newtype Untweaked = Untweaked MIME
+
+
+toUntweaked :: Message ctx MIME -> Message ctx Untweaked
+toUntweaked (Message h b) = Message h (Untweaked b)
+
+
+instance RenderMessage Untweaked where
+  buildBody _h (Untweaked z) = Just $ case z of
+    Part partbody -> Builder.byteString partbody
+    Encapsulated msg -> buildMessage . toUntweaked $ msg
+    Multipart _sub b xs ->
+      let
+        boundary = "--" <> Builder.byteString (unBoundary b)
+      in
+        boundary <> "\r\n"
+        <> fold (intersperse ("\r\n" <> boundary <> "\r\n") (fmap (buildMessage . toUntweaked) xs))
+        <> "\r\n" <> boundary <> "--\r\n"
+    FailedParse _ bs -> Builder.byteString bs
+
+
-- 
cgit v1.2.3