packages feed

delivery-status-notification (empty) → 0.1.0.0

raw patch · 5 files changed

+355/−0 lines, 5 filesdep +basedep +delivery-status-notification

Dependencies added: base, delivery-status-notification

Files

+ CHANGELOG.md view
@@ -0,0 +1,5 @@+# Revision history for delivery-status-notification++## 0.1.0.0 -- 2024-08-18++* implemented `Email.StatusCode`
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright (c) 2024, Ben Millwood++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.++    * Redistributions in binary form must reproduce the above+      copyright notice, this list of conditions and the following+      disclaimer in the documentation and/or other materials provided+      with the distribution.++    * Neither the name of Ben Millwood nor the names of other+      contributors may be used to endorse or promote products derived+      from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ delivery-status-notification.cabal view
@@ -0,0 +1,49 @@+cabal-version:      3.0+name:               delivery-status-notification+version:            0.1.0.0+synopsis:           Parse bounce messages per RFC3464, RFC3463++description:+  delivery-status-notification seeks to aid in understanding bounce e-mails. The+  library will be guided by RFC3464 and RFC3463 (and any other relevant RFCs I+  find), but in practice will prioritise being useful over being correct, since+  DSNs in practice seem to have a reputation for being inconsistent.++homepage:           https://github.com/bmillwood/delivery-status-notification+license:            BSD-3-Clause+license-file:       LICENSE+author:             Ben Millwood+maintainer:         thebenmachine+git@gmail.com+copyright:          2024 Ben Millwood+category:           Web+build-type:         Simple+extra-doc-files:    CHANGELOG.md+-- extra-source-files:++source-repository head+  type: git+  location: git://github.com/bmillwood/delivery-status-notification.git++common warnings+    ghc-options: -Wall++library+    import:           warnings+    exposed-modules:  Email.StatusCode+    -- other-modules:+    -- other-extensions:+    build-depends:    base ^>=4.18.2.1+    hs-source-dirs:   src+    default-language: GHC2021++test-suite delivery-status-notification-test+    import:           warnings+    default-language: GHC2021+    -- other-modules:+    -- other-extensions:+    type:             exitcode-stdio-1.0+    hs-source-dirs:   test+    main-is:          Main.hs+    build-depends:+        base ^>=4.18.2.1,+        delivery-status-notification
+ src/Email/StatusCode.hs view
@@ -0,0 +1,230 @@+-- | 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/Main.hs view
@@ -0,0 +1,41 @@+module Main (main) where++import Control.Monad++import Email.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+      ]