-- | https://www.rfc-editor.org/rfc/rfc3464
module Email.DSN.DeliveryStatus
  ( DeliveryStatus(..), PerRecipientField(..), RawField(..)
  , parser
  ) where

import Control.Applicative
import Data.Char
import Data.List.NonEmpty (NonEmpty, some1)
import qualified Data.Text as Text
import Data.Text (Text)
import GHC.Generics (Generic)

import qualified Data.Attoparsec.Text as AP

import qualified Email.DSN.StatusCode as DSC

data RawField = RawField { RawField -> Text
fieldName :: Text, RawField -> Text
fieldBody :: Text }
  deriving ((forall x. RawField -> Rep RawField x)
-> (forall x. Rep RawField x -> RawField) -> Generic RawField
forall x. Rep RawField x -> RawField
forall x. RawField -> Rep RawField x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. RawField -> Rep RawField x
from :: forall x. RawField -> Rep RawField x
$cto :: forall x. Rep RawField x -> RawField
to :: forall x. Rep RawField x -> RawField
Generic, RawField -> RawField -> Bool
(RawField -> RawField -> Bool)
-> (RawField -> RawField -> Bool) -> Eq RawField
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: RawField -> RawField -> Bool
== :: RawField -> RawField -> Bool
$c/= :: RawField -> RawField -> Bool
/= :: RawField -> RawField -> Bool
Eq, Eq RawField
Eq RawField =>
(RawField -> RawField -> Ordering)
-> (RawField -> RawField -> Bool)
-> (RawField -> RawField -> Bool)
-> (RawField -> RawField -> Bool)
-> (RawField -> RawField -> Bool)
-> (RawField -> RawField -> RawField)
-> (RawField -> RawField -> RawField)
-> Ord RawField
RawField -> RawField -> Bool
RawField -> RawField -> Ordering
RawField -> RawField -> RawField
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
$ccompare :: RawField -> RawField -> Ordering
compare :: RawField -> RawField -> Ordering
$c< :: RawField -> RawField -> Bool
< :: RawField -> RawField -> Bool
$c<= :: RawField -> RawField -> Bool
<= :: RawField -> RawField -> Bool
$c> :: RawField -> RawField -> Bool
> :: RawField -> RawField -> Bool
$c>= :: RawField -> RawField -> Bool
>= :: RawField -> RawField -> Bool
$cmax :: RawField -> RawField -> RawField
max :: RawField -> RawField -> RawField
$cmin :: RawField -> RawField -> RawField
min :: RawField -> RawField -> RawField
Ord, ReadPrec [RawField]
ReadPrec RawField
Int -> ReadS RawField
ReadS [RawField]
(Int -> ReadS RawField)
-> ReadS [RawField]
-> ReadPrec RawField
-> ReadPrec [RawField]
-> Read RawField
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS RawField
readsPrec :: Int -> ReadS RawField
$creadList :: ReadS [RawField]
readList :: ReadS [RawField]
$creadPrec :: ReadPrec RawField
readPrec :: ReadPrec RawField
$creadListPrec :: ReadPrec [RawField]
readListPrec :: ReadPrec [RawField]
Read, Int -> RawField -> ShowS
[RawField] -> ShowS
RawField -> String
(Int -> RawField -> ShowS)
-> (RawField -> String) -> ([RawField] -> ShowS) -> Show RawField
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> RawField -> ShowS
showsPrec :: Int -> RawField -> ShowS
$cshow :: RawField -> String
show :: RawField -> String
$cshowList :: [RawField] -> ShowS
showList :: [RawField] -> ShowS
Show)

-- Parsed according to https://www.rfc-editor.org/rfc/rfc5322.html#section-3.6.8
-- In RFC3464 this syntax is defined by reference to RFC822, but RFC5322 updates
-- RFC822 and I found it easier to implement.
fieldParser :: AP.Parser RawField
fieldParser :: Parser RawField
fieldParser =
  Text -> Text -> RawField
RawField
  (Text -> Text -> RawField)
-> Parser Text Text -> Parser Text (Text -> RawField)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Char -> Bool) -> Parser Text Text
AP.takeWhile1 (\Char
c -> Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
> Char
' ' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
':' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
< Char
'\x80')
  Parser Text (Text -> RawField)
-> Parser Text () -> Parser Text (Text -> RawField)
forall a b. Parser Text a -> Parser Text b -> Parser Text a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser Text ()
skipLWS Parser Text (Text -> RawField)
-> Parser Text Char -> Parser Text (Text -> RawField)
forall a b. Parser Text a -> Parser Text b -> Parser Text a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Char -> Parser Text Char
AP.char Char
':'
  Parser Text (Text -> RawField)
-> Parser Text Text -> Parser RawField
forall a b. Parser Text (a -> b) -> Parser Text a -> Parser Text b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Text Text
unstructured
  Parser RawField -> Parser Text Text -> Parser RawField
forall a b. Parser Text a -> Parser Text b -> Parser Text a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Text -> Parser Text Text
AP.string Text
"\r\n"

skipLWS :: AP.Parser ()
skipLWS :: Parser Text ()
skipLWS =
  (Char -> Bool) -> Parser Text ()
AP.skipWhile Char -> Bool
isWsp
  Parser Text () -> Parser Text () -> Parser Text ()
forall a b. Parser Text a -> Parser Text b -> Parser Text a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* () -> Parser Text () -> Parser Text ()
forall (f :: * -> *) a. Alternative f => a -> f a -> f a
AP.option () (Text -> Parser Text Text
AP.string Text
"\r\n" Parser Text Text -> Parser Text () -> Parser Text ()
forall a b. Parser Text a -> Parser Text b -> Parser Text b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Char -> Bool) -> Parser Text ()
AP.skip Char -> Bool
isWsp Parser Text () -> Parser Text () -> Parser Text ()
forall a b. Parser Text a -> Parser Text b -> Parser Text b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Text ()
skipLWS)

{-
   unstructured    =   (*([FWS] VCHAR) *WSP) / obs-unstruct
    VCHAR          =  %x21-7E ; visible (printing) characters
    WSP            = SP / HTAB ; white space
    SP             = %x20
    HTAB           = %x09
   FWS             =   ([*WSP CRLF] 1*WSP) /  obs-FWS ; Folding white space
   obs-FWS         =   1*([CRLF] WSP)
   obs-unstruct    =   *( (*CR 1*(obs-utext / FWS)) / 1*LF ) *CR
   obs-utext       =   %d0 / obs-NO-WS-CTL / VCHAR
   obs-NO-WS-CTL   =   %d1-8 /            ; US-ASCII control
                       %d11 /             ;  characters that do not
                       %d12 /             ;  include the carriage
                       %d14-31 /          ;  return, line feed, and
                       %d127              ;  white space characters
-}

-- Omitting the obsolete syntax for simplicity, even though that is of course
-- incorrect in principle.
unstructured :: AP.Parser Text
unstructured :: Parser Text Text
unstructured =
  Text -> Text -> Text
Text.append
    (Text -> Text -> Text)
-> Parser Text Text -> Parser Text (Text -> Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ([Text] -> Text
Text.concat ([Text] -> Text) -> Parser Text [Text] -> Parser Text Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text Text -> Parser Text [Text]
forall a. Parser Text a -> Parser Text [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (Text -> Char -> Text
Text.snoc (Text -> Char -> Text)
-> Parser Text Text -> Parser Text (Char -> Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text Text
fws0 Parser Text (Char -> Text) -> Parser Text Char -> Parser Text Text
forall a b. Parser Text (a -> b) -> Parser Text a -> Parser Text b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Char -> Bool) -> Parser Text Char
AP.satisfy Char -> Bool
isVchar))
    Parser Text (Text -> Text) -> Parser Text Text -> Parser Text Text
forall a b. Parser Text (a -> b) -> Parser Text a -> Parser Text b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Char -> Bool) -> Parser Text Text
AP.takeWhile Char -> Bool
isWsp
  -- <|> obsUnstruct

fws0 :: AP.Parser Text
fws0 :: Parser Text Text
fws0 =
  Text -> Text -> Text
Text.append
    (Text -> Text -> Text)
-> Parser Text Text -> Parser Text (Text -> Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Char -> Bool) -> Parser Text Text
AP.takeWhile Char -> Bool
isWsp
    Parser Text (Text -> Text) -> Parser Text Text -> Parser Text Text
forall a b. Parser Text (a -> b) -> Parser Text a -> Parser Text b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text -> Parser Text Text -> Parser Text Text
forall (f :: * -> *) a. Alternative f => a -> f a -> f a
AP.option Text
"" (Text -> Parser Text Text
AP.string Text
"\r\n" Parser Text Text -> Parser Text Text -> Parser Text Text
forall a b. Parser Text a -> Parser Text b -> Parser Text b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Char -> Bool) -> Parser Text Text
AP.takeWhile1 Char -> Bool
isWsp)
  -- <|> obsFws

isWsp :: Char -> Bool
isWsp :: Char -> Bool
isWsp Char
c = Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
' ' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\t'

isVchar :: Char -> Bool
isVchar :: Char -> Bool
isVchar Char
c = Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= Char
'\x21' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'\x7e'

-- | A subset of the RFC-specified per-recipient fields, chosen because they are
-- the ones most useful for interpreting bounces.
data PerRecipientField
  = FinalRecipient { PerRecipientField -> Text
addressType :: Text, PerRecipientField -> Text
address :: Text }
  | Status DSC.StatusCode
  | OtherPerRecipient RawField
  deriving ((forall x. PerRecipientField -> Rep PerRecipientField x)
-> (forall x. Rep PerRecipientField x -> PerRecipientField)
-> Generic PerRecipientField
forall x. Rep PerRecipientField x -> PerRecipientField
forall x. PerRecipientField -> Rep PerRecipientField x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. PerRecipientField -> Rep PerRecipientField x
from :: forall x. PerRecipientField -> Rep PerRecipientField x
$cto :: forall x. Rep PerRecipientField x -> PerRecipientField
to :: forall x. Rep PerRecipientField x -> PerRecipientField
Generic, PerRecipientField -> PerRecipientField -> Bool
(PerRecipientField -> PerRecipientField -> Bool)
-> (PerRecipientField -> PerRecipientField -> Bool)
-> Eq PerRecipientField
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PerRecipientField -> PerRecipientField -> Bool
== :: PerRecipientField -> PerRecipientField -> Bool
$c/= :: PerRecipientField -> PerRecipientField -> Bool
/= :: PerRecipientField -> PerRecipientField -> Bool
Eq, Eq PerRecipientField
Eq PerRecipientField =>
(PerRecipientField -> PerRecipientField -> Ordering)
-> (PerRecipientField -> PerRecipientField -> Bool)
-> (PerRecipientField -> PerRecipientField -> Bool)
-> (PerRecipientField -> PerRecipientField -> Bool)
-> (PerRecipientField -> PerRecipientField -> Bool)
-> (PerRecipientField -> PerRecipientField -> PerRecipientField)
-> (PerRecipientField -> PerRecipientField -> PerRecipientField)
-> Ord PerRecipientField
PerRecipientField -> PerRecipientField -> Bool
PerRecipientField -> PerRecipientField -> Ordering
PerRecipientField -> PerRecipientField -> PerRecipientField
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
$ccompare :: PerRecipientField -> PerRecipientField -> Ordering
compare :: PerRecipientField -> PerRecipientField -> Ordering
$c< :: PerRecipientField -> PerRecipientField -> Bool
< :: PerRecipientField -> PerRecipientField -> Bool
$c<= :: PerRecipientField -> PerRecipientField -> Bool
<= :: PerRecipientField -> PerRecipientField -> Bool
$c> :: PerRecipientField -> PerRecipientField -> Bool
> :: PerRecipientField -> PerRecipientField -> Bool
$c>= :: PerRecipientField -> PerRecipientField -> Bool
>= :: PerRecipientField -> PerRecipientField -> Bool
$cmax :: PerRecipientField -> PerRecipientField -> PerRecipientField
max :: PerRecipientField -> PerRecipientField -> PerRecipientField
$cmin :: PerRecipientField -> PerRecipientField -> PerRecipientField
min :: PerRecipientField -> PerRecipientField -> PerRecipientField
Ord, ReadPrec [PerRecipientField]
ReadPrec PerRecipientField
Int -> ReadS PerRecipientField
ReadS [PerRecipientField]
(Int -> ReadS PerRecipientField)
-> ReadS [PerRecipientField]
-> ReadPrec PerRecipientField
-> ReadPrec [PerRecipientField]
-> Read PerRecipientField
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS PerRecipientField
readsPrec :: Int -> ReadS PerRecipientField
$creadList :: ReadS [PerRecipientField]
readList :: ReadS [PerRecipientField]
$creadPrec :: ReadPrec PerRecipientField
readPrec :: ReadPrec PerRecipientField
$creadListPrec :: ReadPrec [PerRecipientField]
readListPrec :: ReadPrec [PerRecipientField]
Read, Int -> PerRecipientField -> ShowS
[PerRecipientField] -> ShowS
PerRecipientField -> String
(Int -> PerRecipientField -> ShowS)
-> (PerRecipientField -> String)
-> ([PerRecipientField] -> ShowS)
-> Show PerRecipientField
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PerRecipientField -> ShowS
showsPrec :: Int -> PerRecipientField -> ShowS
$cshow :: PerRecipientField -> String
show :: PerRecipientField -> String
$cshowList :: [PerRecipientField] -> ShowS
showList :: [PerRecipientField] -> ShowS
Show)

perRecipientFieldParser :: AP.Parser PerRecipientField
perRecipientFieldParser :: Parser PerRecipientField
perRecipientFieldParser = RawField -> Parser PerRecipientField
forall {m :: * -> *}.
MonadFail m =>
RawField -> m PerRecipientField
ofRaw (RawField -> Parser PerRecipientField)
-> Parser RawField -> Parser PerRecipientField
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Parser RawField
fieldParser
  where
    ofRaw :: RawField -> m PerRecipientField
ofRaw raw :: RawField
raw@RawField{ Text
fieldName :: RawField -> Text
fieldName :: Text
fieldName, Text
fieldBody :: RawField -> Text
fieldBody :: Text
fieldBody } =
      case Text -> Text
Text.toLower Text
fieldName of
        Text
"final-recipient" ->
          case (Char -> Bool) -> Text -> (Text, Text)
Text.break (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
';') Text
fieldBody of
            (Text
_, Text
"") -> String -> m PerRecipientField
forall a. String -> m a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"final-recipient should contain ;"
            (Text
addressType, Text
rest) ->
              PerRecipientField -> m PerRecipientField
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PerRecipientField -> m PerRecipientField)
-> PerRecipientField -> m PerRecipientField
forall a b. (a -> b) -> a -> b
$ FinalRecipient
                { addressType :: Text
addressType = (Char -> Bool) -> Text -> Text
Text.dropWhile Char -> Bool
isSpace Text
addressType
                , address :: Text
address = (Char -> Bool) -> Text -> Text
Text.dropWhile Char -> Bool
isSpace (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Int -> Text -> Text
Text.drop Int
1 Text
rest
                }
        Text
"status" ->
          (String -> m PerRecipientField)
-> (StatusCode -> m PerRecipientField)
-> Either String StatusCode
-> m PerRecipientField
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either String -> m PerRecipientField
forall a. String -> m a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (PerRecipientField -> m PerRecipientField
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PerRecipientField -> m PerRecipientField)
-> (StatusCode -> PerRecipientField)
-> StatusCode
-> m PerRecipientField
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StatusCode -> PerRecipientField
Status)
          (Either String StatusCode -> m PerRecipientField)
-> Either String StatusCode -> m PerRecipientField
forall a b. (a -> b) -> a -> b
$ Parser StatusCode -> Text -> Either String StatusCode
forall a. Parser a -> Text -> Either String a
AP.parseOnly (Parser StatusCode
DSC.parser Parser StatusCode -> Parser Text () -> Parser StatusCode
forall a b. Parser Text a -> Parser Text b -> Parser Text a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser Text ()
forall t. Chunk t => Parser t ()
AP.endOfInput)
          (Text -> Either String StatusCode)
-> Text -> Either String StatusCode
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> Text -> Text
Text.dropWhile Char -> Bool
isSpace Text
fieldBody
        Text
_ -> PerRecipientField -> m PerRecipientField
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PerRecipientField -> m PerRecipientField)
-> PerRecipientField -> m PerRecipientField
forall a b. (a -> b) -> a -> b
$ RawField -> PerRecipientField
OtherPerRecipient RawField
raw

-- | Body of a message/delivery-status
-- https://www.rfc-editor.org/rfc/rfc3464#section-2.1
data DeliveryStatus = DeliveryStatus
  { DeliveryStatus -> NonEmpty RawField
perMessageFields :: NonEmpty RawField
  , DeliveryStatus -> NonEmpty (NonEmpty PerRecipientField)
perRecipientFields :: NonEmpty (NonEmpty PerRecipientField)
  } deriving ((forall x. DeliveryStatus -> Rep DeliveryStatus x)
-> (forall x. Rep DeliveryStatus x -> DeliveryStatus)
-> Generic DeliveryStatus
forall x. Rep DeliveryStatus x -> DeliveryStatus
forall x. DeliveryStatus -> Rep DeliveryStatus x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. DeliveryStatus -> Rep DeliveryStatus x
from :: forall x. DeliveryStatus -> Rep DeliveryStatus x
$cto :: forall x. Rep DeliveryStatus x -> DeliveryStatus
to :: forall x. Rep DeliveryStatus x -> DeliveryStatus
Generic, DeliveryStatus -> DeliveryStatus -> Bool
(DeliveryStatus -> DeliveryStatus -> Bool)
-> (DeliveryStatus -> DeliveryStatus -> Bool) -> Eq DeliveryStatus
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: DeliveryStatus -> DeliveryStatus -> Bool
== :: DeliveryStatus -> DeliveryStatus -> Bool
$c/= :: DeliveryStatus -> DeliveryStatus -> Bool
/= :: DeliveryStatus -> DeliveryStatus -> Bool
Eq, Eq DeliveryStatus
Eq DeliveryStatus =>
(DeliveryStatus -> DeliveryStatus -> Ordering)
-> (DeliveryStatus -> DeliveryStatus -> Bool)
-> (DeliveryStatus -> DeliveryStatus -> Bool)
-> (DeliveryStatus -> DeliveryStatus -> Bool)
-> (DeliveryStatus -> DeliveryStatus -> Bool)
-> (DeliveryStatus -> DeliveryStatus -> DeliveryStatus)
-> (DeliveryStatus -> DeliveryStatus -> DeliveryStatus)
-> Ord DeliveryStatus
DeliveryStatus -> DeliveryStatus -> Bool
DeliveryStatus -> DeliveryStatus -> Ordering
DeliveryStatus -> DeliveryStatus -> DeliveryStatus
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
$ccompare :: DeliveryStatus -> DeliveryStatus -> Ordering
compare :: DeliveryStatus -> DeliveryStatus -> Ordering
$c< :: DeliveryStatus -> DeliveryStatus -> Bool
< :: DeliveryStatus -> DeliveryStatus -> Bool
$c<= :: DeliveryStatus -> DeliveryStatus -> Bool
<= :: DeliveryStatus -> DeliveryStatus -> Bool
$c> :: DeliveryStatus -> DeliveryStatus -> Bool
> :: DeliveryStatus -> DeliveryStatus -> Bool
$c>= :: DeliveryStatus -> DeliveryStatus -> Bool
>= :: DeliveryStatus -> DeliveryStatus -> Bool
$cmax :: DeliveryStatus -> DeliveryStatus -> DeliveryStatus
max :: DeliveryStatus -> DeliveryStatus -> DeliveryStatus
$cmin :: DeliveryStatus -> DeliveryStatus -> DeliveryStatus
min :: DeliveryStatus -> DeliveryStatus -> DeliveryStatus
Ord, ReadPrec [DeliveryStatus]
ReadPrec DeliveryStatus
Int -> ReadS DeliveryStatus
ReadS [DeliveryStatus]
(Int -> ReadS DeliveryStatus)
-> ReadS [DeliveryStatus]
-> ReadPrec DeliveryStatus
-> ReadPrec [DeliveryStatus]
-> Read DeliveryStatus
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS DeliveryStatus
readsPrec :: Int -> ReadS DeliveryStatus
$creadList :: ReadS [DeliveryStatus]
readList :: ReadS [DeliveryStatus]
$creadPrec :: ReadPrec DeliveryStatus
readPrec :: ReadPrec DeliveryStatus
$creadListPrec :: ReadPrec [DeliveryStatus]
readListPrec :: ReadPrec [DeliveryStatus]
Read, Int -> DeliveryStatus -> ShowS
[DeliveryStatus] -> ShowS
DeliveryStatus -> String
(Int -> DeliveryStatus -> ShowS)
-> (DeliveryStatus -> String)
-> ([DeliveryStatus] -> ShowS)
-> Show DeliveryStatus
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> DeliveryStatus -> ShowS
showsPrec :: Int -> DeliveryStatus -> ShowS
$cshow :: DeliveryStatus -> String
show :: DeliveryStatus -> String
$cshowList :: [DeliveryStatus] -> ShowS
showList :: [DeliveryStatus] -> ShowS
Show)

-- "Reporting-MTA: dns; d218-13.smtp-out.eu-west-2.amazonses.com\r\n\r\nAction: failed\r\nFinal-Recipient: rfc822; bounce@simulator.amazonses.com\r\nDiagnostic-Code: smtp; 550 5.1.1 user unknown\r\nStatus: 5.1.1\r\n\r\n"

-- | This parser isn't fully compliant with the RFC, since it omits the syntax
-- variants marked as obsolete. The obsolete syntax may be supported in future,
-- but was omitted for simplicity (my use cases didn't need it).
parser :: AP.Parser DeliveryStatus
parser :: Parser DeliveryStatus
parser =
  NonEmpty RawField
-> NonEmpty (NonEmpty PerRecipientField) -> DeliveryStatus
DeliveryStatus
    (NonEmpty RawField
 -> NonEmpty (NonEmpty PerRecipientField) -> DeliveryStatus)
-> Parser Text (NonEmpty RawField)
-> Parser
     Text (NonEmpty (NonEmpty PerRecipientField) -> DeliveryStatus)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser RawField -> Parser Text (NonEmpty RawField)
forall (f :: * -> *) a. Alternative f => f a -> f (NonEmpty a)
some1 Parser RawField
fieldParser
    Parser
  Text (NonEmpty (NonEmpty PerRecipientField) -> DeliveryStatus)
-> Parser Text (NonEmpty (NonEmpty PerRecipientField))
-> Parser DeliveryStatus
forall a b. Parser Text (a -> b) -> Parser Text a -> Parser Text b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Text (NonEmpty PerRecipientField)
-> Parser Text (NonEmpty (NonEmpty PerRecipientField))
forall (f :: * -> *) a. Alternative f => f a -> f (NonEmpty a)
some1 (Text -> Parser Text Text
AP.string Text
"\r\n" Parser Text Text
-> Parser Text (NonEmpty PerRecipientField)
-> Parser Text (NonEmpty PerRecipientField)
forall a b. Parser Text a -> Parser Text b -> Parser Text b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser PerRecipientField
-> Parser Text (NonEmpty PerRecipientField)
forall (f :: * -> *) a. Alternative f => f a -> f (NonEmpty a)
some1 Parser PerRecipientField
perRecipientFieldParser)