module Wire.API.User.Phone
  ( Phone (..),
    parsePhone,
    isValidPhone,
  )
where

import Cassandra qualified as C
import Control.Applicative (optional)
import Control.Lens (over, (?~))
import Data.Aeson (FromJSON (..), ToJSON (..))
import Data.Attoparsec.Text
import Data.ByteString.Conversion
import Data.OpenApi (ToParamSchema (..))
import Data.OpenApi qualified as S
import Data.Schema
import Data.Text qualified as Text
import Data.Text.Encoding
import Data.Text.Encoding.Error
import Imports
import SAML2.WebSSO.Test.Arbitrary ()
import Servant
import Servant.API qualified as S
import Test.QuickCheck qualified as QC
import Web.Scim.Schema.User.Email ()
import Wire.Arbitrary (Arbitrary (arbitrary))

--------------------------------------------------------------------------------
-- Phone

newtype Phone = Phone {Phone -> Text
fromPhone :: Text}
  deriving stock (Phone -> Phone -> Bool
(Phone -> Phone -> Bool) -> (Phone -> Phone -> Bool) -> Eq Phone
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Phone -> Phone -> Bool
== :: Phone -> Phone -> Bool
$c/= :: Phone -> Phone -> Bool
/= :: Phone -> Phone -> Bool
Eq, Eq Phone
Eq Phone =>
(Phone -> Phone -> Ordering)
-> (Phone -> Phone -> Bool)
-> (Phone -> Phone -> Bool)
-> (Phone -> Phone -> Bool)
-> (Phone -> Phone -> Bool)
-> (Phone -> Phone -> Phone)
-> (Phone -> Phone -> Phone)
-> Ord Phone
Phone -> Phone -> Bool
Phone -> Phone -> Ordering
Phone -> Phone -> Phone
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Phone -> Phone -> Ordering
compare :: Phone -> Phone -> Ordering
$c< :: Phone -> Phone -> Bool
< :: Phone -> Phone -> Bool
$c<= :: Phone -> Phone -> Bool
<= :: Phone -> Phone -> Bool
$c> :: Phone -> Phone -> Bool
> :: Phone -> Phone -> Bool
$c>= :: Phone -> Phone -> Bool
>= :: Phone -> Phone -> Bool
$cmax :: Phone -> Phone -> Phone
max :: Phone -> Phone -> Phone
$cmin :: Phone -> Phone -> Phone
min :: Phone -> Phone -> Phone
Ord, Int -> Phone -> ShowS
[Phone] -> ShowS
Phone -> String
(Int -> Phone -> ShowS)
-> (Phone -> String) -> ([Phone] -> ShowS) -> Show Phone
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Phone -> ShowS
showsPrec :: Int -> Phone -> ShowS
$cshow :: Phone -> String
show :: Phone -> String
$cshowList :: [Phone] -> ShowS
showList :: [Phone] -> ShowS
Show, (forall x. Phone -> Rep Phone x)
-> (forall x. Rep Phone x -> Phone) -> Generic Phone
forall x. Rep Phone x -> Phone
forall x. Phone -> Rep Phone x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Phone -> Rep Phone x
from :: forall x. Phone -> Rep Phone x
$cto :: forall x. Rep Phone x -> Phone
to :: forall x. Rep Phone x -> Phone
Generic)
  deriving ([Phone] -> Value
[Phone] -> Encoding
Phone -> Value
Phone -> Encoding
(Phone -> Value)
-> (Phone -> Encoding)
-> ([Phone] -> Value)
-> ([Phone] -> Encoding)
-> ToJSON Phone
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: Phone -> Value
toJSON :: Phone -> Value
$ctoEncoding :: Phone -> Encoding
toEncoding :: Phone -> Encoding
$ctoJSONList :: [Phone] -> Value
toJSONList :: [Phone] -> Value
$ctoEncodingList :: [Phone] -> Encoding
toEncodingList :: [Phone] -> Encoding
ToJSON, Value -> Parser [Phone]
Value -> Parser Phone
(Value -> Parser Phone)
-> (Value -> Parser [Phone]) -> FromJSON Phone
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser Phone
parseJSON :: Value -> Parser Phone
$cparseJSONList :: Value -> Parser [Phone]
parseJSONList :: Value -> Parser [Phone]
FromJSON, Typeable Phone
Typeable Phone =>
(Proxy Phone -> Declare (Definitions Schema) NamedSchema)
-> ToSchema Phone
Proxy Phone -> Declare (Definitions Schema) NamedSchema
forall a.
Typeable a =>
(Proxy a -> Declare (Definitions Schema) NamedSchema) -> ToSchema a
$cdeclareNamedSchema :: Proxy Phone -> Declare (Definitions Schema) NamedSchema
declareNamedSchema :: Proxy Phone -> Declare (Definitions Schema) NamedSchema
S.ToSchema) via (Schema Phone)

instance ToParamSchema Phone where
  toParamSchema :: Proxy Phone -> Schema
toParamSchema Proxy Phone
_ = Proxy Text -> Schema
forall a. ToParamSchema a => Proxy a -> Schema
toParamSchema (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @Text)

instance ToSchema Phone where
  schema :: ValueSchema NamedSwaggerDoc Phone
schema =
    ASetter
  (ValueSchema NamedSwaggerDoc Phone)
  (ValueSchema NamedSwaggerDoc Phone)
  NamedSwaggerDoc
  NamedSwaggerDoc
-> (NamedSwaggerDoc -> NamedSwaggerDoc)
-> ValueSchema NamedSwaggerDoc Phone
-> ValueSchema NamedSwaggerDoc Phone
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter
  (ValueSchema NamedSwaggerDoc Phone)
  (ValueSchema NamedSwaggerDoc Phone)
  NamedSwaggerDoc
  NamedSwaggerDoc
forall a a' doc doc'. HasDoc a a' doc doc' => Lens a a' doc doc'
Lens
  (ValueSchema NamedSwaggerDoc Phone)
  (ValueSchema NamedSwaggerDoc Phone)
  NamedSwaggerDoc
  NamedSwaggerDoc
doc ((Maybe Text -> Identity (Maybe Text))
-> NamedSwaggerDoc -> Identity NamedSwaggerDoc
forall s a. HasDescription s a => Lens' s a
Lens' NamedSwaggerDoc (Maybe Text)
S.description ((Maybe Text -> Identity (Maybe Text))
 -> NamedSwaggerDoc -> Identity NamedSwaggerDoc)
-> Text -> NamedSwaggerDoc -> NamedSwaggerDoc
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Text
"E.164 phone number") (ValueSchema NamedSwaggerDoc Phone
 -> ValueSchema NamedSwaggerDoc Phone)
-> ValueSchema NamedSwaggerDoc Phone
-> ValueSchema NamedSwaggerDoc Phone
forall a b. (a -> b) -> a -> b
$
      Phone -> Text
fromPhone
        (Phone -> Text)
-> SchemaP NamedSwaggerDoc Value Value Text Phone
-> ValueSchema NamedSwaggerDoc Phone
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= Text
-> (Text -> Either String Phone)
-> SchemaP NamedSwaggerDoc Value Value Text Phone
forall a.
Text
-> (Text -> Either String a)
-> SchemaP NamedSwaggerDoc Value Value Text a
parsedText Text
"PhoneNumber" (Either String Phone
-> (Phone -> Either String Phone)
-> Maybe Phone
-> Either String Phone
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> Either String Phone
forall a b. a -> Either a b
Left String
"Invalid phone number. Expected E.164 format.") Phone -> Either String Phone
forall a b. b -> Either a b
Right (Maybe Phone -> Either String Phone)
-> (Text -> Maybe Phone) -> Text -> Either String Phone
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Maybe Phone
parsePhone)

instance ToByteString Phone where
  builder :: Phone -> Builder
builder = Text -> Builder
forall a. ToByteString a => a -> Builder
builder (Text -> Builder) -> (Phone -> Text) -> Phone -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Phone -> Text
fromPhone

instance FromByteString Phone where
  parser :: Parser Phone
parser = Parser Text
forall a. FromByteString a => Parser a
parser Parser Text -> (Text -> Parser Phone) -> Parser Phone
forall a b.
Parser ByteString a
-> (a -> Parser ByteString b) -> Parser ByteString b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Parser Phone
-> (Phone -> Parser Phone) -> Maybe Phone -> Parser Phone
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> Parser Phone
forall a. String -> Parser ByteString a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Invalid phone") Phone -> Parser Phone
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Phone -> Parser Phone)
-> (Text -> Maybe Phone) -> Text -> Parser Phone
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Maybe Phone
parsePhone

instance S.FromHttpApiData Phone where
  parseUrlPiece :: Text -> Either Text Phone
parseUrlPiece = Either Text Phone
-> (Phone -> Either Text Phone) -> Maybe Phone -> Either Text Phone
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Text -> Either Text Phone
forall a b. a -> Either a b
Left Text
"Invalid phone") Phone -> Either Text Phone
forall a b. b -> Either a b
Right (Maybe Phone -> Either Text Phone)
-> (Text -> Maybe Phone) -> Text -> Either Text Phone
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Maybe Phone
forall a. FromByteString a => ByteString -> Maybe a
fromByteString (ByteString -> Maybe Phone)
-> (Text -> ByteString) -> Text -> Maybe Phone
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
encodeUtf8

instance S.ToHttpApiData Phone where
  toUrlPiece :: Phone -> Text
toUrlPiece = OnDecodeError -> ByteString -> Text
decodeUtf8With OnDecodeError
lenientDecode (ByteString -> Text) -> (Phone -> ByteString) -> Phone -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Phone -> ByteString
forall a. ToByteString a => a -> ByteString
toByteString'

instance Arbitrary Phone where
  arbitrary :: Gen Phone
arbitrary =
    Text -> Phone
Phone (Text -> Phone) -> (String -> Text) -> String -> Phone
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
Text.pack (String -> Phone) -> Gen String -> Gen Phone
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> do
      let mkdigits :: Int -> Gen String
mkdigits Int
n = Int -> Gen Char -> Gen String
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
n (String -> Gen Char
forall a. [a] -> Gen a
QC.elements [Char
'0' .. Char
'9'])
      String
mini <- Int -> Gen String
mkdigits Int
8
      String
maxi <- Int -> Gen String
mkdigits (Int -> Gen String) -> Gen Int -> Gen String
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (Int, Int) -> Gen Int
QC.chooseInt (Int
0, Int
7)
      String -> Gen String
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (String -> Gen String) -> String -> Gen String
forall a b. (a -> b) -> a -> b
$ Char
'+' Char -> ShowS
forall a. a -> [a] -> [a]
: String
mini String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
maxi

deriving instance C.Cql Phone

-- | Parses a phone number in E.164 format with a mandatory leading '+'.
parsePhone :: Text -> Maybe Phone
parsePhone :: Text -> Maybe Phone
parsePhone Text
p
  | Text -> Bool
isValidPhone Text
p = Phone -> Maybe Phone
forall a. a -> Maybe a
Just (Phone -> Maybe Phone) -> Phone -> Maybe Phone
forall a b. (a -> b) -> a -> b
$! Text -> Phone
Phone Text
p
  | Bool
otherwise = Maybe Phone
forall a. Maybe a
Nothing

-- | Checks whether a phone number is valid, i.e. it is in E.164 format
-- with a mandatory leading '+' followed by 10-15 digits.
isValidPhone :: Text -> Bool
isValidPhone :: Text -> Bool
isValidPhone = (String -> Bool) -> (() -> Bool) -> Either String () -> Bool
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Bool -> String -> Bool
forall a b. a -> b -> a
const Bool
False) (Bool -> () -> Bool
forall a b. a -> b -> a
const Bool
True) (Either String () -> Bool)
-> (Text -> Either String ()) -> Text -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parser () -> Text -> Either String ()
forall a. Parser a -> Text -> Either String a
parseOnly Parser ()
e164
  where
    e164 :: Parser ()
e164 = Char -> Parser Char
char Char
'+' Parser Char -> Parser Text String -> Parser Text String
forall a b. Parser Text a -> Parser Text b -> Parser Text b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Int -> Parser Char -> Parser Text String
forall (m :: * -> *) a. Monad m => Int -> m a -> m [a]
count Int
8 Parser Char
digit Parser Text String
-> Parser Text [Maybe Char] -> Parser Text [Maybe Char]
forall a b. Parser Text a -> Parser Text b -> Parser Text b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Int -> Parser Text (Maybe Char) -> Parser Text [Maybe Char]
forall (m :: * -> *) a. Monad m => Int -> m a -> m [a]
count Int
7 (Parser Char -> Parser Text (Maybe Char)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional Parser Char
digit) Parser Text [Maybe Char] -> Parser () -> Parser ()
forall a b. Parser Text a -> Parser Text b -> Parser Text b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ()
forall t. Chunk t => Parser t ()
endOfInput