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

module Data.SMTP.Types.URI where

import qualified Network.URI as N
import Data.SMTP.Account
import Data.List
import qualified Data.Text as T
import qualified Data.SMTP.Seal as Seal
import qualified Data.Attoparsec.Text as A

import Text.StringConvert

newtype Path = Path [String] deriving (Eq, Ord, Read, Show)
newtype Revision = Revision String deriving (Eq, Ord, Read, Show)
data Parameter = Parameter String String deriving (Eq, Ord, Read, Show)

data URI = URI {account :: Account, path :: Path, revision :: Maybe Revision, parameters :: [Parameter]} 
         deriving (Eq, Ord, Read)

fullPath :: URI -> String
fullPath URI{path=Path p} = intercalate "/" $ map uriEncode p

fullURI :: URI -> String
fullURI u@(URI{account=a, revision=r, parameters=pp}) =
  concat $ ["FCMTP://", s . fullAccount $ a, fullPath u] ++ (
    case r of
      Nothing -> []
      Just (Revision r') -> [":", r']
    ) ++ (
    if null pp
    then []
    else ["?", intercalate "&" $ map formatParameter pp]
    )
  where
    formatParameter (Parameter nm vl) = concat [uriEncode nm, "=", uriEncode vl]

uriEncode :: String -> String
uriEncode = N.escapeURIString N.isUnescapedInURIComponent
    
instance Show URI where
  show = fullURI

getParameter :: String -> URI -> Maybe String
getParameter p u = case map (\(Parameter _ vl) -> vl) .
                        filter (\(Parameter nm _) -> nm == p) $
                        parameters u of
                     [] -> Nothing
                     (v:_) -> Just v

getSeal :: URI -> Maybe Seal.Seal
getSeal u = do
  se <- getParameter "seal" u
  eitherToMaybe . A.parseOnly Seal.parseURISeal . T.pack $ se
  where
    eitherToMaybe (Left _) = Nothing
    eitherToMaybe (Right v) = Just v