{-# LANGUAGE StrictData #-}

-- 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.Team.LegalHold
  ( NewLegalHoldService (..),
    ViewLegalHoldService (..),
    ViewLegalHoldServiceInfo (..),
    UserLegalHoldStatusResponse (..),
    RemoveLegalHoldSettingsRequest (..),
    DisableLegalHoldForUserRequest (..),
    ApproveLegalHoldForUserRequest (..),
    LegalholdProtectee (..),
  )
where

import Control.Lens (at, (?~))
import Data.Aeson qualified as A
import Data.Aeson.Types qualified as A
import Data.Id
import Data.LegalHold
import Data.Misc
import Data.OpenApi qualified as S hiding (info)
import Data.Proxy
import Data.Schema
import Deriving.Aeson
import Imports
import Wire.API.Provider
import Wire.API.Provider.Service (ServiceKeyPEM)
import Wire.API.User.Client.Prekey
import Wire.Arbitrary (Arbitrary, GenericUniform (..))

--------------------------------------------------------------------------------
-- NewLegalHoldService

-- | This type is analogous to 'NewService' for bots.
data NewLegalHoldService = NewLegalHoldService
  { NewLegalHoldService -> HttpsUrl
newLegalHoldServiceUrl :: HttpsUrl,
    NewLegalHoldService -> ServiceKeyPEM
newLegalHoldServiceKey :: ServiceKeyPEM,
    NewLegalHoldService -> ServiceToken
newLegalHoldServiceToken :: ServiceToken
  }
  deriving stock (NewLegalHoldService -> NewLegalHoldService -> Bool
(NewLegalHoldService -> NewLegalHoldService -> Bool)
-> (NewLegalHoldService -> NewLegalHoldService -> Bool)
-> Eq NewLegalHoldService
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: NewLegalHoldService -> NewLegalHoldService -> Bool
== :: NewLegalHoldService -> NewLegalHoldService -> Bool
$c/= :: NewLegalHoldService -> NewLegalHoldService -> Bool
/= :: NewLegalHoldService -> NewLegalHoldService -> Bool
Eq, Int -> NewLegalHoldService -> ShowS
[NewLegalHoldService] -> ShowS
NewLegalHoldService -> String
(Int -> NewLegalHoldService -> ShowS)
-> (NewLegalHoldService -> String)
-> ([NewLegalHoldService] -> ShowS)
-> Show NewLegalHoldService
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> NewLegalHoldService -> ShowS
showsPrec :: Int -> NewLegalHoldService -> ShowS
$cshow :: NewLegalHoldService -> String
show :: NewLegalHoldService -> String
$cshowList :: [NewLegalHoldService] -> ShowS
showList :: [NewLegalHoldService] -> ShowS
Show, (forall x. NewLegalHoldService -> Rep NewLegalHoldService x)
-> (forall x. Rep NewLegalHoldService x -> NewLegalHoldService)
-> Generic NewLegalHoldService
forall x. Rep NewLegalHoldService x -> NewLegalHoldService
forall x. NewLegalHoldService -> Rep NewLegalHoldService x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. NewLegalHoldService -> Rep NewLegalHoldService x
from :: forall x. NewLegalHoldService -> Rep NewLegalHoldService x
$cto :: forall x. Rep NewLegalHoldService x -> NewLegalHoldService
to :: forall x. Rep NewLegalHoldService x -> NewLegalHoldService
Generic)
  deriving (Gen NewLegalHoldService
Gen NewLegalHoldService
-> (NewLegalHoldService -> [NewLegalHoldService])
-> Arbitrary NewLegalHoldService
NewLegalHoldService -> [NewLegalHoldService]
forall a. Gen a -> (a -> [a]) -> Arbitrary a
$carbitrary :: Gen NewLegalHoldService
arbitrary :: Gen NewLegalHoldService
$cshrink :: NewLegalHoldService -> [NewLegalHoldService]
shrink :: NewLegalHoldService -> [NewLegalHoldService]
Arbitrary) via (GenericUniform NewLegalHoldService)
  deriving ([NewLegalHoldService] -> Value
[NewLegalHoldService] -> Encoding
NewLegalHoldService -> Value
NewLegalHoldService -> Encoding
(NewLegalHoldService -> Value)
-> (NewLegalHoldService -> Encoding)
-> ([NewLegalHoldService] -> Value)
-> ([NewLegalHoldService] -> Encoding)
-> ToJSON NewLegalHoldService
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: NewLegalHoldService -> Value
toJSON :: NewLegalHoldService -> Value
$ctoEncoding :: NewLegalHoldService -> Encoding
toEncoding :: NewLegalHoldService -> Encoding
$ctoJSONList :: [NewLegalHoldService] -> Value
toJSONList :: [NewLegalHoldService] -> Value
$ctoEncodingList :: [NewLegalHoldService] -> Encoding
toEncodingList :: [NewLegalHoldService] -> Encoding
ToJSON, Value -> Parser [NewLegalHoldService]
Value -> Parser NewLegalHoldService
(Value -> Parser NewLegalHoldService)
-> (Value -> Parser [NewLegalHoldService])
-> FromJSON NewLegalHoldService
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser NewLegalHoldService
parseJSON :: Value -> Parser NewLegalHoldService
$cparseJSONList :: Value -> Parser [NewLegalHoldService]
parseJSONList :: Value -> Parser [NewLegalHoldService]
FromJSON, Typeable NewLegalHoldService
Typeable NewLegalHoldService =>
(Proxy NewLegalHoldService
 -> Declare (Definitions Schema) NamedSchema)
-> ToSchema NewLegalHoldService
Proxy NewLegalHoldService
-> Declare (Definitions Schema) NamedSchema
forall a.
Typeable a =>
(Proxy a -> Declare (Definitions Schema) NamedSchema) -> ToSchema a
$cdeclareNamedSchema :: Proxy NewLegalHoldService
-> Declare (Definitions Schema) NamedSchema
declareNamedSchema :: Proxy NewLegalHoldService
-> Declare (Definitions Schema) NamedSchema
S.ToSchema) via (Schema NewLegalHoldService)

instance ToSchema NewLegalHoldService where
  schema :: ValueSchema NamedSwaggerDoc NewLegalHoldService
schema =
    Text
-> SchemaP
     SwaggerDoc Object [Pair] NewLegalHoldService NewLegalHoldService
-> ValueSchema NamedSwaggerDoc NewLegalHoldService
forall doc doc' a b.
HasObject doc doc' =>
Text
-> SchemaP doc Object [Pair] a b -> SchemaP doc' Value Value a b
object Text
"NewLegalHoldService" (SchemaP
   SwaggerDoc Object [Pair] NewLegalHoldService NewLegalHoldService
 -> ValueSchema NamedSwaggerDoc NewLegalHoldService)
-> SchemaP
     SwaggerDoc Object [Pair] NewLegalHoldService NewLegalHoldService
-> ValueSchema NamedSwaggerDoc NewLegalHoldService
forall a b. (a -> b) -> a -> b
$
      HttpsUrl -> ServiceKeyPEM -> ServiceToken -> NewLegalHoldService
NewLegalHoldService
        (HttpsUrl -> ServiceKeyPEM -> ServiceToken -> NewLegalHoldService)
-> SchemaP SwaggerDoc Object [Pair] NewLegalHoldService HttpsUrl
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     NewLegalHoldService
     (ServiceKeyPEM -> ServiceToken -> NewLegalHoldService)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NewLegalHoldService -> HttpsUrl
newLegalHoldServiceUrl (NewLegalHoldService -> HttpsUrl)
-> SchemaP SwaggerDoc Object [Pair] HttpsUrl HttpsUrl
-> SchemaP SwaggerDoc Object [Pair] NewLegalHoldService HttpsUrl
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= Text
-> SchemaP NamedSwaggerDoc Value Value HttpsUrl HttpsUrl
-> SchemaP SwaggerDoc Object [Pair] HttpsUrl HttpsUrl
forall doc' doc a b.
HasField doc' doc =>
Text
-> SchemaP doc' Value Value a b -> SchemaP doc Object [Pair] a b
field Text
"base_url" SchemaP NamedSwaggerDoc Value Value HttpsUrl HttpsUrl
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema
        SchemaP
  SwaggerDoc
  Object
  [Pair]
  NewLegalHoldService
  (ServiceKeyPEM -> ServiceToken -> NewLegalHoldService)
-> SchemaP
     SwaggerDoc Object [Pair] NewLegalHoldService ServiceKeyPEM
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     NewLegalHoldService
     (ServiceToken -> NewLegalHoldService)
forall a b.
SchemaP SwaggerDoc Object [Pair] NewLegalHoldService (a -> b)
-> SchemaP SwaggerDoc Object [Pair] NewLegalHoldService a
-> SchemaP SwaggerDoc Object [Pair] NewLegalHoldService b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> NewLegalHoldService -> ServiceKeyPEM
newLegalHoldServiceKey (NewLegalHoldService -> ServiceKeyPEM)
-> SchemaP SwaggerDoc Object [Pair] ServiceKeyPEM ServiceKeyPEM
-> SchemaP
     SwaggerDoc Object [Pair] NewLegalHoldService ServiceKeyPEM
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= Text
-> SchemaP NamedSwaggerDoc Value Value ServiceKeyPEM ServiceKeyPEM
-> SchemaP SwaggerDoc Object [Pair] ServiceKeyPEM ServiceKeyPEM
forall doc' doc a b.
HasField doc' doc =>
Text
-> SchemaP doc' Value Value a b -> SchemaP doc Object [Pair] a b
field Text
"public_key" SchemaP NamedSwaggerDoc Value Value ServiceKeyPEM ServiceKeyPEM
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema
        SchemaP
  SwaggerDoc
  Object
  [Pair]
  NewLegalHoldService
  (ServiceToken -> NewLegalHoldService)
-> SchemaP
     SwaggerDoc Object [Pair] NewLegalHoldService ServiceToken
-> SchemaP
     SwaggerDoc Object [Pair] NewLegalHoldService NewLegalHoldService
forall a b.
SchemaP SwaggerDoc Object [Pair] NewLegalHoldService (a -> b)
-> SchemaP SwaggerDoc Object [Pair] NewLegalHoldService a
-> SchemaP SwaggerDoc Object [Pair] NewLegalHoldService b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> NewLegalHoldService -> ServiceToken
newLegalHoldServiceToken (NewLegalHoldService -> ServiceToken)
-> SchemaP SwaggerDoc Object [Pair] ServiceToken ServiceToken
-> SchemaP
     SwaggerDoc Object [Pair] NewLegalHoldService ServiceToken
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= Text
-> SchemaP NamedSwaggerDoc Value Value ServiceToken ServiceToken
-> SchemaP SwaggerDoc Object [Pair] ServiceToken ServiceToken
forall doc' doc a b.
HasField doc' doc =>
Text
-> SchemaP doc' Value Value a b -> SchemaP doc Object [Pair] a b
field Text
"auth_token" SchemaP NamedSwaggerDoc Value Value ServiceToken ServiceToken
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema

--------------------------------------------------------------------------------
-- ViewLegalHoldService

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

-- | this type is only introduce locally here to generate the schema for 'ViewLegalHoldService'.
data LHServiceStatus = Configured | NotConfigured | Disabled
  deriving (LHServiceStatus -> LHServiceStatus -> Bool
(LHServiceStatus -> LHServiceStatus -> Bool)
-> (LHServiceStatus -> LHServiceStatus -> Bool)
-> Eq LHServiceStatus
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: LHServiceStatus -> LHServiceStatus -> Bool
== :: LHServiceStatus -> LHServiceStatus -> Bool
$c/= :: LHServiceStatus -> LHServiceStatus -> Bool
/= :: LHServiceStatus -> LHServiceStatus -> Bool
Eq, Int -> LHServiceStatus -> ShowS
[LHServiceStatus] -> ShowS
LHServiceStatus -> String
(Int -> LHServiceStatus -> ShowS)
-> (LHServiceStatus -> String)
-> ([LHServiceStatus] -> ShowS)
-> Show LHServiceStatus
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> LHServiceStatus -> ShowS
showsPrec :: Int -> LHServiceStatus -> ShowS
$cshow :: LHServiceStatus -> String
show :: LHServiceStatus -> String
$cshowList :: [LHServiceStatus] -> ShowS
showList :: [LHServiceStatus] -> ShowS
Show, (forall x. LHServiceStatus -> Rep LHServiceStatus x)
-> (forall x. Rep LHServiceStatus x -> LHServiceStatus)
-> Generic LHServiceStatus
forall x. Rep LHServiceStatus x -> LHServiceStatus
forall x. LHServiceStatus -> Rep LHServiceStatus x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. LHServiceStatus -> Rep LHServiceStatus x
from :: forall x. LHServiceStatus -> Rep LHServiceStatus x
$cto :: forall x. Rep LHServiceStatus x -> LHServiceStatus
to :: forall x. Rep LHServiceStatus x -> LHServiceStatus
Generic)
  deriving ([LHServiceStatus] -> Value
[LHServiceStatus] -> Encoding
LHServiceStatus -> Value
LHServiceStatus -> Encoding
(LHServiceStatus -> Value)
-> (LHServiceStatus -> Encoding)
-> ([LHServiceStatus] -> Value)
-> ([LHServiceStatus] -> Encoding)
-> ToJSON LHServiceStatus
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: LHServiceStatus -> Value
toJSON :: LHServiceStatus -> Value
$ctoEncoding :: LHServiceStatus -> Encoding
toEncoding :: LHServiceStatus -> Encoding
$ctoJSONList :: [LHServiceStatus] -> Value
toJSONList :: [LHServiceStatus] -> Value
$ctoEncodingList :: [LHServiceStatus] -> Encoding
toEncodingList :: [LHServiceStatus] -> Encoding
ToJSON, Value -> Parser [LHServiceStatus]
Value -> Parser LHServiceStatus
(Value -> Parser LHServiceStatus)
-> (Value -> Parser [LHServiceStatus]) -> FromJSON LHServiceStatus
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser LHServiceStatus
parseJSON :: Value -> Parser LHServiceStatus
$cparseJSONList :: Value -> Parser [LHServiceStatus]
parseJSONList :: Value -> Parser [LHServiceStatus]
FromJSON, Typeable LHServiceStatus
Typeable LHServiceStatus =>
(Proxy LHServiceStatus -> Declare (Definitions Schema) NamedSchema)
-> ToSchema LHServiceStatus
Proxy LHServiceStatus -> Declare (Definitions Schema) NamedSchema
forall a.
Typeable a =>
(Proxy a -> Declare (Definitions Schema) NamedSchema) -> ToSchema a
$cdeclareNamedSchema :: Proxy LHServiceStatus -> Declare (Definitions Schema) NamedSchema
declareNamedSchema :: Proxy LHServiceStatus -> Declare (Definitions Schema) NamedSchema
S.ToSchema) via (Schema LHServiceStatus)

instance ToSchema LHServiceStatus where
  schema :: ValueSchema NamedSwaggerDoc LHServiceStatus
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
"LHServiceStatus" (SchemaP
   [Value] Text (Alt Maybe Text) LHServiceStatus LHServiceStatus
 -> ValueSchema NamedSwaggerDoc LHServiceStatus)
-> SchemaP
     [Value] Text (Alt Maybe Text) LHServiceStatus LHServiceStatus
-> ValueSchema NamedSwaggerDoc LHServiceStatus
forall a b. (a -> b) -> a -> b
$
      [SchemaP
   [Value] Text (Alt Maybe Text) LHServiceStatus LHServiceStatus]
-> SchemaP
     [Value] Text (Alt Maybe Text) LHServiceStatus LHServiceStatus
forall a. Monoid a => [a] -> a
mconcat
        [ Text
-> LHServiceStatus
-> SchemaP
     [Value] Text (Alt Maybe Text) LHServiceStatus LHServiceStatus
forall a b.
(ToJSON a, Eq a, Eq b) =>
a -> b -> SchemaP [Value] a (Alt Maybe a) b b
element Text
"configured" LHServiceStatus
Configured,
          Text
-> LHServiceStatus
-> SchemaP
     [Value] Text (Alt Maybe Text) LHServiceStatus LHServiceStatus
forall a b.
(ToJSON a, Eq a, Eq b) =>
a -> b -> SchemaP [Value] a (Alt Maybe a) b b
element Text
"not_configured" LHServiceStatus
NotConfigured,
          Text
-> LHServiceStatus
-> SchemaP
     [Value] Text (Alt Maybe Text) LHServiceStatus LHServiceStatus
forall a b.
(ToJSON a, Eq a, Eq b) =>
a -> b -> SchemaP [Value] a (Alt Maybe a) b b
element Text
"disabled" LHServiceStatus
Disabled
        ]

instance ToSchema ViewLegalHoldService where
  schema :: ValueSchema NamedSwaggerDoc ViewLegalHoldService
schema =
    Text
-> SchemaP
     SwaggerDoc Object [Pair] ViewLegalHoldService ViewLegalHoldService
-> ValueSchema NamedSwaggerDoc ViewLegalHoldService
forall doc doc' a b.
HasObject doc doc' =>
Text
-> SchemaP doc Object [Pair] a b -> SchemaP doc' Value Value a b
object Text
"ViewLegalHoldService" (SchemaP
   SwaggerDoc Object [Pair] ViewLegalHoldService ViewLegalHoldService
 -> ValueSchema NamedSwaggerDoc ViewLegalHoldService)
-> SchemaP
     SwaggerDoc Object [Pair] ViewLegalHoldService ViewLegalHoldService
-> ValueSchema NamedSwaggerDoc ViewLegalHoldService
forall a b. (a -> b) -> a -> b
$
      ViewLegalHoldService
-> (LHServiceStatus, Maybe ViewLegalHoldServiceInfo)
toOutput
        (ViewLegalHoldService
 -> (LHServiceStatus, Maybe ViewLegalHoldServiceInfo))
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     (LHServiceStatus, Maybe ViewLegalHoldServiceInfo)
     (LHServiceStatus, Maybe ViewLegalHoldServiceInfo)
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     ViewLegalHoldService
     (LHServiceStatus, Maybe ViewLegalHoldServiceInfo)
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= SchemaP
  SwaggerDoc
  Object
  [Pair]
  (LHServiceStatus, Maybe ViewLegalHoldServiceInfo)
  (LHServiceStatus, Maybe ViewLegalHoldServiceInfo)
recordSchema
        SchemaP
  SwaggerDoc
  Object
  [Pair]
  ViewLegalHoldService
  (LHServiceStatus, Maybe ViewLegalHoldServiceInfo)
-> ((LHServiceStatus, Maybe ViewLegalHoldServiceInfo)
    -> Parser ViewLegalHoldService)
-> SchemaP
     SwaggerDoc Object [Pair] ViewLegalHoldService ViewLegalHoldService
forall doc v w a b b'.
SchemaP doc v w a b -> (b -> Parser b') -> SchemaP doc v w a b'
`withParser` (LHServiceStatus, Maybe ViewLegalHoldServiceInfo)
-> Parser ViewLegalHoldService
validateViewLegalHoldService
    where
      toOutput :: ViewLegalHoldService -> (LHServiceStatus, Maybe ViewLegalHoldServiceInfo)
      toOutput :: ViewLegalHoldService
-> (LHServiceStatus, Maybe ViewLegalHoldServiceInfo)
toOutput = \case
        ViewLegalHoldService ViewLegalHoldServiceInfo
info -> (LHServiceStatus
Configured, ViewLegalHoldServiceInfo -> Maybe ViewLegalHoldServiceInfo
forall a. a -> Maybe a
Just ViewLegalHoldServiceInfo
info)
        ViewLegalHoldService
ViewLegalHoldServiceNotConfigured -> (LHServiceStatus
NotConfigured, Maybe ViewLegalHoldServiceInfo
forall a. Maybe a
Nothing)
        ViewLegalHoldService
ViewLegalHoldServiceDisabled -> (LHServiceStatus
Disabled, Maybe ViewLegalHoldServiceInfo
forall a. Maybe a
Nothing)

      recordSchema :: ObjectSchema SwaggerDoc (LHServiceStatus, Maybe ViewLegalHoldServiceInfo)
      recordSchema :: SchemaP
  SwaggerDoc
  Object
  [Pair]
  (LHServiceStatus, Maybe ViewLegalHoldServiceInfo)
  (LHServiceStatus, Maybe ViewLegalHoldServiceInfo)
recordSchema =
        (,)
          (LHServiceStatus
 -> Maybe ViewLegalHoldServiceInfo
 -> (LHServiceStatus, Maybe ViewLegalHoldServiceInfo))
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     (LHServiceStatus, Maybe ViewLegalHoldServiceInfo)
     LHServiceStatus
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     (LHServiceStatus, Maybe ViewLegalHoldServiceInfo)
     (Maybe ViewLegalHoldServiceInfo
      -> (LHServiceStatus, Maybe ViewLegalHoldServiceInfo))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (LHServiceStatus, Maybe ViewLegalHoldServiceInfo)
-> LHServiceStatus
forall a b. (a, b) -> a
fst ((LHServiceStatus, Maybe ViewLegalHoldServiceInfo)
 -> LHServiceStatus)
-> SchemaP SwaggerDoc Object [Pair] LHServiceStatus LHServiceStatus
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     (LHServiceStatus, Maybe ViewLegalHoldServiceInfo)
     LHServiceStatus
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= Text
-> ValueSchema NamedSwaggerDoc LHServiceStatus
-> SchemaP SwaggerDoc Object [Pair] LHServiceStatus LHServiceStatus
forall doc' doc a b.
HasField doc' doc =>
Text
-> SchemaP doc' Value Value a b -> SchemaP doc Object [Pair] a b
field Text
"status" ValueSchema NamedSwaggerDoc LHServiceStatus
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema
          SchemaP
  SwaggerDoc
  Object
  [Pair]
  (LHServiceStatus, Maybe ViewLegalHoldServiceInfo)
  (Maybe ViewLegalHoldServiceInfo
   -> (LHServiceStatus, Maybe ViewLegalHoldServiceInfo))
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     (LHServiceStatus, Maybe ViewLegalHoldServiceInfo)
     (Maybe ViewLegalHoldServiceInfo)
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     (LHServiceStatus, Maybe ViewLegalHoldServiceInfo)
     (LHServiceStatus, Maybe ViewLegalHoldServiceInfo)
forall a b.
SchemaP
  SwaggerDoc
  Object
  [Pair]
  (LHServiceStatus, Maybe ViewLegalHoldServiceInfo)
  (a -> b)
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     (LHServiceStatus, Maybe ViewLegalHoldServiceInfo)
     a
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     (LHServiceStatus, Maybe ViewLegalHoldServiceInfo)
     b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (LHServiceStatus, Maybe ViewLegalHoldServiceInfo)
-> Maybe ViewLegalHoldServiceInfo
forall a b. (a, b) -> b
snd ((LHServiceStatus, Maybe ViewLegalHoldServiceInfo)
 -> Maybe ViewLegalHoldServiceInfo)
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     (Maybe ViewLegalHoldServiceInfo)
     (Maybe ViewLegalHoldServiceInfo)
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     (LHServiceStatus, Maybe ViewLegalHoldServiceInfo)
     (Maybe ViewLegalHoldServiceInfo)
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= SchemaP
  SwaggerDoc
  Object
  [Pair]
  ViewLegalHoldServiceInfo
  (Maybe ViewLegalHoldServiceInfo)
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     (Maybe ViewLegalHoldServiceInfo)
     (Maybe ViewLegalHoldServiceInfo)
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
     ViewLegalHoldServiceInfo
     ViewLegalHoldServiceInfo
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     ViewLegalHoldServiceInfo
     (Maybe ViewLegalHoldServiceInfo)
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
"settings" SchemaP
  NamedSwaggerDoc
  Value
  Value
  ViewLegalHoldServiceInfo
  ViewLegalHoldServiceInfo
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema)

      validateViewLegalHoldService :: (LHServiceStatus, Maybe ViewLegalHoldServiceInfo) -> A.Parser ViewLegalHoldService
      validateViewLegalHoldService :: (LHServiceStatus, Maybe ViewLegalHoldServiceInfo)
-> Parser ViewLegalHoldService
validateViewLegalHoldService (LHServiceStatus
Configured, Just ViewLegalHoldServiceInfo
info) =
        ViewLegalHoldService -> Parser ViewLegalHoldService
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ViewLegalHoldService -> Parser ViewLegalHoldService)
-> ViewLegalHoldService -> Parser ViewLegalHoldService
forall a b. (a -> b) -> a -> b
$ ViewLegalHoldServiceInfo -> ViewLegalHoldService
ViewLegalHoldService ViewLegalHoldServiceInfo
info
      validateViewLegalHoldService (LHServiceStatus
Disabled, Maybe ViewLegalHoldServiceInfo
_) =
        ViewLegalHoldService -> Parser ViewLegalHoldService
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ViewLegalHoldService
ViewLegalHoldServiceDisabled
      validateViewLegalHoldService (LHServiceStatus
NotConfigured, Maybe ViewLegalHoldServiceInfo
_) =
        ViewLegalHoldService -> Parser ViewLegalHoldService
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ViewLegalHoldService
ViewLegalHoldServiceNotConfigured
      validateViewLegalHoldService (LHServiceStatus, Maybe ViewLegalHoldServiceInfo)
_ = String -> Parser ViewLegalHoldService
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"status (one of configured, not_configured, disabled)"

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

instance ToSchema ViewLegalHoldServiceInfo where
  schema :: SchemaP
  NamedSwaggerDoc
  Value
  Value
  ViewLegalHoldServiceInfo
  ViewLegalHoldServiceInfo
schema =
    Text
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     ViewLegalHoldServiceInfo
     ViewLegalHoldServiceInfo
-> SchemaP
     NamedSwaggerDoc
     Value
     Value
     ViewLegalHoldServiceInfo
     ViewLegalHoldServiceInfo
forall doc doc' a b.
HasObject doc doc' =>
Text
-> SchemaP doc Object [Pair] a b -> SchemaP doc' Value Value a b
object Text
"ViewLegalHoldServiceInfo" (SchemaP
   SwaggerDoc
   Object
   [Pair]
   ViewLegalHoldServiceInfo
   ViewLegalHoldServiceInfo
 -> SchemaP
      NamedSwaggerDoc
      Value
      Value
      ViewLegalHoldServiceInfo
      ViewLegalHoldServiceInfo)
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     ViewLegalHoldServiceInfo
     ViewLegalHoldServiceInfo
-> SchemaP
     NamedSwaggerDoc
     Value
     Value
     ViewLegalHoldServiceInfo
     ViewLegalHoldServiceInfo
forall a b. (a -> b) -> a -> b
$
      TeamId
-> HttpsUrl
-> Fingerprint Rsa
-> ServiceToken
-> ServiceKeyPEM
-> ViewLegalHoldServiceInfo
ViewLegalHoldServiceInfo
        (TeamId
 -> HttpsUrl
 -> Fingerprint Rsa
 -> ServiceToken
 -> ServiceKeyPEM
 -> ViewLegalHoldServiceInfo)
-> SchemaP SwaggerDoc Object [Pair] ViewLegalHoldServiceInfo TeamId
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     ViewLegalHoldServiceInfo
     (HttpsUrl
      -> Fingerprint Rsa
      -> ServiceToken
      -> ServiceKeyPEM
      -> ViewLegalHoldServiceInfo)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ViewLegalHoldServiceInfo -> TeamId
viewLegalHoldServiceTeam (ViewLegalHoldServiceInfo -> TeamId)
-> SchemaP SwaggerDoc Object [Pair] TeamId TeamId
-> SchemaP SwaggerDoc Object [Pair] ViewLegalHoldServiceInfo 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]
  ViewLegalHoldServiceInfo
  (HttpsUrl
   -> Fingerprint Rsa
   -> ServiceToken
   -> ServiceKeyPEM
   -> ViewLegalHoldServiceInfo)
-> SchemaP
     SwaggerDoc Object [Pair] ViewLegalHoldServiceInfo HttpsUrl
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     ViewLegalHoldServiceInfo
     (Fingerprint Rsa
      -> ServiceToken -> ServiceKeyPEM -> ViewLegalHoldServiceInfo)
forall a b.
SchemaP SwaggerDoc Object [Pair] ViewLegalHoldServiceInfo (a -> b)
-> SchemaP SwaggerDoc Object [Pair] ViewLegalHoldServiceInfo a
-> SchemaP SwaggerDoc Object [Pair] ViewLegalHoldServiceInfo b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ViewLegalHoldServiceInfo -> HttpsUrl
viewLegalHoldServiceUrl (ViewLegalHoldServiceInfo -> HttpsUrl)
-> SchemaP SwaggerDoc Object [Pair] HttpsUrl HttpsUrl
-> SchemaP
     SwaggerDoc Object [Pair] ViewLegalHoldServiceInfo HttpsUrl
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= Text
-> SchemaP NamedSwaggerDoc Value Value HttpsUrl HttpsUrl
-> SchemaP SwaggerDoc Object [Pair] HttpsUrl HttpsUrl
forall doc' doc a b.
HasField doc' doc =>
Text
-> SchemaP doc' Value Value a b -> SchemaP doc Object [Pair] a b
field Text
"base_url" SchemaP NamedSwaggerDoc Value Value HttpsUrl HttpsUrl
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema
        SchemaP
  SwaggerDoc
  Object
  [Pair]
  ViewLegalHoldServiceInfo
  (Fingerprint Rsa
   -> ServiceToken -> ServiceKeyPEM -> ViewLegalHoldServiceInfo)
-> SchemaP
     SwaggerDoc Object [Pair] ViewLegalHoldServiceInfo (Fingerprint Rsa)
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     ViewLegalHoldServiceInfo
     (ServiceToken -> ServiceKeyPEM -> ViewLegalHoldServiceInfo)
forall a b.
SchemaP SwaggerDoc Object [Pair] ViewLegalHoldServiceInfo (a -> b)
-> SchemaP SwaggerDoc Object [Pair] ViewLegalHoldServiceInfo a
-> SchemaP SwaggerDoc Object [Pair] ViewLegalHoldServiceInfo b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ViewLegalHoldServiceInfo -> Fingerprint Rsa
viewLegalHoldServiceFingerprint (ViewLegalHoldServiceInfo -> Fingerprint Rsa)
-> SchemaP
     SwaggerDoc Object [Pair] (Fingerprint Rsa) (Fingerprint Rsa)
-> SchemaP
     SwaggerDoc Object [Pair] ViewLegalHoldServiceInfo (Fingerprint Rsa)
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= Text
-> SchemaP
     NamedSwaggerDoc Value Value (Fingerprint Rsa) (Fingerprint Rsa)
-> SchemaP
     SwaggerDoc Object [Pair] (Fingerprint Rsa) (Fingerprint Rsa)
forall doc' doc a b.
HasField doc' doc =>
Text
-> SchemaP doc' Value Value a b -> SchemaP doc Object [Pair] a b
field Text
"fingerprint" SchemaP
  NamedSwaggerDoc Value Value (Fingerprint Rsa) (Fingerprint Rsa)
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema
        SchemaP
  SwaggerDoc
  Object
  [Pair]
  ViewLegalHoldServiceInfo
  (ServiceToken -> ServiceKeyPEM -> ViewLegalHoldServiceInfo)
-> SchemaP
     SwaggerDoc Object [Pair] ViewLegalHoldServiceInfo ServiceToken
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     ViewLegalHoldServiceInfo
     (ServiceKeyPEM -> ViewLegalHoldServiceInfo)
forall a b.
SchemaP SwaggerDoc Object [Pair] ViewLegalHoldServiceInfo (a -> b)
-> SchemaP SwaggerDoc Object [Pair] ViewLegalHoldServiceInfo a
-> SchemaP SwaggerDoc Object [Pair] ViewLegalHoldServiceInfo b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ViewLegalHoldServiceInfo -> ServiceToken
viewLegalHoldServiceAuthToken (ViewLegalHoldServiceInfo -> ServiceToken)
-> SchemaP SwaggerDoc Object [Pair] ServiceToken ServiceToken
-> SchemaP
     SwaggerDoc Object [Pair] ViewLegalHoldServiceInfo ServiceToken
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= Text
-> SchemaP NamedSwaggerDoc Value Value ServiceToken ServiceToken
-> SchemaP SwaggerDoc Object [Pair] ServiceToken ServiceToken
forall doc' doc a b.
HasField doc' doc =>
Text
-> SchemaP doc' Value Value a b -> SchemaP doc Object [Pair] a b
field Text
"auth_token" SchemaP NamedSwaggerDoc Value Value ServiceToken ServiceToken
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema
        SchemaP
  SwaggerDoc
  Object
  [Pair]
  ViewLegalHoldServiceInfo
  (ServiceKeyPEM -> ViewLegalHoldServiceInfo)
-> SchemaP
     SwaggerDoc Object [Pair] ViewLegalHoldServiceInfo ServiceKeyPEM
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     ViewLegalHoldServiceInfo
     ViewLegalHoldServiceInfo
forall a b.
SchemaP SwaggerDoc Object [Pair] ViewLegalHoldServiceInfo (a -> b)
-> SchemaP SwaggerDoc Object [Pair] ViewLegalHoldServiceInfo a
-> SchemaP SwaggerDoc Object [Pair] ViewLegalHoldServiceInfo b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ViewLegalHoldServiceInfo -> ServiceKeyPEM
viewLegalHoldServiceKey (ViewLegalHoldServiceInfo -> ServiceKeyPEM)
-> SchemaP SwaggerDoc Object [Pair] ServiceKeyPEM ServiceKeyPEM
-> SchemaP
     SwaggerDoc Object [Pair] ViewLegalHoldServiceInfo ServiceKeyPEM
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= Text
-> SchemaP NamedSwaggerDoc Value Value ServiceKeyPEM ServiceKeyPEM
-> SchemaP SwaggerDoc Object [Pair] ServiceKeyPEM ServiceKeyPEM
forall doc' doc a b.
HasField doc' doc =>
Text
-> SchemaP doc' Value Value a b -> SchemaP doc Object [Pair] a b
field Text
"public_key" SchemaP NamedSwaggerDoc Value Value ServiceKeyPEM ServiceKeyPEM
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema

--------------------------------------------------------------------------------
-- UserLegalHoldStatusResponse

data UserLegalHoldStatusResponse = UserLegalHoldStatusResponse
  { UserLegalHoldStatusResponse -> UserLegalHoldStatus
ulhsrStatus :: UserLegalHoldStatus,
    -- | Exists only when status is Pending or Enabled
    UserLegalHoldStatusResponse -> Maybe LastPrekey
ulhsrLastPrekey :: Maybe LastPrekey,
    -- | Exists only when status is Pending or Enabled
    UserLegalHoldStatusResponse -> Maybe ClientId
ulhsrClientId :: Maybe ClientId
  }
  deriving stock (UserLegalHoldStatusResponse -> UserLegalHoldStatusResponse -> Bool
(UserLegalHoldStatusResponse
 -> UserLegalHoldStatusResponse -> Bool)
-> (UserLegalHoldStatusResponse
    -> UserLegalHoldStatusResponse -> Bool)
-> Eq UserLegalHoldStatusResponse
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: UserLegalHoldStatusResponse -> UserLegalHoldStatusResponse -> Bool
== :: UserLegalHoldStatusResponse -> UserLegalHoldStatusResponse -> Bool
$c/= :: UserLegalHoldStatusResponse -> UserLegalHoldStatusResponse -> Bool
/= :: UserLegalHoldStatusResponse -> UserLegalHoldStatusResponse -> Bool
Eq, Int -> UserLegalHoldStatusResponse -> ShowS
[UserLegalHoldStatusResponse] -> ShowS
UserLegalHoldStatusResponse -> String
(Int -> UserLegalHoldStatusResponse -> ShowS)
-> (UserLegalHoldStatusResponse -> String)
-> ([UserLegalHoldStatusResponse] -> ShowS)
-> Show UserLegalHoldStatusResponse
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> UserLegalHoldStatusResponse -> ShowS
showsPrec :: Int -> UserLegalHoldStatusResponse -> ShowS
$cshow :: UserLegalHoldStatusResponse -> String
show :: UserLegalHoldStatusResponse -> String
$cshowList :: [UserLegalHoldStatusResponse] -> ShowS
showList :: [UserLegalHoldStatusResponse] -> ShowS
Show, (forall x.
 UserLegalHoldStatusResponse -> Rep UserLegalHoldStatusResponse x)
-> (forall x.
    Rep UserLegalHoldStatusResponse x -> UserLegalHoldStatusResponse)
-> Generic UserLegalHoldStatusResponse
forall x.
Rep UserLegalHoldStatusResponse x -> UserLegalHoldStatusResponse
forall x.
UserLegalHoldStatusResponse -> Rep UserLegalHoldStatusResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x.
UserLegalHoldStatusResponse -> Rep UserLegalHoldStatusResponse x
from :: forall x.
UserLegalHoldStatusResponse -> Rep UserLegalHoldStatusResponse x
$cto :: forall x.
Rep UserLegalHoldStatusResponse x -> UserLegalHoldStatusResponse
to :: forall x.
Rep UserLegalHoldStatusResponse x -> UserLegalHoldStatusResponse
Generic)
  deriving (Gen UserLegalHoldStatusResponse
Gen UserLegalHoldStatusResponse
-> (UserLegalHoldStatusResponse -> [UserLegalHoldStatusResponse])
-> Arbitrary UserLegalHoldStatusResponse
UserLegalHoldStatusResponse -> [UserLegalHoldStatusResponse]
forall a. Gen a -> (a -> [a]) -> Arbitrary a
$carbitrary :: Gen UserLegalHoldStatusResponse
arbitrary :: Gen UserLegalHoldStatusResponse
$cshrink :: UserLegalHoldStatusResponse -> [UserLegalHoldStatusResponse]
shrink :: UserLegalHoldStatusResponse -> [UserLegalHoldStatusResponse]
Arbitrary) via (GenericUniform UserLegalHoldStatusResponse)
  deriving ([UserLegalHoldStatusResponse] -> Value
[UserLegalHoldStatusResponse] -> Encoding
UserLegalHoldStatusResponse -> Value
UserLegalHoldStatusResponse -> Encoding
(UserLegalHoldStatusResponse -> Value)
-> (UserLegalHoldStatusResponse -> Encoding)
-> ([UserLegalHoldStatusResponse] -> Value)
-> ([UserLegalHoldStatusResponse] -> Encoding)
-> ToJSON UserLegalHoldStatusResponse
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: UserLegalHoldStatusResponse -> Value
toJSON :: UserLegalHoldStatusResponse -> Value
$ctoEncoding :: UserLegalHoldStatusResponse -> Encoding
toEncoding :: UserLegalHoldStatusResponse -> Encoding
$ctoJSONList :: [UserLegalHoldStatusResponse] -> Value
toJSONList :: [UserLegalHoldStatusResponse] -> Value
$ctoEncodingList :: [UserLegalHoldStatusResponse] -> Encoding
toEncodingList :: [UserLegalHoldStatusResponse] -> Encoding
ToJSON, Value -> Parser [UserLegalHoldStatusResponse]
Value -> Parser UserLegalHoldStatusResponse
(Value -> Parser UserLegalHoldStatusResponse)
-> (Value -> Parser [UserLegalHoldStatusResponse])
-> FromJSON UserLegalHoldStatusResponse
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser UserLegalHoldStatusResponse
parseJSON :: Value -> Parser UserLegalHoldStatusResponse
$cparseJSONList :: Value -> Parser [UserLegalHoldStatusResponse]
parseJSONList :: Value -> Parser [UserLegalHoldStatusResponse]
FromJSON, Typeable UserLegalHoldStatusResponse
Typeable UserLegalHoldStatusResponse =>
(Proxy UserLegalHoldStatusResponse
 -> Declare (Definitions Schema) NamedSchema)
-> ToSchema UserLegalHoldStatusResponse
Proxy UserLegalHoldStatusResponse
-> Declare (Definitions Schema) NamedSchema
forall a.
Typeable a =>
(Proxy a -> Declare (Definitions Schema) NamedSchema) -> ToSchema a
$cdeclareNamedSchema :: Proxy UserLegalHoldStatusResponse
-> Declare (Definitions Schema) NamedSchema
declareNamedSchema :: Proxy UserLegalHoldStatusResponse
-> Declare (Definitions Schema) NamedSchema
S.ToSchema) via (Schema UserLegalHoldStatusResponse)

instance ToSchema UserLegalHoldStatusResponse where
  schema :: ValueSchema NamedSwaggerDoc UserLegalHoldStatusResponse
schema =
    Text
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     UserLegalHoldStatusResponse
     UserLegalHoldStatusResponse
-> ValueSchema NamedSwaggerDoc UserLegalHoldStatusResponse
forall doc doc' a b.
HasObject doc doc' =>
Text
-> SchemaP doc Object [Pair] a b -> SchemaP doc' Value Value a b
object Text
"UserLegalHoldStatusResponse" (SchemaP
   SwaggerDoc
   Object
   [Pair]
   UserLegalHoldStatusResponse
   UserLegalHoldStatusResponse
 -> ValueSchema NamedSwaggerDoc UserLegalHoldStatusResponse)
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     UserLegalHoldStatusResponse
     UserLegalHoldStatusResponse
-> ValueSchema NamedSwaggerDoc UserLegalHoldStatusResponse
forall a b. (a -> b) -> a -> b
$
      UserLegalHoldStatus
-> Maybe LastPrekey
-> Maybe ClientId
-> UserLegalHoldStatusResponse
UserLegalHoldStatusResponse
        (UserLegalHoldStatus
 -> Maybe LastPrekey
 -> Maybe ClientId
 -> UserLegalHoldStatusResponse)
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     UserLegalHoldStatusResponse
     UserLegalHoldStatus
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     UserLegalHoldStatusResponse
     (Maybe LastPrekey -> Maybe ClientId -> UserLegalHoldStatusResponse)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> UserLegalHoldStatusResponse -> UserLegalHoldStatus
ulhsrStatus (UserLegalHoldStatusResponse -> UserLegalHoldStatus)
-> SchemaP
     SwaggerDoc Object [Pair] UserLegalHoldStatus UserLegalHoldStatus
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     UserLegalHoldStatusResponse
     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
"status" SchemaP
  NamedSwaggerDoc Value Value UserLegalHoldStatus UserLegalHoldStatus
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema
        SchemaP
  SwaggerDoc
  Object
  [Pair]
  UserLegalHoldStatusResponse
  (Maybe LastPrekey -> Maybe ClientId -> UserLegalHoldStatusResponse)
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     UserLegalHoldStatusResponse
     (Maybe LastPrekey)
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     UserLegalHoldStatusResponse
     (Maybe ClientId -> UserLegalHoldStatusResponse)
forall a b.
SchemaP
  SwaggerDoc Object [Pair] UserLegalHoldStatusResponse (a -> b)
-> SchemaP SwaggerDoc Object [Pair] UserLegalHoldStatusResponse a
-> SchemaP SwaggerDoc Object [Pair] UserLegalHoldStatusResponse b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> UserLegalHoldStatusResponse -> Maybe LastPrekey
ulhsrLastPrekey (UserLegalHoldStatusResponse -> Maybe LastPrekey)
-> SchemaP
     SwaggerDoc Object [Pair] (Maybe LastPrekey) (Maybe LastPrekey)
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     UserLegalHoldStatusResponse
     (Maybe LastPrekey)
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= SchemaP SwaggerDoc Object [Pair] LastPrekey (Maybe LastPrekey)
-> SchemaP
     SwaggerDoc Object [Pair] (Maybe LastPrekey) (Maybe LastPrekey)
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 LastPrekey LastPrekey
-> SchemaP SwaggerDoc Object [Pair] LastPrekey (Maybe LastPrekey)
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
"last_prekey" SchemaP NamedSwaggerDoc Value Value LastPrekey LastPrekey
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema)
        SchemaP
  SwaggerDoc
  Object
  [Pair]
  UserLegalHoldStatusResponse
  (Maybe ClientId -> UserLegalHoldStatusResponse)
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     UserLegalHoldStatusResponse
     (Maybe ClientId)
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     UserLegalHoldStatusResponse
     UserLegalHoldStatusResponse
forall a b.
SchemaP
  SwaggerDoc Object [Pair] UserLegalHoldStatusResponse (a -> b)
-> SchemaP SwaggerDoc Object [Pair] UserLegalHoldStatusResponse a
-> SchemaP SwaggerDoc Object [Pair] UserLegalHoldStatusResponse b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ((ClientId -> IdObject ClientId)
-> Maybe ClientId -> Maybe (IdObject ClientId)
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ClientId -> IdObject ClientId
forall a. a -> IdObject a
IdObject (Maybe ClientId -> Maybe (IdObject ClientId))
-> (UserLegalHoldStatusResponse -> Maybe ClientId)
-> UserLegalHoldStatusResponse
-> Maybe (IdObject ClientId)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UserLegalHoldStatusResponse -> Maybe ClientId
ulhsrClientId) (UserLegalHoldStatusResponse -> Maybe (IdObject ClientId))
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     (Maybe (IdObject ClientId))
     (Maybe ClientId)
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     UserLegalHoldStatusResponse
     (Maybe ClientId)
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= SchemaP
  SwaggerDoc Object [Pair] (IdObject ClientId) (Maybe ClientId)
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     (Maybe (IdObject ClientId))
     (Maybe ClientId)
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 (IdObject ClientId) ClientId
-> SchemaP
     SwaggerDoc Object [Pair] (IdObject ClientId) (Maybe ClientId)
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
"client" (IdObject ClientId -> ClientId
forall a. IdObject a -> a
fromIdObject (IdObject ClientId -> ClientId)
-> SchemaP
     NamedSwaggerDoc Value Value (IdObject ClientId) (IdObject ClientId)
-> SchemaP NamedSwaggerDoc Value Value (IdObject ClientId) ClientId
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SchemaP
  NamedSwaggerDoc Value Value (IdObject ClientId) (IdObject ClientId)
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema))

--------------------------------------------------------------------------------
-- RemoveLegalHoldSettingsRequest

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

instance ToSchema RemoveLegalHoldSettingsRequest where
  schema :: ValueSchema NamedSwaggerDoc RemoveLegalHoldSettingsRequest
schema =
    Text
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     RemoveLegalHoldSettingsRequest
     RemoveLegalHoldSettingsRequest
-> ValueSchema NamedSwaggerDoc RemoveLegalHoldSettingsRequest
forall doc doc' a b.
HasObject doc doc' =>
Text
-> SchemaP doc Object [Pair] a b -> SchemaP doc' Value Value a b
object Text
"RemoveLegalHoldSettingsRequest" (SchemaP
   SwaggerDoc
   Object
   [Pair]
   RemoveLegalHoldSettingsRequest
   RemoveLegalHoldSettingsRequest
 -> ValueSchema NamedSwaggerDoc RemoveLegalHoldSettingsRequest)
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     RemoveLegalHoldSettingsRequest
     RemoveLegalHoldSettingsRequest
-> ValueSchema NamedSwaggerDoc RemoveLegalHoldSettingsRequest
forall a b. (a -> b) -> a -> b
$
      Maybe PlainTextPassword6 -> RemoveLegalHoldSettingsRequest
RemoveLegalHoldSettingsRequest
        (Maybe PlainTextPassword6 -> RemoveLegalHoldSettingsRequest)
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     RemoveLegalHoldSettingsRequest
     (Maybe PlainTextPassword6)
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     RemoveLegalHoldSettingsRequest
     RemoveLegalHoldSettingsRequest
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RemoveLegalHoldSettingsRequest -> Maybe PlainTextPassword6
rmlhsrPassword (RemoveLegalHoldSettingsRequest -> Maybe PlainTextPassword6)
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     (Maybe PlainTextPassword6)
     (Maybe PlainTextPassword6)
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     RemoveLegalHoldSettingsRequest
     (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)

--------------------------------------------------------------------------------
-- DisableLegalHoldForUserRequest

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

instance ToSchema DisableLegalHoldForUserRequest where
  schema :: ValueSchema NamedSwaggerDoc DisableLegalHoldForUserRequest
schema =
    Text
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     DisableLegalHoldForUserRequest
     DisableLegalHoldForUserRequest
-> ValueSchema NamedSwaggerDoc DisableLegalHoldForUserRequest
forall doc doc' a b.
HasObject doc doc' =>
Text
-> SchemaP doc Object [Pair] a b -> SchemaP doc' Value Value a b
object Text
"DisableLegalHoldForUserRequest" (SchemaP
   SwaggerDoc
   Object
   [Pair]
   DisableLegalHoldForUserRequest
   DisableLegalHoldForUserRequest
 -> ValueSchema NamedSwaggerDoc DisableLegalHoldForUserRequest)
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     DisableLegalHoldForUserRequest
     DisableLegalHoldForUserRequest
-> ValueSchema NamedSwaggerDoc DisableLegalHoldForUserRequest
forall a b. (a -> b) -> a -> b
$
      Maybe PlainTextPassword6 -> DisableLegalHoldForUserRequest
DisableLegalHoldForUserRequest
        (Maybe PlainTextPassword6 -> DisableLegalHoldForUserRequest)
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     DisableLegalHoldForUserRequest
     (Maybe PlainTextPassword6)
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     DisableLegalHoldForUserRequest
     DisableLegalHoldForUserRequest
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> DisableLegalHoldForUserRequest -> Maybe PlainTextPassword6
dlhfuPassword (DisableLegalHoldForUserRequest -> Maybe PlainTextPassword6)
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     (Maybe PlainTextPassword6)
     (Maybe PlainTextPassword6)
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     DisableLegalHoldForUserRequest
     (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)

--------------------------------------------------------------------------------
-- ApproveLegalHoldForUserRequest

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

instance ToSchema ApproveLegalHoldForUserRequest where
  schema :: ValueSchema NamedSwaggerDoc ApproveLegalHoldForUserRequest
schema =
    Text
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     ApproveLegalHoldForUserRequest
     ApproveLegalHoldForUserRequest
-> ValueSchema NamedSwaggerDoc ApproveLegalHoldForUserRequest
forall doc doc' a b.
HasObject doc doc' =>
Text
-> SchemaP doc Object [Pair] a b -> SchemaP doc' Value Value a b
object Text
"ApproveLegalHoldForUserRequest" (SchemaP
   SwaggerDoc
   Object
   [Pair]
   ApproveLegalHoldForUserRequest
   ApproveLegalHoldForUserRequest
 -> ValueSchema NamedSwaggerDoc ApproveLegalHoldForUserRequest)
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     ApproveLegalHoldForUserRequest
     ApproveLegalHoldForUserRequest
-> ValueSchema NamedSwaggerDoc ApproveLegalHoldForUserRequest
forall a b. (a -> b) -> a -> b
$
      Maybe PlainTextPassword6 -> ApproveLegalHoldForUserRequest
ApproveLegalHoldForUserRequest
        (Maybe PlainTextPassword6 -> ApproveLegalHoldForUserRequest)
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     ApproveLegalHoldForUserRequest
     (Maybe PlainTextPassword6)
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     ApproveLegalHoldForUserRequest
     ApproveLegalHoldForUserRequest
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ApproveLegalHoldForUserRequest -> Maybe PlainTextPassword6
alhfuPassword (ApproveLegalHoldForUserRequest -> Maybe PlainTextPassword6)
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     (Maybe PlainTextPassword6)
     (Maybe PlainTextPassword6)
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     ApproveLegalHoldForUserRequest
     (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)

-----------------------------------------------------------------------

-- | Bots are not protected to be potentially recorded by legalhold devices.
data LegalholdProtectee
  = ProtectedUser UserId
  | -- | add UserId here if you want to protect bots as well (or just remove and use
    -- 'ProtectedUser', but then you'll loose the user type information).
    UnprotectedBot
  | -- | FUTUREWORK: protection against legalhold when looking up prekeys across federated
    -- instances.
    LegalholdPlusFederationNotImplemented
  deriving (Int -> LegalholdProtectee -> ShowS
[LegalholdProtectee] -> ShowS
LegalholdProtectee -> String
(Int -> LegalholdProtectee -> ShowS)
-> (LegalholdProtectee -> String)
-> ([LegalholdProtectee] -> ShowS)
-> Show LegalholdProtectee
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> LegalholdProtectee -> ShowS
showsPrec :: Int -> LegalholdProtectee -> ShowS
$cshow :: LegalholdProtectee -> String
show :: LegalholdProtectee -> String
$cshowList :: [LegalholdProtectee] -> ShowS
showList :: [LegalholdProtectee] -> ShowS
Show, LegalholdProtectee -> LegalholdProtectee -> Bool
(LegalholdProtectee -> LegalholdProtectee -> Bool)
-> (LegalholdProtectee -> LegalholdProtectee -> Bool)
-> Eq LegalholdProtectee
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: LegalholdProtectee -> LegalholdProtectee -> Bool
== :: LegalholdProtectee -> LegalholdProtectee -> Bool
$c/= :: LegalholdProtectee -> LegalholdProtectee -> Bool
/= :: LegalholdProtectee -> LegalholdProtectee -> Bool
Eq, Eq LegalholdProtectee
Eq LegalholdProtectee =>
(LegalholdProtectee -> LegalholdProtectee -> Ordering)
-> (LegalholdProtectee -> LegalholdProtectee -> Bool)
-> (LegalholdProtectee -> LegalholdProtectee -> Bool)
-> (LegalholdProtectee -> LegalholdProtectee -> Bool)
-> (LegalholdProtectee -> LegalholdProtectee -> Bool)
-> (LegalholdProtectee -> LegalholdProtectee -> LegalholdProtectee)
-> (LegalholdProtectee -> LegalholdProtectee -> LegalholdProtectee)
-> Ord LegalholdProtectee
LegalholdProtectee -> LegalholdProtectee -> Bool
LegalholdProtectee -> LegalholdProtectee -> Ordering
LegalholdProtectee -> LegalholdProtectee -> LegalholdProtectee
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 :: LegalholdProtectee -> LegalholdProtectee -> Ordering
compare :: LegalholdProtectee -> LegalholdProtectee -> Ordering
$c< :: LegalholdProtectee -> LegalholdProtectee -> Bool
< :: LegalholdProtectee -> LegalholdProtectee -> Bool
$c<= :: LegalholdProtectee -> LegalholdProtectee -> Bool
<= :: LegalholdProtectee -> LegalholdProtectee -> Bool
$c> :: LegalholdProtectee -> LegalholdProtectee -> Bool
> :: LegalholdProtectee -> LegalholdProtectee -> Bool
$c>= :: LegalholdProtectee -> LegalholdProtectee -> Bool
>= :: LegalholdProtectee -> LegalholdProtectee -> Bool
$cmax :: LegalholdProtectee -> LegalholdProtectee -> LegalholdProtectee
max :: LegalholdProtectee -> LegalholdProtectee -> LegalholdProtectee
$cmin :: LegalholdProtectee -> LegalholdProtectee -> LegalholdProtectee
min :: LegalholdProtectee -> LegalholdProtectee -> LegalholdProtectee
Ord, (forall x. LegalholdProtectee -> Rep LegalholdProtectee x)
-> (forall x. Rep LegalholdProtectee x -> LegalholdProtectee)
-> Generic LegalholdProtectee
forall x. Rep LegalholdProtectee x -> LegalholdProtectee
forall x. LegalholdProtectee -> Rep LegalholdProtectee x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. LegalholdProtectee -> Rep LegalholdProtectee x
from :: forall x. LegalholdProtectee -> Rep LegalholdProtectee x
$cto :: forall x. Rep LegalholdProtectee x -> LegalholdProtectee
to :: forall x. Rep LegalholdProtectee x -> LegalholdProtectee
Generic)
  deriving (Gen LegalholdProtectee
Gen LegalholdProtectee
-> (LegalholdProtectee -> [LegalholdProtectee])
-> Arbitrary LegalholdProtectee
LegalholdProtectee -> [LegalholdProtectee]
forall a. Gen a -> (a -> [a]) -> Arbitrary a
$carbitrary :: Gen LegalholdProtectee
arbitrary :: Gen LegalholdProtectee
$cshrink :: LegalholdProtectee -> [LegalholdProtectee]
shrink :: LegalholdProtectee -> [LegalholdProtectee]
Arbitrary) via (GenericUniform LegalholdProtectee)

instance ToJSON LegalholdProtectee

-- {"tag":"ProtectedUser","contents":"110a187a-be5b-11eb-8f47-370bc8e40f35"}
-- {"tag":"UnprotectedBot"}
-- {"tag":"LegalholdPlusFederationNotImplemented"}
instance FromJSON LegalholdProtectee

instance ToSchema LegalholdProtectee where
  -- Generated mixed-sums are hard to cover: Just use their existing JSON
  -- representation and add handwritten Swagger docs
  schema :: ValueSchema NamedSwaggerDoc LegalholdProtectee
schema = NamedSwaggerDoc
-> (Value -> Parser LegalholdProtectee)
-> (LegalholdProtectee -> Maybe Value)
-> ValueSchema NamedSwaggerDoc LegalholdProtectee
forall doc v b a w.
doc -> (v -> Parser b) -> (a -> Maybe w) -> SchemaP doc v w a b
mkSchema NamedSwaggerDoc
docs Value -> Parser LegalholdProtectee
forall a. FromJSON a => Value -> Parser a
A.parseJSON (Value -> Maybe Value
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Value -> Maybe Value)
-> (LegalholdProtectee -> Value)
-> LegalholdProtectee
-> Maybe Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LegalholdProtectee -> Value
forall a. ToJSON a => a -> Value
A.toJSON)
    where
      docs :: NamedSwaggerDoc
      docs :: NamedSwaggerDoc
docs =
        NamedSchema -> NamedSwaggerDoc
forall a. a -> WithDeclare a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (NamedSchema -> NamedSwaggerDoc) -> NamedSchema -> NamedSwaggerDoc
forall a b. (a -> b) -> a -> b
$
          Maybe Text -> Schema -> NamedSchema
S.NamedSchema (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"LegalholdProtectee") (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
& (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)
-> ((Maybe (IxValue (InsOrdHashMap Text (Referenced Schema)))
     -> Identity (Maybe (Referenced Schema)))
    -> InsOrdHashMap Text (Referenced Schema)
    -> Identity (InsOrdHashMap Text (Referenced Schema)))
-> (Maybe (IxValue (InsOrdHashMap Text (Referenced Schema)))
    -> Identity (Maybe (Referenced Schema)))
-> Schema
-> Identity Schema
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index (InsOrdHashMap Text (Referenced Schema))
-> Lens'
     (InsOrdHashMap Text (Referenced Schema))
     (Maybe (IxValue (InsOrdHashMap Text (Referenced Schema))))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Index (InsOrdHashMap Text (Referenced Schema))
"tag"
                ((Maybe (IxValue (InsOrdHashMap Text (Referenced Schema)))
  -> Identity (Maybe (Referenced Schema)))
 -> Schema -> Identity Schema)
-> Referenced Schema -> Schema -> Schema
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Schema -> Referenced Schema
forall a. a -> Referenced a
S.Inline
                  ( 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.OpenApiString
                      Schema -> (Schema -> Schema) -> Schema
forall a b. a -> (a -> b) -> b
& (Maybe [Value] -> Identity (Maybe [Value]))
-> Schema -> Identity Schema
forall s a. HasEnum s a => Lens' s a
Lens' Schema (Maybe [Value])
S.enum_
                        ((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
?~ [ String -> Value
forall a. ToJSON a => a -> Value
A.toJSON (String
"ProtectedUser" :: String),
                             String -> Value
forall a. ToJSON a => a -> Value
A.toJSON (String
"UnprotectedBot" :: String),
                             String -> Value
forall a. ToJSON a => a -> Value
A.toJSON (String
"LegalholdPlusFederationNotImplemented" :: String)
                           ]
                  )
              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)
-> ((Maybe (IxValue (InsOrdHashMap Text (Referenced Schema)))
     -> Identity (Maybe (Referenced Schema)))
    -> InsOrdHashMap Text (Referenced Schema)
    -> Identity (InsOrdHashMap Text (Referenced Schema)))
-> (Maybe (IxValue (InsOrdHashMap Text (Referenced Schema)))
    -> Identity (Maybe (Referenced Schema)))
-> Schema
-> Identity Schema
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index (InsOrdHashMap Text (Referenced Schema))
-> Lens'
     (InsOrdHashMap Text (Referenced Schema))
     (Maybe (IxValue (InsOrdHashMap Text (Referenced Schema))))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Index (InsOrdHashMap Text (Referenced Schema))
"contents"
                ((Maybe (IxValue (InsOrdHashMap Text (Referenced Schema)))
  -> Identity (Maybe (Referenced Schema)))
 -> Schema -> Identity Schema)
-> Referenced Schema -> Schema -> Schema
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Schema -> Referenced Schema
forall a. a -> Referenced a
S.Inline
                  ( Proxy UserId -> Schema
forall a. ToSchema a => Proxy a -> Schema
S.toSchema (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @UserId)
                      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
"A UserId for ProtectedUser, otherwise empty / null."
                  )