summaryrefslogtreecommitdiffstats
path: root/src
diff options
context:
space:
mode:
authortv <tv@krebsco.de>2022-08-28 23:58:14 +0200
committertv <tv@krebsco.de>2022-08-29 00:19:29 +0200
commite89946f0e51365969cb2097a4a31205806475f80 (patch)
tree205db30e3b105dfa1064bae5cfb94ccbf8428c9c /src
parent0dc6dbcca7a2e7ac813bb7511d27b781babb6d67 (diff)
properly render untweaked MIME messages
Diffstat (limited to 'src')
-rw-r--r--src/Data/MIME/Untweaked.hs31
-rw-r--r--src/main.hs11
2 files changed, 34 insertions, 8 deletions
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
+
+
diff --git a/src/main.hs b/src/main.hs
index bd2bc73..6c4b061 100644
--- a/src/main.hs
+++ b/src/main.hs
@@ -5,6 +5,7 @@ import qualified Data.Aeson
import Data.Aeson.Encode.Pretty
import qualified Data.ByteString.Lazy.Char8
import Data.MIME.Extended
+import Data.MIME.Untweaked (toUntweaked)
import qualified Options.Applicative
import qualified System.Exit
import System.IO (hPutStrLn,stderr)
@@ -42,12 +43,6 @@ optionsParser =
)
-newtype MIMENoTweak = MIMENoTweak MIME
-
-instance RenderMessage MIMENoTweak where
- buildBody h (MIMENoTweak b) = buildBody h b
-
-
main :: IO ()
main = do
options <-
@@ -71,8 +66,8 @@ main = do
if optionDecode options then
case Data.Aeson.decode s :: Maybe MIMEMessage of
- Just (Message h b) ->
- output $ renderMessage (Message h (MIMENoTweak b))
+ Just m ->
+ output $ renderMessage (toUntweaked m)
Nothing -> do
hPutStrLn stderr "error: failed to decode MIME message"