-- This file is part of the Wire Server implementation.
--
-- Copyright (C) 2022 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 Control.Applicative ((<|>))
import Data.Aeson
import Data.Text hiding (dropWhile)
import Data.Text.Encoding (decodeUtf8, encodeUtf8)
import GHC.Generics (Generic)
import qualified Text.Email.Validate as Email
import Web.Scim.Schema.Common hiding (value)

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

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

instance ToJSON EmailAddress where
  toJSON :: EmailAddress -> Value
toJSON (EmailAddress 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
Email.toByteString (EmailAddress -> Text) -> EmailAddress -> Text
forall a b. (a -> b) -> a -> b
$ EmailAddress
e

data Email = Email
  { Email -> Maybe Text
typ :: Maybe Text, -- Work, private, and so on
    Email -> EmailAddress
value :: EmailAddress,
    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
$cshowsPrec :: Int -> Email -> ShowS
showsPrec :: Int -> Email -> ShowS
$cshow :: Email -> String
show :: Email -> String
$cshowList :: [Email] -> ShowS
showList :: [Email] -> ShowS
Show, Email -> Email -> Bool
(Email -> Email -> Bool) -> (Email -> Email -> Bool) -> Eq Email
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Email -> Email -> Bool
== :: Email -> Email -> Bool
$c/= :: Email -> Email -> Bool
/= :: 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
$cfrom :: forall x. Email -> Rep Email x
from :: forall x. Email -> Rep Email x
$cto :: forall x. Rep Email x -> Email
to :: forall x. Rep Email x -> Email
Generic)

instance FromJSON Email where
  parseJSON :: Value -> Parser Email
parseJSON = ([Text] -> Parser Email)
-> (Value -> Parser Email) -> Either [Text] Value -> Parser Email
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (String -> Parser Email
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser Email)
-> ([Text] -> String) -> [Text] -> Parser Email
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> String
forall a. Show a => a -> String
show) (Options -> Value -> Parser Email
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON Options
parseOptions) (Either [Text] Value -> Parser Email)
-> (Value -> Either [Text] Value) -> Value -> Parser Email
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> Either [Text] Value
forall (m :: * -> *). (m ~ Either [Text]) => Value -> m 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

emailToEmailAddress :: Email -> Email.EmailAddress
emailToEmailAddress :: Email -> EmailAddress
emailToEmailAddress = EmailAddress -> EmailAddress
unEmailAddress (EmailAddress -> EmailAddress)
-> (Email -> EmailAddress) -> Email -> EmailAddress
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Email -> EmailAddress
value

scimEmailsToEmailAddress :: [Email] -> Maybe Email.EmailAddress
scimEmailsToEmailAddress :: [Email] -> Maybe EmailAddress
scimEmailsToEmailAddress [Email]
es = [Email] -> Maybe EmailAddress
pickPrimary [Email]
es Maybe EmailAddress -> Maybe EmailAddress -> Maybe EmailAddress
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> [Email] -> Maybe EmailAddress
pickFirst [Email]
es
  where
    pickFirst :: [Email] -> Maybe EmailAddress
pickFirst [] = Maybe EmailAddress
forall a. Maybe a
Nothing
    pickFirst (Email
e : [Email]
_) = EmailAddress -> Maybe EmailAddress
forall a. a -> Maybe a
Just (EmailAddress -> EmailAddress
unEmailAddress (Email -> EmailAddress
value Email
e))

    pickPrimary :: [Email] -> Maybe EmailAddress
pickPrimary = [Email] -> Maybe EmailAddress
pickFirst ([Email] -> Maybe EmailAddress)
-> ([Email] -> [Email]) -> [Email] -> Maybe EmailAddress
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Email -> Bool) -> [Email] -> [Email]
forall a. (a -> Bool) -> [a] -> [a]
Prelude.filter Email -> Bool
isPrimary

    isPrimary :: Email -> Bool
isPrimary Email
e = Email -> Maybe ScimBool
primary Email
e Maybe ScimBool -> Maybe ScimBool -> Bool
forall a. Eq a => a -> a -> Bool
== ScimBool -> Maybe ScimBool
forall a. a -> Maybe a
Just (Bool -> ScimBool
ScimBool Bool
True)