-- 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 Galley.Data.Conversation
  ( -- * Data Conversation types
    Conversation (..),
    NewConversation,

    -- * Utilities
    isConvDeleted,
    selfConv,
    localOne2OneConvId,
    convAccess,
    convAccessData,
    convAccessRoles,
    convMessageTimer,
    convName,
    convReceiptMode,
    convSetName,
    convType,
    convSetType,
    convTeam,
    defRole,
    maybeRole,
    defRegularConvAccess,
    parseAccessRoles,
  )
where

import Data.Id
import Data.Misc
import Data.Set (Set)
import Data.Set qualified as Set
import Data.UUID.Tagged qualified as U
import Galley.Cassandra.Instances ()
import Galley.Data.Conversation.Types
import Imports hiding (Set)
import Wire.API.Conversation hiding (Conversation)

isConvDeleted :: Conversation -> Bool
isConvDeleted :: Conversation -> Bool
isConvDeleted = Conversation -> Bool
convDeleted

selfConv :: UserId -> ConvId
selfConv :: UserId -> ConvId
selfConv UserId
uid = UUID -> ConvId
forall {k} (a :: k). UUID -> Id a
Id (UserId -> UUID
forall {k} (a :: k). Id a -> UUID
toUUID UserId
uid)

-- | We deduce the conversation ID by adding the 4 components of the V4 UUID
-- together pairwise, and then setting the version bits (v4) and variant bits
-- (variant 2). This means that we always know what the UUID is for a
-- one-to-one conversation which hopefully makes them unique.
localOne2OneConvId :: U.UUID U.V4 -> U.UUID U.V4 -> ConvId
localOne2OneConvId :: UUID V4 -> UUID V4 -> ConvId
localOne2OneConvId UUID V4
a UUID V4
b = UUID -> ConvId
forall {k} (a :: k). UUID -> Id a
Id (UUID -> ConvId) -> (UUID V4 -> UUID) -> UUID V4 -> ConvId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UUID V4 -> UUID
forall {k} (v :: k). UUID v -> UUID
U.unpack (UUID V4 -> ConvId) -> UUID V4 -> ConvId
forall a b. (a -> b) -> a -> b
$ UUID V4 -> UUID V4 -> UUID V4
U.addv4 UUID V4
a UUID V4
b

convType :: Conversation -> ConvType
convType :: Conversation -> ConvType
convType = ConversationMetadata -> ConvType
cnvmType (ConversationMetadata -> ConvType)
-> (Conversation -> ConversationMetadata)
-> Conversation
-> ConvType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Conversation -> ConversationMetadata
convMetadata

convSetType :: ConvType -> Conversation -> Conversation
convSetType :: ConvType -> Conversation -> Conversation
convSetType ConvType
t Conversation
c = Conversation
c {convMetadata = (convMetadata c) {cnvmType = t}}

convTeam :: Conversation -> Maybe TeamId
convTeam :: Conversation -> Maybe TeamId
convTeam = ConversationMetadata -> Maybe TeamId
cnvmTeam (ConversationMetadata -> Maybe TeamId)
-> (Conversation -> ConversationMetadata)
-> Conversation
-> Maybe TeamId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Conversation -> ConversationMetadata
convMetadata

convAccess :: Conversation -> [Access]
convAccess :: Conversation -> [Access]
convAccess = ConversationMetadata -> [Access]
cnvmAccess (ConversationMetadata -> [Access])
-> (Conversation -> ConversationMetadata)
-> Conversation
-> [Access]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Conversation -> ConversationMetadata
convMetadata

convAccessRoles :: Conversation -> Set AccessRole
convAccessRoles :: Conversation -> Set AccessRole
convAccessRoles = ConversationMetadata -> Set AccessRole
cnvmAccessRoles (ConversationMetadata -> Set AccessRole)
-> (Conversation -> ConversationMetadata)
-> Conversation
-> Set AccessRole
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Conversation -> ConversationMetadata
convMetadata

convAccessData :: Conversation -> ConversationAccessData
convAccessData :: Conversation -> ConversationAccessData
convAccessData Conversation
c =
  Set Access -> Set AccessRole -> ConversationAccessData
ConversationAccessData
    ([Access] -> Set Access
forall a. Ord a => [a] -> Set a
Set.fromList (Conversation -> [Access]
convAccess Conversation
c))
    (Conversation -> Set AccessRole
convAccessRoles Conversation
c)

convName :: Conversation -> Maybe Text
convName :: Conversation -> Maybe Text
convName = ConversationMetadata -> Maybe Text
cnvmName (ConversationMetadata -> Maybe Text)
-> (Conversation -> ConversationMetadata)
-> Conversation
-> Maybe Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Conversation -> ConversationMetadata
convMetadata

convSetName :: Maybe Text -> Conversation -> Conversation
convSetName :: Maybe Text -> Conversation -> Conversation
convSetName Maybe Text
n Conversation
c = Conversation
c {convMetadata = (convMetadata c) {cnvmName = n}}

defRegularConvAccess :: [Access]
defRegularConvAccess :: [Access]
defRegularConvAccess = [Access
InviteAccess]

parseAccessRoles :: Maybe AccessRoleLegacy -> Maybe (Set AccessRole) -> Maybe (Set AccessRole)
parseAccessRoles :: Maybe AccessRoleLegacy
-> Maybe (Set AccessRole) -> Maybe (Set AccessRole)
parseAccessRoles Maybe AccessRoleLegacy
mbLegacy Maybe (Set AccessRole)
mbAccess = Maybe (Set AccessRole)
mbAccess Maybe (Set AccessRole)
-> Maybe (Set AccessRole) -> Maybe (Set AccessRole)
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> AccessRoleLegacy -> Set AccessRole
fromAccessRoleLegacy (AccessRoleLegacy -> Set AccessRole)
-> Maybe AccessRoleLegacy -> Maybe (Set AccessRole)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe AccessRoleLegacy
mbLegacy

convMessageTimer :: Conversation -> Maybe Milliseconds
convMessageTimer :: Conversation -> Maybe Milliseconds
convMessageTimer = ConversationMetadata -> Maybe Milliseconds
cnvmMessageTimer (ConversationMetadata -> Maybe Milliseconds)
-> (Conversation -> ConversationMetadata)
-> Conversation
-> Maybe Milliseconds
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Conversation -> ConversationMetadata
convMetadata

convReceiptMode :: Conversation -> Maybe ReceiptMode
convReceiptMode :: Conversation -> Maybe ReceiptMode
convReceiptMode = ConversationMetadata -> Maybe ReceiptMode
cnvmReceiptMode (ConversationMetadata -> Maybe ReceiptMode)
-> (Conversation -> ConversationMetadata)
-> Conversation
-> Maybe ReceiptMode
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Conversation -> ConversationMetadata
convMetadata