{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TemplateHaskell #-}

-- 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
  ( ListUsersById (..),
    UserIdList (..),
    UserIds (..),
    QualifiedUserIdList (..),
    qualifiedUserIdListObjectSchema,
    LimitedQualifiedUserIdList (..),
    ScimUserInfo (..),
    UserSet (..),
    -- Profiles
    UserProfile (..),
    SelfProfile (..),
    -- User (should not be here)
    User (..),
    isSamlUser,
    userId,
    userDeleted,
    userEmail,
    userSSOId,
    userIssuer,
    userSCIMExternalId,
    scimExternalId,
    ssoIssuerAndNameId,
    mkUserProfile,
    mkUserProfileWithEmail,
    userObjectSchema,

    -- * UpgradePersonalToTeam
    CreateUserTeam (..),
    UpgradePersonalToTeamResponses,
    UpgradePersonalToTeamError (..),

    -- * NewUser
    NewUserPublic (..),
    RegisterError (..),
    RegisterSuccess (..),
    RegisterResponses,
    RegisterInternalResponses,
    NewUser (..),
    emptyNewUser,
    NewUserSpar (..),
    CreateUserSparError (..),
    CreateUserSparInternalResponses,
    newUserFromSpar,
    urefToExternalId,
    ExpiresIn,
    newUserTeam,
    newUserEmail,
    newUserSSOId,
    isNewUserEphemeral,
    isNewUserTeamMember,

    -- * NewUserOrigin
    NewUserOrigin (..),
    InvitationCode (..),
    NewTeamUser (..),
    BindingNewTeamUser (..),

    -- * Profile Updates
    UserUpdate (..),
    UpdateProfileError (..),
    PutSelfResponses,
    PasswordChange (..),
    ChangePasswordError (..),
    ChangePasswordResponses,
    LocaleUpdate (..),
    EmailUpdate (..),
    PhoneUpdate (..),
    ChangePhoneError (..),
    ChangePhoneResponses,
    RemoveIdentityError (..),
    RemoveIdentityResponses,
    HandleUpdate (..),
    ChangeHandleError (..),
    ChangeHandleResponses,
    NameUpdate (..),
    ChangeEmailResponse (..),

    -- * Account Deletion
    DeleteUser (..),
    mkDeleteUser,
    VerifyDeleteUser (..),
    DeletionCodeTimeout (..),
    DeleteUserResponse (..),
    DeleteUserResult (..),

    -- * Account Status
    AccountStatus (..),
    AccountStatusUpdate (..),
    AccountStatusResp (..),

    -- * Scim invitations
    NewUserScimInvitation (..),

    -- * List Users
    ListUsersQuery (..),

    -- * misc internal
    GetActivationCodeResp (..),
    GetPasswordResetCodeResp (..),
    CheckBlacklistResponse (..),
    ManagedByUpdate (..),
    RichInfoUpdate (..),
    PasswordResetPair,
    UpdateSSOIdResponse (..),
    CheckHandleResponse (..),
    UpdateConnectionsInternal (..),
    EmailVisibility (..),
    EmailVisibilityConfig,
    EmailVisibilityConfigWithViewer,

    -- * re-exports
    module Wire.API.Locale,
    module Wire.API.User.Identity,
    module Wire.API.User.Profile,

    -- * 2nd factor auth
    VerificationAction (..),
    SendVerificationCode (..),

    -- * Protocol preferences
    BaseProtocolTag (..),
    baseProtocolToProtocol,
    SupportedProtocolUpdate (..),
    defSupportedProtocols,
    protocolSetBits,
    protocolSetFromBits,
  )
where

import Cassandra qualified as C
import Control.Applicative
import Control.Arrow ((&&&))
import Control.Error.Safe (rightMay)
import Control.Lens (makePrisms, over, view, (.~), (?~))
import Data.Aeson (FromJSON (..), ToJSON (..), withText)
import Data.Aeson.Types qualified as A
import Data.Attoparsec.ByteString qualified as Parser
import Data.Bits
import Data.ByteString (toStrict)
import Data.ByteString.Builder (toLazyByteString)
import Data.ByteString.Conversion
import Data.CaseInsensitive qualified as CI
import Data.Code qualified as Code
import Data.Currency qualified as Currency
import Data.Domain (Domain (Domain))
import Data.Either.Extra (maybeToEither)
import Data.Handle (Handle)
import Data.HashMap.Strict.InsOrd qualified as InsOrdHashMap
import Data.Id
import Data.Json.Util (UTCTimeMillis, (#))
import Data.LegalHold (UserLegalHoldStatus)
import Data.List.NonEmpty (NonEmpty (..))
import Data.Misc (PlainTextPassword6, PlainTextPassword8)
import Data.OpenApi qualified as S
import Data.Qualified
import Data.Range
import Data.SOP
import Data.Schema
import Data.Schema qualified as Schema
import Data.Set qualified as Set
import Data.Text qualified as T
import Data.Text.Ascii
import Data.Text.Encoding qualified as T
import Data.Text.Encoding.Error
import Data.UUID (UUID, nil)
import Data.UUID qualified as UUID
import Deriving.Swagger
import GHC.TypeLits
import Generics.SOP qualified as GSOP
import Imports
import SAML2.WebSSO qualified as SAML
import Servant (FromHttpApiData (..), ToHttpApiData (..), type (.++))
import Test.QuickCheck qualified as QC
import URI.ByteString (serializeURIRef)
import Web.Cookie qualified as Web
import Wire.API.Conversation.Protocol
import Wire.API.Error
import Wire.API.Error.Brig
import Wire.API.Error.Brig qualified as E
import Wire.API.Locale
import Wire.API.Provider.Service (ServiceRef)
import Wire.API.Routes.MultiVerb
import Wire.API.Team
import Wire.API.Team.Member (TeamMember)
import Wire.API.Team.Member qualified as TeamMember
import Wire.API.Team.Role
import Wire.API.User.Activation (ActivationCode, ActivationKey)
import Wire.API.User.Auth (CookieLabel)
import Wire.API.User.Identity hiding (toByteString)
import Wire.API.User.Password
import Wire.API.User.Profile
import Wire.API.User.RichInfo
import Wire.Arbitrary (Arbitrary (arbitrary), GenericUniform (..))

--------------------------------------------------------------------------------
-- UserIdList

-- | This datatype replaces the old `Members` datatype,
-- which has been replaced by `SimpleMembers`. This is
-- needed due to backwards compatible reasons since old
-- clients will break if we switch these types. Also, this
-- definition represents better what information it carries
newtype UserIdList = UserIdList {UserIdList -> [UserId]
mUsers :: [UserId]}
  deriving stock (UserIdList -> UserIdList -> Bool
(UserIdList -> UserIdList -> Bool)
-> (UserIdList -> UserIdList -> Bool) -> Eq UserIdList
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: UserIdList -> UserIdList -> Bool
== :: UserIdList -> UserIdList -> Bool
$c/= :: UserIdList -> UserIdList -> Bool
/= :: UserIdList -> UserIdList -> Bool
Eq, Int -> UserIdList -> ShowS
[UserIdList] -> ShowS
UserIdList -> String
(Int -> UserIdList -> ShowS)
-> (UserIdList -> String)
-> ([UserIdList] -> ShowS)
-> Show UserIdList
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> UserIdList -> ShowS
showsPrec :: Int -> UserIdList -> ShowS
$cshow :: UserIdList -> String
show :: UserIdList -> String
$cshowList :: [UserIdList] -> ShowS
showList :: [UserIdList] -> ShowS
Show, (forall x. UserIdList -> Rep UserIdList x)
-> (forall x. Rep UserIdList x -> UserIdList) -> Generic UserIdList
forall x. Rep UserIdList x -> UserIdList
forall x. UserIdList -> Rep UserIdList x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. UserIdList -> Rep UserIdList x
from :: forall x. UserIdList -> Rep UserIdList x
$cto :: forall x. Rep UserIdList x -> UserIdList
to :: forall x. Rep UserIdList x -> UserIdList
Generic)
  deriving newtype (Gen UserIdList
Gen UserIdList
-> (UserIdList -> [UserIdList]) -> Arbitrary UserIdList
UserIdList -> [UserIdList]
forall a. Gen a -> (a -> [a]) -> Arbitrary a
$carbitrary :: Gen UserIdList
arbitrary :: Gen UserIdList
$cshrink :: UserIdList -> [UserIdList]
shrink :: UserIdList -> [UserIdList]
Arbitrary)
  deriving (Value -> Parser [UserIdList]
Value -> Parser UserIdList
(Value -> Parser UserIdList)
-> (Value -> Parser [UserIdList]) -> FromJSON UserIdList
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser UserIdList
parseJSON :: Value -> Parser UserIdList
$cparseJSONList :: Value -> Parser [UserIdList]
parseJSONList :: Value -> Parser [UserIdList]
FromJSON, [UserIdList] -> Value
[UserIdList] -> Encoding
UserIdList -> Value
UserIdList -> Encoding
(UserIdList -> Value)
-> (UserIdList -> Encoding)
-> ([UserIdList] -> Value)
-> ([UserIdList] -> Encoding)
-> ToJSON UserIdList
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: UserIdList -> Value
toJSON :: UserIdList -> Value
$ctoEncoding :: UserIdList -> Encoding
toEncoding :: UserIdList -> Encoding
$ctoJSONList :: [UserIdList] -> Value
toJSONList :: [UserIdList] -> Value
$ctoEncodingList :: [UserIdList] -> Encoding
toEncodingList :: [UserIdList] -> Encoding
ToJSON, Typeable UserIdList
Typeable UserIdList =>
(Proxy UserIdList -> Declare (Definitions Schema) NamedSchema)
-> ToSchema UserIdList
Proxy UserIdList -> Declare (Definitions Schema) NamedSchema
forall a.
Typeable a =>
(Proxy a -> Declare (Definitions Schema) NamedSchema) -> ToSchema a
$cdeclareNamedSchema :: Proxy UserIdList -> Declare (Definitions Schema) NamedSchema
declareNamedSchema :: Proxy UserIdList -> Declare (Definitions Schema) NamedSchema
S.ToSchema) via Schema UserIdList

instance ToSchema UserIdList where
  schema :: ValueSchema NamedSwaggerDoc UserIdList
schema =
    Text
-> SchemaP SwaggerDoc Object [Pair] UserIdList UserIdList
-> ValueSchema NamedSwaggerDoc UserIdList
forall doc doc' a b.
HasObject doc doc' =>
Text
-> SchemaP doc Object [Pair] a b -> SchemaP doc' Value Value a b
object Text
"UserIdList" (SchemaP SwaggerDoc Object [Pair] UserIdList UserIdList
 -> ValueSchema NamedSwaggerDoc UserIdList)
-> SchemaP SwaggerDoc Object [Pair] UserIdList UserIdList
-> ValueSchema NamedSwaggerDoc UserIdList
forall a b. (a -> b) -> a -> b
$
      [UserId] -> UserIdList
UserIdList
        ([UserId] -> UserIdList)
-> SchemaP SwaggerDoc Object [Pair] UserIdList [UserId]
-> SchemaP SwaggerDoc Object [Pair] UserIdList UserIdList
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> UserIdList -> [UserId]
mUsers
          (UserIdList -> [UserId])
-> SchemaP SwaggerDoc Object [Pair] [UserId] [UserId]
-> SchemaP SwaggerDoc Object [Pair] UserIdList [UserId]
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= Text
-> SchemaP SwaggerDoc 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_ids" (ValueSchema NamedSwaggerDoc UserId
-> SchemaP SwaggerDoc Value Value [UserId] [UserId]
forall ndoc doc a.
(HasArray ndoc doc, HasName ndoc) =>
ValueSchema ndoc a -> ValueSchema doc [a]
array ValueSchema NamedSwaggerDoc UserId
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema)

-- | Response type for endpoints returning lists of users with a specific connection state.
-- E.g. 'getContactList' returns a 'UserIds' containing the list of connections in an
-- 'Accepted' state.
--
-- There really shouldn't be both types `UserIds` and `UserIdList`, but refactoring them
-- away requires changing the api.
newtype UserIds = UserIds
  {UserIds -> [UserId]
cUsers :: [UserId]}
  deriving (UserIds -> UserIds -> Bool
(UserIds -> UserIds -> Bool)
-> (UserIds -> UserIds -> Bool) -> Eq UserIds
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: UserIds -> UserIds -> Bool
== :: UserIds -> UserIds -> Bool
$c/= :: UserIds -> UserIds -> Bool
/= :: UserIds -> UserIds -> Bool
Eq, Int -> UserIds -> ShowS
[UserIds] -> ShowS
UserIds -> String
(Int -> UserIds -> ShowS)
-> (UserIds -> String) -> ([UserIds] -> ShowS) -> Show UserIds
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> UserIds -> ShowS
showsPrec :: Int -> UserIds -> ShowS
$cshow :: UserIds -> String
show :: UserIds -> String
$cshowList :: [UserIds] -> ShowS
showList :: [UserIds] -> ShowS
Show, (forall x. UserIds -> Rep UserIds x)
-> (forall x. Rep UserIds x -> UserIds) -> Generic UserIds
forall x. Rep UserIds x -> UserIds
forall x. UserIds -> Rep UserIds x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. UserIds -> Rep UserIds x
from :: forall x. UserIds -> Rep UserIds x
$cto :: forall x. Rep UserIds x -> UserIds
to :: forall x. Rep UserIds x -> UserIds
Generic)
  deriving newtype (Gen UserIds
Gen UserIds -> (UserIds -> [UserIds]) -> Arbitrary UserIds
UserIds -> [UserIds]
forall a. Gen a -> (a -> [a]) -> Arbitrary a
$carbitrary :: Gen UserIds
arbitrary :: Gen UserIds
$cshrink :: UserIds -> [UserIds]
shrink :: UserIds -> [UserIds]
Arbitrary)
  deriving (Value -> Parser [UserIds]
Value -> Parser UserIds
(Value -> Parser UserIds)
-> (Value -> Parser [UserIds]) -> FromJSON UserIds
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser UserIds
parseJSON :: Value -> Parser UserIds
$cparseJSONList :: Value -> Parser [UserIds]
parseJSONList :: Value -> Parser [UserIds]
FromJSON, [UserIds] -> Value
[UserIds] -> Encoding
UserIds -> Value
UserIds -> Encoding
(UserIds -> Value)
-> (UserIds -> Encoding)
-> ([UserIds] -> Value)
-> ([UserIds] -> Encoding)
-> ToJSON UserIds
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: UserIds -> Value
toJSON :: UserIds -> Value
$ctoEncoding :: UserIds -> Encoding
toEncoding :: UserIds -> Encoding
$ctoJSONList :: [UserIds] -> Value
toJSONList :: [UserIds] -> Value
$ctoEncodingList :: [UserIds] -> Encoding
toEncodingList :: [UserIds] -> Encoding
ToJSON, Typeable UserIds
Typeable UserIds =>
(Proxy UserIds -> Declare (Definitions Schema) NamedSchema)
-> ToSchema UserIds
Proxy UserIds -> Declare (Definitions Schema) NamedSchema
forall a.
Typeable a =>
(Proxy a -> Declare (Definitions Schema) NamedSchema) -> ToSchema a
$cdeclareNamedSchema :: Proxy UserIds -> Declare (Definitions Schema) NamedSchema
declareNamedSchema :: Proxy UserIds -> Declare (Definitions Schema) NamedSchema
S.ToSchema) via Schema UserIds

instance ToSchema UserIds where
  schema :: ValueSchema NamedSwaggerDoc UserIds
schema =
    Text
-> SchemaP SwaggerDoc Object [Pair] UserIds UserIds
-> ValueSchema NamedSwaggerDoc UserIds
forall doc doc' a b.
HasObject doc doc' =>
Text
-> SchemaP doc Object [Pair] a b -> SchemaP doc' Value Value a b
object Text
"UserIds" (SchemaP SwaggerDoc Object [Pair] UserIds UserIds
 -> ValueSchema NamedSwaggerDoc UserIds)
-> SchemaP SwaggerDoc Object [Pair] UserIds UserIds
-> ValueSchema NamedSwaggerDoc UserIds
forall a b. (a -> b) -> a -> b
$
      [UserId] -> UserIds
UserIds
        ([UserId] -> UserIds)
-> SchemaP SwaggerDoc Object [Pair] UserIds [UserId]
-> SchemaP SwaggerDoc Object [Pair] UserIds UserIds
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> UserIds -> [UserId]
cUsers
          (UserIds -> [UserId])
-> SchemaP SwaggerDoc Object [Pair] [UserId] [UserId]
-> SchemaP SwaggerDoc Object [Pair] UserIds [UserId]
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= Text
-> SchemaP SwaggerDoc 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
"ids" (ValueSchema NamedSwaggerDoc UserId
-> SchemaP SwaggerDoc Value Value [UserId] [UserId]
forall ndoc doc a.
(HasArray ndoc doc, HasName ndoc) =>
ValueSchema ndoc a -> ValueSchema doc [a]
array ValueSchema NamedSwaggerDoc UserId
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema)

--------------------------------------------------------------------------------
-- misc internal

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

instance ToSchema GetActivationCodeResp where
  schema :: ValueSchema NamedSwaggerDoc GetActivationCodeResp
schema =
    Text
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     GetActivationCodeResp
     GetActivationCodeResp
-> ValueSchema NamedSwaggerDoc GetActivationCodeResp
forall doc doc' a b.
HasObject doc doc' =>
Text
-> SchemaP doc Object [Pair] a b -> SchemaP doc' Value Value a b
object Text
"GetActivationCodeResp" (SchemaP
   SwaggerDoc
   Object
   [Pair]
   GetActivationCodeResp
   GetActivationCodeResp
 -> ValueSchema NamedSwaggerDoc GetActivationCodeResp)
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     GetActivationCodeResp
     GetActivationCodeResp
-> ValueSchema NamedSwaggerDoc GetActivationCodeResp
forall a b. (a -> b) -> a -> b
$
      ((ActivationKey, ActivationCode) -> GetActivationCodeResp)
-> ActivationKey -> ActivationCode -> GetActivationCodeResp
forall a b c. ((a, b) -> c) -> a -> b -> c
curry (ActivationKey, ActivationCode) -> GetActivationCodeResp
GetActivationCodeResp
        (ActivationKey -> ActivationCode -> GetActivationCodeResp)
-> SchemaP
     SwaggerDoc Object [Pair] GetActivationCodeResp ActivationKey
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     GetActivationCodeResp
     (ActivationCode -> GetActivationCodeResp)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((ActivationKey, ActivationCode) -> ActivationKey
forall a b. (a, b) -> a
fst ((ActivationKey, ActivationCode) -> ActivationKey)
-> (GetActivationCodeResp -> (ActivationKey, ActivationCode))
-> GetActivationCodeResp
-> ActivationKey
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GetActivationCodeResp -> (ActivationKey, ActivationCode)
fromGetActivationCodeResp) (GetActivationCodeResp -> ActivationKey)
-> SchemaP SwaggerDoc Object [Pair] ActivationKey ActivationKey
-> SchemaP
     SwaggerDoc Object [Pair] GetActivationCodeResp ActivationKey
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= Text
-> SchemaP NamedSwaggerDoc Value Value ActivationKey ActivationKey
-> SchemaP SwaggerDoc Object [Pair] ActivationKey ActivationKey
forall doc' doc a b.
HasField doc' doc =>
Text
-> SchemaP doc' Value Value a b -> SchemaP doc Object [Pair] a b
field Text
"key" SchemaP NamedSwaggerDoc Value Value ActivationKey ActivationKey
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema
        SchemaP
  SwaggerDoc
  Object
  [Pair]
  GetActivationCodeResp
  (ActivationCode -> GetActivationCodeResp)
-> SchemaP
     SwaggerDoc Object [Pair] GetActivationCodeResp ActivationCode
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     GetActivationCodeResp
     GetActivationCodeResp
forall a b.
SchemaP SwaggerDoc Object [Pair] GetActivationCodeResp (a -> b)
-> SchemaP SwaggerDoc Object [Pair] GetActivationCodeResp a
-> SchemaP SwaggerDoc Object [Pair] GetActivationCodeResp b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ((ActivationKey, ActivationCode) -> ActivationCode
forall a b. (a, b) -> b
snd ((ActivationKey, ActivationCode) -> ActivationCode)
-> (GetActivationCodeResp -> (ActivationKey, ActivationCode))
-> GetActivationCodeResp
-> ActivationCode
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GetActivationCodeResp -> (ActivationKey, ActivationCode)
fromGetActivationCodeResp) (GetActivationCodeResp -> ActivationCode)
-> SchemaP SwaggerDoc Object [Pair] ActivationCode ActivationCode
-> SchemaP
     SwaggerDoc Object [Pair] GetActivationCodeResp ActivationCode
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= Text
-> SchemaP
     NamedSwaggerDoc Value Value ActivationCode ActivationCode
-> SchemaP SwaggerDoc Object [Pair] ActivationCode ActivationCode
forall doc' doc a b.
HasField doc' doc =>
Text
-> SchemaP doc' Value Value a b -> SchemaP doc Object [Pair] a b
field Text
"code" SchemaP NamedSwaggerDoc Value Value ActivationCode ActivationCode
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema

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

instance ToSchema GetPasswordResetCodeResp where
  schema :: ValueSchema NamedSwaggerDoc GetPasswordResetCodeResp
schema =
    Text
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     GetPasswordResetCodeResp
     GetPasswordResetCodeResp
-> ValueSchema NamedSwaggerDoc GetPasswordResetCodeResp
forall doc doc' a b.
HasObject doc doc' =>
Text
-> SchemaP doc Object [Pair] a b -> SchemaP doc' Value Value a b
object Text
"GetPasswordResetCodeResp" (SchemaP
   SwaggerDoc
   Object
   [Pair]
   GetPasswordResetCodeResp
   GetPasswordResetCodeResp
 -> ValueSchema NamedSwaggerDoc GetPasswordResetCodeResp)
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     GetPasswordResetCodeResp
     GetPasswordResetCodeResp
-> ValueSchema NamedSwaggerDoc GetPasswordResetCodeResp
forall a b. (a -> b) -> a -> b
$
      ((PasswordResetKey, PasswordResetCode) -> GetPasswordResetCodeResp)
-> PasswordResetKey
-> PasswordResetCode
-> GetPasswordResetCodeResp
forall a b c. ((a, b) -> c) -> a -> b -> c
curry (PasswordResetKey, PasswordResetCode) -> GetPasswordResetCodeResp
GetPasswordResetCodeResp
        (PasswordResetKey -> PasswordResetCode -> GetPasswordResetCodeResp)
-> SchemaP
     SwaggerDoc Object [Pair] GetPasswordResetCodeResp PasswordResetKey
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     GetPasswordResetCodeResp
     (PasswordResetCode -> GetPasswordResetCodeResp)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((PasswordResetKey, PasswordResetCode) -> PasswordResetKey
forall a b. (a, b) -> a
fst ((PasswordResetKey, PasswordResetCode) -> PasswordResetKey)
-> (GetPasswordResetCodeResp
    -> (PasswordResetKey, PasswordResetCode))
-> GetPasswordResetCodeResp
-> PasswordResetKey
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GetPasswordResetCodeResp -> (PasswordResetKey, PasswordResetCode)
fromGetPasswordResetCodeResp) (GetPasswordResetCodeResp -> PasswordResetKey)
-> SchemaP
     SwaggerDoc Object [Pair] PasswordResetKey PasswordResetKey
-> SchemaP
     SwaggerDoc Object [Pair] GetPasswordResetCodeResp PasswordResetKey
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= Text
-> SchemaP
     NamedSwaggerDoc Value Value PasswordResetKey PasswordResetKey
-> SchemaP
     SwaggerDoc Object [Pair] PasswordResetKey PasswordResetKey
forall doc' doc a b.
HasField doc' doc =>
Text
-> SchemaP doc' Value Value a b -> SchemaP doc Object [Pair] a b
field Text
"key" SchemaP
  NamedSwaggerDoc Value Value PasswordResetKey PasswordResetKey
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema
        SchemaP
  SwaggerDoc
  Object
  [Pair]
  GetPasswordResetCodeResp
  (PasswordResetCode -> GetPasswordResetCodeResp)
-> SchemaP
     SwaggerDoc Object [Pair] GetPasswordResetCodeResp PasswordResetCode
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     GetPasswordResetCodeResp
     GetPasswordResetCodeResp
forall a b.
SchemaP SwaggerDoc Object [Pair] GetPasswordResetCodeResp (a -> b)
-> SchemaP SwaggerDoc Object [Pair] GetPasswordResetCodeResp a
-> SchemaP SwaggerDoc Object [Pair] GetPasswordResetCodeResp b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ((PasswordResetKey, PasswordResetCode) -> PasswordResetCode
forall a b. (a, b) -> b
snd ((PasswordResetKey, PasswordResetCode) -> PasswordResetCode)
-> (GetPasswordResetCodeResp
    -> (PasswordResetKey, PasswordResetCode))
-> GetPasswordResetCodeResp
-> PasswordResetCode
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GetPasswordResetCodeResp -> (PasswordResetKey, PasswordResetCode)
fromGetPasswordResetCodeResp) (GetPasswordResetCodeResp -> PasswordResetCode)
-> SchemaP
     SwaggerDoc Object [Pair] PasswordResetCode PasswordResetCode
-> SchemaP
     SwaggerDoc Object [Pair] GetPasswordResetCodeResp PasswordResetCode
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= Text
-> SchemaP
     NamedSwaggerDoc Value Value PasswordResetCode PasswordResetCode
-> SchemaP
     SwaggerDoc Object [Pair] PasswordResetCode PasswordResetCode
forall doc' doc a b.
HasField doc' doc =>
Text
-> SchemaP doc' Value Value a b -> SchemaP doc Object [Pair] a b
field Text
"code" SchemaP
  NamedSwaggerDoc Value Value PasswordResetCode PasswordResetCode
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema

data CheckBlacklistResponse = NotBlacklisted | YesBlacklisted

instance
  AsUnion
    '[ Respond 404 "Not blacklisted" (),
       Respond 200 "Yes blacklisted" ()
     ]
    CheckBlacklistResponse
  where
  toUnion :: CheckBlacklistResponse
-> Union
     (ResponseTypes
        '[Respond 404 "Not blacklisted" (),
          Respond 200 "Yes blacklisted" ()])
toUnion CheckBlacklistResponse
NotBlacklisted = I () -> NS I '[(), ()]
forall {k} (a :: k -> *) (x :: k) (xs :: [k]). a x -> NS a (x : xs)
Z (() -> I ()
forall a. a -> I a
I ())
  toUnion CheckBlacklistResponse
YesBlacklisted = NS I '[()] -> NS I '[(), ()]
forall {k} (a :: k -> *) (xs :: [k]) (x :: k).
NS a xs -> NS a (x : xs)
S (I () -> NS I '[()]
forall {k} (a :: k -> *) (x :: k) (xs :: [k]). a x -> NS a (x : xs)
Z (() -> I ()
forall a. a -> I a
I ()))
  fromUnion :: Union
  (ResponseTypes
     '[Respond 404 "Not blacklisted" (),
       Respond 200 "Yes blacklisted" ()])
-> CheckBlacklistResponse
fromUnion (Z (I ())) = CheckBlacklistResponse
NotBlacklisted
  fromUnion (S (Z (I ()))) = CheckBlacklistResponse
YesBlacklisted
  fromUnion (S (S NS I xs
x)) = case NS I xs
x of {}

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

instance ToSchema ManagedByUpdate where
  schema :: ValueSchema NamedSwaggerDoc ManagedByUpdate
schema =
    Text
-> SchemaP SwaggerDoc Object [Pair] ManagedByUpdate ManagedByUpdate
-> ValueSchema NamedSwaggerDoc ManagedByUpdate
forall doc doc' a b.
HasObject doc doc' =>
Text
-> SchemaP doc Object [Pair] a b -> SchemaP doc' Value Value a b
object Text
"ManagedByUpdate" (SchemaP SwaggerDoc Object [Pair] ManagedByUpdate ManagedByUpdate
 -> ValueSchema NamedSwaggerDoc ManagedByUpdate)
-> SchemaP SwaggerDoc Object [Pair] ManagedByUpdate ManagedByUpdate
-> ValueSchema NamedSwaggerDoc ManagedByUpdate
forall a b. (a -> b) -> a -> b
$
      ManagedBy -> ManagedByUpdate
ManagedByUpdate
        (ManagedBy -> ManagedByUpdate)
-> SchemaP SwaggerDoc Object [Pair] ManagedByUpdate ManagedBy
-> SchemaP SwaggerDoc Object [Pair] ManagedByUpdate ManagedByUpdate
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ManagedByUpdate -> ManagedBy
mbuManagedBy (ManagedByUpdate -> ManagedBy)
-> SchemaP SwaggerDoc Object [Pair] ManagedBy ManagedBy
-> SchemaP SwaggerDoc Object [Pair] ManagedByUpdate ManagedBy
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= Text
-> SchemaP NamedSwaggerDoc Value Value ManagedBy ManagedBy
-> SchemaP SwaggerDoc Object [Pair] ManagedBy ManagedBy
forall doc' doc a b.
HasField doc' doc =>
Text
-> SchemaP doc' Value Value a b -> SchemaP doc Object [Pair] a b
field Text
"managed_by" SchemaP NamedSwaggerDoc Value Value ManagedBy ManagedBy
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema

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

instance ToSchema RichInfoUpdate where
  schema :: ValueSchema NamedSwaggerDoc RichInfoUpdate
schema =
    Text
-> SchemaP SwaggerDoc Object [Pair] RichInfoUpdate RichInfoUpdate
-> ValueSchema NamedSwaggerDoc RichInfoUpdate
forall doc doc' a b.
HasObject doc doc' =>
Text
-> SchemaP doc Object [Pair] a b -> SchemaP doc' Value Value a b
object Text
"RichInfoUpdate" (SchemaP SwaggerDoc Object [Pair] RichInfoUpdate RichInfoUpdate
 -> ValueSchema NamedSwaggerDoc RichInfoUpdate)
-> SchemaP SwaggerDoc Object [Pair] RichInfoUpdate RichInfoUpdate
-> ValueSchema NamedSwaggerDoc RichInfoUpdate
forall a b. (a -> b) -> a -> b
$
      RichInfoAssocList -> RichInfoUpdate
RichInfoUpdate
        (RichInfoAssocList -> RichInfoUpdate)
-> SchemaP
     SwaggerDoc Object [Pair] RichInfoUpdate RichInfoAssocList
-> SchemaP SwaggerDoc Object [Pair] RichInfoUpdate RichInfoUpdate
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RichInfoUpdate -> RichInfoAssocList
riuRichInfo (RichInfoUpdate -> RichInfoAssocList)
-> SchemaP
     SwaggerDoc Object [Pair] RichInfoAssocList RichInfoAssocList
-> SchemaP
     SwaggerDoc Object [Pair] RichInfoUpdate RichInfoAssocList
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= Text
-> SchemaP
     NamedSwaggerDoc Value Value RichInfoAssocList RichInfoAssocList
-> SchemaP
     SwaggerDoc Object [Pair] RichInfoAssocList RichInfoAssocList
forall doc' doc a b.
HasField doc' doc =>
Text
-> SchemaP doc' Value Value a b -> SchemaP doc Object [Pair] a b
field Text
"rich_info" SchemaP
  NamedSwaggerDoc Value Value RichInfoAssocList RichInfoAssocList
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema

type PasswordResetPair = (PasswordResetKey, PasswordResetCode)

-- we recycle that for delete userssoid, too.  can't be bothered.
data UpdateSSOIdResponse = UpdateSSOIdSuccess | UpdateSSOIdNotFound

instance
  AsUnion
    '[ RespondEmpty 200 "UpdateSSOIdSuccess",
       RespondEmpty 404 "UpdateSSOIdNotFound"
     ]
    UpdateSSOIdResponse
  where
  toUnion :: UpdateSSOIdResponse
-> Union
     (ResponseTypes
        '[RespondEmpty 200 "UpdateSSOIdSuccess",
          RespondEmpty 404 "UpdateSSOIdNotFound"])
toUnion UpdateSSOIdResponse
UpdateSSOIdSuccess = I () -> NS I '[(), ()]
forall {k} (a :: k -> *) (x :: k) (xs :: [k]). a x -> NS a (x : xs)
Z (() -> I ()
forall a. a -> I a
I ())
  toUnion UpdateSSOIdResponse
UpdateSSOIdNotFound = NS I '[()] -> NS I '[(), ()]
forall {k} (a :: k -> *) (xs :: [k]) (x :: k).
NS a xs -> NS a (x : xs)
S (I () -> NS I '[()]
forall {k} (a :: k -> *) (x :: k) (xs :: [k]). a x -> NS a (x : xs)
Z (() -> I ()
forall a. a -> I a
I ()))
  fromUnion :: Union
  (ResponseTypes
     '[RespondEmpty 200 "UpdateSSOIdSuccess",
       RespondEmpty 404 "UpdateSSOIdNotFound"])
-> UpdateSSOIdResponse
fromUnion (Z (I ())) = UpdateSSOIdResponse
UpdateSSOIdSuccess
  fromUnion (S (Z (I ()))) = UpdateSSOIdResponse
UpdateSSOIdNotFound
  fromUnion (S (S NS I xs
x)) = case NS I xs
x of {}

data CheckHandleResponse
  = CheckHandleResponseFound
  | CheckHandleResponseNotFound

instance
  AsUnion
    '[ RespondEmpty 200 "CheckHandleResponseFound",
       RespondEmpty 404 "CheckHandleResponseNotFound"
     ]
    CheckHandleResponse
  where
  toUnion :: CheckHandleResponse
-> Union
     (ResponseTypes
        '[RespondEmpty 200 "CheckHandleResponseFound",
          RespondEmpty 404 "CheckHandleResponseNotFound"])
toUnion CheckHandleResponse
CheckHandleResponseFound = I () -> NS I '[(), ()]
forall {k} (a :: k -> *) (x :: k) (xs :: [k]). a x -> NS a (x : xs)
Z (() -> I ()
forall a. a -> I a
I ())
  toUnion CheckHandleResponse
CheckHandleResponseNotFound = NS I '[()] -> NS I '[(), ()]
forall {k} (a :: k -> *) (xs :: [k]) (x :: k).
NS a xs -> NS a (x : xs)
S (I () -> NS I '[()]
forall {k} (a :: k -> *) (x :: k) (xs :: [k]). a x -> NS a (x : xs)
Z (() -> I ()
forall a. a -> I a
I ()))
  fromUnion :: Union
  (ResponseTypes
     '[RespondEmpty 200 "CheckHandleResponseFound",
       RespondEmpty 404 "CheckHandleResponseNotFound"])
-> CheckHandleResponse
fromUnion (Z (I ())) = CheckHandleResponse
CheckHandleResponseFound
  fromUnion (S (Z (I ()))) = CheckHandleResponse
CheckHandleResponseNotFound
  fromUnion (S (S NS I xs
x)) = case NS I xs
x of {}

-- | FUTUREWORK: This needs to get Qualified IDs when implementing
-- Legalhold + Federation, as it's used in the internal
-- putConnectionInternal / galley->Brig "/i/users/connections-status"
-- endpoint.
-- Internal RPCs need to be updated accordingly.
-- See https://wearezeta.atlassian.net/browse/SQCORE-973
data UpdateConnectionsInternal
  = BlockForMissingLHConsent UserId [UserId]
  | RemoveLHBlocksInvolving UserId
  | -- | This must only be used by tests
    CreateConnectionForTest UserId (Qualified UserId)
  deriving (UpdateConnectionsInternal -> UpdateConnectionsInternal -> Bool
(UpdateConnectionsInternal -> UpdateConnectionsInternal -> Bool)
-> (UpdateConnectionsInternal -> UpdateConnectionsInternal -> Bool)
-> Eq UpdateConnectionsInternal
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: UpdateConnectionsInternal -> UpdateConnectionsInternal -> Bool
== :: UpdateConnectionsInternal -> UpdateConnectionsInternal -> Bool
$c/= :: UpdateConnectionsInternal -> UpdateConnectionsInternal -> Bool
/= :: UpdateConnectionsInternal -> UpdateConnectionsInternal -> Bool
Eq, Int -> UpdateConnectionsInternal -> ShowS
[UpdateConnectionsInternal] -> ShowS
UpdateConnectionsInternal -> String
(Int -> UpdateConnectionsInternal -> ShowS)
-> (UpdateConnectionsInternal -> String)
-> ([UpdateConnectionsInternal] -> ShowS)
-> Show UpdateConnectionsInternal
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> UpdateConnectionsInternal -> ShowS
showsPrec :: Int -> UpdateConnectionsInternal -> ShowS
$cshow :: UpdateConnectionsInternal -> String
show :: UpdateConnectionsInternal -> String
$cshowList :: [UpdateConnectionsInternal] -> ShowS
showList :: [UpdateConnectionsInternal] -> ShowS
Show, (forall x.
 UpdateConnectionsInternal -> Rep UpdateConnectionsInternal x)
-> (forall x.
    Rep UpdateConnectionsInternal x -> UpdateConnectionsInternal)
-> Generic UpdateConnectionsInternal
forall x.
Rep UpdateConnectionsInternal x -> UpdateConnectionsInternal
forall x.
UpdateConnectionsInternal -> Rep UpdateConnectionsInternal x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x.
UpdateConnectionsInternal -> Rep UpdateConnectionsInternal x
from :: forall x.
UpdateConnectionsInternal -> Rep UpdateConnectionsInternal x
$cto :: forall x.
Rep UpdateConnectionsInternal x -> UpdateConnectionsInternal
to :: forall x.
Rep UpdateConnectionsInternal x -> UpdateConnectionsInternal
Generic)
  deriving (Gen UpdateConnectionsInternal
Gen UpdateConnectionsInternal
-> (UpdateConnectionsInternal -> [UpdateConnectionsInternal])
-> Arbitrary UpdateConnectionsInternal
UpdateConnectionsInternal -> [UpdateConnectionsInternal]
forall a. Gen a -> (a -> [a]) -> Arbitrary a
$carbitrary :: Gen UpdateConnectionsInternal
arbitrary :: Gen UpdateConnectionsInternal
$cshrink :: UpdateConnectionsInternal -> [UpdateConnectionsInternal]
shrink :: UpdateConnectionsInternal -> [UpdateConnectionsInternal]
Arbitrary) via (GenericUniform UpdateConnectionsInternal)

$(makePrisms ''UpdateConnectionsInternal)

data UpdateConnectionsInternalTag
  = BlockForMissingLHConsentTag
  | RemoveLHBlocksInvolvingTag
  | CreateConnectionForTestTag
  deriving (UpdateConnectionsInternalTag
-> UpdateConnectionsInternalTag -> Bool
(UpdateConnectionsInternalTag
 -> UpdateConnectionsInternalTag -> Bool)
-> (UpdateConnectionsInternalTag
    -> UpdateConnectionsInternalTag -> Bool)
-> Eq UpdateConnectionsInternalTag
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: UpdateConnectionsInternalTag
-> UpdateConnectionsInternalTag -> Bool
== :: UpdateConnectionsInternalTag
-> UpdateConnectionsInternalTag -> Bool
$c/= :: UpdateConnectionsInternalTag
-> UpdateConnectionsInternalTag -> Bool
/= :: UpdateConnectionsInternalTag
-> UpdateConnectionsInternalTag -> Bool
Eq, Int -> UpdateConnectionsInternalTag -> ShowS
[UpdateConnectionsInternalTag] -> ShowS
UpdateConnectionsInternalTag -> String
(Int -> UpdateConnectionsInternalTag -> ShowS)
-> (UpdateConnectionsInternalTag -> String)
-> ([UpdateConnectionsInternalTag] -> ShowS)
-> Show UpdateConnectionsInternalTag
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> UpdateConnectionsInternalTag -> ShowS
showsPrec :: Int -> UpdateConnectionsInternalTag -> ShowS
$cshow :: UpdateConnectionsInternalTag -> String
show :: UpdateConnectionsInternalTag -> String
$cshowList :: [UpdateConnectionsInternalTag] -> ShowS
showList :: [UpdateConnectionsInternalTag] -> ShowS
Show, Int -> UpdateConnectionsInternalTag
UpdateConnectionsInternalTag -> Int
UpdateConnectionsInternalTag -> [UpdateConnectionsInternalTag]
UpdateConnectionsInternalTag -> UpdateConnectionsInternalTag
UpdateConnectionsInternalTag
-> UpdateConnectionsInternalTag -> [UpdateConnectionsInternalTag]
UpdateConnectionsInternalTag
-> UpdateConnectionsInternalTag
-> UpdateConnectionsInternalTag
-> [UpdateConnectionsInternalTag]
(UpdateConnectionsInternalTag -> UpdateConnectionsInternalTag)
-> (UpdateConnectionsInternalTag -> UpdateConnectionsInternalTag)
-> (Int -> UpdateConnectionsInternalTag)
-> (UpdateConnectionsInternalTag -> Int)
-> (UpdateConnectionsInternalTag -> [UpdateConnectionsInternalTag])
-> (UpdateConnectionsInternalTag
    -> UpdateConnectionsInternalTag -> [UpdateConnectionsInternalTag])
-> (UpdateConnectionsInternalTag
    -> UpdateConnectionsInternalTag -> [UpdateConnectionsInternalTag])
-> (UpdateConnectionsInternalTag
    -> UpdateConnectionsInternalTag
    -> UpdateConnectionsInternalTag
    -> [UpdateConnectionsInternalTag])
-> Enum UpdateConnectionsInternalTag
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: UpdateConnectionsInternalTag -> UpdateConnectionsInternalTag
succ :: UpdateConnectionsInternalTag -> UpdateConnectionsInternalTag
$cpred :: UpdateConnectionsInternalTag -> UpdateConnectionsInternalTag
pred :: UpdateConnectionsInternalTag -> UpdateConnectionsInternalTag
$ctoEnum :: Int -> UpdateConnectionsInternalTag
toEnum :: Int -> UpdateConnectionsInternalTag
$cfromEnum :: UpdateConnectionsInternalTag -> Int
fromEnum :: UpdateConnectionsInternalTag -> Int
$cenumFrom :: UpdateConnectionsInternalTag -> [UpdateConnectionsInternalTag]
enumFrom :: UpdateConnectionsInternalTag -> [UpdateConnectionsInternalTag]
$cenumFromThen :: UpdateConnectionsInternalTag
-> UpdateConnectionsInternalTag -> [UpdateConnectionsInternalTag]
enumFromThen :: UpdateConnectionsInternalTag
-> UpdateConnectionsInternalTag -> [UpdateConnectionsInternalTag]
$cenumFromTo :: UpdateConnectionsInternalTag
-> UpdateConnectionsInternalTag -> [UpdateConnectionsInternalTag]
enumFromTo :: UpdateConnectionsInternalTag
-> UpdateConnectionsInternalTag -> [UpdateConnectionsInternalTag]
$cenumFromThenTo :: UpdateConnectionsInternalTag
-> UpdateConnectionsInternalTag
-> UpdateConnectionsInternalTag
-> [UpdateConnectionsInternalTag]
enumFromThenTo :: UpdateConnectionsInternalTag
-> UpdateConnectionsInternalTag
-> UpdateConnectionsInternalTag
-> [UpdateConnectionsInternalTag]
Enum, UpdateConnectionsInternalTag
UpdateConnectionsInternalTag
-> UpdateConnectionsInternalTag
-> Bounded UpdateConnectionsInternalTag
forall a. a -> a -> Bounded a
$cminBound :: UpdateConnectionsInternalTag
minBound :: UpdateConnectionsInternalTag
$cmaxBound :: UpdateConnectionsInternalTag
maxBound :: UpdateConnectionsInternalTag
Bounded)

updateConnectionsInternalTag :: UpdateConnectionsInternal -> UpdateConnectionsInternalTag
updateConnectionsInternalTag :: UpdateConnectionsInternal -> UpdateConnectionsInternalTag
updateConnectionsInternalTag (BlockForMissingLHConsent UserId
_ [UserId]
_) = UpdateConnectionsInternalTag
BlockForMissingLHConsentTag
updateConnectionsInternalTag (RemoveLHBlocksInvolving UserId
_) = UpdateConnectionsInternalTag
RemoveLHBlocksInvolvingTag
updateConnectionsInternalTag (CreateConnectionForTest UserId
_ Qualified UserId
_) = UpdateConnectionsInternalTag
CreateConnectionForTestTag

instance ToSchema UpdateConnectionsInternalTag where
  schema :: ValueSchema NamedSwaggerDoc UpdateConnectionsInternalTag
schema =
    forall v doc a b.
(With v, HasEnum v doc) =>
Text
-> SchemaP [Value] v (Alt Maybe v) a b
-> SchemaP doc Value Value a b
enum @Text Text
"UpdateConnectionsInternalTag" (SchemaP
   [Value]
   Text
   (Alt Maybe Text)
   UpdateConnectionsInternalTag
   UpdateConnectionsInternalTag
 -> ValueSchema NamedSwaggerDoc UpdateConnectionsInternalTag)
-> SchemaP
     [Value]
     Text
     (Alt Maybe Text)
     UpdateConnectionsInternalTag
     UpdateConnectionsInternalTag
-> ValueSchema NamedSwaggerDoc UpdateConnectionsInternalTag
forall a b. (a -> b) -> a -> b
$
      Text
-> UpdateConnectionsInternalTag
-> SchemaP
     [Value]
     Text
     (Alt Maybe Text)
     UpdateConnectionsInternalTag
     UpdateConnectionsInternalTag
forall a b.
(ToJSON a, Eq a, Eq b) =>
a -> b -> SchemaP [Value] a (Alt Maybe a) b b
element Text
"BlockForMissingLHConsent" UpdateConnectionsInternalTag
BlockForMissingLHConsentTag
        SchemaP
  [Value]
  Text
  (Alt Maybe Text)
  UpdateConnectionsInternalTag
  UpdateConnectionsInternalTag
-> SchemaP
     [Value]
     Text
     (Alt Maybe Text)
     UpdateConnectionsInternalTag
     UpdateConnectionsInternalTag
-> SchemaP
     [Value]
     Text
     (Alt Maybe Text)
     UpdateConnectionsInternalTag
     UpdateConnectionsInternalTag
forall a. Semigroup a => a -> a -> a
<> Text
-> UpdateConnectionsInternalTag
-> SchemaP
     [Value]
     Text
     (Alt Maybe Text)
     UpdateConnectionsInternalTag
     UpdateConnectionsInternalTag
forall a b.
(ToJSON a, Eq a, Eq b) =>
a -> b -> SchemaP [Value] a (Alt Maybe a) b b
element Text
"RemoveLHBlocksInvolving" UpdateConnectionsInternalTag
RemoveLHBlocksInvolvingTag
        SchemaP
  [Value]
  Text
  (Alt Maybe Text)
  UpdateConnectionsInternalTag
  UpdateConnectionsInternalTag
-> SchemaP
     [Value]
     Text
     (Alt Maybe Text)
     UpdateConnectionsInternalTag
     UpdateConnectionsInternalTag
-> SchemaP
     [Value]
     Text
     (Alt Maybe Text)
     UpdateConnectionsInternalTag
     UpdateConnectionsInternalTag
forall a. Semigroup a => a -> a -> a
<> Text
-> UpdateConnectionsInternalTag
-> SchemaP
     [Value]
     Text
     (Alt Maybe Text)
     UpdateConnectionsInternalTag
     UpdateConnectionsInternalTag
forall a b.
(ToJSON a, Eq a, Eq b) =>
a -> b -> SchemaP [Value] a (Alt Maybe a) b b
element Text
"CreateConnectionForTest" UpdateConnectionsInternalTag
CreateConnectionForTestTag

instance ToSchema UpdateConnectionsInternal where
  schema :: ValueSchema NamedSwaggerDoc UpdateConnectionsInternal
schema =
    Text
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     UpdateConnectionsInternal
     UpdateConnectionsInternal
-> ValueSchema NamedSwaggerDoc UpdateConnectionsInternal
forall doc doc' a b.
HasObject doc doc' =>
Text
-> SchemaP doc Object [Pair] a b -> SchemaP doc' Value Value a b
object Text
"UpdateConnectionsInternal" (SchemaP
   SwaggerDoc
   Object
   [Pair]
   UpdateConnectionsInternal
   UpdateConnectionsInternal
 -> ValueSchema NamedSwaggerDoc UpdateConnectionsInternal)
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     UpdateConnectionsInternal
     UpdateConnectionsInternal
-> ValueSchema NamedSwaggerDoc UpdateConnectionsInternal
forall a b. (a -> b) -> a -> b
$
      (UpdateConnectionsInternalTag, UpdateConnectionsInternal)
-> UpdateConnectionsInternal
forall a b. (a, b) -> b
snd
        ((UpdateConnectionsInternalTag, UpdateConnectionsInternal)
 -> UpdateConnectionsInternal)
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     UpdateConnectionsInternal
     (UpdateConnectionsInternalTag, UpdateConnectionsInternal)
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     UpdateConnectionsInternal
     UpdateConnectionsInternal
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (UpdateConnectionsInternal -> UpdateConnectionsInternalTag
updateConnectionsInternalTag (UpdateConnectionsInternal -> UpdateConnectionsInternalTag)
-> (UpdateConnectionsInternal -> UpdateConnectionsInternal)
-> UpdateConnectionsInternal
-> (UpdateConnectionsInternalTag, UpdateConnectionsInternal)
forall b c c'. (b -> c) -> (b -> c') -> b -> (c, c')
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& UpdateConnectionsInternal -> UpdateConnectionsInternal
forall a. a -> a
id)
          (UpdateConnectionsInternal
 -> (UpdateConnectionsInternalTag, UpdateConnectionsInternal))
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     (UpdateConnectionsInternalTag, UpdateConnectionsInternal)
     (UpdateConnectionsInternalTag, UpdateConnectionsInternal)
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     UpdateConnectionsInternal
     (UpdateConnectionsInternalTag, UpdateConnectionsInternal)
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= SchemaP
  SwaggerDoc
  Object
  [Pair]
  (UpdateConnectionsInternalTag, UpdateConnectionsInternal)
  UpdateConnectionsInternalTag
-> SchemaP
     SwaggerDoc
     (Object, UpdateConnectionsInternalTag)
     [Pair]
     (UpdateConnectionsInternalTag, UpdateConnectionsInternal)
     UpdateConnectionsInternal
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     (UpdateConnectionsInternalTag, UpdateConnectionsInternal)
     (UpdateConnectionsInternalTag, UpdateConnectionsInternal)
forall d w v a b c.
(Monoid d, Monoid w) =>
SchemaP d v w a b
-> SchemaP d (v, b) w a c -> SchemaP d v w a (b, c)
bind
            ((UpdateConnectionsInternalTag, UpdateConnectionsInternal)
-> UpdateConnectionsInternalTag
forall a b. (a, b) -> a
fst ((UpdateConnectionsInternalTag, UpdateConnectionsInternal)
 -> UpdateConnectionsInternalTag)
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     UpdateConnectionsInternalTag
     UpdateConnectionsInternalTag
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     (UpdateConnectionsInternalTag, UpdateConnectionsInternal)
     UpdateConnectionsInternalTag
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= Text
-> ValueSchema NamedSwaggerDoc UpdateConnectionsInternalTag
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     UpdateConnectionsInternalTag
     UpdateConnectionsInternalTag
forall doc' doc a b.
HasField doc' doc =>
Text
-> SchemaP doc' Value Value a b -> SchemaP doc Object [Pair] a b
field Text
"tag" ValueSchema NamedSwaggerDoc UpdateConnectionsInternalTag
tagSchema)
            ((UpdateConnectionsInternalTag, UpdateConnectionsInternal)
-> UpdateConnectionsInternal
forall a b. (a, b) -> b
snd ((UpdateConnectionsInternalTag, UpdateConnectionsInternal)
 -> UpdateConnectionsInternal)
-> SchemaP
     SwaggerDoc
     (Object, UpdateConnectionsInternalTag)
     [Pair]
     UpdateConnectionsInternal
     UpdateConnectionsInternal
-> SchemaP
     SwaggerDoc
     (Object, UpdateConnectionsInternalTag)
     [Pair]
     (UpdateConnectionsInternalTag, UpdateConnectionsInternal)
     UpdateConnectionsInternal
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= (UpdateConnectionsInternalTag
 -> SchemaP
      SwaggerDoc
      Object
      [Pair]
      UpdateConnectionsInternal
      UpdateConnectionsInternal)
-> SchemaP
     SwaggerDoc
     (Object, UpdateConnectionsInternalTag)
     [Pair]
     UpdateConnectionsInternal
     UpdateConnectionsInternal
forall t d v w a b.
(Bounded t, Enum t, Monoid d) =>
(t -> SchemaP d v w a b) -> SchemaP d (v, t) w a b
dispatch UpdateConnectionsInternalTag
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     UpdateConnectionsInternal
     UpdateConnectionsInternal
untaggedSchema)
    where
      tagSchema :: ValueSchema NamedSwaggerDoc UpdateConnectionsInternalTag
      tagSchema :: ValueSchema NamedSwaggerDoc UpdateConnectionsInternalTag
tagSchema = ValueSchema NamedSwaggerDoc UpdateConnectionsInternalTag
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema

      untaggedSchema ::
        UpdateConnectionsInternalTag ->
        ObjectSchema SwaggerDoc UpdateConnectionsInternal
      untaggedSchema :: UpdateConnectionsInternalTag
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     UpdateConnectionsInternal
     UpdateConnectionsInternal
untaggedSchema UpdateConnectionsInternalTag
BlockForMissingLHConsentTag =
        Prism' UpdateConnectionsInternal (UserId, [UserId])
-> SchemaP
     SwaggerDoc Object [Pair] (UserId, [UserId]) (UserId, [UserId])
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     UpdateConnectionsInternal
     UpdateConnectionsInternal
forall b b' a a' ss v m.
Prism b b' a a' -> SchemaP ss v m a a' -> SchemaP ss v m b b'
tag p (UserId, [UserId]) (f (UserId, [UserId]))
-> p UpdateConnectionsInternal (f UpdateConnectionsInternal)
Prism' UpdateConnectionsInternal (UserId, [UserId])
_BlockForMissingLHConsent (SchemaP
   SwaggerDoc Object [Pair] (UserId, [UserId]) (UserId, [UserId])
 -> SchemaP
      SwaggerDoc
      Object
      [Pair]
      UpdateConnectionsInternal
      UpdateConnectionsInternal)
-> SchemaP
     SwaggerDoc Object [Pair] (UserId, [UserId]) (UserId, [UserId])
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     UpdateConnectionsInternal
     UpdateConnectionsInternal
forall a b. (a -> b) -> a -> b
$
          (,)
            (UserId -> [UserId] -> (UserId, [UserId]))
-> SchemaP SwaggerDoc Object [Pair] (UserId, [UserId]) UserId
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     (UserId, [UserId])
     ([UserId] -> (UserId, [UserId]))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (UserId, [UserId]) -> UserId
forall a b. (a, b) -> a
fst ((UserId, [UserId]) -> UserId)
-> SchemaP SwaggerDoc Object [Pair] UserId UserId
-> SchemaP SwaggerDoc Object [Pair] (UserId, [UserId]) UserId
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= Text
-> ValueSchema NamedSwaggerDoc 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" ValueSchema NamedSwaggerDoc UserId
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema
            SchemaP
  SwaggerDoc
  Object
  [Pair]
  (UserId, [UserId])
  ([UserId] -> (UserId, [UserId]))
-> SchemaP SwaggerDoc Object [Pair] (UserId, [UserId]) [UserId]
-> SchemaP
     SwaggerDoc Object [Pair] (UserId, [UserId]) (UserId, [UserId])
forall a b.
SchemaP SwaggerDoc Object [Pair] (UserId, [UserId]) (a -> b)
-> SchemaP SwaggerDoc Object [Pair] (UserId, [UserId]) a
-> SchemaP SwaggerDoc Object [Pair] (UserId, [UserId]) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (UserId, [UserId]) -> [UserId]
forall a b. (a, b) -> b
snd ((UserId, [UserId]) -> [UserId])
-> SchemaP SwaggerDoc Object [Pair] [UserId] [UserId]
-> SchemaP SwaggerDoc Object [Pair] (UserId, [UserId]) [UserId]
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= Text
-> SchemaP SwaggerDoc 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
"others" (ValueSchema NamedSwaggerDoc UserId
-> SchemaP SwaggerDoc Value Value [UserId] [UserId]
forall ndoc doc a.
(HasArray ndoc doc, HasName ndoc) =>
ValueSchema ndoc a -> ValueSchema doc [a]
array ValueSchema NamedSwaggerDoc UserId
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema)
      untaggedSchema UpdateConnectionsInternalTag
RemoveLHBlocksInvolvingTag =
        Prism' UpdateConnectionsInternal UserId
-> SchemaP SwaggerDoc Object [Pair] UserId UserId
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     UpdateConnectionsInternal
     UpdateConnectionsInternal
forall b b' a a' ss v m.
Prism b b' a a' -> SchemaP ss v m a a' -> SchemaP ss v m b b'
tag p UserId (f UserId)
-> p UpdateConnectionsInternal (f UpdateConnectionsInternal)
Prism' UpdateConnectionsInternal UserId
_RemoveLHBlocksInvolving (SchemaP SwaggerDoc Object [Pair] UserId UserId
 -> SchemaP
      SwaggerDoc
      Object
      [Pair]
      UpdateConnectionsInternal
      UpdateConnectionsInternal)
-> SchemaP SwaggerDoc Object [Pair] UserId UserId
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     UpdateConnectionsInternal
     UpdateConnectionsInternal
forall a b. (a -> b) -> a -> b
$
          Text
-> ValueSchema NamedSwaggerDoc 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" ValueSchema NamedSwaggerDoc UserId
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema
      untaggedSchema UpdateConnectionsInternalTag
CreateConnectionForTestTag =
        Prism' UpdateConnectionsInternal (UserId, Qualified UserId)
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     (UserId, Qualified UserId)
     (UserId, Qualified UserId)
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     UpdateConnectionsInternal
     UpdateConnectionsInternal
forall b b' a a' ss v m.
Prism b b' a a' -> SchemaP ss v m a a' -> SchemaP ss v m b b'
tag p (UserId, Qualified UserId) (f (UserId, Qualified UserId))
-> p UpdateConnectionsInternal (f UpdateConnectionsInternal)
Prism' UpdateConnectionsInternal (UserId, Qualified UserId)
_CreateConnectionForTest (SchemaP
   SwaggerDoc
   Object
   [Pair]
   (UserId, Qualified UserId)
   (UserId, Qualified UserId)
 -> SchemaP
      SwaggerDoc
      Object
      [Pair]
      UpdateConnectionsInternal
      UpdateConnectionsInternal)
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     (UserId, Qualified UserId)
     (UserId, Qualified UserId)
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     UpdateConnectionsInternal
     UpdateConnectionsInternal
forall a b. (a -> b) -> a -> b
$
          (,)
            (UserId -> Qualified UserId -> (UserId, Qualified UserId))
-> SchemaP
     SwaggerDoc Object [Pair] (UserId, Qualified UserId) UserId
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     (UserId, Qualified UserId)
     (Qualified UserId -> (UserId, Qualified UserId))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (UserId, Qualified UserId) -> UserId
forall a b. (a, b) -> a
fst ((UserId, Qualified UserId) -> UserId)
-> SchemaP SwaggerDoc Object [Pair] UserId UserId
-> SchemaP
     SwaggerDoc Object [Pair] (UserId, Qualified UserId) UserId
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= Text
-> ValueSchema NamedSwaggerDoc 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" ValueSchema NamedSwaggerDoc UserId
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema
            SchemaP
  SwaggerDoc
  Object
  [Pair]
  (UserId, Qualified UserId)
  (Qualified UserId -> (UserId, Qualified UserId))
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     (UserId, Qualified UserId)
     (Qualified UserId)
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     (UserId, Qualified UserId)
     (UserId, Qualified UserId)
forall a b.
SchemaP
  SwaggerDoc Object [Pair] (UserId, Qualified UserId) (a -> b)
-> SchemaP SwaggerDoc Object [Pair] (UserId, Qualified UserId) a
-> SchemaP SwaggerDoc Object [Pair] (UserId, Qualified UserId) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (UserId, Qualified UserId) -> Qualified UserId
forall a b. (a, b) -> b
snd ((UserId, Qualified UserId) -> Qualified UserId)
-> SchemaP
     SwaggerDoc Object [Pair] (Qualified UserId) (Qualified UserId)
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     (UserId, Qualified UserId)
     (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
"other" SchemaP
  NamedSwaggerDoc Value Value (Qualified UserId) (Qualified UserId)
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema

deriving via Schema UpdateConnectionsInternal instance (S.ToSchema UpdateConnectionsInternal)

deriving via Schema UpdateConnectionsInternal instance (FromJSON UpdateConnectionsInternal)

deriving via Schema UpdateConnectionsInternal instance (ToJSON UpdateConnectionsInternal)

--------------------------------------------------------------------------------
-- QualifiedUserIdList

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

instance ToSchema QualifiedUserIdList where
  schema :: ValueSchema NamedSwaggerDoc QualifiedUserIdList
schema =
    Text
-> SchemaP
     SwaggerDoc Object [Pair] QualifiedUserIdList QualifiedUserIdList
-> ValueSchema NamedSwaggerDoc QualifiedUserIdList
forall doc doc' a b.
HasObject doc doc' =>
Text
-> SchemaP doc Object [Pair] a b -> SchemaP doc' Value Value a b
object Text
"QualifiedUserIdList" SchemaP
  SwaggerDoc Object [Pair] QualifiedUserIdList QualifiedUserIdList
qualifiedUserIdListObjectSchema

qualifiedUserIdListObjectSchema :: ObjectSchema SwaggerDoc QualifiedUserIdList
qualifiedUserIdListObjectSchema :: SchemaP
  SwaggerDoc Object [Pair] QualifiedUserIdList QualifiedUserIdList
qualifiedUserIdListObjectSchema =
  [Qualified UserId] -> QualifiedUserIdList
QualifiedUserIdList
    ([Qualified UserId] -> QualifiedUserIdList)
-> SchemaP
     SwaggerDoc Object [Pair] QualifiedUserIdList [Qualified UserId]
-> SchemaP
     SwaggerDoc Object [Pair] QualifiedUserIdList QualifiedUserIdList
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> QualifiedUserIdList -> [Qualified UserId]
qualifiedUserIdList
      (QualifiedUserIdList -> [Qualified UserId])
-> SchemaP
     SwaggerDoc Object [Pair] [Qualified UserId] [Qualified UserId]
-> SchemaP
     SwaggerDoc Object [Pair] QualifiedUserIdList [Qualified UserId]
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= Text
-> SchemaP
     SwaggerDoc 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_ids" (SchemaP
  NamedSwaggerDoc Value Value (Qualified UserId) (Qualified UserId)
-> SchemaP
     SwaggerDoc Value Value [Qualified UserId] [Qualified UserId]
forall ndoc doc a.
(HasArray ndoc doc, HasName ndoc) =>
ValueSchema ndoc a -> ValueSchema doc [a]
array SchemaP
  NamedSwaggerDoc Value Value (Qualified UserId) (Qualified UserId)
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema)
    SchemaP
  SwaggerDoc Object [Pair] QualifiedUserIdList QualifiedUserIdList
-> SchemaP SwaggerDoc Object [Pair] QualifiedUserIdList [UserId]
-> SchemaP
     SwaggerDoc Object [Pair] QualifiedUserIdList QualifiedUserIdList
forall a b.
SchemaP SwaggerDoc Object [Pair] QualifiedUserIdList a
-> SchemaP SwaggerDoc Object [Pair] QualifiedUserIdList b
-> SchemaP SwaggerDoc Object [Pair] QualifiedUserIdList a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ((Qualified UserId -> UserId) -> [Qualified UserId] -> [UserId]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Qualified UserId -> UserId
forall a. Qualified a -> a
qUnqualified ([Qualified UserId] -> [UserId])
-> (QualifiedUserIdList -> [Qualified UserId])
-> QualifiedUserIdList
-> [UserId]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. QualifiedUserIdList -> [Qualified UserId]
qualifiedUserIdList)
      (QualifiedUserIdList -> [UserId])
-> SchemaP SwaggerDoc Object [Pair] [UserId] [UserId]
-> SchemaP SwaggerDoc Object [Pair] QualifiedUserIdList [UserId]
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= Text
-> SchemaP SwaggerDoc 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_ids" (Text
-> SchemaP SwaggerDoc Value Value [UserId] [UserId]
-> SchemaP SwaggerDoc 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_ids" (ValueSchema NamedSwaggerDoc UserId
-> SchemaP SwaggerDoc Value Value [UserId] [UserId]
forall ndoc doc a.
(HasArray ndoc doc, HasName ndoc) =>
ValueSchema ndoc a -> ValueSchema doc [a]
array ValueSchema NamedSwaggerDoc UserId
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema))

--------------------------------------------------------------------------------
-- LimitedQualifiedUserIdList

-- | We cannot use 'Wrapped' here because all the instances require proof that 1
-- is less than or equal to 'max'.
newtype LimitedQualifiedUserIdList (max :: Nat) = LimitedQualifiedUserIdList
  {forall (max :: Nat).
LimitedQualifiedUserIdList max -> Range 1 max [Qualified UserId]
qualifiedUsers :: Range 1 max [Qualified UserId]}
  deriving stock (LimitedQualifiedUserIdList max
-> LimitedQualifiedUserIdList max -> Bool
(LimitedQualifiedUserIdList max
 -> LimitedQualifiedUserIdList max -> Bool)
-> (LimitedQualifiedUserIdList max
    -> LimitedQualifiedUserIdList max -> Bool)
-> Eq (LimitedQualifiedUserIdList max)
forall (max :: Nat).
LimitedQualifiedUserIdList max
-> LimitedQualifiedUserIdList max -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall (max :: Nat).
LimitedQualifiedUserIdList max
-> LimitedQualifiedUserIdList max -> Bool
== :: LimitedQualifiedUserIdList max
-> LimitedQualifiedUserIdList max -> Bool
$c/= :: forall (max :: Nat).
LimitedQualifiedUserIdList max
-> LimitedQualifiedUserIdList max -> Bool
/= :: LimitedQualifiedUserIdList max
-> LimitedQualifiedUserIdList max -> Bool
Eq, Int -> LimitedQualifiedUserIdList max -> ShowS
[LimitedQualifiedUserIdList max] -> ShowS
LimitedQualifiedUserIdList max -> String
(Int -> LimitedQualifiedUserIdList max -> ShowS)
-> (LimitedQualifiedUserIdList max -> String)
-> ([LimitedQualifiedUserIdList max] -> ShowS)
-> Show (LimitedQualifiedUserIdList max)
forall (max :: Nat). Int -> LimitedQualifiedUserIdList max -> ShowS
forall (max :: Nat). [LimitedQualifiedUserIdList max] -> ShowS
forall (max :: Nat). LimitedQualifiedUserIdList max -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall (max :: Nat). Int -> LimitedQualifiedUserIdList max -> ShowS
showsPrec :: Int -> LimitedQualifiedUserIdList max -> ShowS
$cshow :: forall (max :: Nat). LimitedQualifiedUserIdList max -> String
show :: LimitedQualifiedUserIdList max -> String
$cshowList :: forall (max :: Nat). [LimitedQualifiedUserIdList max] -> ShowS
showList :: [LimitedQualifiedUserIdList max] -> ShowS
Show, (forall x.
 LimitedQualifiedUserIdList max
 -> Rep (LimitedQualifiedUserIdList max) x)
-> (forall x.
    Rep (LimitedQualifiedUserIdList max) x
    -> LimitedQualifiedUserIdList max)
-> Generic (LimitedQualifiedUserIdList max)
forall (max :: Nat) x.
Rep (LimitedQualifiedUserIdList max) x
-> LimitedQualifiedUserIdList max
forall (max :: Nat) x.
LimitedQualifiedUserIdList max
-> Rep (LimitedQualifiedUserIdList max) x
forall x.
Rep (LimitedQualifiedUserIdList max) x
-> LimitedQualifiedUserIdList max
forall x.
LimitedQualifiedUserIdList max
-> Rep (LimitedQualifiedUserIdList max) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall (max :: Nat) x.
LimitedQualifiedUserIdList max
-> Rep (LimitedQualifiedUserIdList max) x
from :: forall x.
LimitedQualifiedUserIdList max
-> Rep (LimitedQualifiedUserIdList max) x
$cto :: forall (max :: Nat) x.
Rep (LimitedQualifiedUserIdList max) x
-> LimitedQualifiedUserIdList max
to :: forall x.
Rep (LimitedQualifiedUserIdList max) x
-> LimitedQualifiedUserIdList max
Generic)
  deriving (Typeable (LimitedQualifiedUserIdList max)
Typeable (LimitedQualifiedUserIdList max) =>
(Proxy (LimitedQualifiedUserIdList max)
 -> Declare (Definitions Schema) NamedSchema)
-> ToSchema (LimitedQualifiedUserIdList max)
Proxy (LimitedQualifiedUserIdList max)
-> Declare (Definitions Schema) NamedSchema
forall (max :: Nat).
KnownNat max =>
Typeable (LimitedQualifiedUserIdList max)
forall (max :: Nat).
KnownNat max =>
Proxy (LimitedQualifiedUserIdList max)
-> Declare (Definitions Schema) NamedSchema
forall a.
Typeable a =>
(Proxy a -> Declare (Definitions Schema) NamedSchema) -> ToSchema a
$cdeclareNamedSchema :: forall (max :: Nat).
KnownNat max =>
Proxy (LimitedQualifiedUserIdList max)
-> Declare (Definitions Schema) NamedSchema
declareNamedSchema :: Proxy (LimitedQualifiedUserIdList max)
-> Declare (Definitions Schema) NamedSchema
S.ToSchema) via CustomSwagger '[FieldLabelModifier CamelToSnake] (LimitedQualifiedUserIdList max)

instance (KnownNat max, 1 <= max) => Arbitrary (LimitedQualifiedUserIdList max) where
  arbitrary :: Gen (LimitedQualifiedUserIdList max)
arbitrary = Range 1 max [Qualified UserId] -> LimitedQualifiedUserIdList max
forall (max :: Nat).
Range 1 max [Qualified UserId] -> LimitedQualifiedUserIdList max
LimitedQualifiedUserIdList (Range 1 max [Qualified UserId] -> LimitedQualifiedUserIdList max)
-> Gen (Range 1 max [Qualified UserId])
-> Gen (LimitedQualifiedUserIdList max)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (Range 1 max [Qualified UserId])
forall a. Arbitrary a => Gen a
arbitrary

instance (KnownNat max, 1 <= max) => FromJSON (LimitedQualifiedUserIdList max) where
  parseJSON :: Value -> Parser (LimitedQualifiedUserIdList max)
parseJSON = String
-> (Object -> Parser (LimitedQualifiedUserIdList max))
-> Value
-> Parser (LimitedQualifiedUserIdList max)
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"LimitedQualifiedUserIdList" ((Object -> Parser (LimitedQualifiedUserIdList max))
 -> Value -> Parser (LimitedQualifiedUserIdList max))
-> (Object -> Parser (LimitedQualifiedUserIdList max))
-> Value
-> Parser (LimitedQualifiedUserIdList max)
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Range 1 max [Qualified UserId] -> LimitedQualifiedUserIdList max
forall (max :: Nat).
Range 1 max [Qualified UserId] -> LimitedQualifiedUserIdList max
LimitedQualifiedUserIdList (Range 1 max [Qualified UserId] -> LimitedQualifiedUserIdList max)
-> Parser (Range 1 max [Qualified UserId])
-> Parser (LimitedQualifiedUserIdList max)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser (Range 1 max [Qualified UserId])
forall a. FromJSON a => Object -> Key -> Parser a
A..: Key
"qualified_users"

instance (1 <= max) => ToJSON (LimitedQualifiedUserIdList max) where
  toJSON :: LimitedQualifiedUserIdList max -> Value
toJSON LimitedQualifiedUserIdList max
e = [Pair] -> Value
A.object [Key
"qualified_users" Key -> Range 1 max [Qualified UserId] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
A..= LimitedQualifiedUserIdList max -> Range 1 max [Qualified UserId]
forall (max :: Nat).
LimitedQualifiedUserIdList max -> Range 1 max [Qualified UserId]
qualifiedUsers LimitedQualifiedUserIdList max
e]

--------------------------------------------------------------------------------
-- UserProfile

-- | A subset of the data of an existing 'User' that is returned on the API and is visible to
-- other users. Each user also has access to their own profile in a richer format --
-- 'SelfProfile'.
data UserProfile = UserProfile
  { UserProfile -> Qualified UserId
profileQualifiedId :: Qualified UserId,
    UserProfile -> Name
profileName :: Name,
    UserProfile -> Maybe TextStatus
profileTextStatus :: Maybe TextStatus,
    -- | DEPRECATED
    UserProfile -> Pict
profilePict :: Pict,
    UserProfile -> [Asset]
profileAssets :: [Asset],
    UserProfile -> ColourId
profileAccentId :: ColourId,
    UserProfile -> Bool
profileDeleted :: Bool,
    -- | Set if the user represents an external service,
    -- i.e. it is a "bot".
    UserProfile -> Maybe ServiceRef
profileService :: Maybe ServiceRef,
    UserProfile -> Maybe Handle
profileHandle :: Maybe Handle,
    UserProfile -> Maybe UTCTimeMillis
profileExpire :: Maybe UTCTimeMillis,
    UserProfile -> Maybe TeamId
profileTeam :: Maybe TeamId,
    UserProfile -> Maybe EmailAddress
profileEmail :: Maybe EmailAddress,
    UserProfile -> UserLegalHoldStatus
profileLegalholdStatus :: UserLegalHoldStatus,
    UserProfile -> Set BaseProtocolTag
profileSupportedProtocols :: Set BaseProtocolTag
  }
  deriving stock (UserProfile -> UserProfile -> Bool
(UserProfile -> UserProfile -> Bool)
-> (UserProfile -> UserProfile -> Bool) -> Eq UserProfile
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: UserProfile -> UserProfile -> Bool
== :: UserProfile -> UserProfile -> Bool
$c/= :: UserProfile -> UserProfile -> Bool
/= :: UserProfile -> UserProfile -> Bool
Eq, Int -> UserProfile -> ShowS
[UserProfile] -> ShowS
UserProfile -> String
(Int -> UserProfile -> ShowS)
-> (UserProfile -> String)
-> ([UserProfile] -> ShowS)
-> Show UserProfile
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> UserProfile -> ShowS
showsPrec :: Int -> UserProfile -> ShowS
$cshow :: UserProfile -> String
show :: UserProfile -> String
$cshowList :: [UserProfile] -> ShowS
showList :: [UserProfile] -> ShowS
Show, (forall x. UserProfile -> Rep UserProfile x)
-> (forall x. Rep UserProfile x -> UserProfile)
-> Generic UserProfile
forall x. Rep UserProfile x -> UserProfile
forall x. UserProfile -> Rep UserProfile x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. UserProfile -> Rep UserProfile x
from :: forall x. UserProfile -> Rep UserProfile x
$cto :: forall x. Rep UserProfile x -> UserProfile
to :: forall x. Rep UserProfile x -> UserProfile
Generic)
  deriving (Gen UserProfile
Gen UserProfile
-> (UserProfile -> [UserProfile]) -> Arbitrary UserProfile
UserProfile -> [UserProfile]
forall a. Gen a -> (a -> [a]) -> Arbitrary a
$carbitrary :: Gen UserProfile
arbitrary :: Gen UserProfile
$cshrink :: UserProfile -> [UserProfile]
shrink :: UserProfile -> [UserProfile]
Arbitrary) via (GenericUniform UserProfile)
  deriving (Value -> Parser [UserProfile]
Value -> Parser UserProfile
(Value -> Parser UserProfile)
-> (Value -> Parser [UserProfile]) -> FromJSON UserProfile
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser UserProfile
parseJSON :: Value -> Parser UserProfile
$cparseJSONList :: Value -> Parser [UserProfile]
parseJSONList :: Value -> Parser [UserProfile]
FromJSON, [UserProfile] -> Value
[UserProfile] -> Encoding
UserProfile -> Value
UserProfile -> Encoding
(UserProfile -> Value)
-> (UserProfile -> Encoding)
-> ([UserProfile] -> Value)
-> ([UserProfile] -> Encoding)
-> ToJSON UserProfile
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: UserProfile -> Value
toJSON :: UserProfile -> Value
$ctoEncoding :: UserProfile -> Encoding
toEncoding :: UserProfile -> Encoding
$ctoJSONList :: [UserProfile] -> Value
toJSONList :: [UserProfile] -> Value
$ctoEncodingList :: [UserProfile] -> Encoding
toEncodingList :: [UserProfile] -> Encoding
ToJSON, Typeable UserProfile
Typeable UserProfile =>
(Proxy UserProfile -> Declare (Definitions Schema) NamedSchema)
-> ToSchema UserProfile
Proxy UserProfile -> Declare (Definitions Schema) NamedSchema
forall a.
Typeable a =>
(Proxy a -> Declare (Definitions Schema) NamedSchema) -> ToSchema a
$cdeclareNamedSchema :: Proxy UserProfile -> Declare (Definitions Schema) NamedSchema
declareNamedSchema :: Proxy UserProfile -> Declare (Definitions Schema) NamedSchema
S.ToSchema) via (Schema UserProfile)

instance ToSchema UserProfile where
  schema :: ValueSchema NamedSwaggerDoc UserProfile
schema =
    Text
-> SchemaP SwaggerDoc Object [Pair] UserProfile UserProfile
-> ValueSchema NamedSwaggerDoc UserProfile
forall doc doc' a b.
HasObject doc doc' =>
Text
-> SchemaP doc Object [Pair] a b -> SchemaP doc' Value Value a b
object Text
"UserProfile" (SchemaP SwaggerDoc Object [Pair] UserProfile UserProfile
 -> ValueSchema NamedSwaggerDoc UserProfile)
-> SchemaP SwaggerDoc Object [Pair] UserProfile UserProfile
-> ValueSchema NamedSwaggerDoc UserProfile
forall a b. (a -> b) -> a -> b
$
      Qualified UserId
-> Name
-> Maybe TextStatus
-> Pict
-> [Asset]
-> ColourId
-> Bool
-> Maybe ServiceRef
-> Maybe Handle
-> Maybe UTCTimeMillis
-> Maybe TeamId
-> Maybe EmailAddress
-> UserLegalHoldStatus
-> Set BaseProtocolTag
-> UserProfile
UserProfile
        (Qualified UserId
 -> Name
 -> Maybe TextStatus
 -> Pict
 -> [Asset]
 -> ColourId
 -> Bool
 -> Maybe ServiceRef
 -> Maybe Handle
 -> Maybe UTCTimeMillis
 -> Maybe TeamId
 -> Maybe EmailAddress
 -> UserLegalHoldStatus
 -> Set BaseProtocolTag
 -> UserProfile)
-> SchemaP SwaggerDoc Object [Pair] UserProfile (Qualified UserId)
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     UserProfile
     (Name
      -> Maybe TextStatus
      -> Pict
      -> [Asset]
      -> ColourId
      -> Bool
      -> Maybe ServiceRef
      -> Maybe Handle
      -> Maybe UTCTimeMillis
      -> Maybe TeamId
      -> Maybe EmailAddress
      -> UserLegalHoldStatus
      -> Set BaseProtocolTag
      -> UserProfile)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> UserProfile -> Qualified UserId
profileQualifiedId
          (UserProfile -> Qualified UserId)
-> SchemaP
     SwaggerDoc Object [Pair] (Qualified UserId) (Qualified UserId)
-> SchemaP SwaggerDoc Object [Pair] UserProfile (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_id" SchemaP
  NamedSwaggerDoc Value Value (Qualified UserId) (Qualified UserId)
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema
        SchemaP
  SwaggerDoc
  Object
  [Pair]
  UserProfile
  (Name
   -> Maybe TextStatus
   -> Pict
   -> [Asset]
   -> ColourId
   -> Bool
   -> Maybe ServiceRef
   -> Maybe Handle
   -> Maybe UTCTimeMillis
   -> Maybe TeamId
   -> Maybe EmailAddress
   -> UserLegalHoldStatus
   -> Set BaseProtocolTag
   -> UserProfile)
-> SchemaP SwaggerDoc Object [Pair] UserProfile (Maybe UserId)
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     UserProfile
     (Name
      -> Maybe TextStatus
      -> Pict
      -> [Asset]
      -> ColourId
      -> Bool
      -> Maybe ServiceRef
      -> Maybe Handle
      -> Maybe UTCTimeMillis
      -> Maybe TeamId
      -> Maybe EmailAddress
      -> UserLegalHoldStatus
      -> Set BaseProtocolTag
      -> UserProfile)
forall a b.
SchemaP SwaggerDoc Object [Pair] UserProfile a
-> SchemaP SwaggerDoc Object [Pair] UserProfile b
-> SchemaP SwaggerDoc Object [Pair] UserProfile 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)
-> (UserProfile -> Qualified UserId) -> UserProfile -> UserId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UserProfile -> Qualified UserId
profileQualifiedId)
          (UserProfile -> UserId)
-> SchemaP SwaggerDoc Object [Pair] UserId (Maybe UserId)
-> SchemaP SwaggerDoc Object [Pair] UserProfile (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
-> ValueSchema NamedSwaggerDoc 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
"id" (Text
-> ValueSchema NamedSwaggerDoc UserId
-> ValueSchema NamedSwaggerDoc UserId
forall doc a.
(HasDeprecated doc (Maybe Bool),
 HasDescription doc (Maybe Text)) =>
Text -> ValueSchema doc a -> ValueSchema doc a
deprecatedSchema Text
"qualified_id" ValueSchema NamedSwaggerDoc UserId
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema))
        SchemaP
  SwaggerDoc
  Object
  [Pair]
  UserProfile
  (Name
   -> Maybe TextStatus
   -> Pict
   -> [Asset]
   -> ColourId
   -> Bool
   -> Maybe ServiceRef
   -> Maybe Handle
   -> Maybe UTCTimeMillis
   -> Maybe TeamId
   -> Maybe EmailAddress
   -> UserLegalHoldStatus
   -> Set BaseProtocolTag
   -> UserProfile)
-> SchemaP SwaggerDoc Object [Pair] UserProfile Name
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     UserProfile
     (Maybe TextStatus
      -> Pict
      -> [Asset]
      -> ColourId
      -> Bool
      -> Maybe ServiceRef
      -> Maybe Handle
      -> Maybe UTCTimeMillis
      -> Maybe TeamId
      -> Maybe EmailAddress
      -> UserLegalHoldStatus
      -> Set BaseProtocolTag
      -> UserProfile)
forall a b.
SchemaP SwaggerDoc Object [Pair] UserProfile (a -> b)
-> SchemaP SwaggerDoc Object [Pair] UserProfile a
-> SchemaP SwaggerDoc Object [Pair] UserProfile b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> UserProfile -> Name
profileName
          (UserProfile -> Name)
-> SchemaP SwaggerDoc Object [Pair] Name Name
-> SchemaP SwaggerDoc Object [Pair] UserProfile Name
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= Text
-> SchemaP NamedSwaggerDoc Value Value Name Name
-> SchemaP SwaggerDoc Object [Pair] Name Name
forall doc' doc a b.
HasField doc' doc =>
Text
-> SchemaP doc' Value Value a b -> SchemaP doc Object [Pair] a b
field Text
"name" SchemaP NamedSwaggerDoc Value Value Name Name
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema
        SchemaP
  SwaggerDoc
  Object
  [Pair]
  UserProfile
  (Maybe TextStatus
   -> Pict
   -> [Asset]
   -> ColourId
   -> Bool
   -> Maybe ServiceRef
   -> Maybe Handle
   -> Maybe UTCTimeMillis
   -> Maybe TeamId
   -> Maybe EmailAddress
   -> UserLegalHoldStatus
   -> Set BaseProtocolTag
   -> UserProfile)
-> SchemaP SwaggerDoc Object [Pair] UserProfile (Maybe TextStatus)
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     UserProfile
     (Pict
      -> [Asset]
      -> ColourId
      -> Bool
      -> Maybe ServiceRef
      -> Maybe Handle
      -> Maybe UTCTimeMillis
      -> Maybe TeamId
      -> Maybe EmailAddress
      -> UserLegalHoldStatus
      -> Set BaseProtocolTag
      -> UserProfile)
forall a b.
SchemaP SwaggerDoc Object [Pair] UserProfile (a -> b)
-> SchemaP SwaggerDoc Object [Pair] UserProfile a
-> SchemaP SwaggerDoc Object [Pair] UserProfile b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> UserProfile -> Maybe TextStatus
profileTextStatus
          (UserProfile -> Maybe TextStatus)
-> SchemaP
     SwaggerDoc Object [Pair] (Maybe TextStatus) (Maybe TextStatus)
-> SchemaP SwaggerDoc Object [Pair] UserProfile (Maybe TextStatus)
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= SchemaP SwaggerDoc Object [Pair] TextStatus (Maybe TextStatus)
-> SchemaP
     SwaggerDoc Object [Pair] (Maybe TextStatus) (Maybe TextStatus)
forall w d v a b.
Monoid w =>
SchemaP d v w a b -> SchemaP d v w (Maybe a) b
maybe_ (Text
-> SchemaP NamedSwaggerDoc Value Value TextStatus TextStatus
-> SchemaP SwaggerDoc Object [Pair] TextStatus (Maybe TextStatus)
forall doc doc' a b.
(HasOpt doc, HasField doc' doc) =>
Text
-> SchemaP doc' Value Value a b
-> SchemaP doc Object [Pair] a (Maybe b)
optField Text
"text_status" SchemaP NamedSwaggerDoc Value Value TextStatus TextStatus
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema)
        SchemaP
  SwaggerDoc
  Object
  [Pair]
  UserProfile
  (Pict
   -> [Asset]
   -> ColourId
   -> Bool
   -> Maybe ServiceRef
   -> Maybe Handle
   -> Maybe UTCTimeMillis
   -> Maybe TeamId
   -> Maybe EmailAddress
   -> UserLegalHoldStatus
   -> Set BaseProtocolTag
   -> UserProfile)
-> SchemaP SwaggerDoc Object [Pair] UserProfile Pict
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     UserProfile
     ([Asset]
      -> ColourId
      -> Bool
      -> Maybe ServiceRef
      -> Maybe Handle
      -> Maybe UTCTimeMillis
      -> Maybe TeamId
      -> Maybe EmailAddress
      -> UserLegalHoldStatus
      -> Set BaseProtocolTag
      -> UserProfile)
forall a b.
SchemaP SwaggerDoc Object [Pair] UserProfile (a -> b)
-> SchemaP SwaggerDoc Object [Pair] UserProfile a
-> SchemaP SwaggerDoc Object [Pair] UserProfile b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> UserProfile -> Pict
profilePict
          (UserProfile -> Pict)
-> SchemaP SwaggerDoc Object [Pair] Pict Pict
-> SchemaP SwaggerDoc Object [Pair] UserProfile Pict
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= (Text
-> SchemaP NamedSwaggerDoc Value Value Pict Pict
-> SchemaP SwaggerDoc Object [Pair] Pict Pict
forall doc' doc a b.
HasField doc' doc =>
Text
-> SchemaP doc' Value Value a b -> SchemaP doc Object [Pair] a b
field Text
"picture" SchemaP NamedSwaggerDoc Value Value Pict Pict
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema SchemaP SwaggerDoc Object [Pair] Pict Pict
-> SchemaP SwaggerDoc Object [Pair] Pict Pict
-> SchemaP SwaggerDoc Object [Pair] Pict Pict
forall a.
SchemaP SwaggerDoc Object [Pair] Pict a
-> SchemaP SwaggerDoc Object [Pair] Pict a
-> SchemaP SwaggerDoc Object [Pair] Pict a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Pict -> SchemaP SwaggerDoc Object [Pair] Pict Pict
forall a. a -> SchemaP SwaggerDoc Object [Pair] Pict a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Pict
noPict)
        SchemaP
  SwaggerDoc
  Object
  [Pair]
  UserProfile
  ([Asset]
   -> ColourId
   -> Bool
   -> Maybe ServiceRef
   -> Maybe Handle
   -> Maybe UTCTimeMillis
   -> Maybe TeamId
   -> Maybe EmailAddress
   -> UserLegalHoldStatus
   -> Set BaseProtocolTag
   -> UserProfile)
-> SchemaP SwaggerDoc Object [Pair] UserProfile [Asset]
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     UserProfile
     (ColourId
      -> Bool
      -> Maybe ServiceRef
      -> Maybe Handle
      -> Maybe UTCTimeMillis
      -> Maybe TeamId
      -> Maybe EmailAddress
      -> UserLegalHoldStatus
      -> Set BaseProtocolTag
      -> UserProfile)
forall a b.
SchemaP SwaggerDoc Object [Pair] UserProfile (a -> b)
-> SchemaP SwaggerDoc Object [Pair] UserProfile a
-> SchemaP SwaggerDoc Object [Pair] UserProfile b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> UserProfile -> [Asset]
profileAssets
          (UserProfile -> [Asset])
-> SchemaP SwaggerDoc Object [Pair] [Asset] [Asset]
-> SchemaP SwaggerDoc Object [Pair] UserProfile [Asset]
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= (Text
-> SchemaP SwaggerDoc Value Value [Asset] [Asset]
-> SchemaP SwaggerDoc Object [Pair] [Asset] [Asset]
forall doc' doc a b.
HasField doc' doc =>
Text
-> SchemaP doc' Value Value a b -> SchemaP doc Object [Pair] a b
field Text
"assets" (ValueSchema NamedSwaggerDoc Asset
-> SchemaP SwaggerDoc Value Value [Asset] [Asset]
forall ndoc doc a.
(HasArray ndoc doc, HasName ndoc) =>
ValueSchema ndoc a -> ValueSchema doc [a]
array ValueSchema NamedSwaggerDoc Asset
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema) SchemaP SwaggerDoc Object [Pair] [Asset] [Asset]
-> SchemaP SwaggerDoc Object [Pair] [Asset] [Asset]
-> SchemaP SwaggerDoc Object [Pair] [Asset] [Asset]
forall a.
SchemaP SwaggerDoc Object [Pair] [Asset] a
-> SchemaP SwaggerDoc Object [Pair] [Asset] a
-> SchemaP SwaggerDoc Object [Pair] [Asset] a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> [Asset] -> SchemaP SwaggerDoc Object [Pair] [Asset] [Asset]
forall a. a -> SchemaP SwaggerDoc Object [Pair] [Asset] a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [])
        SchemaP
  SwaggerDoc
  Object
  [Pair]
  UserProfile
  (ColourId
   -> Bool
   -> Maybe ServiceRef
   -> Maybe Handle
   -> Maybe UTCTimeMillis
   -> Maybe TeamId
   -> Maybe EmailAddress
   -> UserLegalHoldStatus
   -> Set BaseProtocolTag
   -> UserProfile)
-> SchemaP SwaggerDoc Object [Pair] UserProfile ColourId
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     UserProfile
     (Bool
      -> Maybe ServiceRef
      -> Maybe Handle
      -> Maybe UTCTimeMillis
      -> Maybe TeamId
      -> Maybe EmailAddress
      -> UserLegalHoldStatus
      -> Set BaseProtocolTag
      -> UserProfile)
forall a b.
SchemaP SwaggerDoc Object [Pair] UserProfile (a -> b)
-> SchemaP SwaggerDoc Object [Pair] UserProfile a
-> SchemaP SwaggerDoc Object [Pair] UserProfile b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> UserProfile -> ColourId
profileAccentId
          (UserProfile -> ColourId)
-> SchemaP SwaggerDoc Object [Pair] ColourId ColourId
-> SchemaP SwaggerDoc Object [Pair] UserProfile ColourId
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= Text
-> SchemaP NamedSwaggerDoc Value Value ColourId ColourId
-> SchemaP SwaggerDoc Object [Pair] ColourId ColourId
forall doc' doc a b.
HasField doc' doc =>
Text
-> SchemaP doc' Value Value a b -> SchemaP doc Object [Pair] a b
field Text
"accent_id" SchemaP NamedSwaggerDoc Value Value ColourId ColourId
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema
        SchemaP
  SwaggerDoc
  Object
  [Pair]
  UserProfile
  (Bool
   -> Maybe ServiceRef
   -> Maybe Handle
   -> Maybe UTCTimeMillis
   -> Maybe TeamId
   -> Maybe EmailAddress
   -> UserLegalHoldStatus
   -> Set BaseProtocolTag
   -> UserProfile)
-> SchemaP SwaggerDoc Object [Pair] UserProfile Bool
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     UserProfile
     (Maybe ServiceRef
      -> Maybe Handle
      -> Maybe UTCTimeMillis
      -> Maybe TeamId
      -> Maybe EmailAddress
      -> UserLegalHoldStatus
      -> Set BaseProtocolTag
      -> UserProfile)
forall a b.
SchemaP SwaggerDoc Object [Pair] UserProfile (a -> b)
-> SchemaP SwaggerDoc Object [Pair] UserProfile a
-> SchemaP SwaggerDoc Object [Pair] UserProfile b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ((\Bool
del -> if Bool
del then Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
True else Maybe Bool
forall a. Maybe a
Nothing) (Bool -> Maybe Bool)
-> (UserProfile -> Bool) -> UserProfile -> Maybe Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UserProfile -> Bool
profileDeleted)
          (UserProfile -> Maybe Bool)
-> SchemaP SwaggerDoc Object [Pair] (Maybe Bool) Bool
-> SchemaP SwaggerDoc Object [Pair] UserProfile Bool
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= SchemaP SwaggerDoc Object [Pair] Bool Bool
-> SchemaP SwaggerDoc Object [Pair] (Maybe Bool) Bool
forall w d v a b.
Monoid w =>
SchemaP d v w a b -> SchemaP d v w (Maybe a) b
maybe_ (Bool -> Maybe Bool -> Bool
forall a. a -> Maybe a -> a
fromMaybe Bool
False (Maybe Bool -> Bool)
-> SchemaP SwaggerDoc Object [Pair] Bool (Maybe Bool)
-> SchemaP SwaggerDoc Object [Pair] Bool Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text
-> SchemaP NamedSwaggerDoc Value Value Bool Bool
-> SchemaP SwaggerDoc Object [Pair] Bool (Maybe Bool)
forall doc doc' a b.
(HasOpt doc, HasField doc' doc) =>
Text
-> SchemaP doc' Value Value a b
-> SchemaP doc Object [Pair] a (Maybe b)
optField Text
"deleted" SchemaP NamedSwaggerDoc Value Value Bool Bool
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema)
        SchemaP
  SwaggerDoc
  Object
  [Pair]
  UserProfile
  (Maybe ServiceRef
   -> Maybe Handle
   -> Maybe UTCTimeMillis
   -> Maybe TeamId
   -> Maybe EmailAddress
   -> UserLegalHoldStatus
   -> Set BaseProtocolTag
   -> UserProfile)
-> SchemaP SwaggerDoc Object [Pair] UserProfile (Maybe ServiceRef)
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     UserProfile
     (Maybe Handle
      -> Maybe UTCTimeMillis
      -> Maybe TeamId
      -> Maybe EmailAddress
      -> UserLegalHoldStatus
      -> Set BaseProtocolTag
      -> UserProfile)
forall a b.
SchemaP SwaggerDoc Object [Pair] UserProfile (a -> b)
-> SchemaP SwaggerDoc Object [Pair] UserProfile a
-> SchemaP SwaggerDoc Object [Pair] UserProfile b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> UserProfile -> Maybe ServiceRef
profileService
          (UserProfile -> Maybe ServiceRef)
-> SchemaP
     SwaggerDoc Object [Pair] (Maybe ServiceRef) (Maybe ServiceRef)
-> SchemaP SwaggerDoc Object [Pair] UserProfile (Maybe ServiceRef)
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= SchemaP SwaggerDoc Object [Pair] ServiceRef (Maybe ServiceRef)
-> SchemaP
     SwaggerDoc Object [Pair] (Maybe ServiceRef) (Maybe ServiceRef)
forall w d v a b.
Monoid w =>
SchemaP d v w a b -> SchemaP d v w (Maybe a) b
maybe_ (Text
-> SchemaP NamedSwaggerDoc Value Value ServiceRef ServiceRef
-> SchemaP SwaggerDoc Object [Pair] ServiceRef (Maybe ServiceRef)
forall doc doc' a b.
(HasOpt doc, HasField doc' doc) =>
Text
-> SchemaP doc' Value Value a b
-> SchemaP doc Object [Pair] a (Maybe b)
optField Text
"service" SchemaP NamedSwaggerDoc Value Value ServiceRef ServiceRef
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema)
        SchemaP
  SwaggerDoc
  Object
  [Pair]
  UserProfile
  (Maybe Handle
   -> Maybe UTCTimeMillis
   -> Maybe TeamId
   -> Maybe EmailAddress
   -> UserLegalHoldStatus
   -> Set BaseProtocolTag
   -> UserProfile)
-> SchemaP SwaggerDoc Object [Pair] UserProfile (Maybe Handle)
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     UserProfile
     (Maybe UTCTimeMillis
      -> Maybe TeamId
      -> Maybe EmailAddress
      -> UserLegalHoldStatus
      -> Set BaseProtocolTag
      -> UserProfile)
forall a b.
SchemaP SwaggerDoc Object [Pair] UserProfile (a -> b)
-> SchemaP SwaggerDoc Object [Pair] UserProfile a
-> SchemaP SwaggerDoc Object [Pair] UserProfile b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> UserProfile -> Maybe Handle
profileHandle
          (UserProfile -> Maybe Handle)
-> SchemaP SwaggerDoc Object [Pair] (Maybe Handle) (Maybe Handle)
-> SchemaP SwaggerDoc Object [Pair] UserProfile (Maybe Handle)
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= SchemaP SwaggerDoc Object [Pair] Handle (Maybe Handle)
-> SchemaP SwaggerDoc Object [Pair] (Maybe Handle) (Maybe Handle)
forall w d v a b.
Monoid w =>
SchemaP d v w a b -> SchemaP d v w (Maybe a) b
maybe_ (Text
-> SchemaP NamedSwaggerDoc Value Value Handle Handle
-> SchemaP SwaggerDoc Object [Pair] Handle (Maybe Handle)
forall doc doc' a b.
(HasOpt doc, HasField doc' doc) =>
Text
-> SchemaP doc' Value Value a b
-> SchemaP doc Object [Pair] a (Maybe b)
optField Text
"handle" SchemaP NamedSwaggerDoc Value Value Handle Handle
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema)
        SchemaP
  SwaggerDoc
  Object
  [Pair]
  UserProfile
  (Maybe UTCTimeMillis
   -> Maybe TeamId
   -> Maybe EmailAddress
   -> UserLegalHoldStatus
   -> Set BaseProtocolTag
   -> UserProfile)
-> SchemaP
     SwaggerDoc Object [Pair] UserProfile (Maybe UTCTimeMillis)
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     UserProfile
     (Maybe TeamId
      -> Maybe EmailAddress
      -> UserLegalHoldStatus
      -> Set BaseProtocolTag
      -> UserProfile)
forall a b.
SchemaP SwaggerDoc Object [Pair] UserProfile (a -> b)
-> SchemaP SwaggerDoc Object [Pair] UserProfile a
-> SchemaP SwaggerDoc Object [Pair] UserProfile b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> UserProfile -> Maybe UTCTimeMillis
profileExpire
          (UserProfile -> Maybe UTCTimeMillis)
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     (Maybe UTCTimeMillis)
     (Maybe UTCTimeMillis)
-> SchemaP
     SwaggerDoc Object [Pair] UserProfile (Maybe UTCTimeMillis)
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= SchemaP
  SwaggerDoc Object [Pair] UTCTimeMillis (Maybe UTCTimeMillis)
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     (Maybe UTCTimeMillis)
     (Maybe UTCTimeMillis)
forall w d v a b.
Monoid w =>
SchemaP d v w a b -> SchemaP d v w (Maybe a) b
maybe_ (Text
-> SchemaP NamedSwaggerDoc Value Value UTCTimeMillis UTCTimeMillis
-> SchemaP
     SwaggerDoc Object [Pair] UTCTimeMillis (Maybe UTCTimeMillis)
forall doc doc' a b.
(HasOpt doc, HasField doc' doc) =>
Text
-> SchemaP doc' Value Value a b
-> SchemaP doc Object [Pair] a (Maybe b)
optField Text
"expires_at" SchemaP NamedSwaggerDoc Value Value UTCTimeMillis UTCTimeMillis
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema)
        SchemaP
  SwaggerDoc
  Object
  [Pair]
  UserProfile
  (Maybe TeamId
   -> Maybe EmailAddress
   -> UserLegalHoldStatus
   -> Set BaseProtocolTag
   -> UserProfile)
-> SchemaP SwaggerDoc Object [Pair] UserProfile (Maybe TeamId)
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     UserProfile
     (Maybe EmailAddress
      -> UserLegalHoldStatus -> Set BaseProtocolTag -> UserProfile)
forall a b.
SchemaP SwaggerDoc Object [Pair] UserProfile (a -> b)
-> SchemaP SwaggerDoc Object [Pair] UserProfile a
-> SchemaP SwaggerDoc Object [Pair] UserProfile b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> UserProfile -> Maybe TeamId
profileTeam
          (UserProfile -> Maybe TeamId)
-> SchemaP SwaggerDoc Object [Pair] (Maybe TeamId) (Maybe TeamId)
-> SchemaP SwaggerDoc Object [Pair] UserProfile (Maybe TeamId)
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= SchemaP SwaggerDoc Object [Pair] TeamId (Maybe TeamId)
-> SchemaP SwaggerDoc Object [Pair] (Maybe TeamId) (Maybe TeamId)
forall w d v a b.
Monoid w =>
SchemaP d v w a b -> SchemaP d v w (Maybe a) b
maybe_ (Text
-> SchemaP NamedSwaggerDoc Value Value TeamId TeamId
-> SchemaP SwaggerDoc Object [Pair] TeamId (Maybe TeamId)
forall doc doc' a b.
(HasOpt doc, HasField doc' doc) =>
Text
-> SchemaP doc' Value Value a b
-> SchemaP doc Object [Pair] a (Maybe b)
optField Text
"team" SchemaP NamedSwaggerDoc Value Value TeamId TeamId
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema)
        SchemaP
  SwaggerDoc
  Object
  [Pair]
  UserProfile
  (Maybe EmailAddress
   -> UserLegalHoldStatus -> Set BaseProtocolTag -> UserProfile)
-> SchemaP
     SwaggerDoc Object [Pair] UserProfile (Maybe EmailAddress)
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     UserProfile
     (UserLegalHoldStatus -> Set BaseProtocolTag -> UserProfile)
forall a b.
SchemaP SwaggerDoc Object [Pair] UserProfile (a -> b)
-> SchemaP SwaggerDoc Object [Pair] UserProfile a
-> SchemaP SwaggerDoc Object [Pair] UserProfile b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> UserProfile -> Maybe EmailAddress
profileEmail
          (UserProfile -> Maybe EmailAddress)
-> SchemaP
     SwaggerDoc Object [Pair] (Maybe EmailAddress) (Maybe EmailAddress)
-> SchemaP
     SwaggerDoc Object [Pair] UserProfile (Maybe EmailAddress)
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= SchemaP SwaggerDoc Object [Pair] EmailAddress (Maybe EmailAddress)
-> SchemaP
     SwaggerDoc Object [Pair] (Maybe EmailAddress) (Maybe EmailAddress)
forall w d v a b.
Monoid w =>
SchemaP d v w a b -> SchemaP d v w (Maybe a) b
maybe_ (Text
-> SchemaP NamedSwaggerDoc Value Value EmailAddress EmailAddress
-> SchemaP
     SwaggerDoc Object [Pair] EmailAddress (Maybe EmailAddress)
forall doc doc' a b.
(HasOpt doc, HasField doc' doc) =>
Text
-> SchemaP doc' Value Value a b
-> SchemaP doc Object [Pair] a (Maybe b)
optField Text
"email" SchemaP NamedSwaggerDoc Value Value EmailAddress EmailAddress
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema)
        SchemaP
  SwaggerDoc
  Object
  [Pair]
  UserProfile
  (UserLegalHoldStatus -> Set BaseProtocolTag -> UserProfile)
-> SchemaP SwaggerDoc Object [Pair] UserProfile UserLegalHoldStatus
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     UserProfile
     (Set BaseProtocolTag -> UserProfile)
forall a b.
SchemaP SwaggerDoc Object [Pair] UserProfile (a -> b)
-> SchemaP SwaggerDoc Object [Pair] UserProfile a
-> SchemaP SwaggerDoc Object [Pair] UserProfile b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> UserProfile -> UserLegalHoldStatus
profileLegalholdStatus
          (UserProfile -> UserLegalHoldStatus)
-> SchemaP
     SwaggerDoc Object [Pair] UserLegalHoldStatus UserLegalHoldStatus
-> SchemaP SwaggerDoc Object [Pair] UserProfile UserLegalHoldStatus
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= Text
-> SchemaP
     NamedSwaggerDoc Value Value UserLegalHoldStatus UserLegalHoldStatus
-> SchemaP
     SwaggerDoc Object [Pair] UserLegalHoldStatus UserLegalHoldStatus
forall doc' doc a b.
HasField doc' doc =>
Text
-> SchemaP doc' Value Value a b -> SchemaP doc Object [Pair] a b
field Text
"legalhold_status" SchemaP
  NamedSwaggerDoc Value Value UserLegalHoldStatus UserLegalHoldStatus
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema
        SchemaP
  SwaggerDoc
  Object
  [Pair]
  UserProfile
  (Set BaseProtocolTag -> UserProfile)
-> SchemaP
     SwaggerDoc Object [Pair] UserProfile (Set BaseProtocolTag)
-> SchemaP SwaggerDoc Object [Pair] UserProfile UserProfile
forall a b.
SchemaP SwaggerDoc Object [Pair] UserProfile (a -> b)
-> SchemaP SwaggerDoc Object [Pair] UserProfile a
-> SchemaP SwaggerDoc Object [Pair] UserProfile b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> UserProfile -> Set BaseProtocolTag
profileSupportedProtocols (UserProfile -> Set BaseProtocolTag)
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     (Set BaseProtocolTag)
     (Set BaseProtocolTag)
-> SchemaP
     SwaggerDoc Object [Pair] UserProfile (Set BaseProtocolTag)
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= SchemaP
  SwaggerDoc
  Object
  [Pair]
  (Set BaseProtocolTag)
  (Set BaseProtocolTag)
supportedProtocolsObjectSchema

--------------------------------------------------------------------------------
-- SelfProfile

-- | A self profile.
newtype SelfProfile = SelfProfile
  { SelfProfile -> User
selfUser :: User
  }
  deriving stock (SelfProfile -> SelfProfile -> Bool
(SelfProfile -> SelfProfile -> Bool)
-> (SelfProfile -> SelfProfile -> Bool) -> Eq SelfProfile
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SelfProfile -> SelfProfile -> Bool
== :: SelfProfile -> SelfProfile -> Bool
$c/= :: SelfProfile -> SelfProfile -> Bool
/= :: SelfProfile -> SelfProfile -> Bool
Eq, Int -> SelfProfile -> ShowS
[SelfProfile] -> ShowS
SelfProfile -> String
(Int -> SelfProfile -> ShowS)
-> (SelfProfile -> String)
-> ([SelfProfile] -> ShowS)
-> Show SelfProfile
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SelfProfile -> ShowS
showsPrec :: Int -> SelfProfile -> ShowS
$cshow :: SelfProfile -> String
show :: SelfProfile -> String
$cshowList :: [SelfProfile] -> ShowS
showList :: [SelfProfile] -> ShowS
Show, (forall x. SelfProfile -> Rep SelfProfile x)
-> (forall x. Rep SelfProfile x -> SelfProfile)
-> Generic SelfProfile
forall x. Rep SelfProfile x -> SelfProfile
forall x. SelfProfile -> Rep SelfProfile x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. SelfProfile -> Rep SelfProfile x
from :: forall x. SelfProfile -> Rep SelfProfile x
$cto :: forall x. Rep SelfProfile x -> SelfProfile
to :: forall x. Rep SelfProfile x -> SelfProfile
Generic)
  deriving (Gen SelfProfile
Gen SelfProfile
-> (SelfProfile -> [SelfProfile]) -> Arbitrary SelfProfile
SelfProfile -> [SelfProfile]
forall a. Gen a -> (a -> [a]) -> Arbitrary a
$carbitrary :: Gen SelfProfile
arbitrary :: Gen SelfProfile
$cshrink :: SelfProfile -> [SelfProfile]
shrink :: SelfProfile -> [SelfProfile]
Arbitrary) via (GenericUniform SelfProfile)
  deriving newtype (Typeable SelfProfile
Typeable SelfProfile =>
(Proxy SelfProfile -> Declare (Definitions Schema) NamedSchema)
-> ToSchema SelfProfile
Proxy SelfProfile -> Declare (Definitions Schema) NamedSchema
forall a.
Typeable a =>
(Proxy a -> Declare (Definitions Schema) NamedSchema) -> ToSchema a
$cdeclareNamedSchema :: Proxy SelfProfile -> Declare (Definitions Schema) NamedSchema
declareNamedSchema :: Proxy SelfProfile -> Declare (Definitions Schema) NamedSchema
S.ToSchema)

instance ToJSON SelfProfile where
  toJSON :: SelfProfile -> Value
toJSON (SelfProfile User
u) = User -> Value
forall a. ToJSON a => a -> Value
toJSON User
u

instance FromJSON SelfProfile where
  parseJSON :: Value -> Parser SelfProfile
parseJSON = String
-> (Object -> Parser SelfProfile) -> Value -> Parser SelfProfile
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"SelfProfile" ((Object -> Parser SelfProfile) -> Value -> Parser SelfProfile)
-> (Object -> Parser SelfProfile) -> Value -> Parser SelfProfile
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    User -> SelfProfile
SelfProfile (User -> SelfProfile) -> Parser User -> Parser SelfProfile
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser User
forall a. FromJSON a => Value -> Parser a
parseJSON (Object -> Value
A.Object Object
o)

--------------------------------------------------------------------------------
-- User
--
-- FUTUREWORK: Move this type somewhere else, it's not part of the client API.

-- | The data of an existing user.
data User = User
  { User -> Qualified UserId
userQualifiedId :: Qualified UserId,
    -- | User identity. For endpoints like @/self@, it will be present in the response iff
    -- the user is activated, and the email/phone contained in it will be guaranteedly
    -- verified. {#RefActivation}
    User -> Maybe UserIdentity
userIdentity :: Maybe UserIdentity,
    User -> Maybe EmailAddress
userEmailUnvalidated :: Maybe EmailAddress,
    -- | required; non-unique
    User -> Name
userDisplayName :: Name,
    -- | text status
    User -> Maybe TextStatus
userTextStatus :: Maybe TextStatus,
    -- | DEPRECATED
    User -> Pict
userPict :: Pict,
    User -> [Asset]
userAssets :: [Asset],
    User -> ColourId
userAccentId :: ColourId,
    User -> AccountStatus
userStatus :: AccountStatus,
    User -> Locale
userLocale :: Locale,
    -- | Set if the user represents an external service,
    -- i.e. it is a "bot".
    User -> Maybe ServiceRef
userService :: Maybe ServiceRef,
    -- | not required; must be unique if present
    User -> Maybe Handle
userHandle :: Maybe Handle,
    -- | Set if the user is ephemeral
    User -> Maybe UTCTimeMillis
userExpire :: Maybe UTCTimeMillis,
    -- | Set if the user is part of a binding team
    User -> Maybe TeamId
userTeam :: Maybe TeamId,
    -- | How is the user profile managed (e.g. if it's via SCIM then the user profile
    -- can't be edited via normal means)
    User -> ManagedBy
userManagedBy :: ManagedBy,
    User -> Set BaseProtocolTag
userSupportedProtocols :: Set BaseProtocolTag
  }
  deriving stock (User -> User -> Bool
(User -> User -> Bool) -> (User -> User -> Bool) -> Eq User
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: User -> User -> Bool
== :: User -> User -> Bool
$c/= :: User -> User -> Bool
/= :: User -> User -> Bool
Eq, Eq User
Eq User =>
(User -> User -> Ordering)
-> (User -> User -> Bool)
-> (User -> User -> Bool)
-> (User -> User -> Bool)
-> (User -> User -> Bool)
-> (User -> User -> User)
-> (User -> User -> User)
-> Ord User
User -> User -> Bool
User -> User -> Ordering
User -> User -> User
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 :: User -> User -> Ordering
compare :: User -> User -> Ordering
$c< :: User -> User -> Bool
< :: User -> User -> Bool
$c<= :: User -> User -> Bool
<= :: User -> User -> Bool
$c> :: User -> User -> Bool
> :: User -> User -> Bool
$c>= :: User -> User -> Bool
>= :: User -> User -> Bool
$cmax :: User -> User -> User
max :: User -> User -> User
$cmin :: User -> User -> User
min :: User -> User -> User
Ord, Int -> User -> ShowS
[User] -> ShowS
User -> String
(Int -> User -> ShowS)
-> (User -> String) -> ([User] -> ShowS) -> Show User
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> User -> ShowS
showsPrec :: Int -> User -> ShowS
$cshow :: User -> String
show :: User -> String
$cshowList :: [User] -> ShowS
showList :: [User] -> ShowS
Show, (forall x. User -> Rep User x)
-> (forall x. Rep User x -> User) -> Generic User
forall x. Rep User x -> User
forall x. User -> Rep User x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. User -> Rep User x
from :: forall x. User -> Rep User x
$cto :: forall x. Rep User x -> User
to :: forall x. Rep User x -> User
Generic)
  deriving (Gen User
Gen User -> (User -> [User]) -> Arbitrary User
User -> [User]
forall a. Gen a -> (a -> [a]) -> Arbitrary a
$carbitrary :: Gen User
arbitrary :: Gen User
$cshrink :: User -> [User]
shrink :: User -> [User]
Arbitrary) via (GenericUniform User)
  deriving ([User] -> Value
[User] -> Encoding
User -> Value
User -> Encoding
(User -> Value)
-> (User -> Encoding)
-> ([User] -> Value)
-> ([User] -> Encoding)
-> ToJSON User
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: User -> Value
toJSON :: User -> Value
$ctoEncoding :: User -> Encoding
toEncoding :: User -> Encoding
$ctoJSONList :: [User] -> Value
toJSONList :: [User] -> Value
$ctoEncodingList :: [User] -> Encoding
toEncodingList :: [User] -> Encoding
ToJSON, Value -> Parser [User]
Value -> Parser User
(Value -> Parser User) -> (Value -> Parser [User]) -> FromJSON User
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser User
parseJSON :: Value -> Parser User
$cparseJSONList :: Value -> Parser [User]
parseJSONList :: Value -> Parser [User]
FromJSON, Typeable User
Typeable User =>
(Proxy User -> Declare (Definitions Schema) NamedSchema)
-> ToSchema User
Proxy User -> Declare (Definitions Schema) NamedSchema
forall a.
Typeable a =>
(Proxy a -> Declare (Definitions Schema) NamedSchema) -> ToSchema a
$cdeclareNamedSchema :: Proxy User -> Declare (Definitions Schema) NamedSchema
declareNamedSchema :: Proxy User -> Declare (Definitions Schema) NamedSchema
S.ToSchema) via (Schema User)

isSamlUser :: User -> Bool
isSamlUser :: User -> Bool
isSamlUser User
usr = do
  case User
usr.userIdentity of
    Just (SSOIdentity (UserSSOId UserRef
_) Maybe EmailAddress
_) -> Bool
True
    Maybe UserIdentity
_ -> Bool
False

userId :: User -> UserId
userId :: User -> UserId
userId = Qualified UserId -> UserId
forall a. Qualified a -> a
qUnqualified (Qualified UserId -> UserId)
-> (User -> Qualified UserId) -> User -> UserId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. User -> Qualified UserId
userQualifiedId

userDeleted :: User -> Bool
userDeleted :: User -> Bool
userDeleted User
u = User -> AccountStatus
userStatus User
u AccountStatus -> AccountStatus -> Bool
forall a. Eq a => a -> a -> Bool
== AccountStatus
Deleted

-- -- FUTUREWORK:
-- -- disentangle json serializations for 'User', 'NewUser', 'UserIdentity', 'NewUserOrigin'.
instance ToSchema User where
  schema :: ValueSchema NamedSwaggerDoc User
schema = Text
-> SchemaP SwaggerDoc Object [Pair] User User
-> ValueSchema NamedSwaggerDoc User
forall doc doc' a b.
HasObject doc doc' =>
Text
-> SchemaP doc Object [Pair] a b -> SchemaP doc' Value Value a b
object Text
"User" SchemaP SwaggerDoc Object [Pair] User User
userObjectSchema

userObjectSchema :: ObjectSchema SwaggerDoc User
userObjectSchema :: SchemaP SwaggerDoc Object [Pair] User User
userObjectSchema =
  Qualified UserId
-> Maybe UserIdentity
-> Maybe EmailAddress
-> Name
-> Maybe TextStatus
-> Pict
-> [Asset]
-> ColourId
-> AccountStatus
-> Locale
-> Maybe ServiceRef
-> Maybe Handle
-> Maybe UTCTimeMillis
-> Maybe TeamId
-> ManagedBy
-> Set BaseProtocolTag
-> User
User
    (Qualified UserId
 -> Maybe UserIdentity
 -> Maybe EmailAddress
 -> Name
 -> Maybe TextStatus
 -> Pict
 -> [Asset]
 -> ColourId
 -> AccountStatus
 -> Locale
 -> Maybe ServiceRef
 -> Maybe Handle
 -> Maybe UTCTimeMillis
 -> Maybe TeamId
 -> ManagedBy
 -> Set BaseProtocolTag
 -> User)
-> SchemaP SwaggerDoc Object [Pair] User (Qualified UserId)
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     User
     (Maybe UserIdentity
      -> Maybe EmailAddress
      -> Name
      -> Maybe TextStatus
      -> Pict
      -> [Asset]
      -> ColourId
      -> AccountStatus
      -> Locale
      -> Maybe ServiceRef
      -> Maybe Handle
      -> Maybe UTCTimeMillis
      -> Maybe TeamId
      -> ManagedBy
      -> Set BaseProtocolTag
      -> User)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> User -> Qualified UserId
userQualifiedId
      (User -> Qualified UserId)
-> SchemaP
     SwaggerDoc Object [Pair] (Qualified UserId) (Qualified UserId)
-> SchemaP SwaggerDoc Object [Pair] User (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_id" SchemaP
  NamedSwaggerDoc Value Value (Qualified UserId) (Qualified UserId)
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema
    SchemaP
  SwaggerDoc
  Object
  [Pair]
  User
  (Maybe UserIdentity
   -> Maybe EmailAddress
   -> Name
   -> Maybe TextStatus
   -> Pict
   -> [Asset]
   -> ColourId
   -> AccountStatus
   -> Locale
   -> Maybe ServiceRef
   -> Maybe Handle
   -> Maybe UTCTimeMillis
   -> Maybe TeamId
   -> ManagedBy
   -> Set BaseProtocolTag
   -> User)
-> SchemaP SwaggerDoc Object [Pair] User (Maybe UserId)
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     User
     (Maybe UserIdentity
      -> Maybe EmailAddress
      -> Name
      -> Maybe TextStatus
      -> Pict
      -> [Asset]
      -> ColourId
      -> AccountStatus
      -> Locale
      -> Maybe ServiceRef
      -> Maybe Handle
      -> Maybe UTCTimeMillis
      -> Maybe TeamId
      -> ManagedBy
      -> Set BaseProtocolTag
      -> User)
forall a b.
SchemaP SwaggerDoc Object [Pair] User a
-> SchemaP SwaggerDoc Object [Pair] User b
-> SchemaP SwaggerDoc Object [Pair] User a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* User -> UserId
userId
      (User -> UserId)
-> SchemaP SwaggerDoc Object [Pair] UserId (Maybe UserId)
-> SchemaP SwaggerDoc Object [Pair] User (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
-> ValueSchema NamedSwaggerDoc 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
"id" (Text
-> ValueSchema NamedSwaggerDoc UserId
-> ValueSchema NamedSwaggerDoc UserId
forall doc a.
(HasDeprecated doc (Maybe Bool),
 HasDescription doc (Maybe Text)) =>
Text -> ValueSchema doc a -> ValueSchema doc a
deprecatedSchema Text
"qualified_id" ValueSchema NamedSwaggerDoc UserId
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema))
    SchemaP
  SwaggerDoc
  Object
  [Pair]
  User
  (Maybe UserIdentity
   -> Maybe EmailAddress
   -> Name
   -> Maybe TextStatus
   -> Pict
   -> [Asset]
   -> ColourId
   -> AccountStatus
   -> Locale
   -> Maybe ServiceRef
   -> Maybe Handle
   -> Maybe UTCTimeMillis
   -> Maybe TeamId
   -> ManagedBy
   -> Set BaseProtocolTag
   -> User)
-> SchemaP SwaggerDoc Object [Pair] User (Maybe UserIdentity)
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     User
     (Maybe EmailAddress
      -> Name
      -> Maybe TextStatus
      -> Pict
      -> [Asset]
      -> ColourId
      -> AccountStatus
      -> Locale
      -> Maybe ServiceRef
      -> Maybe Handle
      -> Maybe UTCTimeMillis
      -> Maybe TeamId
      -> ManagedBy
      -> Set BaseProtocolTag
      -> User)
forall a b.
SchemaP SwaggerDoc Object [Pair] User (a -> b)
-> SchemaP SwaggerDoc Object [Pair] User a
-> SchemaP SwaggerDoc Object [Pair] User b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> User -> Maybe UserIdentity
userIdentity (User -> Maybe UserIdentity)
-> SchemaP
     SwaggerDoc Object [Pair] (Maybe UserIdentity) (Maybe UserIdentity)
-> SchemaP SwaggerDoc Object [Pair] User (Maybe UserIdentity)
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= SchemaP
  SwaggerDoc Object [Pair] (Maybe UserIdentity) (Maybe UserIdentity)
maybeUserIdentityObjectSchema
    SchemaP
  SwaggerDoc
  Object
  [Pair]
  User
  (Maybe EmailAddress
   -> Name
   -> Maybe TextStatus
   -> Pict
   -> [Asset]
   -> ColourId
   -> AccountStatus
   -> Locale
   -> Maybe ServiceRef
   -> Maybe Handle
   -> Maybe UTCTimeMillis
   -> Maybe TeamId
   -> ManagedBy
   -> Set BaseProtocolTag
   -> User)
-> SchemaP SwaggerDoc Object [Pair] User (Maybe EmailAddress)
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     User
     (Name
      -> Maybe TextStatus
      -> Pict
      -> [Asset]
      -> ColourId
      -> AccountStatus
      -> Locale
      -> Maybe ServiceRef
      -> Maybe Handle
      -> Maybe UTCTimeMillis
      -> Maybe TeamId
      -> ManagedBy
      -> Set BaseProtocolTag
      -> User)
forall a b.
SchemaP SwaggerDoc Object [Pair] User (a -> b)
-> SchemaP SwaggerDoc Object [Pair] User a
-> SchemaP SwaggerDoc Object [Pair] User b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> User -> Maybe EmailAddress
userEmailUnvalidated (User -> Maybe EmailAddress)
-> SchemaP
     SwaggerDoc Object [Pair] (Maybe EmailAddress) (Maybe EmailAddress)
-> SchemaP SwaggerDoc Object [Pair] User (Maybe EmailAddress)
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= SchemaP SwaggerDoc Object [Pair] EmailAddress (Maybe EmailAddress)
-> SchemaP
     SwaggerDoc Object [Pair] (Maybe EmailAddress) (Maybe EmailAddress)
forall w d v a b.
Monoid w =>
SchemaP d v w a b -> SchemaP d v w (Maybe a) b
maybe_ (Text
-> SchemaP NamedSwaggerDoc Value Value EmailAddress EmailAddress
-> SchemaP
     SwaggerDoc Object [Pair] EmailAddress (Maybe EmailAddress)
forall doc doc' a b.
(HasOpt doc, HasField doc' doc) =>
Text
-> SchemaP doc' Value Value a b
-> SchemaP doc Object [Pair] a (Maybe b)
optField Text
"email_unvalidated" SchemaP NamedSwaggerDoc Value Value EmailAddress EmailAddress
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema)
    SchemaP
  SwaggerDoc
  Object
  [Pair]
  User
  (Name
   -> Maybe TextStatus
   -> Pict
   -> [Asset]
   -> ColourId
   -> AccountStatus
   -> Locale
   -> Maybe ServiceRef
   -> Maybe Handle
   -> Maybe UTCTimeMillis
   -> Maybe TeamId
   -> ManagedBy
   -> Set BaseProtocolTag
   -> User)
-> SchemaP SwaggerDoc Object [Pair] User Name
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     User
     (Maybe TextStatus
      -> Pict
      -> [Asset]
      -> ColourId
      -> AccountStatus
      -> Locale
      -> Maybe ServiceRef
      -> Maybe Handle
      -> Maybe UTCTimeMillis
      -> Maybe TeamId
      -> ManagedBy
      -> Set BaseProtocolTag
      -> User)
forall a b.
SchemaP SwaggerDoc Object [Pair] User (a -> b)
-> SchemaP SwaggerDoc Object [Pair] User a
-> SchemaP SwaggerDoc Object [Pair] User b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> User -> Name
userDisplayName
      (User -> Name)
-> SchemaP SwaggerDoc Object [Pair] Name Name
-> SchemaP SwaggerDoc Object [Pair] User Name
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= Text
-> SchemaP NamedSwaggerDoc Value Value Name Name
-> SchemaP SwaggerDoc Object [Pair] Name Name
forall doc' doc a b.
HasField doc' doc =>
Text
-> SchemaP doc' Value Value a b -> SchemaP doc Object [Pair] a b
field Text
"name" SchemaP NamedSwaggerDoc Value Value Name Name
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema
    SchemaP
  SwaggerDoc
  Object
  [Pair]
  User
  (Maybe TextStatus
   -> Pict
   -> [Asset]
   -> ColourId
   -> AccountStatus
   -> Locale
   -> Maybe ServiceRef
   -> Maybe Handle
   -> Maybe UTCTimeMillis
   -> Maybe TeamId
   -> ManagedBy
   -> Set BaseProtocolTag
   -> User)
-> SchemaP SwaggerDoc Object [Pair] User (Maybe TextStatus)
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     User
     (Pict
      -> [Asset]
      -> ColourId
      -> AccountStatus
      -> Locale
      -> Maybe ServiceRef
      -> Maybe Handle
      -> Maybe UTCTimeMillis
      -> Maybe TeamId
      -> ManagedBy
      -> Set BaseProtocolTag
      -> User)
forall a b.
SchemaP SwaggerDoc Object [Pair] User (a -> b)
-> SchemaP SwaggerDoc Object [Pair] User a
-> SchemaP SwaggerDoc Object [Pair] User b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> User -> Maybe TextStatus
userTextStatus
      (User -> Maybe TextStatus)
-> SchemaP
     SwaggerDoc Object [Pair] (Maybe TextStatus) (Maybe TextStatus)
-> SchemaP SwaggerDoc Object [Pair] User (Maybe TextStatus)
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= SchemaP SwaggerDoc Object [Pair] TextStatus (Maybe TextStatus)
-> SchemaP
     SwaggerDoc Object [Pair] (Maybe TextStatus) (Maybe TextStatus)
forall w d v a b.
Monoid w =>
SchemaP d v w a b -> SchemaP d v w (Maybe a) b
maybe_ (Text
-> SchemaP NamedSwaggerDoc Value Value TextStatus TextStatus
-> SchemaP SwaggerDoc Object [Pair] TextStatus (Maybe TextStatus)
forall doc doc' a b.
(HasOpt doc, HasField doc' doc) =>
Text
-> SchemaP doc' Value Value a b
-> SchemaP doc Object [Pair] a (Maybe b)
optField Text
"text_status" SchemaP NamedSwaggerDoc Value Value TextStatus TextStatus
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema)
    SchemaP
  SwaggerDoc
  Object
  [Pair]
  User
  (Pict
   -> [Asset]
   -> ColourId
   -> AccountStatus
   -> Locale
   -> Maybe ServiceRef
   -> Maybe Handle
   -> Maybe UTCTimeMillis
   -> Maybe TeamId
   -> ManagedBy
   -> Set BaseProtocolTag
   -> User)
-> SchemaP SwaggerDoc Object [Pair] User Pict
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     User
     ([Asset]
      -> ColourId
      -> AccountStatus
      -> Locale
      -> Maybe ServiceRef
      -> Maybe Handle
      -> Maybe UTCTimeMillis
      -> Maybe TeamId
      -> ManagedBy
      -> Set BaseProtocolTag
      -> User)
forall a b.
SchemaP SwaggerDoc Object [Pair] User (a -> b)
-> SchemaP SwaggerDoc Object [Pair] User a
-> SchemaP SwaggerDoc Object [Pair] User b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> User -> Pict
userPict
      (User -> Pict)
-> SchemaP SwaggerDoc Object [Pair] Pict Pict
-> SchemaP SwaggerDoc Object [Pair] User Pict
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= (Pict -> Maybe Pict -> Pict
forall a. a -> Maybe a -> a
fromMaybe Pict
noPict (Maybe Pict -> Pict)
-> SchemaP SwaggerDoc Object [Pair] Pict (Maybe Pict)
-> SchemaP SwaggerDoc Object [Pair] Pict Pict
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text
-> SchemaP NamedSwaggerDoc Value Value Pict Pict
-> SchemaP SwaggerDoc Object [Pair] Pict (Maybe Pict)
forall doc doc' a b.
(HasOpt doc, HasField doc' doc) =>
Text
-> SchemaP doc' Value Value a b
-> SchemaP doc Object [Pair] a (Maybe b)
optField Text
"picture" SchemaP NamedSwaggerDoc Value Value Pict Pict
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema)
    SchemaP
  SwaggerDoc
  Object
  [Pair]
  User
  ([Asset]
   -> ColourId
   -> AccountStatus
   -> Locale
   -> Maybe ServiceRef
   -> Maybe Handle
   -> Maybe UTCTimeMillis
   -> Maybe TeamId
   -> ManagedBy
   -> Set BaseProtocolTag
   -> User)
-> SchemaP SwaggerDoc Object [Pair] User [Asset]
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     User
     (ColourId
      -> AccountStatus
      -> Locale
      -> Maybe ServiceRef
      -> Maybe Handle
      -> Maybe UTCTimeMillis
      -> Maybe TeamId
      -> ManagedBy
      -> Set BaseProtocolTag
      -> User)
forall a b.
SchemaP SwaggerDoc Object [Pair] User (a -> b)
-> SchemaP SwaggerDoc Object [Pair] User a
-> SchemaP SwaggerDoc Object [Pair] User b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> User -> [Asset]
userAssets
      (User -> [Asset])
-> SchemaP SwaggerDoc Object [Pair] [Asset] [Asset]
-> SchemaP SwaggerDoc Object [Pair] User [Asset]
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= ([Asset] -> Maybe [Asset] -> [Asset]
forall a. a -> Maybe a -> a
fromMaybe [] (Maybe [Asset] -> [Asset])
-> SchemaP SwaggerDoc Object [Pair] [Asset] (Maybe [Asset])
-> SchemaP SwaggerDoc Object [Pair] [Asset] [Asset]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text
-> SchemaP SwaggerDoc Value Value [Asset] [Asset]
-> SchemaP SwaggerDoc Object [Pair] [Asset] (Maybe [Asset])
forall doc doc' a b.
(HasOpt doc, HasField doc' doc) =>
Text
-> SchemaP doc' Value Value a b
-> SchemaP doc Object [Pair] a (Maybe b)
optField Text
"assets" (ValueSchema NamedSwaggerDoc Asset
-> SchemaP SwaggerDoc Value Value [Asset] [Asset]
forall ndoc doc a.
(HasArray ndoc doc, HasName ndoc) =>
ValueSchema ndoc a -> ValueSchema doc [a]
array ValueSchema NamedSwaggerDoc Asset
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema))
    SchemaP
  SwaggerDoc
  Object
  [Pair]
  User
  (ColourId
   -> AccountStatus
   -> Locale
   -> Maybe ServiceRef
   -> Maybe Handle
   -> Maybe UTCTimeMillis
   -> Maybe TeamId
   -> ManagedBy
   -> Set BaseProtocolTag
   -> User)
-> SchemaP SwaggerDoc Object [Pair] User ColourId
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     User
     (AccountStatus
      -> Locale
      -> Maybe ServiceRef
      -> Maybe Handle
      -> Maybe UTCTimeMillis
      -> Maybe TeamId
      -> ManagedBy
      -> Set BaseProtocolTag
      -> User)
forall a b.
SchemaP SwaggerDoc Object [Pair] User (a -> b)
-> SchemaP SwaggerDoc Object [Pair] User a
-> SchemaP SwaggerDoc Object [Pair] User b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> User -> ColourId
userAccentId (User -> ColourId)
-> SchemaP SwaggerDoc Object [Pair] ColourId ColourId
-> SchemaP SwaggerDoc Object [Pair] User ColourId
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= Text
-> SchemaP NamedSwaggerDoc Value Value ColourId ColourId
-> SchemaP SwaggerDoc Object [Pair] ColourId ColourId
forall doc' doc a b.
HasField doc' doc =>
Text
-> SchemaP doc' Value Value a b -> SchemaP doc Object [Pair] a b
field Text
"accent_id" SchemaP NamedSwaggerDoc Value Value ColourId ColourId
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema
    SchemaP
  SwaggerDoc
  Object
  [Pair]
  User
  (AccountStatus
   -> Locale
   -> Maybe ServiceRef
   -> Maybe Handle
   -> Maybe UTCTimeMillis
   -> Maybe TeamId
   -> ManagedBy
   -> Set BaseProtocolTag
   -> User)
-> SchemaP SwaggerDoc Object [Pair] User AccountStatus
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     User
     (Locale
      -> Maybe ServiceRef
      -> Maybe Handle
      -> Maybe UTCTimeMillis
      -> Maybe TeamId
      -> ManagedBy
      -> Set BaseProtocolTag
      -> User)
forall a b.
SchemaP SwaggerDoc Object [Pair] User (a -> b)
-> SchemaP SwaggerDoc Object [Pair] User a
-> SchemaP SwaggerDoc Object [Pair] User b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> User -> AccountStatus
userStatus (User -> AccountStatus)
-> SchemaP SwaggerDoc Object [Pair] AccountStatus AccountStatus
-> SchemaP SwaggerDoc Object [Pair] User AccountStatus
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= Text
-> SchemaP NamedSwaggerDoc Value Value AccountStatus AccountStatus
-> SchemaP SwaggerDoc Object [Pair] AccountStatus AccountStatus
forall doc' doc a b.
HasField doc' doc =>
Text
-> SchemaP doc' Value Value a b -> SchemaP doc Object [Pair] a b
field Text
"status" SchemaP NamedSwaggerDoc Value Value AccountStatus AccountStatus
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema
    SchemaP
  SwaggerDoc
  Object
  [Pair]
  User
  (Locale
   -> Maybe ServiceRef
   -> Maybe Handle
   -> Maybe UTCTimeMillis
   -> Maybe TeamId
   -> ManagedBy
   -> Set BaseProtocolTag
   -> User)
-> SchemaP SwaggerDoc Object [Pair] User Locale
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     User
     (Maybe ServiceRef
      -> Maybe Handle
      -> Maybe UTCTimeMillis
      -> Maybe TeamId
      -> ManagedBy
      -> Set BaseProtocolTag
      -> User)
forall a b.
SchemaP SwaggerDoc Object [Pair] User (a -> b)
-> SchemaP SwaggerDoc Object [Pair] User a
-> SchemaP SwaggerDoc Object [Pair] User b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> User -> Locale
userLocale (User -> Locale)
-> SchemaP SwaggerDoc Object [Pair] Locale Locale
-> SchemaP SwaggerDoc Object [Pair] User Locale
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= Text
-> SchemaP NamedSwaggerDoc Value Value Locale Locale
-> SchemaP SwaggerDoc Object [Pair] Locale Locale
forall doc' doc a b.
HasField doc' doc =>
Text
-> SchemaP doc' Value Value a b -> SchemaP doc Object [Pair] a b
field Text
"locale" SchemaP NamedSwaggerDoc Value Value Locale Locale
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema
    SchemaP
  SwaggerDoc
  Object
  [Pair]
  User
  (Maybe ServiceRef
   -> Maybe Handle
   -> Maybe UTCTimeMillis
   -> Maybe TeamId
   -> ManagedBy
   -> Set BaseProtocolTag
   -> User)
-> SchemaP SwaggerDoc Object [Pair] User (Maybe ServiceRef)
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     User
     (Maybe Handle
      -> Maybe UTCTimeMillis
      -> Maybe TeamId
      -> ManagedBy
      -> Set BaseProtocolTag
      -> User)
forall a b.
SchemaP SwaggerDoc Object [Pair] User (a -> b)
-> SchemaP SwaggerDoc Object [Pair] User a
-> SchemaP SwaggerDoc Object [Pair] User b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> User -> Maybe ServiceRef
userService (User -> Maybe ServiceRef)
-> SchemaP
     SwaggerDoc Object [Pair] (Maybe ServiceRef) (Maybe ServiceRef)
-> SchemaP SwaggerDoc Object [Pair] User (Maybe ServiceRef)
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= SchemaP SwaggerDoc Object [Pair] ServiceRef (Maybe ServiceRef)
-> SchemaP
     SwaggerDoc Object [Pair] (Maybe ServiceRef) (Maybe ServiceRef)
forall w d v a b.
Monoid w =>
SchemaP d v w a b -> SchemaP d v w (Maybe a) b
maybe_ (Text
-> SchemaP NamedSwaggerDoc Value Value ServiceRef ServiceRef
-> SchemaP SwaggerDoc Object [Pair] ServiceRef (Maybe ServiceRef)
forall doc doc' a b.
(HasOpt doc, HasField doc' doc) =>
Text
-> SchemaP doc' Value Value a b
-> SchemaP doc Object [Pair] a (Maybe b)
optField Text
"service" SchemaP NamedSwaggerDoc Value Value ServiceRef ServiceRef
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema)
    SchemaP
  SwaggerDoc
  Object
  [Pair]
  User
  (Maybe Handle
   -> Maybe UTCTimeMillis
   -> Maybe TeamId
   -> ManagedBy
   -> Set BaseProtocolTag
   -> User)
-> SchemaP SwaggerDoc Object [Pair] User (Maybe Handle)
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     User
     (Maybe UTCTimeMillis
      -> Maybe TeamId -> ManagedBy -> Set BaseProtocolTag -> User)
forall a b.
SchemaP SwaggerDoc Object [Pair] User (a -> b)
-> SchemaP SwaggerDoc Object [Pair] User a
-> SchemaP SwaggerDoc Object [Pair] User b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> User -> Maybe Handle
userHandle (User -> Maybe Handle)
-> SchemaP SwaggerDoc Object [Pair] (Maybe Handle) (Maybe Handle)
-> SchemaP SwaggerDoc Object [Pair] User (Maybe Handle)
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= SchemaP SwaggerDoc Object [Pair] Handle (Maybe Handle)
-> SchemaP SwaggerDoc Object [Pair] (Maybe Handle) (Maybe Handle)
forall w d v a b.
Monoid w =>
SchemaP d v w a b -> SchemaP d v w (Maybe a) b
maybe_ (Text
-> SchemaP NamedSwaggerDoc Value Value Handle Handle
-> SchemaP SwaggerDoc Object [Pair] Handle (Maybe Handle)
forall doc doc' a b.
(HasOpt doc, HasField doc' doc) =>
Text
-> SchemaP doc' Value Value a b
-> SchemaP doc Object [Pair] a (Maybe b)
optField Text
"handle" SchemaP NamedSwaggerDoc Value Value Handle Handle
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema)
    SchemaP
  SwaggerDoc
  Object
  [Pair]
  User
  (Maybe UTCTimeMillis
   -> Maybe TeamId -> ManagedBy -> Set BaseProtocolTag -> User)
-> SchemaP SwaggerDoc Object [Pair] User (Maybe UTCTimeMillis)
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     User
     (Maybe TeamId -> ManagedBy -> Set BaseProtocolTag -> User)
forall a b.
SchemaP SwaggerDoc Object [Pair] User (a -> b)
-> SchemaP SwaggerDoc Object [Pair] User a
-> SchemaP SwaggerDoc Object [Pair] User b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> User -> Maybe UTCTimeMillis
userExpire (User -> Maybe UTCTimeMillis)
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     (Maybe UTCTimeMillis)
     (Maybe UTCTimeMillis)
-> SchemaP SwaggerDoc Object [Pair] User (Maybe UTCTimeMillis)
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= SchemaP
  SwaggerDoc Object [Pair] UTCTimeMillis (Maybe UTCTimeMillis)
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     (Maybe UTCTimeMillis)
     (Maybe UTCTimeMillis)
forall w d v a b.
Monoid w =>
SchemaP d v w a b -> SchemaP d v w (Maybe a) b
maybe_ (Text
-> SchemaP NamedSwaggerDoc Value Value UTCTimeMillis UTCTimeMillis
-> SchemaP
     SwaggerDoc Object [Pair] UTCTimeMillis (Maybe UTCTimeMillis)
forall doc doc' a b.
(HasOpt doc, HasField doc' doc) =>
Text
-> SchemaP doc' Value Value a b
-> SchemaP doc Object [Pair] a (Maybe b)
optField Text
"expires_at" SchemaP NamedSwaggerDoc Value Value UTCTimeMillis UTCTimeMillis
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema)
    SchemaP
  SwaggerDoc
  Object
  [Pair]
  User
  (Maybe TeamId -> ManagedBy -> Set BaseProtocolTag -> User)
-> SchemaP SwaggerDoc Object [Pair] User (Maybe TeamId)
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     User
     (ManagedBy -> Set BaseProtocolTag -> User)
forall a b.
SchemaP SwaggerDoc Object [Pair] User (a -> b)
-> SchemaP SwaggerDoc Object [Pair] User a
-> SchemaP SwaggerDoc Object [Pair] User b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> User -> Maybe TeamId
userTeam (User -> Maybe TeamId)
-> SchemaP SwaggerDoc Object [Pair] (Maybe TeamId) (Maybe TeamId)
-> SchemaP SwaggerDoc Object [Pair] User (Maybe TeamId)
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= SchemaP SwaggerDoc Object [Pair] TeamId (Maybe TeamId)
-> SchemaP SwaggerDoc Object [Pair] (Maybe TeamId) (Maybe TeamId)
forall w d v a b.
Monoid w =>
SchemaP d v w a b -> SchemaP d v w (Maybe a) b
maybe_ (Text
-> SchemaP NamedSwaggerDoc Value Value TeamId TeamId
-> SchemaP SwaggerDoc Object [Pair] TeamId (Maybe TeamId)
forall doc doc' a b.
(HasOpt doc, HasField doc' doc) =>
Text
-> SchemaP doc' Value Value a b
-> SchemaP doc Object [Pair] a (Maybe b)
optField Text
"team" SchemaP NamedSwaggerDoc Value Value TeamId TeamId
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema)
    SchemaP
  SwaggerDoc
  Object
  [Pair]
  User
  (ManagedBy -> Set BaseProtocolTag -> User)
-> SchemaP SwaggerDoc Object [Pair] User ManagedBy
-> SchemaP
     SwaggerDoc Object [Pair] User (Set BaseProtocolTag -> User)
forall a b.
SchemaP SwaggerDoc Object [Pair] User (a -> b)
-> SchemaP SwaggerDoc Object [Pair] User a
-> SchemaP SwaggerDoc Object [Pair] User b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> User -> ManagedBy
userManagedBy
      (User -> ManagedBy)
-> SchemaP SwaggerDoc Object [Pair] ManagedBy ManagedBy
-> SchemaP SwaggerDoc Object [Pair] User ManagedBy
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= (ManagedBy -> Maybe ManagedBy -> ManagedBy
forall a. a -> Maybe a -> a
fromMaybe ManagedBy
ManagedByWire (Maybe ManagedBy -> ManagedBy)
-> SchemaP SwaggerDoc Object [Pair] ManagedBy (Maybe ManagedBy)
-> SchemaP SwaggerDoc Object [Pair] ManagedBy ManagedBy
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text
-> SchemaP NamedSwaggerDoc Value Value ManagedBy ManagedBy
-> SchemaP SwaggerDoc Object [Pair] ManagedBy (Maybe ManagedBy)
forall doc doc' a b.
(HasOpt doc, HasField doc' doc) =>
Text
-> SchemaP doc' Value Value a b
-> SchemaP doc Object [Pair] a (Maybe b)
optField Text
"managed_by" SchemaP NamedSwaggerDoc Value Value ManagedBy ManagedBy
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema)
    SchemaP SwaggerDoc Object [Pair] User (Set BaseProtocolTag -> User)
-> SchemaP SwaggerDoc Object [Pair] User (Set BaseProtocolTag)
-> SchemaP SwaggerDoc Object [Pair] User User
forall a b.
SchemaP SwaggerDoc Object [Pair] User (a -> b)
-> SchemaP SwaggerDoc Object [Pair] User a
-> SchemaP SwaggerDoc Object [Pair] User b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> User -> Set BaseProtocolTag
userSupportedProtocols (User -> Set BaseProtocolTag)
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     (Set BaseProtocolTag)
     (Set BaseProtocolTag)
-> SchemaP SwaggerDoc Object [Pair] User (Set BaseProtocolTag)
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= SchemaP
  SwaggerDoc
  Object
  [Pair]
  (Set BaseProtocolTag)
  (Set BaseProtocolTag)
supportedProtocolsObjectSchema
    SchemaP SwaggerDoc Object [Pair] User User
-> SchemaP SwaggerDoc Object [Pair] User Bool
-> SchemaP SwaggerDoc Object [Pair] User User
forall a b.
SchemaP SwaggerDoc Object [Pair] User a
-> SchemaP SwaggerDoc Object [Pair] User b
-> SchemaP SwaggerDoc Object [Pair] User a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* (Bool -> Maybe Bool -> Bool
forall a. a -> Maybe a -> a
fromMaybe Bool
False (Maybe Bool -> Bool)
-> SchemaP SwaggerDoc Object [Pair] User (Maybe Bool)
-> SchemaP SwaggerDoc Object [Pair] User Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (\User
u -> if User -> Bool
userDeleted User
u then Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
True else Maybe Bool
forall a. Maybe a
Nothing) (User -> Maybe Bool)
-> SchemaP SwaggerDoc Object [Pair] (Maybe Bool) (Maybe Bool)
-> SchemaP SwaggerDoc Object [Pair] User (Maybe Bool)
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= SchemaP SwaggerDoc Object [Pair] Bool (Maybe Bool)
-> SchemaP SwaggerDoc Object [Pair] (Maybe Bool) (Maybe Bool)
forall w d v a b.
Monoid w =>
SchemaP d v w a b -> SchemaP d v w (Maybe a) b
maybe_ (Text
-> SchemaP NamedSwaggerDoc Value Value Bool Bool
-> SchemaP SwaggerDoc Object [Pair] Bool (Maybe Bool)
forall doc doc' a b.
(HasOpt doc, HasField doc' doc) =>
Text
-> SchemaP doc' Value Value a b
-> SchemaP doc Object [Pair] a (Maybe b)
optField Text
"deleted" SchemaP NamedSwaggerDoc Value Value Bool Bool
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema))

userEmail :: User -> Maybe EmailAddress
userEmail :: User -> Maybe EmailAddress
userEmail = UserIdentity -> Maybe EmailAddress
emailIdentity (UserIdentity -> Maybe EmailAddress)
-> (User -> Maybe UserIdentity) -> User -> Maybe EmailAddress
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< User -> Maybe UserIdentity
userIdentity

userSSOId :: User -> Maybe UserSSOId
userSSOId :: User -> Maybe UserSSOId
userSSOId = UserIdentity -> Maybe UserSSOId
ssoIdentity (UserIdentity -> Maybe UserSSOId)
-> (User -> Maybe UserIdentity) -> User -> Maybe UserSSOId
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< User -> Maybe UserIdentity
userIdentity

userSCIMExternalId :: User -> Maybe Text
userSCIMExternalId :: User -> Maybe Text
userSCIMExternalId User
usr = ManagedBy -> UserSSOId -> Maybe Text
scimExternalId (User -> ManagedBy
userManagedBy User
usr) (UserSSOId -> Maybe Text) -> Maybe UserSSOId -> Maybe Text
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< User -> Maybe UserSSOId
userSSOId User
usr

-- FUTUREWORK: this is only ignoring case in the email format, and emails should be
-- handled case-insensitively.  https://wearezeta.atlassian.net/browse/SQSERVICES-909
scimExternalId :: ManagedBy -> UserSSOId -> Maybe Text
scimExternalId :: ManagedBy -> UserSSOId -> Maybe Text
scimExternalId ManagedBy
_ (UserScimExternalId Text
extId) = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
extId
scimExternalId ManagedBy
ManagedByScim (UserSSOId (SAML.UserRef Issuer
_ NameID
nameIdXML)) = Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> (NameID -> Text) -> NameID -> Maybe Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CI Text -> Text
forall s. CI s -> s
CI.original (CI Text -> Text) -> (NameID -> CI Text) -> NameID -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NameID -> CI Text
SAML.unsafeShowNameID (NameID -> Maybe Text) -> NameID -> Maybe Text
forall a b. (a -> b) -> a -> b
$ NameID
nameIdXML
scimExternalId ManagedBy
ManagedByWire (UserSSOId UserRef
_) = Maybe Text
forall a. Maybe a
Nothing

ssoIssuerAndNameId :: UserSSOId -> Maybe (Text, Text)
ssoIssuerAndNameId :: UserSSOId -> Maybe (Text, Text)
ssoIssuerAndNameId (UserSSOId (SAML.UserRef (SAML.Issuer URI
uri) NameID
nameIdXML)) = (Text, Text) -> Maybe (Text, Text)
forall a. a -> Maybe a
Just (URI -> Text
forall {a}. URIRef a -> Text
fromUri URI
uri, NameID -> Text
fromNameId NameID
nameIdXML)
  where
    fromUri :: URIRef a -> Text
fromUri =
      OnDecodeError -> ByteString -> Text
T.decodeUtf8With OnDecodeError
lenientDecode
        (ByteString -> Text)
-> (URIRef a -> ByteString) -> URIRef a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
toStrict
        (ByteString -> ByteString)
-> (URIRef a -> ByteString) -> URIRef a -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> ByteString
toLazyByteString
        (Builder -> ByteString)
-> (URIRef a -> Builder) -> URIRef a -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. URIRef a -> Builder
forall a. URIRef a -> Builder
serializeURIRef
    fromNameId :: NameID -> Text
fromNameId = CI Text -> Text
forall s. CI s -> s
CI.original (CI Text -> Text) -> (NameID -> CI Text) -> NameID -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NameID -> CI Text
SAML.unsafeShowNameID
ssoIssuerAndNameId (UserScimExternalId Text
_) = Maybe (Text, Text)
forall a. Maybe a
Nothing

userIssuer :: User -> Maybe SAML.Issuer
userIssuer :: User -> Maybe Issuer
userIssuer User
user = User -> Maybe UserSSOId
userSSOId User
user Maybe UserSSOId -> (UserSSOId -> Maybe Issuer) -> Maybe Issuer
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= UserSSOId -> Maybe Issuer
fromSSOId
  where
    fromSSOId :: UserSSOId -> Maybe SAML.Issuer
    fromSSOId :: UserSSOId -> Maybe Issuer
fromSSOId (UserSSOId (SAML.UserRef Issuer
issuer NameID
_)) = Issuer -> Maybe Issuer
forall a. a -> Maybe a
Just Issuer
issuer
    fromSSOId UserSSOId
_ = Maybe Issuer
forall a. Maybe a
Nothing

-- | Configurations for whether to show a user's email to others.
data EmailVisibility a
  = -- | Anyone can see the email of someone who is on ANY team.
    --         This may sound strange; but certain on-premise hosters have many different teams
    --         and still want them to see each-other's emails.
    EmailVisibleIfOnTeam
  | -- | Anyone on your team with at least 'Member' privileges can see your email address.
    EmailVisibleIfOnSameTeam a
  | -- | Show your email only to yourself
    EmailVisibleToSelf
  deriving (EmailVisibility a -> EmailVisibility a -> Bool
(EmailVisibility a -> EmailVisibility a -> Bool)
-> (EmailVisibility a -> EmailVisibility a -> Bool)
-> Eq (EmailVisibility a)
forall a. Eq a => EmailVisibility a -> EmailVisibility a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a. Eq a => EmailVisibility a -> EmailVisibility a -> Bool
== :: EmailVisibility a -> EmailVisibility a -> Bool
$c/= :: forall a. Eq a => EmailVisibility a -> EmailVisibility a -> Bool
/= :: EmailVisibility a -> EmailVisibility a -> Bool
Eq, Int -> EmailVisibility a -> ShowS
[EmailVisibility a] -> ShowS
EmailVisibility a -> String
(Int -> EmailVisibility a -> ShowS)
-> (EmailVisibility a -> String)
-> ([EmailVisibility a] -> ShowS)
-> Show (EmailVisibility a)
forall a. Show a => Int -> EmailVisibility a -> ShowS
forall a. Show a => [EmailVisibility a] -> ShowS
forall a. Show a => EmailVisibility a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Show a => Int -> EmailVisibility a -> ShowS
showsPrec :: Int -> EmailVisibility a -> ShowS
$cshow :: forall a. Show a => EmailVisibility a -> String
show :: EmailVisibility a -> String
$cshowList :: forall a. Show a => [EmailVisibility a] -> ShowS
showList :: [EmailVisibility a] -> ShowS
Show, (forall x. EmailVisibility a -> Rep (EmailVisibility a) x)
-> (forall x. Rep (EmailVisibility a) x -> EmailVisibility a)
-> Generic (EmailVisibility a)
forall x. Rep (EmailVisibility a) x -> EmailVisibility a
forall x. EmailVisibility a -> Rep (EmailVisibility a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (EmailVisibility a) x -> EmailVisibility a
forall a x. EmailVisibility a -> Rep (EmailVisibility a) x
$cfrom :: forall a x. EmailVisibility a -> Rep (EmailVisibility a) x
from :: forall x. EmailVisibility a -> Rep (EmailVisibility a) x
$cto :: forall a x. Rep (EmailVisibility a) x -> EmailVisibility a
to :: forall x. Rep (EmailVisibility a) x -> EmailVisibility a
Generic, (forall a b. (a -> b) -> EmailVisibility a -> EmailVisibility b)
-> (forall a b. a -> EmailVisibility b -> EmailVisibility a)
-> Functor EmailVisibility
forall a b. a -> EmailVisibility b -> EmailVisibility a
forall a b. (a -> b) -> EmailVisibility a -> EmailVisibility b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> EmailVisibility a -> EmailVisibility b
fmap :: forall a b. (a -> b) -> EmailVisibility a -> EmailVisibility b
$c<$ :: forall a b. a -> EmailVisibility b -> EmailVisibility a
<$ :: forall a b. a -> EmailVisibility b -> EmailVisibility a
Functor, (forall m. Monoid m => EmailVisibility m -> m)
-> (forall m a. Monoid m => (a -> m) -> EmailVisibility a -> m)
-> (forall m a. Monoid m => (a -> m) -> EmailVisibility a -> m)
-> (forall a b. (a -> b -> b) -> b -> EmailVisibility a -> b)
-> (forall a b. (a -> b -> b) -> b -> EmailVisibility a -> b)
-> (forall b a. (b -> a -> b) -> b -> EmailVisibility a -> b)
-> (forall b a. (b -> a -> b) -> b -> EmailVisibility a -> b)
-> (forall a. (a -> a -> a) -> EmailVisibility a -> a)
-> (forall a. (a -> a -> a) -> EmailVisibility a -> a)
-> (forall a. EmailVisibility a -> [a])
-> (forall a. EmailVisibility a -> Bool)
-> (forall a. EmailVisibility a -> Int)
-> (forall a. Eq a => a -> EmailVisibility a -> Bool)
-> (forall a. Ord a => EmailVisibility a -> a)
-> (forall a. Ord a => EmailVisibility a -> a)
-> (forall a. Num a => EmailVisibility a -> a)
-> (forall a. Num a => EmailVisibility a -> a)
-> Foldable EmailVisibility
forall a. Eq a => a -> EmailVisibility a -> Bool
forall a. Num a => EmailVisibility a -> a
forall a. Ord a => EmailVisibility a -> a
forall m. Monoid m => EmailVisibility m -> m
forall a. EmailVisibility a -> Bool
forall a. EmailVisibility a -> Int
forall a. EmailVisibility a -> [a]
forall a. (a -> a -> a) -> EmailVisibility a -> a
forall m a. Monoid m => (a -> m) -> EmailVisibility a -> m
forall b a. (b -> a -> b) -> b -> EmailVisibility a -> b
forall a b. (a -> b -> b) -> b -> EmailVisibility a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
$cfold :: forall m. Monoid m => EmailVisibility m -> m
fold :: forall m. Monoid m => EmailVisibility m -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> EmailVisibility a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> EmailVisibility a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> EmailVisibility a -> m
foldMap' :: forall m a. Monoid m => (a -> m) -> EmailVisibility a -> m
$cfoldr :: forall a b. (a -> b -> b) -> b -> EmailVisibility a -> b
foldr :: forall a b. (a -> b -> b) -> b -> EmailVisibility a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> EmailVisibility a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> EmailVisibility a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> EmailVisibility a -> b
foldl :: forall b a. (b -> a -> b) -> b -> EmailVisibility a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> EmailVisibility a -> b
foldl' :: forall b a. (b -> a -> b) -> b -> EmailVisibility a -> b
$cfoldr1 :: forall a. (a -> a -> a) -> EmailVisibility a -> a
foldr1 :: forall a. (a -> a -> a) -> EmailVisibility a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> EmailVisibility a -> a
foldl1 :: forall a. (a -> a -> a) -> EmailVisibility a -> a
$ctoList :: forall a. EmailVisibility a -> [a]
toList :: forall a. EmailVisibility a -> [a]
$cnull :: forall a. EmailVisibility a -> Bool
null :: forall a. EmailVisibility a -> Bool
$clength :: forall a. EmailVisibility a -> Int
length :: forall a. EmailVisibility a -> Int
$celem :: forall a. Eq a => a -> EmailVisibility a -> Bool
elem :: forall a. Eq a => a -> EmailVisibility a -> Bool
$cmaximum :: forall a. Ord a => EmailVisibility a -> a
maximum :: forall a. Ord a => EmailVisibility a -> a
$cminimum :: forall a. Ord a => EmailVisibility a -> a
minimum :: forall a. Ord a => EmailVisibility a -> a
$csum :: forall a. Num a => EmailVisibility a -> a
sum :: forall a. Num a => EmailVisibility a -> a
$cproduct :: forall a. Num a => EmailVisibility a -> a
product :: forall a. Num a => EmailVisibility a -> a
Foldable, Functor EmailVisibility
Foldable EmailVisibility
(Functor EmailVisibility, Foldable EmailVisibility) =>
(forall (f :: * -> *) a b.
 Applicative f =>
 (a -> f b) -> EmailVisibility a -> f (EmailVisibility b))
-> (forall (f :: * -> *) a.
    Applicative f =>
    EmailVisibility (f a) -> f (EmailVisibility a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> EmailVisibility a -> m (EmailVisibility b))
-> (forall (m :: * -> *) a.
    Monad m =>
    EmailVisibility (m a) -> m (EmailVisibility a))
-> Traversable EmailVisibility
forall (t :: * -> *).
(Functor t, Foldable t) =>
(forall (f :: * -> *) a b.
 Applicative f =>
 (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a.
Monad m =>
EmailVisibility (m a) -> m (EmailVisibility a)
forall (f :: * -> *) a.
Applicative f =>
EmailVisibility (f a) -> f (EmailVisibility a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> EmailVisibility a -> m (EmailVisibility b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> EmailVisibility a -> f (EmailVisibility b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> EmailVisibility a -> f (EmailVisibility b)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> EmailVisibility a -> f (EmailVisibility b)
$csequenceA :: forall (f :: * -> *) a.
Applicative f =>
EmailVisibility (f a) -> f (EmailVisibility a)
sequenceA :: forall (f :: * -> *) a.
Applicative f =>
EmailVisibility (f a) -> f (EmailVisibility a)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> EmailVisibility a -> m (EmailVisibility b)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> EmailVisibility a -> m (EmailVisibility b)
$csequence :: forall (m :: * -> *) a.
Monad m =>
EmailVisibility (m a) -> m (EmailVisibility a)
sequence :: forall (m :: * -> *) a.
Monad m =>
EmailVisibility (m a) -> m (EmailVisibility a)
Traversable)
  deriving (Gen (EmailVisibility a)
Gen (EmailVisibility a)
-> (EmailVisibility a -> [EmailVisibility a])
-> Arbitrary (EmailVisibility a)
EmailVisibility a -> [EmailVisibility a]
forall a. Gen a -> (a -> [a]) -> Arbitrary a
forall a. Arbitrary a => Gen (EmailVisibility a)
forall a. Arbitrary a => EmailVisibility a -> [EmailVisibility a]
$carbitrary :: forall a. Arbitrary a => Gen (EmailVisibility a)
arbitrary :: Gen (EmailVisibility a)
$cshrink :: forall a. Arbitrary a => EmailVisibility a -> [EmailVisibility a]
shrink :: EmailVisibility a -> [EmailVisibility a]
Arbitrary) via (GenericUniform (EmailVisibility a))

type EmailVisibilityConfig = EmailVisibility ()

type EmailVisibilityConfigWithViewer = EmailVisibility (Maybe (TeamId, TeamMember))

instance FromJSON (EmailVisibility ()) where
  parseJSON :: Value -> Parser (EmailVisibility ())
parseJSON = String
-> (Text -> Parser (EmailVisibility ()))
-> Value
-> Parser (EmailVisibility ())
forall a. String -> (Text -> Parser a) -> Value -> Parser a
withText String
"EmailVisibility" ((Text -> Parser (EmailVisibility ()))
 -> Value -> Parser (EmailVisibility ()))
-> (Text -> Parser (EmailVisibility ()))
-> Value
-> Parser (EmailVisibility ())
forall a b. (a -> b) -> a -> b
$ \case
    Text
"visible_if_on_team" -> EmailVisibility () -> Parser (EmailVisibility ())
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure EmailVisibility ()
forall a. EmailVisibility a
EmailVisibleIfOnTeam
    Text
"visible_if_on_same_team" -> EmailVisibility () -> Parser (EmailVisibility ())
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (EmailVisibility () -> Parser (EmailVisibility ()))
-> EmailVisibility () -> Parser (EmailVisibility ())
forall a b. (a -> b) -> a -> b
$ () -> EmailVisibility ()
forall a. a -> EmailVisibility a
EmailVisibleIfOnSameTeam ()
    Text
"visible_to_self" -> EmailVisibility () -> Parser (EmailVisibility ())
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure EmailVisibility ()
forall a. EmailVisibility a
EmailVisibleToSelf
    Text
_ -> String -> Parser (EmailVisibility ())
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"unexpected value for EmailVisibility settings"

mkUserProfileWithEmail :: Maybe EmailAddress -> User -> UserLegalHoldStatus -> UserProfile
mkUserProfileWithEmail :: Maybe EmailAddress -> User -> UserLegalHoldStatus -> UserProfile
mkUserProfileWithEmail Maybe EmailAddress
memail User
u UserLegalHoldStatus
legalHoldStatus =
  -- This profile would be visible to any other user. When a new field is
  -- added, please make sure it is OK for other users to have access to it.
  UserProfile
    { $sel:profileQualifiedId:UserProfile :: Qualified UserId
profileQualifiedId = User -> Qualified UserId
userQualifiedId User
u,
      $sel:profileHandle:UserProfile :: Maybe Handle
profileHandle = User -> Maybe Handle
userHandle User
u,
      $sel:profileName:UserProfile :: Name
profileName = User -> Name
userDisplayName User
u,
      $sel:profileTextStatus:UserProfile :: Maybe TextStatus
profileTextStatus = User -> Maybe TextStatus
userTextStatus User
u,
      $sel:profilePict:UserProfile :: Pict
profilePict = User -> Pict
userPict User
u,
      $sel:profileAssets:UserProfile :: [Asset]
profileAssets = User -> [Asset]
userAssets User
u,
      $sel:profileAccentId:UserProfile :: ColourId
profileAccentId = User -> ColourId
userAccentId User
u,
      $sel:profileService:UserProfile :: Maybe ServiceRef
profileService = User -> Maybe ServiceRef
userService User
u,
      $sel:profileDeleted:UserProfile :: Bool
profileDeleted = User -> Bool
userDeleted User
u,
      $sel:profileExpire:UserProfile :: Maybe UTCTimeMillis
profileExpire = User -> Maybe UTCTimeMillis
userExpire User
u,
      $sel:profileTeam:UserProfile :: Maybe TeamId
profileTeam = User -> Maybe TeamId
userTeam User
u,
      $sel:profileEmail:UserProfile :: Maybe EmailAddress
profileEmail = Maybe EmailAddress
memail,
      $sel:profileLegalholdStatus:UserProfile :: UserLegalHoldStatus
profileLegalholdStatus = UserLegalHoldStatus
legalHoldStatus,
      $sel:profileSupportedProtocols:UserProfile :: Set BaseProtocolTag
profileSupportedProtocols = User -> Set BaseProtocolTag
userSupportedProtocols User
u
    }

mkUserProfile :: EmailVisibilityConfigWithViewer -> User -> UserLegalHoldStatus -> UserProfile
mkUserProfile :: EmailVisibilityConfigWithViewer
-> User -> UserLegalHoldStatus -> UserProfile
mkUserProfile EmailVisibilityConfigWithViewer
emailVisibilityConfigAndViewer User
u UserLegalHoldStatus
legalHoldStatus =
  let isEmailVisible :: Bool
isEmailVisible = case EmailVisibilityConfigWithViewer
emailVisibilityConfigAndViewer of
        EmailVisibilityConfigWithViewer
EmailVisibleToSelf -> Bool
False
        EmailVisibilityConfigWithViewer
EmailVisibleIfOnTeam -> Maybe TeamId -> Bool
forall a. Maybe a -> Bool
isJust (User -> Maybe TeamId
userTeam User
u)
        EmailVisibleIfOnSameTeam Maybe (TeamId, TeamMember)
Nothing -> Bool
False
        EmailVisibleIfOnSameTeam (Just (TeamId
viewerTeamId, TeamMember
viewerMembership)) ->
          TeamId -> Maybe TeamId
forall a. a -> Maybe a
Just TeamId
viewerTeamId Maybe TeamId -> Maybe TeamId -> Bool
forall a. Eq a => a -> a -> Bool
== User -> Maybe TeamId
userTeam User
u
            Bool -> Bool -> Bool
&& TeamMember -> HiddenPerm -> Bool
forall perm. IsPerm perm => TeamMember -> perm -> Bool
TeamMember.hasPermission TeamMember
viewerMembership HiddenPerm
TeamMember.ViewSameTeamEmails
   in Maybe EmailAddress -> User -> UserLegalHoldStatus -> UserProfile
mkUserProfileWithEmail (if Bool
isEmailVisible then User -> Maybe EmailAddress
userEmail User
u else Maybe EmailAddress
forall a. Maybe a
Nothing) User
u UserLegalHoldStatus
legalHoldStatus

--------------------------------------------------------------------------------
-- NewUser

-- | We use the same 'NewUser' type for the @\/register@ and @\/i\/users@ endpoints. This
-- newtype is used as request body type for the public @\/register@ endpoint, where only a
-- subset of the 'NewUser' functionality should be allowed.
--
-- Specifically, we forbid the following:
--
--   * Setting 'SSOIdentity' (SSO users are created by Spar)
--
--   * Setting the UUID (only needed so that Spar can find the user if Spar crashes before it
--     finishes creating the user).
--
--   * Setting 'ManagedBy' (it should be the default in all cases unless Spar creates a
--     SCIM-managed user)
newtype NewUserPublic = NewUserPublic NewUser
  deriving stock (NewUserPublic -> NewUserPublic -> Bool
(NewUserPublic -> NewUserPublic -> Bool)
-> (NewUserPublic -> NewUserPublic -> Bool) -> Eq NewUserPublic
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: NewUserPublic -> NewUserPublic -> Bool
== :: NewUserPublic -> NewUserPublic -> Bool
$c/= :: NewUserPublic -> NewUserPublic -> Bool
/= :: NewUserPublic -> NewUserPublic -> Bool
Eq, Int -> NewUserPublic -> ShowS
[NewUserPublic] -> ShowS
NewUserPublic -> String
(Int -> NewUserPublic -> ShowS)
-> (NewUserPublic -> String)
-> ([NewUserPublic] -> ShowS)
-> Show NewUserPublic
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> NewUserPublic -> ShowS
showsPrec :: Int -> NewUserPublic -> ShowS
$cshow :: NewUserPublic -> String
show :: NewUserPublic -> String
$cshowList :: [NewUserPublic] -> ShowS
showList :: [NewUserPublic] -> ShowS
Show, (forall x. NewUserPublic -> Rep NewUserPublic x)
-> (forall x. Rep NewUserPublic x -> NewUserPublic)
-> Generic NewUserPublic
forall x. Rep NewUserPublic x -> NewUserPublic
forall x. NewUserPublic -> Rep NewUserPublic x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. NewUserPublic -> Rep NewUserPublic x
from :: forall x. NewUserPublic -> Rep NewUserPublic x
$cto :: forall x. Rep NewUserPublic x -> NewUserPublic
to :: forall x. Rep NewUserPublic x -> NewUserPublic
Generic)
  deriving ([NewUserPublic] -> Value
[NewUserPublic] -> Encoding
NewUserPublic -> Value
NewUserPublic -> Encoding
(NewUserPublic -> Value)
-> (NewUserPublic -> Encoding)
-> ([NewUserPublic] -> Value)
-> ([NewUserPublic] -> Encoding)
-> ToJSON NewUserPublic
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: NewUserPublic -> Value
toJSON :: NewUserPublic -> Value
$ctoEncoding :: NewUserPublic -> Encoding
toEncoding :: NewUserPublic -> Encoding
$ctoJSONList :: [NewUserPublic] -> Value
toJSONList :: [NewUserPublic] -> Value
$ctoEncodingList :: [NewUserPublic] -> Encoding
toEncodingList :: [NewUserPublic] -> Encoding
ToJSON, Value -> Parser [NewUserPublic]
Value -> Parser NewUserPublic
(Value -> Parser NewUserPublic)
-> (Value -> Parser [NewUserPublic]) -> FromJSON NewUserPublic
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser NewUserPublic
parseJSON :: Value -> Parser NewUserPublic
$cparseJSONList :: Value -> Parser [NewUserPublic]
parseJSONList :: Value -> Parser [NewUserPublic]
FromJSON, Typeable NewUserPublic
Typeable NewUserPublic =>
(Proxy NewUserPublic -> Declare (Definitions Schema) NamedSchema)
-> ToSchema NewUserPublic
Proxy NewUserPublic -> Declare (Definitions Schema) NamedSchema
forall a.
Typeable a =>
(Proxy a -> Declare (Definitions Schema) NamedSchema) -> ToSchema a
$cdeclareNamedSchema :: Proxy NewUserPublic -> Declare (Definitions Schema) NamedSchema
declareNamedSchema :: Proxy NewUserPublic -> Declare (Definitions Schema) NamedSchema
S.ToSchema) via (Schema NewUserPublic)

instance ToSchema NewUserPublic where
  schema :: ValueSchema NamedSwaggerDoc NewUserPublic
schema =
    NewUserPublic -> NewUser
unwrap (NewUserPublic -> NewUser)
-> SchemaP NamedSwaggerDoc Value Value NewUser NewUserPublic
-> ValueSchema NamedSwaggerDoc NewUserPublic
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= SchemaP NamedSwaggerDoc Value Value NewUser NewUser
-> (NewUser -> Parser NewUserPublic)
-> SchemaP NamedSwaggerDoc Value Value NewUser NewUserPublic
forall doc v w a b b'.
SchemaP doc v w a b -> (b -> Parser b') -> SchemaP doc v w a b'
withParser SchemaP NamedSwaggerDoc Value Value NewUser NewUser
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema ((String -> Parser NewUserPublic)
-> (NewUserPublic -> Parser NewUserPublic)
-> Either String NewUserPublic
-> Parser NewUserPublic
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either String -> Parser NewUserPublic
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail NewUserPublic -> Parser NewUserPublic
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either String NewUserPublic -> Parser NewUserPublic)
-> (NewUser -> Either String NewUserPublic)
-> NewUser
-> Parser NewUserPublic
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NewUser -> Either String NewUserPublic
validateNewUserPublic)
    where
      unwrap :: NewUserPublic -> NewUser
unwrap (NewUserPublic NewUser
nu) = NewUser
nu

validateNewUserPublic :: NewUser -> Either String NewUserPublic
validateNewUserPublic :: NewUser -> Either String NewUserPublic
validateNewUserPublic NewUser
nu
  | Maybe UserSSOId -> Bool
forall a. Maybe a -> Bool
isJust (NewUser -> Maybe UserSSOId
newUserSSOId NewUser
nu) =
      String -> Either String NewUserPublic
forall a b. a -> Either a b
Left String
"SSO-managed users are not allowed here."
  | Maybe UUID -> Bool
forall a. Maybe a -> Bool
isJust (NewUser -> Maybe UUID
newUserUUID NewUser
nu) =
      String -> Either String NewUserPublic
forall a b. a -> Either a b
Left String
"it is not allowed to provide a UUID for the users here."
  | NewUser -> Maybe ManagedBy
newUserManagedBy NewUser
nu Maybe ManagedBy -> [Maybe ManagedBy] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [Maybe ManagedBy
forall a. Maybe a
Nothing, ManagedBy -> Maybe ManagedBy
forall a. a -> Maybe a
Just ManagedBy
ManagedByWire] =
      String -> Either String NewUserPublic
forall a b. a -> Either a b
Left String
"only managed-by-Wire users can be created here."
  | Bool
otherwise =
      NewUserPublic -> Either String NewUserPublic
forall a b. b -> Either a b
Right (NewUser -> NewUserPublic
NewUserPublic NewUser
nu)

-- | A user is Ephemeral if she has neither email, phone, nor sso credentials and is not
-- created via scim.  Ephemeral users can be deleted after expires_in or sessionTokenTimeout
-- (whichever comes earlier).
isNewUserEphemeral :: NewUser -> Bool
isNewUserEphemeral :: NewUser -> Bool
isNewUserEphemeral NewUser
u = Bool
noId Bool -> Bool -> Bool
&& Bool
noScim
  where
    noId :: Bool
noId = Maybe UserIdentity -> Bool
forall a. Maybe a -> Bool
isNothing (Maybe UserIdentity -> Bool) -> Maybe UserIdentity -> Bool
forall a b. (a -> b) -> a -> b
$ NewUser -> Maybe UserIdentity
newUserIdentity NewUser
u
    noScim :: Bool
noScim = case NewUser -> Maybe ManagedBy
newUserManagedBy NewUser
u of
      Maybe ManagedBy
Nothing -> Bool
True
      Just ManagedBy
ManagedByWire -> Bool
True
      Just ManagedBy
ManagedByScim -> Bool
False

isNewUserTeamMember :: NewUser -> Bool
isNewUserTeamMember :: NewUser -> Bool
isNewUserTeamMember NewUser
u = case NewUser -> Maybe NewTeamUser
newUserTeam NewUser
u of
  Just (NewTeamMember InvitationCode
_) -> Bool
True
  Just (NewTeamMemberSSO TeamId
_) -> Bool
True
  Just (NewTeamCreator BindingNewTeamUser
_) -> Bool
False
  Maybe NewTeamUser
Nothing -> Bool
False

instance Arbitrary NewUserPublic where
  arbitrary :: Gen NewUserPublic
arbitrary = Gen NewUser
forall a. Arbitrary a => Gen a
arbitrary Gen NewUser
-> (NewUser -> Maybe NewUserPublic) -> Gen NewUserPublic
forall a b. Gen a -> (a -> Maybe b) -> Gen b
`QC.suchThatMap` (Either String NewUserPublic -> Maybe NewUserPublic
forall e a. Either e a -> Maybe a
rightMay (Either String NewUserPublic -> Maybe NewUserPublic)
-> (NewUser -> Either String NewUserPublic)
-> NewUser
-> Maybe NewUserPublic
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NewUser -> Either String NewUserPublic
validateNewUserPublic)

data CreateUserTeam = CreateUserTeam
  { CreateUserTeam -> TeamId
createdTeamId :: !TeamId,
    CreateUserTeam -> Text
createdTeamName :: !Text
  }
  deriving (Int -> CreateUserTeam -> ShowS
[CreateUserTeam] -> ShowS
CreateUserTeam -> String
(Int -> CreateUserTeam -> ShowS)
-> (CreateUserTeam -> String)
-> ([CreateUserTeam] -> ShowS)
-> Show CreateUserTeam
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CreateUserTeam -> ShowS
showsPrec :: Int -> CreateUserTeam -> ShowS
$cshow :: CreateUserTeam -> String
show :: CreateUserTeam -> String
$cshowList :: [CreateUserTeam] -> ShowS
showList :: [CreateUserTeam] -> ShowS
Show)
  deriving (Value -> Parser [CreateUserTeam]
Value -> Parser CreateUserTeam
(Value -> Parser CreateUserTeam)
-> (Value -> Parser [CreateUserTeam]) -> FromJSON CreateUserTeam
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser CreateUserTeam
parseJSON :: Value -> Parser CreateUserTeam
$cparseJSONList :: Value -> Parser [CreateUserTeam]
parseJSONList :: Value -> Parser [CreateUserTeam]
FromJSON, [CreateUserTeam] -> Value
[CreateUserTeam] -> Encoding
CreateUserTeam -> Value
CreateUserTeam -> Encoding
(CreateUserTeam -> Value)
-> (CreateUserTeam -> Encoding)
-> ([CreateUserTeam] -> Value)
-> ([CreateUserTeam] -> Encoding)
-> ToJSON CreateUserTeam
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: CreateUserTeam -> Value
toJSON :: CreateUserTeam -> Value
$ctoEncoding :: CreateUserTeam -> Encoding
toEncoding :: CreateUserTeam -> Encoding
$ctoJSONList :: [CreateUserTeam] -> Value
toJSONList :: [CreateUserTeam] -> Value
$ctoEncodingList :: [CreateUserTeam] -> Encoding
toEncodingList :: [CreateUserTeam] -> Encoding
ToJSON, Typeable CreateUserTeam
Typeable CreateUserTeam =>
(Proxy CreateUserTeam -> Declare (Definitions Schema) NamedSchema)
-> ToSchema CreateUserTeam
Proxy CreateUserTeam -> Declare (Definitions Schema) NamedSchema
forall a.
Typeable a =>
(Proxy a -> Declare (Definitions Schema) NamedSchema) -> ToSchema a
$cdeclareNamedSchema :: Proxy CreateUserTeam -> Declare (Definitions Schema) NamedSchema
declareNamedSchema :: Proxy CreateUserTeam -> Declare (Definitions Schema) NamedSchema
S.ToSchema) via Schema CreateUserTeam

instance ToSchema CreateUserTeam where
  schema :: ValueSchema NamedSwaggerDoc CreateUserTeam
schema =
    Text
-> SchemaP SwaggerDoc Object [Pair] CreateUserTeam CreateUserTeam
-> ValueSchema NamedSwaggerDoc CreateUserTeam
forall doc doc' a b.
HasObject doc doc' =>
Text
-> SchemaP doc Object [Pair] a b -> SchemaP doc' Value Value a b
object Text
"CreateUserTeam" (SchemaP SwaggerDoc Object [Pair] CreateUserTeam CreateUserTeam
 -> ValueSchema NamedSwaggerDoc CreateUserTeam)
-> SchemaP SwaggerDoc Object [Pair] CreateUserTeam CreateUserTeam
-> ValueSchema NamedSwaggerDoc CreateUserTeam
forall a b. (a -> b) -> a -> b
$
      TeamId -> Text -> CreateUserTeam
CreateUserTeam
        (TeamId -> Text -> CreateUserTeam)
-> SchemaP SwaggerDoc Object [Pair] CreateUserTeam TeamId
-> SchemaP
     SwaggerDoc Object [Pair] CreateUserTeam (Text -> CreateUserTeam)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CreateUserTeam -> TeamId
createdTeamId (CreateUserTeam -> TeamId)
-> SchemaP SwaggerDoc Object [Pair] TeamId TeamId
-> SchemaP SwaggerDoc Object [Pair] CreateUserTeam TeamId
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= Text
-> SchemaP NamedSwaggerDoc Value Value TeamId TeamId
-> SchemaP SwaggerDoc Object [Pair] TeamId TeamId
forall doc' doc a b.
HasField doc' doc =>
Text
-> SchemaP doc' Value Value a b -> SchemaP doc Object [Pair] a b
field Text
"team_id" SchemaP NamedSwaggerDoc Value Value TeamId TeamId
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema
        SchemaP
  SwaggerDoc Object [Pair] CreateUserTeam (Text -> CreateUserTeam)
-> SchemaP SwaggerDoc Object [Pair] CreateUserTeam Text
-> SchemaP SwaggerDoc Object [Pair] CreateUserTeam CreateUserTeam
forall a b.
SchemaP SwaggerDoc Object [Pair] CreateUserTeam (a -> b)
-> SchemaP SwaggerDoc Object [Pair] CreateUserTeam a
-> SchemaP SwaggerDoc Object [Pair] CreateUserTeam b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> CreateUserTeam -> Text
createdTeamName (CreateUserTeam -> Text)
-> SchemaP SwaggerDoc Object [Pair] Text Text
-> SchemaP SwaggerDoc Object [Pair] CreateUserTeam Text
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= Text
-> SchemaP NamedSwaggerDoc Value Value Text Text
-> SchemaP SwaggerDoc Object [Pair] Text Text
forall doc' doc a b.
HasField doc' doc =>
Text
-> SchemaP doc' Value Value a b -> SchemaP doc Object [Pair] a b
field Text
"team_name" SchemaP NamedSwaggerDoc Value Value Text Text
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema

data UpgradePersonalToTeamError
  = UpgradePersonalToTeamErrorAlreadyInATeam
  | UpgradePersonalToTeamErrorUserNotFound
  deriving (Int -> UpgradePersonalToTeamError -> ShowS
[UpgradePersonalToTeamError] -> ShowS
UpgradePersonalToTeamError -> String
(Int -> UpgradePersonalToTeamError -> ShowS)
-> (UpgradePersonalToTeamError -> String)
-> ([UpgradePersonalToTeamError] -> ShowS)
-> Show UpgradePersonalToTeamError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> UpgradePersonalToTeamError -> ShowS
showsPrec :: Int -> UpgradePersonalToTeamError -> ShowS
$cshow :: UpgradePersonalToTeamError -> String
show :: UpgradePersonalToTeamError -> String
$cshowList :: [UpgradePersonalToTeamError] -> ShowS
showList :: [UpgradePersonalToTeamError] -> ShowS
Show)

type UpgradePersonalToTeamResponses =
  '[ ErrorResponse UserAlreadyInATeam,
     ErrorResponse UserNotFound,
     Respond 200 "Team created" CreateUserTeam
   ]

instance
  AsUnion
    UpgradePersonalToTeamResponses
    (Either UpgradePersonalToTeamError CreateUserTeam)
  where
  toUnion :: Either UpgradePersonalToTeamError CreateUserTeam
-> Union (ResponseTypes UpgradePersonalToTeamResponses)
toUnion (Left UpgradePersonalToTeamError
UpgradePersonalToTeamErrorAlreadyInATeam) =
    I DynError -> NS I '[DynError, DynError, CreateUserTeam]
forall {k} (a :: k -> *) (x :: k) (xs :: [k]). a x -> NS a (x : xs)
Z (DynError -> I DynError
forall a. a -> I a
I (forall (e :: StaticError). KnownError e => DynError
dynError @(MapError UserAlreadyInATeam)))
  toUnion (Left UpgradePersonalToTeamError
UpgradePersonalToTeamErrorUserNotFound) =
    NS I '[DynError, CreateUserTeam]
-> NS I '[DynError, DynError, CreateUserTeam]
forall {k} (a :: k -> *) (xs :: [k]) (x :: k).
NS a xs -> NS a (x : xs)
S (I DynError -> NS I '[DynError, CreateUserTeam]
forall {k} (a :: k -> *) (x :: k) (xs :: [k]). a x -> NS a (x : xs)
Z (DynError -> I DynError
forall a. a -> I a
I (forall (e :: StaticError). KnownError e => DynError
dynError @(MapError UserNotFound))))
  toUnion (Right CreateUserTeam
x) = NS I '[DynError, CreateUserTeam]
-> NS I '[DynError, DynError, CreateUserTeam]
forall {k} (a :: k -> *) (xs :: [k]) (x :: k).
NS a xs -> NS a (x : xs)
S (NS I '[CreateUserTeam] -> NS I '[DynError, CreateUserTeam]
forall {k} (a :: k -> *) (xs :: [k]) (x :: k).
NS a xs -> NS a (x : xs)
S (I CreateUserTeam -> NS I '[CreateUserTeam]
forall {k} (a :: k -> *) (x :: k) (xs :: [k]). a x -> NS a (x : xs)
Z (CreateUserTeam -> I CreateUserTeam
forall a. a -> I a
I CreateUserTeam
x)))

  fromUnion :: Union (ResponseTypes UpgradePersonalToTeamResponses)
-> Either UpgradePersonalToTeamError CreateUserTeam
fromUnion (Z (I x
_)) = UpgradePersonalToTeamError
-> Either UpgradePersonalToTeamError CreateUserTeam
forall a b. a -> Either a b
Left UpgradePersonalToTeamError
UpgradePersonalToTeamErrorAlreadyInATeam
  fromUnion (S (Z (I x
_))) = UpgradePersonalToTeamError
-> Either UpgradePersonalToTeamError CreateUserTeam
forall a b. a -> Either a b
Left UpgradePersonalToTeamError
UpgradePersonalToTeamErrorAlreadyInATeam
  fromUnion (S (S (Z (I x
x)))) = CreateUserTeam -> Either UpgradePersonalToTeamError CreateUserTeam
forall a b. b -> Either a b
Right x
CreateUserTeam
x
  fromUnion (S (S (S NS I xs
x))) = case NS I xs
x of {}

data RegisterError
  = RegisterErrorAllowlistError
  | RegisterErrorInvalidInvitationCode
  | RegisterErrorMissingIdentity
  | RegisterErrorUserKeyExists
  | RegisterErrorInvalidActivationCodeWrongUser
  | RegisterErrorInvalidActivationCodeWrongCode
  | RegisterErrorInvalidEmail
  | RegisterErrorInvalidPhone
  | RegisterErrorBlacklistedEmail
  | RegisterErrorTooManyTeamMembers
  | RegisterErrorUserCreationRestricted
  deriving (Int -> RegisterError -> ShowS
[RegisterError] -> ShowS
RegisterError -> String
(Int -> RegisterError -> ShowS)
-> (RegisterError -> String)
-> ([RegisterError] -> ShowS)
-> Show RegisterError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> RegisterError -> ShowS
showsPrec :: Int -> RegisterError -> ShowS
$cshow :: RegisterError -> String
show :: RegisterError -> String
$cshowList :: [RegisterError] -> ShowS
showList :: [RegisterError] -> ShowS
Show, (forall x. RegisterError -> Rep RegisterError x)
-> (forall x. Rep RegisterError x -> RegisterError)
-> Generic RegisterError
forall x. Rep RegisterError x -> RegisterError
forall x. RegisterError -> Rep RegisterError x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. RegisterError -> Rep RegisterError x
from :: forall x. RegisterError -> Rep RegisterError x
$cto :: forall x. Rep RegisterError x -> RegisterError
to :: forall x. Rep RegisterError x -> RegisterError
Generic)
  deriving (AsUnion RegisterErrorResponses) via GenericAsUnion RegisterErrorResponses RegisterError

instance GSOP.Generic RegisterError

type RegisterErrorResponses =
  '[ ErrorResponse 'AllowlistError,
     ErrorResponse 'InvalidInvitationCode,
     ErrorResponse 'MissingIdentity,
     ErrorResponse 'UserKeyExists,
     ErrorResponse 'InvalidActivationCodeWrongUser,
     ErrorResponse 'InvalidActivationCodeWrongCode,
     ErrorResponse 'InvalidEmail,
     ErrorResponse 'InvalidPhone,
     ErrorResponse 'BlacklistedEmail,
     ErrorResponse 'TooManyTeamMembers,
     ErrorResponse 'UserCreationRestricted
   ]

type RegisterResponses =
  RegisterErrorResponses
    .++ '[ WithHeaders
             '[ DescHeader "Set-Cookie" "Cookie" Web.SetCookie,
                DescHeader "Location" "UserId" UserId
              ]
             RegisterSuccess
             (Respond 201 "User created and pending activation" SelfProfile)
         ]

instance AsHeaders '[Web.SetCookie, UserId] SelfProfile RegisterSuccess where
  fromHeaders :: (NP I '[SetCookie, UserId], SelfProfile) -> RegisterSuccess
fromHeaders (I x
cookie :* (I x
_ :* NP I xs
Nil), SelfProfile
sp) = SetCookie -> SelfProfile -> RegisterSuccess
RegisterSuccess x
SetCookie
cookie SelfProfile
sp
  toHeaders :: RegisterSuccess -> (NP I '[SetCookie, UserId], SelfProfile)
toHeaders (RegisterSuccess SetCookie
cookie SelfProfile
sp) = (SetCookie -> I SetCookie
forall a. a -> I a
I SetCookie
cookie I SetCookie -> NP I '[UserId] -> NP I '[SetCookie, UserId]
forall {k} (a :: k -> *) (x :: k) (xs :: [k]).
a x -> NP a xs -> NP a (x : xs)
:* (UserId -> I UserId
forall a. a -> I a
I (User -> UserId
userId (SelfProfile -> User
selfUser SelfProfile
sp)) I UserId -> NP I '[] -> NP I '[UserId]
forall {k} (a :: k -> *) (x :: k) (xs :: [k]).
a x -> NP a xs -> NP a (x : xs)
:* NP I '[]
forall {k} (a :: k -> *). NP a '[]
Nil), SelfProfile
sp)

data RegisterSuccess = RegisterSuccess Web.SetCookie SelfProfile

instance (res ~ RegisterResponses) => AsUnion res (Either RegisterError RegisterSuccess) where
  toUnion :: Either RegisterError RegisterSuccess -> Union (ResponseTypes res)
toUnion = (RegisterError
 -> Union
      '[DynError, DynError, DynError, DynError, DynError, DynError,
        DynError, DynError, DynError, DynError, DynError])
-> (RegisterSuccess -> Union '[RegisterSuccess])
-> Either RegisterError RegisterSuccess
-> Union
     ('[DynError, DynError, DynError, DynError, DynError, DynError,
        DynError, DynError, DynError, DynError, DynError]
      .++ '[RegisterSuccess])
forall (as :: [*]) (bs :: [*]) a b.
(InjectAfter as bs, InjectBefore as bs) =>
(a -> Union as)
-> (b -> Union bs) -> Either a b -> Union (as .++ bs)
eitherToUnion (forall (as :: [*]) r. AsUnion as r => r -> Union (ResponseTypes as)
toUnion @RegisterErrorResponses) (I RegisterSuccess -> Union '[RegisterSuccess]
forall {k} (a :: k -> *) (x :: k) (xs :: [k]). a x -> NS a (x : xs)
Z (I RegisterSuccess -> Union '[RegisterSuccess])
-> (RegisterSuccess -> I RegisterSuccess)
-> RegisterSuccess
-> Union '[RegisterSuccess]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RegisterSuccess -> I RegisterSuccess
forall a. a -> I a
I)
  fromUnion :: Union (ResponseTypes res) -> Either RegisterError RegisterSuccess
fromUnion = (Union
   '[DynError, DynError, DynError, DynError, DynError, DynError,
     DynError, DynError, DynError, DynError, DynError]
 -> RegisterError)
-> (Union '[RegisterSuccess] -> RegisterSuccess)
-> Union
     ('[DynError, DynError, DynError, DynError, DynError, DynError,
        DynError, DynError, DynError, DynError, DynError]
      .++ '[RegisterSuccess])
-> Either RegisterError RegisterSuccess
forall (as :: [*]) (bs :: [*]) a b.
EitherFromUnion as bs =>
(Union as -> a)
-> (Union bs -> b) -> Union (as .++ bs) -> Either a b
forall a b.
(Union
   '[DynError, DynError, DynError, DynError, DynError, DynError,
     DynError, DynError, DynError, DynError, DynError]
 -> a)
-> (Union '[RegisterSuccess] -> b)
-> Union
     ('[DynError, DynError, DynError, DynError, DynError, DynError,
        DynError, DynError, DynError, DynError, DynError]
      .++ '[RegisterSuccess])
-> Either a b
eitherFromUnion (forall (as :: [*]) r. AsUnion as r => Union (ResponseTypes as) -> r
fromUnion @RegisterErrorResponses) (I RegisterSuccess -> RegisterSuccess
forall a. I a -> a
unI (I RegisterSuccess -> RegisterSuccess)
-> (Union '[RegisterSuccess] -> I RegisterSuccess)
-> Union '[RegisterSuccess]
-> RegisterSuccess
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Union '[RegisterSuccess] -> I RegisterSuccess
forall {k} (f :: k -> *) (x :: k). NS f '[x] -> f x
unZ)

type RegisterInternalResponses =
  RegisterErrorResponses
    .++ '[ WithHeaders
             '[DescHeader "Location" "UserId" UserId]
             SelfProfile
             (Respond 201 "User created and pending activation" SelfProfile)
         ]

instance AsHeaders '[UserId] SelfProfile SelfProfile where
  fromHeaders :: (NP I '[UserId], SelfProfile) -> SelfProfile
fromHeaders (I x
_ :* NP I xs
Nil, SelfProfile
sp) = SelfProfile
sp
  toHeaders :: SelfProfile -> (NP I '[UserId], SelfProfile)
toHeaders SelfProfile
sp = (UserId -> I UserId
forall a. a -> I a
I (User -> UserId
userId (SelfProfile -> User
selfUser SelfProfile
sp)) I UserId -> NP I '[] -> NP I '[UserId]
forall {k} (a :: k -> *) (x :: k) (xs :: [k]).
a x -> NP a xs -> NP a (x : xs)
:* NP I '[]
forall {k} (a :: k -> *). NP a '[]
Nil, SelfProfile
sp)

instance (res ~ RegisterInternalResponses) => AsUnion res (Either RegisterError SelfProfile) where
  toUnion :: Either RegisterError SelfProfile -> Union (ResponseTypes res)
toUnion = (RegisterError
 -> Union
      '[DynError, DynError, DynError, DynError, DynError, DynError,
        DynError, DynError, DynError, DynError, DynError])
-> (SelfProfile -> Union '[SelfProfile])
-> Either RegisterError SelfProfile
-> Union
     ('[DynError, DynError, DynError, DynError, DynError, DynError,
        DynError, DynError, DynError, DynError, DynError]
      .++ '[SelfProfile])
forall (as :: [*]) (bs :: [*]) a b.
(InjectAfter as bs, InjectBefore as bs) =>
(a -> Union as)
-> (b -> Union bs) -> Either a b -> Union (as .++ bs)
eitherToUnion (forall (as :: [*]) r. AsUnion as r => r -> Union (ResponseTypes as)
toUnion @RegisterErrorResponses) (I SelfProfile -> Union '[SelfProfile]
forall {k} (a :: k -> *) (x :: k) (xs :: [k]). a x -> NS a (x : xs)
Z (I SelfProfile -> Union '[SelfProfile])
-> (SelfProfile -> I SelfProfile)
-> SelfProfile
-> Union '[SelfProfile]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SelfProfile -> I SelfProfile
forall a. a -> I a
I)
  fromUnion :: Union (ResponseTypes res) -> Either RegisterError SelfProfile
fromUnion = (Union
   '[DynError, DynError, DynError, DynError, DynError, DynError,
     DynError, DynError, DynError, DynError, DynError]
 -> RegisterError)
-> (Union '[SelfProfile] -> SelfProfile)
-> Union
     ('[DynError, DynError, DynError, DynError, DynError, DynError,
        DynError, DynError, DynError, DynError, DynError]
      .++ '[SelfProfile])
-> Either RegisterError SelfProfile
forall (as :: [*]) (bs :: [*]) a b.
EitherFromUnion as bs =>
(Union as -> a)
-> (Union bs -> b) -> Union (as .++ bs) -> Either a b
forall a b.
(Union
   '[DynError, DynError, DynError, DynError, DynError, DynError,
     DynError, DynError, DynError, DynError, DynError]
 -> a)
-> (Union '[SelfProfile] -> b)
-> Union
     ('[DynError, DynError, DynError, DynError, DynError, DynError,
        DynError, DynError, DynError, DynError, DynError]
      .++ '[SelfProfile])
-> Either a b
eitherFromUnion (forall (as :: [*]) r. AsUnion as r => Union (ResponseTypes as) -> r
fromUnion @RegisterErrorResponses) (I SelfProfile -> SelfProfile
forall a. I a -> a
unI (I SelfProfile -> SelfProfile)
-> (Union '[SelfProfile] -> I SelfProfile)
-> Union '[SelfProfile]
-> SelfProfile
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Union '[SelfProfile] -> I SelfProfile
forall {k} (f :: k -> *) (x :: k). NS f '[x] -> f x
unZ)

urefToExternalId :: SAML.UserRef -> Maybe Text
urefToExternalId :: UserRef -> Maybe Text
urefToExternalId = (CI Text -> Text) -> Maybe (CI Text) -> Maybe Text
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap CI Text -> Text
forall s. CI s -> s
CI.original (Maybe (CI Text) -> Maybe Text)
-> (UserRef -> Maybe (CI Text)) -> UserRef -> Maybe Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NameID -> Maybe (CI Text)
SAML.shortShowNameID (NameID -> Maybe (CI Text))
-> (UserRef -> NameID) -> UserRef -> Maybe (CI Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting NameID UserRef NameID -> UserRef -> NameID
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting NameID UserRef NameID
Lens' UserRef NameID
SAML.uidSubject

data CreateUserSparError
  = CreateUserSparHandleError ChangeHandleError
  | CreateUserSparRegistrationError RegisterError
  deriving (Int -> CreateUserSparError -> ShowS
[CreateUserSparError] -> ShowS
CreateUserSparError -> String
(Int -> CreateUserSparError -> ShowS)
-> (CreateUserSparError -> String)
-> ([CreateUserSparError] -> ShowS)
-> Show CreateUserSparError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CreateUserSparError -> ShowS
showsPrec :: Int -> CreateUserSparError -> ShowS
$cshow :: CreateUserSparError -> String
show :: CreateUserSparError -> String
$cshowList :: [CreateUserSparError] -> ShowS
showList :: [CreateUserSparError] -> ShowS
Show, (forall x. CreateUserSparError -> Rep CreateUserSparError x)
-> (forall x. Rep CreateUserSparError x -> CreateUserSparError)
-> Generic CreateUserSparError
forall x. Rep CreateUserSparError x -> CreateUserSparError
forall x. CreateUserSparError -> Rep CreateUserSparError x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. CreateUserSparError -> Rep CreateUserSparError x
from :: forall x. CreateUserSparError -> Rep CreateUserSparError x
$cto :: forall x. Rep CreateUserSparError x -> CreateUserSparError
to :: forall x. Rep CreateUserSparError x -> CreateUserSparError
Generic)

type CreateUserSparErrorResponses =
  RegisterErrorResponses .++ ChangeHandleErrorResponses

type CreateUserSparResponses =
  CreateUserSparErrorResponses
    .++ '[ WithHeaders
             '[ DescHeader "Set-Cookie" "Cookie" Web.SetCookie,
                DescHeader "Location" "UserId" UserId
              ]
             RegisterSuccess
             (Respond 201 "User created and pending activation" SelfProfile)
         ]

type CreateUserSparInternalResponses =
  CreateUserSparErrorResponses
    .++ '[ WithHeaders
             '[DescHeader "Location" "UserId" UserId]
             SelfProfile
             (Respond 201 "User created and pending activation" SelfProfile)
         ]

instance (res ~ CreateUserSparErrorResponses) => AsUnion res CreateUserSparError where
  toUnion :: CreateUserSparError -> Union (ResponseTypes res)
toUnion = (ChangeHandleError
 -> Union '[DynError, DynError, DynError, DynError])
-> (RegisterError
    -> Union
         '[DynError, DynError, DynError, DynError, DynError, DynError,
           DynError, DynError, DynError, DynError, DynError])
-> Either ChangeHandleError RegisterError
-> Union
     ('[DynError, DynError, DynError, DynError]
      .++ '[DynError, DynError, DynError, DynError, DynError, DynError,
            DynError, DynError, DynError, DynError, DynError])
forall (as :: [*]) (bs :: [*]) a b.
(InjectAfter as bs, InjectBefore as bs) =>
(a -> Union as)
-> (b -> Union bs) -> Either a b -> Union (as .++ bs)
eitherToUnion (forall (as :: [*]) r. AsUnion as r => r -> Union (ResponseTypes as)
toUnion @ChangeHandleErrorResponses) (forall (as :: [*]) r. AsUnion as r => r -> Union (ResponseTypes as)
toUnion @RegisterErrorResponses) (Either ChangeHandleError RegisterError
 -> NS
      I
      '[DynError, DynError, DynError, DynError, DynError, DynError,
        DynError, DynError, DynError, DynError, DynError, DynError,
        DynError, DynError, DynError])
-> (CreateUserSparError -> Either ChangeHandleError RegisterError)
-> CreateUserSparError
-> NS
     I
     '[DynError, DynError, DynError, DynError, DynError, DynError,
       DynError, DynError, DynError, DynError, DynError, DynError,
       DynError, DynError, DynError]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CreateUserSparError -> Either ChangeHandleError RegisterError
errToEither
  fromUnion :: Union (ResponseTypes res) -> CreateUserSparError
fromUnion = Either ChangeHandleError RegisterError -> CreateUserSparError
errFromEither (Either ChangeHandleError RegisterError -> CreateUserSparError)
-> (NS
      I
      '[DynError, DynError, DynError, DynError, DynError, DynError,
        DynError, DynError, DynError, DynError, DynError, DynError,
        DynError, DynError, DynError]
    -> Either ChangeHandleError RegisterError)
-> NS
     I
     '[DynError, DynError, DynError, DynError, DynError, DynError,
       DynError, DynError, DynError, DynError, DynError, DynError,
       DynError, DynError, DynError]
-> CreateUserSparError
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Union '[DynError, DynError, DynError, DynError]
 -> ChangeHandleError)
-> (Union
      '[DynError, DynError, DynError, DynError, DynError, DynError,
        DynError, DynError, DynError, DynError, DynError]
    -> RegisterError)
-> Union
     ('[DynError, DynError, DynError, DynError]
      .++ '[DynError, DynError, DynError, DynError, DynError, DynError,
            DynError, DynError, DynError, DynError, DynError])
-> Either ChangeHandleError RegisterError
forall (as :: [*]) (bs :: [*]) a b.
EitherFromUnion as bs =>
(Union as -> a)
-> (Union bs -> b) -> Union (as .++ bs) -> Either a b
forall a b.
(Union '[DynError, DynError, DynError, DynError] -> a)
-> (Union
      '[DynError, DynError, DynError, DynError, DynError, DynError,
        DynError, DynError, DynError, DynError, DynError]
    -> b)
-> Union
     ('[DynError, DynError, DynError, DynError]
      .++ '[DynError, DynError, DynError, DynError, DynError, DynError,
            DynError, DynError, DynError, DynError, DynError])
-> Either a b
eitherFromUnion (forall (as :: [*]) r. AsUnion as r => Union (ResponseTypes as) -> r
fromUnion @ChangeHandleErrorResponses) (forall (as :: [*]) r. AsUnion as r => Union (ResponseTypes as) -> r
fromUnion @RegisterErrorResponses)

instance (res ~ CreateUserSparResponses) => AsUnion res (Either CreateUserSparError RegisterSuccess) where
  toUnion :: Either CreateUserSparError RegisterSuccess
-> Union (ResponseTypes res)
toUnion = (CreateUserSparError
 -> NS
      I
      '[DynError, DynError, DynError, DynError, DynError, DynError,
        DynError, DynError, DynError, DynError, DynError, DynError,
        DynError, DynError, DynError])
-> (RegisterSuccess -> Union '[RegisterSuccess])
-> Either CreateUserSparError RegisterSuccess
-> Union
     ('[DynError, DynError, DynError, DynError, DynError, DynError,
        DynError, DynError, DynError, DynError, DynError, DynError,
        DynError, DynError, DynError]
      .++ '[RegisterSuccess])
forall (as :: [*]) (bs :: [*]) a b.
(InjectAfter as bs, InjectBefore as bs) =>
(a -> Union as)
-> (b -> Union bs) -> Either a b -> Union (as .++ bs)
eitherToUnion (forall (as :: [*]) r. AsUnion as r => r -> Union (ResponseTypes as)
toUnion @CreateUserSparErrorResponses) (I RegisterSuccess -> Union '[RegisterSuccess]
forall {k} (a :: k -> *) (x :: k) (xs :: [k]). a x -> NS a (x : xs)
Z (I RegisterSuccess -> Union '[RegisterSuccess])
-> (RegisterSuccess -> I RegisterSuccess)
-> RegisterSuccess
-> Union '[RegisterSuccess]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RegisterSuccess -> I RegisterSuccess
forall a. a -> I a
I)
  fromUnion :: Union (ResponseTypes res)
-> Either CreateUserSparError RegisterSuccess
fromUnion = (NS
   I
   '[DynError, DynError, DynError, DynError, DynError, DynError,
     DynError, DynError, DynError, DynError, DynError, DynError,
     DynError, DynError, DynError]
 -> CreateUserSparError)
-> (Union '[RegisterSuccess] -> RegisterSuccess)
-> Union
     ('[DynError, DynError, DynError, DynError, DynError, DynError,
        DynError, DynError, DynError, DynError, DynError, DynError,
        DynError, DynError, DynError]
      .++ '[RegisterSuccess])
-> Either CreateUserSparError RegisterSuccess
forall (as :: [*]) (bs :: [*]) a b.
EitherFromUnion as bs =>
(Union as -> a)
-> (Union bs -> b) -> Union (as .++ bs) -> Either a b
forall a b.
(NS
   I
   '[DynError, DynError, DynError, DynError, DynError, DynError,
     DynError, DynError, DynError, DynError, DynError, DynError,
     DynError, DynError, DynError]
 -> a)
-> (Union '[RegisterSuccess] -> b)
-> Union
     ('[DynError, DynError, DynError, DynError, DynError, DynError,
        DynError, DynError, DynError, DynError, DynError, DynError,
        DynError, DynError, DynError]
      .++ '[RegisterSuccess])
-> Either a b
eitherFromUnion (forall (as :: [*]) r. AsUnion as r => Union (ResponseTypes as) -> r
fromUnion @CreateUserSparErrorResponses) (I RegisterSuccess -> RegisterSuccess
forall a. I a -> a
unI (I RegisterSuccess -> RegisterSuccess)
-> (Union '[RegisterSuccess] -> I RegisterSuccess)
-> Union '[RegisterSuccess]
-> RegisterSuccess
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Union '[RegisterSuccess] -> I RegisterSuccess
forall {k} (f :: k -> *) (x :: k). NS f '[x] -> f x
unZ)

instance (res ~ CreateUserSparInternalResponses) => AsUnion res (Either CreateUserSparError SelfProfile) where
  toUnion :: Either CreateUserSparError SelfProfile -> Union (ResponseTypes res)
toUnion = (CreateUserSparError
 -> NS
      I
      '[DynError, DynError, DynError, DynError, DynError, DynError,
        DynError, DynError, DynError, DynError, DynError, DynError,
        DynError, DynError, DynError])
-> (SelfProfile -> Union '[SelfProfile])
-> Either CreateUserSparError SelfProfile
-> Union
     ('[DynError, DynError, DynError, DynError, DynError, DynError,
        DynError, DynError, DynError, DynError, DynError, DynError,
        DynError, DynError, DynError]
      .++ '[SelfProfile])
forall (as :: [*]) (bs :: [*]) a b.
(InjectAfter as bs, InjectBefore as bs) =>
(a -> Union as)
-> (b -> Union bs) -> Either a b -> Union (as .++ bs)
eitherToUnion (forall (as :: [*]) r. AsUnion as r => r -> Union (ResponseTypes as)
toUnion @CreateUserSparErrorResponses) (I SelfProfile -> Union '[SelfProfile]
forall {k} (a :: k -> *) (x :: k) (xs :: [k]). a x -> NS a (x : xs)
Z (I SelfProfile -> Union '[SelfProfile])
-> (SelfProfile -> I SelfProfile)
-> SelfProfile
-> Union '[SelfProfile]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SelfProfile -> I SelfProfile
forall a. a -> I a
I)
  fromUnion :: Union (ResponseTypes res) -> Either CreateUserSparError SelfProfile
fromUnion = (NS
   I
   '[DynError, DynError, DynError, DynError, DynError, DynError,
     DynError, DynError, DynError, DynError, DynError, DynError,
     DynError, DynError, DynError]
 -> CreateUserSparError)
-> (Union '[SelfProfile] -> SelfProfile)
-> Union
     ('[DynError, DynError, DynError, DynError, DynError, DynError,
        DynError, DynError, DynError, DynError, DynError, DynError,
        DynError, DynError, DynError]
      .++ '[SelfProfile])
-> Either CreateUserSparError SelfProfile
forall (as :: [*]) (bs :: [*]) a b.
EitherFromUnion as bs =>
(Union as -> a)
-> (Union bs -> b) -> Union (as .++ bs) -> Either a b
forall a b.
(NS
   I
   '[DynError, DynError, DynError, DynError, DynError, DynError,
     DynError, DynError, DynError, DynError, DynError, DynError,
     DynError, DynError, DynError]
 -> a)
-> (Union '[SelfProfile] -> b)
-> Union
     ('[DynError, DynError, DynError, DynError, DynError, DynError,
        DynError, DynError, DynError, DynError, DynError, DynError,
        DynError, DynError, DynError]
      .++ '[SelfProfile])
-> Either a b
eitherFromUnion (forall (as :: [*]) r. AsUnion as r => Union (ResponseTypes as) -> r
fromUnion @CreateUserSparErrorResponses) (I SelfProfile -> SelfProfile
forall a. I a -> a
unI (I SelfProfile -> SelfProfile)
-> (Union '[SelfProfile] -> I SelfProfile)
-> Union '[SelfProfile]
-> SelfProfile
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Union '[SelfProfile] -> I SelfProfile
forall {k} (f :: k -> *) (x :: k). NS f '[x] -> f x
unZ)

errToEither :: CreateUserSparError -> Either ChangeHandleError RegisterError
errToEither :: CreateUserSparError -> Either ChangeHandleError RegisterError
errToEither (CreateUserSparHandleError ChangeHandleError
e) = ChangeHandleError -> Either ChangeHandleError RegisterError
forall a b. a -> Either a b
Left ChangeHandleError
e
errToEither (CreateUserSparRegistrationError RegisterError
e) = RegisterError -> Either ChangeHandleError RegisterError
forall a b. b -> Either a b
Right RegisterError
e

errFromEither :: Either ChangeHandleError RegisterError -> CreateUserSparError
errFromEither :: Either ChangeHandleError RegisterError -> CreateUserSparError
errFromEither (Left ChangeHandleError
e) = ChangeHandleError -> CreateUserSparError
CreateUserSparHandleError ChangeHandleError
e
errFromEither (Right RegisterError
e) = RegisterError -> CreateUserSparError
CreateUserSparRegistrationError RegisterError
e

data NewUserSpar = NewUserSpar
  { NewUserSpar -> UUID
newUserSparUUID :: UUID,
    NewUserSpar -> UserSSOId
newUserSparSSOId :: UserSSOId,
    NewUserSpar -> Name
newUserSparDisplayName :: Name,
    NewUserSpar -> TeamId
newUserSparTeamId :: TeamId,
    NewUserSpar -> ManagedBy
newUserSparManagedBy :: ManagedBy,
    NewUserSpar -> Maybe Handle
newUserSparHandle :: Maybe Handle,
    NewUserSpar -> Maybe RichInfo
newUserSparRichInfo :: Maybe RichInfo,
    NewUserSpar -> Maybe Locale
newUserSparLocale :: Maybe Locale,
    NewUserSpar -> Role
newUserSparRole :: Role
  }
  deriving stock (NewUserSpar -> NewUserSpar -> Bool
(NewUserSpar -> NewUserSpar -> Bool)
-> (NewUserSpar -> NewUserSpar -> Bool) -> Eq NewUserSpar
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: NewUserSpar -> NewUserSpar -> Bool
== :: NewUserSpar -> NewUserSpar -> Bool
$c/= :: NewUserSpar -> NewUserSpar -> Bool
/= :: NewUserSpar -> NewUserSpar -> Bool
Eq, Int -> NewUserSpar -> ShowS
[NewUserSpar] -> ShowS
NewUserSpar -> String
(Int -> NewUserSpar -> ShowS)
-> (NewUserSpar -> String)
-> ([NewUserSpar] -> ShowS)
-> Show NewUserSpar
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> NewUserSpar -> ShowS
showsPrec :: Int -> NewUserSpar -> ShowS
$cshow :: NewUserSpar -> String
show :: NewUserSpar -> String
$cshowList :: [NewUserSpar] -> ShowS
showList :: [NewUserSpar] -> ShowS
Show, (forall x. NewUserSpar -> Rep NewUserSpar x)
-> (forall x. Rep NewUserSpar x -> NewUserSpar)
-> Generic NewUserSpar
forall x. Rep NewUserSpar x -> NewUserSpar
forall x. NewUserSpar -> Rep NewUserSpar x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. NewUserSpar -> Rep NewUserSpar x
from :: forall x. NewUserSpar -> Rep NewUserSpar x
$cto :: forall x. Rep NewUserSpar x -> NewUserSpar
to :: forall x. Rep NewUserSpar x -> NewUserSpar
Generic)
  deriving ([NewUserSpar] -> Value
[NewUserSpar] -> Encoding
NewUserSpar -> Value
NewUserSpar -> Encoding
(NewUserSpar -> Value)
-> (NewUserSpar -> Encoding)
-> ([NewUserSpar] -> Value)
-> ([NewUserSpar] -> Encoding)
-> ToJSON NewUserSpar
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: NewUserSpar -> Value
toJSON :: NewUserSpar -> Value
$ctoEncoding :: NewUserSpar -> Encoding
toEncoding :: NewUserSpar -> Encoding
$ctoJSONList :: [NewUserSpar] -> Value
toJSONList :: [NewUserSpar] -> Value
$ctoEncodingList :: [NewUserSpar] -> Encoding
toEncodingList :: [NewUserSpar] -> Encoding
ToJSON, Value -> Parser [NewUserSpar]
Value -> Parser NewUserSpar
(Value -> Parser NewUserSpar)
-> (Value -> Parser [NewUserSpar]) -> FromJSON NewUserSpar
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser NewUserSpar
parseJSON :: Value -> Parser NewUserSpar
$cparseJSONList :: Value -> Parser [NewUserSpar]
parseJSONList :: Value -> Parser [NewUserSpar]
FromJSON, Typeable NewUserSpar
Typeable NewUserSpar =>
(Proxy NewUserSpar -> Declare (Definitions Schema) NamedSchema)
-> ToSchema NewUserSpar
Proxy NewUserSpar -> Declare (Definitions Schema) NamedSchema
forall a.
Typeable a =>
(Proxy a -> Declare (Definitions Schema) NamedSchema) -> ToSchema a
$cdeclareNamedSchema :: Proxy NewUserSpar -> Declare (Definitions Schema) NamedSchema
declareNamedSchema :: Proxy NewUserSpar -> Declare (Definitions Schema) NamedSchema
S.ToSchema) via (Schema NewUserSpar)

instance ToSchema NewUserSpar where
  schema :: ValueSchema NamedSwaggerDoc NewUserSpar
schema =
    Text
-> SchemaP SwaggerDoc Object [Pair] NewUserSpar NewUserSpar
-> ValueSchema NamedSwaggerDoc NewUserSpar
forall doc doc' a b.
HasObject doc doc' =>
Text
-> SchemaP doc Object [Pair] a b -> SchemaP doc' Value Value a b
object Text
"NewUserSpar" (SchemaP SwaggerDoc Object [Pair] NewUserSpar NewUserSpar
 -> ValueSchema NamedSwaggerDoc NewUserSpar)
-> SchemaP SwaggerDoc Object [Pair] NewUserSpar NewUserSpar
-> ValueSchema NamedSwaggerDoc NewUserSpar
forall a b. (a -> b) -> a -> b
$
      UUID
-> UserSSOId
-> Name
-> TeamId
-> ManagedBy
-> Maybe Handle
-> Maybe RichInfo
-> Maybe Locale
-> Role
-> NewUserSpar
NewUserSpar
        (UUID
 -> UserSSOId
 -> Name
 -> TeamId
 -> ManagedBy
 -> Maybe Handle
 -> Maybe RichInfo
 -> Maybe Locale
 -> Role
 -> NewUserSpar)
-> SchemaP SwaggerDoc Object [Pair] NewUserSpar UUID
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     NewUserSpar
     (UserSSOId
      -> Name
      -> TeamId
      -> ManagedBy
      -> Maybe Handle
      -> Maybe RichInfo
      -> Maybe Locale
      -> Role
      -> NewUserSpar)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NewUserSpar -> UUID
newUserSparUUID
          (NewUserSpar -> UUID)
-> SchemaP SwaggerDoc Object [Pair] UUID UUID
-> SchemaP SwaggerDoc Object [Pair] NewUserSpar UUID
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= Text
-> SchemaP NamedSwaggerDoc Value Value UUID UUID
-> SchemaP SwaggerDoc Object [Pair] UUID UUID
forall doc' doc a b.
HasField doc' doc =>
Text
-> SchemaP doc' Value Value a b -> SchemaP doc Object [Pair] a b
field Text
"newUserSparUUID" SchemaP NamedSwaggerDoc Value Value UUID UUID
forall a.
(ToSchema a, ToJSON a, FromJSON a) =>
ValueSchema NamedSwaggerDoc a
genericToSchema
        SchemaP
  SwaggerDoc
  Object
  [Pair]
  NewUserSpar
  (UserSSOId
   -> Name
   -> TeamId
   -> ManagedBy
   -> Maybe Handle
   -> Maybe RichInfo
   -> Maybe Locale
   -> Role
   -> NewUserSpar)
-> SchemaP SwaggerDoc Object [Pair] NewUserSpar UserSSOId
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     NewUserSpar
     (Name
      -> TeamId
      -> ManagedBy
      -> Maybe Handle
      -> Maybe RichInfo
      -> Maybe Locale
      -> Role
      -> NewUserSpar)
forall a b.
SchemaP SwaggerDoc Object [Pair] NewUserSpar (a -> b)
-> SchemaP SwaggerDoc Object [Pair] NewUserSpar a
-> SchemaP SwaggerDoc Object [Pair] NewUserSpar b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> NewUserSpar -> UserSSOId
newUserSparSSOId
          (NewUserSpar -> UserSSOId)
-> SchemaP SwaggerDoc Object [Pair] UserSSOId UserSSOId
-> SchemaP SwaggerDoc Object [Pair] NewUserSpar UserSSOId
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= Text
-> SchemaP NamedSwaggerDoc Value Value UserSSOId UserSSOId
-> SchemaP SwaggerDoc Object [Pair] UserSSOId UserSSOId
forall doc' doc a b.
HasField doc' doc =>
Text
-> SchemaP doc' Value Value a b -> SchemaP doc Object [Pair] a b
field Text
"newUserSparSSOId" SchemaP NamedSwaggerDoc Value Value UserSSOId UserSSOId
forall a.
(ToSchema a, ToJSON a, FromJSON a) =>
ValueSchema NamedSwaggerDoc a
genericToSchema
        SchemaP
  SwaggerDoc
  Object
  [Pair]
  NewUserSpar
  (Name
   -> TeamId
   -> ManagedBy
   -> Maybe Handle
   -> Maybe RichInfo
   -> Maybe Locale
   -> Role
   -> NewUserSpar)
-> SchemaP SwaggerDoc Object [Pair] NewUserSpar Name
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     NewUserSpar
     (TeamId
      -> ManagedBy
      -> Maybe Handle
      -> Maybe RichInfo
      -> Maybe Locale
      -> Role
      -> NewUserSpar)
forall a b.
SchemaP SwaggerDoc Object [Pair] NewUserSpar (a -> b)
-> SchemaP SwaggerDoc Object [Pair] NewUserSpar a
-> SchemaP SwaggerDoc Object [Pair] NewUserSpar b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> NewUserSpar -> Name
newUserSparDisplayName
          (NewUserSpar -> Name)
-> SchemaP SwaggerDoc Object [Pair] Name Name
-> SchemaP SwaggerDoc Object [Pair] NewUserSpar Name
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= Text
-> SchemaP NamedSwaggerDoc Value Value Name Name
-> SchemaP SwaggerDoc Object [Pair] Name Name
forall doc' doc a b.
HasField doc' doc =>
Text
-> SchemaP doc' Value Value a b -> SchemaP doc Object [Pair] a b
field Text
"newUserSparDisplayName" SchemaP NamedSwaggerDoc Value Value Name Name
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema
        SchemaP
  SwaggerDoc
  Object
  [Pair]
  NewUserSpar
  (TeamId
   -> ManagedBy
   -> Maybe Handle
   -> Maybe RichInfo
   -> Maybe Locale
   -> Role
   -> NewUserSpar)
-> SchemaP SwaggerDoc Object [Pair] NewUserSpar TeamId
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     NewUserSpar
     (ManagedBy
      -> Maybe Handle
      -> Maybe RichInfo
      -> Maybe Locale
      -> Role
      -> NewUserSpar)
forall a b.
SchemaP SwaggerDoc Object [Pair] NewUserSpar (a -> b)
-> SchemaP SwaggerDoc Object [Pair] NewUserSpar a
-> SchemaP SwaggerDoc Object [Pair] NewUserSpar b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> NewUserSpar -> TeamId
newUserSparTeamId
          (NewUserSpar -> TeamId)
-> SchemaP SwaggerDoc Object [Pair] TeamId TeamId
-> SchemaP SwaggerDoc Object [Pair] NewUserSpar TeamId
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= Text
-> SchemaP NamedSwaggerDoc Value Value TeamId TeamId
-> SchemaP SwaggerDoc Object [Pair] TeamId TeamId
forall doc' doc a b.
HasField doc' doc =>
Text
-> SchemaP doc' Value Value a b -> SchemaP doc Object [Pair] a b
field Text
"newUserSparTeamId" SchemaP NamedSwaggerDoc Value Value TeamId TeamId
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema
        SchemaP
  SwaggerDoc
  Object
  [Pair]
  NewUserSpar
  (ManagedBy
   -> Maybe Handle
   -> Maybe RichInfo
   -> Maybe Locale
   -> Role
   -> NewUserSpar)
-> SchemaP SwaggerDoc Object [Pair] NewUserSpar ManagedBy
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     NewUserSpar
     (Maybe Handle
      -> Maybe RichInfo -> Maybe Locale -> Role -> NewUserSpar)
forall a b.
SchemaP SwaggerDoc Object [Pair] NewUserSpar (a -> b)
-> SchemaP SwaggerDoc Object [Pair] NewUserSpar a
-> SchemaP SwaggerDoc Object [Pair] NewUserSpar b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> NewUserSpar -> ManagedBy
newUserSparManagedBy
          (NewUserSpar -> ManagedBy)
-> SchemaP SwaggerDoc Object [Pair] ManagedBy ManagedBy
-> SchemaP SwaggerDoc Object [Pair] NewUserSpar ManagedBy
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= Text
-> SchemaP NamedSwaggerDoc Value Value ManagedBy ManagedBy
-> SchemaP SwaggerDoc Object [Pair] ManagedBy ManagedBy
forall doc' doc a b.
HasField doc' doc =>
Text
-> SchemaP doc' Value Value a b -> SchemaP doc Object [Pair] a b
field Text
"newUserSparManagedBy" SchemaP NamedSwaggerDoc Value Value ManagedBy ManagedBy
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema
        SchemaP
  SwaggerDoc
  Object
  [Pair]
  NewUserSpar
  (Maybe Handle
   -> Maybe RichInfo -> Maybe Locale -> Role -> NewUserSpar)
-> SchemaP SwaggerDoc Object [Pair] NewUserSpar (Maybe Handle)
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     NewUserSpar
     (Maybe RichInfo -> Maybe Locale -> Role -> NewUserSpar)
forall a b.
SchemaP SwaggerDoc Object [Pair] NewUserSpar (a -> b)
-> SchemaP SwaggerDoc Object [Pair] NewUserSpar a
-> SchemaP SwaggerDoc Object [Pair] NewUserSpar b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> NewUserSpar -> Maybe Handle
newUserSparHandle
          (NewUserSpar -> Maybe Handle)
-> SchemaP SwaggerDoc Object [Pair] (Maybe Handle) (Maybe Handle)
-> SchemaP SwaggerDoc Object [Pair] NewUserSpar (Maybe Handle)
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= SchemaP SwaggerDoc Object [Pair] Handle (Maybe Handle)
-> SchemaP SwaggerDoc Object [Pair] (Maybe Handle) (Maybe Handle)
forall w d v a b.
Monoid w =>
SchemaP d v w a b -> SchemaP d v w (Maybe a) b
maybe_ (Text
-> SchemaP NamedSwaggerDoc Value Value Handle Handle
-> SchemaP SwaggerDoc Object [Pair] Handle (Maybe Handle)
forall doc doc' a b.
(HasOpt doc, HasField doc' doc) =>
Text
-> SchemaP doc' Value Value a b
-> SchemaP doc Object [Pair] a (Maybe b)
optField Text
"newUserSparHandle" SchemaP NamedSwaggerDoc Value Value Handle Handle
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema)
        SchemaP
  SwaggerDoc
  Object
  [Pair]
  NewUserSpar
  (Maybe RichInfo -> Maybe Locale -> Role -> NewUserSpar)
-> SchemaP SwaggerDoc Object [Pair] NewUserSpar (Maybe RichInfo)
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     NewUserSpar
     (Maybe Locale -> Role -> NewUserSpar)
forall a b.
SchemaP SwaggerDoc Object [Pair] NewUserSpar (a -> b)
-> SchemaP SwaggerDoc Object [Pair] NewUserSpar a
-> SchemaP SwaggerDoc Object [Pair] NewUserSpar b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> NewUserSpar -> Maybe RichInfo
newUserSparRichInfo
          (NewUserSpar -> Maybe RichInfo)
-> SchemaP
     SwaggerDoc Object [Pair] (Maybe RichInfo) (Maybe RichInfo)
-> SchemaP SwaggerDoc Object [Pair] NewUserSpar (Maybe RichInfo)
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= SchemaP SwaggerDoc Object [Pair] RichInfo (Maybe RichInfo)
-> SchemaP
     SwaggerDoc Object [Pair] (Maybe RichInfo) (Maybe RichInfo)
forall w d v a b.
Monoid w =>
SchemaP d v w a b -> SchemaP d v w (Maybe a) b
maybe_ (Text
-> SchemaP NamedSwaggerDoc Value Value RichInfo RichInfo
-> SchemaP SwaggerDoc Object [Pair] RichInfo (Maybe RichInfo)
forall doc doc' a b.
(HasOpt doc, HasField doc' doc) =>
Text
-> SchemaP doc' Value Value a b
-> SchemaP doc Object [Pair] a (Maybe b)
optField Text
"newUserSparRichInfo" SchemaP NamedSwaggerDoc Value Value RichInfo RichInfo
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema)
        SchemaP
  SwaggerDoc
  Object
  [Pair]
  NewUserSpar
  (Maybe Locale -> Role -> NewUserSpar)
-> SchemaP SwaggerDoc Object [Pair] NewUserSpar (Maybe Locale)
-> SchemaP
     SwaggerDoc Object [Pair] NewUserSpar (Role -> NewUserSpar)
forall a b.
SchemaP SwaggerDoc Object [Pair] NewUserSpar (a -> b)
-> SchemaP SwaggerDoc Object [Pair] NewUserSpar a
-> SchemaP SwaggerDoc Object [Pair] NewUserSpar b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> NewUserSpar -> Maybe Locale
newUserSparLocale
          (NewUserSpar -> Maybe Locale)
-> SchemaP SwaggerDoc Object [Pair] (Maybe Locale) (Maybe Locale)
-> SchemaP SwaggerDoc Object [Pair] NewUserSpar (Maybe Locale)
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= SchemaP SwaggerDoc Object [Pair] Locale (Maybe Locale)
-> SchemaP SwaggerDoc Object [Pair] (Maybe Locale) (Maybe Locale)
forall w d v a b.
Monoid w =>
SchemaP d v w a b -> SchemaP d v w (Maybe a) b
maybe_ (Text
-> SchemaP NamedSwaggerDoc Value Value Locale Locale
-> SchemaP SwaggerDoc Object [Pair] Locale (Maybe Locale)
forall doc doc' a b.
(HasOpt doc, HasField doc' doc) =>
Text
-> SchemaP doc' Value Value a b
-> SchemaP doc Object [Pair] a (Maybe b)
optField Text
"newUserSparLocale" SchemaP NamedSwaggerDoc Value Value Locale Locale
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema)
        SchemaP SwaggerDoc Object [Pair] NewUserSpar (Role -> NewUserSpar)
-> SchemaP SwaggerDoc Object [Pair] NewUserSpar Role
-> SchemaP SwaggerDoc Object [Pair] NewUserSpar NewUserSpar
forall a b.
SchemaP SwaggerDoc Object [Pair] NewUserSpar (a -> b)
-> SchemaP SwaggerDoc Object [Pair] NewUserSpar a
-> SchemaP SwaggerDoc Object [Pair] NewUserSpar b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> NewUserSpar -> Role
newUserSparRole
          (NewUserSpar -> Role)
-> SchemaP SwaggerDoc Object [Pair] Role Role
-> SchemaP SwaggerDoc Object [Pair] NewUserSpar Role
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= Text
-> SchemaP NamedSwaggerDoc Value Value Role Role
-> SchemaP SwaggerDoc Object [Pair] Role Role
forall doc' doc a b.
HasField doc' doc =>
Text
-> SchemaP doc' Value Value a b -> SchemaP doc Object [Pair] a b
field Text
"newUserSparRole" SchemaP NamedSwaggerDoc Value Value Role Role
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema

newUserFromSpar :: NewUserSpar -> NewUser
newUserFromSpar :: NewUserSpar -> NewUser
newUserFromSpar NewUserSpar
new =
  NewUser
    { $sel:newUserDisplayName:NewUser :: Name
newUserDisplayName = NewUserSpar -> Name
newUserSparDisplayName NewUserSpar
new,
      $sel:newUserUUID:NewUser :: Maybe UUID
newUserUUID = UUID -> Maybe UUID
forall a. a -> Maybe a
Just (UUID -> Maybe UUID) -> UUID -> Maybe UUID
forall a b. (a -> b) -> a -> b
$ NewUserSpar -> UUID
newUserSparUUID NewUserSpar
new,
      $sel:newUserIdentity:NewUser :: Maybe UserIdentity
newUserIdentity = UserIdentity -> Maybe UserIdentity
forall a. a -> Maybe a
Just (UserIdentity -> Maybe UserIdentity)
-> UserIdentity -> Maybe UserIdentity
forall a b. (a -> b) -> a -> b
$ UserSSOId -> Maybe EmailAddress -> UserIdentity
SSOIdentity (NewUserSpar -> UserSSOId
newUserSparSSOId NewUserSpar
new) Maybe EmailAddress
forall a. Maybe a
Nothing,
      $sel:newUserPict:NewUser :: Maybe Pict
newUserPict = Maybe Pict
forall a. Maybe a
Nothing,
      $sel:newUserAssets:NewUser :: [Asset]
newUserAssets = [],
      $sel:newUserAccentId:NewUser :: Maybe ColourId
newUserAccentId = Maybe ColourId
forall a. Maybe a
Nothing,
      $sel:newUserEmailCode:NewUser :: Maybe ActivationCode
newUserEmailCode = Maybe ActivationCode
forall a. Maybe a
Nothing,
      $sel:newUserOrigin:NewUser :: Maybe NewUserOrigin
newUserOrigin = NewUserOrigin -> Maybe NewUserOrigin
forall a. a -> Maybe a
Just (NewUserOrigin -> Maybe NewUserOrigin)
-> (TeamId -> NewUserOrigin) -> TeamId -> Maybe NewUserOrigin
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NewTeamUser -> NewUserOrigin
NewUserOriginTeamUser (NewTeamUser -> NewUserOrigin)
-> (TeamId -> NewTeamUser) -> TeamId -> NewUserOrigin
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TeamId -> NewTeamUser
NewTeamMemberSSO (TeamId -> Maybe NewUserOrigin) -> TeamId -> Maybe NewUserOrigin
forall a b. (a -> b) -> a -> b
$ NewUserSpar -> TeamId
newUserSparTeamId NewUserSpar
new,
      $sel:newUserLabel:NewUser :: Maybe CookieLabel
newUserLabel = Maybe CookieLabel
forall a. Maybe a
Nothing,
      $sel:newUserPassword:NewUser :: Maybe PlainTextPassword8
newUserPassword = Maybe PlainTextPassword8
forall a. Maybe a
Nothing,
      $sel:newUserExpiresIn:NewUser :: Maybe ExpiresIn
newUserExpiresIn = Maybe ExpiresIn
forall a. Maybe a
Nothing,
      $sel:newUserManagedBy:NewUser :: Maybe ManagedBy
newUserManagedBy = ManagedBy -> Maybe ManagedBy
forall a. a -> Maybe a
Just (ManagedBy -> Maybe ManagedBy) -> ManagedBy -> Maybe ManagedBy
forall a b. (a -> b) -> a -> b
$ NewUserSpar -> ManagedBy
newUserSparManagedBy NewUserSpar
new,
      $sel:newUserLocale:NewUser :: Maybe Locale
newUserLocale = NewUserSpar -> Maybe Locale
newUserSparLocale NewUserSpar
new,
      $sel:newUserSupportedProtocols:NewUser :: Maybe (Set BaseProtocolTag)
newUserSupportedProtocols = Maybe (Set BaseProtocolTag)
forall a. Maybe a
Nothing
    }

data NewUser = NewUser
  { NewUser -> Name
newUserDisplayName :: Name,
    -- | use this as 'UserId' (if 'Nothing', call 'Data.UUID.nextRandom').
    NewUser -> Maybe UUID
newUserUUID :: Maybe UUID,
    NewUser -> Maybe UserIdentity
newUserIdentity :: Maybe UserIdentity,
    -- | DEPRECATED
    NewUser -> Maybe Pict
newUserPict :: Maybe Pict,
    NewUser -> [Asset]
newUserAssets :: [Asset],
    NewUser -> Maybe ColourId
newUserAccentId :: Maybe ColourId,
    NewUser -> Maybe ActivationCode
newUserEmailCode :: Maybe ActivationCode,
    NewUser -> Maybe NewUserOrigin
newUserOrigin :: Maybe NewUserOrigin,
    NewUser -> Maybe CookieLabel
newUserLabel :: Maybe CookieLabel,
    NewUser -> Maybe Locale
newUserLocale :: Maybe Locale,
    NewUser -> Maybe PlainTextPassword8
newUserPassword :: Maybe PlainTextPassword8,
    NewUser -> Maybe ExpiresIn
newUserExpiresIn :: Maybe ExpiresIn,
    NewUser -> Maybe ManagedBy
newUserManagedBy :: Maybe ManagedBy,
    NewUser -> Maybe (Set BaseProtocolTag)
newUserSupportedProtocols :: Maybe (Set BaseProtocolTag)
  }
  deriving stock (NewUser -> NewUser -> Bool
(NewUser -> NewUser -> Bool)
-> (NewUser -> NewUser -> Bool) -> Eq NewUser
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: NewUser -> NewUser -> Bool
== :: NewUser -> NewUser -> Bool
$c/= :: NewUser -> NewUser -> Bool
/= :: NewUser -> NewUser -> Bool
Eq, Int -> NewUser -> ShowS
[NewUser] -> ShowS
NewUser -> String
(Int -> NewUser -> ShowS)
-> (NewUser -> String) -> ([NewUser] -> ShowS) -> Show NewUser
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> NewUser -> ShowS
showsPrec :: Int -> NewUser -> ShowS
$cshow :: NewUser -> String
show :: NewUser -> String
$cshowList :: [NewUser] -> ShowS
showList :: [NewUser] -> ShowS
Show, (forall x. NewUser -> Rep NewUser x)
-> (forall x. Rep NewUser x -> NewUser) -> Generic NewUser
forall x. Rep NewUser x -> NewUser
forall x. NewUser -> Rep NewUser x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. NewUser -> Rep NewUser x
from :: forall x. NewUser -> Rep NewUser x
$cto :: forall x. Rep NewUser x -> NewUser
to :: forall x. Rep NewUser x -> NewUser
Generic)
  deriving ([NewUser] -> Value
[NewUser] -> Encoding
NewUser -> Value
NewUser -> Encoding
(NewUser -> Value)
-> (NewUser -> Encoding)
-> ([NewUser] -> Value)
-> ([NewUser] -> Encoding)
-> ToJSON NewUser
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: NewUser -> Value
toJSON :: NewUser -> Value
$ctoEncoding :: NewUser -> Encoding
toEncoding :: NewUser -> Encoding
$ctoJSONList :: [NewUser] -> Value
toJSONList :: [NewUser] -> Value
$ctoEncodingList :: [NewUser] -> Encoding
toEncodingList :: [NewUser] -> Encoding
ToJSON, Value -> Parser [NewUser]
Value -> Parser NewUser
(Value -> Parser NewUser)
-> (Value -> Parser [NewUser]) -> FromJSON NewUser
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser NewUser
parseJSON :: Value -> Parser NewUser
$cparseJSONList :: Value -> Parser [NewUser]
parseJSONList :: Value -> Parser [NewUser]
FromJSON, Typeable NewUser
Typeable NewUser =>
(Proxy NewUser -> Declare (Definitions Schema) NamedSchema)
-> ToSchema NewUser
Proxy NewUser -> Declare (Definitions Schema) NamedSchema
forall a.
Typeable a =>
(Proxy a -> Declare (Definitions Schema) NamedSchema) -> ToSchema a
$cdeclareNamedSchema :: Proxy NewUser -> Declare (Definitions Schema) NamedSchema
declareNamedSchema :: Proxy NewUser -> Declare (Definitions Schema) NamedSchema
S.ToSchema) via (Schema NewUser)

emptyNewUser :: Name -> NewUser
emptyNewUser :: Name -> NewUser
emptyNewUser Name
name =
  NewUser
    { $sel:newUserDisplayName:NewUser :: Name
newUserDisplayName = Name
name,
      $sel:newUserUUID:NewUser :: Maybe UUID
newUserUUID = Maybe UUID
forall a. Maybe a
Nothing,
      $sel:newUserIdentity:NewUser :: Maybe UserIdentity
newUserIdentity = Maybe UserIdentity
forall a. Maybe a
Nothing,
      $sel:newUserPict:NewUser :: Maybe Pict
newUserPict = Maybe Pict
forall a. Maybe a
Nothing,
      $sel:newUserAssets:NewUser :: [Asset]
newUserAssets = [],
      $sel:newUserAccentId:NewUser :: Maybe ColourId
newUserAccentId = Maybe ColourId
forall a. Maybe a
Nothing,
      $sel:newUserEmailCode:NewUser :: Maybe ActivationCode
newUserEmailCode = Maybe ActivationCode
forall a. Maybe a
Nothing,
      $sel:newUserOrigin:NewUser :: Maybe NewUserOrigin
newUserOrigin = Maybe NewUserOrigin
forall a. Maybe a
Nothing,
      $sel:newUserLabel:NewUser :: Maybe CookieLabel
newUserLabel = Maybe CookieLabel
forall a. Maybe a
Nothing,
      $sel:newUserLocale:NewUser :: Maybe Locale
newUserLocale = Maybe Locale
forall a. Maybe a
Nothing,
      $sel:newUserPassword:NewUser :: Maybe PlainTextPassword8
newUserPassword = Maybe PlainTextPassword8
forall a. Maybe a
Nothing,
      $sel:newUserExpiresIn:NewUser :: Maybe ExpiresIn
newUserExpiresIn = Maybe ExpiresIn
forall a. Maybe a
Nothing,
      $sel:newUserManagedBy:NewUser :: Maybe ManagedBy
newUserManagedBy = Maybe ManagedBy
forall a. Maybe a
Nothing,
      $sel:newUserSupportedProtocols:NewUser :: Maybe (Set BaseProtocolTag)
newUserSupportedProtocols = Maybe (Set BaseProtocolTag)
forall a. Maybe a
Nothing
    }

-- | 1 second - 1 week
type ExpiresIn = Range 1 604800 Integer

-- | Raw representation of 'NewUser' to help with writing Schema instances.
data NewUserRaw = NewUserRaw
  { NewUserRaw -> Name
newUserRawDisplayName :: Name,
    NewUserRaw -> Maybe UUID
newUserRawUUID :: Maybe UUID,
    NewUserRaw -> Maybe EmailAddress
newUserRawEmail :: Maybe EmailAddress,
    NewUserRaw -> Maybe UserSSOId
newUserRawSSOId :: Maybe UserSSOId,
    -- | DEPRECATED
    NewUserRaw -> Maybe Pict
newUserRawPict :: Maybe Pict,
    NewUserRaw -> [Asset]
newUserRawAssets :: [Asset],
    NewUserRaw -> Maybe ColourId
newUserRawAccentId :: Maybe ColourId,
    NewUserRaw -> Maybe ActivationCode
newUserRawEmailCode :: Maybe ActivationCode,
    NewUserRaw -> Maybe InvitationCode
newUserRawInvitationCode :: Maybe InvitationCode,
    NewUserRaw -> Maybe InvitationCode
newUserRawTeamCode :: Maybe InvitationCode,
    NewUserRaw -> Maybe BindingNewTeamUser
newUserRawTeam :: Maybe BindingNewTeamUser,
    NewUserRaw -> Maybe TeamId
newUserRawTeamId :: Maybe TeamId,
    NewUserRaw -> Maybe CookieLabel
newUserRawLabel :: Maybe CookieLabel,
    NewUserRaw -> Maybe Locale
newUserRawLocale :: Maybe Locale,
    NewUserRaw -> Maybe PlainTextPassword8
newUserRawPassword :: Maybe PlainTextPassword8,
    NewUserRaw -> Maybe ExpiresIn
newUserRawExpiresIn :: Maybe ExpiresIn,
    NewUserRaw -> Maybe ManagedBy
newUserRawManagedBy :: Maybe ManagedBy,
    NewUserRaw -> Maybe (Set BaseProtocolTag)
newUserRawSupportedProtocols :: Maybe (Set BaseProtocolTag)
  }

newUserRawObjectSchema :: ObjectSchema SwaggerDoc NewUserRaw
newUserRawObjectSchema :: ObjectSchema SwaggerDoc NewUserRaw
newUserRawObjectSchema =
  Name
-> Maybe UUID
-> Maybe EmailAddress
-> Maybe UserSSOId
-> Maybe Pict
-> [Asset]
-> Maybe ColourId
-> Maybe ActivationCode
-> Maybe InvitationCode
-> Maybe InvitationCode
-> Maybe BindingNewTeamUser
-> Maybe TeamId
-> Maybe CookieLabel
-> Maybe Locale
-> Maybe PlainTextPassword8
-> Maybe ExpiresIn
-> Maybe ManagedBy
-> Maybe (Set BaseProtocolTag)
-> NewUserRaw
NewUserRaw
    (Name
 -> Maybe UUID
 -> Maybe EmailAddress
 -> Maybe UserSSOId
 -> Maybe Pict
 -> [Asset]
 -> Maybe ColourId
 -> Maybe ActivationCode
 -> Maybe InvitationCode
 -> Maybe InvitationCode
 -> Maybe BindingNewTeamUser
 -> Maybe TeamId
 -> Maybe CookieLabel
 -> Maybe Locale
 -> Maybe PlainTextPassword8
 -> Maybe ExpiresIn
 -> Maybe ManagedBy
 -> Maybe (Set BaseProtocolTag)
 -> NewUserRaw)
-> SchemaP SwaggerDoc Object [Pair] NewUserRaw Name
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     NewUserRaw
     (Maybe UUID
      -> Maybe EmailAddress
      -> Maybe UserSSOId
      -> Maybe Pict
      -> [Asset]
      -> Maybe ColourId
      -> Maybe ActivationCode
      -> Maybe InvitationCode
      -> Maybe InvitationCode
      -> Maybe BindingNewTeamUser
      -> Maybe TeamId
      -> Maybe CookieLabel
      -> Maybe Locale
      -> Maybe PlainTextPassword8
      -> Maybe ExpiresIn
      -> Maybe ManagedBy
      -> Maybe (Set BaseProtocolTag)
      -> NewUserRaw)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NewUserRaw -> Name
newUserRawDisplayName
      (NewUserRaw -> Name)
-> SchemaP SwaggerDoc Object [Pair] Name Name
-> SchemaP SwaggerDoc Object [Pair] NewUserRaw Name
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= Text
-> SchemaP NamedSwaggerDoc Value Value Name Name
-> SchemaP SwaggerDoc Object [Pair] Name Name
forall doc' doc a b.
HasField doc' doc =>
Text
-> SchemaP doc' Value Value a b -> SchemaP doc Object [Pair] a b
field Text
"name" SchemaP NamedSwaggerDoc Value Value Name Name
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema
    SchemaP
  SwaggerDoc
  Object
  [Pair]
  NewUserRaw
  (Maybe UUID
   -> Maybe EmailAddress
   -> Maybe UserSSOId
   -> Maybe Pict
   -> [Asset]
   -> Maybe ColourId
   -> Maybe ActivationCode
   -> Maybe InvitationCode
   -> Maybe InvitationCode
   -> Maybe BindingNewTeamUser
   -> Maybe TeamId
   -> Maybe CookieLabel
   -> Maybe Locale
   -> Maybe PlainTextPassword8
   -> Maybe ExpiresIn
   -> Maybe ManagedBy
   -> Maybe (Set BaseProtocolTag)
   -> NewUserRaw)
-> SchemaP SwaggerDoc Object [Pair] NewUserRaw (Maybe UUID)
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     NewUserRaw
     (Maybe EmailAddress
      -> Maybe UserSSOId
      -> Maybe Pict
      -> [Asset]
      -> Maybe ColourId
      -> Maybe ActivationCode
      -> Maybe InvitationCode
      -> Maybe InvitationCode
      -> Maybe BindingNewTeamUser
      -> Maybe TeamId
      -> Maybe CookieLabel
      -> Maybe Locale
      -> Maybe PlainTextPassword8
      -> Maybe ExpiresIn
      -> Maybe ManagedBy
      -> Maybe (Set BaseProtocolTag)
      -> NewUserRaw)
forall a b.
SchemaP SwaggerDoc Object [Pair] NewUserRaw (a -> b)
-> SchemaP SwaggerDoc Object [Pair] NewUserRaw a
-> SchemaP SwaggerDoc Object [Pair] NewUserRaw b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> NewUserRaw -> Maybe UUID
newUserRawUUID
      (NewUserRaw -> Maybe UUID)
-> SchemaP SwaggerDoc Object [Pair] (Maybe UUID) (Maybe UUID)
-> SchemaP SwaggerDoc Object [Pair] NewUserRaw (Maybe UUID)
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= SchemaP SwaggerDoc Object [Pair] UUID (Maybe UUID)
-> SchemaP SwaggerDoc Object [Pair] (Maybe UUID) (Maybe UUID)
forall w d v a b.
Monoid w =>
SchemaP d v w a b -> SchemaP d v w (Maybe a) b
maybe_ (Text
-> SchemaP NamedSwaggerDoc Value Value UUID UUID
-> SchemaP SwaggerDoc Object [Pair] UUID (Maybe UUID)
forall doc doc' a b.
(HasOpt doc, HasField doc' doc) =>
Text
-> SchemaP doc' Value Value a b
-> SchemaP doc Object [Pair] a (Maybe b)
optField Text
"uuid" SchemaP NamedSwaggerDoc Value Value UUID UUID
forall a.
(ToSchema a, ToJSON a, FromJSON a) =>
ValueSchema NamedSwaggerDoc a
genericToSchema)
    SchemaP
  SwaggerDoc
  Object
  [Pair]
  NewUserRaw
  (Maybe EmailAddress
   -> Maybe UserSSOId
   -> Maybe Pict
   -> [Asset]
   -> Maybe ColourId
   -> Maybe ActivationCode
   -> Maybe InvitationCode
   -> Maybe InvitationCode
   -> Maybe BindingNewTeamUser
   -> Maybe TeamId
   -> Maybe CookieLabel
   -> Maybe Locale
   -> Maybe PlainTextPassword8
   -> Maybe ExpiresIn
   -> Maybe ManagedBy
   -> Maybe (Set BaseProtocolTag)
   -> NewUserRaw)
-> SchemaP SwaggerDoc Object [Pair] NewUserRaw (Maybe EmailAddress)
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     NewUserRaw
     (Maybe UserSSOId
      -> Maybe Pict
      -> [Asset]
      -> Maybe ColourId
      -> Maybe ActivationCode
      -> Maybe InvitationCode
      -> Maybe InvitationCode
      -> Maybe BindingNewTeamUser
      -> Maybe TeamId
      -> Maybe CookieLabel
      -> Maybe Locale
      -> Maybe PlainTextPassword8
      -> Maybe ExpiresIn
      -> Maybe ManagedBy
      -> Maybe (Set BaseProtocolTag)
      -> NewUserRaw)
forall a b.
SchemaP SwaggerDoc Object [Pair] NewUserRaw (a -> b)
-> SchemaP SwaggerDoc Object [Pair] NewUserRaw a
-> SchemaP SwaggerDoc Object [Pair] NewUserRaw b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> NewUserRaw -> Maybe EmailAddress
newUserRawEmail
      (NewUserRaw -> Maybe EmailAddress)
-> SchemaP
     SwaggerDoc Object [Pair] (Maybe EmailAddress) (Maybe EmailAddress)
-> SchemaP SwaggerDoc Object [Pair] NewUserRaw (Maybe EmailAddress)
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= SchemaP SwaggerDoc Object [Pair] EmailAddress (Maybe EmailAddress)
-> SchemaP
     SwaggerDoc Object [Pair] (Maybe EmailAddress) (Maybe EmailAddress)
forall w d v a b.
Monoid w =>
SchemaP d v w a b -> SchemaP d v w (Maybe a) b
maybe_ (Text
-> SchemaP NamedSwaggerDoc Value Value EmailAddress EmailAddress
-> SchemaP
     SwaggerDoc Object [Pair] EmailAddress (Maybe EmailAddress)
forall doc doc' a b.
(HasOpt doc, HasField doc' doc) =>
Text
-> SchemaP doc' Value Value a b
-> SchemaP doc Object [Pair] a (Maybe b)
optField Text
"email" SchemaP NamedSwaggerDoc Value Value EmailAddress EmailAddress
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema)
    SchemaP
  SwaggerDoc
  Object
  [Pair]
  NewUserRaw
  (Maybe UserSSOId
   -> Maybe Pict
   -> [Asset]
   -> Maybe ColourId
   -> Maybe ActivationCode
   -> Maybe InvitationCode
   -> Maybe InvitationCode
   -> Maybe BindingNewTeamUser
   -> Maybe TeamId
   -> Maybe CookieLabel
   -> Maybe Locale
   -> Maybe PlainTextPassword8
   -> Maybe ExpiresIn
   -> Maybe ManagedBy
   -> Maybe (Set BaseProtocolTag)
   -> NewUserRaw)
-> SchemaP SwaggerDoc Object [Pair] NewUserRaw (Maybe UserSSOId)
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     NewUserRaw
     (Maybe Pict
      -> [Asset]
      -> Maybe ColourId
      -> Maybe ActivationCode
      -> Maybe InvitationCode
      -> Maybe InvitationCode
      -> Maybe BindingNewTeamUser
      -> Maybe TeamId
      -> Maybe CookieLabel
      -> Maybe Locale
      -> Maybe PlainTextPassword8
      -> Maybe ExpiresIn
      -> Maybe ManagedBy
      -> Maybe (Set BaseProtocolTag)
      -> NewUserRaw)
forall a b.
SchemaP SwaggerDoc Object [Pair] NewUserRaw (a -> b)
-> SchemaP SwaggerDoc Object [Pair] NewUserRaw a
-> SchemaP SwaggerDoc Object [Pair] NewUserRaw b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> NewUserRaw -> Maybe UserSSOId
newUserRawSSOId
      (NewUserRaw -> Maybe UserSSOId)
-> SchemaP
     SwaggerDoc Object [Pair] (Maybe UserSSOId) (Maybe UserSSOId)
-> SchemaP SwaggerDoc Object [Pair] NewUserRaw (Maybe UserSSOId)
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= SchemaP SwaggerDoc Object [Pair] UserSSOId (Maybe UserSSOId)
-> SchemaP
     SwaggerDoc Object [Pair] (Maybe UserSSOId) (Maybe UserSSOId)
forall w d v a b.
Monoid w =>
SchemaP d v w a b -> SchemaP d v w (Maybe a) b
maybe_ (Text
-> SchemaP NamedSwaggerDoc Value Value UserSSOId UserSSOId
-> SchemaP SwaggerDoc Object [Pair] UserSSOId (Maybe UserSSOId)
forall doc doc' a b.
(HasOpt doc, HasField doc' doc) =>
Text
-> SchemaP doc' Value Value a b
-> SchemaP doc Object [Pair] a (Maybe b)
optField Text
"sso_id" SchemaP NamedSwaggerDoc Value Value UserSSOId UserSSOId
forall a.
(ToSchema a, ToJSON a, FromJSON a) =>
ValueSchema NamedSwaggerDoc a
genericToSchema)
    SchemaP
  SwaggerDoc
  Object
  [Pair]
  NewUserRaw
  (Maybe Pict
   -> [Asset]
   -> Maybe ColourId
   -> Maybe ActivationCode
   -> Maybe InvitationCode
   -> Maybe InvitationCode
   -> Maybe BindingNewTeamUser
   -> Maybe TeamId
   -> Maybe CookieLabel
   -> Maybe Locale
   -> Maybe PlainTextPassword8
   -> Maybe ExpiresIn
   -> Maybe ManagedBy
   -> Maybe (Set BaseProtocolTag)
   -> NewUserRaw)
-> SchemaP SwaggerDoc Object [Pair] NewUserRaw (Maybe Pict)
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     NewUserRaw
     ([Asset]
      -> Maybe ColourId
      -> Maybe ActivationCode
      -> Maybe InvitationCode
      -> Maybe InvitationCode
      -> Maybe BindingNewTeamUser
      -> Maybe TeamId
      -> Maybe CookieLabel
      -> Maybe Locale
      -> Maybe PlainTextPassword8
      -> Maybe ExpiresIn
      -> Maybe ManagedBy
      -> Maybe (Set BaseProtocolTag)
      -> NewUserRaw)
forall a b.
SchemaP SwaggerDoc Object [Pair] NewUserRaw (a -> b)
-> SchemaP SwaggerDoc Object [Pair] NewUserRaw a
-> SchemaP SwaggerDoc Object [Pair] NewUserRaw b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> NewUserRaw -> Maybe Pict
newUserRawPict
      (NewUserRaw -> Maybe Pict)
-> SchemaP SwaggerDoc Object [Pair] (Maybe Pict) (Maybe Pict)
-> SchemaP SwaggerDoc Object [Pair] NewUserRaw (Maybe Pict)
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= SchemaP SwaggerDoc Object [Pair] Pict (Maybe Pict)
-> SchemaP SwaggerDoc Object [Pair] (Maybe Pict) (Maybe Pict)
forall w d v a b.
Monoid w =>
SchemaP d v w a b -> SchemaP d v w (Maybe a) b
maybe_ (Text
-> SchemaP NamedSwaggerDoc Value Value Pict Pict
-> SchemaP SwaggerDoc Object [Pair] Pict (Maybe Pict)
forall doc doc' a b.
(HasOpt doc, HasField doc' doc) =>
Text
-> SchemaP doc' Value Value a b
-> SchemaP doc Object [Pair] a (Maybe b)
optField Text
"picture" SchemaP NamedSwaggerDoc Value Value Pict Pict
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema)
    SchemaP
  SwaggerDoc
  Object
  [Pair]
  NewUserRaw
  ([Asset]
   -> Maybe ColourId
   -> Maybe ActivationCode
   -> Maybe InvitationCode
   -> Maybe InvitationCode
   -> Maybe BindingNewTeamUser
   -> Maybe TeamId
   -> Maybe CookieLabel
   -> Maybe Locale
   -> Maybe PlainTextPassword8
   -> Maybe ExpiresIn
   -> Maybe ManagedBy
   -> Maybe (Set BaseProtocolTag)
   -> NewUserRaw)
-> SchemaP SwaggerDoc Object [Pair] NewUserRaw [Asset]
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     NewUserRaw
     (Maybe ColourId
      -> Maybe ActivationCode
      -> Maybe InvitationCode
      -> Maybe InvitationCode
      -> Maybe BindingNewTeamUser
      -> Maybe TeamId
      -> Maybe CookieLabel
      -> Maybe Locale
      -> Maybe PlainTextPassword8
      -> Maybe ExpiresIn
      -> Maybe ManagedBy
      -> Maybe (Set BaseProtocolTag)
      -> NewUserRaw)
forall a b.
SchemaP SwaggerDoc Object [Pair] NewUserRaw (a -> b)
-> SchemaP SwaggerDoc Object [Pair] NewUserRaw a
-> SchemaP SwaggerDoc Object [Pair] NewUserRaw b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> NewUserRaw -> [Asset]
newUserRawAssets
      (NewUserRaw -> [Asset])
-> SchemaP SwaggerDoc Object [Pair] [Asset] [Asset]
-> SchemaP SwaggerDoc Object [Pair] NewUserRaw [Asset]
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= ([Asset] -> Maybe [Asset] -> [Asset]
forall a. a -> Maybe a -> a
fromMaybe [] (Maybe [Asset] -> [Asset])
-> SchemaP SwaggerDoc Object [Pair] [Asset] (Maybe [Asset])
-> SchemaP SwaggerDoc Object [Pair] [Asset] [Asset]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text
-> SchemaP SwaggerDoc Value Value [Asset] [Asset]
-> SchemaP SwaggerDoc Object [Pair] [Asset] (Maybe [Asset])
forall doc doc' a b.
(HasOpt doc, HasField doc' doc) =>
Text
-> SchemaP doc' Value Value a b
-> SchemaP doc Object [Pair] a (Maybe b)
optField Text
"assets" (ValueSchema NamedSwaggerDoc Asset
-> SchemaP SwaggerDoc Value Value [Asset] [Asset]
forall ndoc doc a.
(HasArray ndoc doc, HasName ndoc) =>
ValueSchema ndoc a -> ValueSchema doc [a]
array ValueSchema NamedSwaggerDoc Asset
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema))
    SchemaP
  SwaggerDoc
  Object
  [Pair]
  NewUserRaw
  (Maybe ColourId
   -> Maybe ActivationCode
   -> Maybe InvitationCode
   -> Maybe InvitationCode
   -> Maybe BindingNewTeamUser
   -> Maybe TeamId
   -> Maybe CookieLabel
   -> Maybe Locale
   -> Maybe PlainTextPassword8
   -> Maybe ExpiresIn
   -> Maybe ManagedBy
   -> Maybe (Set BaseProtocolTag)
   -> NewUserRaw)
-> SchemaP SwaggerDoc Object [Pair] NewUserRaw (Maybe ColourId)
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     NewUserRaw
     (Maybe ActivationCode
      -> Maybe InvitationCode
      -> Maybe InvitationCode
      -> Maybe BindingNewTeamUser
      -> Maybe TeamId
      -> Maybe CookieLabel
      -> Maybe Locale
      -> Maybe PlainTextPassword8
      -> Maybe ExpiresIn
      -> Maybe ManagedBy
      -> Maybe (Set BaseProtocolTag)
      -> NewUserRaw)
forall a b.
SchemaP SwaggerDoc Object [Pair] NewUserRaw (a -> b)
-> SchemaP SwaggerDoc Object [Pair] NewUserRaw a
-> SchemaP SwaggerDoc Object [Pair] NewUserRaw b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> NewUserRaw -> Maybe ColourId
newUserRawAccentId
      (NewUserRaw -> Maybe ColourId)
-> SchemaP
     SwaggerDoc Object [Pair] (Maybe ColourId) (Maybe ColourId)
-> SchemaP SwaggerDoc Object [Pair] NewUserRaw (Maybe ColourId)
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= SchemaP SwaggerDoc Object [Pair] ColourId (Maybe ColourId)
-> SchemaP
     SwaggerDoc Object [Pair] (Maybe ColourId) (Maybe ColourId)
forall w d v a b.
Monoid w =>
SchemaP d v w a b -> SchemaP d v w (Maybe a) b
maybe_ (Text
-> SchemaP NamedSwaggerDoc Value Value ColourId ColourId
-> SchemaP SwaggerDoc Object [Pair] ColourId (Maybe ColourId)
forall doc doc' a b.
(HasOpt doc, HasField doc' doc) =>
Text
-> SchemaP doc' Value Value a b
-> SchemaP doc Object [Pair] a (Maybe b)
optField Text
"accent_id" SchemaP NamedSwaggerDoc Value Value ColourId ColourId
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema)
    SchemaP
  SwaggerDoc
  Object
  [Pair]
  NewUserRaw
  (Maybe ActivationCode
   -> Maybe InvitationCode
   -> Maybe InvitationCode
   -> Maybe BindingNewTeamUser
   -> Maybe TeamId
   -> Maybe CookieLabel
   -> Maybe Locale
   -> Maybe PlainTextPassword8
   -> Maybe ExpiresIn
   -> Maybe ManagedBy
   -> Maybe (Set BaseProtocolTag)
   -> NewUserRaw)
-> SchemaP
     SwaggerDoc Object [Pair] NewUserRaw (Maybe ActivationCode)
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     NewUserRaw
     (Maybe InvitationCode
      -> Maybe InvitationCode
      -> Maybe BindingNewTeamUser
      -> Maybe TeamId
      -> Maybe CookieLabel
      -> Maybe Locale
      -> Maybe PlainTextPassword8
      -> Maybe ExpiresIn
      -> Maybe ManagedBy
      -> Maybe (Set BaseProtocolTag)
      -> NewUserRaw)
forall a b.
SchemaP SwaggerDoc Object [Pair] NewUserRaw (a -> b)
-> SchemaP SwaggerDoc Object [Pair] NewUserRaw a
-> SchemaP SwaggerDoc Object [Pair] NewUserRaw b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> NewUserRaw -> Maybe ActivationCode
newUserRawEmailCode
      (NewUserRaw -> Maybe ActivationCode)
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     (Maybe ActivationCode)
     (Maybe ActivationCode)
-> SchemaP
     SwaggerDoc Object [Pair] NewUserRaw (Maybe ActivationCode)
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= SchemaP
  SwaggerDoc Object [Pair] ActivationCode (Maybe ActivationCode)
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     (Maybe ActivationCode)
     (Maybe ActivationCode)
forall w d v a b.
Monoid w =>
SchemaP d v w a b -> SchemaP d v w (Maybe a) b
maybe_ (Text
-> SchemaP
     NamedSwaggerDoc Value Value ActivationCode ActivationCode
-> SchemaP
     SwaggerDoc Object [Pair] ActivationCode (Maybe ActivationCode)
forall doc doc' a b.
(HasOpt doc, HasField doc' doc) =>
Text
-> SchemaP doc' Value Value a b
-> SchemaP doc Object [Pair] a (Maybe b)
optField Text
"email_code" SchemaP NamedSwaggerDoc Value Value ActivationCode ActivationCode
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema)
    SchemaP
  SwaggerDoc
  Object
  [Pair]
  NewUserRaw
  (Maybe InvitationCode
   -> Maybe InvitationCode
   -> Maybe BindingNewTeamUser
   -> Maybe TeamId
   -> Maybe CookieLabel
   -> Maybe Locale
   -> Maybe PlainTextPassword8
   -> Maybe ExpiresIn
   -> Maybe ManagedBy
   -> Maybe (Set BaseProtocolTag)
   -> NewUserRaw)
-> SchemaP
     SwaggerDoc Object [Pair] NewUserRaw (Maybe InvitationCode)
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     NewUserRaw
     (Maybe InvitationCode
      -> Maybe BindingNewTeamUser
      -> Maybe TeamId
      -> Maybe CookieLabel
      -> Maybe Locale
      -> Maybe PlainTextPassword8
      -> Maybe ExpiresIn
      -> Maybe ManagedBy
      -> Maybe (Set BaseProtocolTag)
      -> NewUserRaw)
forall a b.
SchemaP SwaggerDoc Object [Pair] NewUserRaw (a -> b)
-> SchemaP SwaggerDoc Object [Pair] NewUserRaw a
-> SchemaP SwaggerDoc Object [Pair] NewUserRaw b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> NewUserRaw -> Maybe InvitationCode
newUserRawInvitationCode
      (NewUserRaw -> Maybe InvitationCode)
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     (Maybe InvitationCode)
     (Maybe InvitationCode)
-> SchemaP
     SwaggerDoc Object [Pair] NewUserRaw (Maybe InvitationCode)
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= SchemaP
  SwaggerDoc Object [Pair] InvitationCode (Maybe InvitationCode)
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     (Maybe InvitationCode)
     (Maybe InvitationCode)
forall w d v a b.
Monoid w =>
SchemaP d v w a b -> SchemaP d v w (Maybe a) b
maybe_ (Text
-> SchemaP
     NamedSwaggerDoc Value Value InvitationCode InvitationCode
-> SchemaP
     SwaggerDoc Object [Pair] InvitationCode (Maybe InvitationCode)
forall doc doc' a b.
(HasOpt doc, HasField doc' doc) =>
Text
-> SchemaP doc' Value Value a b
-> SchemaP doc Object [Pair] a (Maybe b)
optField Text
"invitation_code" SchemaP NamedSwaggerDoc Value Value InvitationCode InvitationCode
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema)
    SchemaP
  SwaggerDoc
  Object
  [Pair]
  NewUserRaw
  (Maybe InvitationCode
   -> Maybe BindingNewTeamUser
   -> Maybe TeamId
   -> Maybe CookieLabel
   -> Maybe Locale
   -> Maybe PlainTextPassword8
   -> Maybe ExpiresIn
   -> Maybe ManagedBy
   -> Maybe (Set BaseProtocolTag)
   -> NewUserRaw)
-> SchemaP
     SwaggerDoc Object [Pair] NewUserRaw (Maybe InvitationCode)
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     NewUserRaw
     (Maybe BindingNewTeamUser
      -> Maybe TeamId
      -> Maybe CookieLabel
      -> Maybe Locale
      -> Maybe PlainTextPassword8
      -> Maybe ExpiresIn
      -> Maybe ManagedBy
      -> Maybe (Set BaseProtocolTag)
      -> NewUserRaw)
forall a b.
SchemaP SwaggerDoc Object [Pair] NewUserRaw (a -> b)
-> SchemaP SwaggerDoc Object [Pair] NewUserRaw a
-> SchemaP SwaggerDoc Object [Pair] NewUserRaw b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> NewUserRaw -> Maybe InvitationCode
newUserRawTeamCode
      (NewUserRaw -> Maybe InvitationCode)
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     (Maybe InvitationCode)
     (Maybe InvitationCode)
-> SchemaP
     SwaggerDoc Object [Pair] NewUserRaw (Maybe InvitationCode)
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= SchemaP
  SwaggerDoc Object [Pair] InvitationCode (Maybe InvitationCode)
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     (Maybe InvitationCode)
     (Maybe InvitationCode)
forall w d v a b.
Monoid w =>
SchemaP d v w a b -> SchemaP d v w (Maybe a) b
maybe_ (Text
-> SchemaP
     NamedSwaggerDoc Value Value InvitationCode InvitationCode
-> SchemaP
     SwaggerDoc Object [Pair] InvitationCode (Maybe InvitationCode)
forall doc doc' a b.
(HasOpt doc, HasField doc' doc) =>
Text
-> SchemaP doc' Value Value a b
-> SchemaP doc Object [Pair] a (Maybe b)
optField Text
"team_code" SchemaP NamedSwaggerDoc Value Value InvitationCode InvitationCode
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema)
    SchemaP
  SwaggerDoc
  Object
  [Pair]
  NewUserRaw
  (Maybe BindingNewTeamUser
   -> Maybe TeamId
   -> Maybe CookieLabel
   -> Maybe Locale
   -> Maybe PlainTextPassword8
   -> Maybe ExpiresIn
   -> Maybe ManagedBy
   -> Maybe (Set BaseProtocolTag)
   -> NewUserRaw)
-> SchemaP
     SwaggerDoc Object [Pair] NewUserRaw (Maybe BindingNewTeamUser)
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     NewUserRaw
     (Maybe TeamId
      -> Maybe CookieLabel
      -> Maybe Locale
      -> Maybe PlainTextPassword8
      -> Maybe ExpiresIn
      -> Maybe ManagedBy
      -> Maybe (Set BaseProtocolTag)
      -> NewUserRaw)
forall a b.
SchemaP SwaggerDoc Object [Pair] NewUserRaw (a -> b)
-> SchemaP SwaggerDoc Object [Pair] NewUserRaw a
-> SchemaP SwaggerDoc Object [Pair] NewUserRaw b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> NewUserRaw -> Maybe BindingNewTeamUser
newUserRawTeam
      (NewUserRaw -> Maybe BindingNewTeamUser)
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     (Maybe BindingNewTeamUser)
     (Maybe BindingNewTeamUser)
-> SchemaP
     SwaggerDoc Object [Pair] NewUserRaw (Maybe BindingNewTeamUser)
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= SchemaP
  SwaggerDoc
  Object
  [Pair]
  BindingNewTeamUser
  (Maybe BindingNewTeamUser)
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     (Maybe BindingNewTeamUser)
     (Maybe BindingNewTeamUser)
forall w d v a b.
Monoid w =>
SchemaP d v w a b -> SchemaP d v w (Maybe a) b
maybe_ (Text
-> SchemaP
     NamedSwaggerDoc Value Value BindingNewTeamUser BindingNewTeamUser
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     BindingNewTeamUser
     (Maybe BindingNewTeamUser)
forall doc doc' a b.
(HasOpt doc, HasField doc' doc) =>
Text
-> SchemaP doc' Value Value a b
-> SchemaP doc Object [Pair] a (Maybe b)
optField Text
"team" SchemaP
  NamedSwaggerDoc Value Value BindingNewTeamUser BindingNewTeamUser
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema)
    SchemaP
  SwaggerDoc
  Object
  [Pair]
  NewUserRaw
  (Maybe TeamId
   -> Maybe CookieLabel
   -> Maybe Locale
   -> Maybe PlainTextPassword8
   -> Maybe ExpiresIn
   -> Maybe ManagedBy
   -> Maybe (Set BaseProtocolTag)
   -> NewUserRaw)
-> SchemaP SwaggerDoc Object [Pair] NewUserRaw (Maybe TeamId)
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     NewUserRaw
     (Maybe CookieLabel
      -> Maybe Locale
      -> Maybe PlainTextPassword8
      -> Maybe ExpiresIn
      -> Maybe ManagedBy
      -> Maybe (Set BaseProtocolTag)
      -> NewUserRaw)
forall a b.
SchemaP SwaggerDoc Object [Pair] NewUserRaw (a -> b)
-> SchemaP SwaggerDoc Object [Pair] NewUserRaw a
-> SchemaP SwaggerDoc Object [Pair] NewUserRaw b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> NewUserRaw -> Maybe TeamId
newUserRawTeamId
      (NewUserRaw -> Maybe TeamId)
-> SchemaP SwaggerDoc Object [Pair] (Maybe TeamId) (Maybe TeamId)
-> SchemaP SwaggerDoc Object [Pair] NewUserRaw (Maybe TeamId)
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= SchemaP SwaggerDoc Object [Pair] TeamId (Maybe TeamId)
-> SchemaP SwaggerDoc Object [Pair] (Maybe TeamId) (Maybe TeamId)
forall w d v a b.
Monoid w =>
SchemaP d v w a b -> SchemaP d v w (Maybe a) b
maybe_ (Text
-> SchemaP NamedSwaggerDoc Value Value TeamId TeamId
-> SchemaP SwaggerDoc Object [Pair] TeamId (Maybe TeamId)
forall doc doc' a b.
(HasOpt doc, HasField doc' doc) =>
Text
-> SchemaP doc' Value Value a b
-> SchemaP doc Object [Pair] a (Maybe b)
optField Text
"team_id" SchemaP NamedSwaggerDoc Value Value TeamId TeamId
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema)
    SchemaP
  SwaggerDoc
  Object
  [Pair]
  NewUserRaw
  (Maybe CookieLabel
   -> Maybe Locale
   -> Maybe PlainTextPassword8
   -> Maybe ExpiresIn
   -> Maybe ManagedBy
   -> Maybe (Set BaseProtocolTag)
   -> NewUserRaw)
-> SchemaP SwaggerDoc Object [Pair] NewUserRaw (Maybe CookieLabel)
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     NewUserRaw
     (Maybe Locale
      -> Maybe PlainTextPassword8
      -> Maybe ExpiresIn
      -> Maybe ManagedBy
      -> Maybe (Set BaseProtocolTag)
      -> NewUserRaw)
forall a b.
SchemaP SwaggerDoc Object [Pair] NewUserRaw (a -> b)
-> SchemaP SwaggerDoc Object [Pair] NewUserRaw a
-> SchemaP SwaggerDoc Object [Pair] NewUserRaw b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> NewUserRaw -> Maybe CookieLabel
newUserRawLabel
      (NewUserRaw -> Maybe CookieLabel)
-> SchemaP
     SwaggerDoc Object [Pair] (Maybe CookieLabel) (Maybe CookieLabel)
-> SchemaP SwaggerDoc Object [Pair] NewUserRaw (Maybe CookieLabel)
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= SchemaP SwaggerDoc Object [Pair] CookieLabel (Maybe CookieLabel)
-> SchemaP
     SwaggerDoc Object [Pair] (Maybe CookieLabel) (Maybe CookieLabel)
forall w d v a b.
Monoid w =>
SchemaP d v w a b -> SchemaP d v w (Maybe a) b
maybe_ (Text
-> SchemaP NamedSwaggerDoc Value Value CookieLabel CookieLabel
-> SchemaP SwaggerDoc Object [Pair] CookieLabel (Maybe CookieLabel)
forall doc doc' a b.
(HasOpt doc, HasField doc' doc) =>
Text
-> SchemaP doc' Value Value a b
-> SchemaP doc Object [Pair] a (Maybe b)
optField Text
"label" SchemaP NamedSwaggerDoc Value Value CookieLabel CookieLabel
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema)
    SchemaP
  SwaggerDoc
  Object
  [Pair]
  NewUserRaw
  (Maybe Locale
   -> Maybe PlainTextPassword8
   -> Maybe ExpiresIn
   -> Maybe ManagedBy
   -> Maybe (Set BaseProtocolTag)
   -> NewUserRaw)
-> SchemaP SwaggerDoc Object [Pair] NewUserRaw (Maybe Locale)
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     NewUserRaw
     (Maybe PlainTextPassword8
      -> Maybe ExpiresIn
      -> Maybe ManagedBy
      -> Maybe (Set BaseProtocolTag)
      -> NewUserRaw)
forall a b.
SchemaP SwaggerDoc Object [Pair] NewUserRaw (a -> b)
-> SchemaP SwaggerDoc Object [Pair] NewUserRaw a
-> SchemaP SwaggerDoc Object [Pair] NewUserRaw b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> NewUserRaw -> Maybe Locale
newUserRawLocale
      (NewUserRaw -> Maybe Locale)
-> SchemaP SwaggerDoc Object [Pair] (Maybe Locale) (Maybe Locale)
-> SchemaP SwaggerDoc Object [Pair] NewUserRaw (Maybe Locale)
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= SchemaP SwaggerDoc Object [Pair] Locale (Maybe Locale)
-> SchemaP SwaggerDoc Object [Pair] (Maybe Locale) (Maybe Locale)
forall w d v a b.
Monoid w =>
SchemaP d v w a b -> SchemaP d v w (Maybe a) b
maybe_ (Text
-> SchemaP NamedSwaggerDoc Value Value Locale Locale
-> SchemaP SwaggerDoc Object [Pair] Locale (Maybe Locale)
forall doc doc' a b.
(HasOpt doc, HasField doc' doc) =>
Text
-> SchemaP doc' Value Value a b
-> SchemaP doc Object [Pair] a (Maybe b)
optField Text
"locale" SchemaP NamedSwaggerDoc Value Value Locale Locale
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema)
    SchemaP
  SwaggerDoc
  Object
  [Pair]
  NewUserRaw
  (Maybe PlainTextPassword8
   -> Maybe ExpiresIn
   -> Maybe ManagedBy
   -> Maybe (Set BaseProtocolTag)
   -> NewUserRaw)
-> SchemaP
     SwaggerDoc Object [Pair] NewUserRaw (Maybe PlainTextPassword8)
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     NewUserRaw
     (Maybe ExpiresIn
      -> Maybe ManagedBy -> Maybe (Set BaseProtocolTag) -> NewUserRaw)
forall a b.
SchemaP SwaggerDoc Object [Pair] NewUserRaw (a -> b)
-> SchemaP SwaggerDoc Object [Pair] NewUserRaw a
-> SchemaP SwaggerDoc Object [Pair] NewUserRaw b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> NewUserRaw -> Maybe PlainTextPassword8
newUserRawPassword
      (NewUserRaw -> Maybe PlainTextPassword8)
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     (Maybe PlainTextPassword8)
     (Maybe PlainTextPassword8)
-> SchemaP
     SwaggerDoc Object [Pair] NewUserRaw (Maybe PlainTextPassword8)
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= SchemaP
  SwaggerDoc
  Object
  [Pair]
  PlainTextPassword8
  (Maybe PlainTextPassword8)
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     (Maybe PlainTextPassword8)
     (Maybe PlainTextPassword8)
forall w d v a b.
Monoid w =>
SchemaP d v w a b -> SchemaP d v w (Maybe a) b
maybe_ (Text
-> SchemaP
     NamedSwaggerDoc Value Value PlainTextPassword8 PlainTextPassword8
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     PlainTextPassword8
     (Maybe PlainTextPassword8)
forall doc doc' a b.
(HasOpt doc, HasField doc' doc) =>
Text
-> SchemaP doc' Value Value a b
-> SchemaP doc Object [Pair] a (Maybe b)
optField Text
"password" SchemaP
  NamedSwaggerDoc Value Value PlainTextPassword8 PlainTextPassword8
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema)
    SchemaP
  SwaggerDoc
  Object
  [Pair]
  NewUserRaw
  (Maybe ExpiresIn
   -> Maybe ManagedBy -> Maybe (Set BaseProtocolTag) -> NewUserRaw)
-> SchemaP SwaggerDoc Object [Pair] NewUserRaw (Maybe ExpiresIn)
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     NewUserRaw
     (Maybe ManagedBy -> Maybe (Set BaseProtocolTag) -> NewUserRaw)
forall a b.
SchemaP SwaggerDoc Object [Pair] NewUserRaw (a -> b)
-> SchemaP SwaggerDoc Object [Pair] NewUserRaw a
-> SchemaP SwaggerDoc Object [Pair] NewUserRaw b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> NewUserRaw -> Maybe ExpiresIn
newUserRawExpiresIn
      (NewUserRaw -> Maybe ExpiresIn)
-> SchemaP
     SwaggerDoc Object [Pair] (Maybe ExpiresIn) (Maybe ExpiresIn)
-> SchemaP SwaggerDoc Object [Pair] NewUserRaw (Maybe ExpiresIn)
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= SchemaP SwaggerDoc Object [Pair] ExpiresIn (Maybe ExpiresIn)
-> SchemaP
     SwaggerDoc Object [Pair] (Maybe ExpiresIn) (Maybe ExpiresIn)
forall w d v a b.
Monoid w =>
SchemaP d v w a b -> SchemaP d v w (Maybe a) b
maybe_ (Text
-> SchemaP NamedSwaggerDoc Value Value ExpiresIn ExpiresIn
-> SchemaP SwaggerDoc Object [Pair] ExpiresIn (Maybe ExpiresIn)
forall doc doc' a b.
(HasOpt doc, HasField doc' doc) =>
Text
-> SchemaP doc' Value Value a b
-> SchemaP doc Object [Pair] a (Maybe b)
optField Text
"expires_in" SchemaP NamedSwaggerDoc Value Value ExpiresIn ExpiresIn
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema)
    SchemaP
  SwaggerDoc
  Object
  [Pair]
  NewUserRaw
  (Maybe ManagedBy -> Maybe (Set BaseProtocolTag) -> NewUserRaw)
-> SchemaP SwaggerDoc Object [Pair] NewUserRaw (Maybe ManagedBy)
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     NewUserRaw
     (Maybe (Set BaseProtocolTag) -> NewUserRaw)
forall a b.
SchemaP SwaggerDoc Object [Pair] NewUserRaw (a -> b)
-> SchemaP SwaggerDoc Object [Pair] NewUserRaw a
-> SchemaP SwaggerDoc Object [Pair] NewUserRaw b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> NewUserRaw -> Maybe ManagedBy
newUserRawManagedBy
      (NewUserRaw -> Maybe ManagedBy)
-> SchemaP
     SwaggerDoc Object [Pair] (Maybe ManagedBy) (Maybe ManagedBy)
-> SchemaP SwaggerDoc Object [Pair] NewUserRaw (Maybe ManagedBy)
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= SchemaP SwaggerDoc Object [Pair] ManagedBy (Maybe ManagedBy)
-> SchemaP
     SwaggerDoc Object [Pair] (Maybe ManagedBy) (Maybe ManagedBy)
forall w d v a b.
Monoid w =>
SchemaP d v w a b -> SchemaP d v w (Maybe a) b
maybe_ (Text
-> SchemaP NamedSwaggerDoc Value Value ManagedBy ManagedBy
-> SchemaP SwaggerDoc Object [Pair] ManagedBy (Maybe ManagedBy)
forall doc doc' a b.
(HasOpt doc, HasField doc' doc) =>
Text
-> SchemaP doc' Value Value a b
-> SchemaP doc Object [Pair] a (Maybe b)
optField Text
"managed_by" SchemaP NamedSwaggerDoc Value Value ManagedBy ManagedBy
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema)
    SchemaP
  SwaggerDoc
  Object
  [Pair]
  NewUserRaw
  (Maybe (Set BaseProtocolTag) -> NewUserRaw)
-> SchemaP
     SwaggerDoc Object [Pair] NewUserRaw (Maybe (Set BaseProtocolTag))
-> ObjectSchema SwaggerDoc NewUserRaw
forall a b.
SchemaP SwaggerDoc Object [Pair] NewUserRaw (a -> b)
-> SchemaP SwaggerDoc Object [Pair] NewUserRaw a
-> SchemaP SwaggerDoc Object [Pair] NewUserRaw b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> NewUserRaw -> Maybe (Set BaseProtocolTag)
newUserRawSupportedProtocols
      (NewUserRaw -> Maybe (Set BaseProtocolTag))
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     (Maybe (Set BaseProtocolTag))
     (Maybe (Set BaseProtocolTag))
-> SchemaP
     SwaggerDoc Object [Pair] NewUserRaw (Maybe (Set BaseProtocolTag))
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= SchemaP
  SwaggerDoc
  Object
  [Pair]
  (Set BaseProtocolTag)
  (Maybe (Set BaseProtocolTag))
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     (Maybe (Set BaseProtocolTag))
     (Maybe (Set BaseProtocolTag))
forall w d v a b.
Monoid w =>
SchemaP d v w a b -> SchemaP d v w (Maybe a) b
maybe_ (Text
-> SchemaP
     SwaggerDoc Value Value (Set BaseProtocolTag) (Set BaseProtocolTag)
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     (Set BaseProtocolTag)
     (Maybe (Set BaseProtocolTag))
forall doc doc' a b.
(HasOpt doc, HasField doc' doc) =>
Text
-> SchemaP doc' Value Value a b
-> SchemaP doc Object [Pair] a (Maybe b)
optField Text
"supported_protocols" (ValueSchema NamedSwaggerDoc BaseProtocolTag
-> SchemaP
     SwaggerDoc Value Value (Set BaseProtocolTag) (Set BaseProtocolTag)
forall ndoc doc a.
(HasArray ndoc doc, HasName ndoc, Ord a) =>
ValueSchema ndoc a -> ValueSchema doc (Set a)
set ValueSchema NamedSwaggerDoc BaseProtocolTag
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema))

instance ToSchema NewUser where
  schema :: SchemaP NamedSwaggerDoc Value Value NewUser NewUser
schema =
    Text
-> SchemaP SwaggerDoc Object [Pair] NewUser NewUser
-> SchemaP NamedSwaggerDoc Value Value NewUser NewUser
forall doc doc' a b.
HasObject doc doc' =>
Text
-> SchemaP doc Object [Pair] a b -> SchemaP doc' Value Value a b
object Text
"NewUser" (SchemaP SwaggerDoc Object [Pair] NewUser NewUser
 -> SchemaP NamedSwaggerDoc Value Value NewUser NewUser)
-> SchemaP SwaggerDoc Object [Pair] NewUser NewUser
-> SchemaP NamedSwaggerDoc Value Value NewUser NewUser
forall a b. (a -> b) -> a -> b
$ NewUser -> NewUserRaw
newUserToRaw (NewUser -> NewUserRaw)
-> SchemaP SwaggerDoc Object [Pair] NewUserRaw NewUser
-> SchemaP SwaggerDoc Object [Pair] NewUser NewUser
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= ObjectSchema SwaggerDoc NewUserRaw
-> (NewUserRaw -> Parser NewUser)
-> SchemaP SwaggerDoc Object [Pair] NewUserRaw NewUser
forall doc v w a b b'.
SchemaP doc v w a b -> (b -> Parser b') -> SchemaP doc v w a b'
withParser ObjectSchema SwaggerDoc NewUserRaw
newUserRawObjectSchema NewUserRaw -> Parser NewUser
newUserFromRaw

newUserToRaw :: NewUser -> NewUserRaw
newUserToRaw :: NewUser -> NewUserRaw
newUserToRaw NewUser {[Asset]
Maybe (Set BaseProtocolTag)
Maybe ExpiresIn
Maybe PlainTextPassword8
Maybe UUID
Maybe Locale
Maybe Pict
Maybe ManagedBy
Maybe ColourId
Maybe UserIdentity
Maybe CookieLabel
Maybe ActivationCode
Maybe NewUserOrigin
Name
$sel:newUserUUID:NewUser :: NewUser -> Maybe UUID
$sel:newUserManagedBy:NewUser :: NewUser -> Maybe ManagedBy
$sel:newUserIdentity:NewUser :: NewUser -> Maybe UserIdentity
$sel:newUserDisplayName:NewUser :: NewUser -> Name
$sel:newUserPict:NewUser :: NewUser -> Maybe Pict
$sel:newUserAssets:NewUser :: NewUser -> [Asset]
$sel:newUserAccentId:NewUser :: NewUser -> Maybe ColourId
$sel:newUserEmailCode:NewUser :: NewUser -> Maybe ActivationCode
$sel:newUserOrigin:NewUser :: NewUser -> Maybe NewUserOrigin
$sel:newUserLabel:NewUser :: NewUser -> Maybe CookieLabel
$sel:newUserPassword:NewUser :: NewUser -> Maybe PlainTextPassword8
$sel:newUserExpiresIn:NewUser :: NewUser -> Maybe ExpiresIn
$sel:newUserLocale:NewUser :: NewUser -> Maybe Locale
$sel:newUserSupportedProtocols:NewUser :: NewUser -> Maybe (Set BaseProtocolTag)
newUserDisplayName :: Name
newUserUUID :: Maybe UUID
newUserIdentity :: Maybe UserIdentity
newUserPict :: Maybe Pict
newUserAssets :: [Asset]
newUserAccentId :: Maybe ColourId
newUserEmailCode :: Maybe ActivationCode
newUserOrigin :: Maybe NewUserOrigin
newUserLabel :: Maybe CookieLabel
newUserLocale :: Maybe Locale
newUserPassword :: Maybe PlainTextPassword8
newUserExpiresIn :: Maybe ExpiresIn
newUserManagedBy :: Maybe ManagedBy
newUserSupportedProtocols :: Maybe (Set BaseProtocolTag)
..} =
  let maybeOriginNTU :: Maybe NewTeamUser
maybeOriginNTU = NewUserOrigin -> Maybe NewTeamUser
newUserOriginNewTeamUser (NewUserOrigin -> Maybe NewTeamUser)
-> Maybe NewUserOrigin -> Maybe NewTeamUser
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Maybe NewUserOrigin
newUserOrigin
   in NewUserRaw
        { $sel:newUserRawDisplayName:NewUserRaw :: Name
newUserRawDisplayName = Name
newUserDisplayName,
          $sel:newUserRawUUID:NewUserRaw :: Maybe UUID
newUserRawUUID = Maybe UUID
newUserUUID,
          $sel:newUserRawEmail:NewUserRaw :: Maybe EmailAddress
newUserRawEmail = UserIdentity -> Maybe EmailAddress
emailIdentity (UserIdentity -> Maybe EmailAddress)
-> Maybe UserIdentity -> Maybe EmailAddress
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Maybe UserIdentity
newUserIdentity,
          $sel:newUserRawSSOId:NewUserRaw :: Maybe UserSSOId
newUserRawSSOId = UserIdentity -> Maybe UserSSOId
ssoIdentity (UserIdentity -> Maybe UserSSOId)
-> Maybe UserIdentity -> Maybe UserSSOId
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Maybe UserIdentity
newUserIdentity,
          $sel:newUserRawPict:NewUserRaw :: Maybe Pict
newUserRawPict = Maybe Pict
newUserPict,
          $sel:newUserRawAssets:NewUserRaw :: [Asset]
newUserRawAssets = [Asset]
newUserAssets,
          $sel:newUserRawAccentId:NewUserRaw :: Maybe ColourId
newUserRawAccentId = Maybe ColourId
newUserAccentId,
          $sel:newUserRawEmailCode:NewUserRaw :: Maybe ActivationCode
newUserRawEmailCode = Maybe ActivationCode
newUserEmailCode,
          $sel:newUserRawInvitationCode:NewUserRaw :: Maybe InvitationCode
newUserRawInvitationCode = NewUserOrigin -> Maybe InvitationCode
newUserOriginInvitationCode (NewUserOrigin -> Maybe InvitationCode)
-> Maybe NewUserOrigin -> Maybe InvitationCode
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Maybe NewUserOrigin
newUserOrigin,
          $sel:newUserRawTeamCode:NewUserRaw :: Maybe InvitationCode
newUserRawTeamCode = NewTeamUser -> Maybe InvitationCode
newTeamUserCode (NewTeamUser -> Maybe InvitationCode)
-> Maybe NewTeamUser -> Maybe InvitationCode
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Maybe NewTeamUser
maybeOriginNTU,
          $sel:newUserRawTeam:NewUserRaw :: Maybe BindingNewTeamUser
newUserRawTeam = NewTeamUser -> Maybe BindingNewTeamUser
newTeamUserCreator (NewTeamUser -> Maybe BindingNewTeamUser)
-> Maybe NewTeamUser -> Maybe BindingNewTeamUser
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Maybe NewTeamUser
maybeOriginNTU,
          $sel:newUserRawTeamId:NewUserRaw :: Maybe TeamId
newUserRawTeamId = NewTeamUser -> Maybe TeamId
newTeamUserTeamId (NewTeamUser -> Maybe TeamId) -> Maybe NewTeamUser -> Maybe TeamId
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Maybe NewTeamUser
maybeOriginNTU,
          $sel:newUserRawLabel:NewUserRaw :: Maybe CookieLabel
newUserRawLabel = Maybe CookieLabel
newUserLabel,
          $sel:newUserRawLocale:NewUserRaw :: Maybe Locale
newUserRawLocale = Maybe Locale
newUserLocale,
          $sel:newUserRawPassword:NewUserRaw :: Maybe PlainTextPassword8
newUserRawPassword = Maybe PlainTextPassword8
newUserPassword,
          $sel:newUserRawExpiresIn:NewUserRaw :: Maybe ExpiresIn
newUserRawExpiresIn = Maybe ExpiresIn
newUserExpiresIn,
          $sel:newUserRawManagedBy:NewUserRaw :: Maybe ManagedBy
newUserRawManagedBy = Maybe ManagedBy
newUserManagedBy,
          $sel:newUserRawSupportedProtocols:NewUserRaw :: Maybe (Set BaseProtocolTag)
newUserRawSupportedProtocols = Maybe (Set BaseProtocolTag)
newUserSupportedProtocols
        }

newUserFromRaw :: NewUserRaw -> A.Parser NewUser
newUserFromRaw :: NewUserRaw -> Parser NewUser
newUserFromRaw NewUserRaw {[Asset]
Maybe (Set BaseProtocolTag)
Maybe EmailAddress
Maybe TeamId
Maybe ExpiresIn
Maybe PlainTextPassword8
Maybe UUID
Maybe Locale
Maybe Pict
Maybe ManagedBy
Maybe ColourId
Maybe UserSSOId
Maybe CookieLabel
Maybe ActivationCode
Maybe BindingNewTeamUser
Maybe InvitationCode
Name
$sel:newUserRawDisplayName:NewUserRaw :: NewUserRaw -> Name
$sel:newUserRawUUID:NewUserRaw :: NewUserRaw -> Maybe UUID
$sel:newUserRawEmail:NewUserRaw :: NewUserRaw -> Maybe EmailAddress
$sel:newUserRawSSOId:NewUserRaw :: NewUserRaw -> Maybe UserSSOId
$sel:newUserRawPict:NewUserRaw :: NewUserRaw -> Maybe Pict
$sel:newUserRawAssets:NewUserRaw :: NewUserRaw -> [Asset]
$sel:newUserRawAccentId:NewUserRaw :: NewUserRaw -> Maybe ColourId
$sel:newUserRawEmailCode:NewUserRaw :: NewUserRaw -> Maybe ActivationCode
$sel:newUserRawInvitationCode:NewUserRaw :: NewUserRaw -> Maybe InvitationCode
$sel:newUserRawTeamCode:NewUserRaw :: NewUserRaw -> Maybe InvitationCode
$sel:newUserRawTeam:NewUserRaw :: NewUserRaw -> Maybe BindingNewTeamUser
$sel:newUserRawTeamId:NewUserRaw :: NewUserRaw -> Maybe TeamId
$sel:newUserRawLabel:NewUserRaw :: NewUserRaw -> Maybe CookieLabel
$sel:newUserRawLocale:NewUserRaw :: NewUserRaw -> Maybe Locale
$sel:newUserRawPassword:NewUserRaw :: NewUserRaw -> Maybe PlainTextPassword8
$sel:newUserRawExpiresIn:NewUserRaw :: NewUserRaw -> Maybe ExpiresIn
$sel:newUserRawManagedBy:NewUserRaw :: NewUserRaw -> Maybe ManagedBy
$sel:newUserRawSupportedProtocols:NewUserRaw :: NewUserRaw -> Maybe (Set BaseProtocolTag)
newUserRawDisplayName :: Name
newUserRawUUID :: Maybe UUID
newUserRawEmail :: Maybe EmailAddress
newUserRawSSOId :: Maybe UserSSOId
newUserRawPict :: Maybe Pict
newUserRawAssets :: [Asset]
newUserRawAccentId :: Maybe ColourId
newUserRawEmailCode :: Maybe ActivationCode
newUserRawInvitationCode :: Maybe InvitationCode
newUserRawTeamCode :: Maybe InvitationCode
newUserRawTeam :: Maybe BindingNewTeamUser
newUserRawTeamId :: Maybe TeamId
newUserRawLabel :: Maybe CookieLabel
newUserRawLocale :: Maybe Locale
newUserRawPassword :: Maybe PlainTextPassword8
newUserRawExpiresIn :: Maybe ExpiresIn
newUserRawManagedBy :: Maybe ManagedBy
newUserRawSupportedProtocols :: Maybe (Set BaseProtocolTag)
..} = do
  Maybe NewUserOrigin
origin <-
    (String -> Parser (Maybe NewUserOrigin))
-> (Maybe NewUserOrigin -> Parser (Maybe NewUserOrigin))
-> Either String (Maybe NewUserOrigin)
-> Parser (Maybe NewUserOrigin)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either String -> Parser (Maybe NewUserOrigin)
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail Maybe NewUserOrigin -> Parser (Maybe NewUserOrigin)
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either String (Maybe NewUserOrigin)
 -> Parser (Maybe NewUserOrigin))
-> Either String (Maybe NewUserOrigin)
-> Parser (Maybe NewUserOrigin)
forall a b. (a -> b) -> a -> b
$
      Bool
-> Bool
-> NewUserOriginComponents
-> Either String (Maybe NewUserOrigin)
maybeNewUserOriginFromComponents
        (Maybe PlainTextPassword8 -> Bool
forall a. Maybe a -> Bool
isJust Maybe PlainTextPassword8
newUserRawPassword)
        (Maybe UserSSOId -> Bool
forall a. Maybe a -> Bool
isJust Maybe UserSSOId
newUserRawSSOId)
        (Maybe InvitationCode
newUserRawInvitationCode, Maybe InvitationCode
newUserRawTeamCode, Maybe BindingNewTeamUser
newUserRawTeam, Maybe TeamId
newUserRawTeamId)
  let identity :: Maybe UserIdentity
identity =
        UserIdentityComponents -> Maybe UserIdentity
maybeUserIdentityFromComponents
          (Maybe EmailAddress
newUserRawEmail, Maybe UserSSOId
newUserRawSSOId)
  Maybe ExpiresIn
expiresIn <-
    case (Maybe ExpiresIn
newUserRawExpiresIn, Maybe UserIdentity
identity) of
      (Just ExpiresIn
_, Just UserIdentity
_) -> String -> Parser (Maybe ExpiresIn)
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Only users without an identity can expire"
      (Maybe ExpiresIn, Maybe UserIdentity)
_ -> Maybe ExpiresIn -> Parser (Maybe ExpiresIn)
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe ExpiresIn
newUserRawExpiresIn
  NewUser -> Parser NewUser
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (NewUser -> Parser NewUser) -> NewUser -> Parser NewUser
forall a b. (a -> b) -> a -> b
$
    NewUser
      { $sel:newUserDisplayName:NewUser :: Name
newUserDisplayName = Name
newUserRawDisplayName,
        $sel:newUserUUID:NewUser :: Maybe UUID
newUserUUID = Maybe UUID
newUserRawUUID,
        $sel:newUserIdentity:NewUser :: Maybe UserIdentity
newUserIdentity = Maybe UserIdentity
identity,
        $sel:newUserPict:NewUser :: Maybe Pict
newUserPict = Maybe Pict
newUserRawPict,
        $sel:newUserAssets:NewUser :: [Asset]
newUserAssets = [Asset]
newUserRawAssets,
        $sel:newUserAccentId:NewUser :: Maybe ColourId
newUserAccentId = Maybe ColourId
newUserRawAccentId,
        $sel:newUserEmailCode:NewUser :: Maybe ActivationCode
newUserEmailCode = Maybe ActivationCode
newUserRawEmailCode,
        $sel:newUserOrigin:NewUser :: Maybe NewUserOrigin
newUserOrigin = Maybe NewUserOrigin
origin,
        $sel:newUserLabel:NewUser :: Maybe CookieLabel
newUserLabel = Maybe CookieLabel
newUserRawLabel,
        $sel:newUserLocale:NewUser :: Maybe Locale
newUserLocale = Maybe Locale
newUserRawLocale,
        $sel:newUserPassword:NewUser :: Maybe PlainTextPassword8
newUserPassword = Maybe PlainTextPassword8
newUserRawPassword,
        $sel:newUserExpiresIn:NewUser :: Maybe ExpiresIn
newUserExpiresIn = Maybe ExpiresIn
expiresIn,
        $sel:newUserManagedBy:NewUser :: Maybe ManagedBy
newUserManagedBy = Maybe ManagedBy
newUserRawManagedBy,
        $sel:newUserSupportedProtocols:NewUser :: Maybe (Set BaseProtocolTag)
newUserSupportedProtocols = Maybe (Set BaseProtocolTag)
newUserRawSupportedProtocols
      }

-- FUTUREWORK: align more with FromJSON instance?
instance Arbitrary NewUser where
  arbitrary :: Gen NewUser
arbitrary = do
    Maybe UserIdentity
newUserIdentity <- Gen (Maybe UserIdentity)
forall a. Arbitrary a => Gen a
arbitrary
    Maybe NewUserOrigin
newUserOrigin <- Maybe UserIdentity -> Gen (Maybe NewUserOrigin)
genUserOrigin Maybe UserIdentity
newUserIdentity
    Name
newUserDisplayName <- Gen Name
forall a. Arbitrary a => Gen a
arbitrary
    Maybe UUID
newUserUUID <- [Maybe UUID] -> Gen (Maybe UUID)
forall a. [a] -> Gen a
QC.elements [UUID -> Maybe UUID
forall a. a -> Maybe a
Just UUID
nil, Maybe UUID
forall a. Maybe a
Nothing]
    Maybe Pict
newUserPict <- Gen (Maybe Pict)
forall a. Arbitrary a => Gen a
arbitrary
    [Asset]
newUserAssets <- Gen [Asset]
forall a. Arbitrary a => Gen a
arbitrary
    Maybe ColourId
newUserAccentId <- Gen (Maybe ColourId)
forall a. Arbitrary a => Gen a
arbitrary
    Maybe ActivationCode
newUserEmailCode <- Gen (Maybe ActivationCode)
forall a. Arbitrary a => Gen a
arbitrary
    Maybe CookieLabel
newUserLabel <- Gen (Maybe CookieLabel)
forall a. Arbitrary a => Gen a
arbitrary
    Maybe Locale
newUserLocale <- Gen (Maybe Locale)
forall a. Arbitrary a => Gen a
arbitrary
    Maybe PlainTextPassword8
newUserPassword <- Maybe UserIdentity
-> Maybe NewUserOrigin -> Gen (Maybe PlainTextPassword8)
forall {a}.
Arbitrary a =>
Maybe UserIdentity -> Maybe NewUserOrigin -> Gen (Maybe a)
genUserPassword Maybe UserIdentity
newUserIdentity Maybe NewUserOrigin
newUserOrigin
    Maybe ExpiresIn
newUserExpiresIn <- Maybe UserIdentity -> Gen (Maybe ExpiresIn)
forall {a} {a}. Arbitrary a => Maybe a -> Gen (Maybe a)
genUserExpiresIn Maybe UserIdentity
newUserIdentity
    Maybe ManagedBy
newUserManagedBy <- Gen (Maybe ManagedBy)
forall a. Arbitrary a => Gen a
arbitrary
    Maybe (Set BaseProtocolTag)
newUserSupportedProtocols <- Gen (Maybe (Set BaseProtocolTag))
forall a. Arbitrary a => Gen a
arbitrary
    NewUser -> Gen NewUser
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure NewUser {[Asset]
Maybe (Set BaseProtocolTag)
Maybe ExpiresIn
Maybe PlainTextPassword8
Maybe UUID
Maybe Locale
Maybe Pict
Maybe ManagedBy
Maybe ColourId
Maybe UserIdentity
Maybe CookieLabel
Maybe ActivationCode
Maybe NewUserOrigin
Name
$sel:newUserUUID:NewUser :: Maybe UUID
$sel:newUserManagedBy:NewUser :: Maybe ManagedBy
$sel:newUserIdentity:NewUser :: Maybe UserIdentity
$sel:newUserDisplayName:NewUser :: Name
$sel:newUserPict:NewUser :: Maybe Pict
$sel:newUserAssets:NewUser :: [Asset]
$sel:newUserAccentId:NewUser :: Maybe ColourId
$sel:newUserEmailCode:NewUser :: Maybe ActivationCode
$sel:newUserOrigin:NewUser :: Maybe NewUserOrigin
$sel:newUserLabel:NewUser :: Maybe CookieLabel
$sel:newUserPassword:NewUser :: Maybe PlainTextPassword8
$sel:newUserExpiresIn:NewUser :: Maybe ExpiresIn
$sel:newUserLocale:NewUser :: Maybe Locale
$sel:newUserSupportedProtocols:NewUser :: Maybe (Set BaseProtocolTag)
newUserIdentity :: Maybe UserIdentity
newUserOrigin :: Maybe NewUserOrigin
newUserDisplayName :: Name
newUserUUID :: Maybe UUID
newUserPict :: Maybe Pict
newUserAssets :: [Asset]
newUserAccentId :: Maybe ColourId
newUserEmailCode :: Maybe ActivationCode
newUserLabel :: Maybe CookieLabel
newUserLocale :: Maybe Locale
newUserPassword :: Maybe PlainTextPassword8
newUserExpiresIn :: Maybe ExpiresIn
newUserManagedBy :: Maybe ManagedBy
newUserSupportedProtocols :: Maybe (Set BaseProtocolTag)
..}
    where
      genUserOrigin :: Maybe UserIdentity -> Gen (Maybe NewUserOrigin)
genUserOrigin Maybe UserIdentity
newUserIdentity = do
        TeamId
teamid <- Gen TeamId
forall a. Arbitrary a => Gen a
arbitrary
        let hasSSOId :: Bool
hasSSOId = case Maybe UserIdentity
newUserIdentity of
              Just SSOIdentity {} -> Bool
True
              Maybe UserIdentity
_ -> Bool
False
            ssoOrigin :: Maybe NewUserOrigin
ssoOrigin = NewUserOrigin -> Maybe NewUserOrigin
forall a. a -> Maybe a
Just (NewTeamUser -> NewUserOrigin
NewUserOriginTeamUser (TeamId -> NewTeamUser
NewTeamMemberSSO TeamId
teamid))
            isSsoOrigin :: Maybe NewUserOrigin -> Bool
isSsoOrigin (Just (NewUserOriginTeamUser (NewTeamMemberSSO TeamId
_))) = Bool
True
            isSsoOrigin Maybe NewUserOrigin
_ = Bool
False
        if Bool
hasSSOId
          then Maybe NewUserOrigin -> Gen (Maybe NewUserOrigin)
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe NewUserOrigin
ssoOrigin
          else Gen (Maybe NewUserOrigin)
forall a. Arbitrary a => Gen a
arbitrary Gen (Maybe NewUserOrigin)
-> (Maybe NewUserOrigin -> Bool) -> Gen (Maybe NewUserOrigin)
forall a. Gen a -> (a -> Bool) -> Gen a
`QC.suchThat` (Bool -> Bool
not (Bool -> Bool)
-> (Maybe NewUserOrigin -> Bool) -> Maybe NewUserOrigin -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe NewUserOrigin -> Bool
isSsoOrigin)
      genUserPassword :: Maybe UserIdentity -> Maybe NewUserOrigin -> Gen (Maybe a)
genUserPassword Maybe UserIdentity
newUserIdentity Maybe NewUserOrigin
newUserOrigin = do
        let hasSSOId :: Bool
hasSSOId = case Maybe UserIdentity
newUserIdentity of
              Just SSOIdentity {} -> Bool
True
              Maybe UserIdentity
_ -> Bool
False
            isTeamUser :: Bool
isTeamUser = case Maybe NewUserOrigin
newUserOrigin of
              Just (NewUserOriginTeamUser NewTeamUser
_) -> Bool
True
              Maybe NewUserOrigin
_ -> Bool
False
        if Bool
isTeamUser Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
hasSSOId then a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a) -> Gen a -> Gen (Maybe a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen a
forall a. Arbitrary a => Gen a
arbitrary else Gen (Maybe a)
forall a. Arbitrary a => Gen a
arbitrary
      genUserExpiresIn :: Maybe a -> Gen (Maybe a)
genUserExpiresIn Maybe a
newUserIdentity =
        if Maybe a -> Bool
forall a. Maybe a -> Bool
isJust Maybe a
newUserIdentity then Maybe a -> Gen (Maybe a)
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe a
forall a. Maybe a
Nothing else Gen (Maybe a)
forall a. Arbitrary a => Gen a
arbitrary

newUserTeam :: NewUser -> Maybe NewTeamUser
newUserTeam :: NewUser -> Maybe NewTeamUser
newUserTeam NewUser
nu = case NewUser -> Maybe NewUserOrigin
newUserOrigin NewUser
nu of
  Just (NewUserOriginTeamUser NewTeamUser
tu) -> NewTeamUser -> Maybe NewTeamUser
forall a. a -> Maybe a
Just NewTeamUser
tu
  Maybe NewUserOrigin
_ -> Maybe NewTeamUser
forall a. Maybe a
Nothing

newUserEmail :: NewUser -> Maybe EmailAddress
newUserEmail :: NewUser -> Maybe EmailAddress
newUserEmail = UserIdentity -> Maybe EmailAddress
emailIdentity (UserIdentity -> Maybe EmailAddress)
-> (NewUser -> Maybe UserIdentity) -> NewUser -> Maybe EmailAddress
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< NewUser -> Maybe UserIdentity
newUserIdentity

newUserSSOId :: NewUser -> Maybe UserSSOId
newUserSSOId :: NewUser -> Maybe UserSSOId
newUserSSOId = UserIdentity -> Maybe UserSSOId
ssoIdentity (UserIdentity -> Maybe UserSSOId)
-> (NewUser -> Maybe UserIdentity) -> NewUser -> Maybe UserSSOId
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< NewUser -> Maybe UserIdentity
newUserIdentity

--------------------------------------------------------------------------------
-- NewUserOrigin

data NewUserOrigin
  = NewUserOriginInvitationCode InvitationCode
  | NewUserOriginTeamUser NewTeamUser
  deriving stock (NewUserOrigin -> NewUserOrigin -> Bool
(NewUserOrigin -> NewUserOrigin -> Bool)
-> (NewUserOrigin -> NewUserOrigin -> Bool) -> Eq NewUserOrigin
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: NewUserOrigin -> NewUserOrigin -> Bool
== :: NewUserOrigin -> NewUserOrigin -> Bool
$c/= :: NewUserOrigin -> NewUserOrigin -> Bool
/= :: NewUserOrigin -> NewUserOrigin -> Bool
Eq, Int -> NewUserOrigin -> ShowS
[NewUserOrigin] -> ShowS
NewUserOrigin -> String
(Int -> NewUserOrigin -> ShowS)
-> (NewUserOrigin -> String)
-> ([NewUserOrigin] -> ShowS)
-> Show NewUserOrigin
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> NewUserOrigin -> ShowS
showsPrec :: Int -> NewUserOrigin -> ShowS
$cshow :: NewUserOrigin -> String
show :: NewUserOrigin -> String
$cshowList :: [NewUserOrigin] -> ShowS
showList :: [NewUserOrigin] -> ShowS
Show, (forall x. NewUserOrigin -> Rep NewUserOrigin x)
-> (forall x. Rep NewUserOrigin x -> NewUserOrigin)
-> Generic NewUserOrigin
forall x. Rep NewUserOrigin x -> NewUserOrigin
forall x. NewUserOrigin -> Rep NewUserOrigin x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. NewUserOrigin -> Rep NewUserOrigin x
from :: forall x. NewUserOrigin -> Rep NewUserOrigin x
$cto :: forall x. Rep NewUserOrigin x -> NewUserOrigin
to :: forall x. Rep NewUserOrigin x -> NewUserOrigin
Generic)
  deriving (Gen NewUserOrigin
Gen NewUserOrigin
-> (NewUserOrigin -> [NewUserOrigin]) -> Arbitrary NewUserOrigin
NewUserOrigin -> [NewUserOrigin]
forall a. Gen a -> (a -> [a]) -> Arbitrary a
$carbitrary :: Gen NewUserOrigin
arbitrary :: Gen NewUserOrigin
$cshrink :: NewUserOrigin -> [NewUserOrigin]
shrink :: NewUserOrigin -> [NewUserOrigin]
Arbitrary) via (GenericUniform NewUserOrigin)

type NewUserOriginComponents = (Maybe InvitationCode, Maybe InvitationCode, Maybe BindingNewTeamUser, Maybe TeamId)

newUserOriginInvitationCode :: NewUserOrigin -> Maybe InvitationCode
newUserOriginInvitationCode :: NewUserOrigin -> Maybe InvitationCode
newUserOriginInvitationCode = \case
  NewUserOriginInvitationCode InvitationCode
ic -> InvitationCode -> Maybe InvitationCode
forall a. a -> Maybe a
Just InvitationCode
ic
  NewUserOriginTeamUser NewTeamUser
_ -> Maybe InvitationCode
forall a. Maybe a
Nothing

newUserOriginNewTeamUser :: NewUserOrigin -> Maybe NewTeamUser
newUserOriginNewTeamUser :: NewUserOrigin -> Maybe NewTeamUser
newUserOriginNewTeamUser = \case
  NewUserOriginInvitationCode InvitationCode
_ -> Maybe NewTeamUser
forall a. Maybe a
Nothing
  NewUserOriginTeamUser NewTeamUser
ntu -> NewTeamUser -> Maybe NewTeamUser
forall a. a -> Maybe a
Just NewTeamUser
ntu

maybeNewUserOriginFromComponents ::
  -- | Does the user have a password
  Bool ->
  -- | Does the user have an SSO Identity
  Bool ->
  NewUserOriginComponents ->
  Either String (Maybe NewUserOrigin)
maybeNewUserOriginFromComponents :: Bool
-> Bool
-> NewUserOriginComponents
-> Either String (Maybe NewUserOrigin)
maybeNewUserOriginFromComponents Bool
hasPassword Bool
hasSSO (Maybe InvitationCode
invcode, Maybe InvitationCode
teamcode, Maybe BindingNewTeamUser
team, Maybe TeamId
teamid) = do
  Maybe NewUserOrigin
result <- case (Maybe InvitationCode
invcode, Maybe InvitationCode
teamcode, Maybe BindingNewTeamUser
team, Bool
hasSSO, Maybe TeamId
teamid) of
    (Just InvitationCode
a, Maybe InvitationCode
Nothing, Maybe BindingNewTeamUser
Nothing, Bool
False, Maybe TeamId
Nothing) -> Maybe NewUserOrigin -> Either String (Maybe NewUserOrigin)
forall a b. b -> Either a b
Right (Maybe NewUserOrigin -> Either String (Maybe NewUserOrigin))
-> (InvitationCode -> Maybe NewUserOrigin)
-> InvitationCode
-> Either String (Maybe NewUserOrigin)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NewUserOrigin -> Maybe NewUserOrigin
forall a. a -> Maybe a
Just (NewUserOrigin -> Maybe NewUserOrigin)
-> (InvitationCode -> NewUserOrigin)
-> InvitationCode
-> Maybe NewUserOrigin
forall b c a. (b -> c) -> (a -> b) -> a -> c
. InvitationCode -> NewUserOrigin
NewUserOriginInvitationCode (InvitationCode -> Either String (Maybe NewUserOrigin))
-> InvitationCode -> Either String (Maybe NewUserOrigin)
forall a b. (a -> b) -> a -> b
$ InvitationCode
a
    (Maybe InvitationCode
Nothing, Just InvitationCode
a, Maybe BindingNewTeamUser
Nothing, Bool
False, Maybe TeamId
Nothing) -> Maybe NewUserOrigin -> Either String (Maybe NewUserOrigin)
forall a b. b -> Either a b
Right (Maybe NewUserOrigin -> Either String (Maybe NewUserOrigin))
-> (NewTeamUser -> Maybe NewUserOrigin)
-> NewTeamUser
-> Either String (Maybe NewUserOrigin)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NewUserOrigin -> Maybe NewUserOrigin
forall a. a -> Maybe a
Just (NewUserOrigin -> Maybe NewUserOrigin)
-> (NewTeamUser -> NewUserOrigin)
-> NewTeamUser
-> Maybe NewUserOrigin
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NewTeamUser -> NewUserOrigin
NewUserOriginTeamUser (NewTeamUser -> Either String (Maybe NewUserOrigin))
-> NewTeamUser -> Either String (Maybe NewUserOrigin)
forall a b. (a -> b) -> a -> b
$ InvitationCode -> NewTeamUser
NewTeamMember InvitationCode
a
    (Maybe InvitationCode
Nothing, Maybe InvitationCode
Nothing, Just BindingNewTeamUser
a, Bool
False, Maybe TeamId
Nothing) -> Maybe NewUserOrigin -> Either String (Maybe NewUserOrigin)
forall a b. b -> Either a b
Right (Maybe NewUserOrigin -> Either String (Maybe NewUserOrigin))
-> (NewTeamUser -> Maybe NewUserOrigin)
-> NewTeamUser
-> Either String (Maybe NewUserOrigin)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NewUserOrigin -> Maybe NewUserOrigin
forall a. a -> Maybe a
Just (NewUserOrigin -> Maybe NewUserOrigin)
-> (NewTeamUser -> NewUserOrigin)
-> NewTeamUser
-> Maybe NewUserOrigin
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NewTeamUser -> NewUserOrigin
NewUserOriginTeamUser (NewTeamUser -> Either String (Maybe NewUserOrigin))
-> NewTeamUser -> Either String (Maybe NewUserOrigin)
forall a b. (a -> b) -> a -> b
$ BindingNewTeamUser -> NewTeamUser
NewTeamCreator BindingNewTeamUser
a
    (Maybe InvitationCode
Nothing, Maybe InvitationCode
Nothing, Maybe BindingNewTeamUser
Nothing, Bool
True, Just TeamId
t) -> Maybe NewUserOrigin -> Either String (Maybe NewUserOrigin)
forall a b. b -> Either a b
Right (Maybe NewUserOrigin -> Either String (Maybe NewUserOrigin))
-> (NewTeamUser -> Maybe NewUserOrigin)
-> NewTeamUser
-> Either String (Maybe NewUserOrigin)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NewUserOrigin -> Maybe NewUserOrigin
forall a. a -> Maybe a
Just (NewUserOrigin -> Maybe NewUserOrigin)
-> (NewTeamUser -> NewUserOrigin)
-> NewTeamUser
-> Maybe NewUserOrigin
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NewTeamUser -> NewUserOrigin
NewUserOriginTeamUser (NewTeamUser -> Either String (Maybe NewUserOrigin))
-> NewTeamUser -> Either String (Maybe NewUserOrigin)
forall a b. (a -> b) -> a -> b
$ TeamId -> NewTeamUser
NewTeamMemberSSO TeamId
t
    (Maybe InvitationCode
Nothing, Maybe InvitationCode
Nothing, Maybe BindingNewTeamUser
Nothing, Bool
False, Maybe TeamId
Nothing) -> Maybe NewUserOrigin -> Either String (Maybe NewUserOrigin)
forall a b. b -> Either a b
Right Maybe NewUserOrigin
forall a. Maybe a
Nothing
    (Maybe InvitationCode
_, Maybe InvitationCode
_, Maybe BindingNewTeamUser
_, Bool
True, Maybe TeamId
Nothing) -> String -> Either String (Maybe NewUserOrigin)
forall a b. a -> Either a b
Left String
"sso_id, team_id must be either both present or both absent."
    (Maybe InvitationCode
_, Maybe InvitationCode
_, Maybe BindingNewTeamUser
_, Bool
False, Just TeamId
_) -> String -> Either String (Maybe NewUserOrigin)
forall a b. a -> Either a b
Left String
"sso_id, team_id must be either both present or both absent."
    (Maybe InvitationCode, Maybe InvitationCode,
 Maybe BindingNewTeamUser, Bool, Maybe TeamId)
_ -> String -> Either String (Maybe NewUserOrigin)
forall a b. a -> Either a b
Left String
"team_code, team, invitation_code, sso_id, and the pair (sso_id, team_id) are mutually exclusive"
  case (Maybe NewUserOrigin
result, Bool
hasPassword, Bool
hasSSO) of
    (Maybe NewUserOrigin
_, Bool
_, Bool
True) -> Maybe NewUserOrigin -> Either String (Maybe NewUserOrigin)
forall a b. b -> Either a b
Right Maybe NewUserOrigin
result
    (Just (NewUserOriginTeamUser NewTeamUser
_), Bool
False, Bool
_) -> String -> Either String (Maybe NewUserOrigin)
forall a b. a -> Either a b
Left String
"all team users must set a password on creation"
    (Maybe NewUserOrigin, Bool, Bool)
_ -> Maybe NewUserOrigin -> Either String (Maybe NewUserOrigin)
forall a. a -> Either String a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe NewUserOrigin
result

-- | A random invitation code for use during registration
newtype InvitationCode = InvitationCode
  {InvitationCode -> AsciiBase64Url
fromInvitationCode :: AsciiBase64Url}
  deriving stock (InvitationCode -> InvitationCode -> Bool
(InvitationCode -> InvitationCode -> Bool)
-> (InvitationCode -> InvitationCode -> Bool) -> Eq InvitationCode
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: InvitationCode -> InvitationCode -> Bool
== :: InvitationCode -> InvitationCode -> Bool
$c/= :: InvitationCode -> InvitationCode -> Bool
/= :: InvitationCode -> InvitationCode -> Bool
Eq, Eq InvitationCode
Eq InvitationCode =>
(InvitationCode -> InvitationCode -> Ordering)
-> (InvitationCode -> InvitationCode -> Bool)
-> (InvitationCode -> InvitationCode -> Bool)
-> (InvitationCode -> InvitationCode -> Bool)
-> (InvitationCode -> InvitationCode -> Bool)
-> (InvitationCode -> InvitationCode -> InvitationCode)
-> (InvitationCode -> InvitationCode -> InvitationCode)
-> Ord InvitationCode
InvitationCode -> InvitationCode -> Bool
InvitationCode -> InvitationCode -> Ordering
InvitationCode -> InvitationCode -> InvitationCode
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 :: InvitationCode -> InvitationCode -> Ordering
compare :: InvitationCode -> InvitationCode -> Ordering
$c< :: InvitationCode -> InvitationCode -> Bool
< :: InvitationCode -> InvitationCode -> Bool
$c<= :: InvitationCode -> InvitationCode -> Bool
<= :: InvitationCode -> InvitationCode -> Bool
$c> :: InvitationCode -> InvitationCode -> Bool
> :: InvitationCode -> InvitationCode -> Bool
$c>= :: InvitationCode -> InvitationCode -> Bool
>= :: InvitationCode -> InvitationCode -> Bool
$cmax :: InvitationCode -> InvitationCode -> InvitationCode
max :: InvitationCode -> InvitationCode -> InvitationCode
$cmin :: InvitationCode -> InvitationCode -> InvitationCode
min :: InvitationCode -> InvitationCode -> InvitationCode
Ord, Int -> InvitationCode -> ShowS
[InvitationCode] -> ShowS
InvitationCode -> String
(Int -> InvitationCode -> ShowS)
-> (InvitationCode -> String)
-> ([InvitationCode] -> ShowS)
-> Show InvitationCode
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> InvitationCode -> ShowS
showsPrec :: Int -> InvitationCode -> ShowS
$cshow :: InvitationCode -> String
show :: InvitationCode -> String
$cshowList :: [InvitationCode] -> ShowS
showList :: [InvitationCode] -> ShowS
Show, (forall x. InvitationCode -> Rep InvitationCode x)
-> (forall x. Rep InvitationCode x -> InvitationCode)
-> Generic InvitationCode
forall x. Rep InvitationCode x -> InvitationCode
forall x. InvitationCode -> Rep InvitationCode x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. InvitationCode -> Rep InvitationCode x
from :: forall x. InvitationCode -> Rep InvitationCode x
$cto :: forall x. Rep InvitationCode x -> InvitationCode
to :: forall x. Rep InvitationCode x -> InvitationCode
Generic)
  deriving newtype (SchemaP NamedSwaggerDoc Value Value InvitationCode InvitationCode
SchemaP NamedSwaggerDoc Value Value InvitationCode InvitationCode
-> ToSchema InvitationCode
forall a. ValueSchema NamedSwaggerDoc a -> ToSchema a
$cschema :: SchemaP NamedSwaggerDoc Value Value InvitationCode InvitationCode
schema :: SchemaP NamedSwaggerDoc Value Value InvitationCode InvitationCode
ToSchema, InvitationCode -> Builder
(InvitationCode -> Builder) -> ToByteString InvitationCode
forall a. (a -> Builder) -> ToByteString a
$cbuilder :: InvitationCode -> Builder
builder :: InvitationCode -> Builder
ToByteString, Parser InvitationCode
Parser InvitationCode -> FromByteString InvitationCode
forall a. Parser a -> FromByteString a
$cparser :: Parser InvitationCode
parser :: Parser InvitationCode
FromByteString, Gen InvitationCode
Gen InvitationCode
-> (InvitationCode -> [InvitationCode]) -> Arbitrary InvitationCode
InvitationCode -> [InvitationCode]
forall a. Gen a -> (a -> [a]) -> Arbitrary a
$carbitrary :: Gen InvitationCode
arbitrary :: Gen InvitationCode
$cshrink :: InvitationCode -> [InvitationCode]
shrink :: InvitationCode -> [InvitationCode]
Arbitrary)
  deriving (Value -> Parser [InvitationCode]
Value -> Parser InvitationCode
(Value -> Parser InvitationCode)
-> (Value -> Parser [InvitationCode]) -> FromJSON InvitationCode
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser InvitationCode
parseJSON :: Value -> Parser InvitationCode
$cparseJSONList :: Value -> Parser [InvitationCode]
parseJSONList :: Value -> Parser [InvitationCode]
FromJSON, [InvitationCode] -> Value
[InvitationCode] -> Encoding
InvitationCode -> Value
InvitationCode -> Encoding
(InvitationCode -> Value)
-> (InvitationCode -> Encoding)
-> ([InvitationCode] -> Value)
-> ([InvitationCode] -> Encoding)
-> ToJSON InvitationCode
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: InvitationCode -> Value
toJSON :: InvitationCode -> Value
$ctoEncoding :: InvitationCode -> Encoding
toEncoding :: InvitationCode -> Encoding
$ctoJSONList :: [InvitationCode] -> Value
toJSONList :: [InvitationCode] -> Value
$ctoEncodingList :: [InvitationCode] -> Encoding
toEncodingList :: [InvitationCode] -> Encoding
ToJSON, Typeable InvitationCode
Typeable InvitationCode =>
(Proxy InvitationCode -> Declare (Definitions Schema) NamedSchema)
-> ToSchema InvitationCode
Proxy InvitationCode -> Declare (Definitions Schema) NamedSchema
forall a.
Typeable a =>
(Proxy a -> Declare (Definitions Schema) NamedSchema) -> ToSchema a
$cdeclareNamedSchema :: Proxy InvitationCode -> Declare (Definitions Schema) NamedSchema
declareNamedSchema :: Proxy InvitationCode -> Declare (Definitions Schema) NamedSchema
S.ToSchema) via Schema InvitationCode

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

instance FromHttpApiData InvitationCode where
  parseQueryParam :: Text -> Either Text InvitationCode
parseQueryParam = (String -> Text)
-> (AsciiBase64Url -> InvitationCode)
-> Either String AsciiBase64Url
-> Either Text InvitationCode
forall a b c d. (a -> b) -> (c -> d) -> Either a c -> Either b d
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap String -> Text
T.pack AsciiBase64Url -> InvitationCode
InvitationCode (Either String AsciiBase64Url -> Either Text InvitationCode)
-> (Text -> Either String AsciiBase64Url)
-> Text
-> Either Text InvitationCode
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either String AsciiBase64Url
validateBase64Url

instance ToHttpApiData InvitationCode where
  toQueryParam :: InvitationCode -> Text
toQueryParam =
    OnDecodeError -> ByteString -> Text
T.decodeUtf8With OnDecodeError
lenientDecode
      (ByteString -> Text)
-> (InvitationCode -> ByteString) -> InvitationCode -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
toStrict
      (ByteString -> ByteString)
-> (InvitationCode -> ByteString) -> InvitationCode -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AsciiBase64Url -> ByteString
forall a. ToByteString a => a -> ByteString
toByteString
      (AsciiBase64Url -> ByteString)
-> (InvitationCode -> AsciiBase64Url)
-> InvitationCode
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. InvitationCode -> AsciiBase64Url
fromInvitationCode

deriving instance C.Cql InvitationCode

--------------------------------------------------------------------------------
-- NewTeamUser

data NewTeamUser
  = -- | requires email address
    NewTeamMember InvitationCode
  | NewTeamCreator BindingNewTeamUser
  | -- | sso: users with saml credentials and/or created via scim
    NewTeamMemberSSO TeamId
  deriving stock (NewTeamUser -> NewTeamUser -> Bool
(NewTeamUser -> NewTeamUser -> Bool)
-> (NewTeamUser -> NewTeamUser -> Bool) -> Eq NewTeamUser
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: NewTeamUser -> NewTeamUser -> Bool
== :: NewTeamUser -> NewTeamUser -> Bool
$c/= :: NewTeamUser -> NewTeamUser -> Bool
/= :: NewTeamUser -> NewTeamUser -> Bool
Eq, Int -> NewTeamUser -> ShowS
[NewTeamUser] -> ShowS
NewTeamUser -> String
(Int -> NewTeamUser -> ShowS)
-> (NewTeamUser -> String)
-> ([NewTeamUser] -> ShowS)
-> Show NewTeamUser
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> NewTeamUser -> ShowS
showsPrec :: Int -> NewTeamUser -> ShowS
$cshow :: NewTeamUser -> String
show :: NewTeamUser -> String
$cshowList :: [NewTeamUser] -> ShowS
showList :: [NewTeamUser] -> ShowS
Show, (forall x. NewTeamUser -> Rep NewTeamUser x)
-> (forall x. Rep NewTeamUser x -> NewTeamUser)
-> Generic NewTeamUser
forall x. Rep NewTeamUser x -> NewTeamUser
forall x. NewTeamUser -> Rep NewTeamUser x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. NewTeamUser -> Rep NewTeamUser x
from :: forall x. NewTeamUser -> Rep NewTeamUser x
$cto :: forall x. Rep NewTeamUser x -> NewTeamUser
to :: forall x. Rep NewTeamUser x -> NewTeamUser
Generic)
  deriving (Gen NewTeamUser
Gen NewTeamUser
-> (NewTeamUser -> [NewTeamUser]) -> Arbitrary NewTeamUser
NewTeamUser -> [NewTeamUser]
forall a. Gen a -> (a -> [a]) -> Arbitrary a
$carbitrary :: Gen NewTeamUser
arbitrary :: Gen NewTeamUser
$cshrink :: NewTeamUser -> [NewTeamUser]
shrink :: NewTeamUser -> [NewTeamUser]
Arbitrary) via (GenericUniform NewTeamUser)

newTeamUserCode :: NewTeamUser -> Maybe InvitationCode
newTeamUserCode :: NewTeamUser -> Maybe InvitationCode
newTeamUserCode = \case
  NewTeamMember InvitationCode
ic -> InvitationCode -> Maybe InvitationCode
forall a. a -> Maybe a
Just InvitationCode
ic
  NewTeamCreator BindingNewTeamUser
_ -> Maybe InvitationCode
forall a. Maybe a
Nothing
  NewTeamMemberSSO TeamId
_ -> Maybe InvitationCode
forall a. Maybe a
Nothing

newTeamUserCreator :: NewTeamUser -> Maybe BindingNewTeamUser
newTeamUserCreator :: NewTeamUser -> Maybe BindingNewTeamUser
newTeamUserCreator = \case
  NewTeamMember InvitationCode
_ -> Maybe BindingNewTeamUser
forall a. Maybe a
Nothing
  NewTeamCreator BindingNewTeamUser
bntu -> BindingNewTeamUser -> Maybe BindingNewTeamUser
forall a. a -> Maybe a
Just BindingNewTeamUser
bntu
  NewTeamMemberSSO TeamId
_ -> Maybe BindingNewTeamUser
forall a. Maybe a
Nothing

newTeamUserTeamId :: NewTeamUser -> Maybe TeamId
newTeamUserTeamId :: NewTeamUser -> Maybe TeamId
newTeamUserTeamId = \case
  NewTeamMember InvitationCode
_ -> Maybe TeamId
forall a. Maybe a
Nothing
  NewTeamCreator BindingNewTeamUser
_ -> Maybe TeamId
forall a. Maybe a
Nothing
  NewTeamMemberSSO TeamId
tid -> TeamId -> Maybe TeamId
forall a. a -> Maybe a
Just TeamId
tid

data BindingNewTeamUser = BindingNewTeamUser
  { BindingNewTeamUser -> NewTeam
bnuTeam :: NewTeam,
    BindingNewTeamUser -> Maybe Alpha
bnuCurrency :: Maybe Currency.Alpha
    -- FUTUREWORK:
    -- Remove Currency selection once billing supports currency changes after team creation
  }
  deriving stock (BindingNewTeamUser -> BindingNewTeamUser -> Bool
(BindingNewTeamUser -> BindingNewTeamUser -> Bool)
-> (BindingNewTeamUser -> BindingNewTeamUser -> Bool)
-> Eq BindingNewTeamUser
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: BindingNewTeamUser -> BindingNewTeamUser -> Bool
== :: BindingNewTeamUser -> BindingNewTeamUser -> Bool
$c/= :: BindingNewTeamUser -> BindingNewTeamUser -> Bool
/= :: BindingNewTeamUser -> BindingNewTeamUser -> Bool
Eq, Int -> BindingNewTeamUser -> ShowS
[BindingNewTeamUser] -> ShowS
BindingNewTeamUser -> String
(Int -> BindingNewTeamUser -> ShowS)
-> (BindingNewTeamUser -> String)
-> ([BindingNewTeamUser] -> ShowS)
-> Show BindingNewTeamUser
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> BindingNewTeamUser -> ShowS
showsPrec :: Int -> BindingNewTeamUser -> ShowS
$cshow :: BindingNewTeamUser -> String
show :: BindingNewTeamUser -> String
$cshowList :: [BindingNewTeamUser] -> ShowS
showList :: [BindingNewTeamUser] -> ShowS
Show, (forall x. BindingNewTeamUser -> Rep BindingNewTeamUser x)
-> (forall x. Rep BindingNewTeamUser x -> BindingNewTeamUser)
-> Generic BindingNewTeamUser
forall x. Rep BindingNewTeamUser x -> BindingNewTeamUser
forall x. BindingNewTeamUser -> Rep BindingNewTeamUser x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. BindingNewTeamUser -> Rep BindingNewTeamUser x
from :: forall x. BindingNewTeamUser -> Rep BindingNewTeamUser x
$cto :: forall x. Rep BindingNewTeamUser x -> BindingNewTeamUser
to :: forall x. Rep BindingNewTeamUser x -> BindingNewTeamUser
Generic)
  deriving (Gen BindingNewTeamUser
Gen BindingNewTeamUser
-> (BindingNewTeamUser -> [BindingNewTeamUser])
-> Arbitrary BindingNewTeamUser
BindingNewTeamUser -> [BindingNewTeamUser]
forall a. Gen a -> (a -> [a]) -> Arbitrary a
$carbitrary :: Gen BindingNewTeamUser
arbitrary :: Gen BindingNewTeamUser
$cshrink :: BindingNewTeamUser -> [BindingNewTeamUser]
shrink :: BindingNewTeamUser -> [BindingNewTeamUser]
Arbitrary) via (GenericUniform BindingNewTeamUser)
  deriving ([BindingNewTeamUser] -> Value
[BindingNewTeamUser] -> Encoding
BindingNewTeamUser -> Value
BindingNewTeamUser -> Encoding
(BindingNewTeamUser -> Value)
-> (BindingNewTeamUser -> Encoding)
-> ([BindingNewTeamUser] -> Value)
-> ([BindingNewTeamUser] -> Encoding)
-> ToJSON BindingNewTeamUser
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: BindingNewTeamUser -> Value
toJSON :: BindingNewTeamUser -> Value
$ctoEncoding :: BindingNewTeamUser -> Encoding
toEncoding :: BindingNewTeamUser -> Encoding
$ctoJSONList :: [BindingNewTeamUser] -> Value
toJSONList :: [BindingNewTeamUser] -> Value
$ctoEncodingList :: [BindingNewTeamUser] -> Encoding
toEncodingList :: [BindingNewTeamUser] -> Encoding
ToJSON, Value -> Parser [BindingNewTeamUser]
Value -> Parser BindingNewTeamUser
(Value -> Parser BindingNewTeamUser)
-> (Value -> Parser [BindingNewTeamUser])
-> FromJSON BindingNewTeamUser
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser BindingNewTeamUser
parseJSON :: Value -> Parser BindingNewTeamUser
$cparseJSONList :: Value -> Parser [BindingNewTeamUser]
parseJSONList :: Value -> Parser [BindingNewTeamUser]
FromJSON, Typeable BindingNewTeamUser
Typeable BindingNewTeamUser =>
(Proxy BindingNewTeamUser
 -> Declare (Definitions Schema) NamedSchema)
-> ToSchema BindingNewTeamUser
Proxy BindingNewTeamUser
-> Declare (Definitions Schema) NamedSchema
forall a.
Typeable a =>
(Proxy a -> Declare (Definitions Schema) NamedSchema) -> ToSchema a
$cdeclareNamedSchema :: Proxy BindingNewTeamUser
-> Declare (Definitions Schema) NamedSchema
declareNamedSchema :: Proxy BindingNewTeamUser
-> Declare (Definitions Schema) NamedSchema
S.ToSchema) via (Schema BindingNewTeamUser)

instance ToSchema BindingNewTeamUser where
  schema :: SchemaP
  NamedSwaggerDoc Value Value BindingNewTeamUser BindingNewTeamUser
schema =
    Text
-> SchemaP
     SwaggerDoc Object [Pair] BindingNewTeamUser BindingNewTeamUser
-> SchemaP
     NamedSwaggerDoc Value Value BindingNewTeamUser BindingNewTeamUser
forall doc doc' a b.
HasObject doc doc' =>
Text
-> SchemaP doc Object [Pair] a b -> SchemaP doc' Value Value a b
object Text
"BindingNewTeamUser" (SchemaP
   SwaggerDoc Object [Pair] BindingNewTeamUser BindingNewTeamUser
 -> SchemaP
      NamedSwaggerDoc Value Value BindingNewTeamUser BindingNewTeamUser)
-> SchemaP
     SwaggerDoc Object [Pair] BindingNewTeamUser BindingNewTeamUser
-> SchemaP
     NamedSwaggerDoc Value Value BindingNewTeamUser BindingNewTeamUser
forall a b. (a -> b) -> a -> b
$
      NewTeam -> Maybe Alpha -> BindingNewTeamUser
BindingNewTeamUser
        (NewTeam -> Maybe Alpha -> BindingNewTeamUser)
-> SchemaP SwaggerDoc Object [Pair] BindingNewTeamUser NewTeam
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     BindingNewTeamUser
     (Maybe Alpha -> BindingNewTeamUser)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BindingNewTeamUser -> NewTeam
bnuTeam
          (BindingNewTeamUser -> NewTeam)
-> SchemaP SwaggerDoc Object [Pair] NewTeam NewTeam
-> SchemaP SwaggerDoc Object [Pair] BindingNewTeamUser NewTeam
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= SchemaP SwaggerDoc Object [Pair] NewTeam NewTeam
newTeamObjectSchema
        SchemaP
  SwaggerDoc
  Object
  [Pair]
  BindingNewTeamUser
  (Maybe Alpha -> BindingNewTeamUser)
-> SchemaP
     SwaggerDoc Object [Pair] BindingNewTeamUser (Maybe Alpha)
-> SchemaP
     SwaggerDoc Object [Pair] BindingNewTeamUser BindingNewTeamUser
forall a b.
SchemaP SwaggerDoc Object [Pair] BindingNewTeamUser (a -> b)
-> SchemaP SwaggerDoc Object [Pair] BindingNewTeamUser a
-> SchemaP SwaggerDoc Object [Pair] BindingNewTeamUser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> BindingNewTeamUser -> Maybe Alpha
bnuCurrency
          (BindingNewTeamUser -> Maybe Alpha)
-> SchemaP SwaggerDoc Object [Pair] (Maybe Alpha) (Maybe Alpha)
-> SchemaP
     SwaggerDoc Object [Pair] BindingNewTeamUser (Maybe Alpha)
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= SchemaP SwaggerDoc Object [Pair] Alpha (Maybe Alpha)
-> SchemaP SwaggerDoc Object [Pair] (Maybe Alpha) (Maybe Alpha)
forall w d v a b.
Monoid w =>
SchemaP d v w a b -> SchemaP d v w (Maybe a) b
maybe_ (Text
-> SchemaP NamedSwaggerDoc Value Value Alpha Alpha
-> SchemaP SwaggerDoc Object [Pair] Alpha (Maybe Alpha)
forall doc doc' a b.
(HasOpt doc, HasField doc' doc) =>
Text
-> SchemaP doc' Value Value a b
-> SchemaP doc Object [Pair] a (Maybe b)
optField Text
"currency" SchemaP NamedSwaggerDoc Value Value Alpha Alpha
forall a.
(ToSchema a, ToJSON a, FromJSON a) =>
ValueSchema NamedSwaggerDoc a
genericToSchema)

--------------------------------------------------------------------------------
-- SCIM User Info

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

instance ToSchema ScimUserInfo where
  schema :: ValueSchema NamedSwaggerDoc ScimUserInfo
schema =
    Text
-> SchemaP SwaggerDoc Object [Pair] ScimUserInfo ScimUserInfo
-> ValueSchema NamedSwaggerDoc ScimUserInfo
forall doc doc' a b.
HasObject doc doc' =>
Text
-> SchemaP doc Object [Pair] a b -> SchemaP doc' Value Value a b
object Text
"ScimUserInfo" (SchemaP SwaggerDoc Object [Pair] ScimUserInfo ScimUserInfo
 -> ValueSchema NamedSwaggerDoc ScimUserInfo)
-> SchemaP SwaggerDoc Object [Pair] ScimUserInfo ScimUserInfo
-> ValueSchema NamedSwaggerDoc ScimUserInfo
forall a b. (a -> b) -> a -> b
$
      UserId -> Maybe UTCTimeMillis -> ScimUserInfo
ScimUserInfo
        (UserId -> Maybe UTCTimeMillis -> ScimUserInfo)
-> SchemaP SwaggerDoc Object [Pair] ScimUserInfo UserId
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     ScimUserInfo
     (Maybe UTCTimeMillis -> ScimUserInfo)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ScimUserInfo -> UserId
suiUserId
          (ScimUserInfo -> UserId)
-> SchemaP SwaggerDoc Object [Pair] UserId UserId
-> SchemaP SwaggerDoc Object [Pair] ScimUserInfo UserId
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= Text
-> ValueSchema NamedSwaggerDoc 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
"id" ValueSchema NamedSwaggerDoc UserId
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema
        SchemaP
  SwaggerDoc
  Object
  [Pair]
  ScimUserInfo
  (Maybe UTCTimeMillis -> ScimUserInfo)
-> SchemaP
     SwaggerDoc Object [Pair] ScimUserInfo (Maybe UTCTimeMillis)
-> SchemaP SwaggerDoc Object [Pair] ScimUserInfo ScimUserInfo
forall a b.
SchemaP SwaggerDoc Object [Pair] ScimUserInfo (a -> b)
-> SchemaP SwaggerDoc Object [Pair] ScimUserInfo a
-> SchemaP SwaggerDoc Object [Pair] ScimUserInfo b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ScimUserInfo -> Maybe UTCTimeMillis
suiCreatedOn
          (ScimUserInfo -> Maybe UTCTimeMillis)
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     (Maybe UTCTimeMillis)
     (Maybe UTCTimeMillis)
-> SchemaP
     SwaggerDoc Object [Pair] ScimUserInfo (Maybe UTCTimeMillis)
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= SchemaP
  SwaggerDoc Object [Pair] UTCTimeMillis (Maybe UTCTimeMillis)
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     (Maybe UTCTimeMillis)
     (Maybe UTCTimeMillis)
forall w d v a b.
Monoid w =>
SchemaP d v w a b -> SchemaP d v w (Maybe a) b
maybe_ (Text
-> SchemaP NamedSwaggerDoc Value Value UTCTimeMillis UTCTimeMillis
-> SchemaP
     SwaggerDoc Object [Pair] UTCTimeMillis (Maybe UTCTimeMillis)
forall doc doc' a b.
(HasOpt doc, HasField doc' doc) =>
Text
-> SchemaP doc' Value Value a b
-> SchemaP doc Object [Pair] a (Maybe b)
optField Text
"created_on" SchemaP NamedSwaggerDoc Value Value UTCTimeMillis UTCTimeMillis
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema)

-------------------------------------------------------------------------------
-- UserSet

-- | Set of user ids, can be used for different purposes (e.g., used on the internal
-- APIs for listing user's clients)
newtype UserSet = UserSet
  { UserSet -> Set UserId
usUsrs :: Set UserId
  }
  deriving stock (UserSet -> UserSet -> Bool
(UserSet -> UserSet -> Bool)
-> (UserSet -> UserSet -> Bool) -> Eq UserSet
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: UserSet -> UserSet -> Bool
== :: UserSet -> UserSet -> Bool
$c/= :: UserSet -> UserSet -> Bool
/= :: UserSet -> UserSet -> Bool
Eq, Int -> UserSet -> ShowS
[UserSet] -> ShowS
UserSet -> String
(Int -> UserSet -> ShowS)
-> (UserSet -> String) -> ([UserSet] -> ShowS) -> Show UserSet
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> UserSet -> ShowS
showsPrec :: Int -> UserSet -> ShowS
$cshow :: UserSet -> String
show :: UserSet -> String
$cshowList :: [UserSet] -> ShowS
showList :: [UserSet] -> ShowS
Show, (forall x. UserSet -> Rep UserSet x)
-> (forall x. Rep UserSet x -> UserSet) -> Generic UserSet
forall x. Rep UserSet x -> UserSet
forall x. UserSet -> Rep UserSet x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. UserSet -> Rep UserSet x
from :: forall x. UserSet -> Rep UserSet x
$cto :: forall x. Rep UserSet x -> UserSet
to :: forall x. Rep UserSet x -> UserSet
Generic)
  deriving newtype (Gen UserSet
Gen UserSet -> (UserSet -> [UserSet]) -> Arbitrary UserSet
UserSet -> [UserSet]
forall a. Gen a -> (a -> [a]) -> Arbitrary a
$carbitrary :: Gen UserSet
arbitrary :: Gen UserSet
$cshrink :: UserSet -> [UserSet]
shrink :: UserSet -> [UserSet]
Arbitrary)
  deriving ([UserSet] -> Value
[UserSet] -> Encoding
UserSet -> Value
UserSet -> Encoding
(UserSet -> Value)
-> (UserSet -> Encoding)
-> ([UserSet] -> Value)
-> ([UserSet] -> Encoding)
-> ToJSON UserSet
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: UserSet -> Value
toJSON :: UserSet -> Value
$ctoEncoding :: UserSet -> Encoding
toEncoding :: UserSet -> Encoding
$ctoJSONList :: [UserSet] -> Value
toJSONList :: [UserSet] -> Value
$ctoEncodingList :: [UserSet] -> Encoding
toEncodingList :: [UserSet] -> Encoding
ToJSON, Value -> Parser [UserSet]
Value -> Parser UserSet
(Value -> Parser UserSet)
-> (Value -> Parser [UserSet]) -> FromJSON UserSet
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser UserSet
parseJSON :: Value -> Parser UserSet
$cparseJSONList :: Value -> Parser [UserSet]
parseJSONList :: Value -> Parser [UserSet]
FromJSON, Typeable UserSet
Typeable UserSet =>
(Proxy UserSet -> Declare (Definitions Schema) NamedSchema)
-> ToSchema UserSet
Proxy UserSet -> Declare (Definitions Schema) NamedSchema
forall a.
Typeable a =>
(Proxy a -> Declare (Definitions Schema) NamedSchema) -> ToSchema a
$cdeclareNamedSchema :: Proxy UserSet -> Declare (Definitions Schema) NamedSchema
declareNamedSchema :: Proxy UserSet -> Declare (Definitions Schema) NamedSchema
S.ToSchema) via (Schema UserSet)

instance ToSchema UserSet where
  schema :: ValueSchema NamedSwaggerDoc UserSet
schema =
    Text
-> SchemaP SwaggerDoc Object [Pair] UserSet UserSet
-> ValueSchema NamedSwaggerDoc UserSet
forall doc doc' a b.
HasObject doc doc' =>
Text
-> SchemaP doc Object [Pair] a b -> SchemaP doc' Value Value a b
object Text
"UserSet" (SchemaP SwaggerDoc Object [Pair] UserSet UserSet
 -> ValueSchema NamedSwaggerDoc UserSet)
-> SchemaP SwaggerDoc Object [Pair] UserSet UserSet
-> ValueSchema NamedSwaggerDoc UserSet
forall a b. (a -> b) -> a -> b
$
      Set UserId -> UserSet
UserSet
        (Set UserId -> UserSet)
-> SchemaP SwaggerDoc Object [Pair] UserSet (Set UserId)
-> SchemaP SwaggerDoc Object [Pair] UserSet UserSet
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> UserSet -> Set UserId
usUsrs
          (UserSet -> Set UserId)
-> SchemaP SwaggerDoc Object [Pair] (Set UserId) (Set UserId)
-> SchemaP SwaggerDoc Object [Pair] UserSet (Set UserId)
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= Text
-> SchemaP SwaggerDoc Value Value (Set UserId) (Set UserId)
-> SchemaP SwaggerDoc Object [Pair] (Set UserId) (Set UserId)
forall doc' doc a b.
HasField doc' doc =>
Text
-> SchemaP doc' Value Value a b -> SchemaP doc Object [Pair] a b
field Text
"users" (ValueSchema NamedSwaggerDoc UserId
-> SchemaP SwaggerDoc Value Value (Set UserId) (Set UserId)
forall ndoc doc a.
(HasArray ndoc doc, HasName ndoc, Ord a) =>
ValueSchema ndoc a -> ValueSchema doc (Set a)
set ValueSchema NamedSwaggerDoc UserId
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema)

--------------------------------------------------------------------------------
-- Profile Updates

data UserUpdate = UserUpdate
  { UserUpdate -> Maybe Name
uupName :: Maybe Name,
    UserUpdate -> Maybe TextStatus
uupTextStatus :: Maybe TextStatus,
    -- | DEPRECATED
    UserUpdate -> Maybe Pict
uupPict :: Maybe Pict,
    UserUpdate -> Maybe [Asset]
uupAssets :: Maybe [Asset],
    UserUpdate -> Maybe ColourId
uupAccentId :: Maybe ColourId
  }
  deriving stock (UserUpdate -> UserUpdate -> Bool
(UserUpdate -> UserUpdate -> Bool)
-> (UserUpdate -> UserUpdate -> Bool) -> Eq UserUpdate
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: UserUpdate -> UserUpdate -> Bool
== :: UserUpdate -> UserUpdate -> Bool
$c/= :: UserUpdate -> UserUpdate -> Bool
/= :: UserUpdate -> UserUpdate -> Bool
Eq, Int -> UserUpdate -> ShowS
[UserUpdate] -> ShowS
UserUpdate -> String
(Int -> UserUpdate -> ShowS)
-> (UserUpdate -> String)
-> ([UserUpdate] -> ShowS)
-> Show UserUpdate
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> UserUpdate -> ShowS
showsPrec :: Int -> UserUpdate -> ShowS
$cshow :: UserUpdate -> String
show :: UserUpdate -> String
$cshowList :: [UserUpdate] -> ShowS
showList :: [UserUpdate] -> ShowS
Show, (forall x. UserUpdate -> Rep UserUpdate x)
-> (forall x. Rep UserUpdate x -> UserUpdate) -> Generic UserUpdate
forall x. Rep UserUpdate x -> UserUpdate
forall x. UserUpdate -> Rep UserUpdate x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. UserUpdate -> Rep UserUpdate x
from :: forall x. UserUpdate -> Rep UserUpdate x
$cto :: forall x. Rep UserUpdate x -> UserUpdate
to :: forall x. Rep UserUpdate x -> UserUpdate
Generic)
  deriving ([UserUpdate] -> Value
[UserUpdate] -> Encoding
UserUpdate -> Value
UserUpdate -> Encoding
(UserUpdate -> Value)
-> (UserUpdate -> Encoding)
-> ([UserUpdate] -> Value)
-> ([UserUpdate] -> Encoding)
-> ToJSON UserUpdate
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: UserUpdate -> Value
toJSON :: UserUpdate -> Value
$ctoEncoding :: UserUpdate -> Encoding
toEncoding :: UserUpdate -> Encoding
$ctoJSONList :: [UserUpdate] -> Value
toJSONList :: [UserUpdate] -> Value
$ctoEncodingList :: [UserUpdate] -> Encoding
toEncodingList :: [UserUpdate] -> Encoding
ToJSON, Value -> Parser [UserUpdate]
Value -> Parser UserUpdate
(Value -> Parser UserUpdate)
-> (Value -> Parser [UserUpdate]) -> FromJSON UserUpdate
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser UserUpdate
parseJSON :: Value -> Parser UserUpdate
$cparseJSONList :: Value -> Parser [UserUpdate]
parseJSONList :: Value -> Parser [UserUpdate]
FromJSON, Typeable UserUpdate
Typeable UserUpdate =>
(Proxy UserUpdate -> Declare (Definitions Schema) NamedSchema)
-> ToSchema UserUpdate
Proxy UserUpdate -> Declare (Definitions Schema) NamedSchema
forall a.
Typeable a =>
(Proxy a -> Declare (Definitions Schema) NamedSchema) -> ToSchema a
$cdeclareNamedSchema :: Proxy UserUpdate -> Declare (Definitions Schema) NamedSchema
declareNamedSchema :: Proxy UserUpdate -> Declare (Definitions Schema) NamedSchema
S.ToSchema) via (Schema UserUpdate)
  deriving (Gen UserUpdate
Gen UserUpdate
-> (UserUpdate -> [UserUpdate]) -> Arbitrary UserUpdate
UserUpdate -> [UserUpdate]
forall a. Gen a -> (a -> [a]) -> Arbitrary a
$carbitrary :: Gen UserUpdate
arbitrary :: Gen UserUpdate
$cshrink :: UserUpdate -> [UserUpdate]
shrink :: UserUpdate -> [UserUpdate]
Arbitrary) via (GenericUniform UserUpdate)

instance ToSchema UserUpdate where
  schema :: ValueSchema NamedSwaggerDoc UserUpdate
schema =
    Text
-> SchemaP SwaggerDoc Object [Pair] UserUpdate UserUpdate
-> ValueSchema NamedSwaggerDoc UserUpdate
forall doc doc' a b.
HasObject doc doc' =>
Text
-> SchemaP doc Object [Pair] a b -> SchemaP doc' Value Value a b
object Text
"UserUpdate" (SchemaP SwaggerDoc Object [Pair] UserUpdate UserUpdate
 -> ValueSchema NamedSwaggerDoc UserUpdate)
-> SchemaP SwaggerDoc Object [Pair] UserUpdate UserUpdate
-> ValueSchema NamedSwaggerDoc UserUpdate
forall a b. (a -> b) -> a -> b
$
      Maybe Name
-> Maybe TextStatus
-> Maybe Pict
-> Maybe [Asset]
-> Maybe ColourId
-> UserUpdate
UserUpdate
        (Maybe Name
 -> Maybe TextStatus
 -> Maybe Pict
 -> Maybe [Asset]
 -> Maybe ColourId
 -> UserUpdate)
-> SchemaP SwaggerDoc Object [Pair] UserUpdate (Maybe Name)
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     UserUpdate
     (Maybe TextStatus
      -> Maybe Pict -> Maybe [Asset] -> Maybe ColourId -> UserUpdate)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> UserUpdate -> Maybe Name
uupName
          (UserUpdate -> Maybe Name)
-> SchemaP SwaggerDoc Object [Pair] (Maybe Name) (Maybe Name)
-> SchemaP SwaggerDoc Object [Pair] UserUpdate (Maybe Name)
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= SchemaP SwaggerDoc Object [Pair] Name (Maybe Name)
-> SchemaP SwaggerDoc Object [Pair] (Maybe Name) (Maybe Name)
forall w d v a b.
Monoid w =>
SchemaP d v w a b -> SchemaP d v w (Maybe a) b
maybe_ (Text
-> SchemaP NamedSwaggerDoc Value Value Name Name
-> SchemaP SwaggerDoc Object [Pair] Name (Maybe Name)
forall doc doc' a b.
(HasOpt doc, HasField doc' doc) =>
Text
-> SchemaP doc' Value Value a b
-> SchemaP doc Object [Pair] a (Maybe b)
optField Text
"name" SchemaP NamedSwaggerDoc Value Value Name Name
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema)
        SchemaP
  SwaggerDoc
  Object
  [Pair]
  UserUpdate
  (Maybe TextStatus
   -> Maybe Pict -> Maybe [Asset] -> Maybe ColourId -> UserUpdate)
-> SchemaP SwaggerDoc Object [Pair] UserUpdate (Maybe TextStatus)
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     UserUpdate
     (Maybe Pict -> Maybe [Asset] -> Maybe ColourId -> UserUpdate)
forall a b.
SchemaP SwaggerDoc Object [Pair] UserUpdate (a -> b)
-> SchemaP SwaggerDoc Object [Pair] UserUpdate a
-> SchemaP SwaggerDoc Object [Pair] UserUpdate b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> UserUpdate -> Maybe TextStatus
uupTextStatus
          (UserUpdate -> Maybe TextStatus)
-> SchemaP
     SwaggerDoc Object [Pair] (Maybe TextStatus) (Maybe TextStatus)
-> SchemaP SwaggerDoc Object [Pair] UserUpdate (Maybe TextStatus)
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= SchemaP SwaggerDoc Object [Pair] TextStatus (Maybe TextStatus)
-> SchemaP
     SwaggerDoc Object [Pair] (Maybe TextStatus) (Maybe TextStatus)
forall w d v a b.
Monoid w =>
SchemaP d v w a b -> SchemaP d v w (Maybe a) b
maybe_ (Text
-> SchemaP NamedSwaggerDoc Value Value TextStatus TextStatus
-> SchemaP SwaggerDoc Object [Pair] TextStatus (Maybe TextStatus)
forall doc doc' a b.
(HasOpt doc, HasField doc' doc) =>
Text
-> SchemaP doc' Value Value a b
-> SchemaP doc Object [Pair] a (Maybe b)
optField Text
"text_status" SchemaP NamedSwaggerDoc Value Value TextStatus TextStatus
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema)
        SchemaP
  SwaggerDoc
  Object
  [Pair]
  UserUpdate
  (Maybe Pict -> Maybe [Asset] -> Maybe ColourId -> UserUpdate)
-> SchemaP SwaggerDoc Object [Pair] UserUpdate (Maybe Pict)
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     UserUpdate
     (Maybe [Asset] -> Maybe ColourId -> UserUpdate)
forall a b.
SchemaP SwaggerDoc Object [Pair] UserUpdate (a -> b)
-> SchemaP SwaggerDoc Object [Pair] UserUpdate a
-> SchemaP SwaggerDoc Object [Pair] UserUpdate b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> UserUpdate -> Maybe Pict
uupPict
          (UserUpdate -> Maybe Pict)
-> SchemaP SwaggerDoc Object [Pair] (Maybe Pict) (Maybe Pict)
-> SchemaP SwaggerDoc Object [Pair] UserUpdate (Maybe Pict)
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= SchemaP SwaggerDoc Object [Pair] Pict (Maybe Pict)
-> SchemaP SwaggerDoc Object [Pair] (Maybe Pict) (Maybe Pict)
forall w d v a b.
Monoid w =>
SchemaP d v w a b -> SchemaP d v w (Maybe a) b
maybe_ (Text
-> SchemaP NamedSwaggerDoc Value Value Pict Pict
-> SchemaP SwaggerDoc Object [Pair] Pict (Maybe Pict)
forall doc doc' a b.
(HasOpt doc, HasField doc' doc) =>
Text
-> SchemaP doc' Value Value a b
-> SchemaP doc Object [Pair] a (Maybe b)
optField Text
"picture" SchemaP NamedSwaggerDoc Value Value Pict Pict
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema)
        SchemaP
  SwaggerDoc
  Object
  [Pair]
  UserUpdate
  (Maybe [Asset] -> Maybe ColourId -> UserUpdate)
-> SchemaP SwaggerDoc Object [Pair] UserUpdate (Maybe [Asset])
-> SchemaP
     SwaggerDoc Object [Pair] UserUpdate (Maybe ColourId -> UserUpdate)
forall a b.
SchemaP SwaggerDoc Object [Pair] UserUpdate (a -> b)
-> SchemaP SwaggerDoc Object [Pair] UserUpdate a
-> SchemaP SwaggerDoc Object [Pair] UserUpdate b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> UserUpdate -> Maybe [Asset]
uupAssets
          (UserUpdate -> Maybe [Asset])
-> SchemaP SwaggerDoc Object [Pair] (Maybe [Asset]) (Maybe [Asset])
-> SchemaP SwaggerDoc Object [Pair] UserUpdate (Maybe [Asset])
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= SchemaP SwaggerDoc Object [Pair] [Asset] (Maybe [Asset])
-> SchemaP SwaggerDoc Object [Pair] (Maybe [Asset]) (Maybe [Asset])
forall w d v a b.
Monoid w =>
SchemaP d v w a b -> SchemaP d v w (Maybe a) b
maybe_ (Text
-> SchemaP SwaggerDoc Value Value [Asset] [Asset]
-> SchemaP SwaggerDoc Object [Pair] [Asset] (Maybe [Asset])
forall doc doc' a b.
(HasOpt doc, HasField doc' doc) =>
Text
-> SchemaP doc' Value Value a b
-> SchemaP doc Object [Pair] a (Maybe b)
optField Text
"assets" (ValueSchema NamedSwaggerDoc Asset
-> SchemaP SwaggerDoc Value Value [Asset] [Asset]
forall ndoc doc a.
(HasArray ndoc doc, HasName ndoc) =>
ValueSchema ndoc a -> ValueSchema doc [a]
array ValueSchema NamedSwaggerDoc Asset
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema))
        SchemaP
  SwaggerDoc Object [Pair] UserUpdate (Maybe ColourId -> UserUpdate)
-> SchemaP SwaggerDoc Object [Pair] UserUpdate (Maybe ColourId)
-> SchemaP SwaggerDoc Object [Pair] UserUpdate UserUpdate
forall a b.
SchemaP SwaggerDoc Object [Pair] UserUpdate (a -> b)
-> SchemaP SwaggerDoc Object [Pair] UserUpdate a
-> SchemaP SwaggerDoc Object [Pair] UserUpdate b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> UserUpdate -> Maybe ColourId
uupAccentId
          (UserUpdate -> Maybe ColourId)
-> SchemaP
     SwaggerDoc Object [Pair] (Maybe ColourId) (Maybe ColourId)
-> SchemaP SwaggerDoc Object [Pair] UserUpdate (Maybe ColourId)
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= SchemaP SwaggerDoc Object [Pair] ColourId (Maybe ColourId)
-> SchemaP
     SwaggerDoc Object [Pair] (Maybe ColourId) (Maybe ColourId)
forall w d v a b.
Monoid w =>
SchemaP d v w a b -> SchemaP d v w (Maybe a) b
maybe_ (Text
-> SchemaP NamedSwaggerDoc Value Value ColourId ColourId
-> SchemaP SwaggerDoc Object [Pair] ColourId (Maybe ColourId)
forall doc doc' a b.
(HasOpt doc, HasField doc' doc) =>
Text
-> SchemaP doc' Value Value a b
-> SchemaP doc Object [Pair] a (Maybe b)
optField Text
"accent_id" SchemaP NamedSwaggerDoc Value Value ColourId ColourId
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema)

data UpdateProfileError
  = DisplayNameManagedByScim
  | ProfileNotFound
  deriving ((forall x. UpdateProfileError -> Rep UpdateProfileError x)
-> (forall x. Rep UpdateProfileError x -> UpdateProfileError)
-> Generic UpdateProfileError
forall x. Rep UpdateProfileError x -> UpdateProfileError
forall x. UpdateProfileError -> Rep UpdateProfileError x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. UpdateProfileError -> Rep UpdateProfileError x
from :: forall x. UpdateProfileError -> Rep UpdateProfileError x
$cto :: forall x. Rep UpdateProfileError x -> UpdateProfileError
to :: forall x. Rep UpdateProfileError x -> UpdateProfileError
Generic)
  deriving (AsUnion PutSelfErrorResponses) via GenericAsUnion PutSelfErrorResponses UpdateProfileError

instance GSOP.Generic UpdateProfileError

type PutSelfErrorResponses = '[ErrorResponse 'E.NameManagedByScim, ErrorResponse 'E.UserNotFound]

type PutSelfResponses = PutSelfErrorResponses .++ '[RespondEmpty 200 "User updated"]

instance (res ~ PutSelfResponses) => AsUnion res (Maybe UpdateProfileError) where
  toUnion :: Maybe UpdateProfileError -> Union (ResponseTypes res)
toUnion = (UpdateProfileError -> Union '[DynError, DynError])
-> Maybe UpdateProfileError
-> Union ('[DynError, DynError] .++ '[()])
forall (as :: [*]) a.
(InjectAfter as '[()], InjectBefore as '[()]) =>
(a -> Union as) -> Maybe a -> Union (as .++ '[()])
maybeToUnion (forall (as :: [*]) r. AsUnion as r => r -> Union (ResponseTypes as)
toUnion @PutSelfErrorResponses)
  fromUnion :: Union (ResponseTypes res) -> Maybe UpdateProfileError
fromUnion = (Union '[DynError, DynError] -> UpdateProfileError)
-> Union ('[DynError, DynError] .++ '[()])
-> Maybe UpdateProfileError
forall (as :: [*]) a.
EitherFromUnion as '[()] =>
(Union as -> a) -> Union (as .++ '[()]) -> Maybe a
maybeFromUnion (forall (as :: [*]) r. AsUnion as r => Union (ResponseTypes as) -> r
fromUnion @PutSelfErrorResponses)

-- | The payload for setting or changing a password.
data PasswordChange = PasswordChange
  { PasswordChange -> Maybe PlainTextPassword6
oldPassword :: Maybe PlainTextPassword6,
    PasswordChange -> PlainTextPassword8
newPassword :: PlainTextPassword8
  }
  deriving stock (PasswordChange -> PasswordChange -> Bool
(PasswordChange -> PasswordChange -> Bool)
-> (PasswordChange -> PasswordChange -> Bool) -> Eq PasswordChange
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PasswordChange -> PasswordChange -> Bool
== :: PasswordChange -> PasswordChange -> Bool
$c/= :: PasswordChange -> PasswordChange -> Bool
/= :: PasswordChange -> PasswordChange -> Bool
Eq, Int -> PasswordChange -> ShowS
[PasswordChange] -> ShowS
PasswordChange -> String
(Int -> PasswordChange -> ShowS)
-> (PasswordChange -> String)
-> ([PasswordChange] -> ShowS)
-> Show PasswordChange
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PasswordChange -> ShowS
showsPrec :: Int -> PasswordChange -> ShowS
$cshow :: PasswordChange -> String
show :: PasswordChange -> String
$cshowList :: [PasswordChange] -> ShowS
showList :: [PasswordChange] -> ShowS
Show, (forall x. PasswordChange -> Rep PasswordChange x)
-> (forall x. Rep PasswordChange x -> PasswordChange)
-> Generic PasswordChange
forall x. Rep PasswordChange x -> PasswordChange
forall x. PasswordChange -> Rep PasswordChange x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. PasswordChange -> Rep PasswordChange x
from :: forall x. PasswordChange -> Rep PasswordChange x
$cto :: forall x. Rep PasswordChange x -> PasswordChange
to :: forall x. Rep PasswordChange x -> PasswordChange
Generic)
  deriving (Gen PasswordChange
Gen PasswordChange
-> (PasswordChange -> [PasswordChange]) -> Arbitrary PasswordChange
PasswordChange -> [PasswordChange]
forall a. Gen a -> (a -> [a]) -> Arbitrary a
$carbitrary :: Gen PasswordChange
arbitrary :: Gen PasswordChange
$cshrink :: PasswordChange -> [PasswordChange]
shrink :: PasswordChange -> [PasswordChange]
Arbitrary) via (GenericUniform PasswordChange)
  deriving ([PasswordChange] -> Value
[PasswordChange] -> Encoding
PasswordChange -> Value
PasswordChange -> Encoding
(PasswordChange -> Value)
-> (PasswordChange -> Encoding)
-> ([PasswordChange] -> Value)
-> ([PasswordChange] -> Encoding)
-> ToJSON PasswordChange
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: PasswordChange -> Value
toJSON :: PasswordChange -> Value
$ctoEncoding :: PasswordChange -> Encoding
toEncoding :: PasswordChange -> Encoding
$ctoJSONList :: [PasswordChange] -> Value
toJSONList :: [PasswordChange] -> Value
$ctoEncodingList :: [PasswordChange] -> Encoding
toEncodingList :: [PasswordChange] -> Encoding
ToJSON, Value -> Parser [PasswordChange]
Value -> Parser PasswordChange
(Value -> Parser PasswordChange)
-> (Value -> Parser [PasswordChange]) -> FromJSON PasswordChange
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser PasswordChange
parseJSON :: Value -> Parser PasswordChange
$cparseJSONList :: Value -> Parser [PasswordChange]
parseJSONList :: Value -> Parser [PasswordChange]
FromJSON, Typeable PasswordChange
Typeable PasswordChange =>
(Proxy PasswordChange -> Declare (Definitions Schema) NamedSchema)
-> ToSchema PasswordChange
Proxy PasswordChange -> Declare (Definitions Schema) NamedSchema
forall a.
Typeable a =>
(Proxy a -> Declare (Definitions Schema) NamedSchema) -> ToSchema a
$cdeclareNamedSchema :: Proxy PasswordChange -> Declare (Definitions Schema) NamedSchema
declareNamedSchema :: Proxy PasswordChange -> Declare (Definitions Schema) NamedSchema
S.ToSchema) via (Schema PasswordChange)

instance ToSchema PasswordChange where
  schema :: ValueSchema NamedSwaggerDoc PasswordChange
schema =
    ASetter
  (ValueSchema NamedSwaggerDoc PasswordChange)
  (ValueSchema NamedSwaggerDoc PasswordChange)
  NamedSwaggerDoc
  NamedSwaggerDoc
-> (NamedSwaggerDoc -> NamedSwaggerDoc)
-> ValueSchema NamedSwaggerDoc PasswordChange
-> ValueSchema NamedSwaggerDoc PasswordChange
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over
      ASetter
  (ValueSchema NamedSwaggerDoc PasswordChange)
  (ValueSchema NamedSwaggerDoc PasswordChange)
  NamedSwaggerDoc
  NamedSwaggerDoc
forall a a' doc doc'. HasDoc a a' doc doc' => Lens a a' doc doc'
Lens
  (ValueSchema NamedSwaggerDoc PasswordChange)
  (ValueSchema NamedSwaggerDoc PasswordChange)
  NamedSwaggerDoc
  NamedSwaggerDoc
doc
      ( (Maybe Text -> Identity (Maybe Text))
-> NamedSwaggerDoc -> Identity NamedSwaggerDoc
forall s a. HasDescription s a => Lens' s a
Lens' NamedSwaggerDoc (Maybe Text)
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
"Data to change a password. The old password is required if \
             \a password already exists."
      )
      (ValueSchema NamedSwaggerDoc PasswordChange
 -> ValueSchema NamedSwaggerDoc PasswordChange)
-> (SchemaP SwaggerDoc Object [Pair] PasswordChange PasswordChange
    -> ValueSchema NamedSwaggerDoc PasswordChange)
-> SchemaP SwaggerDoc Object [Pair] PasswordChange PasswordChange
-> ValueSchema NamedSwaggerDoc PasswordChange
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text
-> SchemaP SwaggerDoc Object [Pair] PasswordChange PasswordChange
-> ValueSchema NamedSwaggerDoc PasswordChange
forall doc doc' a b.
HasObject doc doc' =>
Text
-> SchemaP doc Object [Pair] a b -> SchemaP doc' Value Value a b
object Text
"PasswordChange"
      (SchemaP SwaggerDoc Object [Pair] PasswordChange PasswordChange
 -> ValueSchema NamedSwaggerDoc PasswordChange)
-> SchemaP SwaggerDoc Object [Pair] PasswordChange PasswordChange
-> ValueSchema NamedSwaggerDoc PasswordChange
forall a b. (a -> b) -> a -> b
$ Maybe PlainTextPassword6 -> PlainTextPassword8 -> PasswordChange
PasswordChange
        (Maybe PlainTextPassword6 -> PlainTextPassword8 -> PasswordChange)
-> SchemaP
     SwaggerDoc Object [Pair] PasswordChange (Maybe PlainTextPassword6)
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     PasswordChange
     (PlainTextPassword8 -> PasswordChange)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PasswordChange -> Maybe PlainTextPassword6
oldPassword
          (PasswordChange -> Maybe PlainTextPassword6)
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     (Maybe PlainTextPassword6)
     (Maybe PlainTextPassword6)
-> SchemaP
     SwaggerDoc Object [Pair] PasswordChange (Maybe PlainTextPassword6)
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= SchemaP
  SwaggerDoc
  Object
  [Pair]
  PlainTextPassword6
  (Maybe PlainTextPassword6)
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     (Maybe PlainTextPassword6)
     (Maybe PlainTextPassword6)
forall w d v a b.
Monoid w =>
SchemaP d v w a b -> SchemaP d v w (Maybe a) b
maybe_ (Text
-> SchemaP
     NamedSwaggerDoc Value Value PlainTextPassword6 PlainTextPassword6
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     PlainTextPassword6
     (Maybe PlainTextPassword6)
forall doc doc' a b.
(HasOpt doc, HasField doc' doc) =>
Text
-> SchemaP doc' Value Value a b
-> SchemaP doc Object [Pair] a (Maybe b)
optField Text
"old_password" SchemaP
  NamedSwaggerDoc Value Value PlainTextPassword6 PlainTextPassword6
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema)
        SchemaP
  SwaggerDoc
  Object
  [Pair]
  PasswordChange
  (PlainTextPassword8 -> PasswordChange)
-> SchemaP
     SwaggerDoc Object [Pair] PasswordChange PlainTextPassword8
-> SchemaP SwaggerDoc Object [Pair] PasswordChange PasswordChange
forall a b.
SchemaP SwaggerDoc Object [Pair] PasswordChange (a -> b)
-> SchemaP SwaggerDoc Object [Pair] PasswordChange a
-> SchemaP SwaggerDoc Object [Pair] PasswordChange b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> PasswordChange -> PlainTextPassword8
newPassword
          (PasswordChange -> PlainTextPassword8)
-> SchemaP
     SwaggerDoc Object [Pair] PlainTextPassword8 PlainTextPassword8
-> SchemaP
     SwaggerDoc Object [Pair] PasswordChange PlainTextPassword8
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= Text
-> SchemaP
     NamedSwaggerDoc Value Value PlainTextPassword8 PlainTextPassword8
-> SchemaP
     SwaggerDoc Object [Pair] PlainTextPassword8 PlainTextPassword8
forall doc' doc a b.
HasField doc' doc =>
Text
-> SchemaP doc' Value Value a b -> SchemaP doc Object [Pair] a b
field Text
"new_password" SchemaP
  NamedSwaggerDoc Value Value PlainTextPassword8 PlainTextPassword8
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema

data ChangePasswordError
  = InvalidCurrentPassword
  | ChangePasswordNoIdentity
  | ChangePasswordMustDiffer
  deriving ((forall x. ChangePasswordError -> Rep ChangePasswordError x)
-> (forall x. Rep ChangePasswordError x -> ChangePasswordError)
-> Generic ChangePasswordError
forall x. Rep ChangePasswordError x -> ChangePasswordError
forall x. ChangePasswordError -> Rep ChangePasswordError x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ChangePasswordError -> Rep ChangePasswordError x
from :: forall x. ChangePasswordError -> Rep ChangePasswordError x
$cto :: forall x. Rep ChangePasswordError x -> ChangePasswordError
to :: forall x. Rep ChangePasswordError x -> ChangePasswordError
Generic)
  deriving (AsUnion ChangePasswordErrorResponses) via GenericAsUnion ChangePasswordErrorResponses ChangePasswordError

instance GSOP.Generic ChangePasswordError

type ChangePasswordErrorResponses =
  [ ErrorResponse 'E.BadCredentials,
    ErrorResponse 'E.NoIdentity,
    ErrorResponse 'E.ChangePasswordMustDiffer
  ]

type ChangePasswordResponses =
  ChangePasswordErrorResponses .++ '[RespondEmpty 200 "Password Changed"]

instance (res ~ ChangePasswordResponses) => AsUnion res (Maybe ChangePasswordError) where
  toUnion :: Maybe ChangePasswordError -> Union (ResponseTypes res)
toUnion = (ChangePasswordError -> Union '[DynError, DynError, DynError])
-> Maybe ChangePasswordError
-> Union ('[DynError, DynError, DynError] .++ '[()])
forall (as :: [*]) a.
(InjectAfter as '[()], InjectBefore as '[()]) =>
(a -> Union as) -> Maybe a -> Union (as .++ '[()])
maybeToUnion (forall (as :: [*]) r. AsUnion as r => r -> Union (ResponseTypes as)
toUnion @ChangePasswordErrorResponses)
  fromUnion :: Union (ResponseTypes res) -> Maybe ChangePasswordError
fromUnion = (Union '[DynError, DynError, DynError] -> ChangePasswordError)
-> Union ('[DynError, DynError, DynError] .++ '[()])
-> Maybe ChangePasswordError
forall (as :: [*]) a.
EitherFromUnion as '[()] =>
(Union as -> a) -> Union (as .++ '[()]) -> Maybe a
maybeFromUnion (forall (as :: [*]) r. AsUnion as r => Union (ResponseTypes as) -> r
fromUnion @ChangePasswordErrorResponses)

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

instance ToSchema LocaleUpdate where
  schema :: ValueSchema NamedSwaggerDoc LocaleUpdate
schema =
    Text
-> SchemaP SwaggerDoc Object [Pair] LocaleUpdate LocaleUpdate
-> ValueSchema NamedSwaggerDoc LocaleUpdate
forall doc doc' a b.
HasObject doc doc' =>
Text
-> SchemaP doc Object [Pair] a b -> SchemaP doc' Value Value a b
object Text
"LocaleUpdate" (SchemaP SwaggerDoc Object [Pair] LocaleUpdate LocaleUpdate
 -> ValueSchema NamedSwaggerDoc LocaleUpdate)
-> SchemaP SwaggerDoc Object [Pair] LocaleUpdate LocaleUpdate
-> ValueSchema NamedSwaggerDoc LocaleUpdate
forall a b. (a -> b) -> a -> b
$
      Locale -> LocaleUpdate
LocaleUpdate
        (Locale -> LocaleUpdate)
-> SchemaP SwaggerDoc Object [Pair] LocaleUpdate Locale
-> SchemaP SwaggerDoc Object [Pair] LocaleUpdate LocaleUpdate
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> LocaleUpdate -> Locale
luLocale
          (LocaleUpdate -> Locale)
-> SchemaP SwaggerDoc Object [Pair] Locale Locale
-> SchemaP SwaggerDoc Object [Pair] LocaleUpdate Locale
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= Text
-> SchemaP NamedSwaggerDoc Value Value Locale Locale
-> SchemaP SwaggerDoc Object [Pair] Locale Locale
forall doc' doc a b.
HasField doc' doc =>
Text
-> SchemaP doc' Value Value a b -> SchemaP doc Object [Pair] a b
field Text
"locale" SchemaP NamedSwaggerDoc Value Value Locale Locale
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema

newtype EmailUpdate = EmailUpdate {EmailUpdate -> EmailAddress
euEmail :: EmailAddress}
  deriving stock (EmailUpdate -> EmailUpdate -> Bool
(EmailUpdate -> EmailUpdate -> Bool)
-> (EmailUpdate -> EmailUpdate -> Bool) -> Eq EmailUpdate
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: EmailUpdate -> EmailUpdate -> Bool
== :: EmailUpdate -> EmailUpdate -> Bool
$c/= :: EmailUpdate -> EmailUpdate -> Bool
/= :: EmailUpdate -> EmailUpdate -> Bool
Eq, Int -> EmailUpdate -> ShowS
[EmailUpdate] -> ShowS
EmailUpdate -> String
(Int -> EmailUpdate -> ShowS)
-> (EmailUpdate -> String)
-> ([EmailUpdate] -> ShowS)
-> Show EmailUpdate
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> EmailUpdate -> ShowS
showsPrec :: Int -> EmailUpdate -> ShowS
$cshow :: EmailUpdate -> String
show :: EmailUpdate -> String
$cshowList :: [EmailUpdate] -> ShowS
showList :: [EmailUpdate] -> ShowS
Show, (forall x. EmailUpdate -> Rep EmailUpdate x)
-> (forall x. Rep EmailUpdate x -> EmailUpdate)
-> Generic EmailUpdate
forall x. Rep EmailUpdate x -> EmailUpdate
forall x. EmailUpdate -> Rep EmailUpdate x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. EmailUpdate -> Rep EmailUpdate x
from :: forall x. EmailUpdate -> Rep EmailUpdate x
$cto :: forall x. Rep EmailUpdate x -> EmailUpdate
to :: forall x. Rep EmailUpdate x -> EmailUpdate
Generic)
  deriving newtype (Gen EmailUpdate
Gen EmailUpdate
-> (EmailUpdate -> [EmailUpdate]) -> Arbitrary EmailUpdate
EmailUpdate -> [EmailUpdate]
forall a. Gen a -> (a -> [a]) -> Arbitrary a
$carbitrary :: Gen EmailUpdate
arbitrary :: Gen EmailUpdate
$cshrink :: EmailUpdate -> [EmailUpdate]
shrink :: EmailUpdate -> [EmailUpdate]
Arbitrary)
  deriving (Typeable EmailUpdate
Typeable EmailUpdate =>
(Proxy EmailUpdate -> Declare (Definitions Schema) NamedSchema)
-> ToSchema EmailUpdate
Proxy EmailUpdate -> Declare (Definitions Schema) NamedSchema
forall a.
Typeable a =>
(Proxy a -> Declare (Definitions Schema) NamedSchema) -> ToSchema a
$cdeclareNamedSchema :: Proxy EmailUpdate -> Declare (Definitions Schema) NamedSchema
declareNamedSchema :: Proxy EmailUpdate -> Declare (Definitions Schema) NamedSchema
S.ToSchema) via (Schema EmailUpdate)

instance ToSchema EmailUpdate where
  schema :: ValueSchema NamedSwaggerDoc EmailUpdate
schema =
    Text
-> SchemaP SwaggerDoc Object [Pair] EmailUpdate EmailUpdate
-> ValueSchema NamedSwaggerDoc EmailUpdate
forall doc doc' a b.
HasObject doc doc' =>
Text
-> SchemaP doc Object [Pair] a b -> SchemaP doc' Value Value a b
object Text
"EmailUpdate" (SchemaP SwaggerDoc Object [Pair] EmailUpdate EmailUpdate
 -> ValueSchema NamedSwaggerDoc EmailUpdate)
-> SchemaP SwaggerDoc Object [Pair] EmailUpdate EmailUpdate
-> ValueSchema NamedSwaggerDoc EmailUpdate
forall a b. (a -> b) -> a -> b
$
      EmailAddress -> EmailUpdate
EmailUpdate
        (EmailAddress -> EmailUpdate)
-> SchemaP SwaggerDoc Object [Pair] EmailUpdate EmailAddress
-> SchemaP SwaggerDoc Object [Pair] EmailUpdate EmailUpdate
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> EmailUpdate -> EmailAddress
euEmail
          (EmailUpdate -> EmailAddress)
-> SchemaP SwaggerDoc Object [Pair] EmailAddress EmailAddress
-> SchemaP SwaggerDoc Object [Pair] EmailUpdate EmailAddress
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= Text
-> SchemaP NamedSwaggerDoc Value Value EmailAddress EmailAddress
-> SchemaP SwaggerDoc Object [Pair] EmailAddress EmailAddress
forall doc' doc a b.
HasField doc' doc =>
Text
-> SchemaP doc' Value Value a b -> SchemaP doc Object [Pair] a b
field Text
"email" SchemaP NamedSwaggerDoc Value Value EmailAddress EmailAddress
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema

instance ToJSON EmailUpdate where
  toJSON :: EmailUpdate -> Value
toJSON EmailUpdate
e = [Pair] -> Value
A.object [Key
"email" Key -> EmailAddress -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
A..= EmailUpdate -> EmailAddress
euEmail EmailUpdate
e]

instance FromJSON EmailUpdate where
  parseJSON :: Value -> Parser EmailUpdate
parseJSON = String
-> (Object -> Parser EmailUpdate) -> Value -> Parser EmailUpdate
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"email-update" ((Object -> Parser EmailUpdate) -> Value -> Parser EmailUpdate)
-> (Object -> Parser EmailUpdate) -> Value -> Parser EmailUpdate
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    EmailAddress -> EmailUpdate
EmailUpdate (EmailAddress -> EmailUpdate)
-> Parser EmailAddress -> Parser EmailUpdate
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser EmailAddress
forall a. FromJSON a => Object -> Key -> Parser a
A..: Key
"email"

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

instance ToSchema PhoneUpdate where
  schema :: ValueSchema NamedSwaggerDoc PhoneUpdate
schema =
    Text
-> SchemaP SwaggerDoc Object [Pair] PhoneUpdate PhoneUpdate
-> ValueSchema NamedSwaggerDoc PhoneUpdate
forall doc doc' a b.
HasObject doc doc' =>
Text
-> SchemaP doc Object [Pair] a b -> SchemaP doc' Value Value a b
object Text
"PhoneUpdate" (SchemaP SwaggerDoc Object [Pair] PhoneUpdate PhoneUpdate
 -> ValueSchema NamedSwaggerDoc PhoneUpdate)
-> SchemaP SwaggerDoc Object [Pair] PhoneUpdate PhoneUpdate
-> ValueSchema NamedSwaggerDoc PhoneUpdate
forall a b. (a -> b) -> a -> b
$
      Phone -> PhoneUpdate
PhoneUpdate
        (Phone -> PhoneUpdate)
-> SchemaP SwaggerDoc Object [Pair] PhoneUpdate Phone
-> SchemaP SwaggerDoc Object [Pair] PhoneUpdate PhoneUpdate
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PhoneUpdate -> Phone
puPhone
          (PhoneUpdate -> Phone)
-> SchemaP SwaggerDoc Object [Pair] Phone Phone
-> SchemaP SwaggerDoc Object [Pair] PhoneUpdate Phone
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= Text
-> SchemaP NamedSwaggerDoc Value Value Phone Phone
-> SchemaP SwaggerDoc Object [Pair] Phone Phone
forall doc' doc a b.
HasField doc' doc =>
Text
-> SchemaP doc' Value Value a b -> SchemaP doc Object [Pair] a b
field Text
"phone" SchemaP NamedSwaggerDoc Value Value Phone Phone
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema

data ChangePhoneError
  = PhoneExists
  | InvalidNewPhone
  deriving ((forall x. ChangePhoneError -> Rep ChangePhoneError x)
-> (forall x. Rep ChangePhoneError x -> ChangePhoneError)
-> Generic ChangePhoneError
forall x. Rep ChangePhoneError x -> ChangePhoneError
forall x. ChangePhoneError -> Rep ChangePhoneError x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ChangePhoneError -> Rep ChangePhoneError x
from :: forall x. ChangePhoneError -> Rep ChangePhoneError x
$cto :: forall x. Rep ChangePhoneError x -> ChangePhoneError
to :: forall x. Rep ChangePhoneError x -> ChangePhoneError
Generic)
  deriving (AsUnion ChangePhoneErrorResponses) via GenericAsUnion ChangePhoneErrorResponses ChangePhoneError

instance GSOP.Generic ChangePhoneError

type ChangePhoneErrorResponses =
  [ ErrorResponse 'UserKeyExists,
    ErrorResponse 'InvalidPhone
  ]

type ChangePhoneResponses =
  ChangePhoneErrorResponses .++ '[RespondEmpty 202 "Phone updated"]

instance (res ~ ChangePhoneResponses) => AsUnion res (Maybe ChangePhoneError) where
  toUnion :: Maybe ChangePhoneError -> Union (ResponseTypes res)
toUnion = (ChangePhoneError -> Union '[DynError, DynError])
-> Maybe ChangePhoneError
-> Union ('[DynError, DynError] .++ '[()])
forall (as :: [*]) a.
(InjectAfter as '[()], InjectBefore as '[()]) =>
(a -> Union as) -> Maybe a -> Union (as .++ '[()])
maybeToUnion (forall (as :: [*]) r. AsUnion as r => r -> Union (ResponseTypes as)
toUnion @ChangePhoneErrorResponses)
  fromUnion :: Union (ResponseTypes res) -> Maybe ChangePhoneError
fromUnion = (Union '[DynError, DynError] -> ChangePhoneError)
-> Union ('[DynError, DynError] .++ '[()])
-> Maybe ChangePhoneError
forall (as :: [*]) a.
EitherFromUnion as '[()] =>
(Union as -> a) -> Union (as .++ '[()]) -> Maybe a
maybeFromUnion (forall (as :: [*]) r. AsUnion as r => Union (ResponseTypes as) -> r
fromUnion @ChangePhoneErrorResponses)

data RemoveIdentityError
  = LastIdentity
  | NoPassword
  | NoIdentity
  deriving ((forall x. RemoveIdentityError -> Rep RemoveIdentityError x)
-> (forall x. Rep RemoveIdentityError x -> RemoveIdentityError)
-> Generic RemoveIdentityError
forall x. Rep RemoveIdentityError x -> RemoveIdentityError
forall x. RemoveIdentityError -> Rep RemoveIdentityError x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. RemoveIdentityError -> Rep RemoveIdentityError x
from :: forall x. RemoveIdentityError -> Rep RemoveIdentityError x
$cto :: forall x. Rep RemoveIdentityError x -> RemoveIdentityError
to :: forall x. Rep RemoveIdentityError x -> RemoveIdentityError
Generic)
  deriving (AsUnion RemoveIdentityErrorResponses) via GenericAsUnion RemoveIdentityErrorResponses RemoveIdentityError

instance GSOP.Generic RemoveIdentityError

type RemoveIdentityErrorResponses =
  [ ErrorResponse 'E.LastIdentity,
    ErrorResponse 'E.NoPassword,
    ErrorResponse 'E.NoIdentity
  ]

type RemoveIdentityResponses =
  RemoveIdentityErrorResponses .++ '[RespondEmpty 200 "Identity Removed"]

instance (res ~ RemoveIdentityResponses) => AsUnion res (Maybe RemoveIdentityError) where
  toUnion :: Maybe RemoveIdentityError -> Union (ResponseTypes res)
toUnion = (RemoveIdentityError -> Union '[DynError, DynError, DynError])
-> Maybe RemoveIdentityError
-> Union ('[DynError, DynError, DynError] .++ '[()])
forall (as :: [*]) a.
(InjectAfter as '[()], InjectBefore as '[()]) =>
(a -> Union as) -> Maybe a -> Union (as .++ '[()])
maybeToUnion (forall (as :: [*]) r. AsUnion as r => r -> Union (ResponseTypes as)
toUnion @RemoveIdentityErrorResponses)
  fromUnion :: Union (ResponseTypes res) -> Maybe RemoveIdentityError
fromUnion = (Union '[DynError, DynError, DynError] -> RemoveIdentityError)
-> Union ('[DynError, DynError, DynError] .++ '[()])
-> Maybe RemoveIdentityError
forall (as :: [*]) a.
EitherFromUnion as '[()] =>
(Union as -> a) -> Union (as .++ '[()]) -> Maybe a
maybeFromUnion (forall (as :: [*]) r. AsUnion as r => Union (ResponseTypes as) -> r
fromUnion @RemoveIdentityErrorResponses)

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

instance ToSchema HandleUpdate where
  schema :: ValueSchema NamedSwaggerDoc HandleUpdate
schema =
    Text
-> SchemaP SwaggerDoc Object [Pair] HandleUpdate HandleUpdate
-> ValueSchema NamedSwaggerDoc HandleUpdate
forall doc doc' a b.
HasObject doc doc' =>
Text
-> SchemaP doc Object [Pair] a b -> SchemaP doc' Value Value a b
object Text
"HandleUpdate" (SchemaP SwaggerDoc Object [Pair] HandleUpdate HandleUpdate
 -> ValueSchema NamedSwaggerDoc HandleUpdate)
-> SchemaP SwaggerDoc Object [Pair] HandleUpdate HandleUpdate
-> ValueSchema NamedSwaggerDoc HandleUpdate
forall a b. (a -> b) -> a -> b
$
      Text -> HandleUpdate
HandleUpdate (Text -> HandleUpdate)
-> SchemaP SwaggerDoc Object [Pair] HandleUpdate Text
-> SchemaP SwaggerDoc Object [Pair] HandleUpdate HandleUpdate
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HandleUpdate -> Text
huHandle (HandleUpdate -> Text)
-> SchemaP SwaggerDoc Object [Pair] Text Text
-> SchemaP SwaggerDoc Object [Pair] HandleUpdate Text
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= Text
-> SchemaP NamedSwaggerDoc Value Value Text Text
-> SchemaP SwaggerDoc Object [Pair] Text Text
forall doc' doc a b.
HasField doc' doc =>
Text
-> SchemaP doc' Value Value a b -> SchemaP doc Object [Pair] a b
field Text
"handle" SchemaP NamedSwaggerDoc Value Value Text Text
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema

data ChangeHandleError
  = ChangeHandleNoIdentity
  | ChangeHandleExists
  | ChangeHandleInvalid
  | ChangeHandleManagedByScim
  deriving (Int -> ChangeHandleError -> ShowS
[ChangeHandleError] -> ShowS
ChangeHandleError -> String
(Int -> ChangeHandleError -> ShowS)
-> (ChangeHandleError -> String)
-> ([ChangeHandleError] -> ShowS)
-> Show ChangeHandleError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ChangeHandleError -> ShowS
showsPrec :: Int -> ChangeHandleError -> ShowS
$cshow :: ChangeHandleError -> String
show :: ChangeHandleError -> String
$cshowList :: [ChangeHandleError] -> ShowS
showList :: [ChangeHandleError] -> ShowS
Show, (forall x. ChangeHandleError -> Rep ChangeHandleError x)
-> (forall x. Rep ChangeHandleError x -> ChangeHandleError)
-> Generic ChangeHandleError
forall x. Rep ChangeHandleError x -> ChangeHandleError
forall x. ChangeHandleError -> Rep ChangeHandleError x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ChangeHandleError -> Rep ChangeHandleError x
from :: forall x. ChangeHandleError -> Rep ChangeHandleError x
$cto :: forall x. Rep ChangeHandleError x -> ChangeHandleError
to :: forall x. Rep ChangeHandleError x -> ChangeHandleError
Generic)
  deriving (AsUnion ChangeHandleErrorResponses) via GenericAsUnion ChangeHandleErrorResponses ChangeHandleError

instance GSOP.Generic ChangeHandleError

type ChangeHandleErrorResponses =
  '[ ErrorResponse 'E.NoIdentity,
     ErrorResponse 'E.HandleExists,
     ErrorResponse 'E.InvalidHandle,
     ErrorResponse 'E.HandleManagedByScim
   ]

type ChangeHandleResponses =
  ChangeHandleErrorResponses .++ '[RespondEmpty 200 "Handle Changed"]

instance (res ~ ChangeHandleResponses) => AsUnion res (Maybe ChangeHandleError) where
  toUnion :: Maybe ChangeHandleError -> Union (ResponseTypes res)
toUnion = (ChangeHandleError
 -> Union '[DynError, DynError, DynError, DynError])
-> Maybe ChangeHandleError
-> Union ('[DynError, DynError, DynError, DynError] .++ '[()])
forall (as :: [*]) a.
(InjectAfter as '[()], InjectBefore as '[()]) =>
(a -> Union as) -> Maybe a -> Union (as .++ '[()])
maybeToUnion (forall (as :: [*]) r. AsUnion as r => r -> Union (ResponseTypes as)
toUnion @ChangeHandleErrorResponses)
  fromUnion :: Union (ResponseTypes res) -> Maybe ChangeHandleError
fromUnion = (Union '[DynError, DynError, DynError, DynError]
 -> ChangeHandleError)
-> Union ('[DynError, DynError, DynError, DynError] .++ '[()])
-> Maybe ChangeHandleError
forall (as :: [*]) a.
EitherFromUnion as '[()] =>
(Union as -> a) -> Union (as .++ '[()]) -> Maybe a
maybeFromUnion (forall (as :: [*]) r. AsUnion as r => Union (ResponseTypes as) -> r
fromUnion @ChangeHandleErrorResponses)

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

instance ToSchema NameUpdate where
  schema :: ValueSchema NamedSwaggerDoc NameUpdate
schema =
    Text
-> SchemaP SwaggerDoc Object [Pair] NameUpdate NameUpdate
-> ValueSchema NamedSwaggerDoc NameUpdate
forall doc doc' a b.
HasObject doc doc' =>
Text
-> SchemaP doc Object [Pair] a b -> SchemaP doc' Value Value a b
object Text
"NameUpdate" (SchemaP SwaggerDoc Object [Pair] NameUpdate NameUpdate
 -> ValueSchema NamedSwaggerDoc NameUpdate)
-> SchemaP SwaggerDoc Object [Pair] NameUpdate NameUpdate
-> ValueSchema NamedSwaggerDoc NameUpdate
forall a b. (a -> b) -> a -> b
$
      Text -> NameUpdate
NameUpdate (Text -> NameUpdate)
-> SchemaP SwaggerDoc Object [Pair] NameUpdate Text
-> SchemaP SwaggerDoc Object [Pair] NameUpdate NameUpdate
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NameUpdate -> Text
nuHandle (NameUpdate -> Text)
-> SchemaP SwaggerDoc Object [Pair] Text Text
-> SchemaP SwaggerDoc Object [Pair] NameUpdate Text
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= Text
-> SchemaP NamedSwaggerDoc Value Value Text Text
-> SchemaP SwaggerDoc Object [Pair] Text Text
forall doc' doc a b.
HasField doc' doc =>
Text
-> SchemaP doc' Value Value a b -> SchemaP doc Object [Pair] a b
field Text
"name" SchemaP NamedSwaggerDoc Value Value Text Text
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema

data ChangeEmailResponse
  = ChangeEmailResponseIdempotent
  | ChangeEmailResponseNeedsActivation

instance
  AsUnion
    '[ Respond 202 "Update accepted and pending activation of the new email" (),
       Respond 204 "No update, current and new email address are the same" ()
     ]
    ChangeEmailResponse
  where
  toUnion :: ChangeEmailResponse
-> Union
     (ResponseTypes
        '[Respond
            202 "Update accepted and pending activation of the new email" (),
          Respond
            204 "No update, current and new email address are the same" ()])
toUnion ChangeEmailResponse
ChangeEmailResponseNeedsActivation = I () -> NS I '[(), ()]
forall {k} (a :: k -> *) (x :: k) (xs :: [k]). a x -> NS a (x : xs)
Z (() -> I ()
forall a. a -> I a
I ())
  toUnion ChangeEmailResponse
ChangeEmailResponseIdempotent = NS I '[()] -> NS I '[(), ()]
forall {k} (a :: k -> *) (xs :: [k]) (x :: k).
NS a xs -> NS a (x : xs)
S (I () -> NS I '[()]
forall {k} (a :: k -> *) (x :: k) (xs :: [k]). a x -> NS a (x : xs)
Z (() -> I ()
forall a. a -> I a
I ()))
  fromUnion :: Union
  (ResponseTypes
     '[Respond
         202 "Update accepted and pending activation of the new email" (),
       Respond
         204 "No update, current and new email address are the same" ()])
-> ChangeEmailResponse
fromUnion (Z (I ())) = ChangeEmailResponse
ChangeEmailResponseNeedsActivation
  fromUnion (S (Z (I ()))) = ChangeEmailResponse
ChangeEmailResponseIdempotent
  fromUnion (S (S NS I xs
x)) = case NS I xs
x of {}

-----------------------------------------------------------------------------
-- Account Deletion

-- | Payload for requesting account deletion.
newtype DeleteUser = DeleteUser
  { DeleteUser -> Maybe PlainTextPassword6
deleteUserPassword :: Maybe PlainTextPassword6
  }
  deriving stock (DeleteUser -> DeleteUser -> Bool
(DeleteUser -> DeleteUser -> Bool)
-> (DeleteUser -> DeleteUser -> Bool) -> Eq DeleteUser
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: DeleteUser -> DeleteUser -> Bool
== :: DeleteUser -> DeleteUser -> Bool
$c/= :: DeleteUser -> DeleteUser -> Bool
/= :: DeleteUser -> DeleteUser -> Bool
Eq, Int -> DeleteUser -> ShowS
[DeleteUser] -> ShowS
DeleteUser -> String
(Int -> DeleteUser -> ShowS)
-> (DeleteUser -> String)
-> ([DeleteUser] -> ShowS)
-> Show DeleteUser
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> DeleteUser -> ShowS
showsPrec :: Int -> DeleteUser -> ShowS
$cshow :: DeleteUser -> String
show :: DeleteUser -> String
$cshowList :: [DeleteUser] -> ShowS
showList :: [DeleteUser] -> ShowS
Show, (forall x. DeleteUser -> Rep DeleteUser x)
-> (forall x. Rep DeleteUser x -> DeleteUser) -> Generic DeleteUser
forall x. Rep DeleteUser x -> DeleteUser
forall x. DeleteUser -> Rep DeleteUser x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. DeleteUser -> Rep DeleteUser x
from :: forall x. DeleteUser -> Rep DeleteUser x
$cto :: forall x. Rep DeleteUser x -> DeleteUser
to :: forall x. Rep DeleteUser x -> DeleteUser
Generic)
  deriving newtype (Gen DeleteUser
Gen DeleteUser
-> (DeleteUser -> [DeleteUser]) -> Arbitrary DeleteUser
DeleteUser -> [DeleteUser]
forall a. Gen a -> (a -> [a]) -> Arbitrary a
$carbitrary :: Gen DeleteUser
arbitrary :: Gen DeleteUser
$cshrink :: DeleteUser -> [DeleteUser]
shrink :: DeleteUser -> [DeleteUser]
Arbitrary)
  deriving (Typeable DeleteUser
Typeable DeleteUser =>
(Proxy DeleteUser -> Declare (Definitions Schema) NamedSchema)
-> ToSchema DeleteUser
Proxy DeleteUser -> Declare (Definitions Schema) NamedSchema
forall a.
Typeable a =>
(Proxy a -> Declare (Definitions Schema) NamedSchema) -> ToSchema a
$cdeclareNamedSchema :: Proxy DeleteUser -> Declare (Definitions Schema) NamedSchema
declareNamedSchema :: Proxy DeleteUser -> Declare (Definitions Schema) NamedSchema
S.ToSchema) via (Schema DeleteUser)

instance ToSchema DeleteUser where
  schema :: ValueSchema NamedSwaggerDoc DeleteUser
schema =
    Text
-> SchemaP SwaggerDoc Object [Pair] DeleteUser DeleteUser
-> ValueSchema NamedSwaggerDoc DeleteUser
forall doc doc' a b.
HasObject doc doc' =>
Text
-> SchemaP doc Object [Pair] a b -> SchemaP doc' Value Value a b
object Text
"DeleteUser" (SchemaP SwaggerDoc Object [Pair] DeleteUser DeleteUser
 -> ValueSchema NamedSwaggerDoc DeleteUser)
-> SchemaP SwaggerDoc Object [Pair] DeleteUser DeleteUser
-> ValueSchema NamedSwaggerDoc DeleteUser
forall a b. (a -> b) -> a -> b
$
      Maybe PlainTextPassword6 -> DeleteUser
DeleteUser
        (Maybe PlainTextPassword6 -> DeleteUser)
-> SchemaP
     SwaggerDoc Object [Pair] DeleteUser (Maybe PlainTextPassword6)
-> SchemaP SwaggerDoc Object [Pair] DeleteUser DeleteUser
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> DeleteUser -> Maybe PlainTextPassword6
deleteUserPassword
          (DeleteUser -> Maybe PlainTextPassword6)
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     (Maybe PlainTextPassword6)
     (Maybe PlainTextPassword6)
-> SchemaP
     SwaggerDoc Object [Pair] DeleteUser (Maybe PlainTextPassword6)
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= SchemaP
  SwaggerDoc
  Object
  [Pair]
  PlainTextPassword6
  (Maybe PlainTextPassword6)
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     (Maybe PlainTextPassword6)
     (Maybe PlainTextPassword6)
forall w d v a b.
Monoid w =>
SchemaP d v w a b -> SchemaP d v w (Maybe a) b
maybe_ (Text
-> SchemaP
     NamedSwaggerDoc Value Value PlainTextPassword6 PlainTextPassword6
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     PlainTextPassword6
     (Maybe PlainTextPassword6)
forall doc doc' a b.
(HasOpt doc, HasField doc' doc) =>
Text
-> SchemaP doc' Value Value a b
-> SchemaP doc Object [Pair] a (Maybe b)
optField Text
"password" SchemaP
  NamedSwaggerDoc Value Value PlainTextPassword6 PlainTextPassword6
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema)

mkDeleteUser :: Maybe PlainTextPassword6 -> DeleteUser
mkDeleteUser :: Maybe PlainTextPassword6 -> DeleteUser
mkDeleteUser = Maybe PlainTextPassword6 -> DeleteUser
DeleteUser

instance ToJSON DeleteUser where
  toJSON :: DeleteUser -> Value
toJSON DeleteUser
d =
    [Pair] -> Value
A.object ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$
      Key
"password"
        Key -> Maybe PlainTextPassword6 -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
A..= DeleteUser -> Maybe PlainTextPassword6
deleteUserPassword DeleteUser
d
        # []

instance FromJSON DeleteUser where
  parseJSON :: Value -> Parser DeleteUser
parseJSON = String
-> (Object -> Parser DeleteUser) -> Value -> Parser DeleteUser
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"DeleteUser" ((Object -> Parser DeleteUser) -> Value -> Parser DeleteUser)
-> (Object -> Parser DeleteUser) -> Value -> Parser DeleteUser
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Maybe PlainTextPassword6 -> DeleteUser
DeleteUser (Maybe PlainTextPassword6 -> DeleteUser)
-> Parser (Maybe PlainTextPassword6) -> Parser DeleteUser
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser (Maybe PlainTextPassword6)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
A..:? Key
"password"

-- | Payload for verifying account deletion via a code.
data VerifyDeleteUser = VerifyDeleteUser
  { VerifyDeleteUser -> Key
verifyDeleteUserKey :: Code.Key,
    VerifyDeleteUser -> Value
verifyDeleteUserCode :: Code.Value
  }
  deriving stock (VerifyDeleteUser -> VerifyDeleteUser -> Bool
(VerifyDeleteUser -> VerifyDeleteUser -> Bool)
-> (VerifyDeleteUser -> VerifyDeleteUser -> Bool)
-> Eq VerifyDeleteUser
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: VerifyDeleteUser -> VerifyDeleteUser -> Bool
== :: VerifyDeleteUser -> VerifyDeleteUser -> Bool
$c/= :: VerifyDeleteUser -> VerifyDeleteUser -> Bool
/= :: VerifyDeleteUser -> VerifyDeleteUser -> Bool
Eq, Int -> VerifyDeleteUser -> ShowS
[VerifyDeleteUser] -> ShowS
VerifyDeleteUser -> String
(Int -> VerifyDeleteUser -> ShowS)
-> (VerifyDeleteUser -> String)
-> ([VerifyDeleteUser] -> ShowS)
-> Show VerifyDeleteUser
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> VerifyDeleteUser -> ShowS
showsPrec :: Int -> VerifyDeleteUser -> ShowS
$cshow :: VerifyDeleteUser -> String
show :: VerifyDeleteUser -> String
$cshowList :: [VerifyDeleteUser] -> ShowS
showList :: [VerifyDeleteUser] -> ShowS
Show, (forall x. VerifyDeleteUser -> Rep VerifyDeleteUser x)
-> (forall x. Rep VerifyDeleteUser x -> VerifyDeleteUser)
-> Generic VerifyDeleteUser
forall x. Rep VerifyDeleteUser x -> VerifyDeleteUser
forall x. VerifyDeleteUser -> Rep VerifyDeleteUser x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. VerifyDeleteUser -> Rep VerifyDeleteUser x
from :: forall x. VerifyDeleteUser -> Rep VerifyDeleteUser x
$cto :: forall x. Rep VerifyDeleteUser x -> VerifyDeleteUser
to :: forall x. Rep VerifyDeleteUser x -> VerifyDeleteUser
Generic)
  deriving (Gen VerifyDeleteUser
Gen VerifyDeleteUser
-> (VerifyDeleteUser -> [VerifyDeleteUser])
-> Arbitrary VerifyDeleteUser
VerifyDeleteUser -> [VerifyDeleteUser]
forall a. Gen a -> (a -> [a]) -> Arbitrary a
$carbitrary :: Gen VerifyDeleteUser
arbitrary :: Gen VerifyDeleteUser
$cshrink :: VerifyDeleteUser -> [VerifyDeleteUser]
shrink :: VerifyDeleteUser -> [VerifyDeleteUser]
Arbitrary) via (GenericUniform VerifyDeleteUser)
  deriving ([VerifyDeleteUser] -> Value
[VerifyDeleteUser] -> Encoding
VerifyDeleteUser -> Value
VerifyDeleteUser -> Encoding
(VerifyDeleteUser -> Value)
-> (VerifyDeleteUser -> Encoding)
-> ([VerifyDeleteUser] -> Value)
-> ([VerifyDeleteUser] -> Encoding)
-> ToJSON VerifyDeleteUser
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: VerifyDeleteUser -> Value
toJSON :: VerifyDeleteUser -> Value
$ctoEncoding :: VerifyDeleteUser -> Encoding
toEncoding :: VerifyDeleteUser -> Encoding
$ctoJSONList :: [VerifyDeleteUser] -> Value
toJSONList :: [VerifyDeleteUser] -> Value
$ctoEncodingList :: [VerifyDeleteUser] -> Encoding
toEncodingList :: [VerifyDeleteUser] -> Encoding
ToJSON, Value -> Parser [VerifyDeleteUser]
Value -> Parser VerifyDeleteUser
(Value -> Parser VerifyDeleteUser)
-> (Value -> Parser [VerifyDeleteUser])
-> FromJSON VerifyDeleteUser
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser VerifyDeleteUser
parseJSON :: Value -> Parser VerifyDeleteUser
$cparseJSONList :: Value -> Parser [VerifyDeleteUser]
parseJSONList :: Value -> Parser [VerifyDeleteUser]
FromJSON, Typeable VerifyDeleteUser
Typeable VerifyDeleteUser =>
(Proxy VerifyDeleteUser
 -> Declare (Definitions Schema) NamedSchema)
-> ToSchema VerifyDeleteUser
Proxy VerifyDeleteUser -> Declare (Definitions Schema) NamedSchema
forall a.
Typeable a =>
(Proxy a -> Declare (Definitions Schema) NamedSchema) -> ToSchema a
$cdeclareNamedSchema :: Proxy VerifyDeleteUser -> Declare (Definitions Schema) NamedSchema
declareNamedSchema :: Proxy VerifyDeleteUser -> Declare (Definitions Schema) NamedSchema
S.ToSchema) via (Schema VerifyDeleteUser)

instance ToSchema VerifyDeleteUser where
  schema :: ValueSchema NamedSwaggerDoc VerifyDeleteUser
schema =
    Text
-> (NamedSwaggerDoc -> NamedSwaggerDoc)
-> ObjectSchema SwaggerDoc VerifyDeleteUser
-> ValueSchema NamedSwaggerDoc VerifyDeleteUser
forall doc doc' a.
HasObject doc doc' =>
Text -> (doc' -> doc') -> ObjectSchema doc a -> ValueSchema doc' a
objectWithDocModifier Text
"VerifyDeleteUser" ((Maybe Text -> Identity (Maybe Text))
-> NamedSwaggerDoc -> Identity NamedSwaggerDoc
forall s a. HasDescription s a => Lens' s a
Lens' NamedSwaggerDoc (Maybe Text)
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
"Data for verifying an account deletion.") (ObjectSchema SwaggerDoc VerifyDeleteUser
 -> ValueSchema NamedSwaggerDoc VerifyDeleteUser)
-> ObjectSchema SwaggerDoc VerifyDeleteUser
-> ValueSchema NamedSwaggerDoc VerifyDeleteUser
forall a b. (a -> b) -> a -> b
$
      Key -> Value -> VerifyDeleteUser
VerifyDeleteUser
        (Key -> Value -> VerifyDeleteUser)
-> SchemaP SwaggerDoc Object [Pair] VerifyDeleteUser Key
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     VerifyDeleteUser
     (Value -> VerifyDeleteUser)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> VerifyDeleteUser -> Key
verifyDeleteUserKey
          (VerifyDeleteUser -> Key)
-> SchemaP SwaggerDoc Object [Pair] Key Key
-> SchemaP SwaggerDoc Object [Pair] VerifyDeleteUser Key
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= Text
-> (NamedSwaggerDoc -> NamedSwaggerDoc)
-> SchemaP NamedSwaggerDoc Value Value Key Key
-> SchemaP SwaggerDoc Object [Pair] Key Key
forall doc' doc a b.
HasField doc' doc =>
Text
-> (doc' -> doc')
-> SchemaP doc' Value Value a b
-> SchemaP doc Object [Pair] a b
fieldWithDocModifier Text
"key" ((Maybe Text -> Identity (Maybe Text))
-> NamedSwaggerDoc -> Identity NamedSwaggerDoc
forall s a. HasDescription s a => Lens' s a
Lens' NamedSwaggerDoc (Maybe Text)
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
"The identifying key of the account (i.e. user ID).") SchemaP NamedSwaggerDoc Value Value Key Key
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema
        SchemaP
  SwaggerDoc
  Object
  [Pair]
  VerifyDeleteUser
  (Value -> VerifyDeleteUser)
-> SchemaP SwaggerDoc Object [Pair] VerifyDeleteUser Value
-> ObjectSchema SwaggerDoc VerifyDeleteUser
forall a b.
SchemaP SwaggerDoc Object [Pair] VerifyDeleteUser (a -> b)
-> SchemaP SwaggerDoc Object [Pair] VerifyDeleteUser a
-> SchemaP SwaggerDoc Object [Pair] VerifyDeleteUser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> VerifyDeleteUser -> Value
verifyDeleteUserCode
          (VerifyDeleteUser -> Value)
-> SchemaP SwaggerDoc Object [Pair] Value Value
-> SchemaP SwaggerDoc Object [Pair] VerifyDeleteUser Value
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= Text
-> (NamedSwaggerDoc -> NamedSwaggerDoc)
-> SchemaP NamedSwaggerDoc Value Value Value Value
-> SchemaP SwaggerDoc Object [Pair] Value Value
forall doc' doc a b.
HasField doc' doc =>
Text
-> (doc' -> doc')
-> SchemaP doc' Value Value a b
-> SchemaP doc Object [Pair] a b
fieldWithDocModifier Text
"code" ((Maybe Text -> Identity (Maybe Text))
-> NamedSwaggerDoc -> Identity NamedSwaggerDoc
forall s a. HasDescription s a => Lens' s a
Lens' NamedSwaggerDoc (Maybe Text)
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
"The verification code.") SchemaP NamedSwaggerDoc Value Value Value Value
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema

-- | A response for a pending deletion code.
newtype DeletionCodeTimeout = DeletionCodeTimeout
  {DeletionCodeTimeout -> Timeout
fromDeletionCodeTimeout :: Code.Timeout}
  deriving stock (DeletionCodeTimeout -> DeletionCodeTimeout -> Bool
(DeletionCodeTimeout -> DeletionCodeTimeout -> Bool)
-> (DeletionCodeTimeout -> DeletionCodeTimeout -> Bool)
-> Eq DeletionCodeTimeout
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: DeletionCodeTimeout -> DeletionCodeTimeout -> Bool
== :: DeletionCodeTimeout -> DeletionCodeTimeout -> Bool
$c/= :: DeletionCodeTimeout -> DeletionCodeTimeout -> Bool
/= :: DeletionCodeTimeout -> DeletionCodeTimeout -> Bool
Eq, Int -> DeletionCodeTimeout -> ShowS
[DeletionCodeTimeout] -> ShowS
DeletionCodeTimeout -> String
(Int -> DeletionCodeTimeout -> ShowS)
-> (DeletionCodeTimeout -> String)
-> ([DeletionCodeTimeout] -> ShowS)
-> Show DeletionCodeTimeout
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> DeletionCodeTimeout -> ShowS
showsPrec :: Int -> DeletionCodeTimeout -> ShowS
$cshow :: DeletionCodeTimeout -> String
show :: DeletionCodeTimeout -> String
$cshowList :: [DeletionCodeTimeout] -> ShowS
showList :: [DeletionCodeTimeout] -> ShowS
Show, (forall x. DeletionCodeTimeout -> Rep DeletionCodeTimeout x)
-> (forall x. Rep DeletionCodeTimeout x -> DeletionCodeTimeout)
-> Generic DeletionCodeTimeout
forall x. Rep DeletionCodeTimeout x -> DeletionCodeTimeout
forall x. DeletionCodeTimeout -> Rep DeletionCodeTimeout x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. DeletionCodeTimeout -> Rep DeletionCodeTimeout x
from :: forall x. DeletionCodeTimeout -> Rep DeletionCodeTimeout x
$cto :: forall x. Rep DeletionCodeTimeout x -> DeletionCodeTimeout
to :: forall x. Rep DeletionCodeTimeout x -> DeletionCodeTimeout
Generic)
  deriving newtype (Gen DeletionCodeTimeout
Gen DeletionCodeTimeout
-> (DeletionCodeTimeout -> [DeletionCodeTimeout])
-> Arbitrary DeletionCodeTimeout
DeletionCodeTimeout -> [DeletionCodeTimeout]
forall a. Gen a -> (a -> [a]) -> Arbitrary a
$carbitrary :: Gen DeletionCodeTimeout
arbitrary :: Gen DeletionCodeTimeout
$cshrink :: DeletionCodeTimeout -> [DeletionCodeTimeout]
shrink :: DeletionCodeTimeout -> [DeletionCodeTimeout]
Arbitrary)
  deriving (Typeable DeletionCodeTimeout
Typeable DeletionCodeTimeout =>
(Proxy DeletionCodeTimeout
 -> Declare (Definitions Schema) NamedSchema)
-> ToSchema DeletionCodeTimeout
Proxy DeletionCodeTimeout
-> Declare (Definitions Schema) NamedSchema
forall a.
Typeable a =>
(Proxy a -> Declare (Definitions Schema) NamedSchema) -> ToSchema a
$cdeclareNamedSchema :: Proxy DeletionCodeTimeout
-> Declare (Definitions Schema) NamedSchema
declareNamedSchema :: Proxy DeletionCodeTimeout
-> Declare (Definitions Schema) NamedSchema
S.ToSchema) via (Schema DeletionCodeTimeout)

instance ToSchema DeletionCodeTimeout where
  schema :: ValueSchema NamedSwaggerDoc DeletionCodeTimeout
schema =
    Text
-> SchemaP
     SwaggerDoc Object [Pair] DeletionCodeTimeout DeletionCodeTimeout
-> ValueSchema NamedSwaggerDoc DeletionCodeTimeout
forall doc doc' a b.
HasObject doc doc' =>
Text
-> SchemaP doc Object [Pair] a b -> SchemaP doc' Value Value a b
object Text
"DeletionCodeTimeout" (SchemaP
   SwaggerDoc Object [Pair] DeletionCodeTimeout DeletionCodeTimeout
 -> ValueSchema NamedSwaggerDoc DeletionCodeTimeout)
-> SchemaP
     SwaggerDoc Object [Pair] DeletionCodeTimeout DeletionCodeTimeout
-> ValueSchema NamedSwaggerDoc DeletionCodeTimeout
forall a b. (a -> b) -> a -> b
$
      Timeout -> DeletionCodeTimeout
DeletionCodeTimeout
        (Timeout -> DeletionCodeTimeout)
-> SchemaP SwaggerDoc Object [Pair] DeletionCodeTimeout Timeout
-> SchemaP
     SwaggerDoc Object [Pair] DeletionCodeTimeout DeletionCodeTimeout
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> DeletionCodeTimeout -> Timeout
fromDeletionCodeTimeout
          (DeletionCodeTimeout -> Timeout)
-> SchemaP SwaggerDoc Object [Pair] Timeout Timeout
-> SchemaP SwaggerDoc Object [Pair] DeletionCodeTimeout Timeout
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= Text
-> SchemaP NamedSwaggerDoc Value Value Timeout Timeout
-> SchemaP SwaggerDoc Object [Pair] Timeout Timeout
forall doc' doc a b.
HasField doc' doc =>
Text
-> SchemaP doc' Value Value a b -> SchemaP doc Object [Pair] a b
field Text
"expires_in" SchemaP NamedSwaggerDoc Value Value Timeout Timeout
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema

instance ToJSON DeletionCodeTimeout where
  toJSON :: DeletionCodeTimeout -> Value
toJSON (DeletionCodeTimeout Timeout
t) = [Pair] -> Value
A.object [Key
"expires_in" Key -> Timeout -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
A..= Timeout
t]

instance FromJSON DeletionCodeTimeout where
  parseJSON :: Value -> Parser DeletionCodeTimeout
parseJSON = String
-> (Object -> Parser DeletionCodeTimeout)
-> Value
-> Parser DeletionCodeTimeout
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"DeletionCodeTimeout" ((Object -> Parser DeletionCodeTimeout)
 -> Value -> Parser DeletionCodeTimeout)
-> (Object -> Parser DeletionCodeTimeout)
-> Value
-> Parser DeletionCodeTimeout
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Timeout -> DeletionCodeTimeout
DeletionCodeTimeout (Timeout -> DeletionCodeTimeout)
-> Parser Timeout -> Parser DeletionCodeTimeout
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser Timeout
forall a. FromJSON a => Object -> Key -> Parser a
A..: Key
"expires_in"

-- | Like `DeleteUserResult`, but without the exception case.
data DeleteUserResponse
  = UserResponseAccountAlreadyDeleted
  | UserResponseAccountDeleted

instance
  AsUnion
    '[ Respond 200 "UserResponseAccountAlreadyDeleted" (),
       Respond 202 "UserResponseAccountDeleted" ()
     ]
    DeleteUserResponse
  where
  toUnion :: DeleteUserResponse
-> Union
     (ResponseTypes
        '[Respond 200 "UserResponseAccountAlreadyDeleted" (),
          Respond 202 "UserResponseAccountDeleted" ()])
toUnion DeleteUserResponse
UserResponseAccountAlreadyDeleted = I () -> NS I '[(), ()]
forall {k} (a :: k -> *) (x :: k) (xs :: [k]). a x -> NS a (x : xs)
Z (() -> I ()
forall a. a -> I a
I ())
  toUnion DeleteUserResponse
UserResponseAccountDeleted = NS I '[()] -> NS I '[(), ()]
forall {k} (a :: k -> *) (xs :: [k]) (x :: k).
NS a xs -> NS a (x : xs)
S (I () -> NS I '[()]
forall {k} (a :: k -> *) (x :: k) (xs :: [k]). a x -> NS a (x : xs)
Z (() -> I ()
forall a. a -> I a
I ()))
  fromUnion :: Union
  (ResponseTypes
     '[Respond 200 "UserResponseAccountAlreadyDeleted" (),
       Respond 202 "UserResponseAccountDeleted" ()])
-> DeleteUserResponse
fromUnion (Z (I ())) = DeleteUserResponse
UserResponseAccountAlreadyDeleted
  fromUnion (S (Z (I ()))) = DeleteUserResponse
UserResponseAccountDeleted
  fromUnion (S (S NS I xs
x)) = case NS I xs
x of {}

-- | Result of an internal user/account deletion
data DeleteUserResult
  = -- | User never existed
    NoUser
  | -- | User/account was deleted before
    AccountAlreadyDeleted
  | -- | User/account was deleted in this call
    AccountDeleted
  deriving (DeleteUserResult -> DeleteUserResult -> Bool
(DeleteUserResult -> DeleteUserResult -> Bool)
-> (DeleteUserResult -> DeleteUserResult -> Bool)
-> Eq DeleteUserResult
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: DeleteUserResult -> DeleteUserResult -> Bool
== :: DeleteUserResult -> DeleteUserResult -> Bool
$c/= :: DeleteUserResult -> DeleteUserResult -> Bool
/= :: DeleteUserResult -> DeleteUserResult -> Bool
Eq, Int -> DeleteUserResult -> ShowS
[DeleteUserResult] -> ShowS
DeleteUserResult -> String
(Int -> DeleteUserResult -> ShowS)
-> (DeleteUserResult -> String)
-> ([DeleteUserResult] -> ShowS)
-> Show DeleteUserResult
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> DeleteUserResult -> ShowS
showsPrec :: Int -> DeleteUserResult -> ShowS
$cshow :: DeleteUserResult -> String
show :: DeleteUserResult -> String
$cshowList :: [DeleteUserResult] -> ShowS
showList :: [DeleteUserResult] -> ShowS
Show)

data ListUsersQuery
  = ListUsersByIds [Qualified UserId]
  | ListUsersByHandles (Range 1 4 [Qualified Handle])
  deriving (Int -> ListUsersQuery -> ShowS
[ListUsersQuery] -> ShowS
ListUsersQuery -> String
(Int -> ListUsersQuery -> ShowS)
-> (ListUsersQuery -> String)
-> ([ListUsersQuery] -> ShowS)
-> Show ListUsersQuery
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ListUsersQuery -> ShowS
showsPrec :: Int -> ListUsersQuery -> ShowS
$cshow :: ListUsersQuery -> String
show :: ListUsersQuery -> String
$cshowList :: [ListUsersQuery] -> ShowS
showList :: [ListUsersQuery] -> ShowS
Show, ListUsersQuery -> ListUsersQuery -> Bool
(ListUsersQuery -> ListUsersQuery -> Bool)
-> (ListUsersQuery -> ListUsersQuery -> Bool) -> Eq ListUsersQuery
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ListUsersQuery -> ListUsersQuery -> Bool
== :: ListUsersQuery -> ListUsersQuery -> Bool
$c/= :: ListUsersQuery -> ListUsersQuery -> Bool
/= :: ListUsersQuery -> ListUsersQuery -> Bool
Eq)

instance FromJSON ListUsersQuery where
  parseJSON :: Value -> Parser ListUsersQuery
parseJSON =
    String
-> (Object -> Parser ListUsersQuery)
-> Value
-> Parser ListUsersQuery
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"ListUsersQuery" ((Object -> Parser ListUsersQuery)
 -> Value -> Parser ListUsersQuery)
-> (Object -> Parser ListUsersQuery)
-> Value
-> Parser ListUsersQuery
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
      Maybe ListUsersQuery
mUids <- [Qualified UserId] -> ListUsersQuery
ListUsersByIds ([Qualified UserId] -> ListUsersQuery)
-> Parser (Maybe [Qualified UserId])
-> Parser (Maybe ListUsersQuery)
forall (f :: * -> *) (g :: * -> *) a b.
(Functor f, Functor g) =>
(a -> b) -> f (g a) -> f (g b)
<$$> Object
o Object -> Key -> Parser (Maybe [Qualified UserId])
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
A..:? Key
"qualified_ids"
      Maybe ListUsersQuery
mHandles <- Range 1 4 [Qualified Handle] -> ListUsersQuery
ListUsersByHandles (Range 1 4 [Qualified Handle] -> ListUsersQuery)
-> Parser (Maybe (Range 1 4 [Qualified Handle]))
-> Parser (Maybe ListUsersQuery)
forall (f :: * -> *) (g :: * -> *) a b.
(Functor f, Functor g) =>
(a -> b) -> f (g a) -> f (g b)
<$$> Object
o Object -> Key -> Parser (Maybe (Range 1 4 [Qualified Handle]))
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
A..:? Key
"qualified_handles"
      case (Maybe ListUsersQuery
mUids, Maybe ListUsersQuery
mHandles) of
        (Just ListUsersQuery
uids, Maybe ListUsersQuery
Nothing) -> ListUsersQuery -> Parser ListUsersQuery
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ListUsersQuery
uids
        (Maybe ListUsersQuery
Nothing, Just ListUsersQuery
handles) -> ListUsersQuery -> Parser ListUsersQuery
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ListUsersQuery
handles
        (Maybe ListUsersQuery
_, Maybe ListUsersQuery
_) -> String -> Parser ListUsersQuery
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"exactly one of qualified_ids or qualified_handles must be provided."

instance ToJSON ListUsersQuery where
  toJSON :: ListUsersQuery -> Value
toJSON (ListUsersByIds [Qualified UserId]
uids) = [Pair] -> Value
A.object [Key
"qualified_ids" Key -> [Qualified UserId] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
A..= [Qualified UserId]
uids]
  toJSON (ListUsersByHandles Range 1 4 [Qualified Handle]
handles) = [Pair] -> Value
A.object [Key
"qualified_handles" Key -> Range 1 4 [Qualified Handle] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
A..= Range 1 4 [Qualified Handle]
handles]

-- NB: It is not possible to specific mutually exclusive fields in swagger2, so
-- here we write it in description and modify the example to have the correct
-- JSON.
instance S.ToSchema ListUsersQuery where
  declareNamedSchema :: Proxy ListUsersQuery -> Declare (Definitions Schema) NamedSchema
declareNamedSchema Proxy ListUsersQuery
_ = do
    Referenced Schema
uids <- Proxy [Qualified UserId]
-> Declare (Definitions Schema) (Referenced Schema)
forall a.
ToSchema a =>
Proxy a -> Declare (Definitions Schema) (Referenced Schema)
S.declareSchemaRef (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @[Qualified UserId])
    Referenced Schema
handles <- Proxy (Range 1 4 [Qualified Handle])
-> Declare (Definitions Schema) (Referenced Schema)
forall a.
ToSchema a =>
Proxy a -> Declare (Definitions Schema) (Referenced Schema)
S.declareSchemaRef (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @(Range 1 4 [Qualified Handle]))
    NamedSchema -> Declare (Definitions Schema) NamedSchema
forall a. a -> DeclareT (Definitions Schema) Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (NamedSchema -> Declare (Definitions Schema) NamedSchema)
-> NamedSchema -> Declare (Definitions Schema) NamedSchema
forall a b. (a -> b) -> a -> b
$
      Maybe Text -> Schema -> NamedSchema
S.NamedSchema (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"ListUsersQuery") (Schema -> NamedSchema) -> Schema -> NamedSchema
forall a b. (a -> b) -> a -> b
$
        Schema
forall a. Monoid a => a
mempty
          Schema -> (Schema -> Schema) -> Schema
forall a b. a -> (a -> b) -> b
& (Maybe OpenApiType -> Identity (Maybe OpenApiType))
-> Schema -> Identity Schema
forall s a. HasType s a => Lens' s a
Lens' Schema (Maybe OpenApiType)
S.type_ ((Maybe OpenApiType -> Identity (Maybe OpenApiType))
 -> Schema -> Identity Schema)
-> OpenApiType -> Schema -> Schema
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ OpenApiType
S.OpenApiObject
          Schema -> (Schema -> Schema) -> Schema
forall a b. a -> (a -> b) -> b
& (Maybe Text -> Identity (Maybe Text)) -> Schema -> Identity Schema
forall s a. HasDescription s a => Lens' s a
Lens' Schema (Maybe Text)
S.description ((Maybe Text -> Identity (Maybe Text))
 -> Schema -> Identity Schema)
-> Text -> Schema -> Schema
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Text
"exactly one of qualified_ids or qualified_handles must be provided."
          Schema -> (Schema -> Schema) -> Schema
forall a b. a -> (a -> b) -> b
& (InsOrdHashMap Text (Referenced Schema)
 -> Identity (InsOrdHashMap Text (Referenced Schema)))
-> Schema -> Identity Schema
forall s a. HasProperties s a => Lens' s a
Lens' Schema (InsOrdHashMap Text (Referenced Schema))
S.properties ((InsOrdHashMap Text (Referenced Schema)
  -> Identity (InsOrdHashMap Text (Referenced Schema)))
 -> Schema -> Identity Schema)
-> InsOrdHashMap Text (Referenced Schema) -> Schema -> Schema
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [(Text, Referenced Schema)]
-> InsOrdHashMap Text (Referenced Schema)
forall k v. (Eq k, Hashable k) => [(k, v)] -> InsOrdHashMap k v
InsOrdHashMap.fromList [(Text
"qualified_ids", Referenced Schema
uids), (Text
"qualified_handles", Referenced Schema
handles)]
          Schema -> (Schema -> Schema) -> Schema
forall a b. a -> (a -> b) -> b
& (Maybe Value -> Identity (Maybe Value))
-> Schema -> Identity Schema
forall s a. HasExample s a => Lens' s a
Lens' Schema (Maybe Value)
S.example ((Maybe Value -> Identity (Maybe Value))
 -> Schema -> Identity Schema)
-> Value -> Schema -> Schema
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ ListUsersQuery -> Value
forall a. ToJSON a => a -> Value
toJSON ([Qualified UserId] -> ListUsersQuery
ListUsersByIds [UserId -> Domain -> Qualified UserId
forall a. a -> Domain -> Qualified a
Qualified (UUID -> UserId
forall {k} (a :: k). UUID -> Id a
Id UUID
UUID.nil) (Text -> Domain
Domain Text
"example.com")])

-------------------------------------------------------------------------------
-- AccountStatus

data AccountStatus
  = Active
  | Suspended
  | Deleted
  | Ephemeral
  | -- | for most intents & purposes, this is another form of inactive.  it is used for
    -- allowing scim to find users that have not accepted their invitation yet after
    -- creating via scim.
    PendingInvitation
  deriving (AccountStatus -> AccountStatus -> Bool
(AccountStatus -> AccountStatus -> Bool)
-> (AccountStatus -> AccountStatus -> Bool) -> Eq AccountStatus
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: AccountStatus -> AccountStatus -> Bool
== :: AccountStatus -> AccountStatus -> Bool
$c/= :: AccountStatus -> AccountStatus -> Bool
/= :: AccountStatus -> AccountStatus -> Bool
Eq, Eq AccountStatus
Eq AccountStatus =>
(AccountStatus -> AccountStatus -> Ordering)
-> (AccountStatus -> AccountStatus -> Bool)
-> (AccountStatus -> AccountStatus -> Bool)
-> (AccountStatus -> AccountStatus -> Bool)
-> (AccountStatus -> AccountStatus -> Bool)
-> (AccountStatus -> AccountStatus -> AccountStatus)
-> (AccountStatus -> AccountStatus -> AccountStatus)
-> Ord AccountStatus
AccountStatus -> AccountStatus -> Bool
AccountStatus -> AccountStatus -> Ordering
AccountStatus -> AccountStatus -> AccountStatus
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 :: AccountStatus -> AccountStatus -> Ordering
compare :: AccountStatus -> AccountStatus -> Ordering
$c< :: AccountStatus -> AccountStatus -> Bool
< :: AccountStatus -> AccountStatus -> Bool
$c<= :: AccountStatus -> AccountStatus -> Bool
<= :: AccountStatus -> AccountStatus -> Bool
$c> :: AccountStatus -> AccountStatus -> Bool
> :: AccountStatus -> AccountStatus -> Bool
$c>= :: AccountStatus -> AccountStatus -> Bool
>= :: AccountStatus -> AccountStatus -> Bool
$cmax :: AccountStatus -> AccountStatus -> AccountStatus
max :: AccountStatus -> AccountStatus -> AccountStatus
$cmin :: AccountStatus -> AccountStatus -> AccountStatus
min :: AccountStatus -> AccountStatus -> AccountStatus
Ord, Int -> AccountStatus -> ShowS
[AccountStatus] -> ShowS
AccountStatus -> String
(Int -> AccountStatus -> ShowS)
-> (AccountStatus -> String)
-> ([AccountStatus] -> ShowS)
-> Show AccountStatus
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> AccountStatus -> ShowS
showsPrec :: Int -> AccountStatus -> ShowS
$cshow :: AccountStatus -> String
show :: AccountStatus -> String
$cshowList :: [AccountStatus] -> ShowS
showList :: [AccountStatus] -> ShowS
Show, (forall x. AccountStatus -> Rep AccountStatus x)
-> (forall x. Rep AccountStatus x -> AccountStatus)
-> Generic AccountStatus
forall x. Rep AccountStatus x -> AccountStatus
forall x. AccountStatus -> Rep AccountStatus x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. AccountStatus -> Rep AccountStatus x
from :: forall x. AccountStatus -> Rep AccountStatus x
$cto :: forall x. Rep AccountStatus x -> AccountStatus
to :: forall x. Rep AccountStatus x -> AccountStatus
Generic)
  deriving (Gen AccountStatus
Gen AccountStatus
-> (AccountStatus -> [AccountStatus]) -> Arbitrary AccountStatus
AccountStatus -> [AccountStatus]
forall a. Gen a -> (a -> [a]) -> Arbitrary a
$carbitrary :: Gen AccountStatus
arbitrary :: Gen AccountStatus
$cshrink :: AccountStatus -> [AccountStatus]
shrink :: AccountStatus -> [AccountStatus]
Arbitrary) via (GenericUniform AccountStatus)
  deriving ([AccountStatus] -> Value
[AccountStatus] -> Encoding
AccountStatus -> Value
AccountStatus -> Encoding
(AccountStatus -> Value)
-> (AccountStatus -> Encoding)
-> ([AccountStatus] -> Value)
-> ([AccountStatus] -> Encoding)
-> ToJSON AccountStatus
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: AccountStatus -> Value
toJSON :: AccountStatus -> Value
$ctoEncoding :: AccountStatus -> Encoding
toEncoding :: AccountStatus -> Encoding
$ctoJSONList :: [AccountStatus] -> Value
toJSONList :: [AccountStatus] -> Value
$ctoEncodingList :: [AccountStatus] -> Encoding
toEncodingList :: [AccountStatus] -> Encoding
ToJSON, Value -> Parser [AccountStatus]
Value -> Parser AccountStatus
(Value -> Parser AccountStatus)
-> (Value -> Parser [AccountStatus]) -> FromJSON AccountStatus
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser AccountStatus
parseJSON :: Value -> Parser AccountStatus
$cparseJSONList :: Value -> Parser [AccountStatus]
parseJSONList :: Value -> Parser [AccountStatus]
FromJSON, Typeable AccountStatus
Typeable AccountStatus =>
(Proxy AccountStatus -> Declare (Definitions Schema) NamedSchema)
-> ToSchema AccountStatus
Proxy AccountStatus -> Declare (Definitions Schema) NamedSchema
forall a.
Typeable a =>
(Proxy a -> Declare (Definitions Schema) NamedSchema) -> ToSchema a
$cdeclareNamedSchema :: Proxy AccountStatus -> Declare (Definitions Schema) NamedSchema
declareNamedSchema :: Proxy AccountStatus -> Declare (Definitions Schema) NamedSchema
S.ToSchema) via Schema.Schema AccountStatus

instance Schema.ToSchema AccountStatus where
  schema :: SchemaP NamedSwaggerDoc Value Value AccountStatus AccountStatus
schema =
    forall v doc a b.
(With v, HasEnum v doc) =>
Text
-> SchemaP [Value] v (Alt Maybe v) a b
-> SchemaP doc Value Value a b
Schema.enum @Text Text
"AccountStatus" (SchemaP [Value] Text (Alt Maybe Text) AccountStatus AccountStatus
 -> SchemaP NamedSwaggerDoc Value Value AccountStatus AccountStatus)
-> SchemaP
     [Value] Text (Alt Maybe Text) AccountStatus AccountStatus
-> SchemaP NamedSwaggerDoc Value Value AccountStatus AccountStatus
forall a b. (a -> b) -> a -> b
$
      [SchemaP [Value] Text (Alt Maybe Text) AccountStatus AccountStatus]
-> SchemaP
     [Value] Text (Alt Maybe Text) AccountStatus AccountStatus
forall a. Monoid a => [a] -> a
mconcat
        [ Text
-> AccountStatus
-> SchemaP
     [Value] Text (Alt Maybe Text) AccountStatus AccountStatus
forall a b.
(ToJSON a, Eq a, Eq b) =>
a -> b -> SchemaP [Value] a (Alt Maybe a) b b
Schema.element Text
"active" AccountStatus
Active,
          Text
-> AccountStatus
-> SchemaP
     [Value] Text (Alt Maybe Text) AccountStatus AccountStatus
forall a b.
(ToJSON a, Eq a, Eq b) =>
a -> b -> SchemaP [Value] a (Alt Maybe a) b b
Schema.element Text
"suspended" AccountStatus
Suspended,
          Text
-> AccountStatus
-> SchemaP
     [Value] Text (Alt Maybe Text) AccountStatus AccountStatus
forall a b.
(ToJSON a, Eq a, Eq b) =>
a -> b -> SchemaP [Value] a (Alt Maybe a) b b
Schema.element Text
"deleted" AccountStatus
Deleted,
          Text
-> AccountStatus
-> SchemaP
     [Value] Text (Alt Maybe Text) AccountStatus AccountStatus
forall a b.
(ToJSON a, Eq a, Eq b) =>
a -> b -> SchemaP [Value] a (Alt Maybe a) b b
Schema.element Text
"ephemeral" AccountStatus
Ephemeral,
          Text
-> AccountStatus
-> SchemaP
     [Value] Text (Alt Maybe Text) AccountStatus AccountStatus
forall a b.
(ToJSON a, Eq a, Eq b) =>
a -> b -> SchemaP [Value] a (Alt Maybe a) b b
Schema.element Text
"pending-invitation" AccountStatus
PendingInvitation
        ]

instance C.Cql AccountStatus where
  ctype :: Tagged AccountStatus ColumnType
ctype = ColumnType -> Tagged AccountStatus ColumnType
forall a b. b -> Tagged a b
C.Tagged ColumnType
C.IntColumn

  toCql :: AccountStatus -> Value
toCql AccountStatus
Active = Int32 -> Value
C.CqlInt Int32
0
  toCql AccountStatus
Suspended = Int32 -> Value
C.CqlInt Int32
1
  toCql AccountStatus
Deleted = Int32 -> Value
C.CqlInt Int32
2
  toCql AccountStatus
Ephemeral = Int32 -> Value
C.CqlInt Int32
3
  toCql AccountStatus
PendingInvitation = Int32 -> Value
C.CqlInt Int32
4

  fromCql :: Value -> Either String AccountStatus
fromCql (C.CqlInt Int32
i) = case Int32
i of
    Int32
0 -> AccountStatus -> Either String AccountStatus
forall a. a -> Either String a
forall (f :: * -> *) a. Applicative f => a -> f a
pure AccountStatus
Active
    Int32
1 -> AccountStatus -> Either String AccountStatus
forall a. a -> Either String a
forall (f :: * -> *) a. Applicative f => a -> f a
pure AccountStatus
Suspended
    Int32
2 -> AccountStatus -> Either String AccountStatus
forall a. a -> Either String a
forall (f :: * -> *) a. Applicative f => a -> f a
pure AccountStatus
Deleted
    Int32
3 -> AccountStatus -> Either String AccountStatus
forall a. a -> Either String a
forall (f :: * -> *) a. Applicative f => a -> f a
pure AccountStatus
Ephemeral
    Int32
4 -> AccountStatus -> Either String AccountStatus
forall a. a -> Either String a
forall (f :: * -> *) a. Applicative f => a -> f a
pure AccountStatus
PendingInvitation
    Int32
n -> String -> Either String AccountStatus
forall a b. a -> Either a b
Left (String -> Either String AccountStatus)
-> String -> Either String AccountStatus
forall a b. (a -> b) -> a -> b
$ String
"unexpected account status: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int32 -> String
forall a. Show a => a -> String
show Int32
n
  fromCql Value
_ = String -> Either String AccountStatus
forall a b. a -> Either a b
Left String
"account status: int expected"

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

instance Schema.ToSchema AccountStatusResp where
  schema :: ValueSchema NamedSwaggerDoc AccountStatusResp
schema =
    Text
-> SchemaP
     SwaggerDoc Object [Pair] AccountStatusResp AccountStatusResp
-> ValueSchema NamedSwaggerDoc AccountStatusResp
forall doc doc' a b.
HasObject doc doc' =>
Text
-> SchemaP doc Object [Pair] a b -> SchemaP doc' Value Value a b
object Text
"AccountStatusResp" (SchemaP
   SwaggerDoc Object [Pair] AccountStatusResp AccountStatusResp
 -> ValueSchema NamedSwaggerDoc AccountStatusResp)
-> SchemaP
     SwaggerDoc Object [Pair] AccountStatusResp AccountStatusResp
-> ValueSchema NamedSwaggerDoc AccountStatusResp
forall a b. (a -> b) -> a -> b
$
      AccountStatus -> AccountStatusResp
AccountStatusResp (AccountStatus -> AccountStatusResp)
-> SchemaP SwaggerDoc Object [Pair] AccountStatusResp AccountStatus
-> SchemaP
     SwaggerDoc Object [Pair] AccountStatusResp AccountStatusResp
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> AccountStatusResp -> AccountStatus
fromAccountStatusResp (AccountStatusResp -> AccountStatus)
-> SchemaP SwaggerDoc Object [Pair] AccountStatus AccountStatus
-> SchemaP SwaggerDoc Object [Pair] AccountStatusResp AccountStatus
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= Text
-> SchemaP NamedSwaggerDoc Value Value AccountStatus AccountStatus
-> SchemaP SwaggerDoc Object [Pair] AccountStatus AccountStatus
forall doc' doc a b.
HasField doc' doc =>
Text
-> SchemaP doc' Value Value a b -> SchemaP doc Object [Pair] a b
field Text
"status" SchemaP NamedSwaggerDoc Value Value AccountStatus AccountStatus
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema

newtype AccountStatusUpdate = AccountStatusUpdate {AccountStatusUpdate -> AccountStatus
suStatus :: AccountStatus}
  deriving ((forall x. AccountStatusUpdate -> Rep AccountStatusUpdate x)
-> (forall x. Rep AccountStatusUpdate x -> AccountStatusUpdate)
-> Generic AccountStatusUpdate
forall x. Rep AccountStatusUpdate x -> AccountStatusUpdate
forall x. AccountStatusUpdate -> Rep AccountStatusUpdate x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. AccountStatusUpdate -> Rep AccountStatusUpdate x
from :: forall x. AccountStatusUpdate -> Rep AccountStatusUpdate x
$cto :: forall x. Rep AccountStatusUpdate x -> AccountStatusUpdate
to :: forall x. Rep AccountStatusUpdate x -> AccountStatusUpdate
Generic)
  deriving (Gen AccountStatusUpdate
Gen AccountStatusUpdate
-> (AccountStatusUpdate -> [AccountStatusUpdate])
-> Arbitrary AccountStatusUpdate
AccountStatusUpdate -> [AccountStatusUpdate]
forall a. Gen a -> (a -> [a]) -> Arbitrary a
$carbitrary :: Gen AccountStatusUpdate
arbitrary :: Gen AccountStatusUpdate
$cshrink :: AccountStatusUpdate -> [AccountStatusUpdate]
shrink :: AccountStatusUpdate -> [AccountStatusUpdate]
Arbitrary) via (GenericUniform AccountStatusUpdate)
  deriving ([AccountStatusUpdate] -> Value
[AccountStatusUpdate] -> Encoding
AccountStatusUpdate -> Value
AccountStatusUpdate -> Encoding
(AccountStatusUpdate -> Value)
-> (AccountStatusUpdate -> Encoding)
-> ([AccountStatusUpdate] -> Value)
-> ([AccountStatusUpdate] -> Encoding)
-> ToJSON AccountStatusUpdate
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: AccountStatusUpdate -> Value
toJSON :: AccountStatusUpdate -> Value
$ctoEncoding :: AccountStatusUpdate -> Encoding
toEncoding :: AccountStatusUpdate -> Encoding
$ctoJSONList :: [AccountStatusUpdate] -> Value
toJSONList :: [AccountStatusUpdate] -> Value
$ctoEncodingList :: [AccountStatusUpdate] -> Encoding
toEncodingList :: [AccountStatusUpdate] -> Encoding
ToJSON, Value -> Parser [AccountStatusUpdate]
Value -> Parser AccountStatusUpdate
(Value -> Parser AccountStatusUpdate)
-> (Value -> Parser [AccountStatusUpdate])
-> FromJSON AccountStatusUpdate
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser AccountStatusUpdate
parseJSON :: Value -> Parser AccountStatusUpdate
$cparseJSONList :: Value -> Parser [AccountStatusUpdate]
parseJSONList :: Value -> Parser [AccountStatusUpdate]
FromJSON, Typeable AccountStatusUpdate
Typeable AccountStatusUpdate =>
(Proxy AccountStatusUpdate
 -> Declare (Definitions Schema) NamedSchema)
-> ToSchema AccountStatusUpdate
Proxy AccountStatusUpdate
-> Declare (Definitions Schema) NamedSchema
forall a.
Typeable a =>
(Proxy a -> Declare (Definitions Schema) NamedSchema) -> ToSchema a
$cdeclareNamedSchema :: Proxy AccountStatusUpdate
-> Declare (Definitions Schema) NamedSchema
declareNamedSchema :: Proxy AccountStatusUpdate
-> Declare (Definitions Schema) NamedSchema
S.ToSchema) via Schema.Schema AccountStatusUpdate

instance Schema.ToSchema AccountStatusUpdate where
  schema :: ValueSchema NamedSwaggerDoc AccountStatusUpdate
schema =
    Text
-> SchemaP
     SwaggerDoc Object [Pair] AccountStatusUpdate AccountStatusUpdate
-> ValueSchema NamedSwaggerDoc AccountStatusUpdate
forall doc doc' a b.
HasObject doc doc' =>
Text
-> SchemaP doc Object [Pair] a b -> SchemaP doc' Value Value a b
object Text
"AccountStatusUpdate" (SchemaP
   SwaggerDoc Object [Pair] AccountStatusUpdate AccountStatusUpdate
 -> ValueSchema NamedSwaggerDoc AccountStatusUpdate)
-> SchemaP
     SwaggerDoc Object [Pair] AccountStatusUpdate AccountStatusUpdate
-> ValueSchema NamedSwaggerDoc AccountStatusUpdate
forall a b. (a -> b) -> a -> b
$
      AccountStatus -> AccountStatusUpdate
AccountStatusUpdate (AccountStatus -> AccountStatusUpdate)
-> SchemaP
     SwaggerDoc Object [Pair] AccountStatusUpdate AccountStatus
-> SchemaP
     SwaggerDoc Object [Pair] AccountStatusUpdate AccountStatusUpdate
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> AccountStatusUpdate -> AccountStatus
suStatus (AccountStatusUpdate -> AccountStatus)
-> SchemaP SwaggerDoc Object [Pair] AccountStatus AccountStatus
-> SchemaP
     SwaggerDoc Object [Pair] AccountStatusUpdate AccountStatus
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= Text
-> SchemaP NamedSwaggerDoc Value Value AccountStatus AccountStatus
-> SchemaP SwaggerDoc Object [Pair] AccountStatus AccountStatus
forall doc' doc a b.
HasField doc' doc =>
Text
-> SchemaP doc' Value Value a b -> SchemaP doc Object [Pair] a b
field Text
"status" SchemaP NamedSwaggerDoc Value Value AccountStatus AccountStatus
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema

-------------------------------------------------------------------------------
-- UserAccount

-------------------------------------------------------------------------------
-- NewUserScimInvitation

data NewUserScimInvitation = NewUserScimInvitation
  -- FIXME: the TID should be captured in the route as usual
  { NewUserScimInvitation -> TeamId
newUserScimInvTeamId :: TeamId,
    NewUserScimInvitation -> UserId
newUserScimInvUserId :: UserId,
    NewUserScimInvitation -> Text
newUserScimExternalId :: Text,
    NewUserScimInvitation -> Maybe Locale
newUserScimInvLocale :: Maybe Locale,
    NewUserScimInvitation -> Name
newUserScimInvName :: Name,
    NewUserScimInvitation -> EmailAddress
newUserScimInvEmail :: EmailAddress,
    NewUserScimInvitation -> Role
newUserScimInvRole :: Role
  }
  deriving (NewUserScimInvitation -> NewUserScimInvitation -> Bool
(NewUserScimInvitation -> NewUserScimInvitation -> Bool)
-> (NewUserScimInvitation -> NewUserScimInvitation -> Bool)
-> Eq NewUserScimInvitation
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: NewUserScimInvitation -> NewUserScimInvitation -> Bool
== :: NewUserScimInvitation -> NewUserScimInvitation -> Bool
$c/= :: NewUserScimInvitation -> NewUserScimInvitation -> Bool
/= :: NewUserScimInvitation -> NewUserScimInvitation -> Bool
Eq, Int -> NewUserScimInvitation -> ShowS
[NewUserScimInvitation] -> ShowS
NewUserScimInvitation -> String
(Int -> NewUserScimInvitation -> ShowS)
-> (NewUserScimInvitation -> String)
-> ([NewUserScimInvitation] -> ShowS)
-> Show NewUserScimInvitation
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> NewUserScimInvitation -> ShowS
showsPrec :: Int -> NewUserScimInvitation -> ShowS
$cshow :: NewUserScimInvitation -> String
show :: NewUserScimInvitation -> String
$cshowList :: [NewUserScimInvitation] -> ShowS
showList :: [NewUserScimInvitation] -> ShowS
Show, (forall x. NewUserScimInvitation -> Rep NewUserScimInvitation x)
-> (forall x. Rep NewUserScimInvitation x -> NewUserScimInvitation)
-> Generic NewUserScimInvitation
forall x. Rep NewUserScimInvitation x -> NewUserScimInvitation
forall x. NewUserScimInvitation -> Rep NewUserScimInvitation x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. NewUserScimInvitation -> Rep NewUserScimInvitation x
from :: forall x. NewUserScimInvitation -> Rep NewUserScimInvitation x
$cto :: forall x. Rep NewUserScimInvitation x -> NewUserScimInvitation
to :: forall x. Rep NewUserScimInvitation x -> NewUserScimInvitation
Generic)
  deriving (Gen NewUserScimInvitation
Gen NewUserScimInvitation
-> (NewUserScimInvitation -> [NewUserScimInvitation])
-> Arbitrary NewUserScimInvitation
NewUserScimInvitation -> [NewUserScimInvitation]
forall a. Gen a -> (a -> [a]) -> Arbitrary a
$carbitrary :: Gen NewUserScimInvitation
arbitrary :: Gen NewUserScimInvitation
$cshrink :: NewUserScimInvitation -> [NewUserScimInvitation]
shrink :: NewUserScimInvitation -> [NewUserScimInvitation]
Arbitrary) via (GenericUniform NewUserScimInvitation)
  deriving ([NewUserScimInvitation] -> Value
[NewUserScimInvitation] -> Encoding
NewUserScimInvitation -> Value
NewUserScimInvitation -> Encoding
(NewUserScimInvitation -> Value)
-> (NewUserScimInvitation -> Encoding)
-> ([NewUserScimInvitation] -> Value)
-> ([NewUserScimInvitation] -> Encoding)
-> ToJSON NewUserScimInvitation
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: NewUserScimInvitation -> Value
toJSON :: NewUserScimInvitation -> Value
$ctoEncoding :: NewUserScimInvitation -> Encoding
toEncoding :: NewUserScimInvitation -> Encoding
$ctoJSONList :: [NewUserScimInvitation] -> Value
toJSONList :: [NewUserScimInvitation] -> Value
$ctoEncodingList :: [NewUserScimInvitation] -> Encoding
toEncodingList :: [NewUserScimInvitation] -> Encoding
ToJSON, Value -> Parser [NewUserScimInvitation]
Value -> Parser NewUserScimInvitation
(Value -> Parser NewUserScimInvitation)
-> (Value -> Parser [NewUserScimInvitation])
-> FromJSON NewUserScimInvitation
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser NewUserScimInvitation
parseJSON :: Value -> Parser NewUserScimInvitation
$cparseJSONList :: Value -> Parser [NewUserScimInvitation]
parseJSONList :: Value -> Parser [NewUserScimInvitation]
FromJSON, Typeable NewUserScimInvitation
Typeable NewUserScimInvitation =>
(Proxy NewUserScimInvitation
 -> Declare (Definitions Schema) NamedSchema)
-> ToSchema NewUserScimInvitation
Proxy NewUserScimInvitation
-> Declare (Definitions Schema) NamedSchema
forall a.
Typeable a =>
(Proxy a -> Declare (Definitions Schema) NamedSchema) -> ToSchema a
$cdeclareNamedSchema :: Proxy NewUserScimInvitation
-> Declare (Definitions Schema) NamedSchema
declareNamedSchema :: Proxy NewUserScimInvitation
-> Declare (Definitions Schema) NamedSchema
S.ToSchema) via Schema.Schema NewUserScimInvitation

instance Schema.ToSchema NewUserScimInvitation where
  schema :: ValueSchema NamedSwaggerDoc NewUserScimInvitation
schema =
    Text
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     NewUserScimInvitation
     NewUserScimInvitation
-> ValueSchema NamedSwaggerDoc NewUserScimInvitation
forall doc doc' a b.
HasObject doc doc' =>
Text
-> SchemaP doc Object [Pair] a b -> SchemaP doc' Value Value a b
Schema.object Text
"NewUserScimInvitation" (SchemaP
   SwaggerDoc
   Object
   [Pair]
   NewUserScimInvitation
   NewUserScimInvitation
 -> ValueSchema NamedSwaggerDoc NewUserScimInvitation)
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     NewUserScimInvitation
     NewUserScimInvitation
-> ValueSchema NamedSwaggerDoc NewUserScimInvitation
forall a b. (a -> b) -> a -> b
$
      TeamId
-> UserId
-> Text
-> Maybe Locale
-> Name
-> EmailAddress
-> Role
-> NewUserScimInvitation
NewUserScimInvitation
        (TeamId
 -> UserId
 -> Text
 -> Maybe Locale
 -> Name
 -> EmailAddress
 -> Role
 -> NewUserScimInvitation)
-> SchemaP SwaggerDoc Object [Pair] NewUserScimInvitation TeamId
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     NewUserScimInvitation
     (UserId
      -> Text
      -> Maybe Locale
      -> Name
      -> EmailAddress
      -> Role
      -> NewUserScimInvitation)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NewUserScimInvitation -> TeamId
newUserScimInvTeamId (NewUserScimInvitation -> TeamId)
-> SchemaP SwaggerDoc Object [Pair] TeamId TeamId
-> SchemaP SwaggerDoc Object [Pair] NewUserScimInvitation TeamId
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
Schema..= Text
-> SchemaP NamedSwaggerDoc Value Value TeamId TeamId
-> SchemaP SwaggerDoc Object [Pair] TeamId TeamId
forall doc' doc a b.
HasField doc' doc =>
Text
-> SchemaP doc' Value Value a b -> SchemaP doc Object [Pair] a b
Schema.field Text
"team_id" SchemaP NamedSwaggerDoc Value Value TeamId TeamId
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
Schema.schema
        SchemaP
  SwaggerDoc
  Object
  [Pair]
  NewUserScimInvitation
  (UserId
   -> Text
   -> Maybe Locale
   -> Name
   -> EmailAddress
   -> Role
   -> NewUserScimInvitation)
-> SchemaP SwaggerDoc Object [Pair] NewUserScimInvitation UserId
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     NewUserScimInvitation
     (Text
      -> Maybe Locale
      -> Name
      -> EmailAddress
      -> Role
      -> NewUserScimInvitation)
forall a b.
SchemaP SwaggerDoc Object [Pair] NewUserScimInvitation (a -> b)
-> SchemaP SwaggerDoc Object [Pair] NewUserScimInvitation a
-> SchemaP SwaggerDoc Object [Pair] NewUserScimInvitation b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> NewUserScimInvitation -> UserId
newUserScimInvUserId (NewUserScimInvitation -> UserId)
-> SchemaP SwaggerDoc Object [Pair] UserId UserId
-> SchemaP SwaggerDoc Object [Pair] NewUserScimInvitation UserId
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
Schema..= Text
-> ValueSchema NamedSwaggerDoc 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
Schema.field Text
"user_id" ValueSchema NamedSwaggerDoc UserId
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
Schema.schema
        SchemaP
  SwaggerDoc
  Object
  [Pair]
  NewUserScimInvitation
  (Text
   -> Maybe Locale
   -> Name
   -> EmailAddress
   -> Role
   -> NewUserScimInvitation)
-> SchemaP SwaggerDoc Object [Pair] NewUserScimInvitation Text
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     NewUserScimInvitation
     (Maybe Locale
      -> Name -> EmailAddress -> Role -> NewUserScimInvitation)
forall a b.
SchemaP SwaggerDoc Object [Pair] NewUserScimInvitation (a -> b)
-> SchemaP SwaggerDoc Object [Pair] NewUserScimInvitation a
-> SchemaP SwaggerDoc Object [Pair] NewUserScimInvitation b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> NewUserScimInvitation -> Text
newUserScimExternalId (NewUserScimInvitation -> Text)
-> SchemaP SwaggerDoc Object [Pair] Text Text
-> SchemaP SwaggerDoc Object [Pair] NewUserScimInvitation Text
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
Schema..= Text
-> SchemaP NamedSwaggerDoc Value Value Text Text
-> SchemaP SwaggerDoc Object [Pair] Text Text
forall doc' doc a b.
HasField doc' doc =>
Text
-> SchemaP doc' Value Value a b -> SchemaP doc Object [Pair] a b
field Text
"external_id" SchemaP NamedSwaggerDoc Value Value Text Text
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema
        SchemaP
  SwaggerDoc
  Object
  [Pair]
  NewUserScimInvitation
  (Maybe Locale
   -> Name -> EmailAddress -> Role -> NewUserScimInvitation)
-> SchemaP
     SwaggerDoc Object [Pair] NewUserScimInvitation (Maybe Locale)
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     NewUserScimInvitation
     (Name -> EmailAddress -> Role -> NewUserScimInvitation)
forall a b.
SchemaP SwaggerDoc Object [Pair] NewUserScimInvitation (a -> b)
-> SchemaP SwaggerDoc Object [Pair] NewUserScimInvitation a
-> SchemaP SwaggerDoc Object [Pair] NewUserScimInvitation b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> NewUserScimInvitation -> Maybe Locale
newUserScimInvLocale (NewUserScimInvitation -> Maybe Locale)
-> SchemaP SwaggerDoc Object [Pair] (Maybe Locale) (Maybe Locale)
-> SchemaP
     SwaggerDoc Object [Pair] NewUserScimInvitation (Maybe Locale)
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
Schema..= SchemaP SwaggerDoc Object [Pair] Locale (Maybe Locale)
-> SchemaP SwaggerDoc Object [Pair] (Maybe Locale) (Maybe Locale)
forall w d v a b.
Monoid w =>
SchemaP d v w a b -> SchemaP d v w (Maybe a) b
maybe_ (Text
-> SchemaP NamedSwaggerDoc Value Value Locale Locale
-> SchemaP SwaggerDoc Object [Pair] Locale (Maybe Locale)
forall doc doc' a b.
(HasOpt doc, HasField doc' doc) =>
Text
-> SchemaP doc' Value Value a b
-> SchemaP doc Object [Pair] a (Maybe b)
optField Text
"locale" SchemaP NamedSwaggerDoc Value Value Locale Locale
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
Schema.schema)
        SchemaP
  SwaggerDoc
  Object
  [Pair]
  NewUserScimInvitation
  (Name -> EmailAddress -> Role -> NewUserScimInvitation)
-> SchemaP SwaggerDoc Object [Pair] NewUserScimInvitation Name
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     NewUserScimInvitation
     (EmailAddress -> Role -> NewUserScimInvitation)
forall a b.
SchemaP SwaggerDoc Object [Pair] NewUserScimInvitation (a -> b)
-> SchemaP SwaggerDoc Object [Pair] NewUserScimInvitation a
-> SchemaP SwaggerDoc Object [Pair] NewUserScimInvitation b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> NewUserScimInvitation -> Name
newUserScimInvName (NewUserScimInvitation -> Name)
-> SchemaP SwaggerDoc Object [Pair] Name Name
-> SchemaP SwaggerDoc Object [Pair] NewUserScimInvitation Name
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
Schema..= Text
-> SchemaP NamedSwaggerDoc Value Value Name Name
-> SchemaP SwaggerDoc Object [Pair] Name Name
forall doc' doc a b.
HasField doc' doc =>
Text
-> SchemaP doc' Value Value a b -> SchemaP doc Object [Pair] a b
Schema.field Text
"name" SchemaP NamedSwaggerDoc Value Value Name Name
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
Schema.schema
        SchemaP
  SwaggerDoc
  Object
  [Pair]
  NewUserScimInvitation
  (EmailAddress -> Role -> NewUserScimInvitation)
-> SchemaP
     SwaggerDoc Object [Pair] NewUserScimInvitation EmailAddress
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     NewUserScimInvitation
     (Role -> NewUserScimInvitation)
forall a b.
SchemaP SwaggerDoc Object [Pair] NewUserScimInvitation (a -> b)
-> SchemaP SwaggerDoc Object [Pair] NewUserScimInvitation a
-> SchemaP SwaggerDoc Object [Pair] NewUserScimInvitation b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> NewUserScimInvitation -> EmailAddress
newUserScimInvEmail (NewUserScimInvitation -> EmailAddress)
-> SchemaP SwaggerDoc Object [Pair] EmailAddress EmailAddress
-> SchemaP
     SwaggerDoc Object [Pair] NewUserScimInvitation EmailAddress
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
Schema..= Text
-> SchemaP NamedSwaggerDoc Value Value EmailAddress EmailAddress
-> SchemaP SwaggerDoc Object [Pair] EmailAddress EmailAddress
forall doc' doc a b.
HasField doc' doc =>
Text
-> SchemaP doc' Value Value a b -> SchemaP doc Object [Pair] a b
Schema.field Text
"email" SchemaP NamedSwaggerDoc Value Value EmailAddress EmailAddress
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
Schema.schema
        SchemaP
  SwaggerDoc
  Object
  [Pair]
  NewUserScimInvitation
  (Role -> NewUserScimInvitation)
-> SchemaP SwaggerDoc Object [Pair] NewUserScimInvitation Role
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     NewUserScimInvitation
     NewUserScimInvitation
forall a b.
SchemaP SwaggerDoc Object [Pair] NewUserScimInvitation (a -> b)
-> SchemaP SwaggerDoc Object [Pair] NewUserScimInvitation a
-> SchemaP SwaggerDoc Object [Pair] NewUserScimInvitation b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> NewUserScimInvitation -> Role
newUserScimInvRole (NewUserScimInvitation -> Role)
-> SchemaP SwaggerDoc Object [Pair] Role Role
-> SchemaP SwaggerDoc Object [Pair] NewUserScimInvitation Role
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
Schema..= Text
-> SchemaP NamedSwaggerDoc Value Value Role Role
-> SchemaP SwaggerDoc Object [Pair] Role Role
forall doc' doc a b.
HasField doc' doc =>
Text
-> SchemaP doc' Value Value a b -> SchemaP doc Object [Pair] a b
Schema.field Text
"role" SchemaP NamedSwaggerDoc Value Value Role Role
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
Schema.schema

-----------------------------------------------------------------------------
-- SndFactorPasswordChallenge

data VerificationAction
  = CreateScimToken
  | Login
  | DeleteTeam
  deriving stock (VerificationAction -> VerificationAction -> Bool
(VerificationAction -> VerificationAction -> Bool)
-> (VerificationAction -> VerificationAction -> Bool)
-> Eq VerificationAction
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: VerificationAction -> VerificationAction -> Bool
== :: VerificationAction -> VerificationAction -> Bool
$c/= :: VerificationAction -> VerificationAction -> Bool
/= :: VerificationAction -> VerificationAction -> Bool
Eq, Int -> VerificationAction -> ShowS
[VerificationAction] -> ShowS
VerificationAction -> String
(Int -> VerificationAction -> ShowS)
-> (VerificationAction -> String)
-> ([VerificationAction] -> ShowS)
-> Show VerificationAction
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> VerificationAction -> ShowS
showsPrec :: Int -> VerificationAction -> ShowS
$cshow :: VerificationAction -> String
show :: VerificationAction -> String
$cshowList :: [VerificationAction] -> ShowS
showList :: [VerificationAction] -> ShowS
Show, Int -> VerificationAction
VerificationAction -> Int
VerificationAction -> [VerificationAction]
VerificationAction -> VerificationAction
VerificationAction -> VerificationAction -> [VerificationAction]
VerificationAction
-> VerificationAction -> VerificationAction -> [VerificationAction]
(VerificationAction -> VerificationAction)
-> (VerificationAction -> VerificationAction)
-> (Int -> VerificationAction)
-> (VerificationAction -> Int)
-> (VerificationAction -> [VerificationAction])
-> (VerificationAction
    -> VerificationAction -> [VerificationAction])
-> (VerificationAction
    -> VerificationAction -> [VerificationAction])
-> (VerificationAction
    -> VerificationAction
    -> VerificationAction
    -> [VerificationAction])
-> Enum VerificationAction
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: VerificationAction -> VerificationAction
succ :: VerificationAction -> VerificationAction
$cpred :: VerificationAction -> VerificationAction
pred :: VerificationAction -> VerificationAction
$ctoEnum :: Int -> VerificationAction
toEnum :: Int -> VerificationAction
$cfromEnum :: VerificationAction -> Int
fromEnum :: VerificationAction -> Int
$cenumFrom :: VerificationAction -> [VerificationAction]
enumFrom :: VerificationAction -> [VerificationAction]
$cenumFromThen :: VerificationAction -> VerificationAction -> [VerificationAction]
enumFromThen :: VerificationAction -> VerificationAction -> [VerificationAction]
$cenumFromTo :: VerificationAction -> VerificationAction -> [VerificationAction]
enumFromTo :: VerificationAction -> VerificationAction -> [VerificationAction]
$cenumFromThenTo :: VerificationAction
-> VerificationAction -> VerificationAction -> [VerificationAction]
enumFromThenTo :: VerificationAction
-> VerificationAction -> VerificationAction -> [VerificationAction]
Enum, VerificationAction
VerificationAction
-> VerificationAction -> Bounded VerificationAction
forall a. a -> a -> Bounded a
$cminBound :: VerificationAction
minBound :: VerificationAction
$cmaxBound :: VerificationAction
maxBound :: VerificationAction
Bounded, (forall x. VerificationAction -> Rep VerificationAction x)
-> (forall x. Rep VerificationAction x -> VerificationAction)
-> Generic VerificationAction
forall x. Rep VerificationAction x -> VerificationAction
forall x. VerificationAction -> Rep VerificationAction x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. VerificationAction -> Rep VerificationAction x
from :: forall x. VerificationAction -> Rep VerificationAction x
$cto :: forall x. Rep VerificationAction x -> VerificationAction
to :: forall x. Rep VerificationAction x -> VerificationAction
Generic)
  deriving (Gen VerificationAction
Gen VerificationAction
-> (VerificationAction -> [VerificationAction])
-> Arbitrary VerificationAction
VerificationAction -> [VerificationAction]
forall a. Gen a -> (a -> [a]) -> Arbitrary a
$carbitrary :: Gen VerificationAction
arbitrary :: Gen VerificationAction
$cshrink :: VerificationAction -> [VerificationAction]
shrink :: VerificationAction -> [VerificationAction]
Arbitrary) via (GenericUniform VerificationAction)
  deriving (Value -> Parser [VerificationAction]
Value -> Parser VerificationAction
(Value -> Parser VerificationAction)
-> (Value -> Parser [VerificationAction])
-> FromJSON VerificationAction
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser VerificationAction
parseJSON :: Value -> Parser VerificationAction
$cparseJSONList :: Value -> Parser [VerificationAction]
parseJSONList :: Value -> Parser [VerificationAction]
FromJSON, [VerificationAction] -> Value
[VerificationAction] -> Encoding
VerificationAction -> Value
VerificationAction -> Encoding
(VerificationAction -> Value)
-> (VerificationAction -> Encoding)
-> ([VerificationAction] -> Value)
-> ([VerificationAction] -> Encoding)
-> ToJSON VerificationAction
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: VerificationAction -> Value
toJSON :: VerificationAction -> Value
$ctoEncoding :: VerificationAction -> Encoding
toEncoding :: VerificationAction -> Encoding
$ctoJSONList :: [VerificationAction] -> Value
toJSONList :: [VerificationAction] -> Value
$ctoEncodingList :: [VerificationAction] -> Encoding
toEncodingList :: [VerificationAction] -> Encoding
ToJSON, Typeable VerificationAction
Typeable VerificationAction =>
(Proxy VerificationAction
 -> Declare (Definitions Schema) NamedSchema)
-> ToSchema VerificationAction
Proxy VerificationAction
-> Declare (Definitions Schema) NamedSchema
forall a.
Typeable a =>
(Proxy a -> Declare (Definitions Schema) NamedSchema) -> ToSchema a
$cdeclareNamedSchema :: Proxy VerificationAction
-> Declare (Definitions Schema) NamedSchema
declareNamedSchema :: Proxy VerificationAction
-> Declare (Definitions Schema) NamedSchema
S.ToSchema) via (Schema VerificationAction)

instance ToSchema VerificationAction where
  schema :: ValueSchema NamedSwaggerDoc VerificationAction
schema =
    forall v doc a b.
(With v, HasEnum v doc) =>
Text
-> SchemaP [Value] v (Alt Maybe v) a b
-> SchemaP doc Value Value a b
enum @Text Text
"VerificationAction" (SchemaP
   [Value] Text (Alt Maybe Text) VerificationAction VerificationAction
 -> ValueSchema NamedSwaggerDoc VerificationAction)
-> SchemaP
     [Value] Text (Alt Maybe Text) VerificationAction VerificationAction
-> ValueSchema NamedSwaggerDoc VerificationAction
forall a b. (a -> b) -> a -> b
$
      [SchemaP
   [Value]
   Text
   (Alt Maybe Text)
   VerificationAction
   VerificationAction]
-> SchemaP
     [Value] Text (Alt Maybe Text) VerificationAction VerificationAction
forall a. Monoid a => [a] -> a
mconcat
        [ Text
-> VerificationAction
-> SchemaP
     [Value] Text (Alt Maybe Text) VerificationAction VerificationAction
forall a b.
(ToJSON a, Eq a, Eq b) =>
a -> b -> SchemaP [Value] a (Alt Maybe a) b b
element Text
"create_scim_token" VerificationAction
CreateScimToken,
          Text
-> VerificationAction
-> SchemaP
     [Value] Text (Alt Maybe Text) VerificationAction VerificationAction
forall a b.
(ToJSON a, Eq a, Eq b) =>
a -> b -> SchemaP [Value] a (Alt Maybe a) b b
element Text
"login" VerificationAction
Login,
          Text
-> VerificationAction
-> SchemaP
     [Value] Text (Alt Maybe Text) VerificationAction VerificationAction
forall a b.
(ToJSON a, Eq a, Eq b) =>
a -> b -> SchemaP [Value] a (Alt Maybe a) b b
element Text
"delete_team" VerificationAction
DeleteTeam
        ]

instance ToByteString VerificationAction where
  builder :: VerificationAction -> Builder
builder VerificationAction
CreateScimToken = Builder
"create_scim_token"
  builder VerificationAction
Login = Builder
"login"
  builder VerificationAction
DeleteTeam = Builder
"delete_team"

instance FromByteString VerificationAction where
  parser :: Parser VerificationAction
parser =
    Parser ByteString
Parser.takeByteString Parser ByteString
-> (ByteString -> Parser VerificationAction)
-> Parser VerificationAction
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
>>= \ByteString
b ->
      case ByteString -> Either UnicodeException Text
T.decodeUtf8' ByteString
b of
        Right Text
"login" -> VerificationAction -> Parser VerificationAction
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure VerificationAction
Login
        Right Text
"create_scim_token" -> VerificationAction -> Parser VerificationAction
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure VerificationAction
CreateScimToken
        Right Text
"delete_team" -> VerificationAction -> Parser VerificationAction
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure VerificationAction
DeleteTeam
        Right Text
t -> String -> Parser VerificationAction
forall a. String -> Parser ByteString a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser VerificationAction)
-> String -> Parser VerificationAction
forall a b. (a -> b) -> a -> b
$ String
"Invalid VerificationAction: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Text -> String
T.unpack Text
t
        Left UnicodeException
e -> String -> Parser VerificationAction
forall a. String -> Parser ByteString a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser VerificationAction)
-> String -> Parser VerificationAction
forall a b. (a -> b) -> a -> b
$ String
"Invalid VerificationAction: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> UnicodeException -> String
forall a. Show a => a -> String
show UnicodeException
e

instance S.ToParamSchema VerificationAction where
  toParamSchema :: Proxy VerificationAction -> Schema
toParamSchema Proxy VerificationAction
_ =
    Schema
forall a. Monoid a => a
mempty
      { S._schemaType = Just S.OpenApiString,
        S._schemaEnum = Just (A.String . toQueryParam <$> [(minBound :: VerificationAction) ..])
      }

instance FromHttpApiData VerificationAction where
  parseUrlPiece :: Text -> Either Text VerificationAction
parseUrlPiece =
    Text -> Maybe VerificationAction -> Either Text VerificationAction
forall a b. a -> Maybe b -> Either a b
maybeToEither Text
"Invalid verification action"
      (Maybe VerificationAction -> Either Text VerificationAction)
-> (Text -> Maybe VerificationAction)
-> Text
-> Either Text VerificationAction
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Maybe VerificationAction
forall a. FromByteString a => ByteString -> Maybe a
fromByteString
      (ByteString -> Maybe VerificationAction)
-> (Text -> ByteString) -> Text -> Maybe VerificationAction
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
T.encodeUtf8

instance ToHttpApiData VerificationAction where
  toQueryParam :: VerificationAction -> Text
toQueryParam VerificationAction
a = OnDecodeError -> ByteString -> Text
T.decodeUtf8With OnDecodeError
lenientDecode (VerificationAction -> ByteString
forall a. ToByteString a => a -> ByteString
toByteString' VerificationAction
a)

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

instance ToSchema SendVerificationCode where
  schema :: ValueSchema NamedSwaggerDoc SendVerificationCode
schema =
    Text
-> SchemaP
     SwaggerDoc Object [Pair] SendVerificationCode SendVerificationCode
-> ValueSchema NamedSwaggerDoc SendVerificationCode
forall doc doc' a b.
HasObject doc doc' =>
Text
-> SchemaP doc Object [Pair] a b -> SchemaP doc' Value Value a b
object Text
"SendVerificationCode" (SchemaP
   SwaggerDoc Object [Pair] SendVerificationCode SendVerificationCode
 -> ValueSchema NamedSwaggerDoc SendVerificationCode)
-> SchemaP
     SwaggerDoc Object [Pair] SendVerificationCode SendVerificationCode
-> ValueSchema NamedSwaggerDoc SendVerificationCode
forall a b. (a -> b) -> a -> b
$
      VerificationAction -> EmailAddress -> SendVerificationCode
SendVerificationCode
        (VerificationAction -> EmailAddress -> SendVerificationCode)
-> SchemaP
     SwaggerDoc Object [Pair] SendVerificationCode VerificationAction
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     SendVerificationCode
     (EmailAddress -> SendVerificationCode)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SendVerificationCode -> VerificationAction
svcAction
          (SendVerificationCode -> VerificationAction)
-> SchemaP
     SwaggerDoc Object [Pair] VerificationAction VerificationAction
-> SchemaP
     SwaggerDoc Object [Pair] SendVerificationCode VerificationAction
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= Text
-> ValueSchema NamedSwaggerDoc VerificationAction
-> SchemaP
     SwaggerDoc Object [Pair] VerificationAction VerificationAction
forall doc' doc a b.
HasField doc' doc =>
Text
-> SchemaP doc' Value Value a b -> SchemaP doc Object [Pair] a b
field Text
"action" ValueSchema NamedSwaggerDoc VerificationAction
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema
        SchemaP
  SwaggerDoc
  Object
  [Pair]
  SendVerificationCode
  (EmailAddress -> SendVerificationCode)
-> SchemaP
     SwaggerDoc Object [Pair] SendVerificationCode EmailAddress
-> SchemaP
     SwaggerDoc Object [Pair] SendVerificationCode SendVerificationCode
forall a b.
SchemaP SwaggerDoc Object [Pair] SendVerificationCode (a -> b)
-> SchemaP SwaggerDoc Object [Pair] SendVerificationCode a
-> SchemaP SwaggerDoc Object [Pair] SendVerificationCode b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> SendVerificationCode -> EmailAddress
svcEmail
          (SendVerificationCode -> EmailAddress)
-> SchemaP SwaggerDoc Object [Pair] EmailAddress EmailAddress
-> SchemaP
     SwaggerDoc Object [Pair] SendVerificationCode EmailAddress
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= Text
-> SchemaP NamedSwaggerDoc Value Value EmailAddress EmailAddress
-> SchemaP SwaggerDoc Object [Pair] EmailAddress EmailAddress
forall doc' doc a b.
HasField doc' doc =>
Text
-> SchemaP doc' Value Value a b -> SchemaP doc Object [Pair] a b
field Text
"email" SchemaP NamedSwaggerDoc Value Value EmailAddress EmailAddress
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema

--------------------------------------------------------------------------------
-- Protocol preferences

-- | High-level protocols supported by clients.
--
-- Unlike 'ProtocolTag', this does not include any transitional protocols used
-- for migration.
data BaseProtocolTag = BaseProtocolProteusTag | BaseProtocolMLSTag
  deriving stock (BaseProtocolTag -> BaseProtocolTag -> Bool
(BaseProtocolTag -> BaseProtocolTag -> Bool)
-> (BaseProtocolTag -> BaseProtocolTag -> Bool)
-> Eq BaseProtocolTag
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: BaseProtocolTag -> BaseProtocolTag -> Bool
== :: BaseProtocolTag -> BaseProtocolTag -> Bool
$c/= :: BaseProtocolTag -> BaseProtocolTag -> Bool
/= :: BaseProtocolTag -> BaseProtocolTag -> Bool
Eq, Eq BaseProtocolTag
Eq BaseProtocolTag =>
(BaseProtocolTag -> BaseProtocolTag -> Ordering)
-> (BaseProtocolTag -> BaseProtocolTag -> Bool)
-> (BaseProtocolTag -> BaseProtocolTag -> Bool)
-> (BaseProtocolTag -> BaseProtocolTag -> Bool)
-> (BaseProtocolTag -> BaseProtocolTag -> Bool)
-> (BaseProtocolTag -> BaseProtocolTag -> BaseProtocolTag)
-> (BaseProtocolTag -> BaseProtocolTag -> BaseProtocolTag)
-> Ord BaseProtocolTag
BaseProtocolTag -> BaseProtocolTag -> Bool
BaseProtocolTag -> BaseProtocolTag -> Ordering
BaseProtocolTag -> BaseProtocolTag -> BaseProtocolTag
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 :: BaseProtocolTag -> BaseProtocolTag -> Ordering
compare :: BaseProtocolTag -> BaseProtocolTag -> Ordering
$c< :: BaseProtocolTag -> BaseProtocolTag -> Bool
< :: BaseProtocolTag -> BaseProtocolTag -> Bool
$c<= :: BaseProtocolTag -> BaseProtocolTag -> Bool
<= :: BaseProtocolTag -> BaseProtocolTag -> Bool
$c> :: BaseProtocolTag -> BaseProtocolTag -> Bool
> :: BaseProtocolTag -> BaseProtocolTag -> Bool
$c>= :: BaseProtocolTag -> BaseProtocolTag -> Bool
>= :: BaseProtocolTag -> BaseProtocolTag -> Bool
$cmax :: BaseProtocolTag -> BaseProtocolTag -> BaseProtocolTag
max :: BaseProtocolTag -> BaseProtocolTag -> BaseProtocolTag
$cmin :: BaseProtocolTag -> BaseProtocolTag -> BaseProtocolTag
min :: BaseProtocolTag -> BaseProtocolTag -> BaseProtocolTag
Ord, Int -> BaseProtocolTag
BaseProtocolTag -> Int
BaseProtocolTag -> [BaseProtocolTag]
BaseProtocolTag -> BaseProtocolTag
BaseProtocolTag -> BaseProtocolTag -> [BaseProtocolTag]
BaseProtocolTag
-> BaseProtocolTag -> BaseProtocolTag -> [BaseProtocolTag]
(BaseProtocolTag -> BaseProtocolTag)
-> (BaseProtocolTag -> BaseProtocolTag)
-> (Int -> BaseProtocolTag)
-> (BaseProtocolTag -> Int)
-> (BaseProtocolTag -> [BaseProtocolTag])
-> (BaseProtocolTag -> BaseProtocolTag -> [BaseProtocolTag])
-> (BaseProtocolTag -> BaseProtocolTag -> [BaseProtocolTag])
-> (BaseProtocolTag
    -> BaseProtocolTag -> BaseProtocolTag -> [BaseProtocolTag])
-> Enum BaseProtocolTag
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: BaseProtocolTag -> BaseProtocolTag
succ :: BaseProtocolTag -> BaseProtocolTag
$cpred :: BaseProtocolTag -> BaseProtocolTag
pred :: BaseProtocolTag -> BaseProtocolTag
$ctoEnum :: Int -> BaseProtocolTag
toEnum :: Int -> BaseProtocolTag
$cfromEnum :: BaseProtocolTag -> Int
fromEnum :: BaseProtocolTag -> Int
$cenumFrom :: BaseProtocolTag -> [BaseProtocolTag]
enumFrom :: BaseProtocolTag -> [BaseProtocolTag]
$cenumFromThen :: BaseProtocolTag -> BaseProtocolTag -> [BaseProtocolTag]
enumFromThen :: BaseProtocolTag -> BaseProtocolTag -> [BaseProtocolTag]
$cenumFromTo :: BaseProtocolTag -> BaseProtocolTag -> [BaseProtocolTag]
enumFromTo :: BaseProtocolTag -> BaseProtocolTag -> [BaseProtocolTag]
$cenumFromThenTo :: BaseProtocolTag
-> BaseProtocolTag -> BaseProtocolTag -> [BaseProtocolTag]
enumFromThenTo :: BaseProtocolTag
-> BaseProtocolTag -> BaseProtocolTag -> [BaseProtocolTag]
Enum, BaseProtocolTag
BaseProtocolTag -> BaseProtocolTag -> Bounded BaseProtocolTag
forall a. a -> a -> Bounded a
$cminBound :: BaseProtocolTag
minBound :: BaseProtocolTag
$cmaxBound :: BaseProtocolTag
maxBound :: BaseProtocolTag
Bounded, Int -> BaseProtocolTag -> ShowS
[BaseProtocolTag] -> ShowS
BaseProtocolTag -> String
(Int -> BaseProtocolTag -> ShowS)
-> (BaseProtocolTag -> String)
-> ([BaseProtocolTag] -> ShowS)
-> Show BaseProtocolTag
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> BaseProtocolTag -> ShowS
showsPrec :: Int -> BaseProtocolTag -> ShowS
$cshow :: BaseProtocolTag -> String
show :: BaseProtocolTag -> String
$cshowList :: [BaseProtocolTag] -> ShowS
showList :: [BaseProtocolTag] -> ShowS
Show, (forall x. BaseProtocolTag -> Rep BaseProtocolTag x)
-> (forall x. Rep BaseProtocolTag x -> BaseProtocolTag)
-> Generic BaseProtocolTag
forall x. Rep BaseProtocolTag x -> BaseProtocolTag
forall x. BaseProtocolTag -> Rep BaseProtocolTag x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. BaseProtocolTag -> Rep BaseProtocolTag x
from :: forall x. BaseProtocolTag -> Rep BaseProtocolTag x
$cto :: forall x. Rep BaseProtocolTag x -> BaseProtocolTag
to :: forall x. Rep BaseProtocolTag x -> BaseProtocolTag
Generic)
  deriving (Gen BaseProtocolTag
Gen BaseProtocolTag
-> (BaseProtocolTag -> [BaseProtocolTag])
-> Arbitrary BaseProtocolTag
BaseProtocolTag -> [BaseProtocolTag]
forall a. Gen a -> (a -> [a]) -> Arbitrary a
$carbitrary :: Gen BaseProtocolTag
arbitrary :: Gen BaseProtocolTag
$cshrink :: BaseProtocolTag -> [BaseProtocolTag]
shrink :: BaseProtocolTag -> [BaseProtocolTag]
Arbitrary) via (GenericUniform BaseProtocolTag)
  deriving (Value -> Parser [BaseProtocolTag]
Value -> Parser BaseProtocolTag
(Value -> Parser BaseProtocolTag)
-> (Value -> Parser [BaseProtocolTag]) -> FromJSON BaseProtocolTag
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser BaseProtocolTag
parseJSON :: Value -> Parser BaseProtocolTag
$cparseJSONList :: Value -> Parser [BaseProtocolTag]
parseJSONList :: Value -> Parser [BaseProtocolTag]
FromJSON, [BaseProtocolTag] -> Value
[BaseProtocolTag] -> Encoding
BaseProtocolTag -> Value
BaseProtocolTag -> Encoding
(BaseProtocolTag -> Value)
-> (BaseProtocolTag -> Encoding)
-> ([BaseProtocolTag] -> Value)
-> ([BaseProtocolTag] -> Encoding)
-> ToJSON BaseProtocolTag
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: BaseProtocolTag -> Value
toJSON :: BaseProtocolTag -> Value
$ctoEncoding :: BaseProtocolTag -> Encoding
toEncoding :: BaseProtocolTag -> Encoding
$ctoJSONList :: [BaseProtocolTag] -> Value
toJSONList :: [BaseProtocolTag] -> Value
$ctoEncodingList :: [BaseProtocolTag] -> Encoding
toEncodingList :: [BaseProtocolTag] -> Encoding
ToJSON, Typeable BaseProtocolTag
Typeable BaseProtocolTag =>
(Proxy BaseProtocolTag -> Declare (Definitions Schema) NamedSchema)
-> ToSchema BaseProtocolTag
Proxy BaseProtocolTag -> Declare (Definitions Schema) NamedSchema
forall a.
Typeable a =>
(Proxy a -> Declare (Definitions Schema) NamedSchema) -> ToSchema a
$cdeclareNamedSchema :: Proxy BaseProtocolTag -> Declare (Definitions Schema) NamedSchema
declareNamedSchema :: Proxy BaseProtocolTag -> Declare (Definitions Schema) NamedSchema
S.ToSchema) via (Schema BaseProtocolTag)

instance C.Cql (Imports.Set BaseProtocolTag) where
  ctype :: Tagged (Set BaseProtocolTag) ColumnType
ctype = ColumnType -> Tagged (Set BaseProtocolTag) ColumnType
forall a b. b -> Tagged a b
C.Tagged ColumnType
C.IntColumn

  toCql :: Set BaseProtocolTag -> Value
toCql = Int32 -> Value
C.CqlInt (Int32 -> Value)
-> (Set BaseProtocolTag -> Int32) -> Set BaseProtocolTag -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word32 -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> Int32)
-> (Set BaseProtocolTag -> Word32) -> Set BaseProtocolTag -> Int32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set BaseProtocolTag -> Word32
protocolSetBits
  fromCql :: Value -> Either String (Set BaseProtocolTag)
fromCql (C.CqlInt Int32
bits) = Set BaseProtocolTag -> Either String (Set BaseProtocolTag)
forall a. a -> Either String a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Set BaseProtocolTag -> Either String (Set BaseProtocolTag))
-> Set BaseProtocolTag -> Either String (Set BaseProtocolTag)
forall a b. (a -> b) -> a -> b
$ Word32 -> Set BaseProtocolTag
protocolSetFromBits (Int32 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int32
bits)
  fromCql Value
_ = String -> Either String (Set BaseProtocolTag)
forall a b. a -> Either a b
Left String
"Protocol set: Int expected"

baseProtocolMask :: BaseProtocolTag -> Word32
baseProtocolMask :: BaseProtocolTag -> Word32
baseProtocolMask BaseProtocolTag
BaseProtocolProteusTag = Word32
1
baseProtocolMask BaseProtocolTag
BaseProtocolMLSTag = Word32
2

baseProtocolToProtocol :: BaseProtocolTag -> ProtocolTag
baseProtocolToProtocol :: BaseProtocolTag -> ProtocolTag
baseProtocolToProtocol BaseProtocolTag
BaseProtocolProteusTag = ProtocolTag
ProtocolProteusTag
baseProtocolToProtocol BaseProtocolTag
BaseProtocolMLSTag = ProtocolTag
ProtocolMLSTag

instance ToSchema BaseProtocolTag where
  schema :: ValueSchema NamedSwaggerDoc BaseProtocolTag
schema =
    forall v doc a b.
(With v, HasEnum v doc) =>
Text
-> SchemaP [Value] v (Alt Maybe v) a b
-> SchemaP doc Value Value a b
enum @Text Text
"BaseProtocol" (SchemaP
   [Value] Text (Alt Maybe Text) BaseProtocolTag BaseProtocolTag
 -> ValueSchema NamedSwaggerDoc BaseProtocolTag)
-> SchemaP
     [Value] Text (Alt Maybe Text) BaseProtocolTag BaseProtocolTag
-> ValueSchema NamedSwaggerDoc BaseProtocolTag
forall a b. (a -> b) -> a -> b
$
      [SchemaP
   [Value] Text (Alt Maybe Text) BaseProtocolTag BaseProtocolTag]
-> SchemaP
     [Value] Text (Alt Maybe Text) BaseProtocolTag BaseProtocolTag
forall a. Monoid a => [a] -> a
mconcat
        [ Text
-> BaseProtocolTag
-> SchemaP
     [Value] Text (Alt Maybe Text) BaseProtocolTag BaseProtocolTag
forall a b.
(ToJSON a, Eq a, Eq b) =>
a -> b -> SchemaP [Value] a (Alt Maybe a) b b
element Text
"proteus" BaseProtocolTag
BaseProtocolProteusTag,
          Text
-> BaseProtocolTag
-> SchemaP
     [Value] Text (Alt Maybe Text) BaseProtocolTag BaseProtocolTag
forall a b.
(ToJSON a, Eq a, Eq b) =>
a -> b -> SchemaP [Value] a (Alt Maybe a) b b
element Text
"mls" BaseProtocolTag
BaseProtocolMLSTag
        ]

defSupportedProtocols :: Set BaseProtocolTag
defSupportedProtocols :: Set BaseProtocolTag
defSupportedProtocols = BaseProtocolTag -> Set BaseProtocolTag
forall a. a -> Set a
Set.singleton BaseProtocolTag
BaseProtocolProteusTag

supportedProtocolsObjectSchema :: ObjectSchema SwaggerDoc (Set BaseProtocolTag)
supportedProtocolsObjectSchema :: SchemaP
  SwaggerDoc
  Object
  [Pair]
  (Set BaseProtocolTag)
  (Set BaseProtocolTag)
supportedProtocolsObjectSchema =
  (Maybe (Set BaseProtocolTag) -> Set BaseProtocolTag)
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     (Set BaseProtocolTag)
     (Maybe (Set BaseProtocolTag))
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     (Set BaseProtocolTag)
     (Set BaseProtocolTag)
forall a b.
(a -> b)
-> SchemaP SwaggerDoc Object [Pair] (Set BaseProtocolTag) a
-> SchemaP SwaggerDoc Object [Pair] (Set BaseProtocolTag) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
    (Set BaseProtocolTag
-> Maybe (Set BaseProtocolTag) -> Set BaseProtocolTag
forall a. a -> Maybe a -> a
fromMaybe Set BaseProtocolTag
defSupportedProtocols)
    (Text
-> SchemaP
     SwaggerDoc Value Value (Set BaseProtocolTag) (Set BaseProtocolTag)
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     (Set BaseProtocolTag)
     (Maybe (Set BaseProtocolTag))
forall doc doc' a b.
(HasOpt doc, HasField doc' doc) =>
Text
-> SchemaP doc' Value Value a b
-> SchemaP doc Object [Pair] a (Maybe b)
optField Text
"supported_protocols" (ValueSchema NamedSwaggerDoc BaseProtocolTag
-> SchemaP
     SwaggerDoc Value Value (Set BaseProtocolTag) (Set BaseProtocolTag)
forall ndoc doc a.
(HasArray ndoc doc, HasName ndoc, Ord a) =>
ValueSchema ndoc a -> ValueSchema doc (Set a)
set ValueSchema NamedSwaggerDoc BaseProtocolTag
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema))

protocolSetBits :: Set BaseProtocolTag -> Word32
protocolSetBits :: Set BaseProtocolTag -> Word32
protocolSetBits = (BaseProtocolTag -> Word32 -> Word32)
-> Word32 -> Set BaseProtocolTag -> Word32
forall a b. (a -> b -> b) -> b -> Set a -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\BaseProtocolTag
p Word32
x -> BaseProtocolTag -> Word32
baseProtocolMask BaseProtocolTag
p Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.|. Word32
x) Word32
0

protocolSetFromBits :: Word32 -> Set BaseProtocolTag
protocolSetFromBits :: Word32 -> Set BaseProtocolTag
protocolSetFromBits Word32
w =
  (BaseProtocolTag -> Set BaseProtocolTag -> Set BaseProtocolTag)
-> Set BaseProtocolTag -> [BaseProtocolTag] -> Set BaseProtocolTag
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr
    (\BaseProtocolTag
x -> if Word32
w Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.&. BaseProtocolTag -> Word32
baseProtocolMask BaseProtocolTag
x Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word32
0 then BaseProtocolTag -> Set BaseProtocolTag -> Set BaseProtocolTag
forall a. Ord a => a -> Set a -> Set a
Set.insert BaseProtocolTag
x else Set BaseProtocolTag -> Set BaseProtocolTag
forall a. a -> a
id)
    Set BaseProtocolTag
forall a. Monoid a => a
mempty
    [BaseProtocolTag
BaseProtocolProteusTag, BaseProtocolTag
BaseProtocolMLSTag]

newtype SupportedProtocolUpdate = SupportedProtocolUpdate
  {SupportedProtocolUpdate -> Set BaseProtocolTag
unSupportedProtocolUpdate :: Set BaseProtocolTag}
  deriving stock (SupportedProtocolUpdate -> SupportedProtocolUpdate -> Bool
(SupportedProtocolUpdate -> SupportedProtocolUpdate -> Bool)
-> (SupportedProtocolUpdate -> SupportedProtocolUpdate -> Bool)
-> Eq SupportedProtocolUpdate
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SupportedProtocolUpdate -> SupportedProtocolUpdate -> Bool
== :: SupportedProtocolUpdate -> SupportedProtocolUpdate -> Bool
$c/= :: SupportedProtocolUpdate -> SupportedProtocolUpdate -> Bool
/= :: SupportedProtocolUpdate -> SupportedProtocolUpdate -> Bool
Eq, Int -> SupportedProtocolUpdate -> ShowS
[SupportedProtocolUpdate] -> ShowS
SupportedProtocolUpdate -> String
(Int -> SupportedProtocolUpdate -> ShowS)
-> (SupportedProtocolUpdate -> String)
-> ([SupportedProtocolUpdate] -> ShowS)
-> Show SupportedProtocolUpdate
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SupportedProtocolUpdate -> ShowS
showsPrec :: Int -> SupportedProtocolUpdate -> ShowS
$cshow :: SupportedProtocolUpdate -> String
show :: SupportedProtocolUpdate -> String
$cshowList :: [SupportedProtocolUpdate] -> ShowS
showList :: [SupportedProtocolUpdate] -> ShowS
Show)
  deriving (Value -> Parser [SupportedProtocolUpdate]
Value -> Parser SupportedProtocolUpdate
(Value -> Parser SupportedProtocolUpdate)
-> (Value -> Parser [SupportedProtocolUpdate])
-> FromJSON SupportedProtocolUpdate
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser SupportedProtocolUpdate
parseJSON :: Value -> Parser SupportedProtocolUpdate
$cparseJSONList :: Value -> Parser [SupportedProtocolUpdate]
parseJSONList :: Value -> Parser [SupportedProtocolUpdate]
FromJSON, [SupportedProtocolUpdate] -> Value
[SupportedProtocolUpdate] -> Encoding
SupportedProtocolUpdate -> Value
SupportedProtocolUpdate -> Encoding
(SupportedProtocolUpdate -> Value)
-> (SupportedProtocolUpdate -> Encoding)
-> ([SupportedProtocolUpdate] -> Value)
-> ([SupportedProtocolUpdate] -> Encoding)
-> ToJSON SupportedProtocolUpdate
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: SupportedProtocolUpdate -> Value
toJSON :: SupportedProtocolUpdate -> Value
$ctoEncoding :: SupportedProtocolUpdate -> Encoding
toEncoding :: SupportedProtocolUpdate -> Encoding
$ctoJSONList :: [SupportedProtocolUpdate] -> Value
toJSONList :: [SupportedProtocolUpdate] -> Value
$ctoEncodingList :: [SupportedProtocolUpdate] -> Encoding
toEncodingList :: [SupportedProtocolUpdate] -> Encoding
ToJSON, Typeable SupportedProtocolUpdate
Typeable SupportedProtocolUpdate =>
(Proxy SupportedProtocolUpdate
 -> Declare (Definitions Schema) NamedSchema)
-> ToSchema SupportedProtocolUpdate
Proxy SupportedProtocolUpdate
-> Declare (Definitions Schema) NamedSchema
forall a.
Typeable a =>
(Proxy a -> Declare (Definitions Schema) NamedSchema) -> ToSchema a
$cdeclareNamedSchema :: Proxy SupportedProtocolUpdate
-> Declare (Definitions Schema) NamedSchema
declareNamedSchema :: Proxy SupportedProtocolUpdate
-> Declare (Definitions Schema) NamedSchema
S.ToSchema) via (Schema SupportedProtocolUpdate)

instance ToSchema SupportedProtocolUpdate where
  schema :: ValueSchema NamedSwaggerDoc SupportedProtocolUpdate
schema =
    Text
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     SupportedProtocolUpdate
     SupportedProtocolUpdate
-> ValueSchema NamedSwaggerDoc SupportedProtocolUpdate
forall doc doc' a b.
HasObject doc doc' =>
Text
-> SchemaP doc Object [Pair] a b -> SchemaP doc' Value Value a b
object Text
"SupportedProtocolUpdate" (SchemaP
   SwaggerDoc
   Object
   [Pair]
   SupportedProtocolUpdate
   SupportedProtocolUpdate
 -> ValueSchema NamedSwaggerDoc SupportedProtocolUpdate)
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     SupportedProtocolUpdate
     SupportedProtocolUpdate
-> ValueSchema NamedSwaggerDoc SupportedProtocolUpdate
forall a b. (a -> b) -> a -> b
$
      Set BaseProtocolTag -> SupportedProtocolUpdate
SupportedProtocolUpdate
        (Set BaseProtocolTag -> SupportedProtocolUpdate)
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     SupportedProtocolUpdate
     (Set BaseProtocolTag)
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     SupportedProtocolUpdate
     SupportedProtocolUpdate
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SupportedProtocolUpdate -> Set BaseProtocolTag
unSupportedProtocolUpdate
          (SupportedProtocolUpdate -> Set BaseProtocolTag)
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     (Set BaseProtocolTag)
     (Set BaseProtocolTag)
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     SupportedProtocolUpdate
     (Set BaseProtocolTag)
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= Text
-> SchemaP
     SwaggerDoc Value Value (Set BaseProtocolTag) (Set BaseProtocolTag)
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     (Set BaseProtocolTag)
     (Set BaseProtocolTag)
forall doc' doc a b.
HasField doc' doc =>
Text
-> SchemaP doc' Value Value a b -> SchemaP doc Object [Pair] a b
field Text
"supported_protocols" (ValueSchema NamedSwaggerDoc BaseProtocolTag
-> SchemaP
     SwaggerDoc Value Value (Set BaseProtocolTag) (Set BaseProtocolTag)
forall ndoc doc a.
(HasArray ndoc doc, HasName ndoc, Ord a) =>
ValueSchema ndoc a -> ValueSchema doc (Set a)
set ValueSchema NamedSwaggerDoc BaseProtocolTag
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema)

------- Partial Successes
data ListUsersById = ListUsersById
  { ListUsersById -> [UserProfile]
listUsersByIdFound :: [UserProfile],
    ListUsersById -> Maybe (NonEmpty (Qualified UserId))
listUsersByIdFailed :: Maybe (NonEmpty (Qualified UserId))
  }
  deriving (ListUsersById -> ListUsersById -> Bool
(ListUsersById -> ListUsersById -> Bool)
-> (ListUsersById -> ListUsersById -> Bool) -> Eq ListUsersById
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ListUsersById -> ListUsersById -> Bool
== :: ListUsersById -> ListUsersById -> Bool
$c/= :: ListUsersById -> ListUsersById -> Bool
/= :: ListUsersById -> ListUsersById -> Bool
Eq, Int -> ListUsersById -> ShowS
[ListUsersById] -> ShowS
ListUsersById -> String
(Int -> ListUsersById -> ShowS)
-> (ListUsersById -> String)
-> ([ListUsersById] -> ShowS)
-> Show ListUsersById
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ListUsersById -> ShowS
showsPrec :: Int -> ListUsersById -> ShowS
$cshow :: ListUsersById -> String
show :: ListUsersById -> String
$cshowList :: [ListUsersById] -> ShowS
showList :: [ListUsersById] -> ShowS
Show)
  deriving ([ListUsersById] -> Value
[ListUsersById] -> Encoding
ListUsersById -> Value
ListUsersById -> Encoding
(ListUsersById -> Value)
-> (ListUsersById -> Encoding)
-> ([ListUsersById] -> Value)
-> ([ListUsersById] -> Encoding)
-> ToJSON ListUsersById
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: ListUsersById -> Value
toJSON :: ListUsersById -> Value
$ctoEncoding :: ListUsersById -> Encoding
toEncoding :: ListUsersById -> Encoding
$ctoJSONList :: [ListUsersById] -> Value
toJSONList :: [ListUsersById] -> Value
$ctoEncodingList :: [ListUsersById] -> Encoding
toEncodingList :: [ListUsersById] -> Encoding
ToJSON, Value -> Parser [ListUsersById]
Value -> Parser ListUsersById
(Value -> Parser ListUsersById)
-> (Value -> Parser [ListUsersById]) -> FromJSON ListUsersById
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser ListUsersById
parseJSON :: Value -> Parser ListUsersById
$cparseJSONList :: Value -> Parser [ListUsersById]
parseJSONList :: Value -> Parser [ListUsersById]
FromJSON, Typeable ListUsersById
Typeable ListUsersById =>
(Proxy ListUsersById -> Declare (Definitions Schema) NamedSchema)
-> ToSchema ListUsersById
Proxy ListUsersById -> Declare (Definitions Schema) NamedSchema
forall a.
Typeable a =>
(Proxy a -> Declare (Definitions Schema) NamedSchema) -> ToSchema a
$cdeclareNamedSchema :: Proxy ListUsersById -> Declare (Definitions Schema) NamedSchema
declareNamedSchema :: Proxy ListUsersById -> Declare (Definitions Schema) NamedSchema
S.ToSchema) via Schema ListUsersById

instance ToSchema ListUsersById where
  schema :: ValueSchema NamedSwaggerDoc ListUsersById
schema =
    Text
-> SchemaP SwaggerDoc Object [Pair] ListUsersById ListUsersById
-> ValueSchema NamedSwaggerDoc ListUsersById
forall doc doc' a b.
HasObject doc doc' =>
Text
-> SchemaP doc Object [Pair] a b -> SchemaP doc' Value Value a b
object Text
"ListUsersById" (SchemaP SwaggerDoc Object [Pair] ListUsersById ListUsersById
 -> ValueSchema NamedSwaggerDoc ListUsersById)
-> SchemaP SwaggerDoc Object [Pair] ListUsersById ListUsersById
-> ValueSchema NamedSwaggerDoc ListUsersById
forall a b. (a -> b) -> a -> b
$
      [UserProfile]
-> Maybe (NonEmpty (Qualified UserId)) -> ListUsersById
ListUsersById
        ([UserProfile]
 -> Maybe (NonEmpty (Qualified UserId)) -> ListUsersById)
-> SchemaP SwaggerDoc Object [Pair] ListUsersById [UserProfile]
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     ListUsersById
     (Maybe (NonEmpty (Qualified UserId)) -> ListUsersById)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ListUsersById -> [UserProfile]
listUsersByIdFound (ListUsersById -> [UserProfile])
-> SchemaP SwaggerDoc Object [Pair] [UserProfile] [UserProfile]
-> SchemaP SwaggerDoc Object [Pair] ListUsersById [UserProfile]
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= Text
-> SchemaP SwaggerDoc Value Value [UserProfile] [UserProfile]
-> SchemaP SwaggerDoc Object [Pair] [UserProfile] [UserProfile]
forall doc' doc a b.
HasField doc' doc =>
Text
-> SchemaP doc' Value Value a b -> SchemaP doc Object [Pair] a b
field Text
"found" (ValueSchema NamedSwaggerDoc UserProfile
-> SchemaP SwaggerDoc Value Value [UserProfile] [UserProfile]
forall ndoc doc a.
(HasArray ndoc doc, HasName ndoc) =>
ValueSchema ndoc a -> ValueSchema doc [a]
array ValueSchema NamedSwaggerDoc UserProfile
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema)
        SchemaP
  SwaggerDoc
  Object
  [Pair]
  ListUsersById
  (Maybe (NonEmpty (Qualified UserId)) -> ListUsersById)
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     ListUsersById
     (Maybe (NonEmpty (Qualified UserId)))
-> SchemaP SwaggerDoc Object [Pair] ListUsersById ListUsersById
forall a b.
SchemaP SwaggerDoc Object [Pair] ListUsersById (a -> b)
-> SchemaP SwaggerDoc Object [Pair] ListUsersById a
-> SchemaP SwaggerDoc Object [Pair] ListUsersById b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ListUsersById -> Maybe (NonEmpty (Qualified UserId))
listUsersByIdFailed (ListUsersById -> Maybe (NonEmpty (Qualified UserId)))
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     (Maybe (NonEmpty (Qualified UserId)))
     (Maybe (NonEmpty (Qualified UserId)))
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     ListUsersById
     (Maybe (NonEmpty (Qualified UserId)))
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= SchemaP
  SwaggerDoc
  Object
  [Pair]
  (NonEmpty (Qualified UserId))
  (Maybe (NonEmpty (Qualified UserId)))
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     (Maybe (NonEmpty (Qualified UserId)))
     (Maybe (NonEmpty (Qualified UserId)))
forall w d v a b.
Monoid w =>
SchemaP d v w a b -> SchemaP d v w (Maybe a) b
maybe_ (Text
-> SchemaP
     SwaggerDoc
     Value
     Value
     (NonEmpty (Qualified UserId))
     (NonEmpty (Qualified UserId))
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     (NonEmpty (Qualified UserId))
     (Maybe (NonEmpty (Qualified UserId)))
forall doc doc' a b.
(HasOpt doc, HasField doc' doc) =>
Text
-> SchemaP doc' Value Value a b
-> SchemaP doc Object [Pair] a (Maybe b)
optField Text
"failed" (SchemaP
   SwaggerDoc
   Value
   Value
   (NonEmpty (Qualified UserId))
   (NonEmpty (Qualified UserId))
 -> SchemaP
      SwaggerDoc
      Object
      [Pair]
      (NonEmpty (Qualified UserId))
      (Maybe (NonEmpty (Qualified UserId))))
-> SchemaP
     SwaggerDoc
     Value
     Value
     (NonEmpty (Qualified UserId))
     (NonEmpty (Qualified UserId))
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     (NonEmpty (Qualified UserId))
     (Maybe (NonEmpty (Qualified UserId)))
forall a b. (a -> b) -> a -> b
$ SchemaP
  NamedSwaggerDoc Value Value (Qualified UserId) (Qualified UserId)
-> SchemaP
     SwaggerDoc
     Value
     Value
     (NonEmpty (Qualified UserId))
     (NonEmpty (Qualified UserId))
forall ndoc doc a.
(HasArray ndoc doc, HasName ndoc,
 HasMinItems doc (Maybe Integer)) =>
ValueSchema ndoc a -> ValueSchema doc (NonEmpty a)
nonEmptyArray SchemaP
  NamedSwaggerDoc Value Value (Qualified UserId) (Qualified UserId)
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema)