ResourceInfo parsing

fcmtp-data.cabal

@@ -21,7 +21,6 @@ library
         word8 >= 0.1,
         data-default-class -any,
         utf8-string -any,
-        uniform-io >=1.1,
         tools-for-attoparsec,
         string-convert,
         memory,
@@ -55,7 +54,7 @@ library
         Data.SMTP.Parser.Account Data.SMTP.Types.Account
         Data.SMTP.Types.Mime Data.SMTP.Parser.Mime
         Data.SMTP.Types.Resource Data.SMTP.Parser.Resource
-        Data.SMTP.Types.Seal
+        Data.SMTP.Types.Seal, Data.SMTP.Parser.Seal,
         Data.SMTP.Types.Address Data.SMTP.Parser.Address
         Data.SMTP.Types.URI Data.SMTP.Parser.URI,
         Data.SMTP.Crypto.Types.CP, Data.SMTP.Crypto.Algos.CP

src/Data/SMTP/Parser/URI.hs

@@ -27,10 +27,11 @@ parseURI = do
       ac <- case A.parseOnly parseAccount (s $ au++ah) of
         Left e -> fail e
         Right ac -> return ac
-      let (p, r) = break (==':') . N.uriPath $ uri
+      let (p, r') = break (==':') . N.uriPath $ uri
           pp = splitOn "/" p
           qq = if null . N.uriQuery $ uri
                then []
                else map (\(x, y) -> (drop 1 x, drop 1 y)) . map (break (=='=')) . splitOn "&" . N.uriQuery $ uri
+          r = if null r' then NoRevision else Revision . drop 1 $ r'
       unless (null . N.uriPort $ auth) $ fail "fCMTP URIs must not determine a port"
-      return $ URI ac (Path pp) (Just . Revision . drop 1 $ r) (map (\(x, y) -> Parameter x y) qq)
+      return $ URI ac (Path pp) r (map (\(x, y) -> Parameter x y) qq)

src/Data/SMTP/Resource.hs

@@ -2,7 +2,7 @@
 
 module Data.SMTP.Resource (
   module Data.SMTP.Types.Resource,
-  takeHeaders
+  module Data.SMTP.Parser.Resource
   ) where
 
 import Data.SMTP.Types.Resource

src/Data/SMTP/Types/Resource.hs

@@ -8,6 +8,9 @@ import qualified Data.Attoparsec.ByteString as BA
 import qualified Data.ByteString.Lazy as LBS
 import qualified Text.StringConvert as SC
 
+import Data.Maybe
+import Data.Default.Class
+
 import Data.Char
 
 data Header = Header (String, String) deriving (Read, Show, Eq, Ord)
@@ -19,6 +22,8 @@ data ResourceInfo = ResourceInfo {
   bases :: [URI.Revision],
   address :: [URI.URI]
   } deriving (Eq, Ord, Show)
+instance Default ResourceInfo where
+  def = ResourceInfo def def URI.NoRevision [] []
 
 type ResourceData = LBS.ByteString
 
@@ -48,13 +53,13 @@ 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
+resourceInfo :: [Header] -> ResourceInfo
+resourceInfo hh = let
+  (mimet, mimep) = fromMaybe (def, def) $ getHeaderValue hh Mime.contentTypeHeaderName >>= bparse PMime.parseContentType
+  curr = fromMaybe URI.NoRevision $ URI.Revision <$> getHeaderValue hh revisionHeader
+  bb = map URI.Revision $ getMultipleValue hh baseHeader
+  uu = catMaybes . map (bparse URI.parseURI) $ getMultipleValue hh 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 

src/Data/SMTP/Types/URI.hs

@@ -7,10 +7,10 @@ import Data.List
 import Text.StringConvert
 
 newtype Path = Path [String] deriving (Eq, Ord, Read, Show)
-newtype Revision = Revision String deriving (Eq, Ord, Read, Show)
+data Revision = NoRevision | 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]} 
+data URI = URI {account :: Account, path :: Path, revision :: Revision, parameters :: [Parameter]} 
          deriving (Eq, Ord)
 
 fullPath :: URI -> String
@@ -20,8 +20,8 @@ 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']
+      NoRevision -> []
+      Revision r' -> [":", r']
     ) ++ (
     if null pp
     then []