{-# 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.Provider.External
  ( NewBotRequest (..),
    NewBotResponse (..),
  )
where

import Data.Aeson
import Data.Id
import Data.Json.Util ((#))
import Imports
import Wire.API.Locale (Locale)
import Wire.API.Provider.Bot (BotConvView, BotUserView)
import Wire.API.User.Client.Prekey (LastPrekey, Prekey)
import Wire.API.User.Profile (Asset, ColourId, Name)
import Wire.Arbitrary (Arbitrary, GenericUniform (..))

--------------------------------------------------------------------------------
-- NewBotRequest

-- | Request for a bot to be created in a conversation (by an external service).
data NewBotRequest = NewBotRequest
  { -- | The user ID to use for the bot.
    NewBotRequest -> BotId
newBotId :: BotId,
    -- | The client ID to use for the bot.
    NewBotRequest -> ClientId
newBotClient :: ClientId,
    -- | The origin (user) of the bot request.
    NewBotRequest -> BotUserView
newBotOrigin :: BotUserView,
    -- | The conversation as seen by the bot.
    NewBotRequest -> BotConvView
newBotConv :: BotConvView,
    -- | The API access token.
    NewBotRequest -> Text
newBotToken :: Text,
    -- | The preferred locale (i.e. language) for the bot
    -- to use.
    NewBotRequest -> Locale
newBotLocale :: Locale
  }
  deriving stock (NewBotRequest -> NewBotRequest -> Bool
(NewBotRequest -> NewBotRequest -> Bool)
-> (NewBotRequest -> NewBotRequest -> Bool) -> Eq NewBotRequest
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: NewBotRequest -> NewBotRequest -> Bool
== :: NewBotRequest -> NewBotRequest -> Bool
$c/= :: NewBotRequest -> NewBotRequest -> Bool
/= :: NewBotRequest -> NewBotRequest -> Bool
Eq, Int -> NewBotRequest -> ShowS
[NewBotRequest] -> ShowS
NewBotRequest -> String
(Int -> NewBotRequest -> ShowS)
-> (NewBotRequest -> String)
-> ([NewBotRequest] -> ShowS)
-> Show NewBotRequest
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> NewBotRequest -> ShowS
showsPrec :: Int -> NewBotRequest -> ShowS
$cshow :: NewBotRequest -> String
show :: NewBotRequest -> String
$cshowList :: [NewBotRequest] -> ShowS
showList :: [NewBotRequest] -> ShowS
Show, (forall x. NewBotRequest -> Rep NewBotRequest x)
-> (forall x. Rep NewBotRequest x -> NewBotRequest)
-> Generic NewBotRequest
forall x. Rep NewBotRequest x -> NewBotRequest
forall x. NewBotRequest -> Rep NewBotRequest x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. NewBotRequest -> Rep NewBotRequest x
from :: forall x. NewBotRequest -> Rep NewBotRequest x
$cto :: forall x. Rep NewBotRequest x -> NewBotRequest
to :: forall x. Rep NewBotRequest x -> NewBotRequest
Generic)
  deriving (Gen NewBotRequest
Gen NewBotRequest
-> (NewBotRequest -> [NewBotRequest]) -> Arbitrary NewBotRequest
NewBotRequest -> [NewBotRequest]
forall a. Gen a -> (a -> [a]) -> Arbitrary a
$carbitrary :: Gen NewBotRequest
arbitrary :: Gen NewBotRequest
$cshrink :: NewBotRequest -> [NewBotRequest]
shrink :: NewBotRequest -> [NewBotRequest]
Arbitrary) via (GenericUniform NewBotRequest)

instance FromJSON NewBotRequest where
  parseJSON :: Value -> Parser NewBotRequest
parseJSON = String
-> (Object -> Parser NewBotRequest)
-> Value
-> Parser NewBotRequest
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"NewBotRequest" ((Object -> Parser NewBotRequest) -> Value -> Parser NewBotRequest)
-> (Object -> Parser NewBotRequest)
-> Value
-> Parser NewBotRequest
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    BotId
-> ClientId
-> BotUserView
-> BotConvView
-> Text
-> Locale
-> NewBotRequest
NewBotRequest
      (BotId
 -> ClientId
 -> BotUserView
 -> BotConvView
 -> Text
 -> Locale
 -> NewBotRequest)
-> Parser BotId
-> Parser
     (ClientId
      -> BotUserView -> BotConvView -> Text -> Locale -> NewBotRequest)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser BotId
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"id"
      Parser
  (ClientId
   -> BotUserView -> BotConvView -> Text -> Locale -> NewBotRequest)
-> Parser ClientId
-> Parser
     (BotUserView -> BotConvView -> Text -> Locale -> NewBotRequest)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser ClientId
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"client"
      Parser
  (BotUserView -> BotConvView -> Text -> Locale -> NewBotRequest)
-> Parser BotUserView
-> Parser (BotConvView -> Text -> Locale -> NewBotRequest)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser BotUserView
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"origin"
      Parser (BotConvView -> Text -> Locale -> NewBotRequest)
-> Parser BotConvView -> Parser (Text -> Locale -> NewBotRequest)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser BotConvView
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"conversation"
      Parser (Text -> Locale -> NewBotRequest)
-> Parser Text -> Parser (Locale -> NewBotRequest)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"token"
      Parser (Locale -> NewBotRequest)
-> Parser Locale -> Parser NewBotRequest
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser Locale
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"locale"

instance ToJSON NewBotRequest where
  toJSON :: NewBotRequest -> Value
toJSON NewBotRequest
n =
    [Pair] -> Value
object ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$
      Key
"id"
        Key -> BotId -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= NewBotRequest -> BotId
newBotId NewBotRequest
n
        # "client"
        .= newBotClient n
        # "origin"
        .= newBotOrigin n
        # "conversation"
        .= newBotConv n
        # "token"
        .= newBotToken n
        # "locale"
        .= newBotLocale n
        # []

--------------------------------------------------------------------------------
-- NewBotResponse

-- | Bot data provided by a service in response to a 'NewBotRequest'.
-- The returned optional data overrides the defaults taken from
-- the 'Service' definition.
data NewBotResponse = NewBotResponse
  { NewBotResponse -> [Prekey]
rsNewBotPrekeys :: [Prekey],
    NewBotResponse -> LastPrekey
rsNewBotLastPrekey :: LastPrekey,
    NewBotResponse -> Maybe Name
rsNewBotName :: Maybe Name,
    NewBotResponse -> Maybe ColourId
rsNewBotColour :: Maybe ColourId,
    NewBotResponse -> Maybe [Asset]
rsNewBotAssets :: Maybe [Asset]
  }
  deriving stock (NewBotResponse -> NewBotResponse -> Bool
(NewBotResponse -> NewBotResponse -> Bool)
-> (NewBotResponse -> NewBotResponse -> Bool) -> Eq NewBotResponse
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: NewBotResponse -> NewBotResponse -> Bool
== :: NewBotResponse -> NewBotResponse -> Bool
$c/= :: NewBotResponse -> NewBotResponse -> Bool
/= :: NewBotResponse -> NewBotResponse -> Bool
Eq, Int -> NewBotResponse -> ShowS
[NewBotResponse] -> ShowS
NewBotResponse -> String
(Int -> NewBotResponse -> ShowS)
-> (NewBotResponse -> String)
-> ([NewBotResponse] -> ShowS)
-> Show NewBotResponse
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> NewBotResponse -> ShowS
showsPrec :: Int -> NewBotResponse -> ShowS
$cshow :: NewBotResponse -> String
show :: NewBotResponse -> String
$cshowList :: [NewBotResponse] -> ShowS
showList :: [NewBotResponse] -> ShowS
Show, (forall x. NewBotResponse -> Rep NewBotResponse x)
-> (forall x. Rep NewBotResponse x -> NewBotResponse)
-> Generic NewBotResponse
forall x. Rep NewBotResponse x -> NewBotResponse
forall x. NewBotResponse -> Rep NewBotResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. NewBotResponse -> Rep NewBotResponse x
from :: forall x. NewBotResponse -> Rep NewBotResponse x
$cto :: forall x. Rep NewBotResponse x -> NewBotResponse
to :: forall x. Rep NewBotResponse x -> NewBotResponse
Generic)
  deriving (Gen NewBotResponse
Gen NewBotResponse
-> (NewBotResponse -> [NewBotResponse]) -> Arbitrary NewBotResponse
NewBotResponse -> [NewBotResponse]
forall a. Gen a -> (a -> [a]) -> Arbitrary a
$carbitrary :: Gen NewBotResponse
arbitrary :: Gen NewBotResponse
$cshrink :: NewBotResponse -> [NewBotResponse]
shrink :: NewBotResponse -> [NewBotResponse]
Arbitrary) via (GenericUniform NewBotResponse)

instance FromJSON NewBotResponse where
  parseJSON :: Value -> Parser NewBotResponse
parseJSON = String
-> (Object -> Parser NewBotResponse)
-> Value
-> Parser NewBotResponse
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"NewBotResponse" ((Object -> Parser NewBotResponse)
 -> Value -> Parser NewBotResponse)
-> (Object -> Parser NewBotResponse)
-> Value
-> Parser NewBotResponse
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    [Prekey]
-> LastPrekey
-> Maybe Name
-> Maybe ColourId
-> Maybe [Asset]
-> NewBotResponse
NewBotResponse
      ([Prekey]
 -> LastPrekey
 -> Maybe Name
 -> Maybe ColourId
 -> Maybe [Asset]
 -> NewBotResponse)
-> Parser [Prekey]
-> Parser
     (LastPrekey
      -> Maybe Name -> Maybe ColourId -> Maybe [Asset] -> NewBotResponse)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser [Prekey]
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"prekeys"
      Parser
  (LastPrekey
   -> Maybe Name -> Maybe ColourId -> Maybe [Asset] -> NewBotResponse)
-> Parser LastPrekey
-> Parser
     (Maybe Name -> Maybe ColourId -> Maybe [Asset] -> NewBotResponse)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser LastPrekey
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"last_prekey"
      Parser
  (Maybe Name -> Maybe ColourId -> Maybe [Asset] -> NewBotResponse)
-> Parser (Maybe Name)
-> Parser (Maybe ColourId -> Maybe [Asset] -> NewBotResponse)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser (Maybe Name)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"name"
      Parser (Maybe ColourId -> Maybe [Asset] -> NewBotResponse)
-> Parser (Maybe ColourId)
-> Parser (Maybe [Asset] -> NewBotResponse)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser (Maybe ColourId)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"accent_id"
      Parser (Maybe [Asset] -> NewBotResponse)
-> Parser (Maybe [Asset]) -> Parser NewBotResponse
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser (Maybe [Asset])
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"assets"

instance ToJSON NewBotResponse where
  toJSON :: NewBotResponse -> Value
toJSON NewBotResponse
r =
    [Pair] -> Value
object ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$
      Key
"prekeys"
        Key -> [Prekey] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= NewBotResponse -> [Prekey]
rsNewBotPrekeys NewBotResponse
r
        # "last_prekey"
        .= rsNewBotLastPrekey r
        # "name"
        .= rsNewBotName r
        # "accent_id"
        .= rsNewBotColour r
        # "assets"
        .= rsNewBotAssets r
        # []