{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# 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.Conversation.Bot
  ( AddBot (..),
    AddBotResponse (..),
    RemoveBotResponse (..),
    UpdateBotPrekeys (..),
  )
where

import Data.Aeson qualified as A
import Data.Id
import Data.OpenApi qualified as S
import Data.Schema
import Imports
import Wire.API.Event.Conversation (Event)
import Wire.API.Locale (Locale)
import Wire.API.User.Client.Prekey (Prekey)
import Wire.API.User.Profile (Asset, ColourId, Name)
import Wire.Arbitrary (Arbitrary, GenericUniform (..))

--------------------------------------------------------------------------------
-- AddBot

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

instance ToSchema AddBot where
  schema :: ValueSchema NamedSwaggerDoc AddBot
schema =
    Text
-> SchemaP SwaggerDoc Object [Pair] AddBot AddBot
-> ValueSchema NamedSwaggerDoc AddBot
forall doc doc' a b.
HasObject doc doc' =>
Text
-> SchemaP doc Object [Pair] a b -> SchemaP doc' Value Value a b
object Text
"AddBot" (SchemaP SwaggerDoc Object [Pair] AddBot AddBot
 -> ValueSchema NamedSwaggerDoc AddBot)
-> SchemaP SwaggerDoc Object [Pair] AddBot AddBot
-> ValueSchema NamedSwaggerDoc AddBot
forall a b. (a -> b) -> a -> b
$
      ProviderId -> ServiceId -> Maybe Locale -> AddBot
AddBot
        (ProviderId -> ServiceId -> Maybe Locale -> AddBot)
-> SchemaP SwaggerDoc Object [Pair] AddBot ProviderId
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     AddBot
     (ServiceId -> Maybe Locale -> AddBot)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> AddBot -> ProviderId
addBotProvider (AddBot -> ProviderId)
-> SchemaP SwaggerDoc Object [Pair] ProviderId ProviderId
-> SchemaP SwaggerDoc Object [Pair] AddBot ProviderId
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= Text
-> SchemaP NamedSwaggerDoc Value Value ProviderId ProviderId
-> SchemaP SwaggerDoc Object [Pair] ProviderId ProviderId
forall doc' doc a b.
HasField doc' doc =>
Text
-> SchemaP doc' Value Value a b -> SchemaP doc Object [Pair] a b
field Text
"provider" SchemaP NamedSwaggerDoc Value Value ProviderId ProviderId
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema
        SchemaP
  SwaggerDoc
  Object
  [Pair]
  AddBot
  (ServiceId -> Maybe Locale -> AddBot)
-> SchemaP SwaggerDoc Object [Pair] AddBot ServiceId
-> SchemaP SwaggerDoc Object [Pair] AddBot (Maybe Locale -> AddBot)
forall a b.
SchemaP SwaggerDoc Object [Pair] AddBot (a -> b)
-> SchemaP SwaggerDoc Object [Pair] AddBot a
-> SchemaP SwaggerDoc Object [Pair] AddBot b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> AddBot -> ServiceId
addBotService (AddBot -> ServiceId)
-> SchemaP SwaggerDoc Object [Pair] ServiceId ServiceId
-> SchemaP SwaggerDoc Object [Pair] AddBot ServiceId
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= Text
-> SchemaP NamedSwaggerDoc Value Value ServiceId ServiceId
-> SchemaP SwaggerDoc Object [Pair] ServiceId ServiceId
forall doc' doc a b.
HasField doc' doc =>
Text
-> SchemaP doc' Value Value a b -> SchemaP doc Object [Pair] a b
field Text
"service" SchemaP NamedSwaggerDoc Value Value ServiceId ServiceId
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema
        SchemaP SwaggerDoc Object [Pair] AddBot (Maybe Locale -> AddBot)
-> SchemaP SwaggerDoc Object [Pair] AddBot (Maybe Locale)
-> SchemaP SwaggerDoc Object [Pair] AddBot AddBot
forall a b.
SchemaP SwaggerDoc Object [Pair] AddBot (a -> b)
-> SchemaP SwaggerDoc Object [Pair] AddBot a
-> SchemaP SwaggerDoc Object [Pair] AddBot b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> AddBot -> Maybe Locale
addBotLocale (AddBot -> Maybe Locale)
-> SchemaP SwaggerDoc Object [Pair] (Maybe Locale) (Maybe Locale)
-> SchemaP SwaggerDoc Object [Pair] AddBot (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)

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

instance ToSchema AddBotResponse where
  schema :: ValueSchema NamedSwaggerDoc AddBotResponse
schema =
    Text
-> SchemaP SwaggerDoc Object [Pair] AddBotResponse AddBotResponse
-> ValueSchema NamedSwaggerDoc AddBotResponse
forall doc doc' a b.
HasObject doc doc' =>
Text
-> SchemaP doc Object [Pair] a b -> SchemaP doc' Value Value a b
object Text
"AddBotResponse" (SchemaP SwaggerDoc Object [Pair] AddBotResponse AddBotResponse
 -> ValueSchema NamedSwaggerDoc AddBotResponse)
-> SchemaP SwaggerDoc Object [Pair] AddBotResponse AddBotResponse
-> ValueSchema NamedSwaggerDoc AddBotResponse
forall a b. (a -> b) -> a -> b
$
      BotId
-> ClientId
-> Name
-> ColourId
-> [Asset]
-> Event
-> AddBotResponse
AddBotResponse
        (BotId
 -> ClientId
 -> Name
 -> ColourId
 -> [Asset]
 -> Event
 -> AddBotResponse)
-> SchemaP SwaggerDoc Object [Pair] AddBotResponse BotId
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     AddBotResponse
     (ClientId
      -> Name -> ColourId -> [Asset] -> Event -> AddBotResponse)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> AddBotResponse -> BotId
rsAddBotId (AddBotResponse -> BotId)
-> SchemaP SwaggerDoc Object [Pair] BotId BotId
-> SchemaP SwaggerDoc Object [Pair] AddBotResponse BotId
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= Text
-> SchemaP NamedSwaggerDoc Value Value BotId BotId
-> SchemaP SwaggerDoc Object [Pair] BotId BotId
forall doc' doc a b.
HasField doc' doc =>
Text
-> SchemaP doc' Value Value a b -> SchemaP doc Object [Pair] a b
field Text
"id" SchemaP NamedSwaggerDoc Value Value BotId BotId
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema
        SchemaP
  SwaggerDoc
  Object
  [Pair]
  AddBotResponse
  (ClientId
   -> Name -> ColourId -> [Asset] -> Event -> AddBotResponse)
-> SchemaP SwaggerDoc Object [Pair] AddBotResponse ClientId
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     AddBotResponse
     (Name -> ColourId -> [Asset] -> Event -> AddBotResponse)
forall a b.
SchemaP SwaggerDoc Object [Pair] AddBotResponse (a -> b)
-> SchemaP SwaggerDoc Object [Pair] AddBotResponse a
-> SchemaP SwaggerDoc Object [Pair] AddBotResponse b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> AddBotResponse -> ClientId
rsAddBotClient (AddBotResponse -> ClientId)
-> SchemaP SwaggerDoc Object [Pair] ClientId ClientId
-> SchemaP SwaggerDoc Object [Pair] AddBotResponse ClientId
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= Text
-> SchemaP NamedSwaggerDoc Value Value ClientId ClientId
-> SchemaP SwaggerDoc Object [Pair] ClientId ClientId
forall doc' doc a b.
HasField doc' doc =>
Text
-> SchemaP doc' Value Value a b -> SchemaP doc Object [Pair] a b
field Text
"client" SchemaP NamedSwaggerDoc Value Value ClientId ClientId
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema
        SchemaP
  SwaggerDoc
  Object
  [Pair]
  AddBotResponse
  (Name -> ColourId -> [Asset] -> Event -> AddBotResponse)
-> SchemaP SwaggerDoc Object [Pair] AddBotResponse Name
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     AddBotResponse
     (ColourId -> [Asset] -> Event -> AddBotResponse)
forall a b.
SchemaP SwaggerDoc Object [Pair] AddBotResponse (a -> b)
-> SchemaP SwaggerDoc Object [Pair] AddBotResponse a
-> SchemaP SwaggerDoc Object [Pair] AddBotResponse b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> AddBotResponse -> Name
rsAddBotName (AddBotResponse -> Name)
-> SchemaP SwaggerDoc Object [Pair] Name Name
-> SchemaP SwaggerDoc Object [Pair] AddBotResponse 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]
  AddBotResponse
  (ColourId -> [Asset] -> Event -> AddBotResponse)
-> SchemaP SwaggerDoc Object [Pair] AddBotResponse ColourId
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     AddBotResponse
     ([Asset] -> Event -> AddBotResponse)
forall a b.
SchemaP SwaggerDoc Object [Pair] AddBotResponse (a -> b)
-> SchemaP SwaggerDoc Object [Pair] AddBotResponse a
-> SchemaP SwaggerDoc Object [Pair] AddBotResponse b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> AddBotResponse -> ColourId
rsAddBotColour (AddBotResponse -> ColourId)
-> SchemaP SwaggerDoc Object [Pair] ColourId ColourId
-> SchemaP SwaggerDoc Object [Pair] AddBotResponse 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]
  AddBotResponse
  ([Asset] -> Event -> AddBotResponse)
-> SchemaP SwaggerDoc Object [Pair] AddBotResponse [Asset]
-> SchemaP
     SwaggerDoc Object [Pair] AddBotResponse (Event -> AddBotResponse)
forall a b.
SchemaP SwaggerDoc Object [Pair] AddBotResponse (a -> b)
-> SchemaP SwaggerDoc Object [Pair] AddBotResponse a
-> SchemaP SwaggerDoc Object [Pair] AddBotResponse b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> AddBotResponse -> [Asset]
rsAddBotAssets (AddBotResponse -> [Asset])
-> SchemaP SwaggerDoc Object [Pair] [Asset] [Asset]
-> SchemaP SwaggerDoc Object [Pair] AddBotResponse [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] AddBotResponse (Event -> AddBotResponse)
-> SchemaP SwaggerDoc Object [Pair] AddBotResponse Event
-> SchemaP SwaggerDoc Object [Pair] AddBotResponse AddBotResponse
forall a b.
SchemaP SwaggerDoc Object [Pair] AddBotResponse (a -> b)
-> SchemaP SwaggerDoc Object [Pair] AddBotResponse a
-> SchemaP SwaggerDoc Object [Pair] AddBotResponse b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> AddBotResponse -> Event
rsAddBotEvent (AddBotResponse -> Event)
-> SchemaP SwaggerDoc Object [Pair] Event Event
-> SchemaP SwaggerDoc Object [Pair] AddBotResponse Event
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= Text
-> SchemaP NamedSwaggerDoc Value Value Event Event
-> SchemaP SwaggerDoc Object [Pair] Event Event
forall doc' doc a b.
HasField doc' doc =>
Text
-> SchemaP doc' Value Value a b -> SchemaP doc Object [Pair] a b
field Text
"event" SchemaP NamedSwaggerDoc Value Value Event Event
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema

--------------------------------------------------------------------------------
-- RemoveBot

-- (There is no request payload for bot removal)

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

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

--------------------------------------------------------------------------------
-- UpdateBotPrekeys

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

instance ToSchema UpdateBotPrekeys where
  schema :: ValueSchema NamedSwaggerDoc UpdateBotPrekeys
schema =
    Text
-> SchemaP
     SwaggerDoc Object [Pair] UpdateBotPrekeys UpdateBotPrekeys
-> ValueSchema NamedSwaggerDoc UpdateBotPrekeys
forall doc doc' a b.
HasObject doc doc' =>
Text
-> SchemaP doc Object [Pair] a b -> SchemaP doc' Value Value a b
object Text
"UpdateBotPrekeys" (SchemaP SwaggerDoc Object [Pair] UpdateBotPrekeys UpdateBotPrekeys
 -> ValueSchema NamedSwaggerDoc UpdateBotPrekeys)
-> SchemaP
     SwaggerDoc Object [Pair] UpdateBotPrekeys UpdateBotPrekeys
-> ValueSchema NamedSwaggerDoc UpdateBotPrekeys
forall a b. (a -> b) -> a -> b
$
      [Prekey] -> UpdateBotPrekeys
UpdateBotPrekeys
        ([Prekey] -> UpdateBotPrekeys)
-> SchemaP SwaggerDoc Object [Pair] UpdateBotPrekeys [Prekey]
-> SchemaP
     SwaggerDoc Object [Pair] UpdateBotPrekeys UpdateBotPrekeys
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> UpdateBotPrekeys -> [Prekey]
updateBotPrekeyList (UpdateBotPrekeys -> [Prekey])
-> SchemaP SwaggerDoc Object [Pair] [Prekey] [Prekey]
-> SchemaP SwaggerDoc Object [Pair] UpdateBotPrekeys [Prekey]
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= Text
-> SchemaP SwaggerDoc Value Value [Prekey] [Prekey]
-> SchemaP SwaggerDoc Object [Pair] [Prekey] [Prekey]
forall doc' doc a b.
HasField doc' doc =>
Text
-> SchemaP doc' Value Value a b -> SchemaP doc Object [Pair] a b
field Text
"prekeys" (ValueSchema NamedSwaggerDoc Prekey
-> SchemaP SwaggerDoc Value Value [Prekey] [Prekey]
forall ndoc doc a.
(HasArray ndoc doc, HasName ndoc) =>
ValueSchema ndoc a -> ValueSchema doc [a]
array ValueSchema NamedSwaggerDoc Prekey
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema)