{-# 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
, ContentType(..)
, ctType
, ctSubtype
, matchContentType
, parseContentType
, renderContentType
, showContentType
, MultipartSubtype(..)
, Boundary
, makeBoundary
, unBoundary
, mimeBoundary
, contentTypeTextPlain
, contentTypeApplicationOctetStream
, contentTypeMultipartMixed
, defaultContentType
, contentDisposition
, ContentDisposition(..)
, DispositionType(..)
, dispositionType
, filename
, filenameParameter
, renderContentDisposition
, createTextPlainMessage
, createAttachment
, createAttachmentFromFile
, createMultipartMixedMessage
, setTextPlainBody
, encapsulate
, CharsetLookup
, defaultCharsets
, module Data.IMF
, module Data.MIME.Parameter
, module Data.MIME.Error
) where
import Control.Applicative
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.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
ContentType
(Maybe B.ByteString)
(Maybe B.ByteString)
| Signed B.ByteString B.ByteString
| Encrypted B.ByteString
| Report B.ByteString
| Multilingual
| Unrecognised (CI B.ByteString)
deriving (MultipartSubtype -> MultipartSubtype -> Bool
(MultipartSubtype -> MultipartSubtype -> Bool)
-> (MultipartSubtype -> MultipartSubtype -> Bool)
-> Eq MultipartSubtype
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 -> String
(Int -> MultipartSubtype -> ShowS)
-> (MultipartSubtype -> String)
-> ([MultipartSubtype] -> ShowS)
-> Show MultipartSubtype
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MultipartSubtype] -> ShowS
$cshowList :: [MultipartSubtype] -> ShowS
show :: MultipartSubtype -> String
$cshow :: MultipartSubtype -> String
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
(MIME -> MIME -> Bool) -> (MIME -> MIME -> Bool) -> Eq MIME
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 -> String
(Int -> MIME -> ShowS)
-> (MIME -> String) -> ([MIME] -> ShowS) -> Show MIME
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MIME] -> ShowS
$cshowList :: [MIME] -> ShowS
show :: MIME -> String
$cshow :: MIME -> String
showsPrec :: Int -> MIME -> ShowS
$cshowsPrec :: Int -> MIME -> ShowS
Show)
instance EqMessage MIME where
Message Headers
h1 MIME
b1 eqMessage :: Message s MIME -> Message s MIME -> Bool
`eqMessage` Message Headers
h2 MIME
b2 =
Headers -> Headers
stripVer Headers
h1 Headers -> Headers -> Bool
forall a. Eq a => a -> a -> Bool
== Headers -> Headers
stripVer Headers
h2 Bool -> Bool -> Bool
&& MIME
b1 MIME -> MIME -> Bool
forall a. Eq a => a -> a -> Bool
== MIME
b2
where
stripVer :: Headers -> Headers
stripVer = ASetter Headers Headers (Maybe ByteString) (Maybe ByteString)
-> Maybe ByteString -> Headers -> Headers
forall s t a b. ASetter s t a b -> b -> s -> t
set ((Headers -> Identity Headers) -> Headers -> Identity Headers
forall a. HasHeaders a => Lens' a Headers
headers ((Headers -> Identity Headers) -> Headers -> Identity Headers)
-> ASetter Headers Headers (Maybe ByteString) (Maybe ByteString)
-> ASetter Headers Headers (Maybe ByteString) (Maybe ByteString)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index Headers -> Lens' Headers (Maybe (IxValue Headers))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Index Headers
"MIME-Version") Maybe ByteString
forall a. Maybe a
Nothing
entities :: Traversal' MIMEMessage WireEntity
entities :: (WireEntity -> f WireEntity) -> MIMEMessage -> f MIMEMessage
entities WireEntity -> f WireEntity
f (Message Headers
h MIME
a) = case MIME
a of
Part ByteString
b ->
(\(Message Headers
h' ByteString
b') -> Headers -> MIME -> MIMEMessage
forall s a. Headers -> a -> Message s a
Message Headers
h' (ByteString -> MIME
Part ByteString
b')) (WireEntity -> MIMEMessage) -> f WireEntity -> f MIMEMessage
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> WireEntity -> f WireEntity
f (Headers -> ByteString -> WireEntity
forall s a. Headers -> a -> Message s a
Message Headers
h ByteString
b)
Encapsulated MIMEMessage
msg -> Headers -> MIME -> MIMEMessage
forall s a. Headers -> a -> Message s a
Message Headers
h (MIME -> MIMEMessage)
-> (MIMEMessage -> MIME) -> MIMEMessage -> MIMEMessage
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MIMEMessage -> MIME
Encapsulated (MIMEMessage -> MIMEMessage) -> f MIMEMessage -> f MIMEMessage
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (WireEntity -> f WireEntity) -> MIMEMessage -> f MIMEMessage
Traversal' MIMEMessage WireEntity
entities WireEntity -> f WireEntity
f MIMEMessage
msg
Multipart MultipartSubtype
sub Boundary
b NonEmpty MIMEMessage
bs ->
Headers -> MIME -> MIMEMessage
forall s a. Headers -> a -> Message s a
Message Headers
h (MIME -> MIMEMessage)
-> (NonEmpty MIMEMessage -> MIME)
-> NonEmpty MIMEMessage
-> MIMEMessage
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MultipartSubtype -> Boundary -> NonEmpty MIMEMessage -> MIME
Multipart MultipartSubtype
sub Boundary
b (NonEmpty MIMEMessage -> MIMEMessage)
-> f (NonEmpty MIMEMessage) -> f MIMEMessage
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (MIMEMessage -> f MIMEMessage)
-> NonEmpty MIMEMessage -> f (NonEmpty MIMEMessage)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse ((WireEntity -> f WireEntity) -> MIMEMessage -> f MIMEMessage
Traversal' MIMEMessage WireEntity
entities WireEntity -> f WireEntity
f) NonEmpty MIMEMessage
bs
FailedParse MIMEParseError
_ ByteString
_ -> MIMEMessage -> f MIMEMessage
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Headers -> MIME -> MIMEMessage
forall s a. Headers -> a -> Message s a
Message Headers
h MIME
a)
attachments :: Traversal' MIMEMessage WireEntity
attachments :: (WireEntity -> f WireEntity) -> MIMEMessage -> f MIMEMessage
attachments = (WireEntity -> f WireEntity) -> MIMEMessage -> f MIMEMessage
Traversal' MIMEMessage WireEntity
entities ((WireEntity -> f WireEntity) -> MIMEMessage -> f MIMEMessage)
-> ((WireEntity -> f WireEntity) -> WireEntity -> f WireEntity)
-> (WireEntity -> f WireEntity)
-> MIMEMessage
-> f MIMEMessage
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (WireEntity -> Bool)
-> (WireEntity -> f WireEntity) -> WireEntity -> f WireEntity
forall (p :: * -> * -> *) (f :: * -> *) a.
(Choice p, Applicative f) =>
(a -> Bool) -> Optic' p f a a
filtered WireEntity -> Bool
forall a. HasHeaders a => a -> Bool
isAttachment
isAttachment :: HasHeaders a => a -> Bool
isAttachment :: a -> Bool
isAttachment = Getting Any a DispositionType -> a -> Bool
forall s a. Getting Any s a -> s -> Bool
has ((Maybe ContentDisposition -> Const Any (Maybe ContentDisposition))
-> a -> Const Any a
forall a. HasHeaders a => Lens' a (Maybe ContentDisposition)
contentDisposition ((Maybe ContentDisposition -> Const Any (Maybe ContentDisposition))
-> a -> Const Any a)
-> ((DispositionType -> Const Any DispositionType)
-> Maybe ContentDisposition
-> Const Any (Maybe ContentDisposition))
-> Getting Any a DispositionType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ContentDisposition -> Const Any ContentDisposition)
-> Maybe ContentDisposition -> Const Any (Maybe ContentDisposition)
forall a b. Prism (Maybe a) (Maybe b) a b
_Just ((ContentDisposition -> Const Any ContentDisposition)
-> Maybe ContentDisposition
-> Const Any (Maybe ContentDisposition))
-> ((DispositionType -> Const Any DispositionType)
-> ContentDisposition -> Const Any ContentDisposition)
-> (DispositionType -> Const Any DispositionType)
-> Maybe ContentDisposition
-> Const Any (Maybe ContentDisposition)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (DispositionType -> Const Any DispositionType)
-> ContentDisposition -> Const Any ContentDisposition
Lens' ContentDisposition DispositionType
dispositionType ((DispositionType -> Const Any DispositionType)
-> ContentDisposition -> Const Any ContentDisposition)
-> ((DispositionType -> Const Any DispositionType)
-> DispositionType -> Const Any DispositionType)
-> (DispositionType -> Const Any DispositionType)
-> ContentDisposition
-> Const Any ContentDisposition
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (DispositionType -> Bool)
-> (DispositionType -> Const Any DispositionType)
-> DispositionType
-> Const Any DispositionType
forall (p :: * -> * -> *) (f :: * -> *) a.
(Choice p, Applicative f) =>
(a -> Bool) -> Optic' p f a a
filtered (DispositionType -> DispositionType -> Bool
forall a. Eq a => a -> a -> Bool
== DispositionType
Attachment))
contentTransferEncoding
:: (Profunctor p, Contravariant f) => Optic' p f Headers TransferEncodingName
contentTransferEncoding :: Optic' p f Headers TransferEncodingName
contentTransferEncoding = (Headers -> TransferEncodingName)
-> Optic' p f Headers TransferEncodingName
forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to ((Headers -> TransferEncodingName)
-> Optic' p f Headers TransferEncodingName)
-> (Headers -> TransferEncodingName)
-> Optic' p f Headers TransferEncodingName
forall a b. (a -> b) -> a -> b
$
TransferEncodingName
-> Maybe TransferEncodingName -> TransferEncodingName
forall a. a -> Maybe a -> a
fromMaybe TransferEncodingName
"7bit"
(Maybe TransferEncodingName -> TransferEncodingName)
-> (Headers -> Maybe TransferEncodingName)
-> Headers
-> TransferEncodingName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting (First TransferEncodingName) Headers TransferEncodingName
-> Headers -> Maybe TransferEncodingName
forall s (m :: * -> *) a.
MonadReader s m =>
Getting (First a) s a -> m (Maybe a)
preview (TransferEncodingName -> Traversal' Headers ByteString
forall a.
HasHeaders a =>
TransferEncodingName -> Traversal' a ByteString
header TransferEncodingName
"content-transfer-encoding" ((ByteString -> Const (First TransferEncodingName) ByteString)
-> Headers -> Const (First TransferEncodingName) Headers)
-> ((TransferEncodingName
-> Const (First TransferEncodingName) TransferEncodingName)
-> ByteString -> Const (First TransferEncodingName) ByteString)
-> Getting
(First TransferEncodingName) Headers TransferEncodingName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TransferEncodingName
-> Const (First TransferEncodingName) TransferEncodingName)
-> ByteString -> Const (First TransferEncodingName) ByteString
forall s. FoldCase s => Iso' s (CI s)
caseInsensitive)
instance HasTransferEncoding WireEntity where
type TransferDecoded WireEntity = ByteEntity
transferEncodingName :: (TransferEncodingName -> f TransferEncodingName)
-> WireEntity -> f WireEntity
transferEncodingName = (Headers -> f Headers) -> WireEntity -> f WireEntity
forall a. HasHeaders a => Lens' a Headers
headers ((Headers -> f Headers) -> WireEntity -> f WireEntity)
-> ((TransferEncodingName -> f TransferEncodingName)
-> Headers -> f Headers)
-> (TransferEncodingName -> f TransferEncodingName)
-> WireEntity
-> f WireEntity
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TransferEncodingName -> f TransferEncodingName)
-> Headers -> f Headers
forall (p :: * -> * -> *) (f :: * -> *).
(Profunctor p, Contravariant f) =>
Optic' p f Headers TransferEncodingName
contentTransferEncoding
transferEncodedData :: (ByteString -> f ByteString) -> WireEntity -> f WireEntity
transferEncodedData = (ByteString -> f ByteString) -> WireEntity -> f WireEntity
forall ctx a ctx' b. Lens (Message ctx a) (Message ctx' b) a b
body
transferDecoded :: Optic' p f WireEntity (Either e (TransferDecoded WireEntity))
transferDecoded = (WireEntity -> Either e (Message EncStateByte ByteString))
-> Optic'
p f WireEntity (Either e (Message EncStateByte ByteString))
forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to ((WireEntity -> Either e (Message EncStateByte ByteString))
-> Optic'
p f WireEntity (Either e (Message EncStateByte ByteString)))
-> (WireEntity -> Either e (Message EncStateByte ByteString))
-> Optic'
p f WireEntity (Either e (Message EncStateByte ByteString))
forall a b. (a -> b) -> a -> b
$ \WireEntity
a -> (\ByteString
t -> ASetter
WireEntity (Message EncStateByte ByteString) ByteString ByteString
-> ByteString -> WireEntity -> Message EncStateByte ByteString
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter
WireEntity (Message EncStateByte ByteString) ByteString ByteString
forall ctx a ctx' b. Lens (Message ctx a) (Message ctx' b) a b
body ByteString
t WireEntity
a) (ByteString -> Message EncStateByte ByteString)
-> Either e ByteString
-> Either e (Message EncStateByte ByteString)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Getting (Either e ByteString) WireEntity (Either e ByteString)
-> WireEntity -> Either e ByteString
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting (Either e ByteString) WireEntity (Either e ByteString)
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 h s) =
let
(TransferEncodingName
cteName, TransferEncoding
cte) = ByteString -> (TransferEncodingName, TransferEncoding)
chooseTransferEncoding ByteString
s
s' :: ByteString
s' = AReview ByteString ByteString -> ByteString -> ByteString
forall b (m :: * -> *) t. MonadReader b m => AReview t b -> m t
review (TransferEncoding
-> Prism ByteString ByteString ByteString ByteString
forall s t a b. APrism s t a b -> Prism s t a b
clonePrism TransferEncoding
cte) ByteString
s
cteName' :: ByteString
cteName' = TransferEncodingName -> ByteString
forall s. CI s -> s
CI.original TransferEncodingName
cteName
h' :: Headers
h' = ASetter Headers Headers (Maybe ByteString) (Maybe ByteString)
-> Maybe ByteString -> Headers -> Headers
forall s t a b. ASetter s t a b -> b -> s -> t
set ((Headers -> Identity Headers) -> Headers -> Identity Headers
forall a. HasHeaders a => Lens' a Headers
headers ((Headers -> Identity Headers) -> Headers -> Identity Headers)
-> ASetter Headers Headers (Maybe ByteString) (Maybe ByteString)
-> ASetter Headers Headers (Maybe ByteString) (Maybe ByteString)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index Headers -> Lens' Headers (Maybe (IxValue Headers))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Index Headers
"Content-Transfer-Encoding") (ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just ByteString
cteName') Headers
h
in
Headers -> ByteString -> WireEntity
forall s a. Headers -> a -> Message s a
Message Headers
h' ByteString
s'
caseInsensitive :: CI.FoldCase s => Iso' s (CI s)
caseInsensitive :: Iso' s (CI s)
caseInsensitive = (s -> CI s) -> (CI s -> s) -> Iso' s (CI s)
forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso s -> CI s
forall s. FoldCase s => s -> CI s
CI.mk CI s -> s
forall s. CI s -> s
CI.original
{-# INLINE caseInsensitive #-}
data ContentType = ContentType (CI B.ByteString) (CI B.ByteString) Parameters
deriving (Int -> ContentType -> ShowS
[ContentType] -> ShowS
ContentType -> String
(Int -> ContentType -> ShowS)
-> (ContentType -> String)
-> ([ContentType] -> ShowS)
-> Show ContentType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ContentType] -> ShowS
$cshowList :: [ContentType] -> ShowS
show :: ContentType -> String
$cshow :: ContentType -> String
showsPrec :: Int -> ContentType -> ShowS
$cshowsPrec :: Int -> ContentType -> ShowS
Show, (forall x. ContentType -> Rep ContentType x)
-> (forall x. Rep ContentType x -> ContentType)
-> Generic ContentType
forall x. Rep ContentType x -> ContentType
forall x. ContentType -> Rep ContentType x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ContentType x -> ContentType
$cfrom :: forall x. ContentType -> Rep ContentType x
Generic, ContentType -> ()
(ContentType -> ()) -> NFData ContentType
forall a. (a -> ()) -> NFData a
rnf :: ContentType -> ()
$crnf :: ContentType -> ()
NFData)
instance Eq ContentType where
ContentType TransferEncodingName
a TransferEncodingName
b Parameters
c == :: ContentType -> ContentType -> Bool
== ContentType TransferEncodingName
a' TransferEncodingName
b' Parameters
c' = TransferEncodingName
a TransferEncodingName -> TransferEncodingName -> Bool
forall a. Eq a => a -> a -> Bool
== TransferEncodingName
a' Bool -> Bool -> Bool
&& TransferEncodingName
b TransferEncodingName -> TransferEncodingName -> Bool
forall a. Eq a => a -> a -> Bool
== TransferEncodingName
b' Bool -> Bool -> Bool
&& Parameters
c Parameters -> Parameters -> Bool
forall a. Eq a => a -> a -> Bool
== Parameters
c'
instance IsString ContentType where
fromString :: String -> ContentType
fromString = (String -> ContentType)
-> (ContentType -> ContentType)
-> Either String ContentType
-> ContentType
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either String -> ContentType
forall a. String -> a
err ContentType -> ContentType
forall a. a -> a
id (Either String ContentType -> ContentType)
-> (String -> Either String ContentType) -> String -> ContentType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parser ContentType -> ByteString -> Either String ContentType
forall a. Parser a -> ByteString -> Either String a
parseOnly Parser ContentType
parseContentType (ByteString -> Either String ContentType)
-> (String -> ByteString) -> String -> Either String ContentType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ByteString
C8.pack
where
err :: String -> a
err String
msg = String -> a
forall a. HasCallStack => String -> a
error (String -> a) -> String -> a
forall a b. (a -> b) -> a -> b
$ String
"failed to parse Content-Type: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
msg
matchContentType
:: CI B.ByteString
-> Maybe (CI B.ByteString)
-> ContentType
-> Bool
matchContentType :: TransferEncodingName
-> Maybe TransferEncodingName -> ContentType -> Bool
matchContentType TransferEncodingName
wantType Maybe TransferEncodingName
wantSubtype (ContentType TransferEncodingName
gotType TransferEncodingName
gotSubtype Parameters
_) =
TransferEncodingName
wantType TransferEncodingName -> TransferEncodingName -> Bool
forall a. Eq a => a -> a -> Bool
== TransferEncodingName
gotType Bool -> Bool -> Bool
&& Bool
-> (TransferEncodingName -> Bool)
-> Maybe TransferEncodingName
-> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
True (TransferEncodingName -> TransferEncodingName -> Bool
forall a. Eq a => a -> a -> Bool
== TransferEncodingName
gotSubtype) Maybe TransferEncodingName
wantSubtype
renderContentType :: ContentType -> B.ByteString
renderContentType :: ContentType -> ByteString
renderContentType (ContentType TransferEncodingName
typ TransferEncodingName
sub Parameters
params) =
TransferEncodingName -> ByteString
forall s. CI s -> s
CI.original TransferEncodingName
typ ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
"/" ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> TransferEncodingName -> ByteString
forall s. CI s -> s
CI.original TransferEncodingName
sub ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> Parameters -> ByteString
printParameters Parameters
params
printParameters :: Parameters -> B.ByteString
printParameters :: Parameters -> ByteString
printParameters (Parameters [(TransferEncodingName, ByteString)]
xs) =
((TransferEncodingName, ByteString) -> ByteString)
-> [(TransferEncodingName, ByteString)] -> ByteString
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (\(TransferEncodingName
k,ByteString
v) -> ByteString
"; " ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> TransferEncodingName -> ByteString
forall s. CI s -> s
CI.original TransferEncodingName
k ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
"=" ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
v) [(TransferEncodingName, ByteString)]
xs
ctType :: Lens' ContentType (CI B.ByteString)
ctType :: (TransferEncodingName -> f TransferEncodingName)
-> ContentType -> f ContentType
ctType TransferEncodingName -> f TransferEncodingName
f (ContentType TransferEncodingName
a TransferEncodingName
b Parameters
c) = (TransferEncodingName -> ContentType)
-> f TransferEncodingName -> f ContentType
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\TransferEncodingName
a' -> TransferEncodingName
-> TransferEncodingName -> Parameters -> ContentType
ContentType TransferEncodingName
a' TransferEncodingName
b Parameters
c) (TransferEncodingName -> f TransferEncodingName
f TransferEncodingName
a)
ctSubtype :: Lens' ContentType (CI B.ByteString)
ctSubtype :: (TransferEncodingName -> f TransferEncodingName)
-> ContentType -> f ContentType
ctSubtype TransferEncodingName -> f TransferEncodingName
f (ContentType TransferEncodingName
a TransferEncodingName
b Parameters
c) = (TransferEncodingName -> ContentType)
-> f TransferEncodingName -> f ContentType
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\TransferEncodingName
b' -> TransferEncodingName
-> TransferEncodingName -> Parameters -> ContentType
ContentType TransferEncodingName
a TransferEncodingName
b' Parameters
c) (TransferEncodingName -> f TransferEncodingName
f TransferEncodingName
b)
ctParameters :: Lens' ContentType Parameters
ctParameters :: (Parameters -> f Parameters) -> ContentType -> f ContentType
ctParameters Parameters -> f Parameters
f (ContentType TransferEncodingName
a TransferEncodingName
b Parameters
c) = (Parameters -> ContentType) -> f Parameters -> f ContentType
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Parameters
c' -> TransferEncodingName
-> TransferEncodingName -> Parameters -> ContentType
ContentType TransferEncodingName
a TransferEncodingName
b Parameters
c') (Parameters -> f Parameters
f Parameters
c)
{-# ANN ctParameters ("HLint: ignore Avoid lambda" :: String) #-}
showContentType :: ContentType -> T.Text
showContentType :: ContentType -> Text
showContentType = ByteString -> Text
decodeLenient (ByteString -> Text)
-> (ContentType -> ByteString) -> ContentType -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ContentType -> ByteString
renderContentType
instance HasParameters ContentType where
parameters :: (Parameters -> f Parameters) -> ContentType -> f ContentType
parameters = (Parameters -> f Parameters) -> ContentType -> f ContentType
Lens' ContentType Parameters
ctParameters
parseContentType :: Parser ContentType
parseContentType :: Parser ContentType
parseContentType = do
TransferEncodingName
typ <- Parser ByteString -> Parser TransferEncodingName
forall s. FoldCase s => Parser s -> Parser (CI s)
ci Parser ByteString
token
Word8
_ <- Char -> Parser Word8
char8 Char
'/'
TransferEncodingName
subtype <- Parser ByteString -> Parser TransferEncodingName
forall s. FoldCase s => Parser s -> Parser (CI s)
ci Parser ByteString
token
[(TransferEncodingName, ByteString)]
params <- Parser [(TransferEncodingName, ByteString)]
parseParameters
if TransferEncodingName
typ TransferEncodingName -> TransferEncodingName -> Bool
forall a. Eq a => a -> a -> Bool
== TransferEncodingName
"multipart" Bool -> Bool -> Bool
&& TransferEncodingName
"boundary" TransferEncodingName -> [TransferEncodingName] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` ((TransferEncodingName, ByteString) -> TransferEncodingName)
-> [(TransferEncodingName, ByteString)] -> [TransferEncodingName]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (TransferEncodingName, ByteString) -> TransferEncodingName
forall a b. (a, b) -> a
fst [(TransferEncodingName, ByteString)]
params
then
String -> Parser ContentType
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"\"boundary\" parameter is required for multipart content type"
else ContentType -> Parser ContentType
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ContentType -> Parser ContentType)
-> ContentType -> Parser ContentType
forall a b. (a -> b) -> a -> b
$ TransferEncodingName
-> TransferEncodingName -> Parameters -> ContentType
ContentType TransferEncodingName
typ TransferEncodingName
subtype ([(TransferEncodingName, ByteString)] -> Parameters
Parameters [(TransferEncodingName, ByteString)]
params)
parseParameters :: Parser [(CI B.ByteString, B.ByteString)]
parseParameters :: Parser [(TransferEncodingName, ByteString)]
parseParameters = Parser ByteString (TransferEncodingName, ByteString)
-> Parser [(TransferEncodingName, ByteString)]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (Char -> Parser Word8
char8 Char
';' Parser Word8 -> Parser ByteString () -> Parser ByteString ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Word8 -> Bool) -> Parser ByteString ()
skipWhile (Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
32 ) Parser ByteString ()
-> Parser ByteString (TransferEncodingName, ByteString)
-> Parser ByteString (TransferEncodingName, ByteString)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ByteString (TransferEncodingName, ByteString)
param)
where
param :: Parser ByteString (TransferEncodingName, ByteString)
param = (,) (TransferEncodingName
-> ByteString -> (TransferEncodingName, ByteString))
-> Parser TransferEncodingName
-> Parser
ByteString (ByteString -> (TransferEncodingName, ByteString))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString -> Parser TransferEncodingName
forall s. FoldCase s => Parser s -> Parser (CI s)
ci Parser ByteString
token Parser
ByteString (ByteString -> (TransferEncodingName, ByteString))
-> Parser Word8
-> Parser
ByteString (ByteString -> (TransferEncodingName, ByteString))
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Char -> Parser Word8
char8 Char
'=' Parser
ByteString (ByteString -> (TransferEncodingName, ByteString))
-> Parser ByteString
-> Parser ByteString (TransferEncodingName, ByteString)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ByteString
val
val :: Parser ByteString
val = Parser ByteString
token Parser ByteString -> Parser ByteString -> Parser ByteString
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser ByteString
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 Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
>= Word8
33 Bool -> Bool -> Bool
&& Word8
c Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word8
126 Bool -> Bool -> Bool
&& String -> Word8 -> Bool
notInClass String
"()<>@,;:\\\"/[]?=" Word8
c)
instance HasCharset ByteEntity where
type Decoded ByteEntity = TextEntity
charsetName :: (Maybe TransferEncodingName -> f (Maybe TransferEncodingName))
-> Message EncStateByte ByteString
-> f (Message EncStateByte ByteString)
charsetName = (Message EncStateByte ByteString -> Maybe TransferEncodingName)
-> (Maybe TransferEncodingName -> f (Maybe TransferEncodingName))
-> Message EncStateByte ByteString
-> f (Message EncStateByte ByteString)
forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to ((Message EncStateByte ByteString -> Maybe TransferEncodingName)
-> (Maybe TransferEncodingName -> f (Maybe TransferEncodingName))
-> Message EncStateByte ByteString
-> f (Message EncStateByte ByteString))
-> (Message EncStateByte ByteString -> Maybe TransferEncodingName)
-> (Maybe TransferEncodingName -> f (Maybe TransferEncodingName))
-> Message EncStateByte ByteString
-> f (Message EncStateByte ByteString)
forall a b. (a -> b) -> a -> b
$ \Message EncStateByte ByteString
ent ->
let
(ContentType TransferEncodingName
typ TransferEncodingName
sub Parameters
params) = Getting ContentType (Message EncStateByte ByteString) ContentType
-> Message EncStateByte ByteString -> ContentType
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view ((Headers -> Const ContentType Headers)
-> Message EncStateByte ByteString
-> Const ContentType (Message EncStateByte ByteString)
forall a. HasHeaders a => Lens' a Headers
headers ((Headers -> Const ContentType Headers)
-> Message EncStateByte ByteString
-> Const ContentType (Message EncStateByte ByteString))
-> ((ContentType -> Const ContentType ContentType)
-> Headers -> Const ContentType Headers)
-> Getting
ContentType (Message EncStateByte ByteString) ContentType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ContentType -> Const ContentType ContentType)
-> Headers -> Const ContentType Headers
forall a. HasHeaders a => Lens' a ContentType
contentType) Message EncStateByte ByteString
ent
source :: TransferEncodingName -> EntityCharsetSource
source = EntityCharsetSource
-> Maybe EntityCharsetSource -> EntityCharsetSource
forall a. a -> Maybe a -> a
fromMaybe (Maybe TransferEncodingName -> EntityCharsetSource
InParameter (TransferEncodingName -> Maybe TransferEncodingName
forall a. a -> Maybe a
Just TransferEncodingName
"us-ascii")) (Maybe EntityCharsetSource -> EntityCharsetSource)
-> (TransferEncodingName -> Maybe EntityCharsetSource)
-> TransferEncodingName
-> EntityCharsetSource
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TransferEncodingName
-> [(TransferEncodingName, EntityCharsetSource)]
-> Maybe EntityCharsetSource
forall a b. Eq a => a -> [(a, b)] -> Maybe b
`lookup` [(TransferEncodingName, EntityCharsetSource)]
textCharsetSources)
l :: (TransferEncodingName
-> Const (First TransferEncodingName) TransferEncodingName)
-> Parameters -> Const (First TransferEncodingName) Parameters
l = TransferEncodingName -> Traversal' Parameters ByteString
forall a.
HasParameters a =>
TransferEncodingName -> Traversal' a ByteString
rawParameter TransferEncodingName
"charset" ((ByteString -> Const (First TransferEncodingName) ByteString)
-> Parameters -> Const (First TransferEncodingName) Parameters)
-> ((TransferEncodingName
-> Const (First TransferEncodingName) TransferEncodingName)
-> ByteString -> Const (First TransferEncodingName) ByteString)
-> (TransferEncodingName
-> Const (First TransferEncodingName) TransferEncodingName)
-> Parameters
-> Const (First TransferEncodingName) Parameters
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TransferEncodingName
-> Const (First TransferEncodingName) TransferEncodingName)
-> ByteString -> Const (First TransferEncodingName) ByteString
forall s. FoldCase s => Iso' s (CI s)
caseInsensitive
in
if TransferEncodingName
typ TransferEncodingName -> TransferEncodingName -> Bool
forall a. Eq a => a -> a -> Bool
== TransferEncodingName
"text"
then case TransferEncodingName -> EntityCharsetSource
source TransferEncodingName
sub of
InPayload ByteString -> Maybe TransferEncodingName
f -> ByteString -> Maybe TransferEncodingName
f (Getting ByteString (Message EncStateByte ByteString) ByteString
-> Message EncStateByte ByteString -> ByteString
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting ByteString (Message EncStateByte ByteString) ByteString
forall ctx a ctx' b. Lens (Message ctx a) (Message ctx' b) a b
body Message EncStateByte ByteString
ent)
InParameter Maybe TransferEncodingName
def -> ((TransferEncodingName
-> Const (First TransferEncodingName) TransferEncodingName)
-> Parameters -> Const (First TransferEncodingName) Parameters)
-> Parameters -> Maybe TransferEncodingName
forall s (m :: * -> *) a.
MonadReader s m =>
Getting (First a) s a -> m (Maybe a)
preview (TransferEncodingName
-> Const (First TransferEncodingName) TransferEncodingName)
-> Parameters -> Const (First TransferEncodingName) Parameters
l Parameters
params Maybe TransferEncodingName
-> Maybe TransferEncodingName -> Maybe TransferEncodingName
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe TransferEncodingName
def
InPayloadOrParameter Maybe TransferEncodingName
-> ByteString -> Maybe TransferEncodingName
f -> Maybe TransferEncodingName
-> ByteString -> Maybe TransferEncodingName
f (((TransferEncodingName
-> Const (First TransferEncodingName) TransferEncodingName)
-> Parameters -> Const (First TransferEncodingName) Parameters)
-> Parameters -> Maybe TransferEncodingName
forall s (m :: * -> *) a.
MonadReader s m =>
Getting (First a) s a -> m (Maybe a)
preview (TransferEncodingName
-> Const (First TransferEncodingName) TransferEncodingName)
-> Parameters -> Const (First TransferEncodingName) Parameters
l Parameters
params) (Getting ByteString (Message EncStateByte ByteString) ByteString
-> Message EncStateByte ByteString -> ByteString
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting ByteString (Message EncStateByte ByteString) ByteString
forall ctx a ctx' b. Lens (Message ctx a) (Message ctx' b) a b
body Message EncStateByte ByteString
ent)
else
((TransferEncodingName
-> Const (First TransferEncodingName) TransferEncodingName)
-> Parameters -> Const (First TransferEncodingName) Parameters)
-> Parameters -> Maybe TransferEncodingName
forall s (m :: * -> *) a.
MonadReader s m =>
Getting (First a) s a -> m (Maybe a)
preview (TransferEncodingName
-> Const (First TransferEncodingName) TransferEncodingName)
-> Parameters -> Const (First TransferEncodingName) Parameters
l Parameters
params Maybe TransferEncodingName
-> Maybe TransferEncodingName -> Maybe TransferEncodingName
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> TransferEncodingName -> Maybe TransferEncodingName
forall a. a -> Maybe a
Just TransferEncodingName
"us-ascii"
charsetData :: (ByteString -> f ByteString)
-> Message EncStateByte ByteString
-> f (Message EncStateByte ByteString)
charsetData = (ByteString -> f ByteString)
-> Message EncStateByte ByteString
-> f (Message EncStateByte ByteString)
forall ctx a ctx' b. Lens (Message ctx a) (Message ctx' b) a b
body
charsetDecoded :: CharsetLookup
-> forall (p :: * -> * -> *) (f :: * -> *).
(Profunctor p, Contravariant f) =>
Optic'
p
f
(Message EncStateByte ByteString)
(Either e (Decoded (Message EncStateByte ByteString)))
charsetDecoded CharsetLookup
m = (Message EncStateByte ByteString -> Either e (Message () Text))
-> Optic'
p f (Message EncStateByte ByteString) (Either e (Message () Text))
forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to ((Message EncStateByte ByteString -> Either e (Message () Text))
-> Optic'
p f (Message EncStateByte ByteString) (Either e (Message () Text)))
-> (Message EncStateByte ByteString -> Either e (Message () Text))
-> Optic'
p f (Message EncStateByte ByteString) (Either e (Message () Text))
forall a b. (a -> b) -> a -> b
$ \Message EncStateByte ByteString
a -> (\Text
t -> ASetter
(Message EncStateByte ByteString) (Message () Text) ByteString Text
-> Text -> Message EncStateByte ByteString -> Message () Text
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter
(Message EncStateByte ByteString) (Message () Text) ByteString Text
forall ctx a ctx' b. Lens (Message ctx a) (Message ctx' b) a b
body Text
t Message EncStateByte ByteString
a) (Text -> Message () Text)
-> Either e Text -> Either e (Message () Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Getting
(Either e Text) (Message EncStateByte ByteString) (Either e Text)
-> Message EncStateByte ByteString -> Either e Text
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view (CharsetLookup
-> Getting
(Either e Text) (Message EncStateByte ByteString) (Either e Text)
forall a e (p :: * -> * -> *) (f :: * -> *).
(HasCharset a, AsCharsetError e, Profunctor p, Contravariant f) =>
CharsetLookup -> Optic' p f a (Either e Text)
charsetText CharsetLookup
m) Message EncStateByte ByteString
a
charsetEncode :: Decoded (Message EncStateByte ByteString)
-> Message EncStateByte ByteString
charsetEncode (Message h a) =
let
b :: ByteString
b = Text -> ByteString
T.encodeUtf8 Text
a
charset :: EncodedParameterValue
charset = if (Word8 -> Bool) -> ByteString -> Bool
B.all (Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
< Word8
0x80) ByteString
b then EncodedParameterValue
"us-ascii" else EncodedParameterValue
"utf-8"
in Headers -> ByteString -> Message EncStateByte ByteString
forall s a. Headers -> a -> Message s a
Message (ASetter
Headers
Headers
(Maybe EncodedParameterValue)
(Maybe EncodedParameterValue)
-> Maybe EncodedParameterValue -> Headers -> Headers
forall s t a b. ASetter s t a b -> b -> s -> t
set ((ContentType -> Identity ContentType)
-> Headers -> Identity Headers
forall a. HasHeaders a => Lens' a ContentType
contentType ((ContentType -> Identity ContentType)
-> Headers -> Identity Headers)
-> ((Maybe EncodedParameterValue
-> Identity (Maybe EncodedParameterValue))
-> ContentType -> Identity ContentType)
-> ASetter
Headers
Headers
(Maybe EncodedParameterValue)
(Maybe EncodedParameterValue)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TransferEncodingName
-> Lens' ContentType (Maybe EncodedParameterValue)
forall a.
HasParameters a =>
TransferEncodingName -> Lens' a (Maybe EncodedParameterValue)
parameter TransferEncodingName
"charset") (EncodedParameterValue -> Maybe EncodedParameterValue
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 :: [(TransferEncodingName, EntityCharsetSource)]
textCharsetSources =
[ (TransferEncodingName
"plain", Maybe TransferEncodingName -> EntityCharsetSource
InParameter (TransferEncodingName -> Maybe TransferEncodingName
forall a. a -> Maybe a
Just TransferEncodingName
"us-ascii"))
, (TransferEncodingName
"csv", Maybe TransferEncodingName -> EntityCharsetSource
InParameter (TransferEncodingName -> Maybe TransferEncodingName
forall a. a -> Maybe a
Just TransferEncodingName
"utf-8"))
, (TransferEncodingName
"rtf", (ByteString -> Maybe TransferEncodingName) -> EntityCharsetSource
InPayload (Maybe TransferEncodingName
-> ByteString -> Maybe TransferEncodingName
forall a b. a -> b -> a
const (TransferEncodingName -> Maybe TransferEncodingName
forall a. a -> Maybe a
Just TransferEncodingName
"us-ascii")))
, (TransferEncodingName
"html", (Maybe TransferEncodingName
-> ByteString -> Maybe TransferEncodingName)
-> EntityCharsetSource
InPayloadOrParameter (\Maybe TransferEncodingName
_param ByteString
_payload -> TransferEncodingName -> Maybe TransferEncodingName
forall a. a -> Maybe a
Just TransferEncodingName
"us-ascii"))
, (TransferEncodingName
"markdown", Maybe TransferEncodingName -> EntityCharsetSource
InParameter Maybe TransferEncodingName
forall a. Maybe a
Nothing)
, (TransferEncodingName
"xml", (Maybe TransferEncodingName
-> ByteString -> Maybe TransferEncodingName)
-> EntityCharsetSource
InPayloadOrParameter (\Maybe TransferEncodingName
_param ByteString
_payload -> TransferEncodingName -> Maybe TransferEncodingName
forall a. a -> Maybe a
Just TransferEncodingName
"utf-8"))
, (TransferEncodingName
"enriched", Maybe TransferEncodingName -> EntityCharsetSource
InParameter (TransferEncodingName -> Maybe TransferEncodingName
forall a. a -> Maybe a
Just TransferEncodingName
"us-ascii"))
]
defaultContentType :: ContentType
defaultContentType :: ContentType
defaultContentType =
ASetter
ContentType
ContentType
[(TransferEncodingName, ByteString)]
[(TransferEncodingName, ByteString)]
-> ([(TransferEncodingName, ByteString)]
-> [(TransferEncodingName, ByteString)])
-> ContentType
-> ContentType
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter
ContentType
ContentType
[(TransferEncodingName, ByteString)]
[(TransferEncodingName, ByteString)]
forall a.
HasParameters a =>
Lens' a [(TransferEncodingName, ByteString)]
parameterList ((TransferEncodingName
"charset", ByteString
"us-ascii")(TransferEncodingName, ByteString)
-> [(TransferEncodingName, ByteString)]
-> [(TransferEncodingName, ByteString)]
forall a. a -> [a] -> [a]
:) ContentType
contentTypeTextPlain
contentTypeTextPlain :: ContentType
contentTypeTextPlain :: ContentType
contentTypeTextPlain = TransferEncodingName
-> TransferEncodingName -> Parameters -> ContentType
ContentType TransferEncodingName
"text" TransferEncodingName
"plain" Parameters
forall a. Monoid a => a
mempty
contentTypeApplicationOctetStream :: ContentType
contentTypeApplicationOctetStream :: ContentType
contentTypeApplicationOctetStream =
TransferEncodingName
-> TransferEncodingName -> Parameters -> ContentType
ContentType TransferEncodingName
"application" TransferEncodingName
"octet-stream" Parameters
forall a. Monoid a => a
mempty
contentTypeMultipart :: MultipartSubtype -> Boundary -> ContentType
contentTypeMultipart :: MultipartSubtype -> Boundary -> ContentType
contentTypeMultipart MultipartSubtype
subtype Boundary
boundary =
TransferEncodingName
-> TransferEncodingName -> Parameters -> ContentType
ContentType TransferEncodingName
"multipart" TransferEncodingName
sub Parameters
forall a. Monoid a => a
mempty
ContentType -> (ContentType -> ContentType) -> ContentType
forall a b. a -> (a -> b) -> b
& TransferEncodingName -> ByteString -> ContentType -> ContentType
forall t.
HasParameters t =>
TransferEncodingName -> ByteString -> t -> t
setParam TransferEncodingName
"boundary" (Boundary -> ByteString
unBoundary Boundary
boundary)
ContentType -> (ContentType -> ContentType) -> ContentType
forall a b. a -> (a -> b) -> b
& ContentType -> ContentType
appendParams
where
setParam :: TransferEncodingName -> ByteString -> t -> t
setParam TransferEncodingName
k ByteString
v = ASetter
t t (Maybe EncodedParameterValue) (Maybe EncodedParameterValue)
-> Maybe EncodedParameterValue -> t -> t
forall s t a b. ASetter s t a b -> b -> s -> t
set (TransferEncodingName -> Lens' t (Maybe EncodedParameterValue)
forall a.
HasParameters a =>
TransferEncodingName -> Lens' a (Maybe EncodedParameterValue)
parameter TransferEncodingName
k) (EncodedParameterValue -> Maybe EncodedParameterValue
forall a. a -> Maybe a
Just (EncodedParameterValue -> Maybe EncodedParameterValue)
-> EncodedParameterValue -> Maybe EncodedParameterValue
forall a b. (a -> b) -> a -> b
$ Maybe TransferEncodingName
-> Maybe TransferEncodingName
-> ByteString
-> EncodedParameterValue
forall cs a.
Maybe cs -> Maybe TransferEncodingName -> a -> ParameterValue cs a
ParameterValue Maybe TransferEncodingName
forall a. Maybe a
Nothing Maybe TransferEncodingName
forall a. Maybe a
Nothing ByteString
v)
(TransferEncodingName
sub, ContentType -> ContentType
appendParams) = case MultipartSubtype
subtype of
MultipartSubtype
Mixed -> (TransferEncodingName
"mixed", ContentType -> ContentType
forall a. a -> a
id)
MultipartSubtype
Alternative -> (TransferEncodingName
"alternative", ContentType -> ContentType
forall a. a -> a
id)
MultipartSubtype
Digest -> (TransferEncodingName
"digest", ContentType -> ContentType
forall a. a -> a
id)
MultipartSubtype
Parallel -> (TransferEncodingName
"parallel", ContentType -> ContentType
forall a. a -> a
id)
MultipartSubtype
Multilingual -> (TransferEncodingName
"multilingual", ContentType -> ContentType
forall a. a -> a
id)
Report ByteString
typ -> (TransferEncodingName
"report", TransferEncodingName -> ByteString -> ContentType -> ContentType
forall t.
HasParameters t =>
TransferEncodingName -> ByteString -> t -> t
setParam TransferEncodingName
"report-type" ByteString
typ)
Signed ByteString
proto ByteString
micalg -> (TransferEncodingName
"signed", TransferEncodingName -> ByteString -> ContentType -> ContentType
forall t.
HasParameters t =>
TransferEncodingName -> ByteString -> t -> t
setParam TransferEncodingName
"protocol" ByteString
proto (ContentType -> ContentType)
-> (ContentType -> ContentType) -> ContentType -> ContentType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TransferEncodingName -> ByteString -> ContentType -> ContentType
forall t.
HasParameters t =>
TransferEncodingName -> ByteString -> t -> t
setParam TransferEncodingName
"micalg" ByteString
micalg)
Encrypted ByteString
proto -> (TransferEncodingName
"encrypted", TransferEncodingName -> ByteString -> ContentType -> ContentType
forall t.
HasParameters t =>
TransferEncodingName -> ByteString -> t -> t
setParam TransferEncodingName
"protocol" ByteString
proto)
Related ContentType
typ Maybe ByteString
start Maybe ByteString
startInfo ->
( TransferEncodingName
"related"
, (ContentType -> ContentType)
-> (ByteString -> ContentType -> ContentType)
-> Maybe ByteString
-> ContentType
-> ContentType
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ContentType -> ContentType
forall a. a -> a
id (TransferEncodingName -> ByteString -> ContentType -> ContentType
forall t.
HasParameters t =>
TransferEncodingName -> ByteString -> t -> t
setParam TransferEncodingName
"start") Maybe ByteString
start
(ContentType -> ContentType)
-> (ContentType -> ContentType) -> ContentType -> ContentType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ContentType -> ContentType)
-> (ByteString -> ContentType -> ContentType)
-> Maybe ByteString
-> ContentType
-> ContentType
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ContentType -> ContentType
forall a. a -> a
id (TransferEncodingName -> ByteString -> ContentType -> ContentType
forall t.
HasParameters t =>
TransferEncodingName -> ByteString -> t -> t
setParam TransferEncodingName
"start-info") Maybe ByteString
startInfo
(ContentType -> ContentType)
-> (ContentType -> ContentType) -> ContentType -> ContentType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TransferEncodingName -> ByteString -> ContentType -> ContentType
forall t.
HasParameters t =>
TransferEncodingName -> ByteString -> t -> t
setParam TransferEncodingName
"type" (ContentType -> ByteString
renderContentType ContentType
typ)
)
Unrecognised TransferEncodingName
sub' -> (TransferEncodingName
sub', ContentType -> ContentType
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 :: Lens' a ContentType
contentType = (Headers -> f Headers) -> a -> f a
forall a. HasHeaders a => Lens' a Headers
headers ((Headers -> f Headers) -> a -> f a)
-> ((ContentType -> f ContentType) -> Headers -> f Headers)
-> (ContentType -> f ContentType)
-> a
-> f a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Headers -> ContentType)
-> (Headers -> ContentType -> Headers)
-> Lens Headers Headers ContentType ContentType
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens Headers -> ContentType
sa Headers -> ContentType -> Headers
forall t.
(At t, IsString (Index t), IxValue t ~ ByteString) =>
t -> ContentType -> t
sbt where
sa :: Headers -> ContentType
sa Headers
s = case Getting (Maybe TransferEncoding) Headers (Maybe TransferEncoding)
-> Headers -> Maybe TransferEncoding
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting (Maybe TransferEncoding) Headers (Maybe TransferEncoding)
cte Headers
s of
Maybe TransferEncoding
Nothing -> ContentType
contentTypeApplicationOctetStream
Just TransferEncoding
_ ->
ContentType -> Maybe ContentType -> ContentType
forall a. a -> Maybe a -> a
fromMaybe ContentType
defaultContentType (Maybe ContentType -> ContentType)
-> Maybe ContentType -> ContentType
forall a b. (a -> b) -> a -> b
$ Getting (First ContentType) Headers ContentType
-> Headers -> Maybe ContentType
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 ((ByteString -> Const (First ContentType) ByteString)
-> Headers -> Const (First ContentType) Headers)
-> ((ContentType -> Const (First ContentType) ContentType)
-> ByteString -> Const (First ContentType) ByteString)
-> Getting (First ContentType) Headers ContentType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parser ContentType -> Fold ByteString ContentType
forall s a. Cons s s Word8 Word8 => Parser a -> Fold s a
parsed Parser ContentType
parseContentType) Headers
s
sbt :: t -> ContentType -> t
sbt t
s ContentType
b = ASetter t t (Maybe (IxValue t)) (Maybe ByteString)
-> Maybe ByteString -> t -> t
forall s t a b. ASetter s t a b -> b -> s -> t
set (Index t -> Lens' t (Maybe (IxValue t))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Index t
"Content-Type") (ByteString -> Maybe ByteString
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 = TransferEncodingName -> Traversal' Headers ByteString
forall a.
HasHeaders a =>
TransferEncodingName -> Traversal' a ByteString
header TransferEncodingName
"content-type"
cte :: Getting (Maybe TransferEncoding) Headers (Maybe TransferEncoding)
cte = Optic'
(->) (Const (Maybe TransferEncoding)) Headers TransferEncodingName
forall (p :: * -> * -> *) (f :: * -> *).
(Profunctor p, Contravariant f) =>
Optic' p f Headers TransferEncodingName
contentTransferEncoding Optic'
(->) (Const (Maybe TransferEncoding)) Headers TransferEncodingName
-> ((Maybe TransferEncoding
-> Const (Maybe TransferEncoding) (Maybe TransferEncoding))
-> TransferEncodingName
-> Const (Maybe TransferEncoding) TransferEncodingName)
-> Getting
(Maybe TransferEncoding) Headers (Maybe TransferEncoding)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TransferEncodingName -> Maybe TransferEncoding)
-> (Maybe TransferEncoding
-> Const (Maybe TransferEncoding) (Maybe TransferEncoding))
-> TransferEncodingName
-> Const (Maybe TransferEncoding) TransferEncodingName
forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to (TransferEncodingName
-> [(TransferEncodingName, TransferEncoding)]
-> Maybe TransferEncoding
forall a b. Eq a => a -> [(a, b)] -> Maybe b
`lookup` [(TransferEncodingName, TransferEncoding)]
transferEncodings)
data ContentDisposition = ContentDisposition
DispositionType
Parameters
deriving (Int -> ContentDisposition -> ShowS
[ContentDisposition] -> ShowS
ContentDisposition -> String
(Int -> ContentDisposition -> ShowS)
-> (ContentDisposition -> String)
-> ([ContentDisposition] -> ShowS)
-> Show ContentDisposition
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ContentDisposition] -> ShowS
$cshowList :: [ContentDisposition] -> ShowS
show :: ContentDisposition -> String
$cshow :: ContentDisposition -> String
showsPrec :: Int -> ContentDisposition -> ShowS
$cshowsPrec :: Int -> ContentDisposition -> ShowS
Show, (forall x. ContentDisposition -> Rep ContentDisposition x)
-> (forall x. Rep ContentDisposition x -> ContentDisposition)
-> Generic ContentDisposition
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 -> ()
(ContentDisposition -> ()) -> NFData ContentDisposition
forall a. (a -> ()) -> NFData a
rnf :: ContentDisposition -> ()
$crnf :: ContentDisposition -> ()
NFData)
data DispositionType = Inline | Attachment
deriving (DispositionType -> DispositionType -> Bool
(DispositionType -> DispositionType -> Bool)
-> (DispositionType -> DispositionType -> Bool)
-> Eq DispositionType
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 -> String
(Int -> DispositionType -> ShowS)
-> (DispositionType -> String)
-> ([DispositionType] -> ShowS)
-> Show DispositionType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DispositionType] -> ShowS
$cshowList :: [DispositionType] -> ShowS
show :: DispositionType -> String
$cshow :: DispositionType -> String
showsPrec :: Int -> DispositionType -> ShowS
$cshowsPrec :: Int -> DispositionType -> ShowS
Show, (forall x. DispositionType -> Rep DispositionType x)
-> (forall x. Rep DispositionType x -> DispositionType)
-> Generic DispositionType
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 -> ()
(DispositionType -> ()) -> NFData DispositionType
forall a. (a -> ()) -> NFData a
rnf :: DispositionType -> ()
$crnf :: DispositionType -> ()
NFData)
dispositionType :: Lens' ContentDisposition DispositionType
dispositionType :: (DispositionType -> f DispositionType)
-> ContentDisposition -> f ContentDisposition
dispositionType DispositionType -> f DispositionType
f (ContentDisposition DispositionType
a Parameters
b) =
(DispositionType -> ContentDisposition)
-> f DispositionType -> f ContentDisposition
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 :: (Parameters -> f Parameters)
-> ContentDisposition -> f ContentDisposition
dispositionParameters Parameters -> f Parameters
f (ContentDisposition DispositionType
a Parameters
b) =
(Parameters -> ContentDisposition)
-> f Parameters -> f ContentDisposition
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 :: (Parameters -> f Parameters)
-> ContentDisposition -> f ContentDisposition
parameters = (Parameters -> f Parameters)
-> ContentDisposition -> f ContentDisposition
Lens' ContentDisposition Parameters
dispositionParameters
parseContentDisposition :: Parser ContentDisposition
parseContentDisposition :: Parser ContentDisposition
parseContentDisposition = DispositionType -> Parameters -> ContentDisposition
ContentDisposition
(DispositionType -> Parameters -> ContentDisposition)
-> Parser ByteString DispositionType
-> Parser ByteString (Parameters -> ContentDisposition)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (TransferEncodingName -> DispositionType
forall a. (Eq a, IsString a) => a -> DispositionType
mapDispType (TransferEncodingName -> DispositionType)
-> Parser TransferEncodingName -> Parser ByteString DispositionType
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString -> Parser TransferEncodingName
forall s. FoldCase s => Parser s -> Parser (CI s)
ci Parser ByteString
token)
Parser ByteString (Parameters -> ContentDisposition)
-> Parser ByteString Parameters -> Parser ContentDisposition
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ([(TransferEncodingName, ByteString)] -> Parameters
Parameters ([(TransferEncodingName, ByteString)] -> Parameters)
-> Parser [(TransferEncodingName, ByteString)]
-> Parser ByteString Parameters
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser [(TransferEncodingName, ByteString)]
parseParameters)
where
mapDispType :: a -> DispositionType
mapDispType a
s
| a
s a -> a -> Bool
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 ByteString -> ByteString -> ByteString
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 :: Lens' a (Maybe ContentDisposition)
contentDisposition = (Headers -> f Headers) -> a -> f a
forall a. HasHeaders a => Lens' a Headers
headers ((Headers -> f Headers) -> a -> f a)
-> ((Maybe ContentDisposition -> f (Maybe ContentDisposition))
-> Headers -> f Headers)
-> (Maybe ContentDisposition -> f (Maybe ContentDisposition))
-> a
-> f a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index Headers -> Lens' Headers (Maybe (IxValue Headers))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Index Headers
"Content-Disposition" ((Maybe ByteString -> f (Maybe ByteString))
-> Headers -> f Headers)
-> ((Maybe ContentDisposition -> f (Maybe ContentDisposition))
-> Maybe ByteString -> f (Maybe ByteString))
-> (Maybe ContentDisposition -> f (Maybe ContentDisposition))
-> Headers
-> f Headers
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe ByteString -> Maybe ContentDisposition)
-> (f (Maybe ContentDisposition) -> f (Maybe ByteString))
-> (Maybe ContentDisposition -> f (Maybe ContentDisposition))
-> Maybe ByteString
-> f (Maybe ByteString)
forall (p :: * -> * -> *) a b c d.
Profunctor p =>
(a -> b) -> (c -> d) -> p b c -> p a d
dimap
(Maybe ByteString
-> (ByteString -> Maybe ContentDisposition)
-> Maybe ContentDisposition
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (String -> Maybe ContentDisposition)
-> (ContentDisposition -> Maybe ContentDisposition)
-> Either String ContentDisposition
-> Maybe ContentDisposition
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Maybe ContentDisposition -> String -> Maybe ContentDisposition
forall a b. a -> b -> a
const Maybe ContentDisposition
forall a. Maybe a
Nothing) ContentDisposition -> Maybe ContentDisposition
forall a. a -> Maybe a
Just (Either String ContentDisposition -> Maybe ContentDisposition)
-> (ByteString -> Either String ContentDisposition)
-> ByteString
-> Maybe ContentDisposition
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parser ContentDisposition
-> ByteString -> Either String ContentDisposition
forall s a.
Cons s s Word8 Word8 =>
Parser a -> s -> Either String a
Data.IMF.parse Parser ContentDisposition
parseContentDisposition)
((Maybe ContentDisposition -> Maybe ByteString)
-> f (Maybe ContentDisposition) -> f (Maybe ByteString)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Maybe ContentDisposition -> Maybe ByteString)
-> f (Maybe ContentDisposition) -> f (Maybe ByteString))
-> ((ContentDisposition -> ByteString)
-> Maybe ContentDisposition -> Maybe ByteString)
-> (ContentDisposition -> ByteString)
-> f (Maybe ContentDisposition)
-> f (Maybe ByteString)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ContentDisposition -> ByteString)
-> Maybe ContentDisposition -> Maybe ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((ContentDisposition -> ByteString)
-> f (Maybe ContentDisposition) -> f (Maybe ByteString))
-> (ContentDisposition -> ByteString)
-> f (Maybe ContentDisposition)
-> f (Maybe ByteString)
forall a b. (a -> b) -> a -> b
$ ContentDisposition -> ByteString
renderContentDisposition)
filename :: HasParameters a => CharsetLookup -> Traversal' a T.Text
filename :: CharsetLookup -> Traversal' a Text
filename CharsetLookup
m = (Maybe EncodedParameterValue -> f (Maybe EncodedParameterValue))
-> a -> f a
forall a. HasParameters a => Lens' a (Maybe EncodedParameterValue)
filenameParameter ((Maybe EncodedParameterValue -> f (Maybe EncodedParameterValue))
-> a -> f a)
-> ((Text -> f Text)
-> Maybe EncodedParameterValue -> f (Maybe EncodedParameterValue))
-> (Text -> f Text)
-> a
-> f a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (EncodedParameterValue -> f EncodedParameterValue)
-> Maybe EncodedParameterValue -> f (Maybe EncodedParameterValue)
forall (f :: * -> *) a b.
Traversable f =>
IndexedTraversal Int (f a) (f b) a b
traversed ((EncodedParameterValue -> f EncodedParameterValue)
-> Maybe EncodedParameterValue -> f (Maybe EncodedParameterValue))
-> ((Text -> f Text)
-> EncodedParameterValue -> f EncodedParameterValue)
-> (Text -> f Text)
-> Maybe EncodedParameterValue
-> f (Maybe EncodedParameterValue)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CharsetLookup
-> Prism' EncodedParameterValue (Decoded EncodedParameterValue)
forall a. HasCharset a => CharsetLookup -> Prism' a (Decoded a)
charsetPrism CharsetLookup
m ((DecodedParameterValue -> f DecodedParameterValue)
-> EncodedParameterValue -> f EncodedParameterValue)
-> ((Text -> f Text)
-> DecodedParameterValue -> f DecodedParameterValue)
-> (Text -> f Text)
-> EncodedParameterValue
-> f EncodedParameterValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> f Text)
-> DecodedParameterValue -> f DecodedParameterValue
forall cs a b. Lens (ParameterValue cs a) (ParameterValue cs b) a b
value
filenameParameter :: HasParameters a => Lens' a (Maybe EncodedParameterValue)
filenameParameter :: Lens' a (Maybe EncodedParameterValue)
filenameParameter = TransferEncodingName -> Lens' a (Maybe EncodedParameterValue)
forall a.
HasParameters a =>
TransferEncodingName -> Lens' a (Maybe EncodedParameterValue)
parameter TransferEncodingName
"filename"
mimeBoundary :: Traversal' ContentType B.ByteString
mimeBoundary :: (ByteString -> f ByteString) -> ContentType -> f ContentType
mimeBoundary = (Parameters -> f Parameters) -> ContentType -> f ContentType
forall a. HasParameters a => Lens' a Parameters
parameters ((Parameters -> f Parameters) -> ContentType -> f ContentType)
-> ((ByteString -> f ByteString) -> Parameters -> f Parameters)
-> (ByteString -> f ByteString)
-> ContentType
-> f ContentType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TransferEncodingName -> Traversal' Parameters ByteString
forall a.
HasParameters a =>
TransferEncodingName -> Traversal' a ByteString
rawParameter TransferEncodingName
"boundary"
mime :: Headers -> BodyHandler MIME
mime :: Headers -> BodyHandler MIME
mime Headers
h
| Getting All Headers ByteString -> Headers -> Bool
forall s a. Getting All s a -> s -> Bool
nullOf (TransferEncodingName -> Traversal' Headers ByteString
forall a.
HasHeaders a =>
TransferEncodingName -> Traversal' a ByteString
header TransferEncodingName
"MIME-Version") Headers
h = Parser MIME -> BodyHandler MIME
forall a. Parser a -> BodyHandler a
RequiredBody (ByteString -> MIME
Part (ByteString -> MIME) -> Parser ByteString -> Parser MIME
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 = Parser MIME -> BodyHandler MIME
forall a. Parser a -> BodyHandler a
RequiredBody (Parser MIME -> BodyHandler MIME)
-> Parser MIME -> BodyHandler MIME
forall a b. (a -> b) -> a -> b
$ case ((ContentType -> Const ContentType ContentType)
-> Headers -> Const ContentType Headers)
-> Headers -> ContentType
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view (ContentType -> Const ContentType ContentType)
-> Headers -> Const ContentType Headers
forall a. HasHeaders a => Lens' a ContentType
contentType Headers
h of
ContentType
ct | Getting TransferEncodingName ContentType TransferEncodingName
-> ContentType -> TransferEncodingName
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting TransferEncodingName ContentType TransferEncodingName
Lens' ContentType TransferEncodingName
ctType ContentType
ct TransferEncodingName -> TransferEncodingName -> Bool
forall a. Eq a => a -> a -> Bool
== TransferEncodingName
"multipart" ->
case ContentType -> Either MIMEParseError (MultipartSubtype, Boundary)
prepMultipart ContentType
ct of
Left MIMEParseError
err -> MIMEParseError -> ByteString -> MIME
FailedParse MIMEParseError
err (ByteString -> MIME) -> Parser ByteString -> Parser MIME
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 (NonEmpty MIMEMessage -> MIME)
-> Parser ByteString (NonEmpty MIMEMessage) -> Parser MIME
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString
-> Boundary -> Parser ByteString (NonEmpty MIMEMessage)
multipart Parser ByteString
takeTillEnd Boundary
boundary
Parser MIME -> Parser MIME -> Parser MIME
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> MIMEParseError -> ByteString -> MIME
FailedParse MIMEParseError
MultipartParseFail (ByteString -> MIME) -> Parser ByteString -> Parser MIME
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString
takeTillEnd
| TransferEncodingName
-> Maybe TransferEncodingName -> ContentType -> Bool
matchContentType TransferEncodingName
"message" (TransferEncodingName -> Maybe TransferEncodingName
forall a. a -> Maybe a
Just TransferEncodingName
"rfc822") ContentType
ct ->
(MIMEMessage -> MIME
Encapsulated (MIMEMessage -> MIME)
-> Parser ByteString MIMEMessage -> Parser MIME
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Headers -> BodyHandler MIME)
-> Parser (Message (MessageContext MIME) MIME)
forall a.
(Headers -> BodyHandler a) -> Parser (Message (MessageContext a) a)
message (Parser ByteString -> Headers -> BodyHandler MIME
mime' Parser ByteString
takeTillEnd))
Parser MIME -> Parser MIME -> Parser MIME
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (MIMEParseError -> ByteString -> MIME
FailedParse MIMEParseError
EncapsulatedMessageParseFail (ByteString -> MIME) -> Parser ByteString -> Parser MIME
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString
takeTillEnd)
ContentType
_ -> ByteString -> MIME
Part (ByteString -> MIME) -> Parser ByteString -> Parser MIME
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString
takeTillEnd
where
prepMultipart :: ContentType -> Either MIMEParseError (MultipartSubtype, Boundary)
prepMultipart ContentType
ct =
(,) (MultipartSubtype -> Boundary -> (MultipartSubtype, Boundary))
-> Either MIMEParseError MultipartSubtype
-> Either MIMEParseError (Boundary -> (MultipartSubtype, Boundary))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ContentType -> Either MIMEParseError MultipartSubtype
parseSubtype ContentType
ct Either MIMEParseError (Boundary -> (MultipartSubtype, Boundary))
-> Either MIMEParseError Boundary
-> Either MIMEParseError (MultipartSubtype, Boundary)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ContentType -> Either MIMEParseError Boundary
forall s. HasParameters s => s -> Either MIMEParseError Boundary
parseBoundary ContentType
ct
parseBoundary :: s -> Either MIMEParseError Boundary
parseBoundary s
ct =
TransferEncodingName -> s -> Either MIMEParseError ByteString
forall s.
HasParameters s =>
TransferEncodingName -> s -> Either MIMEParseError ByteString
getRequiredParam TransferEncodingName
"boundary" s
ct
Either MIMEParseError ByteString
-> (ByteString -> Either MIMEParseError Boundary)
-> Either MIMEParseError Boundary
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ASetter
(Either ByteString Boundary)
(Either MIMEParseError Boundary)
ByteString
MIMEParseError
-> (ByteString -> MIMEParseError)
-> Either ByteString Boundary
-> Either MIMEParseError Boundary
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter
(Either ByteString Boundary)
(Either MIMEParseError Boundary)
ByteString
MIMEParseError
forall a c b. Prism (Either a c) (Either b c) a b
_Left (TransferEncodingName -> ByteString -> MIMEParseError
InvalidParameterValue TransferEncodingName
"boundary") (Either ByteString Boundary -> Either MIMEParseError Boundary)
-> (ByteString -> Either ByteString Boundary)
-> ByteString
-> Either MIMEParseError Boundary
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Either ByteString Boundary
makeBoundary
getRequiredParam :: TransferEncodingName -> s -> Either MIMEParseError ByteString
getRequiredParam TransferEncodingName
k =
Either MIMEParseError ByteString
-> (ByteString -> Either MIMEParseError ByteString)
-> Maybe ByteString
-> Either MIMEParseError ByteString
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (MIMEParseError -> Either MIMEParseError ByteString
forall a b. a -> Either a b
Left (MIMEParseError -> Either MIMEParseError ByteString)
-> MIMEParseError -> Either MIMEParseError ByteString
forall a b. (a -> b) -> a -> b
$ TransferEncodingName -> MIMEParseError
RequiredParameterMissing TransferEncodingName
k) ByteString -> Either MIMEParseError ByteString
forall a b. b -> Either a b
Right (Maybe ByteString -> Either MIMEParseError ByteString)
-> (s -> Maybe ByteString) -> s -> Either MIMEParseError ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting (First ByteString) s ByteString -> s -> Maybe ByteString
forall s (m :: * -> *) a.
MonadReader s m =>
Getting (First a) s a -> m (Maybe a)
preview (TransferEncodingName -> Traversal' s ByteString
forall a.
HasParameters a =>
TransferEncodingName -> Traversal' a ByteString
rawParameter TransferEncodingName
k)
getOptionalParam :: TransferEncodingName -> s -> Either a (Maybe ByteString)
getOptionalParam TransferEncodingName
k =
Maybe ByteString -> Either a (Maybe ByteString)
forall a b. b -> Either a b
Right (Maybe ByteString -> Either a (Maybe ByteString))
-> (s -> Maybe ByteString) -> s -> Either a (Maybe ByteString)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting (First ByteString) s ByteString -> s -> Maybe ByteString
forall s (m :: * -> *) a.
MonadReader s m =>
Getting (First a) s a -> m (Maybe a)
preview (TransferEncodingName -> Traversal' s ByteString
forall a.
HasParameters a =>
TransferEncodingName -> Traversal' a ByteString
rawParameter TransferEncodingName
k)
parseSubtype :: ContentType -> Either MIMEParseError MultipartSubtype
parseSubtype ContentType
ct = case Getting TransferEncodingName ContentType TransferEncodingName
-> ContentType -> TransferEncodingName
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting TransferEncodingName ContentType TransferEncodingName
Lens' ContentType TransferEncodingName
ctSubtype ContentType
ct of
TransferEncodingName
"mixed" -> MultipartSubtype -> Either MIMEParseError MultipartSubtype
forall (f :: * -> *) a. Applicative f => a -> f a
pure MultipartSubtype
Mixed
TransferEncodingName
"alternative" -> MultipartSubtype -> Either MIMEParseError MultipartSubtype
forall (f :: * -> *) a. Applicative f => a -> f a
pure MultipartSubtype
Alternative
TransferEncodingName
"digest" -> MultipartSubtype -> Either MIMEParseError MultipartSubtype
forall (f :: * -> *) a. Applicative f => a -> f a
pure MultipartSubtype
Digest
TransferEncodingName
"parallel" -> MultipartSubtype -> Either MIMEParseError MultipartSubtype
forall (f :: * -> *) a. Applicative f => a -> f a
pure MultipartSubtype
Parallel
TransferEncodingName
"multilingual" -> MultipartSubtype -> Either MIMEParseError MultipartSubtype
forall (f :: * -> *) a. Applicative f => a -> f a
pure MultipartSubtype
Multilingual
TransferEncodingName
"report" -> ByteString -> MultipartSubtype
Report (ByteString -> MultipartSubtype)
-> Either MIMEParseError ByteString
-> Either MIMEParseError MultipartSubtype
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TransferEncodingName
-> ContentType -> Either MIMEParseError ByteString
forall s.
HasParameters s =>
TransferEncodingName -> s -> Either MIMEParseError ByteString
getRequiredParam TransferEncodingName
"report-type" ContentType
ct
TransferEncodingName
"signed" -> ByteString -> ByteString -> MultipartSubtype
Signed
(ByteString -> ByteString -> MultipartSubtype)
-> Either MIMEParseError ByteString
-> Either MIMEParseError (ByteString -> MultipartSubtype)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TransferEncodingName
-> ContentType -> Either MIMEParseError ByteString
forall s.
HasParameters s =>
TransferEncodingName -> s -> Either MIMEParseError ByteString
getRequiredParam TransferEncodingName
"protocol" ContentType
ct
Either MIMEParseError (ByteString -> MultipartSubtype)
-> Either MIMEParseError ByteString
-> Either MIMEParseError MultipartSubtype
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> TransferEncodingName
-> ContentType -> Either MIMEParseError ByteString
forall s.
HasParameters s =>
TransferEncodingName -> s -> Either MIMEParseError ByteString
getRequiredParam TransferEncodingName
"micalg" ContentType
ct
TransferEncodingName
"encrypted" -> ByteString -> MultipartSubtype
Encrypted (ByteString -> MultipartSubtype)
-> Either MIMEParseError ByteString
-> Either MIMEParseError MultipartSubtype
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TransferEncodingName
-> ContentType -> Either MIMEParseError ByteString
forall s.
HasParameters s =>
TransferEncodingName -> s -> Either MIMEParseError ByteString
getRequiredParam TransferEncodingName
"protocol" ContentType
ct
TransferEncodingName
"related" -> ContentType
-> Maybe ByteString -> Maybe ByteString -> MultipartSubtype
Related
(ContentType
-> Maybe ByteString -> Maybe ByteString -> MultipartSubtype)
-> Either MIMEParseError ContentType
-> Either
MIMEParseError
(Maybe ByteString -> Maybe ByteString -> MultipartSubtype)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ( TransferEncodingName
-> ContentType -> Either MIMEParseError ByteString
forall s.
HasParameters s =>
TransferEncodingName -> s -> Either MIMEParseError ByteString
getRequiredParam TransferEncodingName
"type" ContentType
ct
Either MIMEParseError ByteString
-> (ByteString -> Either MIMEParseError ContentType)
-> Either MIMEParseError ContentType
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \ByteString
s -> Either MIMEParseError ContentType
-> (ContentType -> Either MIMEParseError ContentType)
-> Maybe ContentType
-> Either MIMEParseError ContentType
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (MIMEParseError -> Either MIMEParseError ContentType
forall a b. a -> Either a b
Left (MIMEParseError -> Either MIMEParseError ContentType)
-> MIMEParseError -> Either MIMEParseError ContentType
forall a b. (a -> b) -> a -> b
$ TransferEncodingName -> ByteString -> MIMEParseError
InvalidParameterValue TransferEncodingName
"type" ByteString
s) ContentType -> Either MIMEParseError ContentType
forall a b. b -> Either a b
Right
(((ContentType -> Const (First ContentType) ContentType)
-> ByteString -> Const (First ContentType) ByteString)
-> ByteString -> Maybe ContentType
forall s (m :: * -> *) a.
MonadReader s m =>
Getting (First a) s a -> m (Maybe a)
preview (Parser ContentType -> Fold ByteString ContentType
forall s a. Cons s s Word8 Word8 => Parser a -> Fold s a
parsed Parser ContentType
parseContentType) ByteString
s)
)
Either
MIMEParseError
(Maybe ByteString -> Maybe ByteString -> MultipartSubtype)
-> Either MIMEParseError (Maybe ByteString)
-> Either MIMEParseError (Maybe ByteString -> MultipartSubtype)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> TransferEncodingName
-> ContentType -> Either MIMEParseError (Maybe ByteString)
forall s a.
HasParameters s =>
TransferEncodingName -> s -> Either a (Maybe ByteString)
getOptionalParam TransferEncodingName
"start" ContentType
ct
Either MIMEParseError (Maybe ByteString -> MultipartSubtype)
-> Either MIMEParseError (Maybe ByteString)
-> Either MIMEParseError MultipartSubtype
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> TransferEncodingName
-> ContentType -> Either MIMEParseError (Maybe ByteString)
forall s a.
HasParameters s =>
TransferEncodingName -> s -> Either a (Maybe ByteString)
getOptionalParam TransferEncodingName
"start-info" ContentType
ct
TransferEncodingName
unrecognised -> MultipartSubtype -> Either MIMEParseError MultipartSubtype
forall (f :: * -> *) a. Applicative f => a -> f a
pure (MultipartSubtype -> Either MIMEParseError MultipartSubtype)
-> MultipartSubtype -> Either MIMEParseError MultipartSubtype
forall a b. (a -> b) -> a -> b
$ TransferEncodingName -> MultipartSubtype
Unrecognised TransferEncodingName
unrecognised
data MIMEParseError
= RequiredParameterMissing (CI B.ByteString)
| InvalidParameterValue (CI B.ByteString) B.ByteString
| MultipartParseFail
| EncapsulatedMessageParseFail
deriving (MIMEParseError -> MIMEParseError -> Bool
(MIMEParseError -> MIMEParseError -> Bool)
-> (MIMEParseError -> MIMEParseError -> Bool) -> Eq MIMEParseError
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 -> String
(Int -> MIMEParseError -> ShowS)
-> (MIMEParseError -> String)
-> ([MIMEParseError] -> ShowS)
-> Show MIMEParseError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MIMEParseError] -> ShowS
$cshowList :: [MIMEParseError] -> ShowS
show :: MIMEParseError -> String
$cshow :: MIMEParseError -> String
showsPrec :: Int -> MIMEParseError -> ShowS
$cshowsPrec :: Int -> MIMEParseError -> ShowS
Show)
multipart
:: Parser B.ByteString
-> Boundary
-> Parser (NonEmpty MIMEMessage)
multipart :: Parser ByteString
-> Boundary -> Parser ByteString (NonEmpty MIMEMessage)
multipart Parser ByteString
takeTillEnd Boundary
boundary =
ByteString -> Parser ByteString ()
skipTillString ByteString
dashBoundary Parser ByteString ()
-> Parser ByteString () -> Parser ByteString ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ByteString ()
forall (f :: * -> * -> *) s a.
(Alternative (f s), CharParsing f s a) =>
f s ()
crlf
Parser ByteString ()
-> Parser ByteString (NonEmpty MIMEMessage)
-> Parser ByteString (NonEmpty MIMEMessage)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ([MIMEMessage] -> NonEmpty MIMEMessage)
-> Parser ByteString [MIMEMessage]
-> Parser ByteString (NonEmpty MIMEMessage)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [MIMEMessage] -> NonEmpty MIMEMessage
forall a. [a] -> NonEmpty a
fromList (Parser (Message (MessageContext MIME) MIME)
Parser ByteString MIMEMessage
part Parser ByteString MIMEMessage
-> Parser ByteString () -> Parser ByteString [MIMEMessage]
forall (f :: * -> *) a s. Alternative f => f a -> f s -> f [a]
`sepBy1` Parser ByteString ()
forall (f :: * -> * -> *) s a.
(Alternative (f s), CharParsing f s a) =>
f s ()
crlf)
Parser ByteString (NonEmpty MIMEMessage)
-> Parser ByteString -> Parser ByteString (NonEmpty MIMEMessage)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ByteString -> Parser ByteString
string ByteString
"--" Parser ByteString (NonEmpty MIMEMessage)
-> Parser ByteString -> Parser ByteString (NonEmpty MIMEMessage)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ByteString
takeTillEnd
where
delimiter :: ByteString
delimiter = ByteString
"\n--" ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> Boundary -> ByteString
unBoundary Boundary
boundary
dashBoundary :: ByteString
dashBoundary = ByteString -> ByteString
B.tail ByteString
delimiter
part :: Parser (Message (MessageContext MIME) MIME)
part = (Headers -> BodyHandler MIME)
-> Parser (Message (MessageContext MIME) MIME)
forall a.
(Headers -> BodyHandler a) -> Parser (Message (MessageContext a) a)
message (Parser ByteString -> Headers -> BodyHandler MIME
mime' (ByteString -> ByteString
trim (ByteString -> ByteString)
-> Parser ByteString -> Parser ByteString
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 Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\r' = 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
Headers -> (Headers -> Headers) -> Headers
forall a b. a -> (a -> b) -> b
& ASetter Headers Headers (Maybe ByteString) (Maybe ByteString)
-> Maybe ByteString -> Headers -> Headers
forall s t a b. ASetter s t a b -> b -> s -> t
set ((Headers -> Identity Headers) -> Headers -> Identity Headers
forall a. HasHeaders a => Lens' a Headers
headers ((Headers -> Identity Headers) -> Headers -> Identity Headers)
-> ASetter Headers Headers (Maybe ByteString) (Maybe ByteString)
-> ASetter Headers Headers (Maybe ByteString) (Maybe ByteString)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index Headers -> Lens' Headers (Maybe (IxValue Headers))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Index Headers
"MIME-Version") (ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just ByteString
"1.0")
Headers -> (Headers -> Headers) -> Headers
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
_ -> ((ContentType -> Identity ContentType)
-> Headers -> Identity Headers)
-> ContentType -> Headers -> Headers
forall s t a b. ASetter s t a b -> b -> s -> t
set (ContentType -> Identity ContentType)
-> Headers -> Identity Headers
forall a. HasHeaders a => Lens' a ContentType
contentType (MultipartSubtype -> Boundary -> ContentType
contentTypeMultipart MultipartSubtype
sub Boundary
boundary)
Encapsulated MIMEMessage
_msg -> ((ContentType -> Identity ContentType)
-> Headers -> Identity Headers)
-> ContentType -> Headers -> Headers
forall s t a b. ASetter s t a b -> b -> s -> t
set (ContentType -> Identity ContentType)
-> Headers -> Identity Headers
forall a. HasHeaders a => Lens' a ContentType
contentType ContentType
"message/rfc822"
MIME
_ -> Headers -> Headers
forall a. a -> a
id
buildBody :: Headers -> MIME -> Maybe Builder
buildBody Headers
_h MIME
z = Builder -> Maybe Builder
forall a. a -> Maybe a
Just (Builder -> Maybe Builder) -> Builder -> Maybe Builder
forall a b. (a -> b) -> a -> b
$ case MIME
z of
Part ByteString
partbody -> ByteString -> Builder
Builder.byteString ByteString
partbody
Encapsulated MIMEMessage
msg -> MIMEMessage -> Builder
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
"--" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ByteString -> Builder
Builder.byteString (Boundary -> ByteString
unBoundary Boundary
b)
in
Builder
boundary Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
"\r\n"
Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> NonEmpty Builder -> Builder
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold (Builder -> NonEmpty Builder -> NonEmpty Builder
forall a. a -> NonEmpty a -> NonEmpty a
intersperse (Builder
"\r\n" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
boundary Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
"\r\n") ((MIMEMessage -> Builder)
-> NonEmpty MIMEMessage -> NonEmpty Builder
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap MIMEMessage -> Builder
forall ctx a. RenderMessage a => Message ctx a -> Builder
buildMessage NonEmpty MIMEMessage
xs))
Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
"\r\n" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
boundary Builder -> Builder -> Builder
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 = [(TransferEncodingName, ByteString)] -> Headers
Headers [] Headers -> (Headers -> Headers) -> Headers
forall a b. a -> (a -> b) -> b
& ((ContentType -> Identity ContentType)
-> Headers -> Identity Headers)
-> ContentType -> Headers -> Headers
forall s t a b. ASetter s t a b -> b -> s -> t
set (ContentType -> Identity ContentType)
-> Headers -> Identity Headers
forall a. HasHeaders a => Lens' a ContentType
contentType (Boundary -> ContentType
contentTypeMultipartMixed Boundary
b)
in Headers -> MIME -> MIMEMessage
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 = Text -> Message Any () -> MIMEMessage
forall ctx a. Text -> Message ctx a -> MIMEMessage
setTextPlainBody Text
s (Headers -> () -> Message Any ()
forall s a. Headers -> a -> Message s a
Message ([(TransferEncodingName, ByteString)] -> Headers
Headers []) ())
setTextPlainBody :: T.Text -> Message ctx a -> MIMEMessage
setTextPlainBody :: Text -> Message ctx a -> MIMEMessage
setTextPlainBody Text
s =
(ByteString -> MIME) -> WireEntity -> MIMEMessage
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ByteString -> MIME
Part
(WireEntity -> MIMEMessage)
-> (Message ctx a -> WireEntity) -> Message ctx a -> MIMEMessage
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Message EncStateByte ByteString -> WireEntity
forall a. HasTransferEncoding a => TransferDecoded a -> a
transferEncode
(Message EncStateByte ByteString -> WireEntity)
-> (Message ctx a -> Message EncStateByte ByteString)
-> Message ctx a
-> WireEntity
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Message () Text -> Message EncStateByte ByteString
forall a. HasCharset a => Decoded a -> a
charsetEncode
(Message () Text -> Message EncStateByte ByteString)
-> (Message ctx a -> Message () Text)
-> Message ctx a
-> Message EncStateByte ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ASetter
(Message () Text)
(Message () Text)
(Maybe ContentDisposition)
(Maybe ContentDisposition)
-> Maybe ContentDisposition -> Message () Text -> Message () Text
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter
(Message () Text)
(Message () Text)
(Maybe ContentDisposition)
(Maybe ContentDisposition)
forall a. HasHeaders a => Lens' a (Maybe ContentDisposition)
contentDisposition (ContentDisposition -> Maybe ContentDisposition
forall a. a -> Maybe a
Just (ContentDisposition -> Maybe ContentDisposition)
-> ContentDisposition -> Maybe ContentDisposition
forall a b. (a -> b) -> a -> b
$ DispositionType -> Parameters -> ContentDisposition
ContentDisposition DispositionType
Inline Parameters
forall a. Monoid a => a
mempty)
(Message () Text -> Message () Text)
-> (Message ctx a -> Message () Text)
-> Message ctx a
-> Message () Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ASetter (Message () Text) (Message () Text) ContentType ContentType
-> ContentType -> Message () Text -> Message () Text
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter (Message () Text) (Message () Text) ContentType ContentType
forall a. HasHeaders a => Lens' a ContentType
contentType ContentType
contentTypeTextPlain
(Message () Text -> Message () Text)
-> (Message ctx a -> Message () Text)
-> Message ctx a
-> Message () Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ASetter (Message ctx a) (Message () Text) a Text
-> Text -> Message ctx a -> Message () Text
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter (Message ctx a) (Message () Text) a Text
forall ctx a ctx' b. Lens (Message ctx a) (Message ctx' b) a b
body Text
s
createAttachmentFromFile :: ContentType -> FilePath -> IO MIMEMessage
createAttachmentFromFile :: ContentType -> String -> IO MIMEMessage
createAttachmentFromFile ContentType
ct String
fp = ContentType -> Maybe String -> ByteString -> MIMEMessage
createAttachment ContentType
ct (String -> Maybe String
forall a. a -> Maybe a
Just String
fp) (ByteString -> MIMEMessage) -> IO ByteString -> IO MIMEMessage
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO ByteString
B.readFile String
fp
createAttachment :: ContentType -> Maybe FilePath -> B.ByteString -> MIMEMessage
createAttachment :: ContentType -> Maybe String -> ByteString -> MIMEMessage
createAttachment ContentType
ct Maybe String
fp ByteString
s = ByteString -> MIME
Part (ByteString -> MIME) -> WireEntity -> MIMEMessage
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TransferDecoded WireEntity -> WireEntity
forall a. HasTransferEncoding a => TransferDecoded a -> a
transferEncode TransferDecoded WireEntity
Message EncStateByte ByteString
msg
where
msg :: Message EncStateByte ByteString
msg = Headers -> ByteString -> Message EncStateByte ByteString
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 = Parameters
forall a. Monoid a => a
mempty Parameters -> (Parameters -> Parameters) -> Parameters
forall a b. a -> (a -> b) -> b
& ASetter
Parameters
Parameters
(Maybe EncodedParameterValue)
(Maybe EncodedParameterValue)
-> Maybe EncodedParameterValue -> Parameters -> Parameters
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter
Parameters
Parameters
(Maybe EncodedParameterValue)
(Maybe EncodedParameterValue)
forall a. HasParameters a => Lens' a (Maybe EncodedParameterValue)
filenameParameter (String -> EncodedParameterValue
forall s. Cons s s Char Char => s -> EncodedParameterValue
newParameter (String -> EncodedParameterValue)
-> Maybe String -> Maybe EncodedParameterValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe String
fp)
hdrs :: Headers
hdrs = [(TransferEncodingName, ByteString)] -> Headers
Headers []
Headers -> (Headers -> Headers) -> Headers
forall a b. a -> (a -> b) -> b
& ((ContentType -> Identity ContentType)
-> Headers -> Identity Headers)
-> ContentType -> Headers -> Headers
forall s t a b. ASetter s t a b -> b -> s -> t
set (ContentType -> Identity ContentType)
-> Headers -> Identity Headers
forall a. HasHeaders a => Lens' a ContentType
contentType ContentType
ct
Headers -> (Headers -> Headers) -> Headers
forall a b. a -> (a -> b) -> b
& ASetter
Headers
Headers
(Maybe ContentDisposition)
(Maybe ContentDisposition)
-> Maybe ContentDisposition -> Headers -> Headers
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter
Headers
Headers
(Maybe ContentDisposition)
(Maybe ContentDisposition)
forall a. HasHeaders a => Lens' a (Maybe ContentDisposition)
contentDisposition (ContentDisposition -> Maybe ContentDisposition
forall a. a -> Maybe a
Just ContentDisposition
cd)
encapsulate :: MIMEMessage -> MIMEMessage
encapsulate :: MIMEMessage -> MIMEMessage
encapsulate = Headers -> MIME -> MIMEMessage
forall s a. Headers -> a -> Message s a
Message Headers
hdrs (MIME -> MIMEMessage)
-> (MIMEMessage -> MIME) -> MIMEMessage -> MIMEMessage
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MIMEMessage -> MIME
Encapsulated
where
hdrs :: Headers
hdrs = [(TransferEncodingName, ByteString)] -> Headers
Headers [] Headers -> (Headers -> Headers) -> Headers
forall a b. a -> (a -> b) -> b
& ((ContentType -> Identity ContentType)
-> Headers -> Identity Headers)
-> ContentType -> Headers -> Headers
forall s t a b. ASetter s t a b -> b -> s -> t
set (ContentType -> Identity ContentType)
-> Headers -> Identity Headers
forall a. HasHeaders a => Lens' a ContentType
contentType ContentType
"message/rfc822"