From e89946f0e51365969cb2097a4a31205806475f80 Mon Sep 17 00:00:00 2001 From: tv Date: Sun, 28 Aug 2022 23:58:14 +0200 Subject: properly render untweaked MIME messages --- mailaids.cabal | 1 + src/Data/MIME/Untweaked.hs | 31 +++++++++++++++++++++++++++++++ src/main.hs | 11 +++-------- 3 files changed, 35 insertions(+), 8 deletions(-) create mode 100644 src/Data/MIME/Untweaked.hs diff --git a/mailaids.cabal b/mailaids.cabal index f883db2..8eecdc1 100644 --- a/mailaids.cabal +++ b/mailaids.cabal @@ -26,3 +26,4 @@ executable mailaid other-modules: Data.ByteString.Extended Data.MIME.Extended + Data.MIME.Untweaked 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" -- cgit v1.2.3