module Text.Email.Validate.Internal
( EmailAddress(unEmailAddress)
, EmailValidate.isValid
, EmailValidate.canonicalizeEmail
, emailAddress
, validate
, emailAddressFromText
, validateFromText
, unsafeEmailAddress
, localPart
, domainPart
, toByteString
, toText
) where
import Control.Monad ((<=<))
import Data.Aeson (FromJSON(..), ToJSON(..), Value(..), withText)
import Data.Aeson.Types (Parser)
import Data.Bifunctor (first)
import Data.ByteString (ByteString)
import Data.Data (Data)
import Data.Monoid ((<>))
import Data.Profunctor (lmap)
import Data.Profunctor.Product.Default (Default(def))
import Data.Proxy (Proxy(Proxy))
import Data.Text (Text, pack)
import Data.Text.Encoding (decodeUtf8With, encodeUtf8)
import Data.Text.Encoding.Error (lenientDecode)
import Database.Persist (PersistField(..), PersistValue)
import Database.Persist.Sql (PersistFieldSql(..), SqlType)
import Database.PostgreSQL.Simple.FromField
( Conversion, FieldParser, FromField(..), ResultError(..), returnError )
import Data.Typeable (Typeable)
import GHC.Generics (Generic)
import Opaleye
( Column, Constant(..), PGText, QueryRunnerColumn
, QueryRunnerColumnDefault(..) , fieldQueryRunnerColumn )
import qualified "email-validate" Text.Email.Validate as EmailValidate
newtype EmailAddress = EmailAddress
{ unEmailAddress :: EmailValidate.EmailAddress }
deriving (Data, Eq, Generic, Ord, Typeable)
instance Show EmailAddress where
show :: EmailAddress -> String
show = show . unEmailAddress
instance QueryRunnerColumnDefault PGText EmailAddress where
queryRunnerColumnDefault :: QueryRunnerColumn PGText EmailAddress
queryRunnerColumnDefault = fieldQueryRunnerColumn
instance FromField EmailAddress where
fromField :: FieldParser EmailAddress
fromField field Nothing = returnError UnexpectedNull field ""
fromField field (Just email) = maybe err return $ emailAddress email
where
err :: Conversion EmailAddress
err = returnError ConversionFailed field $
"Could not convert " <> show email <> " to email address"
instance Default Constant EmailAddress (Column PGText) where
def :: Constant EmailAddress (Column PGText)
def = lmap (decodeUtf8With lenientDecode . toByteString) def
instance FromJSON EmailAddress where
parseJSON :: Value -> Parser EmailAddress
parseJSON = withText "EmailAddress" $ \t ->
case validate $ encodeUtf8 t of
Left err -> fail $ "Failed to parse email address: " <> err
Right email -> return email
instance ToJSON EmailAddress where
toJSON :: EmailAddress -> Value
toJSON = String . decodeUtf8With lenientDecode . toByteString
instance PersistField EmailAddress where
toPersistValue :: EmailAddress -> PersistValue
toPersistValue = toPersistValue . toText
fromPersistValue :: PersistValue -> Either Text EmailAddress
fromPersistValue = first pack . validateFromText <=< fromPersistValue
instance PersistFieldSql EmailAddress where
sqlType :: Proxy EmailAddress -> SqlType
sqlType _ = sqlType (Proxy :: Proxy Text)
validate :: ByteString -> Either String EmailAddress
validate = fmap EmailAddress . EmailValidate.validate
emailAddress :: ByteString -> Maybe EmailAddress
emailAddress = fmap EmailAddress . EmailValidate.emailAddress
validateFromText :: Text -> Either String EmailAddress
validateFromText = validate . encodeUtf8
emailAddressFromText :: Text -> Maybe EmailAddress
emailAddressFromText = emailAddress . encodeUtf8
unsafeEmailAddress
:: ByteString
-> ByteString
-> EmailAddress
unsafeEmailAddress = (EmailAddress .) . EmailValidate.unsafeEmailAddress
localPart :: EmailAddress -> ByteString
localPart = EmailValidate.localPart . unEmailAddress
domainPart :: EmailAddress -> ByteString
domainPart = EmailValidate.domainPart . unEmailAddress
toByteString :: EmailAddress -> ByteString
toByteString = EmailValidate.toByteString . unEmailAddress
toText :: EmailAddress -> Text
toText = decodeUtf8With lenientDecode . toByteString