{-# LANGUAGE OverloadedLabels #-}
{-# OPTIONS_GHC -Wno-ambiguous-fields #-}

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

import API.Common
import Control.Lens hiding ((.=))
import Control.Monad.Reader
import Control.Retry
import qualified Data.Aeson as Aeson
import qualified Data.Aeson.Types as Aeson
import qualified Data.ByteString.Base64 as B64
import qualified Data.ByteString.Base64.URL as B64U
import qualified Data.ByteString.Char8 as BS
import qualified Data.ByteString.Lazy as LBS
import qualified Data.ProtoLens as Proto
import Data.ProtoLens.Labels ()
import qualified Data.UUID as UUID
import Numeric.Lens
import Proto.Otr as Proto
import Testlib.Prelude

data CreateConv = CreateConv
  { CreateConv -> [Value]
qualifiedUsers :: [Value],
    CreateConv -> Maybe String
name :: Maybe String,
    CreateConv -> Maybe [String]
access :: Maybe [String],
    CreateConv -> Maybe [String]
accessRole :: Maybe [String],
    CreateConv -> Maybe String
team :: Maybe String,
    CreateConv -> Maybe Int
messageTimer :: Maybe Int,
    CreateConv -> Maybe Int
receiptMode :: Maybe Int,
    CreateConv -> String
newUsersRole :: String,
    CreateConv -> String
protocol :: String,
    CreateConv -> Maybe String
groupConvType :: Maybe String,
    CreateConv -> Bool
cells :: Bool,
    CreateConv -> Maybe String
addPermission :: Maybe String,
    CreateConv -> Maybe Bool
skipCreator :: Maybe Bool,
    CreateConv -> Maybe String
parent :: Maybe String
  }

defProteus :: CreateConv
defProteus :: CreateConv
defProteus =
  CreateConv
    { qualifiedUsers :: [Value]
qualifiedUsers = [],
      name :: Maybe String
name = Maybe String
forall a. Maybe a
Nothing,
      access :: Maybe [String]
access = Maybe [String]
forall a. Maybe a
Nothing,
      accessRole :: Maybe [String]
accessRole = Maybe [String]
forall a. Maybe a
Nothing,
      team :: Maybe String
team = Maybe String
forall a. Maybe a
Nothing,
      messageTimer :: Maybe Int
messageTimer = Maybe Int
forall a. Maybe a
Nothing,
      receiptMode :: Maybe Int
receiptMode = Maybe Int
forall a. Maybe a
Nothing,
      newUsersRole :: String
newUsersRole = String
"wire_admin",
      protocol :: String
protocol = String
"proteus",
      groupConvType :: Maybe String
groupConvType = Maybe String
forall a. Maybe a
Nothing,
      cells :: Bool
cells = Bool
False,
      addPermission :: Maybe String
addPermission = Maybe String
forall a. Maybe a
Nothing,
      skipCreator :: Maybe Bool
skipCreator = Maybe Bool
forall a. Maybe a
Nothing,
      parent :: Maybe String
parent = Maybe String
forall a. Maybe a
Nothing
    }

defMLS :: CreateConv
defMLS :: CreateConv
defMLS = CreateConv
defProteus {protocol = "mls"}

defConv :: ConversationProtocol -> CreateConv
defConv :: ConversationProtocol -> CreateConv
defConv ConversationProtocol
ConversationProtocolProteus = CreateConv
defProteus
defConv ConversationProtocol
ConversationProtocolMLS = CreateConv
defMLS

allowGuests :: CreateConv -> CreateConv
allowGuests :: CreateConv -> CreateConv
allowGuests CreateConv
cc =
  CreateConv
cc
    { access = Just ["code"],
      accessRole = Just ["team_member", "guest"]
    }

instance MakesValue CreateConv where
  make :: HasCallStack => CreateConv -> App Value
make CreateConv
cc = do
    quids <- [Value] -> (Value -> App Value) -> App [Value]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for (CreateConv
cc.qualifiedUsers) Value -> App Value
forall a. (HasCallStack, MakesValue a) => a -> App Value
objQidObject
    pure
      $ Aeson.object
      $ ( [ "qualified_users" .= quids,
            "conversation_role" .= cc.newUsersRole,
            "protocol" .= cc.protocol,
            "cells" .= cc.cells
          ]
            <> catMaybes
              [ "name" .=? cc.name,
                "access" .=? cc.access,
                "access_role_v2" .=? cc.access,
                "team" .=? (cc.team <&> \String
tid -> [Pair] -> Value
Aeson.object [String
"teamid" String -> String -> Pair
forall a. ToJSON a => String -> a -> Pair
.= String
tid, String
"managed" String -> Bool -> Pair
forall a. ToJSON a => String -> a -> Pair
.= Bool
False]),
                "message_timer" .=? cc.messageTimer,
                "receipt_mode" .=? cc.receiptMode,
                "group_conv_type" .=? cc.groupConvType,
                "add_permission" .=? cc.addPermission,
                "skip_creator" .=? cc.skipCreator,
                "parent" .=? cc.parent
              ]
        )

postConversation ::
  ( HasCallStack,
    MakesValue user
  ) =>
  user ->
  CreateConv ->
  App Response
postConversation :: forall user.
(HasCallStack, MakesValue user) =>
user -> CreateConv -> App Response
postConversation user
user CreateConv
cc = do
  req <- user -> Service -> Versioned -> String -> App Request
forall user.
(HasCallStack, MakesValue user) =>
user -> Service -> Versioned -> String -> App Request
baseRequest user
user Service
Galley Versioned
Versioned String
"/conversations"
  ccv <- make cc
  submit "POST" $ req & addJSON ccv

deleteTeamConversation ::
  ( HasCallStack,
    MakesValue user,
    MakesValue conv
  ) =>
  String ->
  conv ->
  user ->
  App Response
deleteTeamConversation :: forall user conv.
(HasCallStack, MakesValue user, MakesValue conv) =>
String -> conv -> user -> App Response
deleteTeamConversation String
tid conv
qcnv user
user = do
  cnv <- (String, String) -> String
forall a b. (a, b) -> b
snd ((String, String) -> String) -> App (String, String) -> App String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> conv -> App (String, String)
forall a. (HasCallStack, MakesValue a) => a -> App (String, String)
objQid conv
qcnv
  let path = [String] -> String
joinHttpPath [String
"teams", String
tid, String
"conversations", String
cnv]
  req <- baseRequest user Galley Versioned path
  submit "DELETE" req

deleteTeamMember ::
  ( HasCallStack,
    MakesValue owner,
    MakesValue member
  ) =>
  String ->
  owner ->
  member ->
  App Response
deleteTeamMember :: forall owner member.
(HasCallStack, MakesValue owner, MakesValue member) =>
String -> owner -> member -> App Response
deleteTeamMember String
tid owner
owner member
mem = do
  memId <- member -> App String
forall a. (HasCallStack, MakesValue a) => a -> App String
objId member
mem
  let path = [String] -> String
joinHttpPath [String
"teams", String
tid, String
"members", String
memId]
  req <- baseRequest owner Galley Versioned path
  submit "DELETE" (addJSONObject ["password" .= defPassword] req)

data TeamPermissions = Partner | Member | Admin | Owner

instance ToJSON TeamPermissions where
  toJSON :: TeamPermissions -> Value
toJSON TeamPermissions
perms = [Pair] -> Value
object [String
"self" String -> Value -> Pair
forall a. ToJSON a => String -> a -> Pair
.= TeamPermissions -> Value
toInt TeamPermissions
perms, String
"copy" String -> Value -> Pair
forall a. ToJSON a => String -> a -> Pair
.= TeamPermissions -> Value
toInt TeamPermissions
perms]
    where
      toInt :: TeamPermissions -> Value
toInt TeamPermissions
Partner = Scientific -> Value
Number Scientific
1025
      toInt TeamPermissions
Member = Scientific -> Value
Number Scientific
1587
      toInt TeamPermissions
Admin = Scientific -> Value
Number Scientific
5951
      toInt TeamPermissions
Owner = Scientific -> Value
Number Scientific
8191

updateTeamMember :: (HasCallStack, MakesValue user, MakesValue member) => String -> user -> member -> TeamPermissions -> App Response
updateTeamMember :: forall user member.
(HasCallStack, MakesValue user, MakesValue member) =>
String -> user -> member -> TeamPermissions -> App Response
updateTeamMember String
tid user
owner member
mem TeamPermissions
permissions = do
  memId <- member -> App String
forall a. (HasCallStack, MakesValue a) => a -> App String
objId member
mem
  let path = [String] -> String
joinHttpPath [String
"teams", String
tid, String
"members"]
  req <- baseRequest owner Galley Versioned path
  submit "PUT" (req & addJSONObject ["member" .= object ["user" .= memId, "permissions" .= permissions]])

putConversationProtocol ::
  ( HasCallStack,
    MakesValue user,
    MakesValue protocol
  ) =>
  user ->
  ConvId ->
  protocol ->
  App Response
putConversationProtocol :: forall user protocol.
(HasCallStack, MakesValue user, MakesValue protocol) =>
user -> ConvId -> protocol -> App Response
putConversationProtocol user
user ConvId
convId protocol
protocol = do
  p <- protocol -> App String
forall a. (HasCallStack, MakesValue a) => a -> App String
asString protocol
protocol
  req <- baseRequest user Galley Versioned (joinHttpPath ["conversations", convId.domain, convId.id_, "protocol"])
  submit "PUT" (req & addJSONObject ["protocol" .= p])

getConversation ::
  ( HasCallStack,
    MakesValue user,
    MakesValue qcnv
  ) =>
  user ->
  qcnv ->
  App Response
getConversation :: forall user qcnv.
(HasCallStack, MakesValue user, MakesValue qcnv) =>
user -> qcnv -> App Response
getConversation user
user qcnv
qcnv = do
  (domain, cnv) <- qcnv -> App (String, String)
forall a. (HasCallStack, MakesValue a) => a -> App (String, String)
objQid qcnv
qcnv
  req <- baseRequest user Galley Versioned (joinHttpPath ["conversations", domain, cnv])
  submit "GET" req

getConversationInternal ::
  ( HasCallStack,
    MakesValue user,
    MakesValue qcnv
  ) =>
  user ->
  qcnv ->
  App Response
getConversationInternal :: forall user qcnv.
(HasCallStack, MakesValue user, MakesValue qcnv) =>
user -> qcnv -> App Response
getConversationInternal user
user qcnv
qcnv = do
  (_domain, cnv) <- qcnv -> App (String, String)
forall a. (HasCallStack, MakesValue a) => a -> App (String, String)
objQid qcnv
qcnv
  req <- baseRequest user Galley Unversioned (joinHttpPath ["i", "conversations", cnv])
  submit "GET" req

getSubConversation ::
  ( HasCallStack,
    MakesValue user
  ) =>
  user ->
  ConvId ->
  String ->
  App Response
getSubConversation :: forall user.
(HasCallStack, MakesValue user) =>
user -> ConvId -> String -> App Response
getSubConversation user
user ConvId
conv String
sub = do
  req <-
    user -> Service -> Versioned -> String -> App Request
forall user.
(HasCallStack, MakesValue user) =>
user -> Service -> Versioned -> String -> App Request
baseRequest user
user Service
Galley Versioned
Versioned
      (String -> App Request) -> String -> App Request
forall a b. (a -> b) -> a -> b
$ [String] -> String
joinHttpPath
        [ String
"conversations",
          ConvId
conv.domain,
          ConvId
conv.id_,
          String
"subconversations",
          String
sub
        ]
  submit "GET" req

deleteSubConversation ::
  (HasCallStack, MakesValue user, MakesValue sub) =>
  user ->
  sub ->
  App Response
deleteSubConversation :: forall user qcnv.
(HasCallStack, MakesValue user, MakesValue qcnv) =>
user -> qcnv -> App Response
deleteSubConversation user
user sub
sub = do
  (conv, Just subId) <- sub -> App (Value, Maybe String)
forall a.
(HasCallStack, MakesValue a) =>
a -> App (Value, Maybe String)
objSubConv sub
sub
  (domain, convId) <- objQid conv
  groupId <- sub %. "group_id" & asString
  epoch :: Int <- sub %. "epoch" & asIntegral
  req <-
    baseRequest user Galley Versioned
      $ joinHttpPath ["conversations", domain, convId, "subconversations", subId]
  submit "DELETE" $ req & addJSONObject ["group_id" .= groupId, "epoch" .= epoch]

leaveSubConversation ::
  (HasCallStack, MakesValue user) =>
  user ->
  ConvId ->
  App Response
leaveSubConversation :: forall user.
(HasCallStack, MakesValue user) =>
user -> ConvId -> App Response
leaveSubConversation user
user ConvId
convId = do
  let Just String
subId = ConvId
convId.subconvId
  req <-
    user -> Service -> Versioned -> String -> App Request
forall user.
(HasCallStack, MakesValue user) =>
user -> Service -> Versioned -> String -> App Request
baseRequest user
user Service
Galley Versioned
Versioned
      (String -> App Request) -> String -> App Request
forall a b. (a -> b) -> a -> b
$ [String] -> String
joinHttpPath [String
"conversations", ConvId
convId.domain, ConvId
convId.id_, String
"subconversations", String
subId, String
"self"]
  submit "DELETE" req

getSelfConversation :: (HasCallStack, MakesValue user) => user -> App Response
getSelfConversation :: forall user.
(HasCallStack, MakesValue user) =>
user -> App Response
getSelfConversation user
user = do
  req <- user -> Service -> Versioned -> String -> App Request
forall user.
(HasCallStack, MakesValue user) =>
user -> Service -> Versioned -> String -> App Request
baseRequest user
user Service
Galley Versioned
Versioned String
"/conversations/mls-self"
  submit "GET" $ req

data ListConversationIds = ListConversationIds {ListConversationIds -> Maybe String
pagingState :: Maybe String, ListConversationIds -> Maybe Int
size :: Maybe Int}

instance Default ListConversationIds where
  def :: ListConversationIds
def = Maybe String -> Maybe Int -> ListConversationIds
ListConversationIds Maybe String
forall a. Maybe a
Nothing Maybe Int
forall a. Maybe a
Nothing

listConversationIds :: (MakesValue user) => user -> ListConversationIds -> App Response
listConversationIds :: forall user.
MakesValue user =>
user -> ListConversationIds -> App Response
listConversationIds user
user ListConversationIds
args = do
  req <- user -> Service -> Versioned -> String -> App Request
forall user.
(HasCallStack, MakesValue user) =>
user -> Service -> Versioned -> String -> App Request
baseRequest user
user Service
Galley Versioned
Versioned String
"/conversations/list-ids"
  submit "POST"
    $ req
    & addJSONObject
      ( ["paging_state" .= s | s <- toList args.pagingState]
          <> ["size" .= s | s <- toList args.size]
      )

listConversations :: (MakesValue user) => user -> [Value] -> App Response
listConversations :: forall user. MakesValue user => user -> [Value] -> App Response
listConversations user
user [Value]
cnvs = do
  req <- user -> Service -> Versioned -> String -> App Request
forall user.
(HasCallStack, MakesValue user) =>
user -> Service -> Versioned -> String -> App Request
baseRequest user
user Service
Galley Versioned
Versioned String
"/conversations/list"
  submit "POST"
    $ req
    & addJSONObject ["qualified_ids" .= cnvs]

getMLSPublicKeys :: (HasCallStack, MakesValue user) => user -> App Response
getMLSPublicKeys :: forall user.
(HasCallStack, MakesValue user) =>
user -> App Response
getMLSPublicKeys user
user = do
  req <- user -> Service -> Versioned -> String -> App Request
forall user.
(HasCallStack, MakesValue user) =>
user -> Service -> Versioned -> String -> App Request
baseRequest user
user Service
Galley Versioned
Versioned String
"/mls/public-keys"
  submit "GET" req

getMLSPublicKeysJWK :: (HasCallStack, MakesValue user) => user -> App Response
getMLSPublicKeysJWK :: forall user.
(HasCallStack, MakesValue user) =>
user -> App Response
getMLSPublicKeysJWK user
user = do
  req <- user -> Service -> Versioned -> String -> App Request
forall user.
(HasCallStack, MakesValue user) =>
user -> Service -> Versioned -> String -> App Request
baseRequest user
user Service
Galley Versioned
Versioned String
"/mls/public-keys"
  submit "GET" $ addQueryParams [("format", "jwk")] req

postMLSMessage :: (HasCallStack) => ClientIdentity -> ByteString -> App Response
postMLSMessage :: HasCallStack => ClientIdentity -> ByteString -> App Response
postMLSMessage ClientIdentity
cid ByteString
msg = do
  req <- ClientIdentity -> Service -> Versioned -> String -> App Request
forall user.
(HasCallStack, MakesValue user) =>
user -> Service -> Versioned -> String -> App Request
baseRequest ClientIdentity
cid Service
Galley Versioned
Versioned String
"/mls/messages"
  submit "POST" (addMLS msg req)

postMLSCommitBundle :: (HasCallStack) => ClientIdentity -> ByteString -> App Response
postMLSCommitBundle :: HasCallStack => ClientIdentity -> ByteString -> App Response
postMLSCommitBundle ClientIdentity
cid ByteString
msg = do
  req <- ClientIdentity -> Service -> Versioned -> String -> App Request
forall user.
(HasCallStack, MakesValue user) =>
user -> Service -> Versioned -> String -> App Request
baseRequest ClientIdentity
cid Service
Galley Versioned
Versioned String
"/mls/commit-bundles"
  submit "POST" (addMLS msg req)

postProteusMessage :: (HasCallStack, MakesValue user, MakesValue conv) => user -> conv -> QualifiedNewOtrMessage -> App Response
postProteusMessage :: forall user conv.
(HasCallStack, MakesValue user, MakesValue conv) =>
user -> conv -> QualifiedNewOtrMessage -> App Response
postProteusMessage user
user conv
conv QualifiedNewOtrMessage
msgs = do
  convDomain <- conv -> App String
forall a. (HasCallStack, MakesValue a) => a -> App String
objDomain conv
conv
  convId <- objQidObject conv & objId
  let bytes = QualifiedNewOtrMessage -> ByteString
forall msg. Message msg => msg -> ByteString
Proto.encodeMessage QualifiedNewOtrMessage
msgs
  req <- baseRequest user Galley Versioned (joinHttpPath ["conversations", convDomain, convId, "proteus", "messages"])
  submit "POST" (addProtobuf bytes req)

mkProteusRecipient :: (HasCallStack, MakesValue user, MakesValue client) => user -> client -> String -> App Proto.QualifiedUserEntry
mkProteusRecipient :: forall user client.
(HasCallStack, MakesValue user, MakesValue client) =>
user -> client -> String -> App QualifiedUserEntry
mkProteusRecipient user
user client
client = user -> [(user, [client])] -> String -> App QualifiedUserEntry
forall domain user client.
(HasCallStack, MakesValue domain, MakesValue user,
 MakesValue client) =>
domain -> [(user, [client])] -> String -> App QualifiedUserEntry
mkProteusRecipients user
user [(user
user, [client
client])]

mkProteusRecipients :: (HasCallStack, MakesValue domain, MakesValue user, MakesValue client) => domain -> [(user, [client])] -> String -> App Proto.QualifiedUserEntry
mkProteusRecipients :: forall domain user client.
(HasCallStack, MakesValue domain, MakesValue user,
 MakesValue client) =>
domain -> [(user, [client])] -> String -> App QualifiedUserEntry
mkProteusRecipients domain
dom [(user, [client])]
userClients String
msg = do
  userDomain <- String -> App String
forall a. (HasCallStack, MakesValue a) => a -> App String
asString (String -> App String) -> App String -> App String
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< domain -> App String
forall a. (HasCallStack, MakesValue a) => a -> App String
objDomain domain
dom
  userEntries <- mapM mkUserEntry userClients
  pure
    $ Proto.defMessage
    & #domain .~ fromString userDomain
    & #entries .~ userEntries
  where
    mkUserEntry :: (user, [client]) -> App UserEntry
mkUserEntry (user
user, [client]
clients) = do
      userId <- LazyByteString -> ByteString
LBS.toStrict (LazyByteString -> ByteString)
-> (String -> LazyByteString) -> String -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UUID -> LazyByteString
UUID.toByteString (UUID -> LazyByteString)
-> (String -> UUID) -> String -> LazyByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe UUID -> UUID
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe UUID -> UUID) -> (String -> Maybe UUID) -> String -> UUID
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Maybe UUID
UUID.fromString (String -> ByteString) -> App String -> App ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> user -> App String
forall a. (HasCallStack, MakesValue a) => a -> App String
objId user
user
      clientEntries <- mapM mkClientEntry clients
      pure
        $ Proto.defMessage
        & #user . #uuid .~ userId
        & #clients .~ clientEntries
    mkClientEntry :: client -> App ClientEntry
mkClientEntry client
client = do
      clientId <- (String -> Getting (Endo Word64) String Word64 -> Word64
forall s a. HasCallStack => s -> Getting (Endo a) s a -> a
^?! Getting (Endo Word64) String Word64
forall a. Integral a => Prism' String a
Prism' String Word64
hex) (String -> Word64) -> App String -> App Word64
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> client -> App String
forall a. (HasCallStack, MakesValue a) => a -> App String
objId client
client
      pure
        $ Proto.defMessage
        & #client . #client .~ clientId
        & #text .~ fromString msg

getGroupInfo ::
  (HasCallStack, MakesValue user) =>
  user ->
  ConvId ->
  App Response
getGroupInfo :: forall user.
(HasCallStack, MakesValue user) =>
user -> ConvId -> App Response
getGroupInfo user
user ConvId
conv = do
  let path :: String
path = [String] -> String
joinHttpPath ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ case ConvId
conv.subconvId of
        Maybe String
Nothing -> [String
"conversations", ConvId
conv.domain, ConvId
conv.id_, String
"groupinfo"]
        Just String
sub -> [String
"conversations", ConvId
conv.domain, ConvId
conv.id_, String
"subconversations", String
sub, String
"groupinfo"]
  req <- user -> Service -> Versioned -> String -> App Request
forall user.
(HasCallStack, MakesValue user) =>
user -> Service -> Versioned -> String -> App Request
baseRequest user
user Service
Galley Versioned
Versioned String
path
  submit "GET" req

removeConversationMember ::
  (HasCallStack, MakesValue user, MakesValue conv) =>
  user ->
  conv ->
  App Response
removeConversationMember :: forall user qcnv.
(HasCallStack, MakesValue user, MakesValue qcnv) =>
user -> qcnv -> App Response
removeConversationMember user
user conv
conv = do
  (convDomain, convId) <- conv -> App (String, String)
forall a. (HasCallStack, MakesValue a) => a -> App (String, String)
objQid conv
conv
  (userDomain, userId) <- objQid user
  req <- baseRequest user Galley Versioned (joinHttpPath ["conversations", convDomain, convId, "members", userDomain, userId])
  submit "DELETE" req

updateConversationMember ::
  (HasCallStack, MakesValue user, MakesValue conv, MakesValue target) =>
  user ->
  conv ->
  target ->
  String ->
  App Response
updateConversationMember :: forall user conv target.
(HasCallStack, MakesValue user, MakesValue conv,
 MakesValue target) =>
user -> conv -> target -> String -> App Response
updateConversationMember user
user conv
conv target
target String
role = do
  (convDomain, convId) <- conv -> App (String, String)
forall a. (HasCallStack, MakesValue a) => a -> App (String, String)
objQid conv
conv
  (targetDomain, targetId) <- objQid target
  req <- baseRequest user Galley Versioned (joinHttpPath ["conversations", convDomain, convId, "members", targetDomain, targetId])
  submit "PUT" (req & addJSONObject ["conversation_role" .= role])

updateChannelAddPermission :: (HasCallStack, MakesValue user, MakesValue conv) => user -> conv -> String -> App Response
updateChannelAddPermission :: forall user conv.
(HasCallStack, MakesValue user, MakesValue conv) =>
user -> conv -> String -> App Response
updateChannelAddPermission user
user conv
conv String
perm = do
  (convDomain, convId) <- conv -> App (String, String)
forall a. (HasCallStack, MakesValue a) => a -> App (String, String)
objQid conv
conv
  req <- baseRequest user Galley Versioned (joinHttpPath ["conversations", convDomain, convId, "add-permission"])
  submit "PUT" (req & addJSONObject ["add_permission" .= perm])

deleteTeamConv ::
  (HasCallStack, MakesValue team, MakesValue conv, MakesValue user) =>
  team ->
  conv ->
  user ->
  App Response
deleteTeamConv :: forall team conv user.
(HasCallStack, MakesValue team, MakesValue conv,
 MakesValue user) =>
team -> conv -> user -> App Response
deleteTeamConv team
team conv
conv user
user = do
  teamId <- team -> App String
forall a. (HasCallStack, MakesValue a) => a -> App String
objId team
team
  convId <- objId $ objQidObject conv
  req <- baseRequest user Galley Versioned (joinHttpPath ["teams", teamId, "conversations", convId])
  submit "DELETE" req

getMLSOne2OneConversationLegacy ::
  (HasCallStack, MakesValue self, MakesValue other) =>
  self ->
  other ->
  App Response
getMLSOne2OneConversationLegacy :: forall user qcnv.
(HasCallStack, MakesValue user, MakesValue qcnv) =>
user -> qcnv -> App Response
getMLSOne2OneConversationLegacy self
self other
other = do
  (domain, uid) <- other -> App (String, String)
forall a. (HasCallStack, MakesValue a) => a -> App (String, String)
objQid other
other
  req <-
    baseRequest self Galley Versioned
      $ joinHttpPath ["conversations", "one2one", domain, uid]
  submit "GET" req

getMLSOne2OneConversation ::
  (HasCallStack, MakesValue self, MakesValue other) =>
  self ->
  other ->
  App Response
getMLSOne2OneConversation :: forall user qcnv.
(HasCallStack, MakesValue user, MakesValue qcnv) =>
user -> qcnv -> App Response
getMLSOne2OneConversation self
self other
other = do
  (domain, uid) <- other -> App (String, String)
forall a. (HasCallStack, MakesValue a) => a -> App (String, String)
objQid other
other
  req <-
    baseRequest self Galley Versioned
      $ joinHttpPath ["one2one-conversations", domain, uid]
  submit "GET" req

postOne2OneConversation ::
  (HasCallStack, MakesValue self, MakesValue other) =>
  self ->
  other ->
  String ->
  String ->
  App Response
postOne2OneConversation :: forall self other.
(HasCallStack, MakesValue self, MakesValue other) =>
self -> other -> String -> String -> App Response
postOne2OneConversation self
self other
other String
tid String
convName = do
  qUid <- other -> App Value
forall a. (HasCallStack, MakesValue a) => a -> App Value
objQidObject other
other
  req <-
    baseRequest self Galley Versioned
      $ joinHttpPath ["one2one-conversations"]
  submit
    "POST"
    ( req
        & addJSONObject
          [ "name" .= convName,
            "qualified_users" .= [qUid],
            "team" .= Aeson.object ["teamid" .= tid, "managed" .= False]
          ]
    )

getGroupClients ::
  (HasCallStack, MakesValue user) =>
  user ->
  String ->
  App Response
getGroupClients :: forall user.
(HasCallStack, MakesValue user) =>
user -> String -> App Response
getGroupClients user
user String
groupId = do
  req <-
    user -> Service -> Versioned -> String -> App Request
forall user.
(HasCallStack, MakesValue user) =>
user -> Service -> Versioned -> String -> App Request
baseRequest
      user
user
      Service
Galley
      Versioned
Unversioned
      ([String] -> String
joinHttpPath [String
"i", String
"group", ByteString -> String
BS.unpack (ByteString -> String)
-> (ByteString -> ByteString) -> ByteString -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
B64U.encodeUnpadded (ByteString -> ByteString)
-> (ByteString -> ByteString) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
B64.decodeLenient (ByteString -> String) -> ByteString -> String
forall a b. (a -> b) -> a -> b
$ String -> ByteString
BS.pack String
groupId])
  submit "GET" req

data AddMembers = AddMembers
  { AddMembers -> [Value]
users :: [Value],
    AddMembers -> Maybe String
role :: Maybe String,
    AddMembers -> Maybe Int
version :: Maybe Int
  }

instance Default AddMembers where
  def :: AddMembers
def = AddMembers {users :: [Value]
users = [], role :: Maybe String
role = Maybe String
forall a. Maybe a
Nothing, version :: Maybe Int
version = Maybe Int
forall a. Maybe a
Nothing}

addMembers ::
  (HasCallStack, MakesValue user, MakesValue conv) =>
  user ->
  conv ->
  AddMembers ->
  App Response
addMembers :: forall user conv.
(HasCallStack, MakesValue user, MakesValue conv) =>
user -> conv -> AddMembers -> App Response
addMembers user
usr conv
qcnv AddMembers
opts = do
  (convDomain, convId) <- conv -> App (String, String)
forall a. (HasCallStack, MakesValue a) => a -> App (String, String)
objQid conv
qcnv
  qUsers <- mapM objQidObject opts.users
  let path = case AddMembers
opts.version of
        Just Int
v | Int
v Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
1 -> [String
"conversations", String
convId, String
"members", String
"v2"]
        Maybe Int
_ -> [String
"conversations", String
convDomain, String
convId, String
"members"]
  req <-
    baseRequest
      usr
      Galley
      (maybe Versioned ExplicitVersion opts.version)
      (joinHttpPath path)
  submit "POST"
    $ req
    & addJSONObject
      ( ["qualified_users" .= qUsers]
          <> ["conversation_role" .= r | r <- toList opts.role]
      )

replaceMembers ::
  (HasCallStack, MakesValue user, MakesValue conv) =>
  user ->
  conv ->
  AddMembers ->
  App Response
replaceMembers :: forall user conv.
(HasCallStack, MakesValue user, MakesValue conv) =>
user -> conv -> AddMembers -> App Response
replaceMembers user
usr conv
qcnv AddMembers
opts = do
  (convDomain, convId) <- conv -> App (String, String)
forall a. (HasCallStack, MakesValue a) => a -> App (String, String)
objQid conv
qcnv
  qUsers <- mapM objQidObject opts.users
  let path = [String
"conversations", String
convDomain, String
convId, String
"members"]
  req <-
    baseRequest
      usr
      Galley
      (maybe Versioned ExplicitVersion opts.version)
      (joinHttpPath path)
  submit "PUT"
    $ req
    & addJSONObject
      ( ["qualified_users" .= qUsers]
          <> ["conversation_role" .= r | r <- toList opts.role]
      )

removeMember :: (HasCallStack, MakesValue remover, MakesValue conv, MakesValue removed) => remover -> conv -> removed -> App Response
removeMember :: forall team conv user.
(HasCallStack, MakesValue team, MakesValue conv,
 MakesValue user) =>
team -> conv -> user -> App Response
removeMember remover
remover conv
qcnv removed
removed = do
  (convDomain, convId) <- conv -> App (String, String)
forall a. (HasCallStack, MakesValue a) => a -> App (String, String)
objQid conv
qcnv
  (removedDomain, removedId) <- objQid removed
  req <- baseRequest remover Galley Versioned (joinHttpPath ["conversations", convDomain, convId, "members", removedDomain, removedId])
  submit "DELETE" req

postConversationCode ::
  (HasCallStack, MakesValue user, MakesValue conv) =>
  user ->
  conv ->
  Maybe String ->
  Maybe String ->
  App Response
postConversationCode :: forall user conv.
(HasCallStack, MakesValue user, MakesValue conv) =>
user -> conv -> Maybe String -> Maybe String -> App Response
postConversationCode user
user conv
conv Maybe String
mbpassword Maybe String
mbZHost = do
  convId <- conv -> App Value
forall a. (HasCallStack, MakesValue a) => a -> App Value
objQidObject conv
conv App Value -> (App Value -> App String) -> App String
forall a b. a -> (a -> b) -> b
& App Value -> App String
forall a. (HasCallStack, MakesValue a) => a -> App String
objId
  req <- baseRequest user Galley Versioned (joinHttpPath ["conversations", convId, "code"])
  submit
    "POST"
    ( req
        & addJSONObject ["password" .= pw | pw <- maybeToList mbpassword]
        & maybe id zHost mbZHost
    )

getConversationCode ::
  (HasCallStack, MakesValue user, MakesValue conv) =>
  user ->
  conv ->
  Maybe String ->
  App Response
getConversationCode :: forall user conv.
(HasCallStack, MakesValue user, MakesValue conv) =>
user -> conv -> Maybe String -> App Response
getConversationCode user
user conv
conv Maybe String
mbZHost = do
  convId <- conv -> App Value
forall a. (HasCallStack, MakesValue a) => a -> App Value
objQidObject conv
conv App Value -> (App Value -> App String) -> App String
forall a b. a -> (a -> b) -> b
& App Value -> App String
forall a. (HasCallStack, MakesValue a) => a -> App String
objId
  req <- baseRequest user Galley Versioned (joinHttpPath ["conversations", convId, "code"])
  submit
    "GET"
    ( req
        & addQueryParams [("cnv", convId)]
        & maybe id zHost mbZHost
    )

deleteConversationCode :: (HasCallStack, MakesValue user, MakesValue conv) => user -> conv -> App Response
deleteConversationCode :: forall user qcnv.
(HasCallStack, MakesValue user, MakesValue qcnv) =>
user -> qcnv -> App Response
deleteConversationCode user
user conv
conv = do
  convId <- conv -> App Value
forall a. (HasCallStack, MakesValue a) => a -> App Value
objQidObject conv
conv App Value -> (App Value -> App String) -> App String
forall a b. a -> (a -> b) -> b
& App Value -> App String
forall a. (HasCallStack, MakesValue a) => a -> App String
objId
  req <- baseRequest user Galley Versioned (joinHttpPath ["conversations", convId, "code"])
  submit "DELETE" req

getJoinCodeConv :: (HasCallStack, MakesValue user) => user -> String -> String -> App Response
getJoinCodeConv :: forall user.
(HasCallStack, MakesValue user) =>
user -> String -> String -> App Response
getJoinCodeConv user
u String
k String
v = do
  req <- user -> Service -> Versioned -> String -> App Request
forall user.
(HasCallStack, MakesValue user) =>
user -> Service -> Versioned -> String -> App Request
baseRequest user
u Service
Galley Versioned
Versioned ([String] -> String
joinHttpPath [String
"conversations", String
"join"])
  submit "GET" (req & addQueryParams [("key", k), ("code", v)])

-- https://staging-nginz-https.zinfra.io/v5/api/swagger-ui/#/default/put_conversations__cnv_domain___cnv__name
changeConversationName ::
  (HasCallStack, MakesValue user, MakesValue conv, MakesValue name) =>
  user ->
  conv ->
  name ->
  App Response
changeConversationName :: forall team conv user.
(HasCallStack, MakesValue team, MakesValue conv,
 MakesValue user) =>
team -> conv -> user -> App Response
changeConversationName user
user conv
qcnv name
name = do
  (convDomain, convId) <- conv -> App (String, String)
forall a. (HasCallStack, MakesValue a) => a -> App (String, String)
objQid conv
qcnv
  let path = [String] -> String
joinHttpPath [String
"conversations", String
convDomain, String
convId, String
"name"]
  nameReq <- make name
  req <- baseRequest user Galley Versioned path
  submit "PUT" (req & addJSONObject ["name" .= nameReq])

updateRole ::
  ( HasCallStack,
    MakesValue callerUser,
    MakesValue targetUser,
    MakesValue roleUpdate,
    MakesValue qcnv
  ) =>
  callerUser ->
  targetUser ->
  roleUpdate ->
  qcnv ->
  App Response
updateRole :: forall callerUser targetUser roleUpdate qcnv.
(HasCallStack, MakesValue callerUser, MakesValue targetUser,
 MakesValue roleUpdate, MakesValue qcnv) =>
callerUser -> targetUser -> roleUpdate -> qcnv -> App Response
updateRole callerUser
caller targetUser
target roleUpdate
role qcnv
qcnv = do
  (cnvDomain, cnvId) <- qcnv -> App (String, String)
forall a. (HasCallStack, MakesValue a) => a -> App (String, String)
objQid qcnv
qcnv
  (tarDomain, tarId) <- objQid target
  roleReq <- make role
  req <-
    baseRequest
      caller
      Galley
      Versioned
      ( joinHttpPath ["conversations", cnvDomain, cnvId, "members", tarDomain, tarId]
      )
  submit "PUT" (req & addJSONObject ["conversation_role" .= roleReq])

updateReceiptMode ::
  ( HasCallStack,
    MakesValue user,
    MakesValue conv,
    MakesValue mode
  ) =>
  user ->
  conv ->
  mode ->
  App Response
updateReceiptMode :: forall team conv user.
(HasCallStack, MakesValue team, MakesValue conv,
 MakesValue user) =>
team -> conv -> user -> App Response
updateReceiptMode user
user conv
qcnv mode
mode = do
  (cnvDomain, cnvId) <- conv -> App (String, String)
forall a. (HasCallStack, MakesValue a) => a -> App (String, String)
objQid conv
qcnv
  modeReq <- make mode
  let path = [String] -> String
joinHttpPath [String
"conversations", String
cnvDomain, String
cnvId, String
"receipt-mode"]
  req <- baseRequest user Galley Versioned path
  submit "PUT" (req & addJSONObject ["receipt_mode" .= modeReq])

updateAccess ::
  ( HasCallStack,
    MakesValue user,
    MakesValue conv
  ) =>
  user ->
  conv ->
  [Aeson.Pair] ->
  App Response
updateAccess :: forall user conv.
(HasCallStack, MakesValue user, MakesValue conv) =>
user -> conv -> [Pair] -> App Response
updateAccess user
user conv
qcnv [Pair]
update = do
  (cnvDomain, cnvId) <- conv -> App (String, String)
forall a. (HasCallStack, MakesValue a) => a -> App (String, String)
objQid conv
qcnv
  let path = [String] -> String
joinHttpPath [String
"conversations", String
cnvDomain, String
cnvId, String
"access"]
  req <- baseRequest user Galley Versioned path
  submit "PUT" (req & addJSONObject update)

updateMessageTimer ::
  ( HasCallStack,
    MakesValue user,
    MakesValue conv
  ) =>
  user ->
  conv ->
  Word64 ->
  App Response
updateMessageTimer :: forall user conv.
(HasCallStack, MakesValue user, MakesValue conv) =>
user -> conv -> Word64 -> App Response
updateMessageTimer user
user conv
qcnv Word64
update = do
  (cnvDomain, cnvId) <- conv -> App (String, String)
forall a. (HasCallStack, MakesValue a) => a -> App (String, String)
objQid conv
qcnv
  updateReq <- make update
  let path = [String] -> String
joinHttpPath [String
"conversations", String
cnvDomain, String
cnvId, String
"message-timer"]
  req <- baseRequest user Galley Versioned path
  submit "PUT" (addJSONObject ["message_timer" .= updateReq] req)

getTeam :: (HasCallStack, MakesValue user, MakesValue tid) => user -> tid -> App Response
getTeam :: forall user qcnv.
(HasCallStack, MakesValue user, MakesValue qcnv) =>
user -> qcnv -> App Response
getTeam user
user tid
tid = do
  tidStr <- tid -> App String
forall a. (HasCallStack, MakesValue a) => a -> App String
asString tid
tid
  req <- baseRequest user Galley Versioned (joinHttpPath ["teams", tidStr])
  submit "GET" req

getTeamMembers :: (HasCallStack, MakesValue user, MakesValue tid) => user -> tid -> App Response
getTeamMembers :: forall user qcnv.
(HasCallStack, MakesValue user, MakesValue qcnv) =>
user -> qcnv -> App Response
getTeamMembers user
user tid
tid = do
  tidStr <- tid -> App String
forall a. (HasCallStack, MakesValue a) => a -> App String
asString tid
tid
  req <- baseRequest user Galley Versioned (joinHttpPath ["teams", tidStr, "members"])
  submit "GET" req

data AppLockSettings = AppLockSettings
  { AppLockSettings -> String
status :: String,
    AppLockSettings -> Bool
enforce :: Bool,
    AppLockSettings -> Int
inactivityTimeoutSecs :: Int
  }

instance Default AppLockSettings where
  def :: AppLockSettings
def = String -> Bool -> Int -> AppLockSettings
AppLockSettings String
"disabled" Bool
False Int
60

-- | https://staging-nginz-https.zinfra.io/v6/api/swagger-ui/#/default/put_teams__tid__features_appLock
putAppLockSettings ::
  (HasCallStack, MakesValue tid, MakesValue caller) =>
  tid ->
  caller ->
  AppLockSettings ->
  App Response
putAppLockSettings :: forall tid caller.
(HasCallStack, MakesValue tid, MakesValue caller) =>
tid -> caller -> AppLockSettings -> App Response
putAppLockSettings tid
tid caller
caller AppLockSettings
settings = do
  tidStr <- tid -> App String
forall a. (HasCallStack, MakesValue a) => a -> App String
asString tid
tid
  req <- baseRequest caller Galley Versioned (joinHttpPath ["teams", tidStr, "features", "appLock"])
  submit
    "PUT"
    ( addJSONObject
        [ "status" .= settings.status,
          "ttl" .= "unlimited",
          "config"
            .= object
              [ "enforceAppLock" .= settings.enforce,
                "inactivityTimeoutSecs" .= settings.inactivityTimeoutSecs
              ]
        ]
        req
    )

data TeamProperties = TeamProperties
  { TeamProperties -> String
icon :: String,
    TeamProperties -> String
iconKey :: String,
    TeamProperties -> String
name :: String,
    TeamProperties -> String
spashScreen :: String
  }

instance Default TeamProperties where
  def :: TeamProperties
def = String -> String -> String -> String -> TeamProperties
TeamProperties String
"default" String
"default" String
"test" String
"default"

-- | https://staging-nginz-https.zinfra.io/v6/api/swagger-ui/#/default/put_teams__tid_
putTeamProperties ::
  (HasCallStack, MakesValue tid, MakesValue caller) =>
  tid ->
  caller ->
  TeamProperties ->
  App Response
putTeamProperties :: forall tid caller.
(HasCallStack, MakesValue tid, MakesValue caller) =>
tid -> caller -> TeamProperties -> App Response
putTeamProperties tid
tid caller
caller TeamProperties
properties = do
  tidStr <- tid -> App String
forall a. (HasCallStack, MakesValue a) => a -> App String
asString tid
tid
  req <- baseRequest caller Galley Versioned (joinHttpPath ["teams", tidStr])
  submit
    "PUT"
    ( addJSONObject
        [ "icon" .= properties.icon,
          "icon_key" .= properties.iconKey,
          "name" .= properties.name,
          "splash_screen" .= properties.spashScreen
        ]
        req
    )

-- | https://staging-nginz-https.zinfra.io/v5/api/swagger-ui/#/default/get_teams__tid__legalhold__uid_
legalholdUserStatus :: (HasCallStack, MakesValue tid, MakesValue user, MakesValue owner) => tid -> owner -> user -> App Response
legalholdUserStatus :: forall tid user owner.
(HasCallStack, MakesValue tid, MakesValue user,
 MakesValue owner) =>
tid -> owner -> user -> App Response
legalholdUserStatus tid
tid owner
ownerid user
user = do
  tidS <- tid -> App String
forall a. (HasCallStack, MakesValue a) => a -> App String
asString tid
tid
  uid <- objId user
  req <- baseRequest ownerid Galley Versioned (joinHttpPath ["teams", tidS, "legalhold", uid])
  submit "GET" req

-- | https://staging-nginz-https.zinfra.io/v5/api/swagger-ui/#/default/delete_teams__tid__legalhold__uid_
disableLegalHold ::
  (HasCallStack, MakesValue tid, MakesValue ownerid, MakesValue uid) =>
  tid ->
  ownerid ->
  uid ->
  -- | the password for user with $uid$
  String ->
  App Response
disableLegalHold :: forall user conv target.
(HasCallStack, MakesValue user, MakesValue conv,
 MakesValue target) =>
user -> conv -> target -> String -> App Response
disableLegalHold tid
tid ownerid
ownerid uid
uid String
pw = do
  tidStr <- tid -> App String
forall a. (HasCallStack, MakesValue a) => a -> App String
asString tid
tid
  uidStr <- objId uid
  req <- baseRequest ownerid Galley Versioned (joinHttpPath ["teams", tidStr, "legalhold", uidStr])
  submit "DELETE" (addJSONObject ["password" .= pw] req)

-- | https://staging-nginz-https.zinfra.io/v5/api/swagger-ui/#/default/post_teams__tid__legalhold_consent
consentToLegalHold :: (HasCallStack, MakesValue tid, MakesValue zusr) => tid -> zusr -> String -> App Response
consentToLegalHold :: forall user conv.
(HasCallStack, MakesValue user, MakesValue conv) =>
user -> conv -> String -> App Response
consentToLegalHold tid
tid zusr
zusr String
pwd = do
  tidStr <- tid -> App String
forall a. (HasCallStack, MakesValue a) => a -> App String
asString tid
tid
  req <- baseRequest zusr Galley Versioned (joinHttpPath ["teams", tidStr, "legalhold", "consent"])
  submit "POST" (addJSONObject ["password" .= pwd] req)

-- | https://staging-nginz-https.zinfra.io/v5/api/swagger-ui/#/default/get_teams__tid__legalhold__uid_
getLegalHoldStatus :: (HasCallStack, MakesValue tid, MakesValue zusr) => tid -> zusr -> App Response
getLegalHoldStatus :: forall user qcnv.
(HasCallStack, MakesValue user, MakesValue qcnv) =>
user -> qcnv -> App Response
getLegalHoldStatus tid
tid zusr
zusr = do
  tidStr <- tid -> App String
forall a. (HasCallStack, MakesValue a) => a -> App String
asString tid
tid
  uidStr <- asString $ zusr %. "id"
  req <- baseRequest zusr Galley Versioned (joinHttpPath ["teams", tidStr, "legalhold", uidStr])
  submit "GET" req

getLegalHoldSettings :: (HasCallStack, MakesValue tid, MakesValue zusr) => tid -> zusr -> App Response
getLegalHoldSettings :: forall user qcnv.
(HasCallStack, MakesValue user, MakesValue qcnv) =>
user -> qcnv -> App Response
getLegalHoldSettings tid
tid zusr
zusr = do
  tidStr <- tid -> App String
forall a. (HasCallStack, MakesValue a) => a -> App String
asString tid
tid
  req <- baseRequest zusr Galley Versioned (joinHttpPath ["teams", tidStr, "legalhold", "settings"])
  submit "GET" req

-- | https://staging-nginz-https.zinfra.io/v5/api/swagger-ui/#/default/post_teams__tid__legalhold_settings
postLegalHoldSettings :: (HasCallStack, MakesValue ownerid, MakesValue tid, MakesValue newService) => tid -> ownerid -> newService -> App Response
postLegalHoldSettings :: forall ownerid tid newService.
(HasCallStack, MakesValue ownerid, MakesValue tid,
 MakesValue newService) =>
tid -> ownerid -> newService -> App Response
postLegalHoldSettings tid
tid ownerid
owner newService
newSettings =
  (Env -> Int) -> App Int
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks ((Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
1_000_000) (Int -> Int) -> (Env -> Int) -> Env -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Env -> Int
timeOutSeconds) App Int -> (Int -> App Response) -> App Response
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Int
tSecs -> RetryPolicyM App
-> (RetryStatus -> Response -> App Bool)
-> (RetryStatus -> App Response)
-> App Response
forall (m :: * -> *) b.
MonadIO m =>
RetryPolicyM m
-> (RetryStatus -> b -> m Bool) -> (RetryStatus -> m b) -> m b
retrying (Int -> RetryPolicy
policy Int
tSecs) RetryStatus -> Response -> App Bool
only412 ((RetryStatus -> App Response) -> App Response)
-> (RetryStatus -> App Response) -> App Response
forall a b. (a -> b) -> a -> b
$ \RetryStatus
_ -> do
    tidStr <- tid -> App String
forall a. (HasCallStack, MakesValue a) => a -> App String
asString tid
tid
    req <- baseRequest owner Galley Versioned (joinHttpPath ["teams", tidStr, "legalhold", "settings"])
    newSettingsObj <- make newSettings
    submit "POST" (addJSON newSettingsObj req)
  where
    policy :: Int -> RetryPolicy
    policy :: Int -> RetryPolicy
policy Int
tSecs = Int -> RetryPolicyM m -> RetryPolicyM m
forall (m :: * -> *).
Monad m =>
Int -> RetryPolicyM m -> RetryPolicyM m
limitRetriesByCumulativeDelay Int
tSecs (RetryPolicyM m -> RetryPolicyM m)
-> RetryPolicyM m -> RetryPolicyM m
forall a b. (a -> b) -> a -> b
$ Int -> RetryPolicyM m
forall (m :: * -> *). Monad m => Int -> RetryPolicyM m
exponentialBackoff Int
50

    only412 :: RetryStatus -> Response -> App Bool
    only412 :: RetryStatus -> Response -> App Bool
only412 RetryStatus
_ Response
resp = Bool -> App Bool
forall a. a -> App a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bool -> App Bool) -> Bool -> App Bool
forall a b. (a -> b) -> a -> b
$ Response
resp.status Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
412

-- | https://staging-nginz-https.zinfra.io/v5/api/swagger-ui/#/default/post_teams__tid__legalhold__uid_
requestLegalHoldDevice :: (HasCallStack, MakesValue tid, MakesValue ownerid, MakesValue uid) => tid -> ownerid -> uid -> App Response
requestLegalHoldDevice :: forall team conv user.
(HasCallStack, MakesValue team, MakesValue conv,
 MakesValue user) =>
team -> conv -> user -> App Response
requestLegalHoldDevice tid
tid ownerid
ownerid uid
uid = do
  tidStr <- tid -> App String
forall a. (HasCallStack, MakesValue a) => a -> App String
asString tid
tid
  uidStr <- objId uid
  req <- baseRequest ownerid Galley Versioned (joinHttpPath ["teams", tidStr, "legalhold", uidStr])
  submit "POST" req

-- | https://staging-nginz-https.zinfra.io/v5/api/swagger-ui/#/default/put_teams__tid__legalhold__uid__approve
--
--   like approveLegalHoldDevice' but approves for the requesting party
approveLegalHoldDevice :: (HasCallStack, MakesValue tid, MakesValue uid) => tid -> uid -> String -> App Response
approveLegalHoldDevice :: forall user conv.
(HasCallStack, MakesValue user, MakesValue conv) =>
user -> conv -> String -> App Response
approveLegalHoldDevice tid
tid uid
uid = tid -> uid -> uid -> String -> App Response
forall user conv target.
(HasCallStack, MakesValue user, MakesValue conv,
 MakesValue target) =>
user -> conv -> target -> String -> App Response
approveLegalHoldDevice' tid
tid uid
uid uid
uid

-- | https://staging-nginz-https.zinfra.io/v5/api/swagger-ui/#/default/put_teams__tid__legalhold__uid__approve
--
--   useful for testing unauthorized requests
approveLegalHoldDevice' :: (HasCallStack, MakesValue tid, MakesValue uid, MakesValue forUid) => tid -> uid -> forUid -> String -> App Response
approveLegalHoldDevice' :: forall user conv target.
(HasCallStack, MakesValue user, MakesValue conv,
 MakesValue target) =>
user -> conv -> target -> String -> App Response
approveLegalHoldDevice' tid
tid uid
uid forUid
forUid String
pwd = do
  tidStr <- tid -> App String
forall a. (HasCallStack, MakesValue a) => a -> App String
asString tid
tid
  uidStr <- asString $ forUid %. "id"
  req <- baseRequest uid Galley Versioned (joinHttpPath ["teams", tidStr, "legalhold", uidStr, "approve"])
  submit "PUT" (addJSONObject ["password" .= pwd] req)

-- | https://staging-nginz-https.zinfra.io/v5/api/swagger-ui/#/default/put_teams__tid__features_legalhold
putLegalholdStatus ::
  (HasCallStack, MakesValue tid, MakesValue usr) =>
  tid ->
  usr ->
  -- | the status to put to
  String ->
  App Response
putLegalholdStatus :: forall user conv.
(HasCallStack, MakesValue user, MakesValue conv) =>
user -> conv -> String -> App Response
putLegalholdStatus tid
tid usr
usr String
status = do
  tidStr <- tid -> App String
forall a. (HasCallStack, MakesValue a) => a -> App String
asString tid
tid

  baseRequest usr Galley Versioned (joinHttpPath ["teams", tidStr, "features", "legalhold"])
    >>= submit "PUT"
    . addJSONObject ["status" .= status, "ttl" .= "unlimited"]

-- | https://staging-nginz-https.zinfra.io/v5/api/swagger-ui/#/default/get_feature_configs
getFeatureConfigs :: (HasCallStack, MakesValue user) => user -> App Response
getFeatureConfigs :: forall user.
(HasCallStack, MakesValue user) =>
user -> App Response
getFeatureConfigs user
user = do
  req <- user -> Service -> Versioned -> String -> App Request
forall user.
(HasCallStack, MakesValue user) =>
user -> Service -> Versioned -> String -> App Request
baseRequest user
user Service
Galley Versioned
Versioned String
"/feature-configs"
  submit "GET" req

-- | https://staging-nginz-https.zinfra.io/v5/api/swagger-ui/#/default/get_teams__tid__features
getTeamFeatures :: (HasCallStack, MakesValue user, MakesValue tid) => user -> tid -> App Response
getTeamFeatures :: forall user qcnv.
(HasCallStack, MakesValue user, MakesValue qcnv) =>
user -> qcnv -> App Response
getTeamFeatures user
user tid
tid = do
  tidStr <- tid -> App String
forall a. (HasCallStack, MakesValue a) => a -> App String
asString tid
tid
  req <- baseRequest user Galley Versioned (joinHttpPath ["teams", tidStr, "features"])
  submit "GET" req

getTeamFeature :: (HasCallStack, MakesValue user, MakesValue tid) => user -> tid -> String -> App Response
getTeamFeature :: forall user conv.
(HasCallStack, MakesValue user, MakesValue conv) =>
user -> conv -> String -> App Response
getTeamFeature user
user tid
tid String
featureName = do
  tidStr <- tid -> App String
forall a. (HasCallStack, MakesValue a) => a -> App String
asString tid
tid
  req <- baseRequest user Galley Versioned (joinHttpPath ["teams", tidStr, "features", featureName])
  submit "GET" req

setTeamFeatureConfig ::
  (HasCallStack, MakesValue user, MakesValue team, MakesValue featureName, MakesValue payload) =>
  user ->
  team ->
  featureName ->
  payload ->
  App Response
setTeamFeatureConfig :: forall callerUser targetUser roleUpdate qcnv.
(HasCallStack, MakesValue callerUser, MakesValue targetUser,
 MakesValue roleUpdate, MakesValue qcnv) =>
callerUser -> targetUser -> roleUpdate -> qcnv -> App Response
setTeamFeatureConfig = Versioned -> user -> team -> featureName -> payload -> App Response
forall user team featureName payload.
(HasCallStack, MakesValue user, MakesValue team,
 MakesValue featureName, MakesValue payload) =>
Versioned -> user -> team -> featureName -> payload -> App Response
setTeamFeatureConfigVersioned Versioned
Versioned

setTeamFeatureConfigVersioned ::
  (HasCallStack, MakesValue user, MakesValue team, MakesValue featureName, MakesValue payload) =>
  Versioned ->
  user ->
  team ->
  featureName ->
  payload ->
  App Response
setTeamFeatureConfigVersioned :: forall user team featureName payload.
(HasCallStack, MakesValue user, MakesValue team,
 MakesValue featureName, MakesValue payload) =>
Versioned -> user -> team -> featureName -> payload -> App Response
setTeamFeatureConfigVersioned Versioned
versioned user
user team
team featureName
featureName payload
payload = do
  tid <- team -> App String
forall a. (HasCallStack, MakesValue a) => a -> App String
asString team
team
  fn <- asString featureName
  p <- make payload
  req <- baseRequest user Galley versioned $ joinHttpPath ["teams", tid, "features", fn]
  submit "PUT" $ req & addJSON p

-- | http://staging-nginz-https.zinfra.io/v6/api/swagger-ui/#/default/get_feature_configs
getFeaturesForUser :: (HasCallStack, MakesValue user) => user -> App Response
getFeaturesForUser :: forall user.
(HasCallStack, MakesValue user) =>
user -> App Response
getFeaturesForUser user
user = user -> Service -> Versioned -> String -> App Request
forall user.
(HasCallStack, MakesValue user) =>
user -> Service -> Versioned -> String -> App Request
baseRequest user
user Service
Galley Versioned
Versioned String
"feature-configs" App Request -> (Request -> App Response) -> App Response
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> Request -> App Response
submit String
"GET"

-- | https://staging-nginz-https.zinfra.io/v6/api/swagger-ui/#/default/get_teams_notifications
getTeamNotifications :: (HasCallStack, MakesValue user) => user -> Maybe String -> App Response
getTeamNotifications :: forall user.
(HasCallStack, MakesValue user) =>
user -> Maybe String -> App Response
getTeamNotifications user
user Maybe String
mSince =
  user -> Service -> Versioned -> String -> App Request
forall user.
(HasCallStack, MakesValue user) =>
user -> Service -> Versioned -> String -> App Request
baseRequest user
user Service
Galley Versioned
Versioned String
"teams/notifications" App Request -> (Request -> App Response) -> App Response
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Request
req ->
    String -> Request -> App Response
submit String
"GET"
      (Request -> App Response) -> Request -> App Response
forall a b. (a -> b) -> a -> b
$ [(String, String)] -> Request -> Request
addQueryParams [(String
"since", String
since) | String
since <- Maybe String -> [String]
forall a. Maybe a -> [a]
maybeToList Maybe String
mSince] Request
req

-- | https://staging-nginz-https.zinfra.io/v6/api/swagger-ui/#/default/get_teams__tid__members_csv
getTeamMembersCsv :: (HasCallStack, MakesValue user) => user -> String -> App Response
getTeamMembersCsv :: forall user.
(HasCallStack, MakesValue user) =>
user -> String -> App Response
getTeamMembersCsv user
user String
tid = do
  req <- user -> Service -> Versioned -> String -> App Request
forall user.
(HasCallStack, MakesValue user) =>
user -> Service -> Versioned -> String -> App Request
baseRequest user
user Service
Galley Versioned
Versioned ([String] -> String
joinHttpPath [String
"teams", String
tid, String
"members", String
"csv"])
  submit "GET" req

-- | https://staging-nginz-https.zinfra.io/v6/api/swagger-ui/#/default/post_conversations__cnv_domain___cnv__typing
sendTypingStatus :: (HasCallStack, MakesValue user, MakesValue conv) => user -> conv -> String -> App Response
sendTypingStatus :: forall user conv.
(HasCallStack, MakesValue user, MakesValue conv) =>
user -> conv -> String -> App Response
sendTypingStatus user
user conv
conv String
status = do
  convDomain <- conv -> App String
forall a. (HasCallStack, MakesValue a) => a -> App String
objDomain conv
conv
  convId <- objQidObject conv & objId
  req <- baseRequest user Galley Versioned (joinHttpPath ["conversations", convDomain, convId, "typing"])
  submit "POST"
    $ addJSONObject ["status" .= status] req

updateConversationSelf :: (HasCallStack, MakesValue user, MakesValue conv) => user -> conv -> Value -> App Response
updateConversationSelf :: forall user conv.
(HasCallStack, MakesValue user, MakesValue conv) =>
user -> conv -> Value -> App Response
updateConversationSelf user
user conv
conv Value
payload = do
  (domain, cnv) <- conv -> App (String, String)
forall a. (HasCallStack, MakesValue a) => a -> App (String, String)
objQid conv
conv
  req <- baseRequest user Galley Versioned (joinHttpPath ["conversations", domain, cnv, "self"])
  submit "PUT" $ req & addJSON payload

getSelfMember :: (HasCallStack, MakesValue user, MakesValue conv) => user -> conv -> App Response
getSelfMember :: forall user qcnv.
(HasCallStack, MakesValue user, MakesValue qcnv) =>
user -> qcnv -> App Response
getSelfMember user
user conv
conv = do
  (domain, cnv) <- conv -> App (String, String)
forall a. (HasCallStack, MakesValue a) => a -> App (String, String)
objQid conv
conv
  req <- baseRequest user Galley Versioned (joinHttpPath ["conversations", domain, cnv, "self"])
  submit "GET" req

resetConversation :: (HasCallStack, MakesValue user) => user -> String -> Word64 -> App Response
resetConversation :: forall user.
(HasCallStack, MakesValue user) =>
user -> String -> Word64 -> App Response
resetConversation user
user String
groupId Word64
epoch = do
  req <- user -> Service -> Versioned -> String -> App Request
forall user.
(HasCallStack, MakesValue user) =>
user -> Service -> Versioned -> String -> App Request
baseRequest user
user Service
Galley Versioned
Versioned ([String] -> String
joinHttpPath [String
"mls", String
"reset-conversation"])
  let payload = [Pair] -> Value
object [String
"group_id" String -> String -> Pair
forall a. ToJSON a => String -> a -> Pair
.= String
groupId, String
"epoch" String -> Word64 -> Pair
forall a. ToJSON a => String -> a -> Pair
.= Word64
epoch]
  submit "POST" $ req & addJSON payload

updateTeamCollaborator :: (MakesValue owner, MakesValue collaborator, HasCallStack) => owner -> String -> collaborator -> [String] -> App Response
updateTeamCollaborator :: forall owner collaborator.
(MakesValue owner, MakesValue collaborator, HasCallStack) =>
owner -> String -> collaborator -> [String] -> App Response
updateTeamCollaborator owner
owner String
tid collaborator
collaborator [String]
permissions = do
  (_, collabId) <- collaborator -> App (String, String)
forall a. (HasCallStack, MakesValue a) => a -> App (String, String)
objQid collaborator
collaborator
  req <- baseRequest owner Galley Versioned $ joinHttpPath ["teams", tid, "collaborators", collabId]
  submit "PUT"
    $ req
    & addJSON permissions

removeTeamCollaborator :: (MakesValue owner, MakesValue collaborator, HasCallStack) => owner -> String -> collaborator -> App Response
removeTeamCollaborator :: forall owner collaborator.
(MakesValue owner, MakesValue collaborator, HasCallStack) =>
owner -> String -> collaborator -> App Response
removeTeamCollaborator owner
owner String
tid collaborator
collaborator = do
  (_, collabId) <- collaborator -> App (String, String)
forall a. (HasCallStack, MakesValue a) => a -> App (String, String)
objQid collaborator
collaborator
  req <- baseRequest owner Galley Versioned $ joinHttpPath ["teams", tid, "collaborators", collabId]
  submit "DELETE" req

data SearchChannels = SearchChannels
  { SearchChannels -> Maybe String
q :: Maybe String,
    SearchChannels -> Maybe String
sortOrder :: Maybe String,
    SearchChannels -> Maybe Int
pageSize :: Maybe Int,
    SearchChannels -> Maybe String
lastName :: Maybe String,
    SearchChannels -> Maybe String
lastId :: Maybe String,
    SearchChannels -> Bool
discoverable :: Bool
  }

instance Default SearchChannels where
  def :: SearchChannels
def =
    SearchChannels
      { q :: Maybe String
q = Maybe String
forall a. Maybe a
Nothing,
        sortOrder :: Maybe String
sortOrder = Maybe String
forall a. Maybe a
Nothing,
        pageSize :: Maybe Int
pageSize = Maybe Int
forall a. Maybe a
Nothing,
        lastName :: Maybe String
lastName = Maybe String
forall a. Maybe a
Nothing,
        lastId :: Maybe String
lastId = Maybe String
forall a. Maybe a
Nothing,
        discoverable :: Bool
discoverable = Bool
False
      }

searchChannels :: (MakesValue user) => user -> String -> SearchChannels -> App Response
searchChannels :: forall user.
MakesValue user =>
user -> String -> SearchChannels -> App Response
searchChannels user
user String
tid SearchChannels
args = do
  req <-
    user -> Service -> Versioned -> String -> App Request
forall user.
(HasCallStack, MakesValue user) =>
user -> Service -> Versioned -> String -> App Request
baseRequest
      user
user
      Service
Galley
      Versioned
Versioned
      ([String] -> String
joinHttpPath [String
"teams", String
tid, String
"channels", String
"search"])
  submit "GET"
    $ req
    & addQueryParams
      ( mconcat
          [ [("q", q) | q <- toList args.q],
            [("sort_order", o) | o <- toList args.sortOrder],
            [("page_size", show n) | n <- toList args.pageSize],
            [("last_seen_name", n) | n <- toList args.lastName],
            [("last_seen_id", x) | x <- toList args.lastId],
            [("discoverable", "true") | args.discoverable]
          ]
      )