{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE OverloadedLists #-}

-- 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 Wire.API.User.Handle
  ( UserHandleInfo (..),
    CheckHandles (..),
  )
where

import Control.Applicative
import Data.Aeson (FromJSON (..), ToJSON (..))
import Data.Aeson qualified as A
import Data.Id (UserId)
import Data.OpenApi qualified as S
import Data.Qualified (Qualified (..), deprecatedSchema)
import Data.Range
import Data.Schema
import Imports
import Wire.Arbitrary (Arbitrary, GenericUniform (..))

--------------------------------------------------------------------------------
-- UserHandleInfo

newtype UserHandleInfo = UserHandleInfo {UserHandleInfo -> Qualified UserId
userHandleId :: Qualified UserId}
  deriving stock (UserHandleInfo -> UserHandleInfo -> Bool
(UserHandleInfo -> UserHandleInfo -> Bool)
-> (UserHandleInfo -> UserHandleInfo -> Bool) -> Eq UserHandleInfo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: UserHandleInfo -> UserHandleInfo -> Bool
== :: UserHandleInfo -> UserHandleInfo -> Bool
$c/= :: UserHandleInfo -> UserHandleInfo -> Bool
/= :: UserHandleInfo -> UserHandleInfo -> Bool
Eq, Int -> UserHandleInfo -> ShowS
[UserHandleInfo] -> ShowS
UserHandleInfo -> String
(Int -> UserHandleInfo -> ShowS)
-> (UserHandleInfo -> String)
-> ([UserHandleInfo] -> ShowS)
-> Show UserHandleInfo
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> UserHandleInfo -> ShowS
showsPrec :: Int -> UserHandleInfo -> ShowS
$cshow :: UserHandleInfo -> String
show :: UserHandleInfo -> String
$cshowList :: [UserHandleInfo] -> ShowS
showList :: [UserHandleInfo] -> ShowS
Show, (forall x. UserHandleInfo -> Rep UserHandleInfo x)
-> (forall x. Rep UserHandleInfo x -> UserHandleInfo)
-> Generic UserHandleInfo
forall x. Rep UserHandleInfo x -> UserHandleInfo
forall x. UserHandleInfo -> Rep UserHandleInfo x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. UserHandleInfo -> Rep UserHandleInfo x
from :: forall x. UserHandleInfo -> Rep UserHandleInfo x
$cto :: forall x. Rep UserHandleInfo x -> UserHandleInfo
to :: forall x. Rep UserHandleInfo x -> UserHandleInfo
Generic)
  deriving newtype (Gen UserHandleInfo
Gen UserHandleInfo
-> (UserHandleInfo -> [UserHandleInfo]) -> Arbitrary UserHandleInfo
UserHandleInfo -> [UserHandleInfo]
forall a. Gen a -> (a -> [a]) -> Arbitrary a
$carbitrary :: Gen UserHandleInfo
arbitrary :: Gen UserHandleInfo
$cshrink :: UserHandleInfo -> [UserHandleInfo]
shrink :: UserHandleInfo -> [UserHandleInfo]
Arbitrary)
  deriving (Value -> Parser [UserHandleInfo]
Value -> Parser UserHandleInfo
(Value -> Parser UserHandleInfo)
-> (Value -> Parser [UserHandleInfo]) -> FromJSON UserHandleInfo
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser UserHandleInfo
parseJSON :: Value -> Parser UserHandleInfo
$cparseJSONList :: Value -> Parser [UserHandleInfo]
parseJSONList :: Value -> Parser [UserHandleInfo]
FromJSON, [UserHandleInfo] -> Value
[UserHandleInfo] -> Encoding
UserHandleInfo -> Value
UserHandleInfo -> Encoding
(UserHandleInfo -> Value)
-> (UserHandleInfo -> Encoding)
-> ([UserHandleInfo] -> Value)
-> ([UserHandleInfo] -> Encoding)
-> ToJSON UserHandleInfo
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: UserHandleInfo -> Value
toJSON :: UserHandleInfo -> Value
$ctoEncoding :: UserHandleInfo -> Encoding
toEncoding :: UserHandleInfo -> Encoding
$ctoJSONList :: [UserHandleInfo] -> Value
toJSONList :: [UserHandleInfo] -> Value
$ctoEncodingList :: [UserHandleInfo] -> Encoding
toEncodingList :: [UserHandleInfo] -> Encoding
ToJSON, Typeable UserHandleInfo
Typeable UserHandleInfo =>
(Proxy UserHandleInfo -> Declare (Definitions Schema) NamedSchema)
-> ToSchema UserHandleInfo
Proxy UserHandleInfo -> Declare (Definitions Schema) NamedSchema
forall a.
Typeable a =>
(Proxy a -> Declare (Definitions Schema) NamedSchema) -> ToSchema a
$cdeclareNamedSchema :: Proxy UserHandleInfo -> Declare (Definitions Schema) NamedSchema
declareNamedSchema :: Proxy UserHandleInfo -> Declare (Definitions Schema) NamedSchema
S.ToSchema) via Schema UserHandleInfo

instance ToSchema UserHandleInfo where
  schema :: ValueSchema NamedSwaggerDoc UserHandleInfo
schema =
    Text
-> SchemaP SwaggerDoc Object [Pair] UserHandleInfo UserHandleInfo
-> ValueSchema NamedSwaggerDoc UserHandleInfo
forall doc doc' a b.
HasObject doc doc' =>
Text
-> SchemaP doc Object [Pair] a b -> SchemaP doc' Value Value a b
object Text
"UserHandleInfo" (SchemaP SwaggerDoc Object [Pair] UserHandleInfo UserHandleInfo
 -> ValueSchema NamedSwaggerDoc UserHandleInfo)
-> SchemaP SwaggerDoc Object [Pair] UserHandleInfo UserHandleInfo
-> ValueSchema NamedSwaggerDoc UserHandleInfo
forall a b. (a -> b) -> a -> b
$
      Qualified UserId -> UserHandleInfo
UserHandleInfo
        (Qualified UserId -> UserHandleInfo)
-> SchemaP
     SwaggerDoc Object [Pair] UserHandleInfo (Qualified UserId)
-> SchemaP SwaggerDoc Object [Pair] UserHandleInfo UserHandleInfo
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> UserHandleInfo -> Qualified UserId
userHandleId (UserHandleInfo -> Qualified UserId)
-> SchemaP
     SwaggerDoc Object [Pair] (Qualified UserId) (Qualified UserId)
-> SchemaP
     SwaggerDoc Object [Pair] UserHandleInfo (Qualified UserId)
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= Text
-> SchemaP
     NamedSwaggerDoc Value Value (Qualified UserId) (Qualified UserId)
-> SchemaP
     SwaggerDoc Object [Pair] (Qualified UserId) (Qualified UserId)
forall doc' doc a b.
HasField doc' doc =>
Text
-> SchemaP doc' Value Value a b -> SchemaP doc Object [Pair] a b
field Text
"qualified_user" SchemaP
  NamedSwaggerDoc Value Value (Qualified UserId) (Qualified UserId)
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema
        SchemaP SwaggerDoc Object [Pair] UserHandleInfo UserHandleInfo
-> SchemaP SwaggerDoc Object [Pair] UserHandleInfo (Maybe UserId)
-> SchemaP SwaggerDoc Object [Pair] UserHandleInfo UserHandleInfo
forall a b.
SchemaP SwaggerDoc Object [Pair] UserHandleInfo a
-> SchemaP SwaggerDoc Object [Pair] UserHandleInfo b
-> SchemaP SwaggerDoc Object [Pair] UserHandleInfo a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* (Qualified UserId -> UserId
forall a. Qualified a -> a
qUnqualified (Qualified UserId -> UserId)
-> (UserHandleInfo -> Qualified UserId) -> UserHandleInfo -> UserId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UserHandleInfo -> Qualified UserId
userHandleId)
          (UserHandleInfo -> UserId)
-> SchemaP SwaggerDoc Object [Pair] UserId (Maybe UserId)
-> SchemaP SwaggerDoc Object [Pair] UserHandleInfo (Maybe UserId)
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= SchemaP SwaggerDoc Object [Pair] UserId UserId
-> SchemaP SwaggerDoc Object [Pair] UserId (Maybe UserId)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Text
-> SchemaP NamedSwaggerDoc Value Value UserId UserId
-> SchemaP SwaggerDoc Object [Pair] UserId UserId
forall doc' doc a b.
HasField doc' doc =>
Text
-> SchemaP doc' Value Value a b -> SchemaP doc Object [Pair] a b
field Text
"user" (Text
-> SchemaP NamedSwaggerDoc Value Value UserId UserId
-> SchemaP NamedSwaggerDoc Value Value UserId UserId
forall doc a.
(HasDeprecated doc (Maybe Bool),
 HasDescription doc (Maybe Text)) =>
Text -> ValueSchema doc a -> ValueSchema doc a
deprecatedSchema Text
"qualified_user" SchemaP NamedSwaggerDoc Value Value UserId UserId
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema))

--------------------------------------------------------------------------------
-- CheckHandles

-- | Check the availability of user handles.
data CheckHandles = CheckHandles
  { -- | Handles to check for availability, in ascending order of preference.
    CheckHandles -> Range 1 50 [Text]
checkHandlesList :: Range 1 50 [Text],
    -- | Number of free handles to return. Default 1.
    CheckHandles -> Range 1 10 Word
checkHandlesNum :: Range 1 10 Word
  }
  deriving stock (CheckHandles -> CheckHandles -> Bool
(CheckHandles -> CheckHandles -> Bool)
-> (CheckHandles -> CheckHandles -> Bool) -> Eq CheckHandles
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CheckHandles -> CheckHandles -> Bool
== :: CheckHandles -> CheckHandles -> Bool
$c/= :: CheckHandles -> CheckHandles -> Bool
/= :: CheckHandles -> CheckHandles -> Bool
Eq, Int -> CheckHandles -> ShowS
[CheckHandles] -> ShowS
CheckHandles -> String
(Int -> CheckHandles -> ShowS)
-> (CheckHandles -> String)
-> ([CheckHandles] -> ShowS)
-> Show CheckHandles
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CheckHandles -> ShowS
showsPrec :: Int -> CheckHandles -> ShowS
$cshow :: CheckHandles -> String
show :: CheckHandles -> String
$cshowList :: [CheckHandles] -> ShowS
showList :: [CheckHandles] -> ShowS
Show, (forall x. CheckHandles -> Rep CheckHandles x)
-> (forall x. Rep CheckHandles x -> CheckHandles)
-> Generic CheckHandles
forall x. Rep CheckHandles x -> CheckHandles
forall x. CheckHandles -> Rep CheckHandles x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. CheckHandles -> Rep CheckHandles x
from :: forall x. CheckHandles -> Rep CheckHandles x
$cto :: forall x. Rep CheckHandles x -> CheckHandles
to :: forall x. Rep CheckHandles x -> CheckHandles
Generic)
  deriving (Gen CheckHandles
Gen CheckHandles
-> (CheckHandles -> [CheckHandles]) -> Arbitrary CheckHandles
CheckHandles -> [CheckHandles]
forall a. Gen a -> (a -> [a]) -> Arbitrary a
$carbitrary :: Gen CheckHandles
arbitrary :: Gen CheckHandles
$cshrink :: CheckHandles -> [CheckHandles]
shrink :: CheckHandles -> [CheckHandles]
Arbitrary) via (GenericUniform CheckHandles)
  deriving (Typeable CheckHandles
Typeable CheckHandles =>
(Proxy CheckHandles -> Declare (Definitions Schema) NamedSchema)
-> ToSchema CheckHandles
Proxy CheckHandles -> Declare (Definitions Schema) NamedSchema
forall a.
Typeable a =>
(Proxy a -> Declare (Definitions Schema) NamedSchema) -> ToSchema a
$cdeclareNamedSchema :: Proxy CheckHandles -> Declare (Definitions Schema) NamedSchema
declareNamedSchema :: Proxy CheckHandles -> Declare (Definitions Schema) NamedSchema
S.ToSchema) via Schema CheckHandles

instance ToJSON CheckHandles where
  toJSON :: CheckHandles -> Value
toJSON (CheckHandles Range 1 50 [Text]
l Range 1 10 Word
n) =
    [Pair] -> Value
A.object
      [ Key
"handles" Key -> Range 1 50 [Text] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
A..= Range 1 50 [Text]
l,
        Key
"return" Key -> Range 1 10 Word -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
A..= Range 1 10 Word
n
      ]

instance FromJSON CheckHandles where
  parseJSON :: Value -> Parser CheckHandles
parseJSON = String
-> (Object -> Parser CheckHandles) -> Value -> Parser CheckHandles
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"CheckHandles" ((Object -> Parser CheckHandles) -> Value -> Parser CheckHandles)
-> (Object -> Parser CheckHandles) -> Value -> Parser CheckHandles
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Range 1 50 [Text] -> Range 1 10 Word -> CheckHandles
CheckHandles
      (Range 1 50 [Text] -> Range 1 10 Word -> CheckHandles)
-> Parser (Range 1 50 [Text])
-> Parser (Range 1 10 Word -> CheckHandles)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser (Range 1 50 [Text])
forall a. FromJSON a => Object -> Key -> Parser a
A..: Key
"handles"
      Parser (Range 1 10 Word -> CheckHandles)
-> Parser (Range 1 10 Word) -> Parser CheckHandles
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser (Maybe (Range 1 10 Word))
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
A..:? Key
"return" Parser (Maybe (Range 1 10 Word))
-> Range 1 10 Word -> Parser (Range 1 10 Word)
forall a. Parser (Maybe a) -> a -> Parser a
A..!= Word -> Range 1 10 Word
forall a (n :: Nat) (m :: Nat).
(Show a, KnownNat n, KnownNat m, Within a n m) =>
a -> Range n m a
unsafeRange Word
1

instance ToSchema CheckHandles where
  schema :: ValueSchema NamedSwaggerDoc CheckHandles
schema =
    Text
-> SchemaP SwaggerDoc Object [Pair] CheckHandles CheckHandles
-> ValueSchema NamedSwaggerDoc CheckHandles
forall doc doc' a b.
HasObject doc doc' =>
Text
-> SchemaP doc Object [Pair] a b -> SchemaP doc' Value Value a b
object Text
"CheckHandles" (SchemaP SwaggerDoc Object [Pair] CheckHandles CheckHandles
 -> ValueSchema NamedSwaggerDoc CheckHandles)
-> SchemaP SwaggerDoc Object [Pair] CheckHandles CheckHandles
-> ValueSchema NamedSwaggerDoc CheckHandles
forall a b. (a -> b) -> a -> b
$
      Range 1 50 [Text] -> Range 1 10 Word -> CheckHandles
CheckHandles
        (Range 1 50 [Text] -> Range 1 10 Word -> CheckHandles)
-> SchemaP
     SwaggerDoc Object [Pair] CheckHandles (Range 1 50 [Text])
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     CheckHandles
     (Range 1 10 Word -> CheckHandles)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CheckHandles -> Range 1 50 [Text]
checkHandlesList (CheckHandles -> Range 1 50 [Text])
-> SchemaP
     SwaggerDoc Object [Pair] (Range 1 50 [Text]) (Range 1 50 [Text])
-> SchemaP
     SwaggerDoc Object [Pair] CheckHandles (Range 1 50 [Text])
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= Text
-> SchemaP
     SwaggerDoc Value Value (Range 1 50 [Text]) (Range 1 50 [Text])
-> SchemaP
     SwaggerDoc Object [Pair] (Range 1 50 [Text]) (Range 1 50 [Text])
forall doc' doc a b.
HasField doc' doc =>
Text
-> SchemaP doc' Value Value a b -> SchemaP doc Object [Pair] a b
field Text
"handles" (Range 1 50 [Text] -> [Text]
forall (n :: Nat) (m :: Nat) a. Range n m a -> a
fromRange (Range 1 50 [Text] -> [Text])
-> SchemaP SwaggerDoc Value Value [Text] (Range 1 50 [Text])
-> SchemaP
     SwaggerDoc Value Value (Range 1 50 [Text]) (Range 1 50 [Text])
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= SchemaP SwaggerDoc Value Value [Text] [Text]
-> SchemaP SwaggerDoc Value Value [Text] (Range 1 50 [Text])
forall (n :: Nat) (m :: Nat) d v w a b.
(KnownNat n, KnownNat m, Within a n m,
 HasRangedSchemaDocModifier d b) =>
SchemaP d v w a b -> SchemaP d v w a (Range n m b)
rangedSchema (ValueSchema NamedSwaggerDoc Text
-> SchemaP SwaggerDoc Value Value [Text] [Text]
forall ndoc doc a.
(HasArray ndoc doc, HasName ndoc) =>
ValueSchema ndoc a -> ValueSchema doc [a]
array ValueSchema NamedSwaggerDoc Text
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema))
        SchemaP
  SwaggerDoc
  Object
  [Pair]
  CheckHandles
  (Range 1 10 Word -> CheckHandles)
-> SchemaP SwaggerDoc Object [Pair] CheckHandles (Range 1 10 Word)
-> SchemaP SwaggerDoc Object [Pair] CheckHandles CheckHandles
forall a b.
SchemaP SwaggerDoc Object [Pair] CheckHandles (a -> b)
-> SchemaP SwaggerDoc Object [Pair] CheckHandles a
-> SchemaP SwaggerDoc Object [Pair] CheckHandles b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> CheckHandles -> Range 1 10 Word
checkHandlesNum (CheckHandles -> Range 1 10 Word)
-> SchemaP
     SwaggerDoc Object [Pair] (Range 1 10 Word) (Range 1 10 Word)
-> SchemaP SwaggerDoc Object [Pair] CheckHandles (Range 1 10 Word)
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= Text
-> SchemaP
     NamedSwaggerDoc Value Value (Range 1 10 Word) (Range 1 10 Word)
-> SchemaP
     SwaggerDoc Object [Pair] (Range 1 10 Word) (Range 1 10 Word)
forall doc' doc a b.
HasField doc' doc =>
Text
-> SchemaP doc' Value Value a b -> SchemaP doc Object [Pair] a b
field Text
"return" SchemaP
  NamedSwaggerDoc Value Value (Range 1 10 Word) (Range 1 10 Word)
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema