ResourceInfo parsing

src/Data/SMTP/Parser/Address.hs

@@ -2,68 +2,25 @@
 
 module Data.SMTP.Parser.Address (
   parseAddress,
+  renderHeaderAddress,
   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 ((<|>))
 import qualified Text.StringConvert as SC
 
 parseAddress :: Parser Address
-parseAddress = ((\x -> URIAdd x Nothing) <$> URI.parseURI) <|>
-               ((\x -> AccountAdd x Nothing) <$> parseAccount)
+parseAddress = Address <$> URI.parseURI
+
+renderHeaderAddress :: Address -> ByteString
+renderHeaderAddress a = SC.s . show $ a
 
 renderMetadataAddress :: Address -> ByteString
-renderMetadataAddress add =
-  BS.intercalate "; " $ (SC.s . asToURI $ add) : case seal add 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]
+renderMetadataAddress = renderHeaderAddress
 
 parseMetadataAddress :: Parser Address
-parseMetadataAddress = do
-  a <- parseAddress
-  (cp, nonce, code) <- parserFold addrParams (Nothing, Nothing, Nothing)
-  let r = do
-        cp' <- cp
-        code' <- code
-        return . setSeal a . 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
-
+parseMetadataAddress = parseAddress

src/Data/SMTP/Revision.hs

@@ -1,6 +0,0 @@
-module Data.SMTP.Revision (
-  module Data.SMTP.Types.Revision
-  ) where
-
-import Data.SMTP.Types.Revision
-

src/Data/SMTP/Types/Address.hs

@@ -5,31 +5,29 @@ module Data.SMTP.Types.Address where
 import qualified Data.SMTP.Account as Ac
 import qualified Data.SMTP.URI as URI
 import qualified Data.SMTP.Seal as Seal
+import qualified Data.Text as T
+import qualified Data.Attoparsec.Text as A
 
 import Text.StringConvert
 
-data Address = AccountAdd Ac.Account (Maybe Seal.Seal)
-             | URIAdd URI.URI (Maybe Seal.Seal)
-             deriving (Show, Eq, Ord)
+data Address = Address URI.URI
+             deriving (Eq, Ord)
+instance Show Address where
+  show (Address u) = show u
 
-asToURI :: Address -> String
-asToURI (AccountAdd a _) = concat ["<", s . Ac.normalize $ a, ">"]
-asToURI (URIAdd u _) = URI.fullURI u
+headerName :: String
+headerName = "fCMTP-Address"
 
-hostFrom :: Address -> Ac.HostName
-hostFrom = Ac.domain . account
-
-fromAccount :: Ac.Account -> Address
-fromAccount a = AccountAdd a Nothing
+host :: Address -> Ac.HostName
+host = Ac.domain . account
 
 account :: Address -> Ac.Account
-account (AccountAdd a _) = a
-account (URIAdd u _) = URI.account u
-
-seal :: Address -> Maybe Seal.Seal
-seal (AccountAdd _ se) = se
-seal (URIAdd _ se) = se
-
-setSeal :: Address -> Maybe Seal.Seal -> Address
-setSeal (AccountAdd a _) se = AccountAdd a se
-setSeal (URIAdd u _) se = URIAdd u se
+account (Address u) = URI.account u
+
+seal :: URI.URI -> Maybe Seal.Seal
+seal u = do
+  se <- URI.getParameter "seal" u
+  eitherToMaybe . A.parseOnly Seal.parseURISeal . T.pack $ se
+  where
+    eitherToMaybe (Left _) = Nothing
+    eitherToMaybe (Right v) = Just v

src/Data/SMTP/Types/Resource.hs

@@ -1,28 +1,24 @@
 module Data.SMTP.Types.Resource where
 
-import Data.SMTP.Types.Seal
-import Data.SMTP.Types.URI
---import Data.SMTP.Account (Account)
+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 System.IO.Uniform as UIO
 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 RevisionInfo = RevisionInfo {
-  current :: Revision,
-  bases :: [Revision]
-  } deriving (Eq, Ord, Read, Show)
-
-data Resource = Resource {
+data ResourceInfo = ResourceInfo {
   mimeType :: Mime.ContentType,
-  publicHeaders :: [Header],
-  seal :: Maybe Seal,
-  revision :: Maybe RevisionInfo,
-  bodyData :: ResourceData}
+  mimeParameters :: Mime.ContentTypeParameters,
+  revision :: URI.Revision,
+  bases :: [URI.Revision],
+  address :: [URI.URI]
+  } deriving (Eq, Ord, Show)
 
 type ResourceData = LBS.ByteString
 
@@ -44,13 +40,23 @@ getMultipleValue :: [Header] -> String -> [String]
 getMultipleValue hh = map (\(Header (_, v)) -> v) . getMultiple hh
 
 revisionHeader :: String
-revisionHeader = "FCMTP-Revision"
+revisionHeader = "fCMTP-Revision"
 
 baseHeader :: String
-baseHeader = "FCMTP-Revision-Base"
-
-headersRevision :: [Header] -> Maybe RevisionInfo
-headersRevision hh = do
-  curr <- Revision <$> getHeaderValue hh revisionHeader
-  let bb = map Revision $ getMultipleValue hh baseHeader
-  return $ RevisionInfo curr bb
+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

src/Data/SMTP/Types/Revision.hs

@@ -1,5 +0,0 @@
-module Data.SMTP.Types.Revisioning where
-
-import Data.SMTP.Resource
-
-

src/Data/SMTP/Types/URI.hs

@@ -3,9 +3,6 @@ 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
 
@@ -46,10 +43,3 @@ getParameter p u = case map (\(Parameter _ vl) -> vl) .
                      [] -> 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