packages feed

delivery-status-notification 0.1.0.0 → 0.2.0.0

raw patch · 8 files changed

+509/−277 lines, 8 filesdep +attoparsecdep +textdep ~base

Dependencies added: attoparsec, text

Dependency ranges changed: base

Files

CHANGELOG.md view
@@ -1,5 +1,11 @@ # Revision history for delivery-status-notification +## 0.2.0.0 -- 2024-08-19++* added attoparsec status code parser+* added `Email.DSN.DeliveryStatus`+* moved `Email.StatusCode` to `Email.DSN.StatusCode`+ ## 0.1.0.0 -- 2024-08-18  * implemented `Email.StatusCode`
delivery-status-notification.cabal view
@@ -1,6 +1,6 @@ cabal-version:      3.0 name:               delivery-status-notification-version:            0.1.0.0+version:            0.2.0.0 synopsis:           Parse bounce messages per RFC3464, RFC3463  description:@@ -27,23 +27,34 @@ common warnings     ghc-options: -Wall +common language+    default-language: GHC2021+    default-extensions:+      OverloadedStrings+ library+    import:           language     import:           warnings-    exposed-modules:  Email.StatusCode+    exposed-modules:+      Email.DSN.DeliveryStatus+      Email.DSN.StatusCode     -- other-modules:-    -- other-extensions:-    build-depends:    base ^>=4.18.2.1+    build-depends:+      attoparsec ^>=0.14,+      base ^>=4.18,+      text >= 2.0 && < 2.2,     hs-source-dirs:   src-    default-language: GHC2021  test-suite delivery-status-notification-test+    import:           language     import:           warnings-    default-language: GHC2021-    -- other-modules:-    -- other-extensions:     type:             exitcode-stdio-1.0     hs-source-dirs:   test     main-is:          Main.hs+    other-modules:+      DeliveryStatus+      StatusCode     build-depends:-        base ^>=4.18.2.1,-        delivery-status-notification+      attoparsec ^>=0.14,+      base ^>=4.18,+      delivery-status-notification,
+ src/Email/DSN/DeliveryStatus.hs view
@@ -0,0 +1,119 @@+-- | 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 { fieldName :: Text, fieldBody :: Text }+  deriving (Generic, Eq, Ord, Read, 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 =+  RawField+  <$> AP.takeWhile1 (\c -> c > ' ' && c /= ':' && c < '\x80')+  <* skipLWS <* AP.char ':'+  <*> unstructured+  <* AP.string "\r\n"++skipLWS :: AP.Parser ()+skipLWS =+  AP.skipWhile isWsp+  <* AP.option () (AP.string "\r\n" *> AP.skip isWsp *> 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 =+  Text.append+    <$> (Text.concat <$> many (Text.snoc <$> fws0 <*> AP.satisfy isVchar))+    <*> AP.takeWhile isWsp+  -- <|> obsUnstruct++fws0 :: AP.Parser Text+fws0 =+  Text.append+    <$> AP.takeWhile isWsp+    <*> AP.option "" (AP.string "\r\n" *> AP.takeWhile1 isWsp)+  -- <|> obsFws++isWsp :: Char -> Bool+isWsp c = c == ' ' || c == '\t'++isVchar :: Char -> Bool+isVchar c = c >= '\x21' && c <= '\x7e'++-- | A subset of the RFC-specified per-recipient fields, chosen because they are+-- the ones most useful for interpreting bounces.+data PerRecipientField+  = FinalRecipient { addressType :: Text, address :: Text }+  | Status DSC.StatusCode+  | OtherPerRecipient RawField+  deriving (Generic, Eq, Ord, Read, Show)++perRecipientFieldParser :: AP.Parser PerRecipientField+perRecipientFieldParser = ofRaw =<< fieldParser+  where+    ofRaw raw@RawField{ fieldName, fieldBody } =+      case Text.toLower fieldName of+        "final-recipient" ->+          case Text.break (== ';') fieldBody of+            (_, "") -> fail "final-recipient should contain ;"+            (addressType, rest) ->+              pure $ FinalRecipient+                { addressType = Text.dropWhile isSpace addressType+                , address = Text.dropWhile isSpace $ Text.drop 1 rest+                }+        "status" ->+          either fail (pure . Status)+          $ AP.parseOnly (DSC.parser <* AP.endOfInput)+          $ Text.dropWhile isSpace fieldBody+        _ -> pure $ OtherPerRecipient raw++-- | Body of a message/delivery-status+-- https://www.rfc-editor.org/rfc/rfc3464#section-2.1+data DeliveryStatus = DeliveryStatus+  { perMessageFields :: NonEmpty RawField+  , perRecipientFields :: NonEmpty (NonEmpty PerRecipientField)+  } deriving (Generic, Eq, Ord, Read, 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 =+  DeliveryStatus+    <$> some1 fieldParser+    <*> some1 (AP.string "\r\n" *> some1 perRecipientFieldParser)
+ src/Email/DSN/StatusCode.hs view
@@ -0,0 +1,250 @@+-- | https://www.rfc-editor.org/rfc/rfc3463+module Email.DSN.StatusCode+  ( StatusCode(..)+  , Class(..), encodeClass, decodeClass+  , SubjectDetail(..), encodeSubjectDetail, decodeSubjectDetail+  , AddressingDetail(..), encodeAddressingDetail, decodeAddressingDetail+  , MailboxDetail(..), encodeMailboxDetail, decodeMailboxDetail+  , MailSystemDetail(..), encodeMailSystemDetail, decodeMailSystemDetail+  , NetworkAndRoutingDetail(..), encodeNetworkAndRoutingDetail, decodeNetworkAndRoutingDetail+  , DeliveryProtocolDetail(..), encodeDeliveryProtocolDetail, decodeDeliveryProtocolDetail+  , MessageContentOrMediaDetail(..), encodeMessageContentOrMediaDetail, decodeMessageContentOrMediaDetail+  , SecurityOrPolicyDetail(..), encodeSecurityOrPolicyDetail, decodeSecurityOrPolicyDetail+  , parse, parseWithRemainder+  , encodeString+  , parser+  ) where++import Data.Char (isDigit, isSpace)+import GHC.Generics (Generic)+import Text.Read (readMaybe)++import qualified Data.Attoparsec.Text as AP++data StatusCode = StatusCode Class SubjectDetail+  deriving (Generic, Eq, Ord, Read, Show)++data Class+  = Success+  | PersistentTransientFailure+  | PermanentFailure+  deriving (Generic, Eq, Ord, Read, Show)++encodeClass :: Class -> Int+encodeClass c = case c of+  Success -> 2+  PersistentTransientFailure -> 4+  PermanentFailure -> 5++decodeClass :: Int -> Maybe Class+decodeClass c = case c of+  2 -> Just Success+  4 -> Just PersistentTransientFailure+  5 -> Just PermanentFailure+  _ -> Nothing++safeToEnum :: forall a. (Bounded a, Enum a) => Int -> Maybe a+safeToEnum i+  | i < fromEnum (minBound :: a)+    || i > fromEnum (maxBound :: a) = Nothing+  | otherwise = Just (toEnum i)++data AddressingDetail+  = OtherAddressDetail+  | BadDestinationMailbox+  | BadDestinationSystem+  | BadDestinationMailboxSyntax+  | DestinationMailboxAmbiguous+  | DestinationAddressValid+  | DestinationMailboxMovedNoForwarding+  | BadSenderMailboxSyntax+  | BadSenderSystemAddress+  deriving (Generic, Bounded, Enum, Eq, Ord, Read, Show)++encodeAddressingDetail :: AddressingDetail -> Int+encodeAddressingDetail = fromEnum++decodeAddressingDetail :: Int -> Maybe AddressingDetail+decodeAddressingDetail = safeToEnum++data MailboxDetail+  = OtherMailboxDetail+  | MailboxDisabled+  | MailboxFull+  | MessageLengthExceedsAdminLimit+  | MailingListExpansionProblem+  deriving (Generic, Bounded, Enum, Eq, Ord, Read, Show)++encodeMailboxDetail :: MailboxDetail -> Int+encodeMailboxDetail = fromEnum++decodeMailboxDetail :: Int -> Maybe MailboxDetail+decodeMailboxDetail = safeToEnum++data MailSystemDetail+  = OtherMailSystemDetail+  | MailSystemFull+  | SystemNotAcceptingMessages+  | SystemNotCapableOfSelectedFeatures+  | MessageTooBigForSystem+  | SystemIncorrectlyConfigured+  deriving (Generic, Bounded, Enum, Eq, Ord, Read, Show)++encodeMailSystemDetail :: MailSystemDetail -> Int+encodeMailSystemDetail = fromEnum++decodeMailSystemDetail :: Int -> Maybe MailSystemDetail+decodeMailSystemDetail = safeToEnum++data NetworkAndRoutingDetail+  = OtherNetworkAndRoutingDetail+  | NoAnswerFromHost+  | BadConnection+  | DirectoryServerFailure+  | UnableToRoute+  | MailSystemCongestion+  | RoutingLoopDetected+  | DeliveryTimeExpired+  deriving (Generic, Bounded, Enum, Eq, Ord, Read, Show)++encodeNetworkAndRoutingDetail :: NetworkAndRoutingDetail -> Int+encodeNetworkAndRoutingDetail = fromEnum++decodeNetworkAndRoutingDetail :: Int -> Maybe NetworkAndRoutingDetail+decodeNetworkAndRoutingDetail = safeToEnum++data DeliveryProtocolDetail+  = OtherDeliveryProtocolDetail+  | InvalidCommand+  | SyntaxError+  | TooManyRecipients+  | InvalidCommandArguments+  | WrongProtocolVersion+  deriving (Generic, Bounded, Enum, Eq, Ord, Read, Show)++encodeDeliveryProtocolDetail :: DeliveryProtocolDetail -> Int+encodeDeliveryProtocolDetail = fromEnum++decodeDeliveryProtocolDetail :: Int -> Maybe DeliveryProtocolDetail+decodeDeliveryProtocolDetail = safeToEnum++data MessageContentOrMediaDetail+  = OtherContentOrMediaDetail+  | MediaNotSupported+  | ConversionRequiredAndProhibited+  | ConversionRequiredAndUnsupported+  | ConversionWithLossPerformed+  | ConversionFailed+  deriving (Generic, Bounded, Enum, Eq, Ord, Read, Show)++encodeMessageContentOrMediaDetail :: MessageContentOrMediaDetail -> Int+encodeMessageContentOrMediaDetail = fromEnum++decodeMessageContentOrMediaDetail :: Int -> Maybe MessageContentOrMediaDetail+decodeMessageContentOrMediaDetail = safeToEnum++data SecurityOrPolicyDetail+  = OtherSecurityOrPolicyDetail+  | DeliveryNotAuthorized+  | MailingListExpansionProhibited+  | SecurityConversionRequiredButNotPossible+  | SecurityFeaturesNotSupported+  | CryptographicFailure+  | CryptographicAlgorithmNotSupported+  | MessageIntegrityFailure+  deriving (Generic, Bounded, Enum, Eq, Ord, Read, Show)++encodeSecurityOrPolicyDetail :: SecurityOrPolicyDetail -> Int+encodeSecurityOrPolicyDetail = fromEnum++decodeSecurityOrPolicyDetail :: Int -> Maybe SecurityOrPolicyDetail+decodeSecurityOrPolicyDetail = safeToEnum++data SubjectDetail+  = OtherSubjectDetail+  | Addressing AddressingDetail+  | Mailbox MailboxDetail+  | MailSystem MailSystemDetail+  | NetworkAndRouting NetworkAndRoutingDetail+  | MailDeliveryProtocol DeliveryProtocolDetail+  | MessageContentOrMedia MessageContentOrMediaDetail+  | SecurityOrPolicy SecurityOrPolicyDetail+  deriving (Generic, Eq, Ord, Read, Show)++decodeSubjectDetail :: Int -> Int -> Maybe SubjectDetail+decodeSubjectDetail subjectNum detailNum =+  case subjectNum of+    0 | detailNum == 0 -> Just OtherSubjectDetail+      | otherwise -> Nothing+    1 -> Addressing <$> decodeAddressingDetail detailNum+    2 -> Mailbox <$> decodeMailboxDetail detailNum+    3 -> MailSystem <$> decodeMailSystemDetail detailNum+    4 -> NetworkAndRouting <$> decodeNetworkAndRoutingDetail detailNum+    5 -> MailDeliveryProtocol <$> decodeDeliveryProtocolDetail detailNum+    6 -> MessageContentOrMedia <$> decodeMessageContentOrMediaDetail detailNum+    7 -> SecurityOrPolicy <$> decodeSecurityOrPolicyDetail detailNum+    _ -> Nothing++encodeSubjectDetail :: SubjectDetail -> (Int, Int)+encodeSubjectDetail sd = case sd of+  OtherSubjectDetail -> (0, 0)+  Addressing d -> (1, encodeAddressingDetail d)+  Mailbox d -> (2, encodeMailboxDetail d)+  MailSystem d -> (3, encodeMailSystemDetail d)+  NetworkAndRouting d -> (4, encodeNetworkAndRoutingDetail d)+  MailDeliveryProtocol d -> (5, encodeDeliveryProtocolDetail d)+  MessageContentOrMedia d -> (6, encodeMessageContentOrMediaDetail d)+  SecurityOrPolicy d -> (7, encodeSecurityOrPolicyDetail d)++parseNums :: String -> Maybe ((Int, Int, Int), String)+parseNums inp = do+  (classNum, afterClass) <- digitDot inp+  (subjectNum, afterSubject) <- digitDot afterClass+  case span isDigit afterSubject of+    (ns, rest) -> (, rest) . (classNum, subjectNum,) <$> readMaybe ns+  where+    digitDot s = case break (== '.') s of+      (ns, _ : rest) -> (, rest) <$> readMaybe ns+      _ -> Nothing++parseWithRemainder :: String -> Maybe (StatusCode, String)+parseWithRemainder s = do+  ((classNum, subjectNum, detailNum), rest) <- parseNums s+  code <- StatusCode+    <$> decodeClass classNum+    <*> decodeSubjectDetail subjectNum detailNum+  Just (code, rest)++parse :: String -> Maybe StatusCode+parse s = do+  (code, r) <- parseWithRemainder s+  if all isSpace r+    then Just code+    else Nothing++encodeString :: StatusCode -> String+encodeString (StatusCode cl sd) =+  shows (encodeClass cl)+  . showString "."+  . shows subjectNum+  . showString "."+  $ show detailNum+  where+    (subjectNum, detailNum) = encodeSubjectDetail sd++parser :: AP.Parser StatusCode+parser =+  StatusCode+  <$> classParser+  <* AP.char '.'+  <*> sdParser+  where+    classParser =+      decodeClass <$> AP.decimal+      >>= maybe (fail "invalid class") pure+    sdParser =+      decodeSubjectDetail+        <$> AP.decimal+        <* AP.char '.'+        <*> AP.decimal+      >>= maybe (fail "invalid subject/detail") pure
− src/Email/StatusCode.hs 
@@ -1,230 +0,0 @@--- | https://www.rfc-editor.org/rfc/rfc3463-module Email.StatusCode-  ( StatusCode(..)-  , Class(..), encodeClass, decodeClass-  , SubjectDetail(..), encodeSubjectDetail, decodeSubjectDetail-  , AddressingDetail(..), encodeAddressingDetail, decodeAddressingDetail-  , MailboxDetail(..), encodeMailboxDetail, decodeMailboxDetail-  , MailSystemDetail(..), encodeMailSystemDetail, decodeMailSystemDetail-  , NetworkAndRoutingDetail(..), encodeNetworkAndRoutingDetail, decodeNetworkAndRoutingDetail-  , DeliveryProtocolDetail(..), encodeDeliveryProtocolDetail, decodeDeliveryProtocolDetail-  , MessageContentOrMediaDetail(..), encodeMessageContentOrMediaDetail, decodeMessageContentOrMediaDetail-  , SecurityOrPolicyDetail(..), encodeSecurityOrPolicyDetail, decodeSecurityOrPolicyDetail-  , parse, parseWithRemainder-  , encodeString-  ) where--import Data.Char (isDigit, isSpace)-import GHC.Generics (Generic)-import Text.Read (readMaybe)--data StatusCode = StatusCode Class SubjectDetail-  deriving (Generic, Eq, Ord, Read, Show)--data Class-  = Success-  | PersistentTransientFailure-  | PermanentFailure-  deriving (Generic, Eq, Ord, Read, Show)--encodeClass :: Class -> Int-encodeClass c = case c of-  Success -> 2-  PersistentTransientFailure -> 4-  PermanentFailure -> 5--decodeClass :: Int -> Maybe Class-decodeClass c = case c of-  2 -> Just Success-  4 -> Just PersistentTransientFailure-  5 -> Just PermanentFailure-  _ -> Nothing--safeToEnum :: forall a. (Bounded a, Enum a) => Int -> Maybe a-safeToEnum i-  | i < fromEnum (minBound :: a)-    || i > fromEnum (maxBound :: a) = Nothing-  | otherwise = Just (toEnum i)--data AddressingDetail-  = OtherAddressDetail-  | BadDestinationMailbox-  | BadDestinationSystem-  | BadDestinationMailboxSyntax-  | DestinationMailboxAmbiguous-  | DestinationAddressValid-  | DestinationMailboxMovedNoForwarding-  | BadSenderMailboxSyntax-  | BadSenderSystemAddress-  deriving (Generic, Bounded, Enum, Eq, Ord, Read, Show)--encodeAddressingDetail :: AddressingDetail -> Int-encodeAddressingDetail = fromEnum--decodeAddressingDetail :: Int -> Maybe AddressingDetail-decodeAddressingDetail = safeToEnum--data MailboxDetail-  = OtherMailboxDetail-  | MailboxDisabled-  | MailboxFull-  | MessageLengthExceedsAdminLimit-  | MailingListExpansionProblem-  deriving (Generic, Bounded, Enum, Eq, Ord, Read, Show)--encodeMailboxDetail :: MailboxDetail -> Int-encodeMailboxDetail = fromEnum--decodeMailboxDetail :: Int -> Maybe MailboxDetail-decodeMailboxDetail = safeToEnum--data MailSystemDetail-  = OtherMailSystemDetail-  | MailSystemFull-  | SystemNotAcceptingMessages-  | SystemNotCapableOfSelectedFeatures-  | MessageTooBigForSystem-  | SystemIncorrectlyConfigured-  deriving (Generic, Bounded, Enum, Eq, Ord, Read, Show)--encodeMailSystemDetail :: MailSystemDetail -> Int-encodeMailSystemDetail = fromEnum--decodeMailSystemDetail :: Int -> Maybe MailSystemDetail-decodeMailSystemDetail = safeToEnum--data NetworkAndRoutingDetail-  = OtherNetworkAndRoutingDetail-  | NoAnswerFromHost-  | BadConnection-  | DirectoryServerFailure-  | UnableToRoute-  | MailSystemCongestion-  | RoutingLoopDetected-  | DeliveryTimeExpired-  deriving (Generic, Bounded, Enum, Eq, Ord, Read, Show)--encodeNetworkAndRoutingDetail :: NetworkAndRoutingDetail -> Int-encodeNetworkAndRoutingDetail = fromEnum--decodeNetworkAndRoutingDetail :: Int -> Maybe NetworkAndRoutingDetail-decodeNetworkAndRoutingDetail = safeToEnum--data DeliveryProtocolDetail-  = OtherDeliveryProtocolDetail-  | InvalidCommand-  | SyntaxError-  | TooManyRecipients-  | InvalidCommandArguments-  | WrongProtocolVersion-  deriving (Generic, Bounded, Enum, Eq, Ord, Read, Show)--encodeDeliveryProtocolDetail :: DeliveryProtocolDetail -> Int-encodeDeliveryProtocolDetail = fromEnum--decodeDeliveryProtocolDetail :: Int -> Maybe DeliveryProtocolDetail-decodeDeliveryProtocolDetail = safeToEnum--data MessageContentOrMediaDetail-  = OtherContentOrMediaDetail-  | MediaNotSupported-  | ConversionRequiredAndProhibited-  | ConversionRequiredAndUnsupported-  | ConversionWithLossPerformed-  | ConversionFailed-  deriving (Generic, Bounded, Enum, Eq, Ord, Read, Show)--encodeMessageContentOrMediaDetail :: MessageContentOrMediaDetail -> Int-encodeMessageContentOrMediaDetail = fromEnum--decodeMessageContentOrMediaDetail :: Int -> Maybe MessageContentOrMediaDetail-decodeMessageContentOrMediaDetail = safeToEnum--data SecurityOrPolicyDetail-  = OtherSecurityOrPolicyDetail-  | DeliveryNotAuthorized-  | MailingListExpansionProhibited-  | SecurityConversionRequiredButNotPossible-  | SecurityFeaturesNotSupported-  | CryptographicFailure-  | CryptographicAlgorithmNotSupported-  | MessageIntegrityFailure-  deriving (Generic, Bounded, Enum, Eq, Ord, Read, Show)--encodeSecurityOrPolicyDetail :: SecurityOrPolicyDetail -> Int-encodeSecurityOrPolicyDetail = fromEnum--decodeSecurityOrPolicyDetail :: Int -> Maybe SecurityOrPolicyDetail-decodeSecurityOrPolicyDetail = safeToEnum--data SubjectDetail-  = OtherSubjectDetail-  | Addressing AddressingDetail-  | Mailbox MailboxDetail-  | MailSystem MailSystemDetail-  | NetworkAndRouting NetworkAndRoutingDetail-  | MailDeliveryProtocol DeliveryProtocolDetail-  | MessageContentOrMedia MessageContentOrMediaDetail-  | SecurityOrPolicy SecurityOrPolicyDetail-  deriving (Generic, Eq, Ord, Read, Show)--parseNums :: String -> Maybe ((Int, Int, Int), String)-parseNums inp = do-  (classNum, afterClass) <- digitDot inp-  (subjectNum, afterSubject) <- digitDot afterClass-  case span isDigit afterSubject of-    (ns, rest) -> (, rest) . (classNum, subjectNum,) <$> readMaybe ns-  where-    digitDot s = case break (== '.') s of-      (ns, _ : rest) -> (, rest) <$> readMaybe ns-      _ -> Nothing--decodeSubjectDetail :: Int -> Int -> Maybe SubjectDetail-decodeSubjectDetail subjectNum detailNum =-  case subjectNum of-    0 | detailNum == 0 -> Just OtherSubjectDetail-      | otherwise -> Nothing-    1 -> Addressing <$> decodeAddressingDetail detailNum-    2 -> Mailbox <$> decodeMailboxDetail detailNum-    3 -> MailSystem <$> decodeMailSystemDetail detailNum-    4 -> NetworkAndRouting <$> decodeNetworkAndRoutingDetail detailNum-    5 -> MailDeliveryProtocol <$> decodeDeliveryProtocolDetail detailNum-    6 -> MessageContentOrMedia <$> decodeMessageContentOrMediaDetail detailNum-    7 -> SecurityOrPolicy <$> decodeSecurityOrPolicyDetail detailNum-    _ -> Nothing--encodeSubjectDetail :: SubjectDetail -> (Int, Int)-encodeSubjectDetail sd = case sd of-  OtherSubjectDetail -> (0, 0)-  Addressing d -> (1, encodeAddressingDetail d)-  Mailbox d -> (2, encodeMailboxDetail d)-  MailSystem d -> (3, encodeMailSystemDetail d)-  NetworkAndRouting d -> (4, encodeNetworkAndRoutingDetail d)-  MailDeliveryProtocol d -> (5, encodeDeliveryProtocolDetail d)-  MessageContentOrMedia d -> (6, encodeMessageContentOrMediaDetail d)-  SecurityOrPolicy d -> (7, encodeSecurityOrPolicyDetail d)--parseWithRemainder :: String -> Maybe (StatusCode, String)-parseWithRemainder s = do-  ((classNum, subjectNum, detailNum), rest) <- parseNums s-  code <- StatusCode-    <$> decodeClass classNum-    <*> decodeSubjectDetail subjectNum detailNum-  Just (code, rest)--parse :: String -> Maybe StatusCode-parse s = do-  (code, r) <- parseWithRemainder s-  if all isSpace r-    then Just code-    else Nothing--encodeString :: StatusCode -> String-encodeString (StatusCode cl sd) =-  shows (encodeClass cl)-  . showString "."-  . shows subjectNum-  . showString "."-  $ show detailNum-  where-    (subjectNum, detailNum) = encodeSubjectDetail sd
+ test/DeliveryStatus.hs view
@@ -0,0 +1,40 @@+{-# LANGUAGE OverloadedLists #-}+module DeliveryStatus (main) where++import qualified Data.Attoparsec.Text as AP++import Email.DSN.DeliveryStatus+import qualified Email.DSN.StatusCode as DSC++main :: IO ()+main = do+  let+    input = "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"+    actual = AP.parseOnly parser input+    expected :: Either String DeliveryStatus+    expected =+      Right $ DeliveryStatus+        { perMessageFields =+            [ RawField "Reporting-MTA" " dns; d218-13.smtp-out.eu-west-2.amazonses.com"+            ]+        , perRecipientFields =+            [ [ OtherPerRecipient (RawField "Action" " failed")+              , FinalRecipient "rfc822" "bounce@simulator.amazonses.com"+              , OtherPerRecipient (RawField "Diagnostic-Code" " smtp; 550 5.1.1 user unknown")+              , Status (+                  DSC.StatusCode DSC.PermanentFailure+                    (DSC.Addressing DSC.BadDestinationMailbox)+                )+              ]+            ]+        }+  if actual == expected+  then pure ()+  else error $ mconcat+    [ "parsing "+    , show input+    , " expected "+    , show expected+    , " got "+    , show actual+    ]
test/Main.hs view
@@ -1,41 +1,9 @@ module Main (main) where -import Control.Monad--import Email.StatusCode+import qualified DeliveryStatus+import qualified StatusCode  main :: IO ()-main = forM_-  [ ("5.1.1", Just (StatusCode PermanentFailure (Addressing BadDestinationMailbox)))-  , ("2.0.1", Nothing)-  , ("2.0.0", Just (StatusCode Success OtherSubjectDetail))-  , ("0.0.0", Nothing)-  , ("5.7.0", Just (StatusCode PermanentFailure (SecurityOrPolicy OtherSecurityOrPolicyDetail)))-  ]-  $ \(input, expected) ->-    let-      actual = parse input-    in-    if actual == expected-    then case expected of-      Nothing -> pure ()-      Just code-        | roundtrip == input -> pure ()-        | otherwise -> error $ mconcat-            [ "encodeString "-            , show code-            , " expected "-            , show input-            , " got "-            , show roundtrip-            ]-        where-          roundtrip = encodeString code-    else error $ mconcat-      [ "parse "-      , show input-      , " expected "-      , show expected-      , " got "-      , show actual-      ]+main = do+  StatusCode.main+  DeliveryStatus.main
+ test/StatusCode.hs view
@@ -0,0 +1,68 @@+module StatusCode (main) where++import Control.Monad+import Data.Maybe+import Data.String++import qualified Data.Attoparsec.Text as AP++import Email.DSN.StatusCode++testStringParser :: (String, Maybe StatusCode) -> IO ()+testStringParser (input, expected)+  | actual /= expected = error $ mconcat+      [ "parse "+      , show input+      , " expected "+      , show expected+      , " got "+      , show actual+      ]+  | otherwise =+    case expected of+      Nothing -> pure ()+      Just code+        | roundtrip == input -> pure ()+        | otherwise -> error $ mconcat+            [ "encodeString "+            , show code+            , " expected "+            , show input+            , " got "+            , show roundtrip+            ]+        where+          roundtrip = encodeString code+  where+    actual = parse input++testAttoparsec :: (String, Maybe StatusCode) -> IO ()+testAttoparsec (input, expected)+  | expected /= actual = error $ mconcat+      [ "parse "+      , show input+      , " expected "+      , show expected+      , " got "+      , show actual+      ]+  | otherwise = pure ()+  where+    actual =+      case AP.parseOnly (parser <* AP.endOfInput) (fromString input) of+        Left e+          | isNothing expected -> Nothing+          | otherwise -> error e+        Right a -> Just a++main :: IO ()+main = forM_+  [ ("5.1.1", Just (StatusCode PermanentFailure (Addressing BadDestinationMailbox)))+  , ("2.0.1", Nothing)+  , ("2.0.0", Just (StatusCode Success OtherSubjectDetail))+  , ("0.0.0", Nothing)+  , ("5.7.0", Just (StatusCode PermanentFailure (SecurityOrPolicy OtherSecurityOrPolicyDetail)))+  ]+  $ \(input, expected) -> do+    testStringParser (input, expected)+    testAttoparsec (input, expected)