{-# 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
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
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. 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 -> ()
forall a. (a -> ()) -> NFData a
rnf :: Headers -> ()
$crnf :: Headers -> ()
NFData)
class a where
:: Lens' a Headers
instance HasHeaders Headers where
headers :: Lens' Headers Headers
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 = forall a. HasHeaders a => CI ByteString -> Traversal' a ByteString
header
hdriso :: Iso' Headers [(CI B.ByteString, B.ByteString)]
hdriso :: Iso' Headers [Header]
hdriso = forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso (\(Headers [Header]
xs) -> [Header]
xs) [Header] -> Headers
Headers
instance At Headers where
at :: Index Headers -> Lens' Headers (Maybe (IxValue Headers))
at Index Headers
k = Iso' Headers [Header]
hdriso forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' [Header] (Maybe ByteString)
l
where
l :: Lens' [(CI B.ByteString, B.ByteString)] (Maybe B.ByteString)
l :: Lens' [Header] (Maybe ByteString)
l Maybe ByteString -> f (Maybe ByteString)
f [Header]
kv =
let
i :: Maybe Int
i = forall a. (a -> Bool) -> [a] -> Maybe Int
findIndex ((forall a. Eq a => a -> a -> Bool
== Index Headers
k) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst) [Header]
kv
g :: Maybe ByteString -> [Header]
g Maybe ByteString
Nothing = forall b a. b -> (a -> b) -> Maybe a -> b
maybe [Header]
kv (\Int
j -> forall a. Int -> [a] -> [a]
take Int
j [Header]
kv forall a. Semigroup a => a -> a -> a
<> forall a. Int -> [a] -> [a]
drop (Int
j forall a. Num a => a -> a -> a
+ Int
1) [Header]
kv) Maybe Int
i
g (Just ByteString
v) = forall b a. b -> (a -> b) -> Maybe a -> b
maybe ((Index Headers
k,ByteString
v)forall a. a -> [a] -> [a]
:[Header]
kv) (\Int
j -> forall s t a b. ASetter s t a b -> b -> s -> t
set (forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix Int
j) (Index Headers
k,ByteString
v) [Header]
kv) Maybe Int
i
in
Maybe ByteString -> [Header]
g forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe ByteString -> f (Maybe ByteString)
f (forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Index Headers
k [Header]
kv)
header :: HasHeaders a => CI B.ByteString -> Traversal' a B.ByteString
CI ByteString
k = forall a. HasHeaders a => Lens' a [Header]
headerList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b.
Traversable f =>
IndexedTraversal Int (f a) (f b) a b
traversed forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (p :: * -> * -> *) (f :: * -> *) a.
(Choice p, Applicative f) =>
(a -> Bool) -> Optic' p f a a
filtered ((CI ByteString
k forall a. Eq a => a -> a -> Bool
==) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst) forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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
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 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, 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 :: Lens' (Message s a) Headers
headers Headers -> f Headers
f (Message Headers
h a
b) = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall s a. Headers -> a -> Message s a
`Message` a
b) (Headers -> f Headers
f Headers
h)
instance Functor (Message s) where
fmap :: forall a b. (a -> b) -> Message s a -> Message s b
fmap a -> b
f (Message Headers
h a
a) = 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 forall a. Eq a => a -> a -> Bool
== Headers
h2 Bool -> Bool -> Bool
&& a
b1 forall a. Eq a => a -> a -> Bool
== a
b2
instance EqMessage a => Eq (Message s a) where
== :: 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)]
= forall a. HasHeaders a => Lens' a Headers
headers forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 :: forall ctx a ctx' b. Lens (Message ctx a) (Message ctx' b) a b
body a -> f b
f (Message Headers
h a
b) = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\b
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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t. FormatTime t => TimeLocale -> String -> t -> String
formatTime TimeLocale
defaultTimeLocale String
rfc5322DateTimeFormat
headerDate :: HasHeaders a => Lens' a (Maybe ZonedTime)
= forall a. HasHeaders a => Lens' a Headers
headers forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at CI ByteString
"Date" forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso (forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ByteString -> Maybe ZonedTime
p) (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ZonedTime -> ByteString
renderRFC5322Date)
where
p :: ByteString -> Maybe ZonedTime
p = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall a b. a -> b -> a
const forall a. Maybe a
Nothing) forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Parser a -> ByteString -> Either String a
parseOnly (Parser ByteString ZonedTime
dateTime forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall t. Chunk t => Parser t ()
endOfInput)
buildMailbox :: Mailbox -> Builder.Builder
buildMailbox :: Mailbox -> Builder
buildMailbox (Mailbox Maybe Text
n AddrSpec
a) =
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Builder
a' (\Text
n' -> Text -> Builder
buildPhrase Text
n' forall a. Semigroup a => a -> a -> a
<> Builder
" <" forall a. Semigroup a => a -> a -> a
<> Builder
a' 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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. HasTransferEncoding a => TransferDecoded a -> a
transferEncode forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. HasCharset a => Decoded a -> a
charsetEncode forall a b. (a -> b) -> a -> b
$ Text
s
where
enc :: Text -> PhraseEscapeRequirement
enc = forall a b. (a, b) -> b
snd forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 forall a. Semigroup a => a -> a -> a
<> PhraseEscapeRequirement
req)) (Char
'\0', forall a. Monoid a => a
mempty)
encChar :: Char -> Char -> PhraseEscapeRequirement
encChar Char
prev Char
c
| forall c. IsChar c => c -> Bool
isAtext Char
c = PhraseEscapeRequirement
PhraseAtom
| forall c. IsChar c => c -> Bool
isQtext Char
c = PhraseEscapeRequirement
PhraseQuotedString
| forall c. IsChar c => c -> Bool
isVchar Char
c = PhraseEscapeRequirement
PhraseQuotedString
| Char
c forall a. Eq a => a -> a -> Bool
== Char
' ' =
if Char
prev 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
"\"" forall a. Semigroup a => a -> a -> a
<> BoundedPrim Word8 -> Text -> Builder
T.encodeUtf8BuilderEscaped (Bool -> BoundedPrim Word8
escPrim Bool
escSpace) Text
s forall a. Semigroup a => a -> a -> a
<> Builder
"\""
escPrim :: Bool -> BoundedPrim Word8
escPrim Bool
escSpace = forall a.
(a -> Bool) -> BoundedPrim a -> BoundedPrim a -> BoundedPrim a
Prim.condB (\Word8
c -> forall c. IsChar c => c -> Bool
isQtext Word8
c Bool -> Bool -> Bool
|| Bool -> Bool
not Bool
escSpace Bool -> Bool -> Bool
&& Word8
c forall a. Eq a => a -> a -> Bool
== Word8
32)
(forall a. FixedPrim a -> BoundedPrim a
Prim.liftFixedToBounded FixedPrim Word8
Prim.word8)
(forall a. FixedPrim a -> BoundedPrim a
Prim.liftFixedToBounded forall a b. (a -> b) -> a -> b
$ (forall a. IsChar a => Char -> a
fromChar Char
'\\',) forall (f :: * -> *) b a. Contravariant f => (b -> a) -> f a -> f b
Prim.>$< FixedPrim Word8
Prim.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
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
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
Ord)
instance Semigroup PhraseEscapeRequirement where
PhraseEscapeRequirement
PhraseEncodedWord <> :: PhraseEscapeRequirement
-> PhraseEscapeRequirement -> PhraseEscapeRequirement
<> PhraseEscapeRequirement
_ =
PhraseEscapeRequirement
PhraseEncodedWord
PhraseEscapeRequirement
l <> PhraseEscapeRequirement
r = 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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> ByteString
Builder.toLazyByteString forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Mailbox] -> Builder
buildMailboxes
buildMailboxes :: [Mailbox] -> Builder.Builder
buildMailboxes :: [Mailbox] -> Builder
buildMailboxes = forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> [a] -> [a]
Data.List.intersperse Builder
", " forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> ByteString
Builder.toLazyByteString 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 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (CharsetLookup -> Parser Text
displayName CharsetLookup
charsets) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser AddrSpec
angleAddr
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe Text -> AddrSpec -> Mailbox
Mailbox forall a. Maybe a
Nothing forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser AddrSpec
addressSpec
phrase :: CharsetLookup -> Parser T.Text
phrase :: CharsetLookup -> Parser Text
phrase CharsetLookup
charsets = forall m (f :: * -> *).
(Semigroup m, Alternative f) =>
m -> f m -> f m
foldMany1Sep Text
" " forall a b. (a -> b) -> a -> b
$
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
( forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (CharsetLookup -> EncodedWord -> Text
decodeEncodedWord CharsetLookup
charsets) )
( (Parser ByteString ByteString
"=?" forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ByteString EncodedWord
encodedWord) forall (f :: * -> *) a s. Alternative f => f a -> f s -> f [a]
`sepBy1` Char -> Parser Word8
char8 Char
' ' )
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ByteString -> Text
decodeLenient 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 Text
displayName = CharsetLookup -> Parser Text
phrase
angleAddr :: Parser AddrSpec
angleAddr :: Parser AddrSpec
angleAddr = forall (f :: * -> * -> *) s a.
(Alternative (f s), CharParsing f s a, SM s) =>
f s s
optionalCFWS forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*>
Char -> Parser Word8
char8 Char
'<' forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser AddrSpec
addressSpec forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Char -> Parser Word8
char8 Char
'>'
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* 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
"\"" forall a. Semigroup a => a -> a -> a
<> Builder
buildLP forall a. Semigroup a => a -> a -> a
<> Builder
"\"" forall a. Semigroup a => a -> a -> a
<> Builder
rest
| Bool
otherwise = Builder
buildLP forall a. Semigroup a => a -> a -> a
<> Builder
rest
where
buildLP :: Builder
buildLP = ByteString -> Builder
Builder.byteString ByteString
lp
rest :: Builder
rest = Builder
"@" forall a. Semigroup a => a -> a -> a
<> forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (ByteString -> Builder
Builder.byteString forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s. CI s -> s
original)
(forall a. a -> NonEmpty a -> NonEmpty a
Data.List.NonEmpty.intersperse CI ByteString
"." NonEmpty (CI ByteString)
b)
buildAddressSpec (AddrSpec ByteString
lp (DomainLiteral ByteString
b)) =
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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> ByteString
Builder.toLazyByteString forall b c a. (b -> c) -> (a -> b) -> a -> c
. AddrSpec -> Builder
buildAddressSpec
addressSpec :: Parser AddrSpec
addressSpec :: Parser AddrSpec
addressSpec = ByteString -> Domain -> AddrSpec
AddrSpec forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (f :: * -> * -> *) s a.
(Alternative (f s), CharParsing f s a, SM s) =>
f s s
localPart forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Char -> Parser Word8
char8 Char
'@' 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 forall a. Ord a => a -> a -> Bool
>= Word8
33 Bool -> Bool -> Bool
&& Word8
c forall a. Ord a => a -> a -> Bool
<= Word8
90) Bool -> Bool -> Bool
|| (Word8
c forall a. Ord a => a -> a -> Bool
>= Word8
94 Bool -> Bool -> Bool
&& Word8
c forall a. Ord a => a -> a -> Bool
<= Word8
126)
domain :: Parser Domain
domain :: Parser ByteString Domain
domain = (NonEmpty (CI ByteString) -> Domain
DomainDotAtom forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall s. FoldCase s => s -> CI s
mk forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (f :: * -> * -> *) s a.
(Alternative (f s), CharParsing f s a, SM s) =>
f s (NonEmpty s)
dotAtom)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (ByteString -> Domain
DomainLiteral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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 forall (f :: * -> *) a s. Alternative f => f a -> f s -> f [a]
`sepBy` Char -> Parser Word8
char8 Char
','
renderAddresses :: [Address] -> B.ByteString
renderAddresses :: [Address] -> ByteString
renderAddresses [Address]
xs = ByteString -> [ByteString] -> ByteString
B.intercalate ByteString
", " forall a b. (a -> b) -> a -> b
$ Address -> ByteString
renderAddress 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 forall a. Semigroup a => a -> a -> a
<> ByteString
":" forall a. Semigroup a => a -> a -> a
<> [Mailbox] -> ByteString
renderMailboxes [Mailbox]
xs 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 forall (f :: * -> *) a s. Alternative f => f a -> f s -> f [a]
`sepBy` Char -> Parser Word8
char8 Char
','
group :: CharsetLookup -> Parser Address
group :: CharsetLookup -> Parser Address
group CharsetLookup
charsets =
Text -> [Mailbox] -> Address
Group forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CharsetLookup -> Parser Text
displayName CharsetLookup
charsets forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Char -> Parser Word8
char8 Char
':'
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> CharsetLookup -> Parser [Mailbox]
mailboxList CharsetLookup
charsets forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Char -> Parser Word8
char8 Char
';' forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* 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 forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Mailbox -> Address
Single 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 =
forall a. HasHeaders a => Lens' a Headers
headers forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at CI ByteString
k forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso (forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] ByteString -> [a]
f) (\[a]
l -> if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [a]
l then forall a. Maybe a
Nothing else 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 = forall a. HasHeaders a => Lens' a Headers
headers forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at CI ByteString
k forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso (forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ByteString -> Maybe a
f) (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 = forall s a.
HasHeaders s =>
(ByteString -> [a])
-> ([a] -> ByteString) -> CI ByteString -> Lens' s [a]
headerSingleToList
(forall b a. b -> Either a b -> b
fromRight [] forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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]
= forall a.
HasHeaders a =>
CI ByteString -> CharsetLookup -> Lens' a [Address]
headerAddressList CI ByteString
"From"
= forall a.
HasHeaders a =>
CI ByteString -> CharsetLookup -> Lens' a [Address]
headerAddressList CI ByteString
"Reply-To"
= forall a.
HasHeaders a =>
CI ByteString -> CharsetLookup -> Lens' a [Address]
headerAddressList CI ByteString
"To"
= forall a.
HasHeaders a =>
CI ByteString -> CharsetLookup -> Lens' a [Address]
headerAddressList CI ByteString
"Cc"
= 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
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
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
Ord)
instance Show MessageID where
show :: MessageID -> String
show = ByteString -> String
Char8.unpack 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
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall (f :: * -> * -> *) s a.
(Alternative (f s), CharParsing f s a, SM s) =>
f s s
optionalCFWS forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall (f :: * -> * -> *) s a. CharParsing f s a => Char -> f s a
char Char
'<' forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ByteString (NonEmpty ByteString)
idLeft) forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall (f :: * -> * -> *) s a. CharParsing f s a => Char -> f s a
char Char
'@'
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ByteString (Either (NonEmpty ByteString) ByteString)
idRight forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall (f :: * -> * -> *) s a. CharParsing f s a => Char -> f s a
char Char
'>' forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall (f :: * -> * -> *) s a.
(Alternative (f s), CharParsing f s a, SM s) =>
f s s
optionalCFWS
where
idLeft :: Parser ByteString (NonEmpty ByteString)
idLeft = forall (f :: * -> * -> *) s a.
(Alternative (f s), CharParsing f s a) =>
f s (NonEmpty s)
dotAtomText
idRight :: Parser ByteString (Either (NonEmpty ByteString) ByteString)
idRight = forall a b. a -> Either a b
Left forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (f :: * -> * -> *) s a.
(Alternative (f s), CharParsing f s a) =>
f s (NonEmpty s)
dotAtomText forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall a b. b -> Either a b
Right forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString ByteString
noFoldLiteral
noFoldLiteral :: Parser ByteString ByteString
noFoldLiteral = forall (f :: * -> * -> *) s a. CharParsing f s a => Char -> f s a
char Char
'[' forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Word8 -> Bool) -> Parser ByteString ByteString
A.takeWhile1 Word8 -> Bool
isDtext forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* 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
"<" forall a. Semigroup a => a -> a -> a
<> NonEmpty ByteString -> Builder
buildDotAtom NonEmpty ByteString
l forall a. Semigroup a => a -> a -> a
<> Builder
"@" forall a. Semigroup a => a -> a -> a
<> 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 forall a. Semigroup a => a -> a -> a
<> Builder
">"
where
buildDotAtom :: NonEmpty ByteString -> Builder
buildDotAtom =
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> NonEmpty a -> NonEmpty a
Data.List.NonEmpty.intersperse Builder
"." forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ByteString -> Builder
Builder.byteString
buildNoFoldLit :: ByteString -> Builder
buildNoFoldLit ByteString
s =
Builder
"[" forall a. Semigroup a => a -> a -> a
<> ByteString -> Builder
Builder.byteString ByteString
s forall a. Semigroup a => a -> a -> a
<> Builder
"]"
renderMessageID :: MessageID -> B.ByteString
renderMessageID :: MessageID -> ByteString
renderMessageID = ByteString -> ByteString
L.toStrict forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> ByteString
Builder.toLazyByteString forall b c a. (b -> c) -> (a -> b) -> a -> c
. MessageID -> Builder
buildMessageID
headerMessageID :: (HasHeaders a) => Lens' a (Maybe MessageID)
= forall s a.
HasHeaders s =>
(ByteString -> Maybe a)
-> (a -> ByteString) -> CI ByteString -> Lens' s (Maybe a)
headerSingleToMaybe
(forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall a b. a -> b -> a
const forall a. Maybe a
Nothing) forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Parser a -> ByteString -> Either String a
parseOnly (Parser MessageID
parseMessageID forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall t. Chunk t => Parser t ()
endOfInput))
MessageID -> ByteString
renderMessageID
CI ByteString
"Message-ID"
headerMessageIDList :: (HasHeaders a) => CI B.ByteString -> Lens' a [MessageID]
= forall s a.
HasHeaders s =>
(ByteString -> [a])
-> ([a] -> ByteString) -> CI ByteString -> Lens' s [a]
headerSingleToList
(forall b a. b -> Either a b -> b
fromRight [] forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Parser a -> ByteString -> Either String a
parseOnly (forall (f :: * -> *) a. Alternative f => f a -> f [a]
many Parser MessageID
parseMessageID forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall t. Chunk t => Parser t ()
endOfInput))
( ByteString -> ByteString
L.toStrict forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> ByteString
Builder.toLazyByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> [a] -> [a]
Data.List.intersperse Builder
" " forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap MessageID -> Builder
buildMessageID )
headerInReplyTo, headerReferences :: (HasHeaders a) => Lens' a [MessageID]
= forall a. HasHeaders a => CI ByteString -> Lens' a [MessageID]
headerMessageIDList CI ByteString
"In-Reply-To"
= 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 =
forall a. HasHeaders a => Lens' a Headers
headers forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at CI ByteString
k forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (CharsetLookup -> ByteString -> Text
decodeEncodedWords CharsetLookup
charsets)) (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 = 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 :: Lens' 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 :: Lens' 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 :: Lens' 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 :: Lens' 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 :: Lens' 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 :: forall ctx a.
CharsetLookup
-> ReplySettings -> Message ctx a -> ([Address], [Address])
replyRecipients CharsetLookup
charsets ReplySettings
settings Message ctx a
msg =
let
mode :: ReplyMode
mode = forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' ReplySettings ReplyMode
replyMode ReplySettings
settings
rt :: [Address]
rt = forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view (forall a. HasHeaders a => CharsetLookup -> Lens' a [Address]
headerReplyTo CharsetLookup
charsets) Message ctx a
msg
f :: [Address]
f = forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view (forall a. HasHeaders a => CharsetLookup -> Lens' a [Address]
headerFrom CharsetLookup
charsets) Message ctx a
msg
t :: [Address]
t = forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view (forall a. HasHeaders a => CharsetLookup -> Lens' a [Address]
headerTo CharsetLookup
charsets) Message ctx a
msg
c :: [Address]
c = forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view (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 (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Address]
rt) -> ([Address]
rt, [])
| Bool
otherwise -> ([Address]
f, [])
ReplyMode
ReplyToGroup
| forall (t :: * -> *) a. Foldable t => t a -> Int
length ([Address]
t forall a. Semigroup a => a -> a -> a
<> [Address]
c) forall a. Ord a => a -> a -> Bool
<= Int
1
-> forall ctx a.
CharsetLookup
-> ReplySettings -> Message ctx a -> ([Address], [Address])
replyRecipients CharsetLookup
charsets (forall s t a b. ASetter s t a b -> b -> s -> t
set Lens' ReplySettings ReplyMode
replyMode ReplyMode
ReplyToSender ReplySettings
settings) Message ctx a
msg
| Bool
otherwise
-> ([Address]
f, [Address]
t forall a. Semigroup a => a -> a -> a
<> [Address]
c)
replyReferences :: Message ctx a -> [MessageID]
replyReferences :: forall ctx a. Message ctx a -> [MessageID]
replyReferences Message ctx a
msg
| forall (t :: * -> *) a. Foldable t => t a -> Bool
null [MessageID]
refer, forall (t :: * -> *) a. Foldable t => t a -> Int
length [MessageID]
inRep forall a. Eq a => a -> a -> Bool
== Int
1 = [MessageID]
inRep forall a. Semigroup a => a -> a -> a
<> [MessageID]
msgId
| Bool
otherwise = [MessageID]
refer forall a. Semigroup a => a -> a -> a
<> [MessageID]
msgId
where
msgId :: [MessageID]
msgId = forall (t :: * -> *) a. Foldable t => t a -> [a]
toList forall a b. (a -> b) -> a -> b
$ forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view forall a. HasHeaders a => Lens' a (Maybe MessageID)
headerMessageID Message ctx a
msg
refer :: [MessageID]
refer = forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view forall a. HasHeaders a => Lens' a [MessageID]
headerReferences Message ctx a
msg
inRep :: [MessageID]
inRep = forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view forall a. HasHeaders a => Lens' a [MessageID]
headerInReplyTo Message ctx a
msg
replySubject :: CharsetLookup -> Message ctx a -> T.Text
replySubject :: forall ctx a. CharsetLookup -> Message ctx a -> Text
replySubject CharsetLookup
charsets Message ctx a
msg = if Bool
prefixed then Text
orig else Text
"Re: " forall a. Semigroup a => a -> a -> a
<> Text
orig
where
orig :: Text
orig = forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold forall a b. (a -> b) -> a -> b
$ forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view (forall a. HasHeaders a => CharsetLookup -> Lens' a (Maybe Text)
headerSubject CharsetLookup
charsets) Message ctx a
msg
prefixed :: Bool
prefixed = forall s. FoldCase s => s -> CI s
mk (Int -> Text -> Text
T.take Int
3 Text
orig) forall a. Eq a => a -> a -> Bool
== CI Text
"Re:"
reply
:: CharsetLookup
-> ReplySettings
-> Message ctx a
-> Message ctx ()
reply :: forall ctx a.
CharsetLookup -> ReplySettings -> Message ctx a -> Message ctx ()
reply CharsetLookup
charsets ReplySettings
settings Message ctx a
msg =
let
self :: AuthorMailboxes
self = forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' ReplySettings 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 :: forall (t :: * -> *).
Foldable t =>
t Mailbox -> Address -> Maybe Mailbox
findMatchingMailbox t Mailbox
xs (Single Mailbox
addr) =
Mailbox -> Mailbox
f forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
on forall a. Eq a => a -> a -> Bool
(==) Mailbox -> AddrSpec
getAddrSpec Mailbox
addr) t Mailbox
xs
where
f :: Mailbox -> Mailbox
f = case forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' ReplySettings ReplyFromRewriteMode
replyFromRewriteMode ReplySettings
settings of
ReplyFromRewriteMode
ReplyFromRewriteOn -> forall a. a -> a
id
ReplyFromRewriteMode
ReplyFromRewriteOff -> forall a b. a -> b -> a
const Mailbox
addr
findMatchingMailbox t Mailbox
_ Address
_ = forall a. Maybe a
Nothing
getSelf :: Address -> Maybe Mailbox
getSelf :: Address -> Maybe Mailbox
getSelf = forall (t :: * -> *).
Foldable t =>
t Mailbox -> Address -> Maybe Mailbox
findMatchingMailbox AuthorMailboxes
self
isSelf :: Address -> Bool
isSelf :: Address -> Bool
isSelf = forall a. Maybe a -> Bool
isJust forall b c a. (b -> c) -> (a -> b) -> a -> c
. Address -> Maybe Mailbox
getSelf
findSelf :: Maybe Mailbox
findSelf =
let
parentTo :: [Address]
parentTo = forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view (forall a. HasHeaders a => CharsetLookup -> Lens' a [Address]
headerTo CharsetLookup
charsets) Message ctx a
msg
parentCc :: [Address]
parentCc = forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view (forall a. HasHeaders a => CharsetLookup -> Lens' a [Address]
headerCC CharsetLookup
charsets) Message ctx a
msg
in
forall a. First a -> Maybe a
getFirst forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (forall a. Maybe a -> First a
First forall b c a. (b -> c) -> (a -> b) -> a -> c
. Address -> Maybe Mailbox
getSelf) ([Address]
parentTo forall a. Semigroup a => a -> a -> a
<> [Address]
parentCc)
filterSelf :: [Address] -> [Address]
filterSelf = case forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' ReplySettings SelfInRecipientsMode
selfInRecipientsMode ReplySettings
settings of
SelfInRecipientsMode
SelfInRecipientsRemove -> forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. Address -> Bool
isSelf)
SelfInRecipientsMode
SelfInRecipientsIgnore -> forall a. a -> a
id
([Address]
t, [Address]
c) = 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 = forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (\case Single Mailbox
a -> forall a. a -> Maybe a
Just Mailbox
a ; Address
_ -> forall a. Maybe a
Nothing) [Address]
_To
_Cc :: [Address]
_Cc = [Address]
c
forall a b. a -> (a -> b) -> b
& [Address] -> [Address]
filterSelf
forall a b. a -> (a -> b) -> b
& forall a. (a -> Bool) -> [a] -> [a]
filter (forall a. Maybe a -> Bool
isNothing forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *).
Foldable t =>
t Mailbox -> Address -> Maybe Mailbox
findMatchingMailbox [Mailbox]
_To_mailboxes)
_From :: Mailbox
_From =
let preferred :: Mailbox
preferred = forall a. NonEmpty a -> a
Data.List.NonEmpty.head AuthorMailboxes
self
in
case forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' ReplySettings ReplyFromMode
replyFromMode ReplySettings
settings of
ReplyFromMode
ReplyFromPreferredMailbox -> Mailbox
preferred
ReplyFromMode
ReplyFromMatchingMailbox -> forall a. a -> Maybe a -> a
fromMaybe Mailbox
preferred Maybe Mailbox
findSelf
hdrs :: Headers
hdrs = [Header] -> Headers
Headers []
forall a b. a -> (a -> b) -> b
& forall s t a b. ASetter s t a b -> b -> s -> t
set (forall a. HasHeaders a => CharsetLookup -> Lens' a [Address]
headerFrom CharsetLookup
charsets) [Mailbox -> Address
Single Mailbox
_From]
forall a b. a -> (a -> b) -> b
& forall s t a b. ASetter s t a b -> b -> s -> t
set (forall a. HasHeaders a => CharsetLookup -> Lens' a [Address]
headerTo CharsetLookup
charsets) ([Address] -> [Address]
filterSelf [Address]
_To)
forall a b. a -> (a -> b) -> b
& forall s t a b. ASetter s t a b -> b -> s -> t
set (forall a. HasHeaders a => CharsetLookup -> Lens' a [Address]
headerCC CharsetLookup
charsets) ([Address] -> [Address]
filterSelf [Address]
_Cc)
forall a b. a -> (a -> b) -> b
& forall s t a b. ASetter s t a b -> b -> s -> t
set forall a. HasHeaders a => Lens' a [MessageID]
headerInReplyTo (forall (t :: * -> *) a. Foldable t => t a -> [a]
toList forall a b. (a -> b) -> a -> b
$ forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view forall a. HasHeaders a => Lens' a (Maybe MessageID)
headerMessageID Message ctx a
msg)
forall a b. a -> (a -> b) -> b
& forall s t a b. ASetter s t a b -> b -> s -> t
set forall a. HasHeaders a => Lens' a [MessageID]
headerReferences (forall ctx a. Message ctx a -> [MessageID]
replyReferences Message ctx a
msg)
forall a b. a -> (a -> b) -> b
& forall s t a b. ASetter s t a b -> b -> s -> t
set (forall a. HasHeaders a => CharsetLookup -> Lens' a (Maybe Text)
headerSubject CharsetLookup
charsets) (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall ctx a. CharsetLookup -> Message ctx a -> Text
replySubject CharsetLookup
charsets Message ctx a
msg)
in
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 :: forall a.
(Headers -> BodyHandler a) -> Parser (Message (MessageContext a) a)
message Headers -> BodyHandler a
f = Parser Headers
fields forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Headers
hdrs -> forall s a. Headers -> a -> Message s a
Message Headers
hdrs 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 -> forall (f :: * -> * -> *) s a.
(Alternative (f s), CharParsing f s a) =>
f s ()
crlf forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ByteString a
b
OptionalBody (Parser ByteString a
b, a
a) -> forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional forall (f :: * -> * -> *) s a.
(Alternative (f s), CharParsing f s a) =>
f s ()
crlf forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (f :: * -> *) a. Applicative f => a -> f a
pure a
a) (forall a b. a -> b -> a
const Parser ByteString a
b)
NoBody a
b -> forall (f :: * -> *) a. Applicative f => a -> f a
pure a
b
type family MessageContext a
fields :: Parser Headers
fields :: Parser Headers
fields = [Header] -> Headers
Headers forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (f :: * -> *) a. Alternative f => f a -> f [a]
many Parser Header
field
class RenderMessage a where
buildBody :: Headers -> a -> Maybe Builder.Builder
:: a -> Headers -> Headers
tweakHeaders a
_ = forall a. a -> a
id
buildMessage :: forall ctx a. (RenderMessage a) => Message ctx a -> Builder.Builder
buildMessage :: forall ctx a. RenderMessage a => Message ctx a -> Builder
buildMessage (Message Headers
h a
b) =
Headers -> Builder
buildFields (forall a. RenderMessage a => a -> Headers -> Headers
tweakHeaders a
b Headers
h)
forall a. Semigroup a => a -> a -> a
<> forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. Monoid a => a
mempty (Builder
"\r\n" forall a. Semigroup a => a -> a -> a
<>) (forall a. RenderMessage a => Headers -> a -> Maybe Builder
buildBody Headers
h a
b)
renderMessage :: (RenderMessage a) => Message ctx a -> L.ByteString
renderMessage :: forall a ctx. RenderMessage a => Message ctx a -> ByteString
renderMessage = Builder -> ByteString
Builder.toLazyByteString forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall ctx a. RenderMessage a => Message ctx a -> Builder
buildMessage
buildFields :: Headers -> Builder.Builder
buildFields :: Headers -> Builder
buildFields = forall r s a. Getting r s a -> (a -> r) -> s -> r
foldMapOf (Iso' Headers [Header]
hdriso forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b.
Traversable f =>
IndexedTraversal Int (f a) (f b) a b
traversed) Header -> Builder
buildField
buildField :: (CI B.ByteString, B.ByteString) -> Builder.Builder
buildField :: Header -> Builder
buildField (CI ByteString
k,ByteString
v) =
let key :: ByteString
key = forall s. CI s -> s
original CI ByteString
k
in
ByteString -> Builder
Builder.byteString ByteString
key
forall a. Semigroup a => a -> a -> a
<> Builder
":"
forall a. Semigroup a => a -> a -> a
<> ByteString -> Int -> Builder
foldUnstructured ByteString
v (ByteString -> Int
B.length ByteString
key forall a. Num a => a -> a -> a
+ Int
1)
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
[] -> forall a. Monoid a => a
mempty
(ByteString
h:[ByteString]
t) ->
Builder
" " forall a. Semigroup a => a -> a -> a
<> ByteString -> Builder
Builder.byteString ByteString
h forall a. Semigroup a => a -> a -> a
<> [ByteString] -> Int -> Builder
go [ByteString]
t (Int
i forall a. Num a => a -> a -> a
+ Int
1 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
_ = forall a. Monoid a => a
mempty
go (ByteString
chunk:[ByteString]
chunks) Int
col
| Int
col forall a. Ord a => a -> a -> Bool
<= Int
1 Bool -> Bool -> Bool
|| Int
col forall a. Num a => a -> a -> a
+ Int
1 forall a. Num a => a -> a -> a
+ ByteString -> Int
B.length ByteString
chunk forall a. Ord a => a -> a -> Bool
< Int
limit =
Builder
" " forall a. Semigroup a => a -> a -> a
<> ByteString -> Builder
Builder.byteString ByteString
chunk forall a. Semigroup a => a -> a -> a
<> [ByteString] -> Int -> Builder
go [ByteString]
chunks (Int
col forall a. Num a => a -> a -> a
+ Int
1 forall a. Num a => a -> a -> a
+ ByteString -> Int
B.length ByteString
chunk)
| Bool
otherwise = Builder
"\r\n" forall a. Semigroup a => a -> a -> a
<> [ByteString] -> Int -> Builder
go (ByteString
chunkforall a. a -> [a] -> [a]
:[ByteString]
chunks) Int
0
isFtext :: Word8 -> Bool
isFtext :: Word8 -> Bool
isFtext Word8
c = (Word8
c forall a. Ord a => a -> a -> Bool
>= Word8
33 Bool -> Bool -> Bool
&& Word8
c forall a. Ord a => a -> a -> Bool
<= Word8
57) Bool -> Bool -> Bool
|| (Word8
c forall a. Ord a => a -> a -> Bool
>= Word8
59 Bool -> Bool -> Bool
&& Word8
c forall a. Ord a => a -> a -> Bool
<= Word8
126)
field :: Parser (CI B.ByteString, B.ByteString)
field :: Parser Header
field = (,)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s. FoldCase s => Parser s -> Parser (CI s)
ci ((Word8 -> Bool) -> Parser ByteString ByteString
takeWhile1 Word8 -> Bool
isFtext)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Char -> Parser Word8
char8 Char
':' forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall (f :: * -> *) a. Alternative f => f a -> f [a]
many forall (f :: * -> * -> *) s a. CharParsing f s a => f s a
wsp
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ByteString ByteString
unstructured forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall (f :: * -> * -> *) s a.
(Alternative (f s), CharParsing f s a) =>
f s ()
crlf
unstructured :: Parser B.ByteString
unstructured :: Parser ByteString ByteString
unstructured =
forall m (f :: * -> *). (Monoid m, Alternative f) => f m -> f m
foldMany (forall (f :: * -> * -> *) s a.
(Alternative (f s), CharParsing f s a, SM s) =>
f s s
optionalFWS forall m (f :: * -> *).
(Semigroup m, Applicative f) =>
f m -> f m -> f m
<<>> (Word8 -> ByteString
B.singleton forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (f :: * -> * -> *) s a. CharParsing f s a => f s a
vchar))
forall m (f :: * -> *).
(Semigroup m, Applicative f) =>
f m -> f m -> f m
<<>> (Word8 -> Bool) -> Parser ByteString ByteString
A.takeWhile forall c. IsChar c => c -> Bool
isWsp
parsed :: (Cons s s Word8 Word8) => Parser a -> Fold s a
parsed :: forall s a. Cons s s Word8 Word8 => Parser a -> Fold s a
parsed Parser a
p = forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to (forall s a.
Cons s s Word8 Word8 =>
Parser a -> s -> Either String a
parse Parser a
p) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a. Foldable f => IndexedFold Int (f a) a
folded
{-# INLINE parsed #-}
parsePrint :: Parser a -> (a -> B.ByteString) -> Prism' B.ByteString a
parsePrint :: forall a. Parser a -> (a -> ByteString) -> Prism' ByteString a
parsePrint Parser a
fwd a -> ByteString
rev = forall b s a. (b -> s) -> (s -> Maybe a) -> Prism s s a b
prism' a -> ByteString
rev (forall r. Result r -> Maybe r
AL.maybeResult forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Parser a -> ByteString -> Result a
AL.parse Parser a
fwd forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view 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 :: forall s a.
Cons s s Word8 Word8 =>
Parser a -> s -> Either String a
parse Parser a
p = forall r. Result r -> Either String r
AL.eitherResult forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Parser a -> ByteString -> Result a
AL.parse Parser a
p forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view 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
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
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. 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 -> ()
forall a. (a -> ()) -> NFData a
rnf :: Mailbox -> ()
$crnf :: Mailbox -> ()
NFData)
instance IsString Mailbox where
fromString :: String -> Mailbox
fromString =
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall a. HasCallStack => String -> a
error forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Monoid a => a -> a -> a
mappend String
"Failed to parse Mailbox: ") forall a. a -> a
id 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
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
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. 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 -> ()
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
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
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. 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 -> ()
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
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
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. 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 -> ()
forall a. (a -> ()) -> NFData a
rnf :: Domain -> ()
$crnf :: Domain -> ()
NFData)