{-# OPTIONS_GHC -Wno-incomplete-patterns #-}
{-# OPTIONS_GHC -Wno-unused-matches #-}

-- This file is part of the Wire Server implementation.
--
-- Copyright (C) 2023 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.Federation.API.Galley.Notifications where

import Data.Aeson
import Data.Id
import Data.Json.Util
import Data.List.NonEmpty
import Data.OpenApi (ToSchema)
import Data.Qualified
import Data.Range
import Data.Time.Clock
import Imports
import Servant.API
import Wire.API.Conversation.Action
import Wire.API.Federation.Component
import Wire.API.Federation.Endpoint
import Wire.API.Federation.HasNotificationEndpoint
import Wire.API.Federation.Version
import Wire.API.MLS.SubConversation
import Wire.API.Message
import Wire.API.Routes.Version (From, Until)
import Wire.API.Util.Aeson
import Wire.Arbitrary

data GalleyNotificationTag
  = OnClientRemovedTag
  | OnMessageSentTag
  | OnMLSMessageSentTag
  | OnConversationUpdatedTagV0
  | OnConversationUpdatedTag
  | OnUserDeletedConversationsTag
  deriving (Int -> GalleyNotificationTag -> ShowS
[GalleyNotificationTag] -> ShowS
GalleyNotificationTag -> String
(Int -> GalleyNotificationTag -> ShowS)
-> (GalleyNotificationTag -> String)
-> ([GalleyNotificationTag] -> ShowS)
-> Show GalleyNotificationTag
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> GalleyNotificationTag -> ShowS
showsPrec :: Int -> GalleyNotificationTag -> ShowS
$cshow :: GalleyNotificationTag -> String
show :: GalleyNotificationTag -> String
$cshowList :: [GalleyNotificationTag] -> ShowS
showList :: [GalleyNotificationTag] -> ShowS
Show, GalleyNotificationTag -> GalleyNotificationTag -> Bool
(GalleyNotificationTag -> GalleyNotificationTag -> Bool)
-> (GalleyNotificationTag -> GalleyNotificationTag -> Bool)
-> Eq GalleyNotificationTag
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: GalleyNotificationTag -> GalleyNotificationTag -> Bool
== :: GalleyNotificationTag -> GalleyNotificationTag -> Bool
$c/= :: GalleyNotificationTag -> GalleyNotificationTag -> Bool
/= :: GalleyNotificationTag -> GalleyNotificationTag -> Bool
Eq, (forall x. GalleyNotificationTag -> Rep GalleyNotificationTag x)
-> (forall x. Rep GalleyNotificationTag x -> GalleyNotificationTag)
-> Generic GalleyNotificationTag
forall x. Rep GalleyNotificationTag x -> GalleyNotificationTag
forall x. GalleyNotificationTag -> Rep GalleyNotificationTag x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. GalleyNotificationTag -> Rep GalleyNotificationTag x
from :: forall x. GalleyNotificationTag -> Rep GalleyNotificationTag x
$cto :: forall x. Rep GalleyNotificationTag x -> GalleyNotificationTag
to :: forall x. Rep GalleyNotificationTag x -> GalleyNotificationTag
Generic, GalleyNotificationTag
GalleyNotificationTag
-> GalleyNotificationTag -> Bounded GalleyNotificationTag
forall a. a -> a -> Bounded a
$cminBound :: GalleyNotificationTag
minBound :: GalleyNotificationTag
$cmaxBound :: GalleyNotificationTag
maxBound :: GalleyNotificationTag
Bounded, Int -> GalleyNotificationTag
GalleyNotificationTag -> Int
GalleyNotificationTag -> [GalleyNotificationTag]
GalleyNotificationTag -> GalleyNotificationTag
GalleyNotificationTag
-> GalleyNotificationTag -> [GalleyNotificationTag]
GalleyNotificationTag
-> GalleyNotificationTag
-> GalleyNotificationTag
-> [GalleyNotificationTag]
(GalleyNotificationTag -> GalleyNotificationTag)
-> (GalleyNotificationTag -> GalleyNotificationTag)
-> (Int -> GalleyNotificationTag)
-> (GalleyNotificationTag -> Int)
-> (GalleyNotificationTag -> [GalleyNotificationTag])
-> (GalleyNotificationTag
    -> GalleyNotificationTag -> [GalleyNotificationTag])
-> (GalleyNotificationTag
    -> GalleyNotificationTag -> [GalleyNotificationTag])
-> (GalleyNotificationTag
    -> GalleyNotificationTag
    -> GalleyNotificationTag
    -> [GalleyNotificationTag])
-> Enum GalleyNotificationTag
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: GalleyNotificationTag -> GalleyNotificationTag
succ :: GalleyNotificationTag -> GalleyNotificationTag
$cpred :: GalleyNotificationTag -> GalleyNotificationTag
pred :: GalleyNotificationTag -> GalleyNotificationTag
$ctoEnum :: Int -> GalleyNotificationTag
toEnum :: Int -> GalleyNotificationTag
$cfromEnum :: GalleyNotificationTag -> Int
fromEnum :: GalleyNotificationTag -> Int
$cenumFrom :: GalleyNotificationTag -> [GalleyNotificationTag]
enumFrom :: GalleyNotificationTag -> [GalleyNotificationTag]
$cenumFromThen :: GalleyNotificationTag
-> GalleyNotificationTag -> [GalleyNotificationTag]
enumFromThen :: GalleyNotificationTag
-> GalleyNotificationTag -> [GalleyNotificationTag]
$cenumFromTo :: GalleyNotificationTag
-> GalleyNotificationTag -> [GalleyNotificationTag]
enumFromTo :: GalleyNotificationTag
-> GalleyNotificationTag -> [GalleyNotificationTag]
$cenumFromThenTo :: GalleyNotificationTag
-> GalleyNotificationTag
-> GalleyNotificationTag
-> [GalleyNotificationTag]
enumFromThenTo :: GalleyNotificationTag
-> GalleyNotificationTag
-> GalleyNotificationTag
-> [GalleyNotificationTag]
Enum)

instance IsNotificationTag GalleyNotificationTag where
  type NotificationComponent _ = 'Galley

instance HasNotificationEndpoint 'OnClientRemovedTag where
  type Payload 'OnClientRemovedTag = ClientRemovedRequest
  type NotificationPath 'OnClientRemovedTag = "on-client-removed"

-- used to notify this backend that a new message has been posted to a
-- remote conversation
instance HasNotificationEndpoint 'OnMessageSentTag where
  type Payload 'OnMessageSentTag = RemoteMessage ConvId
  type NotificationPath 'OnMessageSentTag = "on-message-sent"

instance HasNotificationEndpoint 'OnMLSMessageSentTag where
  type Payload 'OnMLSMessageSentTag = RemoteMLSMessage
  type NotificationPath 'OnMLSMessageSentTag = "on-mls-message-sent"

-- used by the backend that owns a conversation to inform this backend of
-- changes to the conversation
instance HasNotificationEndpoint 'OnConversationUpdatedTagV0 where
  type Payload 'OnConversationUpdatedTagV0 = ConversationUpdateV0
  type NotificationPath 'OnConversationUpdatedTagV0 = "on-conversation-updated"
  type NotificationVersionTag 'OnConversationUpdatedTagV0 = 'Just 'V0
  type NotificationMods 'OnConversationUpdatedTagV0 = '[Until 'V1]

instance HasNotificationEndpoint 'OnConversationUpdatedTag where
  type Payload 'OnConversationUpdatedTag = ConversationUpdate
  type NotificationPath 'OnConversationUpdatedTag = "on-conversation-updated"
  type NotificationMods 'OnConversationUpdatedTag = '[From 'V1]

instance HasNotificationEndpoint 'OnUserDeletedConversationsTag where
  type Payload 'OnUserDeletedConversationsTag = UserDeletedConversationsNotification
  type NotificationPath 'OnUserDeletedConversationsTag = "on-user-deleted-conversations"

-- | All the notification endpoints return an 'EmptyResponse'.
type GalleyNotificationAPI =
  NotificationFedEndpoint 'OnClientRemovedTag
    :<|> NotificationFedEndpoint 'OnMessageSentTag
    :<|> NotificationFedEndpoint 'OnMLSMessageSentTag
    :<|> NotificationFedEndpoint 'OnConversationUpdatedTagV0
    :<|> NotificationFedEndpoint 'OnConversationUpdatedTag
    :<|> NotificationFedEndpoint 'OnUserDeletedConversationsTag

data ClientRemovedRequest = ClientRemovedRequest
  { ClientRemovedRequest -> UserId
user :: UserId,
    ClientRemovedRequest -> ClientId
client :: ClientId,
    ClientRemovedRequest -> [ConvId]
convs :: [ConvId]
  }
  deriving stock (ClientRemovedRequest -> ClientRemovedRequest -> Bool
(ClientRemovedRequest -> ClientRemovedRequest -> Bool)
-> (ClientRemovedRequest -> ClientRemovedRequest -> Bool)
-> Eq ClientRemovedRequest
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ClientRemovedRequest -> ClientRemovedRequest -> Bool
== :: ClientRemovedRequest -> ClientRemovedRequest -> Bool
$c/= :: ClientRemovedRequest -> ClientRemovedRequest -> Bool
/= :: ClientRemovedRequest -> ClientRemovedRequest -> Bool
Eq, Int -> ClientRemovedRequest -> ShowS
[ClientRemovedRequest] -> ShowS
ClientRemovedRequest -> String
(Int -> ClientRemovedRequest -> ShowS)
-> (ClientRemovedRequest -> String)
-> ([ClientRemovedRequest] -> ShowS)
-> Show ClientRemovedRequest
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ClientRemovedRequest -> ShowS
showsPrec :: Int -> ClientRemovedRequest -> ShowS
$cshow :: ClientRemovedRequest -> String
show :: ClientRemovedRequest -> String
$cshowList :: [ClientRemovedRequest] -> ShowS
showList :: [ClientRemovedRequest] -> ShowS
Show, (forall x. ClientRemovedRequest -> Rep ClientRemovedRequest x)
-> (forall x. Rep ClientRemovedRequest x -> ClientRemovedRequest)
-> Generic ClientRemovedRequest
forall x. Rep ClientRemovedRequest x -> ClientRemovedRequest
forall x. ClientRemovedRequest -> Rep ClientRemovedRequest x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ClientRemovedRequest -> Rep ClientRemovedRequest x
from :: forall x. ClientRemovedRequest -> Rep ClientRemovedRequest x
$cto :: forall x. Rep ClientRemovedRequest x -> ClientRemovedRequest
to :: forall x. Rep ClientRemovedRequest x -> ClientRemovedRequest
Generic)
  deriving (Gen ClientRemovedRequest
Gen ClientRemovedRequest
-> (ClientRemovedRequest -> [ClientRemovedRequest])
-> Arbitrary ClientRemovedRequest
ClientRemovedRequest -> [ClientRemovedRequest]
forall a. Gen a -> (a -> [a]) -> Arbitrary a
$carbitrary :: Gen ClientRemovedRequest
arbitrary :: Gen ClientRemovedRequest
$cshrink :: ClientRemovedRequest -> [ClientRemovedRequest]
shrink :: ClientRemovedRequest -> [ClientRemovedRequest]
Arbitrary) via (GenericUniform ClientRemovedRequest)
  deriving (Value -> Parser [ClientRemovedRequest]
Value -> Parser ClientRemovedRequest
(Value -> Parser ClientRemovedRequest)
-> (Value -> Parser [ClientRemovedRequest])
-> FromJSON ClientRemovedRequest
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser ClientRemovedRequest
parseJSON :: Value -> Parser ClientRemovedRequest
$cparseJSONList :: Value -> Parser [ClientRemovedRequest]
parseJSONList :: Value -> Parser [ClientRemovedRequest]
FromJSON, [ClientRemovedRequest] -> Value
[ClientRemovedRequest] -> Encoding
ClientRemovedRequest -> Value
ClientRemovedRequest -> Encoding
(ClientRemovedRequest -> Value)
-> (ClientRemovedRequest -> Encoding)
-> ([ClientRemovedRequest] -> Value)
-> ([ClientRemovedRequest] -> Encoding)
-> ToJSON ClientRemovedRequest
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: ClientRemovedRequest -> Value
toJSON :: ClientRemovedRequest -> Value
$ctoEncoding :: ClientRemovedRequest -> Encoding
toEncoding :: ClientRemovedRequest -> Encoding
$ctoJSONList :: [ClientRemovedRequest] -> Value
toJSONList :: [ClientRemovedRequest] -> Value
$ctoEncodingList :: [ClientRemovedRequest] -> Encoding
toEncodingList :: [ClientRemovedRequest] -> Encoding
ToJSON) via (CustomEncoded ClientRemovedRequest)

instance ToSchema ClientRemovedRequest

-- Note: this is parametric in the conversation type to allow it to be used
-- both for conversations with a fixed known domain (e.g. as the argument of the
-- federation RPC), and for conversations with an arbitrary Qualified or Remote id
-- (e.g. as the argument of the corresponding handler).
data RemoteMessage conv = RemoteMessage
  { forall conv. RemoteMessage conv -> UTCTime
time :: UTCTime,
    forall conv. RemoteMessage conv -> Maybe Text
_data :: Maybe Text,
    forall conv. RemoteMessage conv -> Qualified UserId
sender :: Qualified UserId,
    forall conv. RemoteMessage conv -> ClientId
senderClient :: ClientId,
    forall conv. RemoteMessage conv -> conv
conversation :: conv,
    forall conv. RemoteMessage conv -> Maybe Priority
priority :: Maybe Priority,
    forall conv. RemoteMessage conv -> Bool
push :: Bool,
    forall conv. RemoteMessage conv -> Bool
transient :: Bool,
    forall conv. RemoteMessage conv -> UserClientMap Text
recipients :: UserClientMap Text
  }
  deriving stock (RemoteMessage conv -> RemoteMessage conv -> Bool
(RemoteMessage conv -> RemoteMessage conv -> Bool)
-> (RemoteMessage conv -> RemoteMessage conv -> Bool)
-> Eq (RemoteMessage conv)
forall conv.
Eq conv =>
RemoteMessage conv -> RemoteMessage conv -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall conv.
Eq conv =>
RemoteMessage conv -> RemoteMessage conv -> Bool
== :: RemoteMessage conv -> RemoteMessage conv -> Bool
$c/= :: forall conv.
Eq conv =>
RemoteMessage conv -> RemoteMessage conv -> Bool
/= :: RemoteMessage conv -> RemoteMessage conv -> Bool
Eq, Int -> RemoteMessage conv -> ShowS
[RemoteMessage conv] -> ShowS
RemoteMessage conv -> String
(Int -> RemoteMessage conv -> ShowS)
-> (RemoteMessage conv -> String)
-> ([RemoteMessage conv] -> ShowS)
-> Show (RemoteMessage conv)
forall conv. Show conv => Int -> RemoteMessage conv -> ShowS
forall conv. Show conv => [RemoteMessage conv] -> ShowS
forall conv. Show conv => RemoteMessage conv -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall conv. Show conv => Int -> RemoteMessage conv -> ShowS
showsPrec :: Int -> RemoteMessage conv -> ShowS
$cshow :: forall conv. Show conv => RemoteMessage conv -> String
show :: RemoteMessage conv -> String
$cshowList :: forall conv. Show conv => [RemoteMessage conv] -> ShowS
showList :: [RemoteMessage conv] -> ShowS
Show, (forall x. RemoteMessage conv -> Rep (RemoteMessage conv) x)
-> (forall x. Rep (RemoteMessage conv) x -> RemoteMessage conv)
-> Generic (RemoteMessage conv)
forall x. Rep (RemoteMessage conv) x -> RemoteMessage conv
forall x. RemoteMessage conv -> Rep (RemoteMessage conv) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall conv x. Rep (RemoteMessage conv) x -> RemoteMessage conv
forall conv x. RemoteMessage conv -> Rep (RemoteMessage conv) x
$cfrom :: forall conv x. RemoteMessage conv -> Rep (RemoteMessage conv) x
from :: forall x. RemoteMessage conv -> Rep (RemoteMessage conv) x
$cto :: forall conv x. Rep (RemoteMessage conv) x -> RemoteMessage conv
to :: forall x. Rep (RemoteMessage conv) x -> RemoteMessage conv
Generic, (forall a b. (a -> b) -> RemoteMessage a -> RemoteMessage b)
-> (forall a b. a -> RemoteMessage b -> RemoteMessage a)
-> Functor RemoteMessage
forall a b. a -> RemoteMessage b -> RemoteMessage a
forall a b. (a -> b) -> RemoteMessage a -> RemoteMessage b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> RemoteMessage a -> RemoteMessage b
fmap :: forall a b. (a -> b) -> RemoteMessage a -> RemoteMessage b
$c<$ :: forall a b. a -> RemoteMessage b -> RemoteMessage a
<$ :: forall a b. a -> RemoteMessage b -> RemoteMessage a
Functor)
  deriving (Gen (RemoteMessage conv)
Gen (RemoteMessage conv)
-> (RemoteMessage conv -> [RemoteMessage conv])
-> Arbitrary (RemoteMessage conv)
RemoteMessage conv -> [RemoteMessage conv]
forall a. Gen a -> (a -> [a]) -> Arbitrary a
forall conv. Arbitrary conv => Gen (RemoteMessage conv)
forall conv.
Arbitrary conv =>
RemoteMessage conv -> [RemoteMessage conv]
$carbitrary :: forall conv. Arbitrary conv => Gen (RemoteMessage conv)
arbitrary :: Gen (RemoteMessage conv)
$cshrink :: forall conv.
Arbitrary conv =>
RemoteMessage conv -> [RemoteMessage conv]
shrink :: RemoteMessage conv -> [RemoteMessage conv]
Arbitrary) via (GenericUniform (RemoteMessage conv))
  deriving ([RemoteMessage conv] -> Value
[RemoteMessage conv] -> Encoding
RemoteMessage conv -> Value
RemoteMessage conv -> Encoding
(RemoteMessage conv -> Value)
-> (RemoteMessage conv -> Encoding)
-> ([RemoteMessage conv] -> Value)
-> ([RemoteMessage conv] -> Encoding)
-> ToJSON (RemoteMessage conv)
forall conv. ToJSON conv => [RemoteMessage conv] -> Value
forall conv. ToJSON conv => [RemoteMessage conv] -> Encoding
forall conv. ToJSON conv => RemoteMessage conv -> Value
forall conv. ToJSON conv => RemoteMessage conv -> Encoding
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: forall conv. ToJSON conv => RemoteMessage conv -> Value
toJSON :: RemoteMessage conv -> Value
$ctoEncoding :: forall conv. ToJSON conv => RemoteMessage conv -> Encoding
toEncoding :: RemoteMessage conv -> Encoding
$ctoJSONList :: forall conv. ToJSON conv => [RemoteMessage conv] -> Value
toJSONList :: [RemoteMessage conv] -> Value
$ctoEncodingList :: forall conv. ToJSON conv => [RemoteMessage conv] -> Encoding
toEncodingList :: [RemoteMessage conv] -> Encoding
ToJSON, Value -> Parser [RemoteMessage conv]
Value -> Parser (RemoteMessage conv)
(Value -> Parser (RemoteMessage conv))
-> (Value -> Parser [RemoteMessage conv])
-> FromJSON (RemoteMessage conv)
forall conv. FromJSON conv => Value -> Parser [RemoteMessage conv]
forall conv. FromJSON conv => Value -> Parser (RemoteMessage conv)
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: forall conv. FromJSON conv => Value -> Parser (RemoteMessage conv)
parseJSON :: Value -> Parser (RemoteMessage conv)
$cparseJSONList :: forall conv. FromJSON conv => Value -> Parser [RemoteMessage conv]
parseJSONList :: Value -> Parser [RemoteMessage conv]
FromJSON) via (CustomEncodedLensable (RemoteMessage conv))

instance (ToSchema a) => ToSchema (RemoteMessage a)

data RemoteMLSMessage = RemoteMLSMessage
  { RemoteMLSMessage -> UTCTime
time :: UTCTime,
    RemoteMLSMessage -> MessageMetadata
metadata :: MessageMetadata,
    RemoteMLSMessage -> Qualified UserId
sender :: Qualified UserId,
    RemoteMLSMessage -> ConvId
conversation :: ConvId,
    RemoteMLSMessage -> Maybe SubConvId
subConversation :: Maybe SubConvId,
    RemoteMLSMessage -> Map UserId (NonEmpty ClientId)
recipients :: Map UserId (NonEmpty ClientId),
    RemoteMLSMessage -> Base64ByteString
message :: Base64ByteString
  }
  deriving stock (RemoteMLSMessage -> RemoteMLSMessage -> Bool
(RemoteMLSMessage -> RemoteMLSMessage -> Bool)
-> (RemoteMLSMessage -> RemoteMLSMessage -> Bool)
-> Eq RemoteMLSMessage
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: RemoteMLSMessage -> RemoteMLSMessage -> Bool
== :: RemoteMLSMessage -> RemoteMLSMessage -> Bool
$c/= :: RemoteMLSMessage -> RemoteMLSMessage -> Bool
/= :: RemoteMLSMessage -> RemoteMLSMessage -> Bool
Eq, Int -> RemoteMLSMessage -> ShowS
[RemoteMLSMessage] -> ShowS
RemoteMLSMessage -> String
(Int -> RemoteMLSMessage -> ShowS)
-> (RemoteMLSMessage -> String)
-> ([RemoteMLSMessage] -> ShowS)
-> Show RemoteMLSMessage
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> RemoteMLSMessage -> ShowS
showsPrec :: Int -> RemoteMLSMessage -> ShowS
$cshow :: RemoteMLSMessage -> String
show :: RemoteMLSMessage -> String
$cshowList :: [RemoteMLSMessage] -> ShowS
showList :: [RemoteMLSMessage] -> ShowS
Show, (forall x. RemoteMLSMessage -> Rep RemoteMLSMessage x)
-> (forall x. Rep RemoteMLSMessage x -> RemoteMLSMessage)
-> Generic RemoteMLSMessage
forall x. Rep RemoteMLSMessage x -> RemoteMLSMessage
forall x. RemoteMLSMessage -> Rep RemoteMLSMessage x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. RemoteMLSMessage -> Rep RemoteMLSMessage x
from :: forall x. RemoteMLSMessage -> Rep RemoteMLSMessage x
$cto :: forall x. Rep RemoteMLSMessage x -> RemoteMLSMessage
to :: forall x. Rep RemoteMLSMessage x -> RemoteMLSMessage
Generic)
  deriving (Gen RemoteMLSMessage
Gen RemoteMLSMessage
-> (RemoteMLSMessage -> [RemoteMLSMessage])
-> Arbitrary RemoteMLSMessage
RemoteMLSMessage -> [RemoteMLSMessage]
forall a. Gen a -> (a -> [a]) -> Arbitrary a
$carbitrary :: Gen RemoteMLSMessage
arbitrary :: Gen RemoteMLSMessage
$cshrink :: RemoteMLSMessage -> [RemoteMLSMessage]
shrink :: RemoteMLSMessage -> [RemoteMLSMessage]
Arbitrary) via (GenericUniform RemoteMLSMessage)
  deriving ([RemoteMLSMessage] -> Value
[RemoteMLSMessage] -> Encoding
RemoteMLSMessage -> Value
RemoteMLSMessage -> Encoding
(RemoteMLSMessage -> Value)
-> (RemoteMLSMessage -> Encoding)
-> ([RemoteMLSMessage] -> Value)
-> ([RemoteMLSMessage] -> Encoding)
-> ToJSON RemoteMLSMessage
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: RemoteMLSMessage -> Value
toJSON :: RemoteMLSMessage -> Value
$ctoEncoding :: RemoteMLSMessage -> Encoding
toEncoding :: RemoteMLSMessage -> Encoding
$ctoJSONList :: [RemoteMLSMessage] -> Value
toJSONList :: [RemoteMLSMessage] -> Value
$ctoEncodingList :: [RemoteMLSMessage] -> Encoding
toEncodingList :: [RemoteMLSMessage] -> Encoding
ToJSON, Value -> Parser [RemoteMLSMessage]
Value -> Parser RemoteMLSMessage
(Value -> Parser RemoteMLSMessage)
-> (Value -> Parser [RemoteMLSMessage])
-> FromJSON RemoteMLSMessage
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser RemoteMLSMessage
parseJSON :: Value -> Parser RemoteMLSMessage
$cparseJSONList :: Value -> Parser [RemoteMLSMessage]
parseJSONList :: Value -> Parser [RemoteMLSMessage]
FromJSON) via (CustomEncoded RemoteMLSMessage)

instance ToSchema RemoteMLSMessage

data ConversationUpdateV0 = ConversationUpdateV0
  { ConversationUpdateV0 -> UTCTime
cuTime :: UTCTime,
    ConversationUpdateV0 -> Qualified UserId
cuOrigUserId :: Qualified UserId,
    -- | The unqualified ID of the conversation where the update is happening.
    -- The ID is local to the sender to prevent putting arbitrary domain that
    -- is different than that of the backend making a conversation membership
    -- update request.
    ConversationUpdateV0 -> ConvId
cuConvId :: ConvId,
    -- | A list of users from the receiving backend that need to be sent
    -- notifications about this change. This is required as we do not expect a
    -- non-conversation owning backend to have an indexed mapping of
    -- conversation to users.
    ConversationUpdateV0 -> [UserId]
cuAlreadyPresentUsers :: [UserId],
    -- | Information on the specific action that caused the update.
    ConversationUpdateV0 -> SomeConversationAction
cuAction :: SomeConversationAction
  }
  deriving (ConversationUpdateV0 -> ConversationUpdateV0 -> Bool
(ConversationUpdateV0 -> ConversationUpdateV0 -> Bool)
-> (ConversationUpdateV0 -> ConversationUpdateV0 -> Bool)
-> Eq ConversationUpdateV0
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ConversationUpdateV0 -> ConversationUpdateV0 -> Bool
== :: ConversationUpdateV0 -> ConversationUpdateV0 -> Bool
$c/= :: ConversationUpdateV0 -> ConversationUpdateV0 -> Bool
/= :: ConversationUpdateV0 -> ConversationUpdateV0 -> Bool
Eq, Int -> ConversationUpdateV0 -> ShowS
[ConversationUpdateV0] -> ShowS
ConversationUpdateV0 -> String
(Int -> ConversationUpdateV0 -> ShowS)
-> (ConversationUpdateV0 -> String)
-> ([ConversationUpdateV0] -> ShowS)
-> Show ConversationUpdateV0
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ConversationUpdateV0 -> ShowS
showsPrec :: Int -> ConversationUpdateV0 -> ShowS
$cshow :: ConversationUpdateV0 -> String
show :: ConversationUpdateV0 -> String
$cshowList :: [ConversationUpdateV0] -> ShowS
showList :: [ConversationUpdateV0] -> ShowS
Show, (forall x. ConversationUpdateV0 -> Rep ConversationUpdateV0 x)
-> (forall x. Rep ConversationUpdateV0 x -> ConversationUpdateV0)
-> Generic ConversationUpdateV0
forall x. Rep ConversationUpdateV0 x -> ConversationUpdateV0
forall x. ConversationUpdateV0 -> Rep ConversationUpdateV0 x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ConversationUpdateV0 -> Rep ConversationUpdateV0 x
from :: forall x. ConversationUpdateV0 -> Rep ConversationUpdateV0 x
$cto :: forall x. Rep ConversationUpdateV0 x -> ConversationUpdateV0
to :: forall x. Rep ConversationUpdateV0 x -> ConversationUpdateV0
Generic)

instance ToJSON ConversationUpdateV0

instance FromJSON ConversationUpdateV0

instance ToSchema ConversationUpdateV0

data ConversationUpdate = ConversationUpdate
  { ConversationUpdate -> UTCTime
time :: UTCTime,
    ConversationUpdate -> Qualified UserId
origUserId :: Qualified UserId,
    -- | The unqualified ID of the conversation where the update is happening.
    -- The ID is local to the sender to prevent putting arbitrary domain that
    -- is different than that of the backend making a conversation membership
    -- update request.
    ConversationUpdate -> ConvId
convId :: ConvId,
    -- | A list of users from the receiving backend that need to be sent
    -- notifications about this change. This is required as we do not expect a
    -- non-conversation owning backend to have an indexed mapping of
    -- conversation to users.
    ConversationUpdate -> [UserId]
alreadyPresentUsers :: [UserId],
    -- | Information on the specific action that caused the update.
    ConversationUpdate -> SomeConversationAction
action :: SomeConversationAction
  }
  deriving (ConversationUpdate -> ConversationUpdate -> Bool
(ConversationUpdate -> ConversationUpdate -> Bool)
-> (ConversationUpdate -> ConversationUpdate -> Bool)
-> Eq ConversationUpdate
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ConversationUpdate -> ConversationUpdate -> Bool
== :: ConversationUpdate -> ConversationUpdate -> Bool
$c/= :: ConversationUpdate -> ConversationUpdate -> Bool
/= :: ConversationUpdate -> ConversationUpdate -> Bool
Eq, Int -> ConversationUpdate -> ShowS
[ConversationUpdate] -> ShowS
ConversationUpdate -> String
(Int -> ConversationUpdate -> ShowS)
-> (ConversationUpdate -> String)
-> ([ConversationUpdate] -> ShowS)
-> Show ConversationUpdate
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ConversationUpdate -> ShowS
showsPrec :: Int -> ConversationUpdate -> ShowS
$cshow :: ConversationUpdate -> String
show :: ConversationUpdate -> String
$cshowList :: [ConversationUpdate] -> ShowS
showList :: [ConversationUpdate] -> ShowS
Show, (forall x. ConversationUpdate -> Rep ConversationUpdate x)
-> (forall x. Rep ConversationUpdate x -> ConversationUpdate)
-> Generic ConversationUpdate
forall x. Rep ConversationUpdate x -> ConversationUpdate
forall x. ConversationUpdate -> Rep ConversationUpdate x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ConversationUpdate -> Rep ConversationUpdate x
from :: forall x. ConversationUpdate -> Rep ConversationUpdate x
$cto :: forall x. Rep ConversationUpdate x -> ConversationUpdate
to :: forall x. Rep ConversationUpdate x -> ConversationUpdate
Generic)

instance ToJSON ConversationUpdate

instance FromJSON ConversationUpdate

instance ToSchema ConversationUpdate

conversationUpdateToV0 :: ConversationUpdate -> ConversationUpdateV0
conversationUpdateToV0 :: ConversationUpdate -> ConversationUpdateV0
conversationUpdateToV0 ConversationUpdate
cu =
  ConversationUpdateV0
    { $sel:cuTime:ConversationUpdateV0 :: UTCTime
cuTime = ConversationUpdate
cu.time,
      $sel:cuOrigUserId:ConversationUpdateV0 :: Qualified UserId
cuOrigUserId = ConversationUpdate
cu.origUserId,
      $sel:cuConvId:ConversationUpdateV0 :: ConvId
cuConvId = ConversationUpdate
cu.convId,
      $sel:cuAlreadyPresentUsers:ConversationUpdateV0 :: [UserId]
cuAlreadyPresentUsers = ConversationUpdate
cu.alreadyPresentUsers,
      $sel:cuAction:ConversationUpdateV0 :: SomeConversationAction
cuAction = ConversationUpdate
cu.action
    }

conversationUpdateFromV0 :: ConversationUpdateV0 -> ConversationUpdate
conversationUpdateFromV0 :: ConversationUpdateV0 -> ConversationUpdate
conversationUpdateFromV0 ConversationUpdateV0
cu =
  ConversationUpdate
    { $sel:time:ConversationUpdate :: UTCTime
time = ConversationUpdateV0
cu.cuTime,
      $sel:origUserId:ConversationUpdate :: Qualified UserId
origUserId = ConversationUpdateV0
cu.cuOrigUserId,
      $sel:convId:ConversationUpdate :: ConvId
convId = ConversationUpdateV0
cu.cuConvId,
      $sel:alreadyPresentUsers:ConversationUpdate :: [UserId]
alreadyPresentUsers = ConversationUpdateV0
cu.cuAlreadyPresentUsers,
      $sel:action:ConversationUpdate :: SomeConversationAction
action = ConversationUpdateV0
cu.cuAction
    }

type UserDeletedNotificationMaxConvs = 1000

data UserDeletedConversationsNotification = UserDeletedConversationsNotification
  { -- | This is qualified implicitly by the origin domain
    UserDeletedConversationsNotification -> UserId
user :: UserId,
    -- | These are qualified implicitly by the target domain
    UserDeletedConversationsNotification
-> Range 1 UserDeletedNotificationMaxConvs [ConvId]
conversations :: Range 1 UserDeletedNotificationMaxConvs [ConvId]
  }
  deriving stock (UserDeletedConversationsNotification
-> UserDeletedConversationsNotification -> Bool
(UserDeletedConversationsNotification
 -> UserDeletedConversationsNotification -> Bool)
-> (UserDeletedConversationsNotification
    -> UserDeletedConversationsNotification -> Bool)
-> Eq UserDeletedConversationsNotification
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: UserDeletedConversationsNotification
-> UserDeletedConversationsNotification -> Bool
== :: UserDeletedConversationsNotification
-> UserDeletedConversationsNotification -> Bool
$c/= :: UserDeletedConversationsNotification
-> UserDeletedConversationsNotification -> Bool
/= :: UserDeletedConversationsNotification
-> UserDeletedConversationsNotification -> Bool
Eq, Int -> UserDeletedConversationsNotification -> ShowS
[UserDeletedConversationsNotification] -> ShowS
UserDeletedConversationsNotification -> String
(Int -> UserDeletedConversationsNotification -> ShowS)
-> (UserDeletedConversationsNotification -> String)
-> ([UserDeletedConversationsNotification] -> ShowS)
-> Show UserDeletedConversationsNotification
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> UserDeletedConversationsNotification -> ShowS
showsPrec :: Int -> UserDeletedConversationsNotification -> ShowS
$cshow :: UserDeletedConversationsNotification -> String
show :: UserDeletedConversationsNotification -> String
$cshowList :: [UserDeletedConversationsNotification] -> ShowS
showList :: [UserDeletedConversationsNotification] -> ShowS
Show, (forall x.
 UserDeletedConversationsNotification
 -> Rep UserDeletedConversationsNotification x)
-> (forall x.
    Rep UserDeletedConversationsNotification x
    -> UserDeletedConversationsNotification)
-> Generic UserDeletedConversationsNotification
forall x.
Rep UserDeletedConversationsNotification x
-> UserDeletedConversationsNotification
forall x.
UserDeletedConversationsNotification
-> Rep UserDeletedConversationsNotification x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x.
UserDeletedConversationsNotification
-> Rep UserDeletedConversationsNotification x
from :: forall x.
UserDeletedConversationsNotification
-> Rep UserDeletedConversationsNotification x
$cto :: forall x.
Rep UserDeletedConversationsNotification x
-> UserDeletedConversationsNotification
to :: forall x.
Rep UserDeletedConversationsNotification x
-> UserDeletedConversationsNotification
Generic)
  deriving (Gen UserDeletedConversationsNotification
Gen UserDeletedConversationsNotification
-> (UserDeletedConversationsNotification
    -> [UserDeletedConversationsNotification])
-> Arbitrary UserDeletedConversationsNotification
UserDeletedConversationsNotification
-> [UserDeletedConversationsNotification]
forall a. Gen a -> (a -> [a]) -> Arbitrary a
$carbitrary :: Gen UserDeletedConversationsNotification
arbitrary :: Gen UserDeletedConversationsNotification
$cshrink :: UserDeletedConversationsNotification
-> [UserDeletedConversationsNotification]
shrink :: UserDeletedConversationsNotification
-> [UserDeletedConversationsNotification]
Arbitrary) via (GenericUniform UserDeletedConversationsNotification)
  deriving (Value -> Parser [UserDeletedConversationsNotification]
Value -> Parser UserDeletedConversationsNotification
(Value -> Parser UserDeletedConversationsNotification)
-> (Value -> Parser [UserDeletedConversationsNotification])
-> FromJSON UserDeletedConversationsNotification
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser UserDeletedConversationsNotification
parseJSON :: Value -> Parser UserDeletedConversationsNotification
$cparseJSONList :: Value -> Parser [UserDeletedConversationsNotification]
parseJSONList :: Value -> Parser [UserDeletedConversationsNotification]
FromJSON, [UserDeletedConversationsNotification] -> Value
[UserDeletedConversationsNotification] -> Encoding
UserDeletedConversationsNotification -> Value
UserDeletedConversationsNotification -> Encoding
(UserDeletedConversationsNotification -> Value)
-> (UserDeletedConversationsNotification -> Encoding)
-> ([UserDeletedConversationsNotification] -> Value)
-> ([UserDeletedConversationsNotification] -> Encoding)
-> ToJSON UserDeletedConversationsNotification
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: UserDeletedConversationsNotification -> Value
toJSON :: UserDeletedConversationsNotification -> Value
$ctoEncoding :: UserDeletedConversationsNotification -> Encoding
toEncoding :: UserDeletedConversationsNotification -> Encoding
$ctoJSONList :: [UserDeletedConversationsNotification] -> Value
toJSONList :: [UserDeletedConversationsNotification] -> Value
$ctoEncodingList :: [UserDeletedConversationsNotification] -> Encoding
toEncodingList :: [UserDeletedConversationsNotification] -> Encoding
ToJSON) via (CustomEncoded UserDeletedConversationsNotification)

instance ToSchema UserDeletedConversationsNotification