Bugfixes on seal and CP resolution

src/Data/SMTP/Crypto/Types/CP.hs

@@ -25,7 +25,7 @@ instance Read.Read Algo where
   
 -- | Public capabilities data
 data PCP = PCPSha3_512Ed25519 ByteString Ed25519.PublicKey
-         | PAll
+         | PAll deriving (Show)
 
 -- | The fCMTP CP revocation header: "CP-Revoked"
 revocationHeader :: String
@@ -58,9 +58,9 @@ sFromHeaders hh = let
     if pbc then Just PAll
     else do
       algo <- Resc.getReadHeader shh algoHeader
-      sh' <- Resc.getBase64Header shh sharedKeyHeader
+      sh' <- Resc.getBase64urlHeader shh sharedKeyHeader
       sh <- maybeCryptoError . Ed25519.publicKey $ sh'
-      cid <- Resc.getBase64Header shh idHeader
+      cid <- Resc.getBase64urlHeader shh idHeader
       case algo of
         Sha3_512Ed25519 -> pure $ PCPSha3_512Ed25519 cid sh
 

src/Data/SMTP/Parser/Mime.hs

@@ -31,7 +31,7 @@ parseContentType = do
     endType c = C.isSpace c || c == ';'
     parseMultipart :: Parser ContentType
     parseMultipart = (
-      stringCI "vnd.dFCMTP.Digest" *>
+      stringCI "vnd.fCMTP.Digest" *>
       (return . MultiPartMime $ FcmtpDigest)
       ) <|> (do
                 tp <- takeTill endType
@@ -40,7 +40,7 @@ parseContentType = do
     parseMessage :: Parser ContentType
     parseMessage = (
       do
-        stringCI "vnd.dFCMTP.Resource"
+        stringCI "vnd.fCMTP.Resource"
         return . MessageMime $ FcmtpResource
       ) <|> (
       do

src/Data/SMTP/Types/Resource.hs

@@ -9,7 +9,8 @@ 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 Data.ByteString.Base64 as Base64
+import qualified Data.ByteString.Base64.URL as Base64url
 import qualified Text.StringConvert as SC
 import Text.Read (readMaybe)
 
@@ -41,7 +42,7 @@ 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
+hasKey k h = map C.toLower k == (map C.toLower $ key h)
 
 -- | Retrieves a single header with the given key
 getHeader :: [Header] -> String -> Maybe Header
@@ -67,6 +68,12 @@ getBase64Header hh s = getHeaderValue hh s >>= (rightToJust . Base64.decode . SC
   where
     rightToJust = either (\_ -> Nothing) Just
 
+-- | Retrieves the binary value of a base64url encoded header
+getBase64urlHeader :: [Header] -> String -> Maybe BS.ByteString
+getBase64urlHeader hh s = getHeaderValue hh s >>= (rightToJust . Base64url.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
@@ -93,11 +100,11 @@ addressHeader = "fCMTP-Address"
 
 -- | Retrieves the meta information from resource headers
 resourceInfo :: PlainHeaders -> ResourceInfo
-resourceInfo (PlainHeaders _ ss _) = let
+resourceInfo (PlainHeaders pp 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
+  uu = catMaybes . map (bparse URI.parseURI) $ getMultipleValue pp addressHeader
   in ResourceInfo mimet mimep curr bb uu
   where
     bparse :: BA.Parser a -> String -> Maybe a

src/Data/SMTP/Types/URI.hs

@@ -59,7 +59,10 @@ getParameter p u = case map (\(Parameter _ vl) -> vl) .
 getSeal :: URI -> Maybe Seal.Seal
 getSeal u = do
   bare <- getParameter Seal.sealURIParam u
-  A.maybeResult . A.parse Seal.parseURISeal $ SC.s bare
+  right2Just . A.parseOnly Seal.parseURISeal $ SC.s bare
+  where
+    right2Just (Left _) = Nothing
+    right2Just (Right v) = Just v
 
 -- | Return revision string or a default value
 fromRevision :: String -> Revision -> String