diff options
| -rw-r--r-- | mailaids.cabal | 1 | ||||
| -rwxr-xr-x | scripts/parts | 19 | ||||
| -rw-r--r-- | src/Data/MIME/Extended.hs | 22 |
3 files changed, 33 insertions, 9 deletions
diff --git a/mailaids.cabal b/mailaids.cabal index 9c501d5..46f2c51 100644 --- a/mailaids.cabal +++ b/mailaids.cabal @@ -17,6 +17,7 @@ executable mailaid base, bytestring, case-insensitive, + either, lens, optparse-applicative, purebred-email >= 0.5, diff --git a/scripts/parts b/scripts/parts index ae73c2f..6449a6e 100755 --- a/scripts/parts +++ b/scripts/parts @@ -66,10 +66,21 @@ add_part() {( contentType="$(file -Lib "$filepath"); name=$filename" case $contentType in text/plain|text/plain\;*) - contentTransferEncoding=8bit - content() { - cat "$filepath" - } + max_length=$(awk ' + length > max_length { max_length = length } + END { print max_length } + ') + if test "$max_length" -le 998; then + contentTransferEncoding=8bit + content() { + cat "$filepath" + } + else + contentTransferEncoding=base64 + content() { + base64 "$filepath" + } + fi ;; *) contentTransferEncoding=base64 diff --git a/src/Data/MIME/Extended.hs b/src/Data/MIME/Extended.hs index 773d0b7..a58b9f5 100644 --- a/src/Data/MIME/Extended.hs +++ b/src/Data/MIME/Extended.hs @@ -7,12 +7,14 @@ module Data.MIME.Extended ( module Data.MIME ) where +import Control.Arrow (left) import Control.Lens hiding ((.=)) import Data.Aeson import Data.ByteString (ByteString) import Data.ByteString.Extended () import Data.CaseInsensitive (CI) import Data.Either (fromRight) +import Data.Either.Combinators (maybeToRight) import Data.List.NonEmpty (NonEmpty) import Data.MIME import Data.MIME.EncodedWord @@ -117,12 +119,18 @@ makeMultipart h = "related" -> Related <$> ( getRequiredParam "type" ct >>= \s -> - maybe - (Left $ InvalidParameterValue "type" s) - Right + maybeToRight + (InvalidParameterValue "type" s) (preview (parsed parseContentType) s) + >>= return . Just . setContentTypeParameters () + ) + <*> ( getOptionalParam "start" ct + >>= traverse + (\s -> + left + (InvalidParameterValue "start" . ((s <> ": ") <>)) + (makeContentID s)) ) - <*> getOptionalParam "start" ct <*> getOptionalParam "start-info" ct unrecognised -> pure $ Unrecognised unrecognised @@ -134,13 +142,17 @@ makeMultipart h = getRequiredParam :: HasParameters s => CI ByteString -> s -> Either MIMEParseError ByteString getRequiredParam k = - maybe (Left $ RequiredParameterMissing k) Right . preview (rawParameter k) + maybeToRight (RequiredParameterMissing k) . preview (rawParameter k) getOptionalParam :: HasParameters s => CI ByteString -> s -> Either a (Maybe ByteString) getOptionalParam k = Right . preview (rawParameter k) + setContentTypeParameters :: b -> ContentTypeWith a -> ContentTypeWith b + setContentTypeParameters p (ContentType t st _) = + ContentType t st p + data MIMEParseError = RequiredParameterMissing (CI ByteString) | InvalidParameterValue (CI ByteString) ByteString |