fcmtp-data/src/Data/SMTP/Parser/Seal.hs

{-# LANGUAGE OverloadedStrings #-}

module Data.SMTP.Parser.Seal (
  parseURISeal
  ) where

import Data.SMTP.Types.Seal
-- import Data.SMTP.Types.Resource
import qualified Data.Attoparsec.Text as A
import qualified Data.ByteString.Base64 as B64
import Data.ByteString (ByteString)
import Text.StringConvert

parseURISeal :: A.Parser Seal
parseURISeal = do
  mycp <- base64
  A.string ":"
  mycode <- base64
  A.choice [
    do
      A.string ":"
      mynonce <- base64
      return . Seal mycp mycode $ Just mynonce,
    return $ Seal mycp mycode Nothing
    ]

base64 :: A.Parser ByteString
base64 = do
  e <- A.takeWhile isBase64Char
  case B64.decode . s . map replaceSlash . s $ e of
    Left r -> fail r
    Right r -> return r
  where
    replaceSlash '-' = '/'
    replaceSlash c = c
--      | c == W8._hyphen = W8._slash
--      | otherwise = c
    isBase64Char c
      | c >= '0' && c <= '9' = True
      | c >= 'a' && c <= 'z' = True
      | c >= 'A' && c <= 'Z' = True
      | c == '+' || c == '-' || c == '=' = True
      | otherwise = False

-- headersToSeal :: [Header] -> Maybe Seal
-- headersToSeal hh = let
--   mycp = decode2maybe =<< getH hh cpHeaderName
--   mynonce = decode2maybe =<< getH hh nonceHeaderName
--   mycode = decode2maybe =<< getH hh sealHeaderName
--   in do
--     cp' <- mycp
--     code' <- mycode
--     Just $ Seal cp' code' mynonce
--   where
--     getH :: [Header] -> String -> Maybe ByteString
--     getH hh' h = C8.pack <$> getHeaderValue hh' h
--     either2maybef :: (a -> Either b c) -> a -> Maybe c
--     either2maybef f v = either2maybe $ f v
--     either2maybe :: Either a b -> Maybe b
--     either2maybe (Left _) = Nothing
--     either2maybe (Right v) = Just v
--     decode2maybe = either2maybef B64.decode