{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE OverloadedRecordDot #-}
{-# 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/>.

-- | Types for verification codes.
module Wire.API.Conversation.Code
  ( -- * ConversationCode
    ConversationCode (..),
    CreateConversationCodeRequest (..),
    JoinConversationByCode (..),
    ConversationCodeInfo (..),
    mkConversationCodeInfo,

    -- * re-exports
    Code.Key (..),
    Value (..),
  )
where

import Control.Lens ((.~), (?~))
import Data.Aeson (FromJSON, ToJSON)
import Data.ByteString.Conversion (toByteString')
-- FUTUREWORK: move content of Data.Code here?
import Data.Code as Code
import Data.Misc
import Data.OpenApi qualified as S
import Data.Schema
import Imports
import URI.ByteString qualified as URI
import Wire.Arbitrary (Arbitrary, GenericUniform (..))

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

instance ToSchema CreateConversationCodeRequest where
  schema :: ValueSchema NamedSwaggerDoc CreateConversationCodeRequest
  schema :: ValueSchema NamedSwaggerDoc CreateConversationCodeRequest
schema =
    Text
-> (NamedSwaggerDoc -> NamedSwaggerDoc)
-> ObjectSchema SwaggerDoc CreateConversationCodeRequest
-> ValueSchema NamedSwaggerDoc CreateConversationCodeRequest
forall doc doc' a.
HasObject doc doc' =>
Text -> (doc' -> doc') -> ObjectSchema doc a -> ValueSchema doc' a
objectWithDocModifier
      Text
"CreateConversationCodeRequest"
      ((Maybe Text -> Identity (Maybe Text))
-> NamedSwaggerDoc -> Identity NamedSwaggerDoc
forall s a. HasDescription s a => Lens' s a
Lens' NamedSwaggerDoc (Maybe Text)
description ((Maybe Text -> Identity (Maybe Text))
 -> NamedSwaggerDoc -> Identity NamedSwaggerDoc)
-> Text -> NamedSwaggerDoc -> NamedSwaggerDoc
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Text
"Request body for creating a conversation code")
      (ObjectSchema SwaggerDoc CreateConversationCodeRequest
 -> ValueSchema NamedSwaggerDoc CreateConversationCodeRequest)
-> ObjectSchema SwaggerDoc CreateConversationCodeRequest
-> ValueSchema NamedSwaggerDoc CreateConversationCodeRequest
forall a b. (a -> b) -> a -> b
$ Maybe PlainTextPassword8 -> CreateConversationCodeRequest
CreateConversationCodeRequest
        (Maybe PlainTextPassword8 -> CreateConversationCodeRequest)
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     CreateConversationCodeRequest
     (Maybe PlainTextPassword8)
-> ObjectSchema SwaggerDoc CreateConversationCodeRequest
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (.password) (CreateConversationCodeRequest -> Maybe PlainTextPassword8)
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     (Maybe PlainTextPassword8)
     (Maybe PlainTextPassword8)
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     CreateConversationCodeRequest
     (Maybe PlainTextPassword8)
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= SchemaP
  SwaggerDoc
  Object
  [Pair]
  PlainTextPassword8
  (Maybe PlainTextPassword8)
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     (Maybe PlainTextPassword8)
     (Maybe PlainTextPassword8)
forall w d v a b.
Monoid w =>
SchemaP d v w a b -> SchemaP d v w (Maybe a) b
maybe_ (Text
-> (NamedSwaggerDoc -> NamedSwaggerDoc)
-> SchemaP
     NamedSwaggerDoc Value Value PlainTextPassword8 PlainTextPassword8
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     PlainTextPassword8
     (Maybe PlainTextPassword8)
forall doc doc' a b.
(HasOpt doc, HasField doc' doc) =>
Text
-> (doc' -> doc')
-> SchemaP doc' Value Value a b
-> SchemaP doc Object [Pair] a (Maybe b)
optFieldWithDocModifier Text
"password" NamedSwaggerDoc -> NamedSwaggerDoc
desc SchemaP
  NamedSwaggerDoc Value Value PlainTextPassword8 PlainTextPassword8
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema)
    where
      desc :: NamedSwaggerDoc -> NamedSwaggerDoc
desc = (Maybe Text -> Identity (Maybe Text))
-> NamedSwaggerDoc -> Identity NamedSwaggerDoc
forall s a. HasDescription s a => Lens' s a
Lens' NamedSwaggerDoc (Maybe Text)
description ((Maybe Text -> Identity (Maybe Text))
 -> NamedSwaggerDoc -> Identity NamedSwaggerDoc)
-> Text -> NamedSwaggerDoc -> NamedSwaggerDoc
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Text
"Password for accessing the conversation via guest link. Set to null or omit for no password."

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

instance ToSchema JoinConversationByCode where
  schema :: ValueSchema NamedSwaggerDoc JoinConversationByCode
schema =
    Text
-> (NamedSwaggerDoc -> NamedSwaggerDoc)
-> ObjectSchema SwaggerDoc JoinConversationByCode
-> ValueSchema NamedSwaggerDoc JoinConversationByCode
forall doc doc' a.
HasObject doc doc' =>
Text -> (doc' -> doc') -> ObjectSchema doc a -> ValueSchema doc' a
objectWithDocModifier
      Text
"JoinConversationByCode"
      ((Maybe Text -> Identity (Maybe Text))
-> NamedSwaggerDoc -> Identity NamedSwaggerDoc
forall s a. HasDescription s a => Lens' s a
Lens' NamedSwaggerDoc (Maybe Text)
description ((Maybe Text -> Identity (Maybe Text))
 -> NamedSwaggerDoc -> Identity NamedSwaggerDoc)
-> Text -> NamedSwaggerDoc -> NamedSwaggerDoc
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Text
"Request body for joining a conversation by code")
      (ObjectSchema SwaggerDoc JoinConversationByCode
 -> ValueSchema NamedSwaggerDoc JoinConversationByCode)
-> ObjectSchema SwaggerDoc JoinConversationByCode
-> ValueSchema NamedSwaggerDoc JoinConversationByCode
forall a b. (a -> b) -> a -> b
$ ConversationCode
-> Maybe PlainTextPassword8 -> JoinConversationByCode
JoinConversationByCode
        (ConversationCode
 -> Maybe PlainTextPassword8 -> JoinConversationByCode)
-> SchemaP
     SwaggerDoc Object [Pair] JoinConversationByCode ConversationCode
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     JoinConversationByCode
     (Maybe PlainTextPassword8 -> JoinConversationByCode)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (.code) (JoinConversationByCode -> ConversationCode)
-> SchemaP
     SwaggerDoc Object [Pair] ConversationCode ConversationCode
-> SchemaP
     SwaggerDoc Object [Pair] JoinConversationByCode ConversationCode
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= SchemaP SwaggerDoc Object [Pair] ConversationCode ConversationCode
conversationCodeObjectSchema
        SchemaP
  SwaggerDoc
  Object
  [Pair]
  JoinConversationByCode
  (Maybe PlainTextPassword8 -> JoinConversationByCode)
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     JoinConversationByCode
     (Maybe PlainTextPassword8)
-> ObjectSchema SwaggerDoc JoinConversationByCode
forall a b.
SchemaP SwaggerDoc Object [Pair] JoinConversationByCode (a -> b)
-> SchemaP SwaggerDoc Object [Pair] JoinConversationByCode a
-> SchemaP SwaggerDoc Object [Pair] JoinConversationByCode b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (.password) (JoinConversationByCode -> Maybe PlainTextPassword8)
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     (Maybe PlainTextPassword8)
     (Maybe PlainTextPassword8)
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     JoinConversationByCode
     (Maybe PlainTextPassword8)
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= SchemaP
  SwaggerDoc
  Object
  [Pair]
  PlainTextPassword8
  (Maybe PlainTextPassword8)
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     (Maybe PlainTextPassword8)
     (Maybe PlainTextPassword8)
forall w d v a b.
Monoid w =>
SchemaP d v w a b -> SchemaP d v w (Maybe a) b
maybe_ (Text
-> SchemaP
     NamedSwaggerDoc Value Value PlainTextPassword8 PlainTextPassword8
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     PlainTextPassword8
     (Maybe PlainTextPassword8)
forall doc doc' a b.
(HasOpt doc, HasField doc' doc) =>
Text
-> SchemaP doc' Value Value a b
-> SchemaP doc Object [Pair] a (Maybe b)
optField Text
"password" SchemaP
  NamedSwaggerDoc Value Value PlainTextPassword8 PlainTextPassword8
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema)

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

conversationCodeObjectSchema :: ObjectSchema SwaggerDoc ConversationCode
conversationCodeObjectSchema :: SchemaP SwaggerDoc Object [Pair] ConversationCode ConversationCode
conversationCodeObjectSchema =
  Key -> Value -> Maybe HttpsUrl -> ConversationCode
ConversationCode
    (Key -> Value -> Maybe HttpsUrl -> ConversationCode)
-> SchemaP SwaggerDoc Object [Pair] ConversationCode Key
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     ConversationCode
     (Value -> Maybe HttpsUrl -> ConversationCode)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ConversationCode -> Key
conversationKey
      (ConversationCode -> Key)
-> SchemaP SwaggerDoc Object [Pair] Key Key
-> SchemaP SwaggerDoc Object [Pair] ConversationCode Key
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= Text
-> (NamedSwaggerDoc -> NamedSwaggerDoc)
-> SchemaP NamedSwaggerDoc Value Value Key Key
-> SchemaP SwaggerDoc Object [Pair] Key Key
forall doc' doc a b.
HasField doc' doc =>
Text
-> (doc' -> doc')
-> SchemaP doc' Value Value a b
-> SchemaP doc Object [Pair] a b
fieldWithDocModifier
        Text
"key"
        ((Maybe Text -> Identity (Maybe Text))
-> NamedSwaggerDoc -> Identity NamedSwaggerDoc
forall s a. HasDescription s a => Lens' s a
Lens' NamedSwaggerDoc (Maybe Text)
description ((Maybe Text -> Identity (Maybe Text))
 -> NamedSwaggerDoc -> Identity NamedSwaggerDoc)
-> Text -> NamedSwaggerDoc -> NamedSwaggerDoc
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Text
"Stable conversation identifier")
        SchemaP NamedSwaggerDoc Value Value Key Key
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema
    SchemaP
  SwaggerDoc
  Object
  [Pair]
  ConversationCode
  (Value -> Maybe HttpsUrl -> ConversationCode)
-> SchemaP SwaggerDoc Object [Pair] ConversationCode Value
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     ConversationCode
     (Maybe HttpsUrl -> ConversationCode)
forall a b.
SchemaP SwaggerDoc Object [Pair] ConversationCode (a -> b)
-> SchemaP SwaggerDoc Object [Pair] ConversationCode a
-> SchemaP SwaggerDoc Object [Pair] ConversationCode b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ConversationCode -> Value
conversationCode
      (ConversationCode -> Value)
-> SchemaP SwaggerDoc Object [Pair] Value Value
-> SchemaP SwaggerDoc Object [Pair] ConversationCode Value
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= Text
-> (NamedSwaggerDoc -> NamedSwaggerDoc)
-> SchemaP NamedSwaggerDoc Value Value Value Value
-> SchemaP SwaggerDoc Object [Pair] Value Value
forall doc' doc a b.
HasField doc' doc =>
Text
-> (doc' -> doc')
-> SchemaP doc' Value Value a b
-> SchemaP doc Object [Pair] a b
fieldWithDocModifier
        Text
"code"
        ((Maybe Text -> Identity (Maybe Text))
-> NamedSwaggerDoc -> Identity NamedSwaggerDoc
forall s a. HasDescription s a => Lens' s a
Lens' NamedSwaggerDoc (Maybe Text)
description ((Maybe Text -> Identity (Maybe Text))
 -> NamedSwaggerDoc -> Identity NamedSwaggerDoc)
-> Text -> NamedSwaggerDoc -> NamedSwaggerDoc
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Text
"Conversation code (random)")
        SchemaP NamedSwaggerDoc Value Value Value Value
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema
    SchemaP
  SwaggerDoc
  Object
  [Pair]
  ConversationCode
  (Maybe HttpsUrl -> ConversationCode)
-> SchemaP
     SwaggerDoc Object [Pair] ConversationCode (Maybe HttpsUrl)
-> SchemaP
     SwaggerDoc Object [Pair] ConversationCode ConversationCode
forall a b.
SchemaP SwaggerDoc Object [Pair] ConversationCode (a -> b)
-> SchemaP SwaggerDoc Object [Pair] ConversationCode a
-> SchemaP SwaggerDoc Object [Pair] ConversationCode b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ConversationCode -> Maybe HttpsUrl
conversationUri
      (ConversationCode -> Maybe HttpsUrl)
-> SchemaP
     SwaggerDoc Object [Pair] (Maybe HttpsUrl) (Maybe HttpsUrl)
-> SchemaP
     SwaggerDoc Object [Pair] ConversationCode (Maybe HttpsUrl)
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= SchemaP SwaggerDoc Object [Pair] HttpsUrl (Maybe HttpsUrl)
-> SchemaP
     SwaggerDoc Object [Pair] (Maybe HttpsUrl) (Maybe HttpsUrl)
forall w d v a b.
Monoid w =>
SchemaP d v w a b -> SchemaP d v w (Maybe a) b
maybe_
        ( Text
-> (NamedSwaggerDoc -> NamedSwaggerDoc)
-> SchemaP NamedSwaggerDoc Value Value HttpsUrl HttpsUrl
-> SchemaP SwaggerDoc Object [Pair] HttpsUrl (Maybe HttpsUrl)
forall doc doc' a b.
(HasOpt doc, HasField doc' doc) =>
Text
-> (doc' -> doc')
-> SchemaP doc' Value Value a b
-> SchemaP doc Object [Pair] a (Maybe b)
optFieldWithDocModifier
            Text
"uri"
            ((Maybe Text -> Identity (Maybe Text))
-> NamedSwaggerDoc -> Identity NamedSwaggerDoc
forall s a. HasDescription s a => Lens' s a
Lens' NamedSwaggerDoc (Maybe Text)
description ((Maybe Text -> Identity (Maybe Text))
 -> NamedSwaggerDoc -> Identity NamedSwaggerDoc)
-> Text -> NamedSwaggerDoc -> NamedSwaggerDoc
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Text
"Full URI (containing key/code) to join a conversation")
            SchemaP NamedSwaggerDoc Value Value HttpsUrl HttpsUrl
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema
        )

instance ToSchema ConversationCode where
  schema :: ValueSchema NamedSwaggerDoc ConversationCode
schema =
    Text
-> (NamedSwaggerDoc -> NamedSwaggerDoc)
-> SchemaP
     SwaggerDoc Object [Pair] ConversationCode ConversationCode
-> ValueSchema NamedSwaggerDoc ConversationCode
forall doc doc' a.
HasObject doc doc' =>
Text -> (doc' -> doc') -> ObjectSchema doc a -> ValueSchema doc' a
objectWithDocModifier
      Text
"ConversationCode"
      ((Maybe Text -> Identity (Maybe Text))
-> NamedSwaggerDoc -> Identity NamedSwaggerDoc
forall s a. HasDescription s a => Lens' s a
Lens' NamedSwaggerDoc (Maybe Text)
description ((Maybe Text -> Identity (Maybe Text))
 -> NamedSwaggerDoc -> Identity NamedSwaggerDoc)
-> Text -> NamedSwaggerDoc -> NamedSwaggerDoc
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Text
"Contains conversation properties to update")
      SchemaP SwaggerDoc Object [Pair] ConversationCode ConversationCode
conversationCodeObjectSchema

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

instance ToSchema ConversationCodeInfo where
  schema :: ValueSchema NamedSwaggerDoc ConversationCodeInfo
schema =
    Text
-> (NamedSwaggerDoc -> NamedSwaggerDoc)
-> ObjectSchema SwaggerDoc ConversationCodeInfo
-> ValueSchema NamedSwaggerDoc ConversationCodeInfo
forall doc doc' a.
HasObject doc doc' =>
Text -> (doc' -> doc') -> ObjectSchema doc a -> ValueSchema doc' a
objectWithDocModifier
      Text
"ConversationCodeInfo"
      ((Maybe Text -> Identity (Maybe Text))
-> NamedSwaggerDoc -> Identity NamedSwaggerDoc
forall s a. HasDescription s a => Lens' s a
Lens' NamedSwaggerDoc (Maybe Text)
description ((Maybe Text -> Identity (Maybe Text))
 -> NamedSwaggerDoc -> Identity NamedSwaggerDoc)
-> Text -> NamedSwaggerDoc -> NamedSwaggerDoc
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Text
"Contains conversation properties to update")
      (ObjectSchema SwaggerDoc ConversationCodeInfo
 -> ValueSchema NamedSwaggerDoc ConversationCodeInfo)
-> ObjectSchema SwaggerDoc ConversationCodeInfo
-> ValueSchema NamedSwaggerDoc ConversationCodeInfo
forall a b. (a -> b) -> a -> b
$ ConversationCode -> Bool -> ConversationCodeInfo
ConversationCodeInfo
        (ConversationCode -> Bool -> ConversationCodeInfo)
-> SchemaP
     SwaggerDoc Object [Pair] ConversationCodeInfo ConversationCode
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     ConversationCodeInfo
     (Bool -> ConversationCodeInfo)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (.code) (ConversationCodeInfo -> ConversationCode)
-> SchemaP
     SwaggerDoc Object [Pair] ConversationCode ConversationCode
-> SchemaP
     SwaggerDoc Object [Pair] ConversationCodeInfo ConversationCode
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= SchemaP SwaggerDoc Object [Pair] ConversationCode ConversationCode
conversationCodeObjectSchema
        SchemaP
  SwaggerDoc
  Object
  [Pair]
  ConversationCodeInfo
  (Bool -> ConversationCodeInfo)
-> SchemaP SwaggerDoc Object [Pair] ConversationCodeInfo Bool
-> ObjectSchema SwaggerDoc ConversationCodeInfo
forall a b.
SchemaP SwaggerDoc Object [Pair] ConversationCodeInfo (a -> b)
-> SchemaP SwaggerDoc Object [Pair] ConversationCodeInfo a
-> SchemaP SwaggerDoc Object [Pair] ConversationCodeInfo b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (.hasPassword) (ConversationCodeInfo -> Bool)
-> SchemaP SwaggerDoc Object [Pair] Bool Bool
-> SchemaP SwaggerDoc Object [Pair] ConversationCodeInfo Bool
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= Text
-> (NamedSwaggerDoc -> NamedSwaggerDoc)
-> SchemaP NamedSwaggerDoc Value Value Bool Bool
-> SchemaP SwaggerDoc Object [Pair] Bool Bool
forall doc' doc a b.
HasField doc' doc =>
Text
-> (doc' -> doc')
-> SchemaP doc' Value Value a b
-> SchemaP doc Object [Pair] a b
fieldWithDocModifier Text
"has_password" ((Maybe Text -> Identity (Maybe Text))
-> NamedSwaggerDoc -> Identity NamedSwaggerDoc
forall s a. HasDescription s a => Lens' s a
Lens' NamedSwaggerDoc (Maybe Text)
description ((Maybe Text -> Identity (Maybe Text))
 -> NamedSwaggerDoc -> Identity NamedSwaggerDoc)
-> Text -> NamedSwaggerDoc -> NamedSwaggerDoc
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Text
"Whether the conversation has a password") SchemaP NamedSwaggerDoc Value Value Bool Bool
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema

mkConversationCodeInfo :: Bool -> Code.Key -> Code.Value -> HttpsUrl -> ConversationCodeInfo
mkConversationCodeInfo :: Bool -> Key -> Value -> HttpsUrl -> ConversationCodeInfo
mkConversationCodeInfo Bool
hasPw Key
k Value
v (HttpsUrl URIRef Absolute
prefix) =
  ConversationCode -> Bool -> ConversationCodeInfo
ConversationCodeInfo (Key -> Value -> Maybe HttpsUrl -> ConversationCode
ConversationCode Key
k Value
v (HttpsUrl -> Maybe HttpsUrl
forall a. a -> Maybe a
Just (URIRef Absolute -> HttpsUrl
HttpsUrl URIRef Absolute
link))) Bool
hasPw
  where
    q :: [(ByteString, ByteString)]
q = [(ByteString
"key", Key -> ByteString
forall a. ToByteString a => a -> ByteString
toByteString' Key
k), (ByteString
"code", Value -> ByteString
forall a. ToByteString a => a -> ByteString
toByteString' Value
v)]
    link :: URIRef Absolute
link = URIRef Absolute
prefix URIRef Absolute
-> (URIRef Absolute -> URIRef Absolute) -> URIRef Absolute
forall a b. a -> (a -> b) -> b
& ((Query -> Identity Query)
-> URIRef Absolute -> Identity (URIRef Absolute)
forall a (f :: * -> *).
Functor f =>
(Query -> f Query) -> URIRef a -> f (URIRef a)
URI.queryL ((Query -> Identity Query)
 -> URIRef Absolute -> Identity (URIRef Absolute))
-> (([(ByteString, ByteString)]
     -> Identity [(ByteString, ByteString)])
    -> Query -> Identity Query)
-> ([(ByteString, ByteString)]
    -> Identity [(ByteString, ByteString)])
-> URIRef Absolute
-> Identity (URIRef Absolute)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([(ByteString, ByteString)] -> Identity [(ByteString, ByteString)])
-> Query -> Identity Query
Lens' Query [(ByteString, ByteString)]
URI.queryPairsL) (([(ByteString, ByteString)]
  -> Identity [(ByteString, ByteString)])
 -> URIRef Absolute -> Identity (URIRef Absolute))
-> [(ByteString, ByteString)] -> URIRef Absolute -> URIRef Absolute
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [(ByteString, ByteString)]
q