123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137 |
- {-# LANGUAGE OverloadedStrings #-}
- module Data.SMTP.Types.Resource where
- import qualified Data.SMTP.URI as URI
- import qualified Data.SMTP.Types.Mime as Mime
- import qualified Data.SMTP.Parser.Mime as PMime
- import qualified Data.Attoparsec.ByteString as BA
- import qualified Data.ByteString as BS
- import qualified Data.ByteString.Lazy as LBS
- import Data.ByteString.Base64 as Base64
- import qualified Text.StringConvert as SC
- import Text.Read (readMaybe)
- import Data.Maybe
- import Data.Default.Class
- import qualified Data.Char as C
- data Header = Header {key :: String, value :: String, bare :: BS.ByteString} deriving (Read, Show, Eq, Ord)
- data PlainHeaders = PlainHeaders {public :: [Header], sealed :: [Header], separators :: (BS.ByteString, BS.ByteString)} deriving (Read, Show, Eq, Ord)
- instance Default PlainHeaders where
- def = PlainHeaders [] [] ("\r\n", "")
- data ResourceInfo = ResourceInfo {
- mimeType :: Mime.ContentType,
- mimeParameters :: Mime.ContentTypeParameters,
- revision :: URI.Revision,
- bases :: [URI.Revision],
- address :: [URI.URI]
- } deriving (Eq, Ord, Show)
- instance Default ResourceInfo where
- def = ResourceInfo def def URI.NoRevision [] []
- type ResourceData = LBS.ByteString
- -- | Creates a header from a key and a value
- makeHeader :: String -> String -> Header
- makeHeader k v = Header k v . SC.s $ k ++ ": " ++ v ++ "\r\n"
- -- | True if the header key matches
- hasKey :: String -> Header -> Bool
- hasKey k h = map C.toLower k == key h
- -- | Retrieves a single header with the given key
- getHeader :: [Header] -> String -> Maybe Header
- getHeader hh k = case getMultiple hh k of
- [] -> Nothing
- (h:_) -> Just h
- -- | Retrieves the value of the header that matches key
- getHeaderValue :: [Header] -> String -> Maybe String
- getHeaderValue hh k = value <$> getHeader hh k
- {- |
- Retrieves the value of a boolean header,
- accepting the common true strings:
- true, t, yes, y, 1
- -}
- getBooleanHeader :: [Header] -> String -> Maybe Bool
- getBooleanHeader hh s = (\k -> map C.toLower k `elem` ["true", "t", "yes", "y", "1"]) <$> getHeaderValue hh s
- -- | Retrieves the binary value of a base64 encoded header
- getBase64Header :: [Header] -> String -> Maybe BS.ByteString
- getBase64Header hh s = getHeaderValue hh s >>= (rightToJust . Base64.decode . SC.s)
- where
- rightToJust = either (\_ -> Nothing) Just
- -- | Gets the reader value, and converts it with readMaybe
- getReadHeader :: Read a => [Header] -> String -> Maybe a
- getReadHeader hh s = getHeaderValue hh s >>= readMaybe
- -- | Retrieves all headers that match the key
- getMultiple :: [Header] -> String -> [Header]
- getMultiple hh k = filter (hasKey k) hh
- -- | Retrieves all the values of the headers that match the key
- getMultipleValue :: [Header] -> String -> [String]
- getMultipleValue hh k = map value $ getMultiple hh k
- -- | fCMTP revision header: "fCMTP-Revision"
- revisionHeader :: String
- revisionHeader = "fCMTP-Revision"
- -- | fCMTP base revision header: "fCMTP-Revision-Base"
- baseHeader :: String
- baseHeader = "fCMTP-Revision-Base"
- -- | fCMTP resource URI header: "fCMTP-Address"
- addressHeader :: String
- addressHeader = "fCMTP-Address"
- -- | Retrieves the meta information from resource headers
- resourceInfo :: PlainHeaders -> ResourceInfo
- resourceInfo (PlainHeaders _ ss _) = let
- (mimet, mimep) = fromMaybe (def, def) $ getHeaderValue ss Mime.contentTypeHeaderName >>= bparse PMime.parseContentType
- curr = fromMaybe URI.NoRevision $ URI.Revision <$> getHeaderValue ss revisionHeader
- bb = map URI.Revision $ getMultipleValue ss baseHeader
- uu = catMaybes . map (bparse URI.parseURI) $ getMultipleValue ss addressHeader
- in ResourceInfo mimet mimep curr bb uu
- where
- bparse :: BA.Parser a -> String -> Maybe a
- bparse p v = eitherToMaybe . BA.parseOnly p $ SC.s v
- eitherToMaybe (Left _) = Nothing
- eitherToMaybe (Right v) = Just v
- -- | Retrieve MIME information from the resource headers
- getMimeData :: [Header] -> (Mime.ContentTypeHeader, Mime.TransferEncoding)
- getMimeData hh = (ct, te)
- where
- ct = case getHeader hh Mime.contentTypeHeaderName of
- Nothing -> def
- Just h -> case BA.parseOnly PMime.parseContentType (SC.s . value $ h) of
- Left _ -> def
- Right (ctv, ctp) -> Mime.ContentTypeHeader ctv ctp
- te = case getHeader hh Mime.transferEncodingHeaderName of
- Nothing -> def
- Just h -> case BA.parseOnly PMime.parseTransferEncoding (SC.s . value $ h) of
- Left _ -> def
- Right t -> t
- -- | Recreates the original resource text for the headers
- originalData :: PlainHeaders -> BS.ByteString
- originalData (PlainHeaders pp ss (psep, ssep)) =
- BS.concat [
- catData pp, psep,
- catData ss, ssep
- ]
- where
- catData :: [Header] -> BS.ByteString
- catData hh = BS.concat . map bare $ hh
- -- | Recreates the original resource text for the sealed headers only
- originalSealed :: PlainHeaders -> BS.ByteString
- originalSealed (PlainHeaders _ ss (_, ssep)) =
- (BS.concat $ map bare ss) `BS.append` ssep
|