-- This file is part of the Wire Server implementation.
--
-- Copyright (C) 2020 Wire Swiss GmbH <opensource@wire.com>
--
-- This program is free software: you can redistribute it and/or modify it under
-- the terms of the GNU Affero General Public License as published by the Free
-- Software Foundation, either version 3 of the License, or (at your option) any
-- later version.
--
-- This program is distributed in the hope that it will be useful, but WITHOUT
-- ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
-- FOR A PARTICULAR PURPOSE. See the GNU Affero General Public License for more
-- details.
--
-- You should have received a copy of the GNU Affero General Public License along
-- with this program. If not, see <https://www.gnu.org/licenses/>.

module Web.Scim.Schema.User.Email where

import Data.Aeson
import Data.Text hiding (dropWhile)
import Data.Text.Encoding (decodeUtf8, encodeUtf8)
import GHC.Generics (Generic)
import Text.Email.Validate
import Web.Scim.Schema.Common

newtype EmailAddress2 = EmailAddress2
  {EmailAddress2 -> EmailAddress
unEmailAddress :: EmailAddress}
  deriving (Int -> EmailAddress2 -> ShowS
[EmailAddress2] -> ShowS
EmailAddress2 -> String
(Int -> EmailAddress2 -> ShowS)
-> (EmailAddress2 -> String)
-> ([EmailAddress2] -> ShowS)
-> Show EmailAddress2
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [EmailAddress2] -> ShowS
$cshowList :: [EmailAddress2] -> ShowS
show :: EmailAddress2 -> String
$cshow :: EmailAddress2 -> String
showsPrec :: Int -> EmailAddress2 -> ShowS
$cshowsPrec :: Int -> EmailAddress2 -> ShowS
Show, EmailAddress2 -> EmailAddress2 -> Bool
(EmailAddress2 -> EmailAddress2 -> Bool)
-> (EmailAddress2 -> EmailAddress2 -> Bool) -> Eq EmailAddress2
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: EmailAddress2 -> EmailAddress2 -> Bool
$c/= :: EmailAddress2 -> EmailAddress2 -> Bool
== :: EmailAddress2 -> EmailAddress2 -> Bool
$c== :: EmailAddress2 -> EmailAddress2 -> Bool
Eq)

instance FromJSON EmailAddress2 where
  parseJSON :: Value -> Parser EmailAddress2
parseJSON = String
-> (Text -> Parser EmailAddress2) -> Value -> Parser EmailAddress2
forall a. String -> (Text -> Parser a) -> Value -> Parser a
withText String
"Email" ((Text -> Parser EmailAddress2) -> Value -> Parser EmailAddress2)
-> (Text -> Parser EmailAddress2) -> Value -> Parser EmailAddress2
forall a b. (a -> b) -> a -> b
$ \Text
e -> case ByteString -> Maybe EmailAddress
emailAddress (Text -> ByteString
encodeUtf8 Text
e) of
    Maybe EmailAddress
Nothing -> String -> Parser EmailAddress2
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Invalid email"
    Just EmailAddress
some -> EmailAddress2 -> Parser EmailAddress2
forall (f :: * -> *) a. Applicative f => a -> f a
pure (EmailAddress2 -> Parser EmailAddress2)
-> EmailAddress2 -> Parser EmailAddress2
forall a b. (a -> b) -> a -> b
$ EmailAddress -> EmailAddress2
EmailAddress2 EmailAddress
some

instance ToJSON EmailAddress2 where
  toJSON :: EmailAddress2 -> Value
toJSON (EmailAddress2 EmailAddress
e) = Text -> Value
String (Text -> Value) -> Text -> Value
forall a b. (a -> b) -> a -> b
$ ByteString -> Text
decodeUtf8 (ByteString -> Text)
-> (EmailAddress -> ByteString) -> EmailAddress -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EmailAddress -> ByteString
toByteString (EmailAddress -> Text) -> EmailAddress -> Text
forall a b. (a -> b) -> a -> b
$ EmailAddress
e

data Email = Email
  { Email -> Maybe Text
typ :: Maybe Text,
    Email -> EmailAddress2
value :: EmailAddress2,
    Email -> Maybe ScimBool
primary :: Maybe ScimBool
  }
  deriving (Int -> Email -> ShowS
[Email] -> ShowS
Email -> String
(Int -> Email -> ShowS)
-> (Email -> String) -> ([Email] -> ShowS) -> Show Email
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Email] -> ShowS
$cshowList :: [Email] -> ShowS
show :: Email -> String
$cshow :: Email -> String
showsPrec :: Int -> Email -> ShowS
$cshowsPrec :: Int -> Email -> ShowS
Show, Email -> Email -> Bool
(Email -> Email -> Bool) -> (Email -> Email -> Bool) -> Eq Email
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Email -> Email -> Bool
$c/= :: Email -> Email -> Bool
== :: Email -> Email -> Bool
$c== :: Email -> Email -> Bool
Eq, (forall x. Email -> Rep Email x)
-> (forall x. Rep Email x -> Email) -> Generic Email
forall x. Rep Email x -> Email
forall x. Email -> Rep Email x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Email x -> Email
$cfrom :: forall x. Email -> Rep Email x
Generic)

instance FromJSON Email where
  parseJSON :: Value -> Parser Email
parseJSON = Options -> Value -> Parser Email
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON Options
parseOptions (Value -> Parser Email)
-> (Value -> Value) -> Value -> Parser Email
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> Value
jsonLower

instance ToJSON Email where
  toJSON :: Email -> Value
toJSON = Options -> Email -> Value
forall a.
(Generic a, GToJSON Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
serializeOptions