{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE DefaultSignatures #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE TypeFamilies #-}
module Data.IMF
(
Message(..)
, message
, MessageContext
, BodyHandler(..)
, body
, EqMessage(..)
, reply
, ReplySettings(ReplySettings)
, defaultReplySettings
, ReplyMode(..)
, ReplyFromMode(..)
, ReplyFromRewriteMode(..)
, SelfInRecipientsMode(..)
, AuthorMailboxes
, replyMode
, replyFromMode
, replyFromRewriteMode
, selfInRecipientsMode
, authorMailboxes
, Header
, HasHeaders(..)
, headerList
, Headers(..)
, headerDate
, dateTime
, headerFrom
, headerReplyTo
, headerTo
, headerCC
, headerBCC
, headerMessageID
, headerInReplyTo
, headerReferences
, headerSubject
, header
, headerText
, MessageID
, parseMessageID
, buildMessageID
, renderMessageID
, Address(..)
, address
, addressList
, AddrSpec(..)
, Domain(..)
, Mailbox(..)
, mailbox
, mailboxList
, parse
, parsed
, parsePrint
, crlf
, quotedString
, field
, buildMessage
, renderMessage
, RenderMessage(..)
, renderRFC5322Date
, buildFields
, buildField
, renderAddressSpec
, renderMailbox
, renderMailboxes
, renderAddress
, renderAddresses
) where
import Control.Applicative
import Data.Either (fromRight)
import Data.Foldable (fold, toList)
import Data.Function (on)
import Data.List (find, findIndex, intersperse)
import Data.List.NonEmpty (NonEmpty, head, intersperse)
import Data.Maybe (fromMaybe, isJust, isNothing, mapMaybe)
import Data.Monoid (First(..))
import Data.String (IsString(..))
import Data.Word (Word8)
import GHC.Generics (Generic)
import Control.DeepSeq (NFData)
import Control.Lens
import Control.Lens.Cons.Extras (recons)
import Data.Attoparsec.ByteString as A hiding (parse, take)
import Data.Attoparsec.ByteString.Char8 (char8)
import qualified Data.Attoparsec.ByteString.Lazy as AL
import qualified Data.ByteString as B
import qualified Data.ByteString.Lazy as L
import qualified Data.ByteString.Char8 as Char8
import qualified Data.ByteString.Builder as Builder
import qualified Data.ByteString.Builder.Prim as Prim
import qualified Data.Text as T
import qualified Data.Text.Encoding as T
import Data.Time (ZonedTime, defaultTimeLocale, formatTime)
import Data.IMF.Syntax
( CI, ci, mk, original
, (<<>>), foldMany, foldMany1Sep
, char, fromChar, isAtext, isQtext, isVchar, isWsp
, optionalCFWS, word, wsp, vchar, optionalFWS, crlf
, domainLiteral, dotAtom, dotAtomText, localPart, quotedString
)
import {-# SOURCE #-} Data.IMF.Text (readMailbox)
import Data.IMF.DateTime (dateTime)
import Data.MIME.Charset
import Data.MIME.EncodedWord
import Data.MIME.TransferEncoding (transferEncode)
type = (CI B.ByteString, B.ByteString)
newtype = [Header]
deriving (Headers -> Headers -> Bool
(Headers -> Headers -> Bool)
-> (Headers -> Headers -> Bool) -> Eq Headers
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Headers -> Headers -> Bool
$c/= :: Headers -> Headers -> Bool
== :: Headers -> Headers -> Bool
$c== :: Headers -> Headers -> Bool
Eq, Int -> Headers -> ShowS
[Headers] -> ShowS
Headers -> String
(Int -> Headers -> ShowS)
-> (Headers -> String) -> ([Headers] -> ShowS) -> Show Headers
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Headers] -> ShowS
$cshowList :: [Headers] -> ShowS
show :: Headers -> String
$cshow :: Headers -> String
showsPrec :: Int -> Headers -> ShowS
$cshowsPrec :: Int -> Headers -> ShowS
Show, (forall x. Headers -> Rep Headers x)
-> (forall x. Rep Headers x -> Headers) -> Generic Headers
forall x. Rep Headers x -> Headers
forall x. Headers -> Rep Headers x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Headers x -> Headers
$cfrom :: forall x. Headers -> Rep Headers x
Generic, Headers -> ()
(Headers -> ()) -> NFData Headers
forall a. (a -> ()) -> NFData a
rnf :: Headers -> ()
$crnf :: Headers -> ()
NFData)
class a where
:: Lens' a Headers
instance HasHeaders Headers where
headers :: (Headers -> f Headers) -> Headers -> f Headers
headers = (Headers -> f Headers) -> Headers -> f Headers
forall a. a -> a
id
type instance Index Headers = CI B.ByteString
type instance IxValue Headers = B.ByteString
instance Ixed Headers where
ix :: Index Headers -> Traversal' Headers (IxValue Headers)
ix = Index Headers
-> (IxValue Headers -> f (IxValue Headers)) -> Headers -> f Headers
forall a. HasHeaders a => CI ByteString -> Traversal' a ByteString
header
hdriso :: Iso' Headers [(CI B.ByteString, B.ByteString)]
hdriso :: p [(CI ByteString, ByteString)] (f [(CI ByteString, ByteString)])
-> p Headers (f Headers)
hdriso = (Headers -> [(CI ByteString, ByteString)])
-> ([(CI ByteString, ByteString)] -> Headers)
-> Iso
Headers
Headers
[(CI ByteString, ByteString)]
[(CI ByteString, ByteString)]
forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso (\(Headers [(CI ByteString, ByteString)]
xs) -> [(CI ByteString, ByteString)]
xs) [(CI ByteString, ByteString)] -> Headers
Headers
instance At Headers where
at :: Index Headers -> Lens' Headers (Maybe (IxValue Headers))
at Index Headers
k = ([(CI ByteString, ByteString)] -> f [(CI ByteString, ByteString)])
-> Headers -> f Headers
Iso
Headers
Headers
[(CI ByteString, ByteString)]
[(CI ByteString, ByteString)]
hdriso (([(CI ByteString, ByteString)] -> f [(CI ByteString, ByteString)])
-> Headers -> f Headers)
-> ((Maybe ByteString -> f (Maybe ByteString))
-> [(CI ByteString, ByteString)]
-> f [(CI ByteString, ByteString)])
-> (Maybe ByteString -> f (Maybe ByteString))
-> Headers
-> f Headers
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe ByteString -> f (Maybe ByteString))
-> [(CI ByteString, ByteString)] -> f [(CI ByteString, ByteString)]
Lens' [(CI ByteString, ByteString)] (Maybe ByteString)
l
where
l :: Lens' [(CI B.ByteString, B.ByteString)] (Maybe B.ByteString)
l :: (Maybe ByteString -> f (Maybe ByteString))
-> [(CI ByteString, ByteString)] -> f [(CI ByteString, ByteString)]
l Maybe ByteString -> f (Maybe ByteString)
f [(CI ByteString, ByteString)]
kv =
let
i :: Maybe Int
i = ((CI ByteString, ByteString) -> Bool)
-> [(CI ByteString, ByteString)] -> Maybe Int
forall a. (a -> Bool) -> [a] -> Maybe Int
findIndex ((CI ByteString -> CI ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== CI ByteString
Index Headers
k) (CI ByteString -> Bool)
-> ((CI ByteString, ByteString) -> CI ByteString)
-> (CI ByteString, ByteString)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CI ByteString, ByteString) -> CI ByteString
forall a b. (a, b) -> a
fst) [(CI ByteString, ByteString)]
kv
g :: Maybe ByteString -> [(CI ByteString, ByteString)]
g Maybe ByteString
Nothing = [(CI ByteString, ByteString)]
-> (Int -> [(CI ByteString, ByteString)])
-> Maybe Int
-> [(CI ByteString, ByteString)]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [(CI ByteString, ByteString)]
kv (\Int
j -> Int
-> [(CI ByteString, ByteString)] -> [(CI ByteString, ByteString)]
forall a. Int -> [a] -> [a]
take Int
j [(CI ByteString, ByteString)]
kv [(CI ByteString, ByteString)]
-> [(CI ByteString, ByteString)] -> [(CI ByteString, ByteString)]
forall a. Semigroup a => a -> a -> a
<> Int
-> [(CI ByteString, ByteString)] -> [(CI ByteString, ByteString)]
forall a. Int -> [a] -> [a]
drop (Int
j Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) [(CI ByteString, ByteString)]
kv) Maybe Int
i
g (Just ByteString
v) = [(CI ByteString, ByteString)]
-> (Int -> [(CI ByteString, ByteString)])
-> Maybe Int
-> [(CI ByteString, ByteString)]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ((CI ByteString
Index Headers
k,ByteString
v)(CI ByteString, ByteString)
-> [(CI ByteString, ByteString)] -> [(CI ByteString, ByteString)]
forall a. a -> [a] -> [a]
:[(CI ByteString, ByteString)]
kv) (\Int
j -> ASetter
[(CI ByteString, ByteString)]
[(CI ByteString, ByteString)]
(CI ByteString, ByteString)
(CI ByteString, ByteString)
-> (CI ByteString, ByteString)
-> [(CI ByteString, ByteString)]
-> [(CI ByteString, ByteString)]
forall s t a b. ASetter s t a b -> b -> s -> t
set (Index [(CI ByteString, ByteString)]
-> Traversal'
[(CI ByteString, ByteString)]
(IxValue [(CI ByteString, ByteString)])
forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix Int
Index [(CI ByteString, ByteString)]
j) (CI ByteString
Index Headers
k,ByteString
v) [(CI ByteString, ByteString)]
kv) Maybe Int
i
in
Maybe ByteString -> [(CI ByteString, ByteString)]
g (Maybe ByteString -> [(CI ByteString, ByteString)])
-> f (Maybe ByteString) -> f [(CI ByteString, ByteString)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe ByteString -> f (Maybe ByteString)
f (CI ByteString -> [(CI ByteString, ByteString)] -> Maybe ByteString
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup CI ByteString
Index Headers
k [(CI ByteString, ByteString)]
kv)
header :: HasHeaders a => CI B.ByteString -> Traversal' a B.ByteString
CI ByteString
k = ([(CI ByteString, ByteString)] -> f [(CI ByteString, ByteString)])
-> a -> f a
forall a. HasHeaders a => Lens' a [(CI ByteString, ByteString)]
headerList (([(CI ByteString, ByteString)] -> f [(CI ByteString, ByteString)])
-> a -> f a)
-> ((ByteString -> f ByteString)
-> [(CI ByteString, ByteString)]
-> f [(CI ByteString, ByteString)])
-> (ByteString -> f ByteString)
-> a
-> f a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((CI ByteString, ByteString) -> f (CI ByteString, ByteString))
-> [(CI ByteString, ByteString)] -> f [(CI ByteString, ByteString)]
forall (f :: * -> *) a b.
Traversable f =>
IndexedTraversal Int (f a) (f b) a b
traversed (((CI ByteString, ByteString) -> f (CI ByteString, ByteString))
-> [(CI ByteString, ByteString)]
-> f [(CI ByteString, ByteString)])
-> ((ByteString -> f ByteString)
-> (CI ByteString, ByteString) -> f (CI ByteString, ByteString))
-> (ByteString -> f ByteString)
-> [(CI ByteString, ByteString)]
-> f [(CI ByteString, ByteString)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((CI ByteString, ByteString) -> Bool)
-> Optic'
(->) f (CI ByteString, ByteString) (CI ByteString, ByteString)
forall (p :: * -> * -> *) (f :: * -> *) a.
(Choice p, Applicative f) =>
(a -> Bool) -> Optic' p f a a
filtered ((CI ByteString
k CI ByteString -> CI ByteString -> Bool
forall a. Eq a => a -> a -> Bool
==) (CI ByteString -> Bool)
-> ((CI ByteString, ByteString) -> CI ByteString)
-> (CI ByteString, ByteString)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CI ByteString, ByteString) -> CI ByteString
forall a b. (a, b) -> a
fst) Optic'
(->) f (CI ByteString, ByteString) (CI ByteString, ByteString)
-> ((ByteString -> f ByteString)
-> (CI ByteString, ByteString) -> f (CI ByteString, ByteString))
-> (ByteString -> f ByteString)
-> (CI ByteString, ByteString)
-> f (CI ByteString, ByteString)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ByteString -> f ByteString)
-> (CI ByteString, ByteString) -> f (CI ByteString, ByteString)
forall s t a b. Field2 s t a b => Lens s t a b
_2
data Message s a = Message Headers a
deriving (Int -> Message s a -> ShowS
[Message s a] -> ShowS
Message s a -> String
(Int -> Message s a -> ShowS)
-> (Message s a -> String)
-> ([Message s a] -> ShowS)
-> Show (Message s a)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall s a. Show a => Int -> Message s a -> ShowS
forall s a. Show a => [Message s a] -> ShowS
forall s a. Show a => Message s a -> String
showList :: [Message s a] -> ShowS
$cshowList :: forall s a. Show a => [Message s a] -> ShowS
show :: Message s a -> String
$cshow :: forall s a. Show a => Message s a -> String
showsPrec :: Int -> Message s a -> ShowS
$cshowsPrec :: forall s a. Show a => Int -> Message s a -> ShowS
Show, (forall x. Message s a -> Rep (Message s a) x)
-> (forall x. Rep (Message s a) x -> Message s a)
-> Generic (Message s a)
forall x. Rep (Message s a) x -> Message s a
forall x. Message s a -> Rep (Message s a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall s a x. Rep (Message s a) x -> Message s a
forall s a x. Message s a -> Rep (Message s a) x
$cto :: forall s a x. Rep (Message s a) x -> Message s a
$cfrom :: forall s a x. Message s a -> Rep (Message s a) x
Generic, Message s a -> ()
(Message s a -> ()) -> NFData (Message s a)
forall a. (a -> ()) -> NFData a
forall s a. NFData a => Message s a -> ()
rnf :: Message s a -> ()
$crnf :: forall s a. NFData a => Message s a -> ()
NFData)
instance HasHeaders (Message s a) where
headers :: (Headers -> f Headers) -> Message s a -> f (Message s a)
headers Headers -> f Headers
f (Message Headers
h a
b) = (Headers -> Message s a) -> f Headers -> f (Message s a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Headers -> a -> Message s a
forall s a. Headers -> a -> Message s a
`Message` a
b) (Headers -> f Headers
f Headers
h)
instance Functor (Message s) where
fmap :: (a -> b) -> Message s a -> Message s b
fmap a -> b
f (Message Headers
h a
a) = Headers -> b -> Message s b
forall s a. Headers -> a -> Message s a
Message Headers
h (a -> b
f a
a)
class EqMessage a where
eqMessage :: Message s a -> Message s a -> Bool
default eqMessage :: (Eq a) => Message s a -> Message s a -> Bool
eqMessage (Message Headers
h1 a
b1) (Message Headers
h2 a
b2) = Headers
h1 Headers -> Headers -> Bool
forall a. Eq a => a -> a -> Bool
== Headers
h2 Bool -> Bool -> Bool
&& a
b1 a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
b2
instance EqMessage a => Eq (Message s a) where
== :: Message s a -> Message s a -> Bool
(==) = Message s a -> Message s a -> Bool
forall a s. EqMessage a => Message s a -> Message s a -> Bool
eqMessage
headerList :: HasHeaders a => Lens' a [(CI B.ByteString, B.ByteString)]
= (Headers -> f Headers) -> a -> f a
forall a. HasHeaders a => Lens' a Headers
headers ((Headers -> f Headers) -> a -> f a)
-> (([(CI ByteString, ByteString)]
-> f [(CI ByteString, ByteString)])
-> Headers -> f Headers)
-> ([(CI ByteString, ByteString)]
-> f [(CI ByteString, ByteString)])
-> a
-> f a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([(CI ByteString, ByteString)] -> f [(CI ByteString, ByteString)])
-> Headers -> f Headers
forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
coerced
body :: Lens (Message ctx a) (Message ctx' b) a b
body :: (a -> f b) -> Message ctx a -> f (Message ctx' b)
body a -> f b
f (Message Headers
h a
b) = (b -> Message ctx' b) -> f b -> f (Message ctx' b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\b
b' -> Headers -> b -> Message ctx' b
forall s a. Headers -> a -> Message s a
Message Headers
h b
b') (a -> f b
f a
b)
{-# ANN body ("HLint: ignore Avoid lambda" :: String) #-}
rfc5322DateTimeFormat :: String
rfc5322DateTimeFormat :: String
rfc5322DateTimeFormat = String
"%a, %d %b %Y %T %z"
renderRFC5322Date :: ZonedTime -> B.ByteString
renderRFC5322Date :: ZonedTime -> ByteString
renderRFC5322Date = String -> ByteString
Char8.pack (String -> ByteString)
-> (ZonedTime -> String) -> ZonedTime -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TimeLocale -> String -> ZonedTime -> String
forall t. FormatTime t => TimeLocale -> String -> t -> String
formatTime TimeLocale
defaultTimeLocale String
rfc5322DateTimeFormat
headerDate :: HasHeaders a => Lens' a (Maybe ZonedTime)
= (Headers -> f Headers) -> a -> f a
forall a. HasHeaders a => Lens' a Headers
headers ((Headers -> f Headers) -> a -> f a)
-> ((Maybe ZonedTime -> f (Maybe ZonedTime))
-> Headers -> f Headers)
-> (Maybe ZonedTime -> f (Maybe ZonedTime))
-> 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
"Date" ((Maybe ByteString -> f (Maybe ByteString))
-> Headers -> f Headers)
-> ((Maybe ZonedTime -> f (Maybe ZonedTime))
-> Maybe ByteString -> f (Maybe ByteString))
-> (Maybe ZonedTime -> f (Maybe ZonedTime))
-> Headers
-> f Headers
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe ByteString -> Maybe ZonedTime)
-> (Maybe ZonedTime -> Maybe ByteString)
-> Iso
(Maybe ByteString)
(Maybe ByteString)
(Maybe ZonedTime)
(Maybe ZonedTime)
forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso (Maybe ByteString
-> (ByteString -> Maybe ZonedTime) -> Maybe ZonedTime
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ByteString -> Maybe ZonedTime
p) ((ZonedTime -> ByteString) -> Maybe ZonedTime -> Maybe ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ZonedTime -> ByteString
renderRFC5322Date)
where
p :: ByteString -> Maybe ZonedTime
p = (String -> Maybe ZonedTime)
-> (ZonedTime -> Maybe ZonedTime)
-> Either String ZonedTime
-> Maybe ZonedTime
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Maybe ZonedTime -> String -> Maybe ZonedTime
forall a b. a -> b -> a
const Maybe ZonedTime
forall a. Maybe a
Nothing) ZonedTime -> Maybe ZonedTime
forall a. a -> Maybe a
Just (Either String ZonedTime -> Maybe ZonedTime)
-> (ByteString -> Either String ZonedTime)
-> ByteString
-> Maybe ZonedTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parser ZonedTime -> ByteString -> Either String ZonedTime
forall a. Parser a -> ByteString -> Either String a
parseOnly (Parser ZonedTime
dateTime Parser ZonedTime -> Parser ByteString () -> Parser ZonedTime
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ByteString ()
forall t. Chunk t => Parser t ()
endOfInput)
buildMailbox :: Mailbox -> Builder.Builder
buildMailbox :: Mailbox -> Builder
buildMailbox (Mailbox Maybe Text
n AddrSpec
a) =
Builder -> (Text -> Builder) -> Maybe Text -> Builder
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Builder
a' (\Text
n' -> Text -> Builder
buildPhrase Text
n' Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
" <" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
a' Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
">") Maybe Text
n
where
a' :: Builder
a' = AddrSpec -> Builder
buildAddressSpec AddrSpec
a
buildPhrase :: T.Text -> Builder.Builder
buildPhrase :: Text -> Builder
buildPhrase Text
"" = Builder
"\"\""
buildPhrase Text
s =
case Text -> PhraseEscapeRequirement
enc Text
s of
PhraseEscapeRequirement
PhraseAtom -> Text -> Builder
T.encodeUtf8Builder Text
s
PhraseEscapeRequirement
PhraseQuotedString -> Bool -> Builder
qsBuilder Bool
False
PhraseEscapeRequirement
PhraseQuotedStringEscapeSpace -> Bool -> Builder
qsBuilder Bool
True
PhraseEscapeRequirement
PhraseEncodedWord -> EncodedWord -> Builder
buildEncodedWord (EncodedWord -> Builder)
-> (Text -> EncodedWord) -> Text -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TransferDecodedEncodedWord -> EncodedWord
forall a. HasTransferEncoding a => TransferDecoded a -> a
transferEncode (TransferDecodedEncodedWord -> EncodedWord)
-> (Text -> TransferDecodedEncodedWord) -> Text -> EncodedWord
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> TransferDecodedEncodedWord
forall a. HasCharset a => Decoded a -> a
charsetEncode (Text -> Builder) -> Text -> Builder
forall a b. (a -> b) -> a -> b
$ Text
s
where
enc :: Text -> PhraseEscapeRequirement
enc = (Char, PhraseEscapeRequirement) -> PhraseEscapeRequirement
forall a b. (a, b) -> b
snd ((Char, PhraseEscapeRequirement) -> PhraseEscapeRequirement)
-> (Text -> (Char, PhraseEscapeRequirement))
-> Text
-> PhraseEscapeRequirement
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char
-> (Char, PhraseEscapeRequirement)
-> (Char, PhraseEscapeRequirement))
-> (Char, PhraseEscapeRequirement)
-> Text
-> (Char, PhraseEscapeRequirement)
forall a. (Char -> a -> a) -> a -> Text -> a
T.foldr (\Char
c (Char
prev, PhraseEscapeRequirement
req) -> (Char
c, Char -> Char -> PhraseEscapeRequirement
encChar Char
prev Char
c PhraseEscapeRequirement
-> PhraseEscapeRequirement -> PhraseEscapeRequirement
forall a. Semigroup a => a -> a -> a
<> PhraseEscapeRequirement
req)) (Char
'\0', PhraseEscapeRequirement
forall a. Monoid a => a
mempty)
encChar :: Char -> Char -> PhraseEscapeRequirement
encChar Char
prev Char
c
| Char -> Bool
forall c. IsChar c => c -> Bool
isAtext Char
c = PhraseEscapeRequirement
PhraseAtom
| Char -> Bool
forall c. IsChar c => c -> Bool
isQtext Char
c = PhraseEscapeRequirement
PhraseQuotedString
| Char -> Bool
forall c. IsChar c => c -> Bool
isVchar Char
c = PhraseEscapeRequirement
PhraseQuotedString
| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
' ' =
if Char
prev Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
' '
then PhraseEscapeRequirement
PhraseQuotedStringEscapeSpace
else PhraseEscapeRequirement
PhraseQuotedString
| Bool
otherwise = PhraseEscapeRequirement
PhraseEncodedWord
qsBuilder :: Bool -> Builder
qsBuilder Bool
escSpace = Builder
"\"" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> BoundedPrim Word8 -> Text -> Builder
T.encodeUtf8BuilderEscaped (Bool -> BoundedPrim Word8
escPrim Bool
escSpace) Text
s Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
"\""
escPrim :: Bool -> BoundedPrim Word8
escPrim Bool
escSpace = (Word8 -> Bool)
-> BoundedPrim Word8 -> BoundedPrim Word8 -> BoundedPrim Word8
forall a.
(a -> Bool) -> BoundedPrim a -> BoundedPrim a -> BoundedPrim a
Prim.condB (\Word8
c -> Word8 -> Bool
forall c. IsChar c => c -> Bool
isQtext Word8
c Bool -> Bool -> Bool
|| Bool -> Bool
not Bool
escSpace Bool -> Bool -> Bool
&& Word8
c Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
32)
(FixedPrim Word8 -> BoundedPrim Word8
forall a. FixedPrim a -> BoundedPrim a
Prim.liftFixedToBounded FixedPrim Word8
Prim.word8)
(FixedPrim Word8 -> BoundedPrim Word8
forall a. FixedPrim a -> BoundedPrim a
Prim.liftFixedToBounded (FixedPrim Word8 -> BoundedPrim Word8)
-> FixedPrim Word8 -> BoundedPrim Word8
forall a b. (a -> b) -> a -> b
$ (Char -> Word8
forall a. IsChar a => Char -> a
fromChar Char
'\\',) (Word8 -> (Word8, Word8))
-> FixedPrim (Word8, Word8) -> FixedPrim Word8
forall (f :: * -> *) b a. Contravariant f => (b -> a) -> f a -> f b
Prim.>$< FixedPrim Word8
Prim.word8 FixedPrim Word8 -> FixedPrim Word8 -> FixedPrim (Word8, Word8)
forall (f :: * -> *) a b. Monoidal f => f a -> f b -> f (a, b)
Prim.>*< FixedPrim Word8
Prim.word8)
data PhraseEscapeRequirement
= PhraseAtom
| PhraseQuotedString
| PhraseQuotedStringEscapeSpace
| PhraseEncodedWord
deriving (PhraseEscapeRequirement -> PhraseEscapeRequirement -> Bool
(PhraseEscapeRequirement -> PhraseEscapeRequirement -> Bool)
-> (PhraseEscapeRequirement -> PhraseEscapeRequirement -> Bool)
-> Eq PhraseEscapeRequirement
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PhraseEscapeRequirement -> PhraseEscapeRequirement -> Bool
$c/= :: PhraseEscapeRequirement -> PhraseEscapeRequirement -> Bool
== :: PhraseEscapeRequirement -> PhraseEscapeRequirement -> Bool
$c== :: PhraseEscapeRequirement -> PhraseEscapeRequirement -> Bool
Eq, Eq PhraseEscapeRequirement
Eq PhraseEscapeRequirement
-> (PhraseEscapeRequirement -> PhraseEscapeRequirement -> Ordering)
-> (PhraseEscapeRequirement -> PhraseEscapeRequirement -> Bool)
-> (PhraseEscapeRequirement -> PhraseEscapeRequirement -> Bool)
-> (PhraseEscapeRequirement -> PhraseEscapeRequirement -> Bool)
-> (PhraseEscapeRequirement -> PhraseEscapeRequirement -> Bool)
-> (PhraseEscapeRequirement
-> PhraseEscapeRequirement -> PhraseEscapeRequirement)
-> (PhraseEscapeRequirement
-> PhraseEscapeRequirement -> PhraseEscapeRequirement)
-> Ord PhraseEscapeRequirement
PhraseEscapeRequirement -> PhraseEscapeRequirement -> Bool
PhraseEscapeRequirement -> PhraseEscapeRequirement -> Ordering
PhraseEscapeRequirement
-> PhraseEscapeRequirement -> PhraseEscapeRequirement
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: PhraseEscapeRequirement
-> PhraseEscapeRequirement -> PhraseEscapeRequirement
$cmin :: PhraseEscapeRequirement
-> PhraseEscapeRequirement -> PhraseEscapeRequirement
max :: PhraseEscapeRequirement
-> PhraseEscapeRequirement -> PhraseEscapeRequirement
$cmax :: PhraseEscapeRequirement
-> PhraseEscapeRequirement -> PhraseEscapeRequirement
>= :: PhraseEscapeRequirement -> PhraseEscapeRequirement -> Bool
$c>= :: PhraseEscapeRequirement -> PhraseEscapeRequirement -> Bool
> :: PhraseEscapeRequirement -> PhraseEscapeRequirement -> Bool
$c> :: PhraseEscapeRequirement -> PhraseEscapeRequirement -> Bool
<= :: PhraseEscapeRequirement -> PhraseEscapeRequirement -> Bool
$c<= :: PhraseEscapeRequirement -> PhraseEscapeRequirement -> Bool
< :: PhraseEscapeRequirement -> PhraseEscapeRequirement -> Bool
$c< :: PhraseEscapeRequirement -> PhraseEscapeRequirement -> Bool
compare :: PhraseEscapeRequirement -> PhraseEscapeRequirement -> Ordering
$ccompare :: PhraseEscapeRequirement -> PhraseEscapeRequirement -> Ordering
$cp1Ord :: Eq PhraseEscapeRequirement
Ord)
instance Semigroup PhraseEscapeRequirement where
PhraseEscapeRequirement
PhraseEncodedWord <> :: PhraseEscapeRequirement
-> PhraseEscapeRequirement -> PhraseEscapeRequirement
<> PhraseEscapeRequirement
_ =
PhraseEscapeRequirement
PhraseEncodedWord
PhraseEscapeRequirement
l <> PhraseEscapeRequirement
r = PhraseEscapeRequirement
-> PhraseEscapeRequirement -> PhraseEscapeRequirement
forall a. Ord a => a -> a -> a
max PhraseEscapeRequirement
l PhraseEscapeRequirement
r
instance Monoid PhraseEscapeRequirement where
mempty :: PhraseEscapeRequirement
mempty = PhraseEscapeRequirement
PhraseAtom
renderMailboxes :: [Mailbox] -> B.ByteString
renderMailboxes :: [Mailbox] -> ByteString
renderMailboxes = ByteString -> ByteString
L.toStrict (ByteString -> ByteString)
-> ([Mailbox] -> ByteString) -> [Mailbox] -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> ByteString
Builder.toLazyByteString (Builder -> ByteString)
-> ([Mailbox] -> Builder) -> [Mailbox] -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Mailbox] -> Builder
buildMailboxes
buildMailboxes :: [Mailbox] -> Builder.Builder
buildMailboxes :: [Mailbox] -> Builder
buildMailboxes = [Builder] -> Builder
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold ([Builder] -> Builder)
-> ([Mailbox] -> [Builder]) -> [Mailbox] -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> [Builder] -> [Builder]
forall a. a -> [a] -> [a]
Data.List.intersperse Builder
", " ([Builder] -> [Builder])
-> ([Mailbox] -> [Builder]) -> [Mailbox] -> [Builder]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Mailbox -> Builder) -> [Mailbox] -> [Builder]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Mailbox -> Builder
buildMailbox
renderMailbox :: Mailbox -> B.ByteString
renderMailbox :: Mailbox -> ByteString
renderMailbox = ByteString -> ByteString
L.toStrict (ByteString -> ByteString)
-> (Mailbox -> ByteString) -> Mailbox -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> ByteString
Builder.toLazyByteString (Builder -> ByteString)
-> (Mailbox -> Builder) -> Mailbox -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Mailbox -> Builder
buildMailbox
mailbox :: CharsetLookup -> Parser Mailbox
mailbox :: CharsetLookup -> Parser Mailbox
mailbox CharsetLookup
charsets =
Maybe Text -> AddrSpec -> Mailbox
Mailbox (Maybe Text -> AddrSpec -> Mailbox)
-> Parser ByteString (Maybe Text)
-> Parser ByteString (AddrSpec -> Mailbox)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString Text -> Parser ByteString (Maybe Text)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (CharsetLookup -> Parser ByteString Text
displayName CharsetLookup
charsets) Parser ByteString (AddrSpec -> Mailbox)
-> Parser ByteString AddrSpec -> Parser Mailbox
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ByteString AddrSpec
angleAddr
Parser Mailbox -> Parser Mailbox -> Parser Mailbox
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe Text -> AddrSpec -> Mailbox
Mailbox Maybe Text
forall a. Maybe a
Nothing (AddrSpec -> Mailbox)
-> Parser ByteString AddrSpec -> Parser Mailbox
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString AddrSpec
addressSpec
phrase :: CharsetLookup -> Parser T.Text
phrase :: CharsetLookup -> Parser ByteString Text
phrase CharsetLookup
charsets = Text -> Parser ByteString Text -> Parser ByteString Text
forall m (f :: * -> *).
(Semigroup m, Alternative f) =>
m -> f m -> f m
foldMany1Sep Text
" " (Parser ByteString Text -> Parser ByteString Text)
-> Parser ByteString Text -> Parser ByteString Text
forall a b. (a -> b) -> a -> b
$
(EncodedWord -> Text)
-> Parser ByteString EncodedWord -> Parser ByteString Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (CharsetLookup -> EncodedWord -> Text
decodeEncodedWord CharsetLookup
charsets) (Parser ByteString ByteString
"=?" Parser ByteString ByteString
-> Parser ByteString EncodedWord -> Parser ByteString EncodedWord
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ByteString EncodedWord
encodedWord)
Parser ByteString Text
-> Parser ByteString Text -> Parser ByteString Text
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (ByteString -> Text)
-> Parser ByteString ByteString -> Parser ByteString Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ByteString -> Text
decodeLenient Parser ByteString ByteString
forall (f :: * -> * -> *) s a.
(Alternative (f s), CharParsing f s a, SM s) =>
f s s
word
displayName :: CharsetLookup -> Parser T.Text
displayName :: CharsetLookup -> Parser ByteString Text
displayName = CharsetLookup -> Parser ByteString Text
phrase
angleAddr :: Parser AddrSpec
angleAddr :: Parser ByteString AddrSpec
angleAddr = Parser ByteString ByteString
forall (f :: * -> * -> *) s a.
(Alternative (f s), CharParsing f s a, SM s) =>
f s s
optionalCFWS Parser ByteString ByteString
-> Parser ByteString Word8 -> Parser ByteString Word8
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*>
Char -> Parser ByteString Word8
char8 Char
'<' Parser ByteString Word8
-> Parser ByteString AddrSpec -> Parser ByteString AddrSpec
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ByteString AddrSpec
addressSpec Parser ByteString AddrSpec
-> Parser ByteString Word8 -> Parser ByteString AddrSpec
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Char -> Parser ByteString Word8
char8 Char
'>'
Parser ByteString AddrSpec
-> Parser ByteString ByteString -> Parser ByteString AddrSpec
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ByteString ByteString
forall (f :: * -> * -> *) s a.
(Alternative (f s), CharParsing f s a, SM s) =>
f s s
optionalCFWS
buildAddressSpec :: AddrSpec -> Builder.Builder
buildAddressSpec :: AddrSpec -> Builder
buildAddressSpec (AddrSpec ByteString
lp (DomainDotAtom NonEmpty (CI ByteString)
b))
| ByteString
" " ByteString -> ByteString -> Bool
`B.isInfixOf` ByteString
lp = Builder
"\"" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
buildLP Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
"\"" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
rest
| Bool
otherwise = Builder
buildLP Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
rest
where
buildLP :: Builder
buildLP = ByteString -> Builder
Builder.byteString ByteString
lp
rest :: Builder
rest = Builder
"@" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> (CI ByteString -> Builder) -> NonEmpty (CI ByteString) -> Builder
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (ByteString -> Builder
Builder.byteString (ByteString -> Builder)
-> (CI ByteString -> ByteString) -> CI ByteString -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CI ByteString -> ByteString
forall s. CI s -> s
original)
(CI ByteString
-> NonEmpty (CI ByteString) -> NonEmpty (CI ByteString)
forall a. a -> NonEmpty a -> NonEmpty a
Data.List.NonEmpty.intersperse CI ByteString
"." NonEmpty (CI ByteString)
b)
buildAddressSpec (AddrSpec ByteString
lp (DomainLiteral ByteString
b)) =
(ByteString -> Builder) -> [ByteString] -> Builder
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap ByteString -> Builder
Builder.byteString [ByteString
lp, ByteString
"@", ByteString
b]
renderAddressSpec :: AddrSpec -> B.ByteString
renderAddressSpec :: AddrSpec -> ByteString
renderAddressSpec = ByteString -> ByteString
L.toStrict (ByteString -> ByteString)
-> (AddrSpec -> ByteString) -> AddrSpec -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> ByteString
Builder.toLazyByteString (Builder -> ByteString)
-> (AddrSpec -> Builder) -> AddrSpec -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AddrSpec -> Builder
buildAddressSpec
addressSpec :: Parser AddrSpec
addressSpec :: Parser ByteString AddrSpec
addressSpec = ByteString -> Domain -> AddrSpec
AddrSpec (ByteString -> Domain -> AddrSpec)
-> Parser ByteString ByteString
-> Parser ByteString (Domain -> AddrSpec)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString ByteString
forall (f :: * -> * -> *) s a.
(Alternative (f s), CharParsing f s a, SM s) =>
f s s
localPart Parser ByteString (Domain -> AddrSpec)
-> Parser ByteString Domain -> Parser ByteString AddrSpec
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Char -> Parser ByteString Word8
char8 Char
'@' Parser ByteString Word8
-> Parser ByteString Domain -> Parser ByteString Domain
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ByteString Domain
domain)
isDtext :: Word8 -> Bool
isDtext :: Word8 -> Bool
isDtext 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
90) Bool -> Bool -> Bool
|| (Word8
c Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
>= Word8
94 Bool -> Bool -> Bool
&& Word8
c Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word8
126)
domain :: Parser Domain
domain :: Parser ByteString Domain
domain = (NonEmpty (CI ByteString) -> Domain
DomainDotAtom (NonEmpty (CI ByteString) -> Domain)
-> (NonEmpty ByteString -> NonEmpty (CI ByteString))
-> NonEmpty ByteString
-> Domain
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ByteString -> CI ByteString)
-> NonEmpty ByteString -> NonEmpty (CI ByteString)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ByteString -> CI ByteString
forall s. FoldCase s => s -> CI s
mk (NonEmpty ByteString -> Domain)
-> Parser ByteString (NonEmpty ByteString)
-> Parser ByteString Domain
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString (NonEmpty ByteString)
forall (f :: * -> * -> *) s a.
(Alternative (f s), CharParsing f s a, SM s) =>
f s (NonEmpty s)
dotAtom)
Parser ByteString Domain
-> Parser ByteString Domain -> Parser ByteString Domain
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (ByteString -> Domain
DomainLiteral (ByteString -> Domain)
-> Parser ByteString ByteString -> Parser ByteString Domain
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString ByteString
forall (f :: * -> * -> *) s a.
(Alternative (f s), CharParsing f s a, SM s) =>
f s s
domainLiteral)
mailboxList :: CharsetLookup -> Parser [Mailbox]
mailboxList :: CharsetLookup -> Parser [Mailbox]
mailboxList CharsetLookup
charsets = CharsetLookup -> Parser Mailbox
mailbox CharsetLookup
charsets Parser Mailbox -> Parser ByteString Word8 -> Parser [Mailbox]
forall (f :: * -> *) a s. Alternative f => f a -> f s -> f [a]
`sepBy` Char -> Parser ByteString Word8
char8 Char
','
renderAddresses :: [Address] -> B.ByteString
renderAddresses :: [Address] -> ByteString
renderAddresses [Address]
xs = ByteString -> [ByteString] -> ByteString
B.intercalate ByteString
", " ([ByteString] -> ByteString) -> [ByteString] -> ByteString
forall a b. (a -> b) -> a -> b
$ Address -> ByteString
renderAddress (Address -> ByteString) -> [Address] -> [ByteString]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Address]
xs
renderAddress :: Address -> B.ByteString
renderAddress :: Address -> ByteString
renderAddress (Single Mailbox
m) = Mailbox -> ByteString
renderMailbox Mailbox
m
renderAddress (Group Text
name [Mailbox]
xs) = Text -> ByteString
T.encodeUtf8 Text
name ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
":" ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> [Mailbox] -> ByteString
renderMailboxes [Mailbox]
xs ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
";"
addressList :: CharsetLookup -> Parser [Address]
addressList :: CharsetLookup -> Parser [Address]
addressList CharsetLookup
charsets = CharsetLookup -> Parser Address
address CharsetLookup
charsets Parser Address -> Parser ByteString Word8 -> Parser [Address]
forall (f :: * -> *) a s. Alternative f => f a -> f s -> f [a]
`sepBy` Char -> Parser ByteString Word8
char8 Char
','
group :: CharsetLookup -> Parser Address
group :: CharsetLookup -> Parser Address
group CharsetLookup
charsets =
Text -> [Mailbox] -> Address
Group (Text -> [Mailbox] -> Address)
-> Parser ByteString Text
-> Parser ByteString ([Mailbox] -> Address)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CharsetLookup -> Parser ByteString Text
displayName CharsetLookup
charsets Parser ByteString ([Mailbox] -> Address)
-> Parser ByteString Word8
-> Parser ByteString ([Mailbox] -> Address)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Char -> Parser ByteString Word8
char8 Char
':'
Parser ByteString ([Mailbox] -> Address)
-> Parser [Mailbox] -> Parser Address
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> CharsetLookup -> Parser [Mailbox]
mailboxList CharsetLookup
charsets Parser Address -> Parser ByteString Word8 -> Parser Address
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Char -> Parser ByteString Word8
char8 Char
';' Parser Address -> Parser ByteString ByteString -> Parser Address
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ByteString ByteString
forall (f :: * -> * -> *) s a.
(Alternative (f s), CharParsing f s a, SM s) =>
f s s
optionalCFWS
address :: CharsetLookup -> Parser Address
address :: CharsetLookup -> Parser Address
address CharsetLookup
charsets =
CharsetLookup -> Parser Address
group CharsetLookup
charsets Parser Address -> Parser Address -> Parser Address
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Mailbox -> Address
Single (Mailbox -> Address) -> Parser Mailbox -> Parser Address
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CharsetLookup -> Parser Mailbox
mailbox CharsetLookup
charsets
headerSingleToList
:: (HasHeaders s)
=> (B.ByteString -> [a])
-> ([a] -> B.ByteString)
-> CI B.ByteString
-> Lens' s [a]
ByteString -> [a]
f [a] -> ByteString
g CI ByteString
k =
(Headers -> f Headers) -> s -> f s
forall a. HasHeaders a => Lens' a Headers
headers ((Headers -> f Headers) -> s -> f s)
-> (([a] -> f [a]) -> Headers -> f Headers)
-> ([a] -> f [a])
-> s
-> f s
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 CI ByteString
Index Headers
k ((Maybe ByteString -> f (Maybe ByteString))
-> Headers -> f Headers)
-> (([a] -> f [a]) -> Maybe ByteString -> f (Maybe ByteString))
-> ([a] -> f [a])
-> Headers
-> f Headers
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe ByteString -> [a])
-> ([a] -> Maybe ByteString)
-> Iso (Maybe ByteString) (Maybe ByteString) [a] [a]
forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso ([a] -> (ByteString -> [a]) -> Maybe ByteString -> [a]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] ByteString -> [a]
f) (\[a]
l -> if [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [a]
l then Maybe ByteString
forall a. Maybe a
Nothing else ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just ([a] -> ByteString
g [a]
l))
headerSingleToMaybe
:: (HasHeaders s)
=> (B.ByteString -> Maybe a)
-> (a -> B.ByteString)
-> CI B.ByteString
-> Lens' s (Maybe a)
ByteString -> Maybe a
f a -> ByteString
g CI ByteString
k = (Headers -> f Headers) -> s -> f s
forall a. HasHeaders a => Lens' a Headers
headers ((Headers -> f Headers) -> s -> f s)
-> ((Maybe a -> f (Maybe a)) -> Headers -> f Headers)
-> (Maybe a -> f (Maybe a))
-> s
-> f s
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 CI ByteString
Index Headers
k ((Maybe ByteString -> f (Maybe ByteString))
-> Headers -> f Headers)
-> ((Maybe a -> f (Maybe a))
-> Maybe ByteString -> f (Maybe ByteString))
-> (Maybe a -> f (Maybe a))
-> Headers
-> f Headers
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe ByteString -> Maybe a)
-> (Maybe a -> Maybe ByteString)
-> Iso (Maybe ByteString) (Maybe ByteString) (Maybe a) (Maybe a)
forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso (Maybe ByteString -> (ByteString -> Maybe a) -> Maybe a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ByteString -> Maybe a
f) ((a -> ByteString) -> Maybe a -> Maybe ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> ByteString
g)
headerAddressList :: (HasHeaders a) => CI B.ByteString -> CharsetLookup -> Lens' a [Address]
CI ByteString
k CharsetLookup
charsets = (ByteString -> [Address])
-> ([Address] -> ByteString) -> CI ByteString -> Lens' a [Address]
forall s a.
HasHeaders s =>
(ByteString -> [a])
-> ([a] -> ByteString) -> CI ByteString -> Lens' s [a]
headerSingleToList
([Address] -> Either String [Address] -> [Address]
forall b a. b -> Either a b -> b
fromRight [] (Either String [Address] -> [Address])
-> (ByteString -> Either String [Address])
-> ByteString
-> [Address]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parser [Address] -> ByteString -> Either String [Address]
forall a. Parser a -> ByteString -> Either String a
parseOnly (CharsetLookup -> Parser [Address]
addressList CharsetLookup
charsets))
[Address] -> ByteString
renderAddresses
CI ByteString
k
headerFrom, headerReplyTo, headerTo, headerCC, headerBCC
:: (HasHeaders a)
=> CharsetLookup -> Lens' a [Address]
= CI ByteString -> CharsetLookup -> Lens' a [Address]
forall a.
HasHeaders a =>
CI ByteString -> CharsetLookup -> Lens' a [Address]
headerAddressList CI ByteString
"From"
= CI ByteString -> CharsetLookup -> Lens' a [Address]
forall a.
HasHeaders a =>
CI ByteString -> CharsetLookup -> Lens' a [Address]
headerAddressList CI ByteString
"Reply-To"
= CI ByteString -> CharsetLookup -> Lens' a [Address]
forall a.
HasHeaders a =>
CI ByteString -> CharsetLookup -> Lens' a [Address]
headerAddressList CI ByteString
"To"
= CI ByteString -> CharsetLookup -> Lens' a [Address]
forall a.
HasHeaders a =>
CI ByteString -> CharsetLookup -> Lens' a [Address]
headerAddressList CI ByteString
"Cc"
= CI ByteString -> CharsetLookup -> Lens' a [Address]
forall a.
HasHeaders a =>
CI ByteString -> CharsetLookup -> Lens' a [Address]
headerAddressList CI ByteString
"Bcc"
data MessageID = MessageID
(NonEmpty B.ByteString)
(Either (NonEmpty B.ByteString) B.ByteString)
deriving (MessageID -> MessageID -> Bool
(MessageID -> MessageID -> Bool)
-> (MessageID -> MessageID -> Bool) -> Eq MessageID
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MessageID -> MessageID -> Bool
$c/= :: MessageID -> MessageID -> Bool
== :: MessageID -> MessageID -> Bool
$c== :: MessageID -> MessageID -> Bool
Eq, Eq MessageID
Eq MessageID
-> (MessageID -> MessageID -> Ordering)
-> (MessageID -> MessageID -> Bool)
-> (MessageID -> MessageID -> Bool)
-> (MessageID -> MessageID -> Bool)
-> (MessageID -> MessageID -> Bool)
-> (MessageID -> MessageID -> MessageID)
-> (MessageID -> MessageID -> MessageID)
-> Ord MessageID
MessageID -> MessageID -> Bool
MessageID -> MessageID -> Ordering
MessageID -> MessageID -> MessageID
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: MessageID -> MessageID -> MessageID
$cmin :: MessageID -> MessageID -> MessageID
max :: MessageID -> MessageID -> MessageID
$cmax :: MessageID -> MessageID -> MessageID
>= :: MessageID -> MessageID -> Bool
$c>= :: MessageID -> MessageID -> Bool
> :: MessageID -> MessageID -> Bool
$c> :: MessageID -> MessageID -> Bool
<= :: MessageID -> MessageID -> Bool
$c<= :: MessageID -> MessageID -> Bool
< :: MessageID -> MessageID -> Bool
$c< :: MessageID -> MessageID -> Bool
compare :: MessageID -> MessageID -> Ordering
$ccompare :: MessageID -> MessageID -> Ordering
$cp1Ord :: Eq MessageID
Ord)
instance Show MessageID where
show :: MessageID -> String
show = ByteString -> String
Char8.unpack (ByteString -> String)
-> (MessageID -> ByteString) -> MessageID -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MessageID -> ByteString
renderMessageID
parseMessageID :: Parser MessageID
parseMessageID :: Parser MessageID
parseMessageID =
NonEmpty ByteString
-> Either (NonEmpty ByteString) ByteString -> MessageID
MessageID
(NonEmpty ByteString
-> Either (NonEmpty ByteString) ByteString -> MessageID)
-> Parser ByteString (NonEmpty ByteString)
-> Parser
ByteString (Either (NonEmpty ByteString) ByteString -> MessageID)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Parser ByteString ByteString
forall (f :: * -> * -> *) s a.
(Alternative (f s), CharParsing f s a, SM s) =>
f s s
optionalCFWS Parser ByteString ByteString
-> Parser ByteString Word8 -> Parser ByteString Word8
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Char -> Parser ByteString Word8
forall (f :: * -> * -> *) s a. CharParsing f s a => Char -> f s a
char Char
'<' Parser ByteString Word8
-> Parser ByteString (NonEmpty ByteString)
-> Parser ByteString (NonEmpty ByteString)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ByteString (NonEmpty ByteString)
idLeft) Parser
ByteString (Either (NonEmpty ByteString) ByteString -> MessageID)
-> Parser ByteString Word8
-> Parser
ByteString (Either (NonEmpty ByteString) ByteString -> MessageID)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Char -> Parser ByteString Word8
forall (f :: * -> * -> *) s a. CharParsing f s a => Char -> f s a
char Char
'@'
Parser
ByteString (Either (NonEmpty ByteString) ByteString -> MessageID)
-> Parser ByteString (Either (NonEmpty ByteString) ByteString)
-> Parser MessageID
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ByteString (Either (NonEmpty ByteString) ByteString)
idRight Parser MessageID -> Parser ByteString Word8 -> Parser MessageID
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Char -> Parser ByteString Word8
forall (f :: * -> * -> *) s a. CharParsing f s a => Char -> f s a
char Char
'>' Parser MessageID
-> Parser ByteString ByteString -> Parser MessageID
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ByteString ByteString
forall (f :: * -> * -> *) s a.
(Alternative (f s), CharParsing f s a, SM s) =>
f s s
optionalCFWS
where
idLeft :: Parser ByteString (NonEmpty ByteString)
idLeft = Parser ByteString (NonEmpty ByteString)
forall (f :: * -> * -> *) s a.
(Alternative (f s), CharParsing f s a) =>
f s (NonEmpty s)
dotAtomText
idRight :: Parser ByteString (Either (NonEmpty ByteString) ByteString)
idRight = NonEmpty ByteString -> Either (NonEmpty ByteString) ByteString
forall a b. a -> Either a b
Left (NonEmpty ByteString -> Either (NonEmpty ByteString) ByteString)
-> Parser ByteString (NonEmpty ByteString)
-> Parser ByteString (Either (NonEmpty ByteString) ByteString)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString (NonEmpty ByteString)
forall (f :: * -> * -> *) s a.
(Alternative (f s), CharParsing f s a) =>
f s (NonEmpty s)
dotAtomText Parser ByteString (Either (NonEmpty ByteString) ByteString)
-> Parser ByteString (Either (NonEmpty ByteString) ByteString)
-> Parser ByteString (Either (NonEmpty ByteString) ByteString)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ByteString -> Either (NonEmpty ByteString) ByteString
forall a b. b -> Either a b
Right (ByteString -> Either (NonEmpty ByteString) ByteString)
-> Parser ByteString ByteString
-> Parser ByteString (Either (NonEmpty ByteString) ByteString)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString ByteString
noFoldLiteral
noFoldLiteral :: Parser ByteString ByteString
noFoldLiteral = Char -> Parser ByteString Word8
forall (f :: * -> * -> *) s a. CharParsing f s a => Char -> f s a
char Char
'[' Parser ByteString Word8
-> Parser ByteString ByteString -> Parser ByteString ByteString
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Word8 -> Bool) -> Parser ByteString ByteString
A.takeWhile1 Word8 -> Bool
isDtext Parser ByteString ByteString
-> Parser ByteString Word8 -> Parser ByteString ByteString
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Char -> Parser ByteString Word8
forall (f :: * -> * -> *) s a. CharParsing f s a => Char -> f s a
char Char
']'
buildMessageID :: MessageID -> Builder.Builder
buildMessageID :: MessageID -> Builder
buildMessageID (MessageID NonEmpty ByteString
l Either (NonEmpty ByteString) ByteString
r) =
Builder
"<" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> NonEmpty ByteString -> Builder
buildDotAtom NonEmpty ByteString
l Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
"@" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> (NonEmpty ByteString -> Builder)
-> (ByteString -> Builder)
-> Either (NonEmpty ByteString) ByteString
-> Builder
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either NonEmpty ByteString -> Builder
buildDotAtom ByteString -> Builder
buildNoFoldLit Either (NonEmpty ByteString) ByteString
r Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
">"
where
buildDotAtom :: NonEmpty ByteString -> Builder
buildDotAtom =
NonEmpty Builder -> Builder
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold (NonEmpty Builder -> Builder)
-> (NonEmpty ByteString -> NonEmpty Builder)
-> NonEmpty ByteString
-> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> NonEmpty Builder -> NonEmpty Builder
forall a. a -> NonEmpty a -> NonEmpty a
Data.List.NonEmpty.intersperse Builder
"." (NonEmpty Builder -> NonEmpty Builder)
-> (NonEmpty ByteString -> NonEmpty Builder)
-> NonEmpty ByteString
-> NonEmpty Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ByteString -> Builder) -> NonEmpty ByteString -> NonEmpty Builder
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ByteString -> Builder
Builder.byteString
buildNoFoldLit :: ByteString -> Builder
buildNoFoldLit ByteString
s =
Builder
"[" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ByteString -> Builder
Builder.byteString ByteString
s Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
"]"
renderMessageID :: MessageID -> B.ByteString
renderMessageID :: MessageID -> ByteString
renderMessageID = ByteString -> ByteString
L.toStrict (ByteString -> ByteString)
-> (MessageID -> ByteString) -> MessageID -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> ByteString
Builder.toLazyByteString (Builder -> ByteString)
-> (MessageID -> Builder) -> MessageID -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MessageID -> Builder
buildMessageID
headerMessageID :: (HasHeaders a) => Lens' a (Maybe MessageID)
= (ByteString -> Maybe MessageID)
-> (MessageID -> ByteString)
-> CI ByteString
-> Lens' a (Maybe MessageID)
forall s a.
HasHeaders s =>
(ByteString -> Maybe a)
-> (a -> ByteString) -> CI ByteString -> Lens' s (Maybe a)
headerSingleToMaybe
((String -> Maybe MessageID)
-> (MessageID -> Maybe MessageID)
-> Either String MessageID
-> Maybe MessageID
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Maybe MessageID -> String -> Maybe MessageID
forall a b. a -> b -> a
const Maybe MessageID
forall a. Maybe a
Nothing) MessageID -> Maybe MessageID
forall a. a -> Maybe a
Just (Either String MessageID -> Maybe MessageID)
-> (ByteString -> Either String MessageID)
-> ByteString
-> Maybe MessageID
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parser MessageID -> ByteString -> Either String MessageID
forall a. Parser a -> ByteString -> Either String a
parseOnly (Parser MessageID
parseMessageID Parser MessageID -> Parser ByteString () -> Parser MessageID
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ByteString ()
forall t. Chunk t => Parser t ()
endOfInput))
MessageID -> ByteString
renderMessageID
CI ByteString
"Message-ID"
headerMessageIDList :: (HasHeaders a) => CI B.ByteString -> Lens' a [MessageID]
= (ByteString -> [MessageID])
-> ([MessageID] -> ByteString)
-> CI ByteString
-> Lens' a [MessageID]
forall s a.
HasHeaders s =>
(ByteString -> [a])
-> ([a] -> ByteString) -> CI ByteString -> Lens' s [a]
headerSingleToList
([MessageID] -> Either String [MessageID] -> [MessageID]
forall b a. b -> Either a b -> b
fromRight [] (Either String [MessageID] -> [MessageID])
-> (ByteString -> Either String [MessageID])
-> ByteString
-> [MessageID]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parser [MessageID] -> ByteString -> Either String [MessageID]
forall a. Parser a -> ByteString -> Either String a
parseOnly (Parser MessageID -> Parser [MessageID]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many Parser MessageID
parseMessageID Parser [MessageID] -> Parser ByteString () -> Parser [MessageID]
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ByteString ()
forall t. Chunk t => Parser t ()
endOfInput))
( ByteString -> ByteString
L.toStrict (ByteString -> ByteString)
-> ([MessageID] -> ByteString) -> [MessageID] -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> ByteString
Builder.toLazyByteString
(Builder -> ByteString)
-> ([MessageID] -> Builder) -> [MessageID] -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Builder] -> Builder
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold ([Builder] -> Builder)
-> ([MessageID] -> [Builder]) -> [MessageID] -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> [Builder] -> [Builder]
forall a. a -> [a] -> [a]
Data.List.intersperse Builder
" " ([Builder] -> [Builder])
-> ([MessageID] -> [Builder]) -> [MessageID] -> [Builder]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (MessageID -> Builder) -> [MessageID] -> [Builder]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap MessageID -> Builder
buildMessageID )
headerInReplyTo, headerReferences :: (HasHeaders a) => Lens' a [MessageID]
= CI ByteString -> Lens' a [MessageID]
forall a. HasHeaders a => CI ByteString -> Lens' a [MessageID]
headerMessageIDList CI ByteString
"In-Reply-To"
= CI ByteString -> Lens' a [MessageID]
forall a. HasHeaders a => CI ByteString -> Lens' a [MessageID]
headerMessageIDList CI ByteString
"References"
headerText :: (HasHeaders a) => CharsetLookup -> CI B.ByteString -> Lens' a (Maybe T.Text)
CharsetLookup
charsets CI ByteString
k =
(Headers -> f Headers) -> a -> f a
forall a. HasHeaders a => Lens' a Headers
headers ((Headers -> f Headers) -> a -> f a)
-> ((Maybe Text -> f (Maybe Text)) -> Headers -> f Headers)
-> (Maybe Text -> f (Maybe Text))
-> 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 CI ByteString
Index Headers
k ((Maybe ByteString -> f (Maybe ByteString))
-> Headers -> f Headers)
-> ((Maybe Text -> f (Maybe Text))
-> Maybe ByteString -> f (Maybe ByteString))
-> (Maybe Text -> f (Maybe Text))
-> Headers
-> f Headers
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe ByteString -> Maybe Text)
-> (Maybe Text -> Maybe ByteString)
-> Iso
(Maybe ByteString) (Maybe ByteString) (Maybe Text) (Maybe Text)
forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso ((ByteString -> Text) -> Maybe ByteString -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (CharsetLookup -> ByteString -> Text
decodeEncodedWords CharsetLookup
charsets)) ((Text -> ByteString) -> Maybe Text -> Maybe ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> ByteString
encodeEncodedWords)
headerSubject :: (HasHeaders a) => CharsetLookup -> Lens' a (Maybe T.Text)
CharsetLookup
charsets = CharsetLookup -> CI ByteString -> Lens' a (Maybe Text)
forall a.
HasHeaders a =>
CharsetLookup -> CI ByteString -> Lens' a (Maybe Text)
headerText CharsetLookup
charsets CI ByteString
"Subject"
data ReplyMode
= ReplyToSender
| ReplyToGroup
type AuthorMailboxes = NonEmpty Mailbox
data ReplyFromMode
= ReplyFromPreferredMailbox
| ReplyFromMatchingMailbox
data ReplyFromRewriteMode
= ReplyFromRewriteOff
| ReplyFromRewriteOn
data SelfInRecipientsMode
= SelfInRecipientsRemove
| SelfInRecipientsIgnore
data ReplySettings = ReplySettings
{ ReplySettings -> ReplyMode
_replyMode :: ReplyMode
, ReplySettings -> ReplyFromMode
_replyFromMode :: ReplyFromMode
, ReplySettings -> ReplyFromRewriteMode
_replyFromRewriteMode :: ReplyFromRewriteMode
, ReplySettings -> SelfInRecipientsMode
_selfInRecipientsMode :: SelfInRecipientsMode
, ReplySettings -> AuthorMailboxes
_authorMailboxes :: AuthorMailboxes
}
defaultReplySettings :: AuthorMailboxes -> ReplySettings
defaultReplySettings :: AuthorMailboxes -> ReplySettings
defaultReplySettings = ReplyMode
-> ReplyFromMode
-> ReplyFromRewriteMode
-> SelfInRecipientsMode
-> AuthorMailboxes
-> ReplySettings
ReplySettings
ReplyMode
ReplyToSender
ReplyFromMode
ReplyFromMatchingMailbox
ReplyFromRewriteMode
ReplyFromRewriteOn
SelfInRecipientsMode
SelfInRecipientsRemove
replyMode :: Lens' ReplySettings ReplyMode
replyMode :: (ReplyMode -> f ReplyMode) -> ReplySettings -> f ReplySettings
replyMode = (ReplySettings -> ReplyMode)
-> (ReplySettings -> ReplyMode -> ReplySettings)
-> Lens ReplySettings ReplySettings ReplyMode ReplyMode
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens ReplySettings -> ReplyMode
_replyMode (\ReplySettings
s ReplyMode
a -> ReplySettings
s { _replyMode :: ReplyMode
_replyMode = ReplyMode
a })
replyFromMode :: Lens' ReplySettings ReplyFromMode
replyFromMode :: (ReplyFromMode -> f ReplyFromMode)
-> ReplySettings -> f ReplySettings
replyFromMode = (ReplySettings -> ReplyFromMode)
-> (ReplySettings -> ReplyFromMode -> ReplySettings)
-> Lens ReplySettings ReplySettings ReplyFromMode ReplyFromMode
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens ReplySettings -> ReplyFromMode
_replyFromMode (\ReplySettings
s ReplyFromMode
a -> ReplySettings
s { _replyFromMode :: ReplyFromMode
_replyFromMode = ReplyFromMode
a })
replyFromRewriteMode :: Lens' ReplySettings ReplyFromRewriteMode
replyFromRewriteMode :: (ReplyFromRewriteMode -> f ReplyFromRewriteMode)
-> ReplySettings -> f ReplySettings
replyFromRewriteMode =
(ReplySettings -> ReplyFromRewriteMode)
-> (ReplySettings -> ReplyFromRewriteMode -> ReplySettings)
-> Lens
ReplySettings
ReplySettings
ReplyFromRewriteMode
ReplyFromRewriteMode
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens ReplySettings -> ReplyFromRewriteMode
_replyFromRewriteMode (\ReplySettings
s ReplyFromRewriteMode
a -> ReplySettings
s { _replyFromRewriteMode :: ReplyFromRewriteMode
_replyFromRewriteMode = ReplyFromRewriteMode
a })
selfInRecipientsMode :: Lens' ReplySettings SelfInRecipientsMode
selfInRecipientsMode :: (SelfInRecipientsMode -> f SelfInRecipientsMode)
-> ReplySettings -> f ReplySettings
selfInRecipientsMode =
(ReplySettings -> SelfInRecipientsMode)
-> (ReplySettings -> SelfInRecipientsMode -> ReplySettings)
-> Lens
ReplySettings
ReplySettings
SelfInRecipientsMode
SelfInRecipientsMode
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens ReplySettings -> SelfInRecipientsMode
_selfInRecipientsMode (\ReplySettings
s SelfInRecipientsMode
a -> ReplySettings
s { _selfInRecipientsMode :: SelfInRecipientsMode
_selfInRecipientsMode = SelfInRecipientsMode
a })
authorMailboxes :: Lens' ReplySettings AuthorMailboxes
authorMailboxes :: (AuthorMailboxes -> f AuthorMailboxes)
-> ReplySettings -> f ReplySettings
authorMailboxes = (ReplySettings -> AuthorMailboxes)
-> (ReplySettings -> AuthorMailboxes -> ReplySettings)
-> Lens ReplySettings ReplySettings AuthorMailboxes AuthorMailboxes
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens ReplySettings -> AuthorMailboxes
_authorMailboxes (\ReplySettings
s AuthorMailboxes
a -> ReplySettings
s { _authorMailboxes :: AuthorMailboxes
_authorMailboxes = AuthorMailboxes
a })
replyRecipients
:: CharsetLookup -> ReplySettings -> Message ctx a -> ([Address], [Address])
replyRecipients :: CharsetLookup
-> ReplySettings -> Message ctx a -> ([Address], [Address])
replyRecipients CharsetLookup
charsets ReplySettings
settings Message ctx a
msg =
let
mode :: ReplyMode
mode = Getting ReplyMode ReplySettings ReplyMode
-> ReplySettings -> ReplyMode
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting ReplyMode ReplySettings ReplyMode
Lens ReplySettings ReplySettings ReplyMode ReplyMode
replyMode ReplySettings
settings
rt :: [Address]
rt = Getting [Address] (Message ctx a) [Address]
-> Message ctx a -> [Address]
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view (CharsetLookup -> Lens' (Message ctx a) [Address]
forall a. HasHeaders a => CharsetLookup -> Lens' a [Address]
headerReplyTo CharsetLookup
charsets) Message ctx a
msg
f :: [Address]
f = Getting [Address] (Message ctx a) [Address]
-> Message ctx a -> [Address]
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view (CharsetLookup -> Lens' (Message ctx a) [Address]
forall a. HasHeaders a => CharsetLookup -> Lens' a [Address]
headerFrom CharsetLookup
charsets) Message ctx a
msg
t :: [Address]
t = Getting [Address] (Message ctx a) [Address]
-> Message ctx a -> [Address]
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view (CharsetLookup -> Lens' (Message ctx a) [Address]
forall a. HasHeaders a => CharsetLookup -> Lens' a [Address]
headerTo CharsetLookup
charsets) Message ctx a
msg
c :: [Address]
c = Getting [Address] (Message ctx a) [Address]
-> Message ctx a -> [Address]
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view (CharsetLookup -> Lens' (Message ctx a) [Address]
forall a. HasHeaders a => CharsetLookup -> Lens' a [Address]
headerCC CharsetLookup
charsets) Message ctx a
msg
in case ReplyMode
mode of
ReplyMode
ReplyToSender
| Bool -> Bool
not ([Address] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Address]
rt) -> ([Address]
rt, [])
| Bool
otherwise -> ([Address]
f, [])
ReplyMode
ReplyToGroup
| [Address] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([Address]
t [Address] -> [Address] -> [Address]
forall a. Semigroup a => a -> a -> a
<> [Address]
c) Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
1
-> CharsetLookup
-> ReplySettings -> Message ctx a -> ([Address], [Address])
forall ctx a.
CharsetLookup
-> ReplySettings -> Message ctx a -> ([Address], [Address])
replyRecipients CharsetLookup
charsets (ASetter ReplySettings ReplySettings ReplyMode ReplyMode
-> ReplyMode -> ReplySettings -> ReplySettings
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter ReplySettings ReplySettings ReplyMode ReplyMode
Lens ReplySettings ReplySettings ReplyMode ReplyMode
replyMode ReplyMode
ReplyToSender ReplySettings
settings) Message ctx a
msg
| Bool
otherwise
-> ([Address]
f, [Address]
t [Address] -> [Address] -> [Address]
forall a. Semigroup a => a -> a -> a
<> [Address]
c)
replyReferences :: Message ctx a -> [MessageID]
replyReferences :: Message ctx a -> [MessageID]
replyReferences Message ctx a
msg
| [MessageID] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [MessageID]
refer, [MessageID] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [MessageID]
inRep Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 = [MessageID]
inRep [MessageID] -> [MessageID] -> [MessageID]
forall a. Semigroup a => a -> a -> a
<> [MessageID]
msgId
| Bool
otherwise = [MessageID]
refer [MessageID] -> [MessageID] -> [MessageID]
forall a. Semigroup a => a -> a -> a
<> [MessageID]
msgId
where
msgId :: [MessageID]
msgId = Maybe MessageID -> [MessageID]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (Maybe MessageID -> [MessageID]) -> Maybe MessageID -> [MessageID]
forall a b. (a -> b) -> a -> b
$ Getting (Maybe MessageID) (Message ctx a) (Maybe MessageID)
-> Message ctx a -> Maybe MessageID
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting (Maybe MessageID) (Message ctx a) (Maybe MessageID)
forall a. HasHeaders a => Lens' a (Maybe MessageID)
headerMessageID Message ctx a
msg
refer :: [MessageID]
refer = Getting [MessageID] (Message ctx a) [MessageID]
-> Message ctx a -> [MessageID]
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting [MessageID] (Message ctx a) [MessageID]
forall a. HasHeaders a => Lens' a [MessageID]
headerReferences Message ctx a
msg
inRep :: [MessageID]
inRep = Getting [MessageID] (Message ctx a) [MessageID]
-> Message ctx a -> [MessageID]
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting [MessageID] (Message ctx a) [MessageID]
forall a. HasHeaders a => Lens' a [MessageID]
headerInReplyTo Message ctx a
msg
replySubject :: CharsetLookup -> Message ctx a -> T.Text
replySubject :: CharsetLookup -> Message ctx a -> Text
replySubject CharsetLookup
charsets Message ctx a
msg = if Bool
prefixed then Text
orig else Text
"Re: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
orig
where
orig :: Text
orig = Maybe Text -> Text
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold (Maybe Text -> Text) -> Maybe Text -> Text
forall a b. (a -> b) -> a -> b
$ Getting (Maybe Text) (Message ctx a) (Maybe Text)
-> Message ctx a -> Maybe Text
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view (CharsetLookup -> Lens' (Message ctx a) (Maybe Text)
forall a. HasHeaders a => CharsetLookup -> Lens' a (Maybe Text)
headerSubject CharsetLookup
charsets) Message ctx a
msg
prefixed :: Bool
prefixed = Text -> CI Text
forall s. FoldCase s => s -> CI s
mk (Int -> Text -> Text
T.take Int
3 Text
orig) CI Text -> CI Text -> Bool
forall a. Eq a => a -> a -> Bool
== CI Text
"Re:"
reply
:: CharsetLookup
-> ReplySettings
-> Message ctx a
-> Message ctx ()
reply :: CharsetLookup -> ReplySettings -> Message ctx a -> Message ctx ()
reply CharsetLookup
charsets ReplySettings
settings Message ctx a
msg =
let
self :: AuthorMailboxes
self = Getting AuthorMailboxes ReplySettings AuthorMailboxes
-> ReplySettings -> AuthorMailboxes
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting AuthorMailboxes ReplySettings AuthorMailboxes
Lens ReplySettings ReplySettings AuthorMailboxes AuthorMailboxes
authorMailboxes ReplySettings
settings
getAddrSpec :: Mailbox -> AddrSpec
getAddrSpec :: Mailbox -> AddrSpec
getAddrSpec (Mailbox Maybe Text
_ AddrSpec
addr) = AddrSpec
addr
findMatchingMailbox
:: (Foldable t)
=> t Mailbox -> Address -> Maybe Mailbox
findMatchingMailbox :: t Mailbox -> Address -> Maybe Mailbox
findMatchingMailbox t Mailbox
xs (Single Mailbox
addr) =
Mailbox -> Mailbox
f (Mailbox -> Mailbox) -> Maybe Mailbox -> Maybe Mailbox
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Mailbox -> Bool) -> t Mailbox -> Maybe Mailbox
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find ((AddrSpec -> AddrSpec -> Bool)
-> (Mailbox -> AddrSpec) -> Mailbox -> Mailbox -> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
on AddrSpec -> AddrSpec -> Bool
forall a. Eq a => a -> a -> Bool
(==) Mailbox -> AddrSpec
getAddrSpec Mailbox
addr) t Mailbox
xs
where
f :: Mailbox -> Mailbox
f = case Getting ReplyFromRewriteMode ReplySettings ReplyFromRewriteMode
-> ReplySettings -> ReplyFromRewriteMode
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting ReplyFromRewriteMode ReplySettings ReplyFromRewriteMode
Lens
ReplySettings
ReplySettings
ReplyFromRewriteMode
ReplyFromRewriteMode
replyFromRewriteMode ReplySettings
settings of
ReplyFromRewriteMode
ReplyFromRewriteOn -> Mailbox -> Mailbox
forall a. a -> a
id
ReplyFromRewriteMode
ReplyFromRewriteOff -> Mailbox -> Mailbox -> Mailbox
forall a b. a -> b -> a
const Mailbox
addr
findMatchingMailbox t Mailbox
_ Address
_ = Maybe Mailbox
forall a. Maybe a
Nothing
getSelf :: Address -> Maybe Mailbox
getSelf :: Address -> Maybe Mailbox
getSelf = AuthorMailboxes -> Address -> Maybe Mailbox
forall (t :: * -> *).
Foldable t =>
t Mailbox -> Address -> Maybe Mailbox
findMatchingMailbox AuthorMailboxes
self
isSelf :: Address -> Bool
isSelf :: Address -> Bool
isSelf = Maybe Mailbox -> Bool
forall a. Maybe a -> Bool
isJust (Maybe Mailbox -> Bool)
-> (Address -> Maybe Mailbox) -> Address -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Address -> Maybe Mailbox
getSelf
findSelf :: Maybe Mailbox
findSelf =
let
parentTo :: [Address]
parentTo = Getting [Address] (Message ctx a) [Address]
-> Message ctx a -> [Address]
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view (CharsetLookup -> Lens' (Message ctx a) [Address]
forall a. HasHeaders a => CharsetLookup -> Lens' a [Address]
headerTo CharsetLookup
charsets) Message ctx a
msg
parentCc :: [Address]
parentCc = Getting [Address] (Message ctx a) [Address]
-> Message ctx a -> [Address]
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view (CharsetLookup -> Lens' (Message ctx a) [Address]
forall a. HasHeaders a => CharsetLookup -> Lens' a [Address]
headerCC CharsetLookup
charsets) Message ctx a
msg
in
First Mailbox -> Maybe Mailbox
forall a. First a -> Maybe a
getFirst (First Mailbox -> Maybe Mailbox) -> First Mailbox -> Maybe Mailbox
forall a b. (a -> b) -> a -> b
$ (Address -> First Mailbox) -> [Address] -> First Mailbox
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (Maybe Mailbox -> First Mailbox
forall a. Maybe a -> First a
First (Maybe Mailbox -> First Mailbox)
-> (Address -> Maybe Mailbox) -> Address -> First Mailbox
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Address -> Maybe Mailbox
getSelf) ([Address]
parentTo [Address] -> [Address] -> [Address]
forall a. Semigroup a => a -> a -> a
<> [Address]
parentCc)
filterSelf :: [Address] -> [Address]
filterSelf = case Getting SelfInRecipientsMode ReplySettings SelfInRecipientsMode
-> ReplySettings -> SelfInRecipientsMode
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting SelfInRecipientsMode ReplySettings SelfInRecipientsMode
Lens
ReplySettings
ReplySettings
SelfInRecipientsMode
SelfInRecipientsMode
selfInRecipientsMode ReplySettings
settings of
SelfInRecipientsMode
SelfInRecipientsRemove -> (Address -> Bool) -> [Address] -> [Address]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (Address -> Bool) -> Address -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Address -> Bool
isSelf)
SelfInRecipientsMode
SelfInRecipientsIgnore -> [Address] -> [Address]
forall a. a -> a
id
([Address]
t, [Address]
c) = CharsetLookup
-> ReplySettings -> Message ctx a -> ([Address], [Address])
forall ctx a.
CharsetLookup
-> ReplySettings -> Message ctx a -> ([Address], [Address])
replyRecipients CharsetLookup
charsets ReplySettings
settings Message ctx a
msg
_To :: [Address]
_To = [Address] -> [Address]
filterSelf [Address]
t
_To_mailboxes :: [Mailbox]
_To_mailboxes = (Address -> Maybe Mailbox) -> [Address] -> [Mailbox]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (\case Single Mailbox
a -> Mailbox -> Maybe Mailbox
forall a. a -> Maybe a
Just Mailbox
a ; Address
_ -> Maybe Mailbox
forall a. Maybe a
Nothing) [Address]
_To
_Cc :: [Address]
_Cc = [Address]
c
[Address] -> ([Address] -> [Address]) -> [Address]
forall a b. a -> (a -> b) -> b
& [Address] -> [Address]
filterSelf
[Address] -> ([Address] -> [Address]) -> [Address]
forall a b. a -> (a -> b) -> b
& (Address -> Bool) -> [Address] -> [Address]
forall a. (a -> Bool) -> [a] -> [a]
filter (Maybe Mailbox -> Bool
forall a. Maybe a -> Bool
isNothing (Maybe Mailbox -> Bool)
-> (Address -> Maybe Mailbox) -> Address -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Mailbox] -> Address -> Maybe Mailbox
forall (t :: * -> *).
Foldable t =>
t Mailbox -> Address -> Maybe Mailbox
findMatchingMailbox [Mailbox]
_To_mailboxes)
_From :: Mailbox
_From =
let preferred :: Mailbox
preferred = AuthorMailboxes -> Mailbox
forall a. NonEmpty a -> a
Data.List.NonEmpty.head AuthorMailboxes
self
in
case Getting ReplyFromMode ReplySettings ReplyFromMode
-> ReplySettings -> ReplyFromMode
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting ReplyFromMode ReplySettings ReplyFromMode
Lens ReplySettings ReplySettings ReplyFromMode ReplyFromMode
replyFromMode ReplySettings
settings of
ReplyFromMode
ReplyFromPreferredMailbox -> Mailbox
preferred
ReplyFromMode
ReplyFromMatchingMailbox -> Mailbox -> Maybe Mailbox -> Mailbox
forall a. a -> Maybe a -> a
fromMaybe Mailbox
preferred Maybe Mailbox
findSelf
hdrs :: Headers
hdrs = [(CI ByteString, ByteString)] -> Headers
Headers []
Headers -> (Headers -> Headers) -> Headers
forall a b. a -> (a -> b) -> b
& ASetter Headers Headers [Address] [Address]
-> [Address] -> Headers -> Headers
forall s t a b. ASetter s t a b -> b -> s -> t
set (CharsetLookup -> Lens' Headers [Address]
forall a. HasHeaders a => CharsetLookup -> Lens' a [Address]
headerFrom CharsetLookup
charsets) [Mailbox -> Address
Single Mailbox
_From]
Headers -> (Headers -> Headers) -> Headers
forall a b. a -> (a -> b) -> b
& ASetter Headers Headers [Address] [Address]
-> [Address] -> Headers -> Headers
forall s t a b. ASetter s t a b -> b -> s -> t
set (CharsetLookup -> Lens' Headers [Address]
forall a. HasHeaders a => CharsetLookup -> Lens' a [Address]
headerTo CharsetLookup
charsets) ([Address] -> [Address]
filterSelf [Address]
_To)
Headers -> (Headers -> Headers) -> Headers
forall a b. a -> (a -> b) -> b
& ASetter Headers Headers [Address] [Address]
-> [Address] -> Headers -> Headers
forall s t a b. ASetter s t a b -> b -> s -> t
set (CharsetLookup -> Lens' Headers [Address]
forall a. HasHeaders a => CharsetLookup -> Lens' a [Address]
headerCC CharsetLookup
charsets) ([Address] -> [Address]
filterSelf [Address]
_Cc)
Headers -> (Headers -> Headers) -> Headers
forall a b. a -> (a -> b) -> b
& ASetter Headers Headers [MessageID] [MessageID]
-> [MessageID] -> Headers -> Headers
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter Headers Headers [MessageID] [MessageID]
forall a. HasHeaders a => Lens' a [MessageID]
headerInReplyTo (Maybe MessageID -> [MessageID]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (Maybe MessageID -> [MessageID]) -> Maybe MessageID -> [MessageID]
forall a b. (a -> b) -> a -> b
$ Getting (Maybe MessageID) (Message ctx a) (Maybe MessageID)
-> Message ctx a -> Maybe MessageID
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting (Maybe MessageID) (Message ctx a) (Maybe MessageID)
forall a. HasHeaders a => Lens' a (Maybe MessageID)
headerMessageID Message ctx a
msg)
Headers -> (Headers -> Headers) -> Headers
forall a b. a -> (a -> b) -> b
& ASetter Headers Headers [MessageID] [MessageID]
-> [MessageID] -> Headers -> Headers
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter Headers Headers [MessageID] [MessageID]
forall a. HasHeaders a => Lens' a [MessageID]
headerReferences (Message ctx a -> [MessageID]
forall ctx a. Message ctx a -> [MessageID]
replyReferences Message ctx a
msg)
Headers -> (Headers -> Headers) -> Headers
forall a b. a -> (a -> b) -> b
& ASetter Headers Headers (Maybe Text) (Maybe Text)
-> Maybe Text -> Headers -> Headers
forall s t a b. ASetter s t a b -> b -> s -> t
set (CharsetLookup -> Lens' Headers (Maybe Text)
forall a. HasHeaders a => CharsetLookup -> Lens' a (Maybe Text)
headerSubject CharsetLookup
charsets) (Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ CharsetLookup -> Message ctx a -> Text
forall ctx a. CharsetLookup -> Message ctx a -> Text
replySubject CharsetLookup
charsets Message ctx a
msg)
in
Headers -> () -> Message ctx ()
forall s a. Headers -> a -> Message s a
Message Headers
hdrs ()
data BodyHandler a
= RequiredBody (Parser a)
| OptionalBody (Parser a, a)
| NoBody a
message :: (Headers -> BodyHandler a) -> Parser (Message (MessageContext a) a)
message :: (Headers -> BodyHandler a) -> Parser (Message (MessageContext a) a)
message Headers -> BodyHandler a
f = Parser Headers
fields Parser Headers
-> (Headers -> Parser (Message (MessageContext a) a))
-> Parser (Message (MessageContext a) a)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Headers
hdrs -> Headers -> a -> Message (MessageContext a) a
forall s a. Headers -> a -> Message s a
Message Headers
hdrs (a -> Message (MessageContext a) a)
-> Parser ByteString a -> Parser (Message (MessageContext a) a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> case Headers -> BodyHandler a
f Headers
hdrs of
RequiredBody Parser ByteString a
b -> Parser ByteString ()
forall (f :: * -> * -> *) s a.
(Alternative (f s), CharParsing f s a) =>
f s ()
crlf Parser ByteString () -> Parser ByteString a -> Parser ByteString a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ByteString a
b
OptionalBody (Parser ByteString a
b, a
a) -> Parser ByteString () -> Parser ByteString (Maybe ())
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional Parser ByteString ()
forall (f :: * -> * -> *) s a.
(Alternative (f s), CharParsing f s a) =>
f s ()
crlf Parser ByteString (Maybe ())
-> (Maybe () -> Parser ByteString a) -> Parser ByteString a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Parser ByteString a
-> (() -> Parser ByteString a) -> Maybe () -> Parser ByteString a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
a) (Parser ByteString a -> () -> Parser ByteString a
forall a b. a -> b -> a
const Parser ByteString a
b)
NoBody a
b -> a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
b
type family MessageContext a
fields :: Parser Headers
fields :: Parser Headers
fields = [(CI ByteString, ByteString)] -> Headers
Headers ([(CI ByteString, ByteString)] -> Headers)
-> Parser ByteString [(CI ByteString, ByteString)]
-> Parser Headers
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString (CI ByteString, ByteString)
-> Parser ByteString [(CI ByteString, ByteString)]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many Parser ByteString (CI ByteString, ByteString)
field
class RenderMessage a where
buildBody :: Headers -> a -> Maybe Builder.Builder
:: a -> Headers -> Headers
tweakHeaders a
_ = Headers -> Headers
forall a. a -> a
id
buildMessage :: forall ctx a. (RenderMessage a) => Message ctx a -> Builder.Builder
buildMessage :: Message ctx a -> Builder
buildMessage (Message Headers
h a
b) =
Headers -> Builder
buildFields (a -> Headers -> Headers
forall a. RenderMessage a => a -> Headers -> Headers
tweakHeaders a
b Headers
h)
Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder -> (Builder -> Builder) -> Maybe Builder -> Builder
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Builder
forall a. Monoid a => a
mempty (Builder
"\r\n" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<>) (Headers -> a -> Maybe Builder
forall a. RenderMessage a => Headers -> a -> Maybe Builder
buildBody Headers
h a
b)
renderMessage :: (RenderMessage a) => Message ctx a -> L.ByteString
renderMessage :: Message ctx a -> ByteString
renderMessage = Builder -> ByteString
Builder.toLazyByteString (Builder -> ByteString)
-> (Message ctx a -> Builder) -> Message ctx a -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Message ctx a -> Builder
forall ctx a. RenderMessage a => Message ctx a -> Builder
buildMessage
buildFields :: Headers -> Builder.Builder
buildFields :: Headers -> Builder
buildFields = Getting Builder Headers (CI ByteString, ByteString)
-> ((CI ByteString, ByteString) -> Builder) -> Headers -> Builder
forall r s a. Getting r s a -> (a -> r) -> s -> r
foldMapOf (([(CI ByteString, ByteString)]
-> Const Builder [(CI ByteString, ByteString)])
-> Headers -> Const Builder Headers
Iso
Headers
Headers
[(CI ByteString, ByteString)]
[(CI ByteString, ByteString)]
hdriso (([(CI ByteString, ByteString)]
-> Const Builder [(CI ByteString, ByteString)])
-> Headers -> Const Builder Headers)
-> (((CI ByteString, ByteString)
-> Const Builder (CI ByteString, ByteString))
-> [(CI ByteString, ByteString)]
-> Const Builder [(CI ByteString, ByteString)])
-> Getting Builder Headers (CI ByteString, ByteString)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((CI ByteString, ByteString)
-> Const Builder (CI ByteString, ByteString))
-> [(CI ByteString, ByteString)]
-> Const Builder [(CI ByteString, ByteString)]
forall (f :: * -> *) a b.
Traversable f =>
IndexedTraversal Int (f a) (f b) a b
traversed) (CI ByteString, ByteString) -> Builder
buildField
buildField :: (CI B.ByteString, B.ByteString) -> Builder.Builder
buildField :: (CI ByteString, ByteString) -> Builder
buildField (CI ByteString
k,ByteString
v) =
let key :: ByteString
key = CI ByteString -> ByteString
forall s. CI s -> s
original CI ByteString
k
in
ByteString -> Builder
Builder.byteString ByteString
key
Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
":"
Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ByteString -> Int -> Builder
foldUnstructured ByteString
v (ByteString -> Int
B.length ByteString
key Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
"\r\n"
foldUnstructured :: B.ByteString -> Int -> Builder.Builder
foldUnstructured :: ByteString -> Int -> Builder
foldUnstructured ByteString
s Int
i = case ByteString -> [ByteString]
Char8.words ByteString
s of
[] -> Builder
forall a. Monoid a => a
mempty
(ByteString
h:[ByteString]
t) ->
Builder
" " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ByteString -> Builder
Builder.byteString ByteString
h Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> [ByteString] -> Int -> Builder
go [ByteString]
t (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ ByteString -> Int
B.length ByteString
h)
where
limit :: Int
limit = Int
76
go :: [ByteString] -> Int -> Builder
go [] Int
_ = Builder
forall a. Monoid a => a
mempty
go (ByteString
chunk:[ByteString]
chunks) Int
col
| Int
col Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
1 Bool -> Bool -> Bool
|| Int
col Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ ByteString -> Int
B.length ByteString
chunk Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
limit =
Builder
" " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ByteString -> Builder
Builder.byteString ByteString
chunk Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> [ByteString] -> Int -> Builder
go [ByteString]
chunks (Int
col Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ ByteString -> Int
B.length ByteString
chunk)
| Bool
otherwise = Builder
"\r\n" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> [ByteString] -> Int -> Builder
go (ByteString
chunkByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
:[ByteString]
chunks) Int
0
isFtext :: Word8 -> Bool
isFtext :: Word8 -> Bool
isFtext 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
57) Bool -> Bool -> Bool
|| (Word8
c Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
>= Word8
59 Bool -> Bool -> Bool
&& Word8
c Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word8
126)
field :: Parser (CI B.ByteString, B.ByteString)
field :: Parser ByteString (CI ByteString, ByteString)
field = (,)
(CI ByteString -> ByteString -> (CI ByteString, ByteString))
-> Parser ByteString (CI ByteString)
-> Parser ByteString (ByteString -> (CI ByteString, ByteString))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString ByteString -> Parser ByteString (CI ByteString)
forall s. FoldCase s => Parser s -> Parser (CI s)
ci ((Word8 -> Bool) -> Parser ByteString ByteString
takeWhile1 Word8 -> Bool
isFtext)
Parser ByteString (ByteString -> (CI ByteString, ByteString))
-> Parser ByteString Word8
-> Parser ByteString (ByteString -> (CI ByteString, ByteString))
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Char -> Parser ByteString Word8
char8 Char
':' Parser ByteString (ByteString -> (CI ByteString, ByteString))
-> Parser ByteString [Word8]
-> Parser ByteString (ByteString -> (CI ByteString, ByteString))
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ByteString Word8 -> Parser ByteString [Word8]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many Parser ByteString Word8
forall (f :: * -> * -> *) s a. CharParsing f s a => f s a
wsp
Parser ByteString (ByteString -> (CI ByteString, ByteString))
-> Parser ByteString ByteString
-> Parser ByteString (CI ByteString, ByteString)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ByteString ByteString
unstructured Parser ByteString (CI ByteString, ByteString)
-> Parser ByteString ()
-> Parser ByteString (CI ByteString, ByteString)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ByteString ()
forall (f :: * -> * -> *) s a.
(Alternative (f s), CharParsing f s a) =>
f s ()
crlf
unstructured :: Parser B.ByteString
unstructured :: Parser ByteString ByteString
unstructured =
Parser ByteString ByteString -> Parser ByteString ByteString
forall m (f :: * -> *). (Monoid m, Alternative f) => f m -> f m
foldMany (Parser ByteString ByteString
forall (f :: * -> * -> *) s a.
(Alternative (f s), CharParsing f s a, SM s) =>
f s s
optionalFWS Parser ByteString ByteString
-> Parser ByteString ByteString -> Parser ByteString ByteString
forall m (f :: * -> *).
(Semigroup m, Applicative f) =>
f m -> f m -> f m
<<>> (Word8 -> ByteString
B.singleton (Word8 -> ByteString)
-> Parser ByteString Word8 -> Parser ByteString ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString Word8
forall (f :: * -> * -> *) s a. CharParsing f s a => f s a
vchar))
Parser ByteString ByteString
-> Parser ByteString ByteString -> Parser ByteString ByteString
forall m (f :: * -> *).
(Semigroup m, Applicative f) =>
f m -> f m -> f m
<<>> (Word8 -> Bool) -> Parser ByteString ByteString
A.takeWhile Word8 -> Bool
forall c. IsChar c => c -> Bool
isWsp
parsed :: (Cons s s Word8 Word8) => Parser a -> Fold s a
parsed :: Parser a -> Fold s a
parsed Parser a
p = (s -> Either String a) -> Optic' (->) f s (Either String a)
forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to (Parser a -> s -> Either String a
forall s a.
Cons s s Word8 Word8 =>
Parser a -> s -> Either String a
parse Parser a
p) Optic' (->) f s (Either String a)
-> ((a -> f a) -> Either String a -> f (Either String a))
-> (a -> f a)
-> s
-> f s
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> f a) -> Either String a -> f (Either String a)
forall (f :: * -> *) a. Foldable f => IndexedFold Int (f a) a
folded
{-# INLINE parsed #-}
parsePrint :: Parser a -> (a -> B.ByteString) -> Prism' B.ByteString a
parsePrint :: Parser a -> (a -> ByteString) -> Prism' ByteString a
parsePrint Parser a
fwd a -> ByteString
rev = (a -> ByteString) -> (ByteString -> Maybe a) -> Prism' ByteString a
forall b s a. (b -> s) -> (s -> Maybe a) -> Prism s s a b
prism' a -> ByteString
rev (Result a -> Maybe a
forall r. Result r -> Maybe r
AL.maybeResult (Result a -> Maybe a)
-> (ByteString -> Result a) -> ByteString -> Maybe a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parser a -> ByteString -> Result a
forall a. Parser a -> ByteString -> Result a
AL.parse Parser a
fwd (ByteString -> Result a)
-> (ByteString -> ByteString) -> ByteString -> Result a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting ByteString ByteString ByteString
-> ByteString -> ByteString
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting ByteString ByteString ByteString
forall s1 a s2.
(Cons s1 s1 a a, Cons s2 s2 a a, AsEmpty s2) =>
Getter s1 s2
recons)
parse :: (Cons s s Word8 Word8) => Parser a -> s -> Either String a
parse :: Parser a -> s -> Either String a
parse Parser a
p = Result a -> Either String a
forall r. Result r -> Either String r
AL.eitherResult (Result a -> Either String a)
-> (s -> Result a) -> s -> Either String a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parser a -> ByteString -> Result a
forall a. Parser a -> ByteString -> Result a
AL.parse Parser a
p (ByteString -> Result a) -> (s -> ByteString) -> s -> Result a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting ByteString s ByteString -> s -> ByteString
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting ByteString s ByteString
forall s1 a s2.
(Cons s1 s1 a a, Cons s2 s2 a a, AsEmpty s2) =>
Getter s1 s2
recons
{-# INLINE parse #-}
data Mailbox =
Mailbox (Maybe T.Text )
AddrSpec
deriving (Int -> Mailbox -> ShowS
[Mailbox] -> ShowS
Mailbox -> String
(Int -> Mailbox -> ShowS)
-> (Mailbox -> String) -> ([Mailbox] -> ShowS) -> Show Mailbox
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Mailbox] -> ShowS
$cshowList :: [Mailbox] -> ShowS
show :: Mailbox -> String
$cshow :: Mailbox -> String
showsPrec :: Int -> Mailbox -> ShowS
$cshowsPrec :: Int -> Mailbox -> ShowS
Show, Mailbox -> Mailbox -> Bool
(Mailbox -> Mailbox -> Bool)
-> (Mailbox -> Mailbox -> Bool) -> Eq Mailbox
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Mailbox -> Mailbox -> Bool
$c/= :: Mailbox -> Mailbox -> Bool
== :: Mailbox -> Mailbox -> Bool
$c== :: Mailbox -> Mailbox -> Bool
Eq, (forall x. Mailbox -> Rep Mailbox x)
-> (forall x. Rep Mailbox x -> Mailbox) -> Generic Mailbox
forall x. Rep Mailbox x -> Mailbox
forall x. Mailbox -> Rep Mailbox x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Mailbox x -> Mailbox
$cfrom :: forall x. Mailbox -> Rep Mailbox x
Generic, Mailbox -> ()
(Mailbox -> ()) -> NFData Mailbox
forall a. (a -> ()) -> NFData a
rnf :: Mailbox -> ()
$crnf :: Mailbox -> ()
NFData)
instance IsString Mailbox where
fromString :: String -> Mailbox
fromString =
(String -> Mailbox)
-> (Mailbox -> Mailbox) -> Either String Mailbox -> Mailbox
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (String -> Mailbox
forall a. HasCallStack => String -> a
error (String -> Mailbox) -> ShowS -> String -> Mailbox
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
forall a. Monoid a => a -> a -> a
mappend String
"Failed to parse Mailbox: ") Mailbox -> Mailbox
forall a. a -> a
id (Either String Mailbox -> Mailbox)
-> (String -> Either String Mailbox) -> String -> Mailbox
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Either String Mailbox
readMailbox
data AddrSpec =
AddrSpec B.ByteString
Domain
deriving (Int -> AddrSpec -> ShowS
[AddrSpec] -> ShowS
AddrSpec -> String
(Int -> AddrSpec -> ShowS)
-> (AddrSpec -> String) -> ([AddrSpec] -> ShowS) -> Show AddrSpec
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AddrSpec] -> ShowS
$cshowList :: [AddrSpec] -> ShowS
show :: AddrSpec -> String
$cshow :: AddrSpec -> String
showsPrec :: Int -> AddrSpec -> ShowS
$cshowsPrec :: Int -> AddrSpec -> ShowS
Show, AddrSpec -> AddrSpec -> Bool
(AddrSpec -> AddrSpec -> Bool)
-> (AddrSpec -> AddrSpec -> Bool) -> Eq AddrSpec
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AddrSpec -> AddrSpec -> Bool
$c/= :: AddrSpec -> AddrSpec -> Bool
== :: AddrSpec -> AddrSpec -> Bool
$c== :: AddrSpec -> AddrSpec -> Bool
Eq, (forall x. AddrSpec -> Rep AddrSpec x)
-> (forall x. Rep AddrSpec x -> AddrSpec) -> Generic AddrSpec
forall x. Rep AddrSpec x -> AddrSpec
forall x. AddrSpec -> Rep AddrSpec x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep AddrSpec x -> AddrSpec
$cfrom :: forall x. AddrSpec -> Rep AddrSpec x
Generic, AddrSpec -> ()
(AddrSpec -> ()) -> NFData AddrSpec
forall a. (a -> ()) -> NFData a
rnf :: AddrSpec -> ()
$crnf :: AddrSpec -> ()
NFData)
data Address
= Single Mailbox
| Group T.Text
[Mailbox]
deriving (Int -> Address -> ShowS
[Address] -> ShowS
Address -> String
(Int -> Address -> ShowS)
-> (Address -> String) -> ([Address] -> ShowS) -> Show Address
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Address] -> ShowS
$cshowList :: [Address] -> ShowS
show :: Address -> String
$cshow :: Address -> String
showsPrec :: Int -> Address -> ShowS
$cshowsPrec :: Int -> Address -> ShowS
Show, Address -> Address -> Bool
(Address -> Address -> Bool)
-> (Address -> Address -> Bool) -> Eq Address
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Address -> Address -> Bool
$c/= :: Address -> Address -> Bool
== :: Address -> Address -> Bool
$c== :: Address -> Address -> Bool
Eq, (forall x. Address -> Rep Address x)
-> (forall x. Rep Address x -> Address) -> Generic Address
forall x. Rep Address x -> Address
forall x. Address -> Rep Address x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Address x -> Address
$cfrom :: forall x. Address -> Rep Address x
Generic, Address -> ()
(Address -> ()) -> NFData Address
forall a. (a -> ()) -> NFData a
rnf :: Address -> ()
$crnf :: Address -> ()
NFData)
data Domain
= DomainDotAtom (NonEmpty (CI B.ByteString) )
| DomainLiteral B.ByteString
deriving (Int -> Domain -> ShowS
[Domain] -> ShowS
Domain -> String
(Int -> Domain -> ShowS)
-> (Domain -> String) -> ([Domain] -> ShowS) -> Show Domain
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Domain] -> ShowS
$cshowList :: [Domain] -> ShowS
show :: Domain -> String
$cshow :: Domain -> String
showsPrec :: Int -> Domain -> ShowS
$cshowsPrec :: Int -> Domain -> ShowS
Show, Domain -> Domain -> Bool
(Domain -> Domain -> Bool)
-> (Domain -> Domain -> Bool) -> Eq Domain
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Domain -> Domain -> Bool
$c/= :: Domain -> Domain -> Bool
== :: Domain -> Domain -> Bool
$c== :: Domain -> Domain -> Bool
Eq, (forall x. Domain -> Rep Domain x)
-> (forall x. Rep Domain x -> Domain) -> Generic Domain
forall x. Rep Domain x -> Domain
forall x. Domain -> Rep Domain x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Domain x -> Domain
$cfrom :: forall x. Domain -> Rep Domain x
Generic, Domain -> ()
(Domain -> ()) -> NFData Domain
forall a. (a -> ()) -> NFData a
rnf :: Domain -> ()
$crnf :: Domain -> ()
NFData)