{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE TypeFamilies #-}
module Data.MIME
(
MIME(..)
, mime
, MIMEMessage
, WireEntity
, ByteEntity
, TextEntity
, EncStateWire
, EncStateByte
, entities
, attachments
, isAttachment
, transferDecoded
, transferDecoded'
, charsetDecoded
, charsetDecoded'
, decodeEncodedWords
, contentType
, ContentTypeWith(..)
, ContentType
, ctType
, ctSubtype
, matchContentType
, parseContentType
, renderContentType
, showContentType
, MultipartSubtype(..)
, Boundary
, makeBoundary
, unBoundary
, mimeBoundary
, contentTypeTextPlain
, contentTypeApplicationOctetStream
, contentTypeMultipartMixed
, defaultContentType
, contentDisposition
, ContentDisposition(..)
, DispositionType(..)
, dispositionType
, filename
, filenameParameter
, renderContentDisposition
, ContentID
, makeContentID
, parseContentID
, buildContentID
, renderContentID
, headerContentID
, createTextPlainMessage
, createAttachment
, createAttachmentFromFile
, createMultipartMixedMessage
, setTextPlainBody
, encapsulate
, 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
data EncStateWire
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
| Alternative
| Digest
| Parallel
| Related
(Maybe (ContentTypeWith ()))
(Maybe ContentID)
(Maybe B.ByteString)
| Signed
B.ByteString
B.ByteString
| Encrypted
B.ByteString
| Report
B.ByteString
| Multilingual
| 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)
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)
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
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)
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
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 #-}
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
)
type ContentType = ContentTypeWith Parameters
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
matchContentType
:: CI B.ByteString
-> Maybe (CI B.ByteString)
-> 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) #-}
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
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
$
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 ) 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
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)
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
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
data EntityCharsetSource
= InPayload (B.ByteString -> Maybe CharsetName)
| InParameter (Maybe CharsetName)
| InPayloadOrParameter (Maybe CharsetName -> B.ByteString -> Maybe CharsetName)
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")))
, (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"))
, (CI ByteString
"markdown", Maybe (CI ByteString) -> EntityCharsetSource
InParameter forall a. Maybe a
Nothing)
, (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"))
, (CI ByteString
"enriched", Maybe (CI ByteString) -> EntityCharsetSource
InParameter (forall a. a -> Maybe a
Just CI ByteString
"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
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
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
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)
contentTypeMultipartMixed :: Boundary -> ContentType
contentTypeMultipartMixed :: Boundary -> ContentType
contentTypeMultipartMixed = MultipartSubtype -> Boundary -> ContentType
contentTypeMultipart MultipartSubtype
Mixed
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)
data ContentDisposition = ContentDisposition
DispositionType
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
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
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"
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)
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
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"
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)
= 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
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"
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
-> 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)
multipart
:: Parser B.ByteString
-> Boundary
-> 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
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
| 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
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
createMultipartMixedMessage
:: Boundary
-> NonEmpty MIMEMessage
-> 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')
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 []) ())
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
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
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 :: 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"