1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768 |
- {-# LANGUAGE OverloadedStrings #-}
- module Data.SMTP.Parser.Address (
- parseAddress,
- parseMetadataAddress,
- renderMetadataAddress
- ) where
- import Data.Attoparsec.ByteString.Char8
- import qualified Data.SMTP.URI as URI
- import Data.SMTP.Account
- import Data.SMTP.Types.Address
- import qualified Data.SMTP.Seal as Seal
- import Data.Attoparsec.ByteString.Char8.Extras
- import Data.ByteString (ByteString)
- import qualified Data.ByteString as BS
- import qualified Data.ByteString.Base64 as B64
- import Control.Applicative ((<|>))
- parseAddress :: Parser Address
- parseAddress = ((\x -> Address (Just x) (URI.account x) Nothing) <$> URI.parseURI) <|>
- ((\x -> Address Nothing x Nothing) <$> parseAccount)
- renderMetadataAddress :: Address -> ByteString
- renderMetadataAddress add@(Address _ _ s) =
- BS.intercalate "; " $ asToURI add : case s of
- Nothing -> []
- Just (Seal.Seal cp code nonce) -> [
- BS.append "CP=" $ B64.encode cp
- ] ++ nc nonce ++ [
- BS.append "SEAL=" $ B64.encode code
- ]
- where
- nc nonce = case nonce of
- Nothing -> []
- Just n -> [BS.append "Nonce=" $ B64.encode n]
- parseMetadataAddress :: Parser Address
- parseMetadataAddress = do
- a <- parseAddress
- (cp, nonce, code) <- parserFold addrParams (Nothing, Nothing, Nothing)
- let r = do
- cp' <- cp
- code' <- code
- return a{seal=Just $ Seal.Seal cp' code' nonce}
- case r of
- Nothing -> return a
- Just r' -> return r'
- where
- addrParams = choice [
- do
- c <- cmdSep "CP" decodeBase64
- return $ \(_, n, s) -> (Just c, n, s),
- do
- n <- cmdSep "Nonce" decodeBase64
- return $ \(c, _, s) -> (c, Just n, s),
- do
- s <- cmdSep "Seal" decodeBase64
- return $ \(c, n, _) -> (c, n, Just s)
- ]
- cmdSep c p = do
- skipWhile isCHorizontalSpace
- stringCI c
- skipWhile isCHorizontalSpace
- char ':'
- skipWhile isCHorizontalSpace
- p
|