fcmtp-data/src/Data/SMTP/Parser/Extension.hs

{-# LANGUAGE OverloadedStrings #-}
-- Parser of mail commands

module Data.SMTP.Parser.Extension (
  parseExtension
  ) where

import Data.SMTP.Types.Extension

import Control.Applicative ((<|>))
import qualified Data.Attoparsec.ByteString.Char8 as A
import Data.Attoparsec.ByteString (Parser)
import qualified Data.Char as C

noParameterExtensions :: [ExtName]
noParameterExtensions = [E8BITMIME, CHUNKING, HELP, SMTPUTF8, STARTTLS, PIPELINING,
                         ATRN, DSN, ETRN, UTF8SMTP, ENHANCEDSTATUSCODES, EXPN, BINARYMIME,
                         CHECKPOINT, DELIVERBY, NOSOLICITING, MTRK, SUBMITTER, BURL,
                         FUTURERELEASE, CONPERM, CONNEG, MTPRIORITY, RRVS, SIZE]

parseExtension :: Parser Extension
parseExtension = parseAuth <|> parseSize <|> onlyName noParameterExtensions

onlyName :: [ExtName] -> Parser Extension
onlyName = foldr
           (\ e ->
             (<|>) ((A.stringCI . printExtName $ e) *> (return . OnlyExt $ e)))
           (fail "Unknown extension")

parseAuth :: Parser Extension
parseAuth = do
  A.stringCI "AUTH "
  skipHor
  mets <- parseAuthMethods
  return $ AuthExt AUTH mets
  
parseAuthMethods :: Parser [SaslMethod]
parseAuthMethods = parsePlainAuth

parsePlainAuth :: Parser [SaslMethod]
parsePlainAuth = do
  A.stringCI "PLAIN"
  skipHor
  return [PLAIN]
  
parseSize :: Parser Extension
parseSize = do
  A.stringCI "SIZE "
  skipHor
  size <- A.decimal
  return $ IntExt SIZE size

skipHor :: Parser ()
skipHor = A.skipWhile $ A.isHorizontalSpace . fromIntegral . C.ord