fcmtp-data/src/Data/SMTP/Types/Resource.hs

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.Lazy as LBS
import qualified Text.StringConvert as SC

import Data.Char

data Header = Header (String, String) deriving (Read, Show, Eq, Ord)

data ResourceInfo = ResourceInfo {
  mimeType :: Mime.ContentType,
  mimeParameters :: Mime.ContentTypeParameters,
  revision :: URI.Revision,
  bases :: [URI.Revision],
  address :: [URI.URI]
  } deriving (Eq, Ord, Show)

type ResourceData = LBS.ByteString

getHeader :: [Header] -> String -> Maybe Header
getHeader [] _ = Nothing
getHeader (h@(Header (hk, _)) : hh) k
  | map toLower hk == map toLower k = Just h
  | otherwise = getHeader hh k

getHeaderValue :: [Header] -> String -> Maybe String
getHeaderValue hh h = case getHeader hh h of
  Just (Header (_, v)) -> Just v
  Nothing -> Nothing

getMultiple :: [Header] -> String -> [Header]
getMultiple hh h = filter (\(Header (k, _)) -> k == h) hh

getMultipleValue :: [Header] -> String -> [String]
getMultipleValue hh = map (\(Header (_, v)) -> v) . getMultiple hh

revisionHeader :: String
revisionHeader = "fCMTP-Revision"

baseHeader :: String
baseHeader = "fCMTP-Revision-Base"

addressHeader :: String
addressHeader = "fCMTP-Address"

resourceInfo :: [Header] -> Maybe ResourceInfo
resourceInfo hh = do
  (mimet, mimep) <- getHeaderValue hh Mime.contentTypeHeaderName >>= bparse PMime.parseContentType
  curr <- URI.Revision <$> getHeaderValue hh revisionHeader
  let bb = map URI.Revision $ getMultipleValue hh baseHeader
  uu <- mapM (bparse URI.parseURI) $ getMultipleValue hh addressHeader
  return $ 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