123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263 |
- {-# LANGUAGE OverloadedStrings #-}
- module Data.SMTP.Extensions where
- import Data.List
- import Data.ByteString (ByteString)
- import qualified Data.ByteString as BS
- import Text.StringConvert
- data Extension = OnlyExt ExtName | IntExt ExtName Int | StringExt ExtName ByteString
- | AuthExt ExtName [SaslMethod] deriving (Eq, Ord, Read, Show)
- data ExtName = E8BITMIME | AUTH | CHUNKING | HELP | SIZE | SMTPUTF8 |
- STARTTLS | PIPELINING | ATRN | DSN | ETRN | UTF8SMTP |
- UNRECOGNIZED | ENHANCEDSTATUSCODES | EXPN | BINARYMIME |
- CHECKPOINT | DELIVERBY | NOSOLICITING | MTRK | SUBMITTER |
- BURL | FUTURERELEASE | CONPERM | CONNEG | MTPRIORITY | RRVS deriving (Eq, Ord, Read, Show)
- ehloValue :: Extension -> ByteString
- ehloValue (OnlyExt e) = printExtName e
- ehloValue (IntExt e v) = BS.intercalate " " [printExtName e, s $ show v]
- ehloValue (StringExt e v) = BS.intercalate " " [printExtName e, v]
- ehloValue (AuthExt e v) = BS.intercalate " " (printExtName e : map saslValue v)
- printExtName :: ExtName -> ByteString
- printExtName E8BITMIME = "8BITMIME"
- printExtName NOSOLICITING = "NO-SOLICITING"
- printExtName MTPRIORITY = "MT-PRIORITY"
- printExtName e = s . show $ e
- hasExtension :: [Extension] -> ExtName -> Bool
- hasExtension [] _ = False
- hasExtension (e:ee) name = (name' == name) || hasExtension ee name
- where
- name' = getExtName e
- getExtension :: [Extension] -> ExtName -> Maybe Extension
- getExtension [] _ = Nothing
- getExtension (e:ee) name = if name' == name then Just e else getExtension ee name
- where
- name' = getExtName e
- getExtName :: Extension -> ExtName
- getExtName (OnlyExt a) = a
- getExtName (IntExt a _) = a
- getExtName (StringExt a _) = a
- getExtName (AuthExt a _) = a
- data SaslMethod = PLAIN | DIGEST_MD5 | GSSAPI | UNRECOGNIZED_SASL deriving (Eq, Ord, Read, Show)
- saslValue :: SaslMethod -> ByteString
- saslValue DIGEST_MD5 = "DIGEST-MD5"
- saslValue v = s . show $ v
- readAllSasl :: String -> [SaslMethod]
- readAllSasl [] = []
- readAllSasl (' ':ss) = readAllSasl ss
- readAllSasl ss
- | "DIGEST-MD5" `isPrefixOf` ss = DIGEST_MD5 : readAllSasl (drop 10 ss)
- | "PLAIN" `isPrefixOf` ss = PLAIN : readAllSasl (drop 5 ss)
- | "GSSAPI" `isPrefixOf` ss = GSSAPI : readAllSasl (drop 6 ss)
- readAllSasl (_:ss) = readAllSasl ss
|