123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113 |
- {-# LANGUAGE OverloadedStrings #-}
- module Data.SMTP.Response (
- ResponseStatus(..),
- Response(..),
- parseResponse,
- parseLineResponse,
- renderResponse,
- renderLineResponse,
- )where
- import qualified Data.Attoparsec.ByteString.Char8 as A
- import Data.Attoparsec.ByteString.Char8.Extras
- import Data.Default.Class
- import Data.ByteString (ByteString)
- import qualified Data.ByteString as BS
- import Text.StringConvert
- data ResponseStatus = Preliminary | Completion | Intermediate | TransientError | PermanentError
- deriving (Read, Show, Ord, Eq)
- data Response = Response {status :: ResponseStatus, respLines :: [ByteString],
- code :: Int, extended :: Maybe (Int, Int, Int), message :: ByteString}
- deriving (Read, Show, Ord, Eq)
- instance Default Response where
- def = Response PermanentError [] 500 Nothing ""
- parseLineResponse :: A.Parser Response
- parseLineResponse = do
- (cd, xcd, m, _) <- parseLine
- return $ Response (statusFromCode cd) [] cd xcd m
-
- parseResponse :: A.Parser Response
- parseResponse = do
- (cd, xcd, m, moreLines) <- parseLine
- A.endOfLine
- lns <- parseLines moreLines
- return $ Response (statusFromCode cd) lns cd xcd m
- parseLines :: Bool -> A.Parser [ByteString]
- parseLines False = return []
- parseLines True = do
- (_, _, m, moreLines) <- parseLine
- A.endOfLine
- lns <- parseLines moreLines
- return $ m : lns
- parseLine :: A.Parser (Int, Maybe (Int, Int, Int), ByteString, Bool)
- parseLine = A.choice [
- do
- cd <- A.decimal
- A.string "-"
- xcd <- parsexcode "-"
- m <- A.takeTill (A.isEndOfLine. asW8)
- return (cd, xcd, m, True),
- do
- cd <- A.decimal
- A.string " "
- xcd <- parsexcode " "
- m <- A.takeTill (A.isEndOfLine . asW8)
- return (cd, xcd, m, False)
- ]
- parsexcode :: ByteString -> A.Parser (Maybe (Int, Int, Int))
- parsexcode sep = A.choice [
- do
- c1 <- A.decimal
- A.string "."
- c2 <- A.decimal
- A.string "."
- c3 <- A.decimal
- A.string sep
- return $ Just (c1, c2, c3),
- return Nothing
- ]
- statusFromCode :: Int -> ResponseStatus
- statusFromCode c
- | c < 100 = PermanentError
- | c < 200 = Preliminary
- | c < 300 = Completion
- | c < 400 = Intermediate
- | c < 500 = TransientError
- | otherwise = PermanentError
- renderResponse :: Response -> ByteString
- renderResponse (Response _ lns cd ext msg) = let
- tst = showBS cd
- sep = if null lns then " " else "-"
- enh = case ext of
- Nothing -> ""
- Just (s1, s2, s3) -> BS.intercalate "." $ map showBS [s1, s2, s3]
- in BS.concat $ [tst, sep, enh, if BS.null enh then "" else sep, msg, "\r\n"] ++ renderLines tst enh lns
- where
- renderLines _ _ [] = []
- renderLines tst enh (l:ll) = let
- sep = if null ll then " " else "-"
- in [tst, sep, enh, if BS.null enh then "" else sep, l, "\r\n"] ++ renderLines tst enh ll
- renderLineResponse :: Response -> ByteString
- renderLineResponse (Response _ _ cd ext msg) = let
- tst = showBS cd
- sep = " "
- enh = case ext of
- Nothing -> ""
- Just (s1, s2, s3) -> BS.intercalate "." $ map showBS [s1, s2, s3]
- in BS.concat [tst, sep, enh, if BS.null enh then "" else sep, msg]
- showBS :: Show a => a -> ByteString
- showBS = s . show
|