-- This file is part of purebred-email
-- Copyright (C) 2017-2021  Fraser Tweedale
--
-- purebred-email is free software: you can redistribute it and/or modify
-- it under the terms of the GNU Affero General Public License as published by
-- the Free Software Foundation, either version 3 of the License, or
-- (at your option) any later version.
--
-- This program is distributed in the hope that it will be useful,
-- but WITHOUT ANY WARRANTY; without even the implied warranty of
-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-- GNU Affero General Public License for more details.
--
-- You should have received a copy of the GNU Affero General Public License
-- along with this program.  If not, see <http://www.gnu.org/licenses/>.

{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE TypeFamilies #-}

{- |

This module extends "Data.IMF" with types for handling MIME messages
(RFC 2045, 2046, 2183 and others).

-}
module Data.MIME
  (
  -- * Overview / HOWTO
  -- ** Creating and serialising mail
  -- $create

  -- ** Parsing mail
  -- $parse

  -- ** Inspecting messages
  -- $inspect

  -- ** Unicode support
  -- $unicode

  -- * API

  -- ** MIME data type
    MIME(..)
  , mime
  , MIMEMessage

  , WireEntity
  , ByteEntity
  , TextEntity
  , EncStateWire
  , EncStateByte

  -- *** Accessing and processing entities
  , entities
  , attachments
  , isAttachment
  , transferDecoded
  , transferDecoded'
  , charsetDecoded
  , charsetDecoded'

  -- ** Header processing
  , decodeEncodedWords

  -- ** Content-Type header
  , contentType
  , ContentTypeWith(..)
  , ContentType
  , ctType
  , ctSubtype
  , matchContentType
  , parseContentType
  , renderContentType
  , showContentType

  -- *** @multipart@ media type
  , MultipartSubtype(..)

  -- **** @boundary@ parameter
  , Boundary
  , makeBoundary
  , unBoundary
  , mimeBoundary

  -- *** Content-Type values
  , contentTypeTextPlain
  , contentTypeApplicationOctetStream
  , contentTypeMultipartMixed
  , defaultContentType

  -- ** Content-Disposition header
  , contentDisposition
  , ContentDisposition(..)
  , DispositionType(..)
  , dispositionType
  , filename
  , filenameParameter
  , renderContentDisposition

  -- *** Content-ID header
  , ContentID
  , makeContentID
  , parseContentID
  , buildContentID
  , renderContentID
  , headerContentID

  -- ** Mail creation
  -- *** Common use cases
  , createTextPlainMessage
  , createAttachment
  , createAttachmentFromFile
  , createMultipartMixedMessage
  , setTextPlainBody

  -- *** Forward
  , encapsulate

  -- * Re-exports
  , CharsetLookup
  , defaultCharsets
  , module Data.IMF
  , module Data.MIME.Parameter
  , module Data.MIME.Error
  ) where

import Control.Applicative
import Control.Monad (when)
import Data.Foldable (fold)
import Data.List.NonEmpty (NonEmpty, fromList, intersperse)
import Data.Maybe (fromMaybe)
import Data.String (IsString(fromString))
import GHC.Generics (Generic)

import Control.DeepSeq (NFData)
import Control.Lens
import Data.Attoparsec.ByteString
import Data.Attoparsec.ByteString.Char8 (char8)
import qualified Data.ByteString as B
import qualified Data.ByteString.Char8 as C8
import qualified Data.ByteString.Builder as Builder
import qualified Data.ByteString.Lazy as L
import qualified Data.CaseInsensitive as CI
import qualified Data.Text as T
import qualified Data.Text.Encoding as T

import Data.IMF
import Data.IMF.Syntax hiding (takeWhile1)
import Data.MIME.Boundary
import Data.MIME.Error
import Data.MIME.Charset
import Data.MIME.EncodedWord
import Data.MIME.Parameter
import Data.MIME.TransferEncoding

{- $create

Create an __inline, plain text message__ and __render__ it:

@
λ> :set -XOverloadedStrings
λ> import Data.MIME
λ> msg = 'createTextPlainMessage' "Hello, world!"
λ> s = 'renderMessage' msg
λ> Data.ByteString.Lazy.Char8.putStrLn s
MIME-Version: 1.0
Content-Transfer-Encoding: 7bit
Content-Disposition: inline
Content-Type: text/plain; charset=us-ascii

Hello, world!
@

Optics are provided for getting and setting the __sender and recipient__
fields:

@
'headerFrom', 'headerReplyTo', 'headerTo', 'headerCC', 'headerBCC'
  :: ('HasHeaders' a)
  => 'CharsetLookup' -> Lens' a ['Address']
@

Example:

@
λ> alice = 'Single' "alice\@example.com"
λ> :t alice
alice :: 'Address'
λ> bob = 'Single' "bob\@example.net"
λ> msgFromAliceToBob = set ('headerFrom' 'defaultCharsets') [alice] . set ('headerTo' defaultCharsets) [bob] $ msg
λ> Data.ByteString.Lazy.Char8.putStrLn ('renderMessage' msgFromAliceToBob)
MIME-Version: 1.0
From: alice\@example.com
To: bob\@example.net
Content-Transfer-Encoding: 7bit
Content-Disposition: inline
Content-Type: text/plain; charset=us-ascii

Hello, world!
@

__NOTE__: the values @alice@ and @bob@ in the above example make use
of the __non-total__ @instance 'IsString' 'Mailbox'@.  This instance
is provided as convenience for static values.  For parsing mailboxes,
use one of:

@
Data.IMF.'Data.IMF.mailbox'      :: 'CharsetLookup' -> Parser ByteString Mailbox
Data.IMF.Text.'Data.IMF.Text.mailbox' ::                  Parser       Text Mailbox
@

The __@Subject@__ header is set via 'headerSubject'.  __Other single-valued headers__
can be set via 'headerText'.

@
λ> :{
| Data.ByteString.Lazy.Char8.putStrLn . 'renderMessage' $
|   set ('headerText' defaultCharsets \"Comments\") (Just "와")
|   . set ('headerSubject' defaultCharsets) (Just "Hi from Alice")
|   $ msgFromAliceToBob
| :}

MIME-Version: 1.0
Comments: =?utf-8?B?7JmA?=
Subject: Hi from Alice
From: alice\@example.com
To: bob\@example.net
Content-Transfer-Encoding: 7bit
Content-Disposition: inline
Content-Type: text/plain; charset=us-ascii

Hello, world!
@

To create __multipart messages__ you need to construct a 'Boundary' value.
Boundary values should be unique (not appearing elsewhere in a message).
High-entropy random values are good.  You can use 'mkBoundary' to construct a
value (checking that the input is a legal value).  Or you can ask
/purebred-email/ to generate a conformant value, as below.

@
λ> import System.Random
λ> boundary <- getStdRandom uniform :: IO Boundary
λ> boundary
Boundary "MEgno8wUdTT\/g8vB,vj.3K8sjU6i_r=CFf1jqrAmnxrv0a\/9PA'G4hQ8oE,u016w"
@

Create a __multipart message with attachment__:

@
λ> attachment = 'createAttachment' "application/json" (Just "data.json") "{\\"foo\\":42}"
λ> msg2 = 'createMultipartMixedMessage' boundary (msg :| [attachment])
λ> s2 = 'renderMessage' msg2
λ> Data.ByteString.Lazy.Char8.putStrLn s2
MIME-Version: 1.0
Content-Type: multipart/mixed;
 boundary="MEgno8wUdTT\/g8vB,vj.3K8sjU6i_r=CFf1jqrAmnxrv0a\/9PA'G4hQ8oE,u016w"

--MEgno8wUdTT\/g8vB,vj.3K8sjU6i_r=CFf1jqrAmnxrv0a\/9PA'G4hQ8oE,u016w
MIME-Version: 1.0
Content-Transfer-Encoding: 7bit
Content-Disposition: inline
Content-Type: text/plain; charset=us-ascii

Hello, world!
--MEgno8wUdTT\/g8vB,vj.3K8sjU6i_r=CFf1jqrAmnxrv0a\/9PA'G4hQ8oE,u016w
MIME-Version: 1.0
Content-Transfer-Encoding: 7bit
Content-Disposition: attachment; filename=data.json
Content-Type: application/json

{"foo":42}
--MEgno8wUdTT\/g8vB,vj.3K8sjU6i_r=CFf1jqrAmnxrv0a\/9PA'G4hQ8oE,u016w--

@

__NOTE:__ for writing a 'Message' to an 
IO handle, 'buildMessage' is more efficient than 'renderMessage'.

-}

{- $parse

Most often you will __parse a message__ like this:

@
λ> parsedMessage = 'parse' ('message' 'mime') s2
λ> :t parsedMessage
parsedMessage :: Either String 'MIMEMessage'
λ> parsedMessage == Right msg2
True
@

The 'message' function builds a parser for a message.  It is
abstracted over the body type; the argument is a function that can
inspect headers and return a parser for the body.  If you are
parsing MIME messages (or plain RFC 5322 messages), the 'mime'
function is the right one to use.

-}

{- $inspect

Parsing an email is nice, but your normally want to get at the
content inside.  One of the most important tasks is __finding
entities__ of interest, e.g.  attachments, plain text or HTML
bodies.  The 'entities' optic is a fold over all /leaf/ entities in
the message.  That is, the leaves of (possibly nested) multipart
messages and "message/rfc822" encapsulations.  You can use
'filtered' to refine the query.

For example, let's say you want to find the first @text/plain@
entity in a message.  Define a predicate with the help of the
'matchContentType' function:

@
λ> isTextPlain = 'matchContentType' "text" (Just "plain") . view 'contentType'
λ> :t isTextPlain
isTextPlain :: 'HasHeaders' s => s -> Bool
λ> (isTextPlain msg, isTextPlain msg2)
(True,False)
@

Now we can use the predicate to construct a fold and retrieve the
body.  If there is no matching entity the result would be @Nothing@.

@
λ> firstOf ('entities' . filtered isTextPlain . 'body') msg2
Just "Hello, world!"
@

For __attachments__, you may be interested in the binary data and
the filename (if specified).  In the following example we get the
(optional) filenames and (decoded) body of all attachments, as a
list of tuples.  The 'attachments' traversal targets non-multipart
entities with @Content-Disposition: attachment@.  The
'transferDecoded'' optic undoes the @Content-Transfer-Encoding@ of
the entity.

@
λ> :set -XTypeFamilies
λ> getFilename = preview ('contentDisposition' . _Just . 'filename' 'defaultCharsets')
λ> getBody = preview ('transferDecoded'' . _Right . 'body')
λ> getAttachment = liftA2 (,) getFilename getBody
λ> toListOf ('attachments' . to getAttachment) msg2
[(Just "data.json",Just "{\\"foo\\":42}")]
@

Finally, note that the 'filename' optic takes an argument: it is a
function for looking up a character set.  Supporting every possible
character encoding is a bit tricky so we let the user supply a map
of supported charsets, and provide 'defaultCharsets' which supports
ASCII, UTF-8 and ISO-8859-1.

@
λ> :t 'filename'
filename
  :: ('HasParameters' a, Applicative f) =>
     'CharsetLookup' -> (T.Text -> f T.Text) -> a -> f a
λ> :t 'defaultCharsets'
defaultCharsets :: CharsetLookup
λ> :i CharsetLookup
type CharsetLookup = CI Char8.ByteString -> Maybe Data.MIME.Charset.Charset
@

-}

{- $unicode

In Australia we say "Hello world" upside down:

@
λ> msg3 = 'createTextPlainMessage' "ɥǝןןo ʍoɹןp"
λ> Data.ByteString.Lazy.Char8.putStrLn $ 'renderMessage' msg3
MIME-Version: 1.0
Content-Transfer-Encoding: base64
Content-Disposition: inline
Content-Type: text/plain; charset=utf-8

yaXHndef159vIMqNb8m5159w
@

Charset set and transfer encoding are handled automatically.  If the
message only includes characters representable in ASCII, the charset
will be @us-ascii@, otherwise @utf-8@.

To read the message as @Text@ you must perform transfer decoding and
charset decoding.  The 'transferDecoded' optic performs transfer
decoding, as does its sibling 'transferDecoded'' which is
monomorphic in the error type.  Similarly, 'charsetText' and
'charsetText'' perform text decoding according to the character set.

If you don't mind throwing away decoding errors, the simplest way to
get the text of a message is:

@
λ> Just ent = firstOf ('entities' . filtered isTextPlain) msg3
λ> :t ent
ent :: 'WireEntity'
λ> text = preview ('transferDecoded'' . _Right . 'charsetText'' 'defaultCharsets' . _Right) ent
λ> :t text
text :: Maybe T.Text
λ> traverse_ Data.Text.IO.putStrLn text
ɥǝןןo ʍoɹןp
@

As mentioned earlier, functions that perform text decoding take a
'CharsetLookup' parameter, and we provide 'defaultCharsets' for
convenience.

-}


-- | Entity is formatted for transfer.  Processing requires
-- transfer decoding.
--
data EncStateWire

-- | Entity requires content-transfer-encoding to send,
--   and may require charset decoding to read.
--
data EncStateByte

type MIMEMessage = Message EncStateWire MIME
type WireEntity = Message EncStateWire B.ByteString
type ByteEntity = Message EncStateByte B.ByteString
type TextEntity = Message () T.Text

data MultipartSubtype
  = Mixed
  -- ^ <https://www.rfc-editor.org/rfc/rfc2046.html#section-5.1.3 RFC 2046 §5.1.3.>
  -- Independent body parts, bundled in a particular order.
  | Alternative
  -- ^ <https://www.rfc-editor.org/rfc/rfc2046.html#section-5.1.4 RFC 2046 §5.1.4.>
  -- Each part is an alternative version of the same content
  -- (e.g. plain text and HTML), in order of increasing faithfulness
  -- to the original content.
  | Digest
  -- ^ <https://www.rfc-editor.org/rfc/rfc2046.html#section-5.1.5 RFC 2046 §5.1.5.>
  -- Collection of messages. Parts should have @Content-Type: message/rfc822@.
  | Parallel
  -- ^ <https://www.rfc-editor.org/rfc/rfc2046.html#section-5.1.6 RFC 2046 §5.1.6.>
  -- Independent body parts, order not significants.  Parts may be
  -- displayed in parallel if the system supports it.
  | Related
  -- ^ Aggregate or compound objects.  Per
  -- <https://www.rfc-editor.org/rfc/rfc2387.html RFC 2387> the
  -- @type@ parameter is required.  Sadly some major producers omit
  -- it, so this constructor must admit that case.  See
  -- https://github.com/purebred-mua/purebred-email/issues/68.
      (Maybe (ContentTypeWith ()))
      -- ^ The @type@ parameter must be specified and its value is
      -- the MIME media type of the "root" body part.  It permits a
      -- MIME user agent to determine the @Content-Type@ without
      -- reference to the enclosed body part.  If the value of the
      -- @type@ parameter and the root body part's @Content-Type@
      -- differ then the User Agent's behavior is undefined.
      (Maybe ContentID)
      -- ^ The @start@ parameter, if given, points, via a
      -- @Content-ID@, to the body part that contains the object
      -- root.  The default root is the first body part within the
      -- @multipart/related@ body.
      (Maybe B.ByteString)
      -- ^ @start-info@ parameter.  Applications that use
      -- @multipart/related@ must specify the interpretation of
      -- @start-info@.  User Agents shall provide the parameter's
      -- value to the processing application.
  | Signed
  -- ^ <https://www.rfc-editor.org/rfc/rfc1847.html#section-2.1 RFC 1847 §2.1.>
  -- Signed messages.
      B.ByteString {- ^ protocol -}
      B.ByteString {- ^ micalg -}
  | Encrypted
  -- ^ <https://www.rfc-editor.org/rfc/rfc1847.html#section-2.2 RFC 1847 §2.2.>
      B.ByteString {- ^ protocol -}
  | Report
  -- ^ <https://www.rfc-editor.org/rfc/rfc6522.html RFC 6522>.
  -- Electronic mail reports.
      B.ByteString {- ^ report-type -}
  | Multilingual
  -- ^ <https://www.rfc-editor.org/rfc/rfc8255.html RFC 8255>.
  -- Multilingual messages.  The first part should be a multilingual
  -- explanatory preface.  Subsequent parts MUST have a
  -- @Content-Language@ and a @Content-Type@ field, and MAY have a
  -- @Content-Translation-Type@ field.
  | Unrecognised (CI B.ByteString)
  deriving (MultipartSubtype -> MultipartSubtype -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MultipartSubtype -> MultipartSubtype -> Bool
$c/= :: MultipartSubtype -> MultipartSubtype -> Bool
== :: MultipartSubtype -> MultipartSubtype -> Bool
$c== :: MultipartSubtype -> MultipartSubtype -> Bool
Eq, Int -> MultipartSubtype -> ShowS
[MultipartSubtype] -> ShowS
MultipartSubtype -> FilePath
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [MultipartSubtype] -> ShowS
$cshowList :: [MultipartSubtype] -> ShowS
show :: MultipartSubtype -> FilePath
$cshow :: MultipartSubtype -> FilePath
showsPrec :: Int -> MultipartSubtype -> ShowS
$cshowsPrec :: Int -> MultipartSubtype -> ShowS
Show)

-- | MIME message body.  Either a single @Part@, or @Multipart@.
-- Only the body is represented; preamble and epilogue are not.
--
data MIME
  = Part B.ByteString
  | Encapsulated MIMEMessage
  | Multipart MultipartSubtype Boundary (NonEmpty MIMEMessage)
  | FailedParse MIMEParseError B.ByteString
  deriving (MIME -> MIME -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MIME -> MIME -> Bool
$c/= :: MIME -> MIME -> Bool
== :: MIME -> MIME -> Bool
$c== :: MIME -> MIME -> Bool
Eq, Int -> MIME -> ShowS
[MIME] -> ShowS
MIME -> FilePath
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [MIME] -> ShowS
$cshowList :: [MIME] -> ShowS
show :: MIME -> FilePath
$cshow :: MIME -> FilePath
showsPrec :: Int -> MIME -> ShowS
$cshowsPrec :: Int -> MIME -> ShowS
Show)

-- | Ignores the presence/absense of @MIME-Version@ header
instance EqMessage MIME where
  Message Headers
h1 MIME
b1 eqMessage :: forall s. Message s MIME -> Message s MIME -> Bool
`eqMessage` Message Headers
h2 MIME
b2 =
    Headers -> Headers
stripVer Headers
h1 forall a. Eq a => a -> a -> Bool
== Headers -> Headers
stripVer Headers
h2 Bool -> Bool -> Bool
&& MIME
b1 forall a. Eq a => a -> a -> Bool
== MIME
b2
    where
    stripVer :: Headers -> Headers
stripVer = forall s t a b. ASetter s t a b -> b -> s -> t
set (forall a. HasHeaders a => Lens' a Headers
headers forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at CI ByteString
"MIME-Version") forall a. Maybe a
Nothing

-- | Get all leaf entities from the MIME message.
-- Entities that failed to parse are skipped.
--
entities :: Traversal' MIMEMessage WireEntity
entities :: Traversal' MIMEMessage WireEntity
entities WireEntity -> f WireEntity
f (Message Headers
h MIME
a) = case MIME
a of
  Part ByteString
b ->
    (\(Message Headers
h' ByteString
b') -> forall s a. Headers -> a -> Message s a
Message Headers
h' (ByteString -> MIME
Part ByteString
b')) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> WireEntity -> f WireEntity
f (forall s a. Headers -> a -> Message s a
Message Headers
h ByteString
b)
  Encapsulated MIMEMessage
msg -> forall s a. Headers -> a -> Message s a
Message Headers
h forall b c a. (b -> c) -> (a -> b) -> a -> c
. MIMEMessage -> MIME
Encapsulated forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Traversal' MIMEMessage WireEntity
entities WireEntity -> f WireEntity
f MIMEMessage
msg
  Multipart MultipartSubtype
sub Boundary
b NonEmpty MIMEMessage
bs ->
    forall s a. Headers -> a -> Message s a
Message Headers
h forall b c a. (b -> c) -> (a -> b) -> a -> c
. MultipartSubtype -> Boundary -> NonEmpty MIMEMessage -> MIME
Multipart MultipartSubtype
sub Boundary
b forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (Traversal' MIMEMessage WireEntity
entities WireEntity -> f WireEntity
f) NonEmpty MIMEMessage
bs
  FailedParse MIMEParseError
_ ByteString
_ -> forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall s a. Headers -> a -> Message s a
Message Headers
h MIME
a)

-- | Leaf entities with @Content-Disposition: attachment@
attachments :: Traversal' MIMEMessage WireEntity
attachments :: Traversal' MIMEMessage WireEntity
attachments = Traversal' MIMEMessage WireEntity
entities forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (p :: * -> * -> *) (f :: * -> *) a.
(Choice p, Applicative f) =>
(a -> Bool) -> Optic' p f a a
filtered forall a. HasHeaders a => a -> Bool
isAttachment

-- | MIMEMessage content disposition is an 'Attachment'
isAttachment :: HasHeaders a => a -> Bool
isAttachment :: forall a. HasHeaders a => a -> Bool
isAttachment = forall s a. Getting Any s a -> s -> Bool
has (forall a. HasHeaders a => Lens' a (Maybe ContentDisposition)
contentDisposition forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. Prism (Maybe a) (Maybe b) a b
_Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' ContentDisposition DispositionType
dispositionType forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (p :: * -> * -> *) (f :: * -> *) a.
(Choice p, Applicative f) =>
(a -> Bool) -> Optic' p f a a
filtered (forall a. Eq a => a -> a -> Bool
== DispositionType
Attachment))

contentTransferEncoding
  :: (Profunctor p, Contravariant f) => Optic' p f Headers TransferEncodingName
contentTransferEncoding :: forall (p :: * -> * -> *) (f :: * -> *).
(Profunctor p, Contravariant f) =>
Optic' p f Headers (CI ByteString)
contentTransferEncoding = forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to forall a b. (a -> b) -> a -> b
$
  forall a. a -> Maybe a -> a
fromMaybe CI ByteString
"7bit"
  forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s (m :: * -> *) a.
MonadReader s m =>
Getting (First a) s a -> m (Maybe a)
preview (forall a. HasHeaders a => CI ByteString -> Traversal' a ByteString
header CI ByteString
"content-transfer-encoding" forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s. FoldCase s => Iso' s (CI s)
caseInsensitive)

instance HasTransferEncoding WireEntity where
  type TransferDecoded WireEntity = ByteEntity
  transferEncodingName :: Getter WireEntity (CI ByteString)
transferEncodingName = forall a. HasHeaders a => Lens' a Headers
headers forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (p :: * -> * -> *) (f :: * -> *).
(Profunctor p, Contravariant f) =>
Optic' p f Headers (CI ByteString)
contentTransferEncoding
  transferEncodedData :: Getter WireEntity ByteString
transferEncodedData = forall ctx a ctx' b. Lens (Message ctx a) (Message ctx' b) a b
body
  transferDecoded :: forall e (p :: * -> * -> *) (f :: * -> *).
(AsTransferEncodingError e, Profunctor p, Contravariant f) =>
Optic' p f WireEntity (Either e (TransferDecoded WireEntity))
transferDecoded = forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to forall a b. (a -> b) -> a -> b
$ \WireEntity
a -> (\ByteString
t -> forall s t a b. ASetter s t a b -> b -> s -> t
set forall ctx a ctx' b. Lens (Message ctx a) (Message ctx' b) a b
body ByteString
t WireEntity
a) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view forall a e (p :: * -> * -> *) (f :: * -> *).
(HasTransferEncoding a, AsTransferEncodingError e, Profunctor p,
 Contravariant f) =>
Optic' p f a (Either e ByteString)
transferDecodedBytes WireEntity
a

  transferEncode :: TransferDecoded WireEntity -> WireEntity
transferEncode (Message Headers
h ByteString
s) =
    let
      (CI ByteString
cteName, TransferEncoding
cte) = ByteString -> (CI ByteString, TransferEncoding)
chooseTransferEncoding ByteString
s
      s' :: ByteString
s' = forall b (m :: * -> *) t. MonadReader b m => AReview t b -> m t
review (forall s t a b. APrism s t a b -> Prism s t a b
clonePrism TransferEncoding
cte) ByteString
s
      cteName' :: ByteString
cteName' = forall s. CI s -> s
CI.original CI ByteString
cteName
      h' :: Headers
h' = forall s t a b. ASetter s t a b -> b -> s -> t
set (forall a. HasHeaders a => Lens' a Headers
headers forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at CI ByteString
"Content-Transfer-Encoding") (forall a. a -> Maybe a
Just ByteString
cteName') Headers
h
    in
      forall s a. Headers -> a -> Message s a
Message Headers
h' ByteString
s'

caseInsensitive :: CI.FoldCase s => Iso' s (CI s)
caseInsensitive :: forall s. FoldCase s => Iso' s (CI s)
caseInsensitive = forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso forall s. FoldCase s => s -> CI s
CI.mk forall s. CI s -> s
CI.original
{-# INLINE caseInsensitive #-}


-- | Content-Type (type and subtype) with explicit parameters type.
-- Use 'parameters' to access the parameters field.
-- Example:
--
-- @
-- ContentType "text" "plain" (Parameters [("charset", "utf-8")])
-- @
--
-- You can also use @-XOverloadedStrings@ but be aware the conversion
-- is non-total (throws an error if it cannot parse the string).
--
data ContentTypeWith a = ContentType (CI B.ByteString) (CI B.ByteString) a
  deriving
    ( Int -> ContentTypeWith a -> ShowS
forall a. Show a => Int -> ContentTypeWith a -> ShowS
forall a. Show a => [ContentTypeWith a] -> ShowS
forall a. Show a => ContentTypeWith a -> FilePath
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [ContentTypeWith a] -> ShowS
$cshowList :: forall a. Show a => [ContentTypeWith a] -> ShowS
show :: ContentTypeWith a -> FilePath
$cshow :: forall a. Show a => ContentTypeWith a -> FilePath
showsPrec :: Int -> ContentTypeWith a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> ContentTypeWith a -> ShowS
Show, forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (ContentTypeWith a) x -> ContentTypeWith a
forall a x. ContentTypeWith a -> Rep (ContentTypeWith a) x
$cto :: forall a x. Rep (ContentTypeWith a) x -> ContentTypeWith a
$cfrom :: forall a x. ContentTypeWith a -> Rep (ContentTypeWith a) x
Generic, forall a. NFData a => ContentTypeWith a -> ()
forall a. (a -> ()) -> NFData a
rnf :: ContentTypeWith a -> ()
$crnf :: forall a. NFData a => ContentTypeWith a -> ()
NFData,
      ContentTypeWith a -> ContentTypeWith a -> Bool
forall a. Eq a => ContentTypeWith a -> ContentTypeWith a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ContentTypeWith a -> ContentTypeWith a -> Bool
$c/= :: forall a. Eq a => ContentTypeWith a -> ContentTypeWith a -> Bool
== :: ContentTypeWith a -> ContentTypeWith a -> Bool
$c== :: forall a. Eq a => ContentTypeWith a -> ContentTypeWith a -> Bool
Eq  -- ^ Compares type and subtype case-insensitively; parameters
          -- are also compared.  Use 'matchContentType' if you just want
          -- to match on the media type while ignoring parameters.
    )

type ContentType = ContentTypeWith Parameters

-- | __NON-TOTAL__ parses the Content-Type (including parameters)
-- and throws an error if the parse fails
--
instance IsString ContentType where
  fromString :: FilePath -> ContentType
fromString = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall {a}. FilePath -> a
err forall a. a -> a
id forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Parser a -> ByteString -> Either FilePath a
parseOnly (Parser ByteString ContentType
parseContentType forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall t. Chunk t => Parser t ()
endOfInput) forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> ByteString
C8.pack
    where
    err :: FilePath -> a
err FilePath
msg = forall a. HasCallStack => FilePath -> a
error forall a b. (a -> b) -> a -> b
$ FilePath
"failed to parse Content-Type: " forall a. Semigroup a => a -> a -> a
<> FilePath
msg

-- | Match content type.  If @Nothing@ is given for subtype, any
-- subtype is accepted.
--
matchContentType
  :: CI B.ByteString         -- ^ type
  -> Maybe (CI B.ByteString) -- ^ optional subtype
  -> ContentTypeWith a
  -> Bool
matchContentType :: forall a.
CI ByteString -> Maybe (CI ByteString) -> ContentTypeWith a -> Bool
matchContentType CI ByteString
wantType Maybe (CI ByteString)
wantSubtype (ContentType CI ByteString
gotType CI ByteString
gotSubtype a
_) =
  CI ByteString
wantType forall a. Eq a => a -> a -> Bool
== CI ByteString
gotType Bool -> Bool -> Bool
&& forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
True (forall a. Eq a => a -> a -> Bool
== CI ByteString
gotSubtype) Maybe (CI ByteString)
wantSubtype

renderContentType :: ContentType -> B.ByteString
renderContentType :: ContentType -> ByteString
renderContentType = forall a. (a -> ByteString) -> ContentTypeWith a -> ByteString
renderContentTypeWith Parameters -> ByteString
printParameters

renderContentTypeWith :: (a -> B.ByteString) -> ContentTypeWith a -> B.ByteString
renderContentTypeWith :: forall a. (a -> ByteString) -> ContentTypeWith a -> ByteString
renderContentTypeWith a -> ByteString
renderParams (ContentType CI ByteString
typ CI ByteString
sub a
params) =
  forall s. CI s -> s
CI.original CI ByteString
typ forall a. Semigroup a => a -> a -> a
<> ByteString
"/" forall a. Semigroup a => a -> a -> a
<> forall s. CI s -> s
CI.original CI ByteString
sub forall a. Semigroup a => a -> a -> a
<> a -> ByteString
renderParams a
params

printParameters :: Parameters -> B.ByteString
printParameters :: Parameters -> ByteString
printParameters (Parameters [(CI ByteString, ByteString)]
xs) =
  forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (\(CI ByteString
k,ByteString
v) -> ByteString
"; " forall a. Semigroup a => a -> a -> a
<> forall s. CI s -> s
CI.original CI ByteString
k forall a. Semigroup a => a -> a -> a
<> ByteString
"=" forall a. Semigroup a => a -> a -> a
<> ByteString
v) [(CI ByteString, ByteString)]
xs

ctType :: Lens' (ContentTypeWith a) (CI B.ByteString)
ctType :: forall a. Lens' (ContentTypeWith a) (CI ByteString)
ctType CI ByteString -> f (CI ByteString)
f (ContentType CI ByteString
a CI ByteString
b a
c) = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\CI ByteString
a' -> forall a. CI ByteString -> CI ByteString -> a -> ContentTypeWith a
ContentType CI ByteString
a' CI ByteString
b a
c) (CI ByteString -> f (CI ByteString)
f CI ByteString
a)

ctSubtype :: Lens' (ContentTypeWith a) (CI B.ByteString)
ctSubtype :: forall a. Lens' (ContentTypeWith a) (CI ByteString)
ctSubtype CI ByteString -> f (CI ByteString)
f (ContentType CI ByteString
a CI ByteString
b a
c) = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\CI ByteString
b' -> forall a. CI ByteString -> CI ByteString -> a -> ContentTypeWith a
ContentType CI ByteString
a CI ByteString
b' a
c) (CI ByteString -> f (CI ByteString)
f CI ByteString
b)

ctParameters :: Lens (ContentTypeWith a) (ContentTypeWith b) a b
ctParameters :: forall a b. Lens (ContentTypeWith a) (ContentTypeWith b) a b
ctParameters a -> f b
f (ContentType CI ByteString
a CI ByteString
b a
c) = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\b
c' -> forall a. CI ByteString -> CI ByteString -> a -> ContentTypeWith a
ContentType CI ByteString
a CI ByteString
b b
c') (a -> f b
f a
c)
{-# ANN ctParameters ("HLint: ignore Avoid lambda" :: String) #-}

-- | Rendered content type field value for displaying
showContentType :: ContentType -> T.Text
showContentType :: ContentType -> Text
showContentType = ByteString -> Text
decodeLenient forall b c a. (b -> c) -> (a -> b) -> a -> c
. ContentType -> ByteString
renderContentType

instance HasParameters ContentType where
  parameters :: Lens' ContentType Parameters
parameters = forall a b. Lens (ContentTypeWith a) (ContentTypeWith b) a b
ctParameters

-- | Parser for Content-Type header
parseContentType :: Parser ContentType
parseContentType :: Parser ByteString ContentType
parseContentType = forall a.
(CI ByteString -> CI ByteString -> Parser a)
-> Parser (ContentTypeWith a)
parseContentTypeWith forall {a} {p}.
(Eq a, IsString a) =>
a -> p -> Parser ByteString Parameters
go
  where
  go :: a -> p -> Parser ByteString Parameters
go a
typ p
_subtype = do
    [(CI ByteString, ByteString)]
params <- Parser [(CI ByteString, ByteString)]
parseParameters
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (a
typ forall a. Eq a => a -> a -> Bool
== a
"multipart" Bool -> Bool -> Bool
&& CI ByteString
"boundary" forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a, b) -> a
fst [(CI ByteString, ByteString)]
params) forall a b. (a -> b) -> a -> b
$
      -- https://tools.ietf.org/html/rfc2046#section-5.1.1
      forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail FilePath
"\"boundary\" parameter is required for multipart content type"
    forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ [(CI ByteString, ByteString)] -> Parameters
Parameters [(CI ByteString, ByteString)]
params

parseContentTypeWith
  :: (CI B.ByteString -> CI B.ByteString -> Parser a)
  -> Parser (ContentTypeWith a)
parseContentTypeWith :: forall a.
(CI ByteString -> CI ByteString -> Parser a)
-> Parser (ContentTypeWith a)
parseContentTypeWith CI ByteString -> CI ByteString -> Parser a
p = do
  CI ByteString
typ <- forall s. FoldCase s => Parser s -> Parser (CI s)
ci Parser ByteString
token
  Word8
_ <- Char -> Parser Word8
char8 Char
'/'
  CI ByteString
subtype <- forall s. FoldCase s => Parser s -> Parser (CI s)
ci Parser ByteString
token
  a
params <- CI ByteString -> CI ByteString -> Parser a
p CI ByteString
typ CI ByteString
subtype
  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a. CI ByteString -> CI ByteString -> a -> ContentTypeWith a
ContentType CI ByteString
typ CI ByteString
subtype a
params

parseParameters :: Parser [(CI B.ByteString, B.ByteString)]
parseParameters :: Parser [(CI ByteString, ByteString)]
parseParameters = forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (Char -> Parser Word8
char8 Char
';' forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Word8 -> Bool) -> Parser ByteString ()
skipWhile (forall a. Eq a => a -> a -> Bool
== Word8
32 {-SP-}) forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ByteString (CI ByteString, ByteString)
param)
  where
    param :: Parser ByteString (CI ByteString, ByteString)
param = (,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s. FoldCase s => Parser s -> Parser (CI s)
ci Parser ByteString
token forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Char -> Parser Word8
char8 Char
'=' forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ByteString
val
    val :: Parser ByteString
val = Parser ByteString
token forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (f :: * -> * -> *) s a.
(Alternative (f s), CharParsing f s a, SM s) =>
f s s
quotedString

-- | header token parser
token :: Parser B.ByteString
token :: Parser ByteString
token =
  (Word8 -> Bool) -> Parser ByteString
takeWhile1 (\Word8
c -> Word8
c forall a. Ord a => a -> a -> Bool
>= Word8
33 Bool -> Bool -> Bool
&& Word8
c forall a. Ord a => a -> a -> Bool
<= Word8
126 Bool -> Bool -> Bool
&& FilePath -> Word8 -> Bool
notInClass FilePath
"()<>@,;:\\\"/[]?=" Word8
c)

-- | <https://www.rfc-editor.org/rfc/rfc6657.html RFC 6657>
-- specifies that each subtype of the @text@ media type can define
-- its own default value for the @charset@ parameter, including the
-- absense of any default.  It can also specify that the charset
-- information is transported inside the payload (such as in
-- @text/xml@.  Behaviour for common media types includes:
--
-- [@text/plain@] Default: @us-ascii@
--   (<https://www.rfc-editor.org/rfc/rfc6657.html#section-4 RFC 6657>)
-- [@text/csv@] Default: @utf-8@
--   (<https://www.rfc-editor.org/rfc/rfc7111.html#section-5.1 RFC 7111>)
-- [@text/markdown@] No default; @charset@ parameter is REQUIRED
--   (<https://www.rfc-editor.org/rfc/rfc7763.html#section-2 RFC 7763>)
-- [@text/enriched@] Default: @us-ascii@
--   (<https://www.rfc-editor.org/rfc/rfc1896.html RFC 1896>)
-- [@text/rtf@] Decoded as @us-ascii@.  Serialised RTF must be 7-bit
--   ASCII, with the character set declared in the payload.
--   Decoding RTF is outside the scope of this library.
--   See <https://www.iana.org/assignments/media-types/text/rtf>.
--
instance HasCharset ByteEntity where
  type Decoded ByteEntity = TextEntity
  charsetName :: Getter ByteEntity (Maybe (CI ByteString))
charsetName = forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to forall a b. (a -> b) -> a -> b
$ \ByteEntity
ent ->
    let
      (ContentType CI ByteString
typ CI ByteString
sub Parameters
params) = forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view (forall a. HasHeaders a => Lens' a Headers
headers forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. HasHeaders a => Lens' a ContentType
contentType) ByteEntity
ent
      source :: CI ByteString -> EntityCharsetSource
source = forall a. a -> Maybe a -> a
fromMaybe (Maybe (CI ByteString) -> EntityCharsetSource
InParameter (forall a. a -> Maybe a
Just CI ByteString
"us-ascii")) forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a b. Eq a => a -> [(a, b)] -> Maybe b
`lookup` [(CI ByteString, EntityCharsetSource)]
textCharsetSources)
      l :: (CI ByteString -> Const (First (CI ByteString)) (CI ByteString))
-> Parameters -> Const (First (CI ByteString)) Parameters
l = forall a.
HasParameters a =>
CI ByteString -> Traversal' a ByteString
rawParameter CI ByteString
"charset" forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s. FoldCase s => Iso' s (CI s)
caseInsensitive
    in
      if CI ByteString
typ forall a. Eq a => a -> a -> Bool
== CI ByteString
"text"
      then case CI ByteString -> EntityCharsetSource
source CI ByteString
sub of
        InPayload ByteString -> Maybe (CI ByteString)
f -> ByteString -> Maybe (CI ByteString)
f (forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view forall ctx a ctx' b. Lens (Message ctx a) (Message ctx' b) a b
body ByteEntity
ent)
        InParameter Maybe (CI ByteString)
def -> forall s (m :: * -> *) a.
MonadReader s m =>
Getting (First a) s a -> m (Maybe a)
preview (CI ByteString -> Const (First (CI ByteString)) (CI ByteString))
-> Parameters -> Const (First (CI ByteString)) Parameters
l Parameters
params forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe (CI ByteString)
def
        InPayloadOrParameter Maybe (CI ByteString) -> ByteString -> Maybe (CI ByteString)
f -> Maybe (CI ByteString) -> ByteString -> Maybe (CI ByteString)
f (forall s (m :: * -> *) a.
MonadReader s m =>
Getting (First a) s a -> m (Maybe a)
preview (CI ByteString -> Const (First (CI ByteString)) (CI ByteString))
-> Parameters -> Const (First (CI ByteString)) Parameters
l Parameters
params) (forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view forall ctx a ctx' b. Lens (Message ctx a) (Message ctx' b) a b
body ByteEntity
ent)
      else
        forall s (m :: * -> *) a.
MonadReader s m =>
Getting (First a) s a -> m (Maybe a)
preview (CI ByteString -> Const (First (CI ByteString)) (CI ByteString))
-> Parameters -> Const (First (CI ByteString)) Parameters
l Parameters
params forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall a. a -> Maybe a
Just CI ByteString
"us-ascii"
  charsetData :: Getter ByteEntity ByteString
charsetData = forall ctx a ctx' b. Lens (Message ctx a) (Message ctx' b) a b
body
  charsetDecoded :: forall e.
AsCharsetError e =>
CharsetLookup
-> forall (p :: * -> * -> *) (f :: * -> *).
   (Profunctor p, Contravariant f) =>
   Optic' p f ByteEntity (Either e (Decoded ByteEntity))
charsetDecoded CharsetLookup
m = forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to forall a b. (a -> b) -> a -> b
$ \ByteEntity
a -> (\Text
t -> forall s t a b. ASetter s t a b -> b -> s -> t
set forall ctx a ctx' b. Lens (Message ctx a) (Message ctx' b) a b
body Text
t ByteEntity
a) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view (forall a e (p :: * -> * -> *) (f :: * -> *).
(HasCharset a, AsCharsetError e, Profunctor p, Contravariant f) =>
CharsetLookup -> Optic' p f a (Either e Text)
charsetText CharsetLookup
m) ByteEntity
a

  -- | Encode (@utf-8@) and add/set charset parameter.  If consisting
  -- entirely of ASCII characters, the @charset@ parameter gets set to
  -- @us-ascii@ instead of @utf-8@.
  --
  -- Ignores Content-Type (which is not correct for all content types).
  --
  charsetEncode :: Decoded ByteEntity -> ByteEntity
charsetEncode (Message Headers
h Text
a) =
    let
      b :: ByteString
b = Text -> ByteString
T.encodeUtf8 Text
a
      charset :: EncodedParameterValue
charset = if (Word8 -> Bool) -> ByteString -> Bool
B.all (forall a. Ord a => a -> a -> Bool
< Word8
0x80) ByteString
b then EncodedParameterValue
"us-ascii" else EncodedParameterValue
"utf-8"
    in forall s a. Headers -> a -> Message s a
Message (forall s t a b. ASetter s t a b -> b -> s -> t
set (forall a. HasHeaders a => Lens' a ContentType
contentType forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a.
HasParameters a =>
CI ByteString -> Lens' a (Maybe EncodedParameterValue)
parameter CI ByteString
"charset") (forall a. a -> Maybe a
Just EncodedParameterValue
charset) Headers
h) ByteString
b

-- | RFC 6657 provides for different media types having different
-- ways to determine the charset.  This data type defines how a
-- charset should be determined for some media type.
--
data EntityCharsetSource
  = InPayload (B.ByteString -> Maybe CharsetName)
  -- ^ Charset should be declared within payload (e.g. rtf).
  --   The given function reads the payload and returns the charset,
  --   or @Nothing@ if the charset cannot be determined or defaulted.
  | InParameter (Maybe CharsetName)
  -- ^ Charset may be declared in the @charset@ parameter,
  --   with optional fallback to the given default.
  | InPayloadOrParameter (Maybe CharsetName -> B.ByteString -> Maybe CharsetName)
  -- ^ Charset could be specified in payload or parameter.  The function
  -- parameter takes the value of the charset parameter (which may be @Nothing@
  -- and the payload, and returns the character set that should be used (or
  -- @Nothing@ if a character set cannot be determined or defaulted.

-- | Charset sources for text/* media types.  IANA registry:
-- https://www.iana.org/assignments/media-types/media-types.xhtml#text
--
textCharsetSources :: [(CI B.ByteString, EntityCharsetSource)]
textCharsetSources :: [(CI ByteString, EntityCharsetSource)]
textCharsetSources =
  [ (CI ByteString
"plain", Maybe (CI ByteString) -> EntityCharsetSource
InParameter (forall a. a -> Maybe a
Just CI ByteString
"us-ascii"))
  , (CI ByteString
"csv", Maybe (CI ByteString) -> EntityCharsetSource
InParameter (forall a. a -> Maybe a
Just CI ByteString
"utf-8"))
  , (CI ByteString
"rtf", (ByteString -> Maybe (CI ByteString)) -> EntityCharsetSource
InPayload (forall a b. a -> b -> a
const (forall a. a -> Maybe a
Just CI ByteString
"us-ascii")))

  -- https://tools.ietf.org/html/rfc2854
  -- The default is ambiguous; using us-ascii for now
  , (CI ByteString
"html", (Maybe (CI ByteString) -> ByteString -> Maybe (CI ByteString))
-> EntityCharsetSource
InPayloadOrParameter (\Maybe (CI ByteString)
_param ByteString
_payload -> forall a. a -> Maybe a
Just CI ByteString
"us-ascii")) -- FIXME

  -- https://tools.ietf.org/html/rfc7763
  , (CI ByteString
"markdown", Maybe (CI ByteString) -> EntityCharsetSource
InParameter forall a. Maybe a
Nothing)

  -- https://tools.ietf.org/html/rfc7303#section-3.2 and
  -- https://www.w3.org/TR/2008/REC-xml-20081126/#charencoding
  , (CI ByteString
"xml", (Maybe (CI ByteString) -> ByteString -> Maybe (CI ByteString))
-> EntityCharsetSource
InPayloadOrParameter (\Maybe (CI ByteString)
_param ByteString
_payload -> forall a. a -> Maybe a
Just CI ByteString
"utf-8")) -- FIXME

  -- https://tools.ietf.org/html/rfc1896.html
  , (CI ByteString
"enriched", Maybe (CI ByteString) -> EntityCharsetSource
InParameter (forall a. a -> Maybe a
Just CI ByteString
"us-ascii"))
  ]

-- | @text/plain; charset=us-ascii@
defaultContentType :: ContentType
defaultContentType :: ContentType
defaultContentType =
  forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over forall a. HasParameters a => Lens' a [(CI ByteString, ByteString)]
parameterList ((CI ByteString
"charset", ByteString
"us-ascii")forall a. a -> [a] -> [a]
:) ContentType
contentTypeTextPlain

-- | @text/plain@
contentTypeTextPlain :: ContentType
contentTypeTextPlain :: ContentType
contentTypeTextPlain = forall a. CI ByteString -> CI ByteString -> a -> ContentTypeWith a
ContentType CI ByteString
"text" CI ByteString
"plain" forall a. Monoid a => a
mempty

-- | @application/octet-stream@
contentTypeApplicationOctetStream :: ContentType
contentTypeApplicationOctetStream :: ContentType
contentTypeApplicationOctetStream =
  forall a. CI ByteString -> CI ByteString -> a -> ContentTypeWith a
ContentType CI ByteString
"application" CI ByteString
"octet-stream" forall a. Monoid a => a
mempty

-- | @multipart/...; boundary=asdf@
contentTypeMultipart :: MultipartSubtype -> Boundary -> ContentType
contentTypeMultipart :: MultipartSubtype -> Boundary -> ContentType
contentTypeMultipart MultipartSubtype
subtype Boundary
boundary =
  forall a. CI ByteString -> CI ByteString -> a -> ContentTypeWith a
ContentType CI ByteString
"multipart" CI ByteString
sub forall a. Monoid a => a
mempty
    forall a b. a -> (a -> b) -> b
& forall {t}.
HasParameters t =>
CI ByteString -> ByteString -> t -> t
setParam CI ByteString
"boundary" (Boundary -> ByteString
unBoundary Boundary
boundary)
    forall a b. a -> (a -> b) -> b
& ContentType -> ContentType
appendParams
  where
    setParam :: CI ByteString -> ByteString -> t -> t
setParam CI ByteString
k ByteString
v = forall s t a b. ASetter s t a b -> b -> s -> t
set (forall a.
HasParameters a =>
CI ByteString -> Lens' a (Maybe EncodedParameterValue)
parameter CI ByteString
k) (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall cs a.
Maybe cs -> Maybe (CI ByteString) -> a -> ParameterValue cs a
ParameterValue forall a. Maybe a
Nothing forall a. Maybe a
Nothing ByteString
v)
    (CI ByteString
sub, ContentType -> ContentType
appendParams) = case MultipartSubtype
subtype of
      MultipartSubtype
Mixed -> (CI ByteString
"mixed", forall a. a -> a
id)
      MultipartSubtype
Alternative -> (CI ByteString
"alternative", forall a. a -> a
id)
      MultipartSubtype
Digest -> (CI ByteString
"digest", forall a. a -> a
id)
      MultipartSubtype
Parallel -> (CI ByteString
"parallel", forall a. a -> a
id)
      MultipartSubtype
Multilingual -> (CI ByteString
"multilingual", forall a. a -> a
id)
      Report ByteString
typ -> (CI ByteString
"report", forall {t}.
HasParameters t =>
CI ByteString -> ByteString -> t -> t
setParam CI ByteString
"report-type" ByteString
typ)
      Signed ByteString
proto ByteString
micalg -> (CI ByteString
"signed", forall {t}.
HasParameters t =>
CI ByteString -> ByteString -> t -> t
setParam CI ByteString
"protocol" ByteString
proto forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {t}.
HasParameters t =>
CI ByteString -> ByteString -> t -> t
setParam CI ByteString
"micalg" ByteString
micalg)
      Encrypted ByteString
proto -> (CI ByteString
"encrypted", forall {t}.
HasParameters t =>
CI ByteString -> ByteString -> t -> t
setParam CI ByteString
"protocol" ByteString
proto)
      Related Maybe (ContentTypeWith ())
typ Maybe ContentID
start Maybe ByteString
startInfo ->
        ( CI ByteString
"related"
        , forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. a -> a
id (forall {t}.
HasParameters t =>
CI ByteString -> ByteString -> t -> t
setParam CI ByteString
"start" forall b c a. (b -> c) -> (a -> b) -> a -> c
. ContentID -> ByteString
renderContentID) Maybe ContentID
start
          forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. a -> a
id (forall {t}.
HasParameters t =>
CI ByteString -> ByteString -> t -> t
setParam CI ByteString
"start-info") Maybe ByteString
startInfo
          forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. a -> a
id (forall {t}.
HasParameters t =>
CI ByteString -> ByteString -> t -> t
setParam CI ByteString
"type" forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> ByteString) -> ContentTypeWith a -> ByteString
renderContentTypeWith (\() -> ByteString
"")) Maybe (ContentTypeWith ())
typ
        )
      Unrecognised CI ByteString
sub' -> (CI ByteString
sub', forall a. a -> a
id)

-- | @multipart/mixed; boundary=asdf@
contentTypeMultipartMixed :: Boundary -> ContentType
contentTypeMultipartMixed :: Boundary -> ContentType
contentTypeMultipartMixed = MultipartSubtype -> Boundary -> ContentType
contentTypeMultipart MultipartSubtype
Mixed

-- | Lens to the content-type header.  Probably not a lawful lens.
--
-- If the header is not specified or is syntactically invalid,
-- 'defaultContentType' is used.  For more info see
-- <https://tools.ietf.org/html/rfc2045#section-5.2>.
--
-- If the Content-Transfer-Encoding is unrecognised, the
-- actual Content-Type value is ignored and
-- @application/octet-stream@ is returned, as required by
-- <https://tools.ietf.org/html/rfc2049#section-2>.
--
-- When setting, if the header already exists it is replaced,
-- otherwise it is added.  Unrecognised Content-Transfer-Encoding
-- is ignored when setting.
--
-- __Note__: when dealing with 'Multipart' or 'Encapsulated'
-- messages, the @Content-Type@ header will be overridden when
-- serialising the message.  This avoids scenarios where the
-- @Content-Type@ does not match the structure of the message.  In
-- general, the @Content-Type@ header should be treated as "read
-- only" for multipart or encapsulated message.
--
contentType :: HasHeaders a => Lens' a ContentType
contentType :: forall a. HasHeaders a => Lens' a ContentType
contentType = forall a. HasHeaders a => Lens' a Headers
headers forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens Headers -> ContentType
sa forall {t}.
(IxValue t ~ ByteString, At t, IsString (Index t)) =>
t -> ContentType -> t
sbt where
  sa :: Headers -> ContentType
sa Headers
s = case forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view (Maybe TransferEncoding
 -> Const (Maybe TransferEncoding) (Maybe TransferEncoding))
-> Headers -> Const (Maybe TransferEncoding) Headers
cte Headers
s of
    Maybe TransferEncoding
Nothing -> ContentType
contentTypeApplicationOctetStream
    Just TransferEncoding
_ ->
      forall a. a -> Maybe a -> a
fromMaybe ContentType
defaultContentType
      forall a b. (a -> b) -> a -> b
$ forall s (m :: * -> *) a.
MonadReader s m =>
Getting (First a) s a -> m (Maybe a)
preview ((ByteString -> Const (First ContentType) ByteString)
-> Headers -> Const (First ContentType) Headers
ct forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. Cons s s Word8 Word8 => Parser a -> Fold s a
parsed (Parser ByteString ContentType
parseContentType forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall t. Chunk t => Parser t ()
endOfInput)) Headers
s

  sbt :: t -> ContentType -> t
sbt t
s ContentType
b = forall s t a b. ASetter s t a b -> b -> s -> t
set (forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Index t
"Content-Type") (forall a. a -> Maybe a
Just (ContentType -> ByteString
renderContentType ContentType
b)) t
s

  ct :: (ByteString -> Const (First ContentType) ByteString)
-> Headers -> Const (First ContentType) Headers
ct = forall a. HasHeaders a => CI ByteString -> Traversal' a ByteString
header CI ByteString
"content-type"
  cte :: (Maybe TransferEncoding
 -> Const (Maybe TransferEncoding) (Maybe TransferEncoding))
-> Headers -> Const (Maybe TransferEncoding) Headers
cte = forall (p :: * -> * -> *) (f :: * -> *).
(Profunctor p, Contravariant f) =>
Optic' p f Headers (CI ByteString)
contentTransferEncoding forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to (forall a b. Eq a => a -> [(a, b)] -> Maybe b
`lookup` [(CI ByteString, TransferEncoding)]
transferEncodings)

-- | Content-Disposition header (RFC 2183).
--
-- Use 'parameters' to access the parameters.
--
data ContentDisposition = ContentDisposition
  DispositionType   -- disposition
  Parameters        -- parameters
  deriving (Int -> ContentDisposition -> ShowS
[ContentDisposition] -> ShowS
ContentDisposition -> FilePath
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [ContentDisposition] -> ShowS
$cshowList :: [ContentDisposition] -> ShowS
show :: ContentDisposition -> FilePath
$cshow :: ContentDisposition -> FilePath
showsPrec :: Int -> ContentDisposition -> ShowS
$cshowsPrec :: Int -> ContentDisposition -> ShowS
Show, forall x. Rep ContentDisposition x -> ContentDisposition
forall x. ContentDisposition -> Rep ContentDisposition x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ContentDisposition x -> ContentDisposition
$cfrom :: forall x. ContentDisposition -> Rep ContentDisposition x
Generic, ContentDisposition -> ()
forall a. (a -> ()) -> NFData a
rnf :: ContentDisposition -> ()
$crnf :: ContentDisposition -> ()
NFData)

data DispositionType = Inline | Attachment
  deriving (DispositionType -> DispositionType -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DispositionType -> DispositionType -> Bool
$c/= :: DispositionType -> DispositionType -> Bool
== :: DispositionType -> DispositionType -> Bool
$c== :: DispositionType -> DispositionType -> Bool
Eq, Int -> DispositionType -> ShowS
[DispositionType] -> ShowS
DispositionType -> FilePath
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [DispositionType] -> ShowS
$cshowList :: [DispositionType] -> ShowS
show :: DispositionType -> FilePath
$cshow :: DispositionType -> FilePath
showsPrec :: Int -> DispositionType -> ShowS
$cshowsPrec :: Int -> DispositionType -> ShowS
Show, forall x. Rep DispositionType x -> DispositionType
forall x. DispositionType -> Rep DispositionType x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DispositionType x -> DispositionType
$cfrom :: forall x. DispositionType -> Rep DispositionType x
Generic, DispositionType -> ()
forall a. (a -> ()) -> NFData a
rnf :: DispositionType -> ()
$crnf :: DispositionType -> ()
NFData)

dispositionType :: Lens' ContentDisposition DispositionType
dispositionType :: Lens' ContentDisposition DispositionType
dispositionType DispositionType -> f DispositionType
f (ContentDisposition DispositionType
a Parameters
b) =
  forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\DispositionType
a' -> DispositionType -> Parameters -> ContentDisposition
ContentDisposition DispositionType
a' Parameters
b) (DispositionType -> f DispositionType
f DispositionType
a)
{-# ANN dispositionType ("HLint: ignore Avoid lambda using `infix`" :: String) #-}

dispositionParameters :: Lens' ContentDisposition Parameters
dispositionParameters :: Lens' ContentDisposition Parameters
dispositionParameters Parameters -> f Parameters
f (ContentDisposition DispositionType
a Parameters
b) =
  forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Parameters
b' -> DispositionType -> Parameters -> ContentDisposition
ContentDisposition DispositionType
a Parameters
b') (Parameters -> f Parameters
f Parameters
b)
{-# ANN dispositionParameters ("HLint: ignore Avoid lambda" :: String) #-}

instance HasParameters ContentDisposition where
  parameters :: Lens' ContentDisposition Parameters
parameters = Lens' ContentDisposition Parameters
dispositionParameters

-- | Parser for Content-Disposition header
--
-- Unrecognised disposition types are coerced to @Attachment@
-- in accordance with RFC 2183 §2.8 which states: /Unrecognized disposition
-- types should be treated as /attachment//.
parseContentDisposition :: Parser ContentDisposition
parseContentDisposition :: Parser ContentDisposition
parseContentDisposition = DispositionType -> Parameters -> ContentDisposition
ContentDisposition
  forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall {a}. (Eq a, IsString a) => a -> DispositionType
mapDispType forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s. FoldCase s => Parser s -> Parser (CI s)
ci Parser ByteString
token)
  forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ([(CI ByteString, ByteString)] -> Parameters
Parameters forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser [(CI ByteString, ByteString)]
parseParameters)
  where
    mapDispType :: a -> DispositionType
mapDispType a
s
      | a
s forall a. Eq a => a -> a -> Bool
== a
"inline" = DispositionType
Inline
      | Bool
otherwise = DispositionType
Attachment

-- | Render the Content-Disposition value, including parameters.
renderContentDisposition :: ContentDisposition -> B.ByteString
renderContentDisposition :: ContentDisposition -> ByteString
renderContentDisposition (ContentDisposition DispositionType
typ Parameters
params) =
  ByteString
typStr forall a. Semigroup a => a -> a -> a
<> Parameters -> ByteString
printParameters Parameters
params
  where
    typStr :: ByteString
typStr = case DispositionType
typ of DispositionType
Inline -> ByteString
"inline" ; DispositionType
Attachment -> ByteString
"attachment"

-- | Access @Content-Disposition@ header.
--
-- Unrecognised disposition types are coerced to @Attachment@
-- in accordance with RFC 2183 §2.8 which states:
-- /Unrecognized disposition types should be treated as attachment/.
--
-- This optic does not distinguish between missing header or malformed
-- value.
--
contentDisposition :: HasHeaders a => Lens' a (Maybe ContentDisposition)
contentDisposition :: forall a. HasHeaders a => Lens' a (Maybe ContentDisposition)
contentDisposition = forall a. HasHeaders a => Lens' a Headers
headers forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at CI ByteString
"Content-Disposition" forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (p :: * -> * -> *) a b c d.
Profunctor p =>
(a -> b) -> (c -> d) -> p b c -> p a d
dimap
  (forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall a b. a -> b -> a
const forall a. Maybe a
Nothing) forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a.
Cons s s Word8 Word8 =>
Parser a -> s -> Either FilePath a
Data.IMF.parse (Parser ContentDisposition
parseContentDisposition forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall t. Chunk t => Parser t ()
endOfInput))
  (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a -> b) -> a -> b
$ ContentDisposition -> ByteString
renderContentDisposition)

-- | Traverse the value of the filename parameter (if present).
--
filename :: HasParameters a => CharsetLookup -> Traversal' a T.Text
filename :: forall a. HasParameters a => CharsetLookup -> Traversal' a Text
filename CharsetLookup
m = forall a. HasParameters a => Lens' a (Maybe EncodedParameterValue)
filenameParameter forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b.
Traversable f =>
IndexedTraversal Int (f a) (f b) a b
traversed forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. HasCharset a => CharsetLookup -> Prism' a (Decoded a)
charsetPrism CharsetLookup
m forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall cs a b. Lens (ParameterValue cs a) (ParameterValue cs b) a b
value

-- | Access the filename parameter as a @Maybe ('ParameterValue' B.ByteString)@.
--
-- This can be used to read or set the filename parameter (see also
-- the 'newParameter' convenience function):
--
-- @
-- λ> let hdrs = Headers [("Content-Disposition", "attachment")]
-- λ> set ('contentDisposition' . 'filenameParameter') (Just ('newParameter' "foo.txt")) hdrs
-- Headers [("Content-Disposition","attachment; filename=foo.txt")]
-- @
filenameParameter :: HasParameters a => Lens' a (Maybe EncodedParameterValue)
filenameParameter :: forall a. HasParameters a => Lens' a (Maybe EncodedParameterValue)
filenameParameter = forall a.
HasParameters a =>
CI ByteString -> Lens' a (Maybe EncodedParameterValue)
parameter CI ByteString
"filename"


-- | The @Content-ID@ value may be used for uniquely identifying
-- MIME entities in several contexts, particularly for caching data
-- referenced by the @message/external-body@ mechanism.  Although
-- the @Content-ID@ header is generally optional, its use is
-- MANDATORY in implementations which generate data of the optional
-- MIME media type @message/external-body@.  That is, each
-- @message/external-body@ entity must have a @Content-ID@ field to
-- permit caching of such data.
--
newtype ContentID = ContentID MessageID
  deriving (ContentID -> ContentID -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ContentID -> ContentID -> Bool
$c/= :: ContentID -> ContentID -> Bool
== :: ContentID -> ContentID -> Bool
$c== :: ContentID -> ContentID -> Bool
Eq)

instance Show ContentID where
  show :: ContentID -> FilePath
show = ByteString -> FilePath
C8.unpack forall b c a. (b -> c) -> (a -> b) -> a -> c
. ContentID -> ByteString
renderContentID

parseContentID :: Parser ContentID
parseContentID :: Parser ContentID
parseContentID = MessageID -> ContentID
ContentID forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser MessageID
parseMessageID

buildContentID :: ContentID -> Builder.Builder
buildContentID :: ContentID -> Builder
buildContentID (ContentID MessageID
mid) = MessageID -> Builder
buildMessageID MessageID
mid

renderContentID :: ContentID -> B.ByteString
renderContentID :: ContentID -> ByteString
renderContentID = ByteString -> ByteString
L.toStrict forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> ByteString
Builder.toLazyByteString forall b c a. (b -> c) -> (a -> b) -> a -> c
. ContentID -> Builder
buildContentID

makeContentID :: B.ByteString -> Either B.ByteString ContentID
makeContentID :: ByteString -> Either ByteString ContentID
makeContentID ByteString
s =
  forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left ByteString
s) forall a b. b -> Either a b
Right
  forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Parser a -> ByteString -> Either FilePath a
parseOnly (Parser ContentID
parseContentID forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall t. Chunk t => Parser t ()
endOfInput)
  forall a b. (a -> b) -> a -> b
$ ByteString
s

headerContentID :: (HasHeaders a) => Lens' a (Maybe ContentID)
headerContentID :: forall a. HasHeaders a => Lens' a (Maybe ContentID)
headerContentID = forall a. HasHeaders a => Lens' a Headers
headers forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at CI ByteString
"Content-ID" forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso (forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ByteString -> Maybe ContentID
f) (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ContentID -> ByteString
g)
  where
  f :: ByteString -> Maybe ContentID
f = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall a b. a -> b -> a
const forall a. Maybe a
Nothing) forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Parser a -> ByteString -> Either FilePath a
parseOnly (Parser ContentID
parseContentID forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall t. Chunk t => Parser t ()
endOfInput)
  g :: ContentID -> ByteString
g = ContentID -> ByteString
renderContentID


-- | Traversal of @boundary@ parameter (which may be unspecified)
mimeBoundary :: Traversal' ContentType B.ByteString
mimeBoundary :: Traversal' ContentType ByteString
mimeBoundary = forall a. HasParameters a => Lens' a Parameters
parameters forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a.
HasParameters a =>
CI ByteString -> Traversal' a ByteString
rawParameter CI ByteString
"boundary"

-- | Top-level MIME body parser that uses headers to decide how to
--   parse the body.
--
-- __Do not use this parser for parsing a nested message.__
-- This parser should only be used when the message you want to
-- parse is the /whole input/.  If you use it to parse a nested
-- message it will treat the remainder of the outer message(s)
-- as part of the epilogue.
--
-- Preambles and epilogues are discarded.
--
-- This parser accepts non-MIME messages, and
-- treats them as a single part.
--
mime :: Headers -> BodyHandler MIME
mime :: Headers -> BodyHandler MIME
mime Headers
h
  | forall s a. Getting All s a -> s -> Bool
nullOf (forall a. HasHeaders a => CI ByteString -> Traversal' a ByteString
header CI ByteString
"MIME-Version") Headers
h = forall a. Parser a -> BodyHandler a
RequiredBody (ByteString -> MIME
Part forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString
takeByteString)
  | Bool
otherwise = Parser ByteString -> Headers -> BodyHandler MIME
mime' Parser ByteString
takeByteString Headers
h

type instance MessageContext MIME = EncStateWire

mime'
  :: Parser B.ByteString
  -- ^ Parser FOR A TAKE to the part delimiter.  If this part is
  -- multipart, we pass it on to the 'multipart' parser.  If this
  -- part is not multipart, we just do the take.
  -> Headers
  -> BodyHandler MIME
mime' :: Parser ByteString -> Headers -> BodyHandler MIME
mime' Parser ByteString
takeTillEnd Headers
h = forall a. Parser a -> BodyHandler a
RequiredBody forall a b. (a -> b) -> a -> b
$ case forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view forall a. HasHeaders a => Lens' a ContentType
contentType Headers
h of
  ContentType
ct | forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view forall a. Lens' (ContentTypeWith a) (CI ByteString)
ctType ContentType
ct forall a. Eq a => a -> a -> Bool
== CI ByteString
"multipart" ->
        case forall {a}.
HasParameters (ContentTypeWith a) =>
ContentTypeWith a
-> Either MIMEParseError (MultipartSubtype, Boundary)
prepMultipart ContentType
ct of
          Left MIMEParseError
err              -> MIMEParseError -> ByteString -> MIME
FailedParse MIMEParseError
err forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString
takeTillEnd
          Right (MultipartSubtype
sub, Boundary
boundary) ->
            MultipartSubtype -> Boundary -> NonEmpty MIMEMessage -> MIME
Multipart MultipartSubtype
sub Boundary
boundary forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString -> Boundary -> Parser (NonEmpty MIMEMessage)
multipart Parser ByteString
takeTillEnd Boundary
boundary
            forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> MIMEParseError -> ByteString -> MIME
FailedParse MIMEParseError
MultipartParseFail forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString
takeTillEnd
     | forall a.
CI ByteString -> Maybe (CI ByteString) -> ContentTypeWith a -> Bool
matchContentType CI ByteString
"message" (forall a. a -> Maybe a
Just CI ByteString
"rfc822") ContentType
ct ->
        (MIMEMessage -> MIME
Encapsulated forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a.
(Headers -> BodyHandler a) -> Parser (Message (MessageContext a) a)
message (Parser ByteString -> Headers -> BodyHandler MIME
mime' Parser ByteString
takeTillEnd))
        forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (MIMEParseError -> ByteString -> MIME
FailedParse MIMEParseError
EncapsulatedMessageParseFail forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString
takeTillEnd)
  ContentType
_ -> ByteString -> MIME
Part forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString
takeTillEnd
  where
    prepMultipart :: ContentTypeWith a
-> Either MIMEParseError (MultipartSubtype, Boundary)
prepMultipart ContentTypeWith a
ct =
      (,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall {a}.
HasParameters (ContentTypeWith a) =>
ContentTypeWith a -> Either MIMEParseError MultipartSubtype
parseSubtype ContentTypeWith a
ct forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall {s}. HasParameters s => s -> Either MIMEParseError Boundary
parseBoundary ContentTypeWith a
ct
    parseBoundary :: s -> Either MIMEParseError Boundary
parseBoundary s
ct =
      forall {s}.
HasParameters s =>
CI ByteString -> s -> Either MIMEParseError ByteString
getRequiredParam CI ByteString
"boundary" s
ct
      forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over forall a c b. Prism (Either a c) (Either b c) a b
_Left (CI ByteString -> ByteString -> MIMEParseError
InvalidParameterValue CI ByteString
"boundary") forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Either ByteString Boundary
makeBoundary
    getRequiredParam :: CI ByteString -> s -> Either MIMEParseError ByteString
getRequiredParam CI ByteString
k =
      forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ CI ByteString -> MIMEParseError
RequiredParameterMissing CI ByteString
k) forall a b. b -> Either a b
Right forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s (m :: * -> *) a.
MonadReader s m =>
Getting (First a) s a -> m (Maybe a)
preview (forall a.
HasParameters a =>
CI ByteString -> Traversal' a ByteString
rawParameter CI ByteString
k)
    getOptionalParam :: CI ByteString -> s -> Either a (Maybe ByteString)
getOptionalParam CI ByteString
k =
      forall a b. b -> Either a b
Right forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s (m :: * -> *) a.
MonadReader s m =>
Getting (First a) s a -> m (Maybe a)
preview (forall a.
HasParameters a =>
CI ByteString -> Traversal' a ByteString
rawParameter CI ByteString
k)
    getOptionalParamParsed :: CI ByteString
-> Parser ByteString a -> s -> Either MIMEParseError (Maybe a)
getOptionalParamParsed CI ByteString
k Parser ByteString a
parser s
ct =
      case forall s (m :: * -> *) a.
MonadReader s m =>
Getting (First a) s a -> m (Maybe a)
preview (forall a.
HasParameters a =>
CI ByteString -> Traversal' a ByteString
rawParameter CI ByteString
k) s
ct of
        Maybe ByteString
Nothing -> forall a b. b -> Either a b
Right forall a. Maybe a
Nothing
        Just ByteString
s  -> case forall s a.
Cons s s Word8 Word8 =>
Parser a -> s -> Either FilePath a
Data.IMF.parse (Parser ByteString a
parser forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall t. Chunk t => Parser t ()
endOfInput) ByteString
s of
          Left FilePath
_  -> forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ CI ByteString -> ByteString -> MIMEParseError
InvalidParameterValue CI ByteString
k ByteString
s
          Right a
a -> forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just a
a
    parseSubtype :: ContentTypeWith a -> Either MIMEParseError MultipartSubtype
parseSubtype ContentTypeWith a
ct = case forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view forall a. Lens' (ContentTypeWith a) (CI ByteString)
ctSubtype ContentTypeWith a
ct of
      CI ByteString
"mixed"         -> forall (f :: * -> *) a. Applicative f => a -> f a
pure MultipartSubtype
Mixed
      CI ByteString
"alternative"   -> forall (f :: * -> *) a. Applicative f => a -> f a
pure MultipartSubtype
Alternative
      CI ByteString
"digest"        -> forall (f :: * -> *) a. Applicative f => a -> f a
pure MultipartSubtype
Digest
      CI ByteString
"parallel"      -> forall (f :: * -> *) a. Applicative f => a -> f a
pure MultipartSubtype
Parallel
      CI ByteString
"multilingual"  -> forall (f :: * -> *) a. Applicative f => a -> f a
pure MultipartSubtype
Multilingual
      CI ByteString
"report"        -> ByteString -> MultipartSubtype
Report forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall {s}.
HasParameters s =>
CI ByteString -> s -> Either MIMEParseError ByteString
getRequiredParam CI ByteString
"report-type" ContentTypeWith a
ct
      CI ByteString
"signed"        -> ByteString -> ByteString -> MultipartSubtype
Signed
                          forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall {s}.
HasParameters s =>
CI ByteString -> s -> Either MIMEParseError ByteString
getRequiredParam CI ByteString
"protocol" ContentTypeWith a
ct
                          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall {s}.
HasParameters s =>
CI ByteString -> s -> Either MIMEParseError ByteString
getRequiredParam CI ByteString
"micalg" ContentTypeWith a
ct
      CI ByteString
"encrypted"     -> ByteString -> MultipartSubtype
Encrypted forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall {s}.
HasParameters s =>
CI ByteString -> s -> Either MIMEParseError ByteString
getRequiredParam CI ByteString
"protocol" ContentTypeWith a
ct
      CI ByteString
"related"       -> Maybe (ContentTypeWith ())
-> Maybe ContentID -> Maybe ByteString -> MultipartSubtype
Related
                          forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall {s} {a}.
HasParameters s =>
CI ByteString
-> Parser ByteString a -> s -> Either MIMEParseError (Maybe a)
getOptionalParamParsed CI ByteString
"type"
                                (forall a.
(CI ByteString -> CI ByteString -> Parser a)
-> Parser (ContentTypeWith a)
parseContentTypeWith (\CI ByteString
_ CI ByteString
_ -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ())) ContentTypeWith a
ct
                          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall {s} {a}.
HasParameters s =>
CI ByteString
-> Parser ByteString a -> s -> Either MIMEParseError (Maybe a)
getOptionalParamParsed CI ByteString
"start" Parser ContentID
parseContentID ContentTypeWith a
ct
                          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall {s} {a}.
HasParameters s =>
CI ByteString -> s -> Either a (Maybe ByteString)
getOptionalParam CI ByteString
"start-info" ContentTypeWith a
ct
      CI ByteString
unrecognised    -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ CI ByteString -> MultipartSubtype
Unrecognised CI ByteString
unrecognised

data MIMEParseError
  = RequiredParameterMissing (CI B.ByteString)
  | InvalidParameterValue (CI B.ByteString) B.ByteString
  | MultipartParseFail
  | EncapsulatedMessageParseFail
  deriving (MIMEParseError -> MIMEParseError -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MIMEParseError -> MIMEParseError -> Bool
$c/= :: MIMEParseError -> MIMEParseError -> Bool
== :: MIMEParseError -> MIMEParseError -> Bool
$c== :: MIMEParseError -> MIMEParseError -> Bool
Eq, Int -> MIMEParseError -> ShowS
[MIMEParseError] -> ShowS
MIMEParseError -> FilePath
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [MIMEParseError] -> ShowS
$cshowList :: [MIMEParseError] -> ShowS
show :: MIMEParseError -> FilePath
$cshow :: MIMEParseError -> FilePath
showsPrec :: Int -> MIMEParseError -> ShowS
$cshowsPrec :: Int -> MIMEParseError -> ShowS
Show)

-- | Parse a multipart MIME message.  Preambles and epilogues are
-- discarded.
--
multipart
  :: Parser B.ByteString  -- ^ parser to the end of the part
  -> Boundary             -- ^ boundary, sans leading "--"
  -> Parser (NonEmpty MIMEMessage)
multipart :: Parser ByteString -> Boundary -> Parser (NonEmpty MIMEMessage)
multipart Parser ByteString
takeTillEnd Boundary
boundary =
  ByteString -> Parser ByteString ()
skipTillString ByteString
dashBoundary forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall (f :: * -> * -> *) s a.
(Alternative (f s), CharParsing f s a) =>
f s ()
crlf -- FIXME transport-padding
  forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. [a] -> NonEmpty a
fromList (Parser (Message (MessageContext MIME) MIME)
part forall (f :: * -> *) a s. Alternative f => f a -> f s -> f [a]
`sepBy1` forall (f :: * -> * -> *) s a.
(Alternative (f s), CharParsing f s a) =>
f s ()
crlf)
  forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ByteString -> Parser ByteString
string ByteString
"--" forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ByteString
takeTillEnd
  where
    delimiter :: ByteString
delimiter = ByteString
"\n--" forall a. Semigroup a => a -> a -> a
<> Boundary -> ByteString
unBoundary Boundary
boundary
    dashBoundary :: ByteString
dashBoundary = HasCallStack => ByteString -> ByteString
B.tail ByteString
delimiter
    part :: Parser (Message (MessageContext MIME) MIME)
part = forall a.
(Headers -> BodyHandler a) -> Parser (Message (MessageContext a) a)
message (Parser ByteString -> Headers -> BodyHandler MIME
mime' (ByteString -> ByteString
trim forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ByteString -> Parser ByteString
takeTillString ByteString
delimiter))
    trim :: ByteString -> ByteString
trim ByteString
s  -- trim trailing CR, because we only searched for LF
      | ByteString -> Bool
B.null ByteString
s = ByteString
s
      | ByteString -> Char
C8.last ByteString
s forall a. Eq a => a -> a -> Bool
== Char
'\r' = HasCallStack => ByteString -> ByteString
B.init ByteString
s
      | Bool
otherwise = ByteString
s

-- | Sets the @MIME-Version: 1.0@ header.
--
instance RenderMessage MIME where
  tweakHeaders :: MIME -> Headers -> Headers
tweakHeaders MIME
b Headers
h =
    Headers
h
    forall a b. a -> (a -> b) -> b
& forall s t a b. ASetter s t a b -> b -> s -> t
set (forall a. HasHeaders a => Lens' a Headers
headers forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at CI ByteString
"MIME-Version") (forall a. a -> Maybe a
Just ByteString
"1.0")
    forall a b. a -> (a -> b) -> b
& Headers -> Headers
setContentType
    where
      setContentType :: Headers -> Headers
setContentType = case MIME
b of
        Multipart MultipartSubtype
sub Boundary
boundary NonEmpty MIMEMessage
_  -> forall s t a b. ASetter s t a b -> b -> s -> t
set forall a. HasHeaders a => Lens' a ContentType
contentType (MultipartSubtype -> Boundary -> ContentType
contentTypeMultipart MultipartSubtype
sub Boundary
boundary)
        Encapsulated MIMEMessage
_msg         -> forall s t a b. ASetter s t a b -> b -> s -> t
set forall a. HasHeaders a => Lens' a ContentType
contentType ContentType
"message/rfc822"
        MIME
_                         -> forall a. a -> a
id
  buildBody :: Headers -> MIME -> Maybe Builder
buildBody Headers
_h MIME
z = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ case MIME
z of
    Part ByteString
partbody -> ByteString -> Builder
Builder.byteString ByteString
partbody
    Encapsulated MIMEMessage
msg -> forall ctx a. RenderMessage a => Message ctx a -> Builder
buildMessage MIMEMessage
msg
    Multipart MultipartSubtype
_sub Boundary
b NonEmpty MIMEMessage
xs ->
      let
        boundary :: Builder
boundary = Builder
"--" forall a. Semigroup a => a -> a -> a
<> ByteString -> Builder
Builder.byteString (Boundary -> ByteString
unBoundary Boundary
b)
      in
        Builder
boundary forall a. Semigroup a => a -> a -> a
<> Builder
"\r\n"
        forall a. Semigroup a => a -> a -> a
<> forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold (forall a. a -> NonEmpty a -> NonEmpty a
intersperse (Builder
"\r\n" forall a. Semigroup a => a -> a -> a
<> Builder
boundary forall a. Semigroup a => a -> a -> a
<> Builder
"\r\n") (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall ctx a. RenderMessage a => Message ctx a -> Builder
buildMessage NonEmpty MIMEMessage
xs))
        forall a. Semigroup a => a -> a -> a
<> Builder
"\r\n" forall a. Semigroup a => a -> a -> a
<> Builder
boundary forall a. Semigroup a => a -> a -> a
<> Builder
"--\r\n"
    FailedParse MIMEParseError
_ ByteString
bs -> ByteString -> Builder
Builder.byteString ByteString
bs

-- | Create a mixed `MIMEMessage` with an inline text/plain part and multiple
-- `attachments`
--
createMultipartMixedMessage
    :: Boundary
    -> NonEmpty MIMEMessage -- ^ parts
    -> MIMEMessage
createMultipartMixedMessage :: Boundary -> NonEmpty MIMEMessage -> MIMEMessage
createMultipartMixedMessage Boundary
b NonEmpty MIMEMessage
attachments' =
  let hdrs :: Headers
hdrs = [(CI ByteString, ByteString)] -> Headers
Headers [] forall a b. a -> (a -> b) -> b
& forall s t a b. ASetter s t a b -> b -> s -> t
set forall a. HasHeaders a => Lens' a ContentType
contentType (Boundary -> ContentType
contentTypeMultipartMixed Boundary
b)
  in forall s a. Headers -> a -> Message s a
Message Headers
hdrs (MultipartSubtype -> Boundary -> NonEmpty MIMEMessage -> MIME
Multipart MultipartSubtype
Mixed Boundary
b NonEmpty MIMEMessage
attachments')

-- | Create an inline, text/plain, utf-8 encoded message
--
createTextPlainMessage :: T.Text -> MIMEMessage
createTextPlainMessage :: Text -> MIMEMessage
createTextPlainMessage Text
s = forall ctx a. Text -> Message ctx a -> MIMEMessage
setTextPlainBody Text
s (forall s a. Headers -> a -> Message s a
Message ([(CI ByteString, ByteString)] -> Headers
Headers []) ())

-- | Set an inline, @text/plain@, utf-8 encoded message body
--
setTextPlainBody :: T.Text -> Message ctx a -> MIMEMessage
setTextPlainBody :: forall ctx a. Text -> Message ctx a -> MIMEMessage
setTextPlainBody Text
s =
  forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ByteString -> MIME
Part
  forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. HasTransferEncoding a => TransferDecoded a -> a
transferEncode
  forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. HasCharset a => Decoded a -> a
charsetEncode
  forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s t a b. ASetter s t a b -> b -> s -> t
set forall a. HasHeaders a => Lens' a (Maybe ContentDisposition)
contentDisposition (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ DispositionType -> Parameters -> ContentDisposition
ContentDisposition DispositionType
Inline forall a. Monoid a => a
mempty)
  forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s t a b. ASetter s t a b -> b -> s -> t
set forall a. HasHeaders a => Lens' a ContentType
contentType ContentType
contentTypeTextPlain
  forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s t a b. ASetter s t a b -> b -> s -> t
set forall ctx a ctx' b. Lens (Message ctx a) (Message ctx' b) a b
body Text
s

-- | Create an attachment from a given file path.
-- Note: The filename content disposition is set to the given `FilePath`. For
-- privacy reasons, you can unset/change it. See `filename` for examples.
--
createAttachmentFromFile :: ContentType -> FilePath -> IO MIMEMessage
createAttachmentFromFile :: ContentType -> FilePath -> IO MIMEMessage
createAttachmentFromFile ContentType
ct FilePath
fp = ContentType -> Maybe FilePath -> ByteString -> MIMEMessage
createAttachment ContentType
ct (forall a. a -> Maybe a
Just FilePath
fp) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> IO ByteString
B.readFile FilePath
fp

-- | Create an attachment from the given file contents. Optionally set the
-- filename parameter to the given file path.
--
createAttachment :: ContentType -> Maybe FilePath -> B.ByteString -> MIMEMessage
createAttachment :: ContentType -> Maybe FilePath -> ByteString -> MIMEMessage
createAttachment ContentType
ct Maybe FilePath
fp ByteString
s = ByteString -> MIME
Part forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. HasTransferEncoding a => TransferDecoded a -> a
transferEncode ByteEntity
msg
  where
  msg :: ByteEntity
msg = forall s a. Headers -> a -> Message s a
Message Headers
hdrs ByteString
s
  cd :: ContentDisposition
cd = DispositionType -> Parameters -> ContentDisposition
ContentDisposition DispositionType
Attachment Parameters
cdParams
  cdParams :: Parameters
cdParams = forall a. Monoid a => a
mempty forall a b. a -> (a -> b) -> b
& forall s t a b. ASetter s t a b -> b -> s -> t
set forall a. HasParameters a => Lens' a (Maybe EncodedParameterValue)
filenameParameter (forall s. Cons s s Char Char => s -> EncodedParameterValue
newParameter forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe FilePath
fp)
  hdrs :: Headers
hdrs = [(CI ByteString, ByteString)] -> Headers
Headers []
          forall a b. a -> (a -> b) -> b
& forall s t a b. ASetter s t a b -> b -> s -> t
set forall a. HasHeaders a => Lens' a ContentType
contentType ContentType
ct
          forall a b. a -> (a -> b) -> b
& forall s t a b. ASetter s t a b -> b -> s -> t
set forall a. HasHeaders a => Lens' a (Maybe ContentDisposition)
contentDisposition (forall a. a -> Maybe a
Just ContentDisposition
cd)

-- | Encapsulate a message as a @message/rfc822@ message.
-- You can use this in creating /forwarded/ or /bounce/ messages.
--
encapsulate :: MIMEMessage -> MIMEMessage
encapsulate :: MIMEMessage -> MIMEMessage
encapsulate = forall s a. Headers -> a -> Message s a
Message Headers
hdrs forall b c a. (b -> c) -> (a -> b) -> a -> c
. MIMEMessage -> MIME
Encapsulated
  where
  hdrs :: Headers
hdrs = [(CI ByteString, ByteString)] -> Headers
Headers [] forall a b. a -> (a -> b) -> b
& forall s t a b. ASetter s t a b -> b -> s -> t
set forall a. HasHeaders a => Lens' a ContentType
contentType ContentType
"message/rfc822"