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

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
  }

defProteus :: CreateConv
defProteus :: CreateConv
defProteus =
  CreateConv
    { $sel:qualifiedUsers:CreateConv :: [Value]
qualifiedUsers = [],
      $sel:name:CreateConv :: Maybe String
name = Maybe String
forall a. Maybe a
Nothing,
      $sel:access:CreateConv :: Maybe [String]
access = Maybe [String]
forall a. Maybe a
Nothing,
      $sel:accessRole:CreateConv :: Maybe [String]
accessRole = Maybe [String]
forall a. Maybe a
Nothing,
      $sel:team:CreateConv :: Maybe String
team = Maybe String
forall a. Maybe a
Nothing,
      $sel:messageTimer:CreateConv :: Maybe Int
messageTimer = Maybe Int
forall a. Maybe a
Nothing,
      $sel:receiptMode:CreateConv :: Maybe Int
receiptMode = Maybe Int
forall a. Maybe a
Nothing,
      $sel:newUsersRole:CreateConv :: String
newUsersRole = String
"wire_admin",
      $sel:protocol:CreateConv :: String
protocol = String
"proteus"
    }

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

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
    [Value]
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
    Value -> App Value
forall a. a -> App a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
      (Value -> App Value) -> Value -> App Value
forall a b. (a -> b) -> a -> b
$ [Pair] -> Value
Aeson.object
      ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$ ( [ String
"qualified_users" String -> [Value] -> Pair
forall a. ToJSON a => String -> a -> Pair
.= [Value]
quids,
            String
"conversation_role" String -> String -> Pair
forall a. ToJSON a => String -> a -> Pair
.= CreateConv
cc.newUsersRole,
            String
"protocol" String -> String -> Pair
forall a. ToJSON a => String -> a -> Pair
.= CreateConv
cc.protocol
          ]
            [Pair] -> [Pair] -> [Pair]
forall a. Semigroup a => a -> a -> a
<> [Maybe Pair] -> [Pair]
forall a. [Maybe a] -> [a]
catMaybes
              [ String
"name" String -> Maybe String -> Maybe Pair
forall a. ToJSON a => String -> Maybe a -> Maybe Pair
.=? CreateConv
cc.name,
                String
"access" String -> Maybe [String] -> Maybe Pair
forall a. ToJSON a => String -> Maybe a -> Maybe Pair
.=? CreateConv
cc.access,
                String
"access_role_v2" String -> Maybe [String] -> Maybe Pair
forall a. ToJSON a => String -> Maybe a -> Maybe Pair
.=? CreateConv
cc.access,
                String
"team" String -> Maybe Value -> Maybe Pair
forall a. ToJSON a => String -> Maybe a -> Maybe Pair
.=? (CreateConv
cc.team Maybe String -> (String -> Value) -> Maybe Value
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \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]),
                String
"message_timer" String -> Maybe Int -> Maybe Pair
forall a. ToJSON a => String -> Maybe a -> Maybe Pair
.=? CreateConv
cc.messageTimer,
                String
"receipt_mode" String -> Maybe Int -> Maybe Pair
forall a. ToJSON a => String -> Maybe a -> Maybe Pair
.=? CreateConv
cc.receiptMode
              ]
        )

postConversation ::
  ( HasCallStack,
    MakesValue user
  ) =>
  user ->
  CreateConv ->
  App Response
postConversation :: forall user.
(HasCallStack, MakesValue user) =>
user -> CreateConv -> App Response
postConversation user
user CreateConv
cc = do
  Request
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"
  Value
ccv <- CreateConv -> App Value
forall a. (MakesValue a, HasCallStack) => a -> App Value
make CreateConv
cc
  String -> Request -> App Response
submit String
"POST" (Request -> App Response) -> Request -> App Response
forall a b. (a -> b) -> a -> b
$ Request
req Request -> (Request -> Request) -> Request
forall a b. a -> (a -> b) -> b
& Value -> Request -> Request
forall a. ToJSON a => a -> Request -> Request
addJSON Value
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
  String
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
path = [String] -> String
joinHttpPath [String
"teams", String
tid, String
"conversations", String
cnv]
  Request
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
  String -> Request -> App Response
submit String
"DELETE" Request
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
  String
memId <- member -> App String
forall a. (HasCallStack, MakesValue a) => a -> App String
objId member
mem
  let path :: String
path = [String] -> String
joinHttpPath [String
"teams", String
tid, String
"members", String
memId]
  Request
req <- owner -> Service -> Versioned -> String -> App Request
forall user.
(HasCallStack, MakesValue user) =>
user -> Service -> Versioned -> String -> App Request
baseRequest owner
owner Service
Galley Versioned
Versioned String
path
  String -> Request -> App Response
submit String
"DELETE" ([Pair] -> Request -> Request
addJSONObject [String
"password" String -> String -> Pair
forall a. ToJSON a => String -> a -> Pair
.= String
defPassword] Request
req)

putConversationProtocol ::
  ( HasCallStack,
    MakesValue user,
    MakesValue qcnv,
    MakesValue protocol
  ) =>
  user ->
  qcnv ->
  protocol ->
  App Response
putConversationProtocol :: forall user qcnv protocol.
(HasCallStack, MakesValue user, MakesValue qcnv,
 MakesValue protocol) =>
user -> qcnv -> protocol -> App Response
putConversationProtocol user
user qcnv
qcnv protocol
protocol = do
  (String
domain, String
cnv) <- qcnv -> App (String, String)
forall a. (HasCallStack, MakesValue a) => a -> App (String, String)
objQid qcnv
qcnv
  String
p <- protocol -> App String
forall a. (HasCallStack, MakesValue a) => a -> App String
asString protocol
protocol
  Request
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
"conversations", String
domain, String
cnv, String
"protocol"])
  String -> Request -> App Response
submit String
"PUT" (Request
req Request -> (Request -> Request) -> Request
forall a b. a -> (a -> b) -> b
& [Pair] -> Request -> Request
addJSONObject [String
"protocol" String -> String -> Pair
forall a. ToJSON a => String -> a -> Pair
.= String
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
  (String
domain, String
cnv) <- qcnv -> App (String, String)
forall a. (HasCallStack, MakesValue a) => a -> App (String, String)
objQid qcnv
qcnv
  Request
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
"conversations", String
domain, String
cnv])
  String -> Request -> App Response
submit String
"GET" Request
req

getSubConversation ::
  ( HasCallStack,
    MakesValue user,
    MakesValue conv
  ) =>
  user ->
  conv ->
  String ->
  App Response
getSubConversation :: forall user conv.
(HasCallStack, MakesValue user, MakesValue conv) =>
user -> conv -> String -> App Response
getSubConversation user
user conv
conv String
sub = do
  (String
cnvDomain, String
cnvId) <- conv -> App (String, String)
forall a. (HasCallStack, MakesValue a) => a -> App (String, String)
objQid conv
conv
  Request
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",
          String
cnvDomain,
          String
cnvId,
          String
"subconversations",
          String
sub
        ]
  String -> Request -> App Response
submit String
"GET" Request
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
  (Value
conv, Just String
subId) <- sub -> App (Value, Maybe String)
forall a.
(HasCallStack, MakesValue a) =>
a -> App (Value, Maybe String)
objSubConv sub
sub
  (String
domain, String
convId) <- Value -> App (String, String)
forall a. (HasCallStack, MakesValue a) => a -> App (String, String)
objQid Value
conv
  String
groupId <- sub
sub sub -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"group_id" 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
asString
  Int
epoch :: Int <- sub
sub sub -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"epoch" App Value -> (App Value -> App Int) -> App Int
forall a b. a -> (a -> b) -> b
& App Value -> App Int
forall i a. (Integral i, HasCallStack, MakesValue a) => a -> App i
asIntegral
  Request
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", String
domain, String
convId, String
"subconversations", String
subId]
  String -> Request -> App Response
submit String
"DELETE" (Request -> App Response) -> Request -> App Response
forall a b. (a -> b) -> a -> b
$ Request
req Request -> (Request -> Request) -> Request
forall a b. a -> (a -> b) -> b
& [Pair] -> Request -> Request
addJSONObject [String
"group_id" String -> String -> Pair
forall a. ToJSON a => String -> a -> Pair
.= String
groupId, String
"epoch" String -> Int -> Pair
forall a. ToJSON a => String -> a -> Pair
.= Int
epoch]

leaveSubConversation ::
  (HasCallStack, MakesValue user, MakesValue sub) =>
  user ->
  sub ->
  App Response
leaveSubConversation :: forall user qcnv.
(HasCallStack, MakesValue user, MakesValue qcnv) =>
user -> qcnv -> App Response
leaveSubConversation user
user sub
sub = do
  (Value
conv, Just String
subId) <- sub -> App (Value, Maybe String)
forall a.
(HasCallStack, MakesValue a) =>
a -> App (Value, Maybe String)
objSubConv sub
sub
  (String
domain, String
convId) <- Value -> App (String, String)
forall a. (HasCallStack, MakesValue a) => a -> App (String, String)
objQid Value
conv
  Request
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", String
domain, String
convId, String
"subconversations", String
subId, String
"self"]
  String -> Request -> App Response
submit String
"DELETE" Request
req

getSelfConversation :: (HasCallStack, MakesValue user) => user -> App Response
getSelfConversation :: forall user.
(HasCallStack, MakesValue user) =>
user -> App Response
getSelfConversation user
user = do
  Request
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"
  String -> Request -> App Response
submit String
"GET" (Request -> App Response) -> Request -> App Response
forall a b. (a -> b) -> a -> b
$ Request
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
  Request
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"
  String -> Request -> App Response
submit String
"POST"
    (Request -> App Response) -> Request -> App Response
forall a b. (a -> b) -> a -> b
$ Request
req
    Request -> (Request -> Request) -> Request
forall a b. a -> (a -> b) -> b
& [Pair] -> Request -> Request
addJSONObject
      ( [String
"paging_state" String -> String -> Pair
forall a. ToJSON a => String -> a -> Pair
.= String
s | String
s <- Maybe String -> [String]
forall a. Maybe a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList ListConversationIds
args.pagingState]
          [Pair] -> [Pair] -> [Pair]
forall a. Semigroup a => a -> a -> a
<> [String
"size" String -> Int -> Pair
forall a. ToJSON a => String -> a -> Pair
.= Int
s | Int
s <- Maybe Int -> [Int]
forall a. Maybe a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList ListConversationIds
args.size]
      )

listConversations :: (MakesValue user) => user -> [Value] -> App Response
listConversations :: forall user. MakesValue user => user -> [Value] -> App Response
listConversations user
user [Value]
cnvs = do
  Request
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"
  String -> Request -> App Response
submit String
"POST"
    (Request -> App Response) -> Request -> App Response
forall a b. (a -> b) -> a -> b
$ Request
req
    Request -> (Request -> Request) -> Request
forall a b. a -> (a -> b) -> b
& [Pair] -> Request -> Request
addJSONObject [String
"qualified_ids" String -> [Value] -> Pair
forall a. ToJSON a => String -> a -> Pair
.= [Value]
cnvs]

getMLSPublicKeys :: (HasCallStack, MakesValue user) => user -> App Response
getMLSPublicKeys :: forall user.
(HasCallStack, MakesValue user) =>
user -> App Response
getMLSPublicKeys user
user = do
  Request
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"
  String -> Request -> App Response
submit String
"GET" Request
req

getMLSPublicKeysJWK :: (HasCallStack, MakesValue user) => user -> App Response
getMLSPublicKeysJWK :: forall user.
(HasCallStack, MakesValue user) =>
user -> App Response
getMLSPublicKeysJWK user
user = do
  Request
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"
  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
"format", String
"jwk")] Request
req

postMLSMessage :: (HasCallStack) => ClientIdentity -> ByteString -> App Response
postMLSMessage :: HasCallStack => ClientIdentity -> ByteString -> App Response
postMLSMessage ClientIdentity
cid ByteString
msg = do
  Request
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"
  String -> Request -> App Response
submit String
"POST" (ByteString -> Request -> Request
addMLS ByteString
msg Request
req)

postMLSCommitBundle :: (HasCallStack) => ClientIdentity -> ByteString -> App Response
postMLSCommitBundle :: HasCallStack => ClientIdentity -> ByteString -> App Response
postMLSCommitBundle ClientIdentity
cid ByteString
msg = do
  Request
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"
  String -> Request -> App Response
submit String
"POST" (ByteString -> Request -> Request
addMLS ByteString
msg Request
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
  String
convDomain <- conv -> App String
forall a. (HasCallStack, MakesValue a) => a -> App String
objDomain conv
conv
  String
convId <- conv -> App String
forall a. (HasCallStack, MakesValue a) => a -> App String
objId conv
conv
  let bytes :: ByteString
bytes = QualifiedNewOtrMessage -> ByteString
forall msg. Message msg => msg -> ByteString
Proto.encodeMessage QualifiedNewOtrMessage
msgs
  Request
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
"conversations", String
convDomain, String
convId, String
"proteus", String
"messages"])
  String -> Request -> App Response
submit String
"POST" (ByteString -> Request -> Request
addProtobuf ByteString
bytes Request
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
  String
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
  [UserEntry]
userEntries <- ((user, [client]) -> App UserEntry)
-> [(user, [client])] -> App [UserEntry]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (user, [client]) -> App UserEntry
mkUserEntry [(user, [client])]
userClients
  QualifiedUserEntry -> App QualifiedUserEntry
forall a. a -> App a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
    (QualifiedUserEntry -> App QualifiedUserEntry)
-> QualifiedUserEntry -> App QualifiedUserEntry
forall a b. (a -> b) -> a -> b
$ QualifiedUserEntry
forall msg. Message msg => msg
Proto.defMessage
    QualifiedUserEntry
-> (QualifiedUserEntry -> QualifiedUserEntry) -> QualifiedUserEntry
forall a b. a -> (a -> b) -> b
& ASetter QualifiedUserEntry QualifiedUserEntry Text Text
#domain ASetter QualifiedUserEntry QualifiedUserEntry Text Text
-> Text -> QualifiedUserEntry -> QualifiedUserEntry
forall s t a b. ASetter s t a b -> b -> s -> t
.~ String -> Text
forall a. IsString a => String -> a
fromString String
userDomain
    QualifiedUserEntry
-> (QualifiedUserEntry -> QualifiedUserEntry) -> QualifiedUserEntry
forall a b. a -> (a -> b) -> b
& ASetter
  QualifiedUserEntry QualifiedUserEntry [UserEntry] [UserEntry]
#entries ASetter
  QualifiedUserEntry QualifiedUserEntry [UserEntry] [UserEntry]
-> [UserEntry] -> QualifiedUserEntry -> QualifiedUserEntry
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [UserEntry]
userEntries
  where
    mkUserEntry :: (user, [client]) -> App UserEntry
mkUserEntry (user
user, [client]
clients) = do
      ByteString
userId <- ByteString -> ByteString
LBS.toStrict (ByteString -> ByteString)
-> (String -> ByteString) -> String -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UUID -> ByteString
UUID.toByteString (UUID -> ByteString) -> (String -> UUID) -> String -> ByteString
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
      [ClientEntry]
clientEntries <- (client -> App ClientEntry) -> [client] -> App [ClientEntry]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM client -> App ClientEntry
mkClientEntry [client]
clients
      UserEntry -> App UserEntry
forall a. a -> App a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
        (UserEntry -> App UserEntry) -> UserEntry -> App UserEntry
forall a b. (a -> b) -> a -> b
$ UserEntry
forall msg. Message msg => msg
Proto.defMessage
        UserEntry -> (UserEntry -> UserEntry) -> UserEntry
forall a b. a -> (a -> b) -> b
& (UserId -> Identity UserId) -> UserEntry -> Identity UserEntry
#user ((UserId -> Identity UserId) -> UserEntry -> Identity UserEntry)
-> ((ByteString -> Identity ByteString)
    -> UserId -> Identity UserId)
-> (ByteString -> Identity ByteString)
-> UserEntry
-> Identity UserEntry
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ByteString -> Identity ByteString) -> UserId -> Identity UserId
#uuid ((ByteString -> Identity ByteString)
 -> UserEntry -> Identity UserEntry)
-> ByteString -> UserEntry -> UserEntry
forall s t a b. ASetter s t a b -> b -> s -> t
.~ ByteString
userId
        UserEntry -> (UserEntry -> UserEntry) -> UserEntry
forall a b. a -> (a -> b) -> b
& ASetter UserEntry UserEntry [ClientEntry] [ClientEntry]
#clients ASetter UserEntry UserEntry [ClientEntry] [ClientEntry]
-> [ClientEntry] -> UserEntry -> UserEntry
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [ClientEntry]
clientEntries
    mkClientEntry :: client -> App ClientEntry
mkClientEntry client
client = do
      Word64
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
      ClientEntry -> App ClientEntry
forall a. a -> App a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
        (ClientEntry -> App ClientEntry) -> ClientEntry -> App ClientEntry
forall a b. (a -> b) -> a -> b
$ ClientEntry
forall msg. Message msg => msg
Proto.defMessage
        ClientEntry -> (ClientEntry -> ClientEntry) -> ClientEntry
forall a b. a -> (a -> b) -> b
& (ClientId -> Identity ClientId)
-> ClientEntry -> Identity ClientEntry
#client ((ClientId -> Identity ClientId)
 -> ClientEntry -> Identity ClientEntry)
-> ((Word64 -> Identity Word64) -> ClientId -> Identity ClientId)
-> (Word64 -> Identity Word64)
-> ClientEntry
-> Identity ClientEntry
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word64 -> Identity Word64) -> ClientId -> Identity ClientId
#client ((Word64 -> Identity Word64)
 -> ClientEntry -> Identity ClientEntry)
-> Word64 -> ClientEntry -> ClientEntry
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Word64
clientId
        ClientEntry -> (ClientEntry -> ClientEntry) -> ClientEntry
forall a b. a -> (a -> b) -> b
& ASetter ClientEntry ClientEntry ByteString ByteString
#text ASetter ClientEntry ClientEntry ByteString ByteString
-> ByteString -> ClientEntry -> ClientEntry
forall s t a b. ASetter s t a b -> b -> s -> t
.~ String -> ByteString
forall a. IsString a => String -> a
fromString String
msg

getGroupInfo ::
  (HasCallStack, MakesValue user, MakesValue conv) =>
  user ->
  conv ->
  App Response
getGroupInfo :: forall user qcnv.
(HasCallStack, MakesValue user, MakesValue qcnv) =>
user -> qcnv -> App Response
getGroupInfo user
user conv
conv = do
  (Value
qcnv, Maybe String
mSub) <- conv -> App (Value, Maybe String)
forall a.
(HasCallStack, MakesValue a) =>
a -> App (Value, Maybe String)
objSubConv conv
conv
  (String
convDomain, String
convId) <- Value -> App (String, String)
forall a. (HasCallStack, MakesValue a) => a -> App (String, String)
objQid Value
qcnv
  let path :: String
path = [String] -> String
joinHttpPath ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ case Maybe String
mSub of
        Maybe String
Nothing -> [String
"conversations", String
convDomain, String
convId, String
"groupinfo"]
        Just String
sub -> [String
"conversations", String
convDomain, String
convId, String
"subconversations", String
sub, String
"groupinfo"]
  Request
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
  String -> Request -> App Response
submit String
"GET" Request
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
  (String
convDomain, String
convId) <- conv -> App (String, String)
forall a. (HasCallStack, MakesValue a) => a -> App (String, String)
objQid conv
conv
  (String
userDomain, String
userId) <- user -> App (String, String)
forall a. (HasCallStack, MakesValue a) => a -> App (String, String)
objQid user
user
  Request
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
"conversations", String
convDomain, String
convId, String
"members", String
userDomain, String
userId])
  String -> Request -> App Response
submit String
"DELETE" Request
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
  (String
convDomain, String
convId) <- conv -> App (String, String)
forall a. (HasCallStack, MakesValue a) => a -> App (String, String)
objQid conv
conv
  (String
targetDomain, String
targetId) <- target -> App (String, String)
forall a. (HasCallStack, MakesValue a) => a -> App (String, String)
objQid target
target
  Request
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
"conversations", String
convDomain, String
convId, String
"members", String
targetDomain, String
targetId])
  String -> Request -> App Response
submit String
"PUT" (Request
req Request -> (Request -> Request) -> Request
forall a b. a -> (a -> b) -> b
& [Pair] -> Request -> Request
addJSONObject [String
"conversation_role" String -> String -> Pair
forall a. ToJSON a => String -> a -> Pair
.= String
role])

deleteTeamConv ::
  (HasCallStack, MakesValue team, MakesValue conv, MakesValue user) =>
  team ->
  conv ->
  user ->
  App Response
deleteTeamConv :: forall user qcnv protocol.
(HasCallStack, MakesValue user, MakesValue qcnv,
 MakesValue protocol) =>
user -> qcnv -> protocol -> App Response
deleteTeamConv team
team conv
conv user
user = do
  String
teamId <- team -> App String
forall a. (HasCallStack, MakesValue a) => a -> App String
objId team
team
  String
convId <- conv -> App String
forall a. (HasCallStack, MakesValue a) => a -> App String
objId conv
conv
  Request
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
teamId, String
"conversations", String
convId])
  String -> Request -> App Response
submit String
"DELETE" Request
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
  (String
domain, String
uid) <- other -> App (String, String)
forall a. (HasCallStack, MakesValue a) => a -> App (String, String)
objQid other
other
  Request
req <-
    self -> Service -> Versioned -> String -> App Request
forall user.
(HasCallStack, MakesValue user) =>
user -> Service -> Versioned -> String -> App Request
baseRequest self
self Service
Galley Versioned
Versioned
      (String -> App Request) -> String -> App Request
forall a b. (a -> b) -> a -> b
$ [String] -> String
joinHttpPath [String
"conversations", String
"one2one", String
domain, String
uid]
  String -> Request -> App Response
submit String
"GET" Request
req

getGroupClients ::
  (HasCallStack, MakesValue user) =>
  user ->
  String ->
  App Response
getGroupClients :: forall user.
(HasCallStack, MakesValue user) =>
user -> String -> App Response
getGroupClients user
user String
groupId = do
  Request
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])
  String -> Request -> App Response
submit String
"GET" Request
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 {$sel:users:AddMembers :: [Value]
users = [], $sel:role:AddMembers :: Maybe String
role = Maybe String
forall a. Maybe a
Nothing, $sel:version:AddMembers :: 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
  (String
convDomain, String
convId) <- conv -> App (String, String)
forall a. (HasCallStack, MakesValue a) => a -> App (String, String)
objQid conv
qcnv
  [Value]
qUsers <- (Value -> App Value) -> [Value] -> App [Value]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Value -> App Value
forall a. (HasCallStack, MakesValue a) => a -> App Value
objQidObject AddMembers
opts.users
  let path :: [String]
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"]
  Request
req <-
    user -> Service -> Versioned -> String -> App Request
forall user.
(HasCallStack, MakesValue user) =>
user -> Service -> Versioned -> String -> App Request
baseRequest
      user
usr
      Service
Galley
      (Versioned -> (Int -> Versioned) -> Maybe Int -> Versioned
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Versioned
Versioned Int -> Versioned
ExplicitVersion AddMembers
opts.version)
      ([String] -> String
joinHttpPath [String]
path)
  String -> Request -> App Response
submit String
"POST"
    (Request -> App Response) -> Request -> App Response
forall a b. (a -> b) -> a -> b
$ Request
req
    Request -> (Request -> Request) -> Request
forall a b. a -> (a -> b) -> b
& [Pair] -> Request -> Request
addJSONObject
      ( [String
"qualified_users" String -> [Value] -> Pair
forall a. ToJSON a => String -> a -> Pair
.= [Value]
qUsers]
          [Pair] -> [Pair] -> [Pair]
forall a. Semigroup a => a -> a -> a
<> [String
"conversation_role" String -> String -> Pair
forall a. ToJSON a => String -> a -> Pair
.= String
r | String
r <- Maybe String -> [String]
forall a. Maybe a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList AddMembers
opts.role]
      )

removeMember :: (HasCallStack, MakesValue remover, MakesValue conv, MakesValue removed) => remover -> conv -> removed -> App Response
removeMember :: forall user qcnv protocol.
(HasCallStack, MakesValue user, MakesValue qcnv,
 MakesValue protocol) =>
user -> qcnv -> protocol -> App Response
removeMember remover
remover conv
qcnv removed
removed = do
  (String
convDomain, String
convId) <- conv -> App (String, String)
forall a. (HasCallStack, MakesValue a) => a -> App (String, String)
objQid conv
qcnv
  (String
removedDomain, String
removedId) <- removed -> App (String, String)
forall a. (HasCallStack, MakesValue a) => a -> App (String, String)
objQid removed
removed
  Request
req <- remover -> Service -> Versioned -> String -> App Request
forall user.
(HasCallStack, MakesValue user) =>
user -> Service -> Versioned -> String -> App Request
baseRequest remover
remover Service
Galley Versioned
Versioned ([String] -> String
joinHttpPath [String
"conversations", String
convDomain, String
convId, String
"members", String
removedDomain, String
removedId])
  String -> Request -> App Response
submit String
"DELETE" Request
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
  String
convId <- conv -> App String
forall a. (HasCallStack, MakesValue a) => a -> App String
objId conv
conv
  Request
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
"conversations", String
convId, String
"code"])
  String -> Request -> App Response
submit
    String
"POST"
    ( Request
req
        Request -> (Request -> Request) -> Request
forall a b. a -> (a -> b) -> b
& [Pair] -> Request -> Request
addJSONObject [String
"password" String -> String -> Pair
forall a. ToJSON a => String -> a -> Pair
.= String
pw | String
pw <- Maybe String -> [String]
forall a. Maybe a -> [a]
maybeToList Maybe String
mbpassword]
        Request -> (Request -> Request) -> Request
forall a b. a -> (a -> b) -> b
& (Request -> Request)
-> (String -> Request -> Request)
-> Maybe String
-> Request
-> Request
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Request -> Request
forall a. a -> a
id String -> Request -> Request
zHost Maybe String
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
  String
convId <- conv -> App String
forall a. (HasCallStack, MakesValue a) => a -> App String
objId conv
conv
  Request
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
"conversations", String
convId, String
"code"])
  String -> Request -> App Response
submit
    String
"GET"
    ( Request
req
        Request -> (Request -> Request) -> Request
forall a b. a -> (a -> b) -> b
& [(String, String)] -> Request -> Request
addQueryParams [(String
"cnv", String
convId)]
        Request -> (Request -> Request) -> Request
forall a b. a -> (a -> b) -> b
& (Request -> Request)
-> (String -> Request -> Request)
-> Maybe String
-> Request
-> Request
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Request -> Request
forall a. a -> a
id String -> Request -> Request
zHost Maybe String
mbZHost
    )

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
  Request
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"])
  String -> Request -> App Response
submit String
"GET" (Request
req Request -> (Request -> Request) -> Request
forall a b. a -> (a -> b) -> b
& [(String, String)] -> Request -> Request
addQueryParams [(String
"key", String
k), (String
"code", String
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 user qcnv protocol.
(HasCallStack, MakesValue user, MakesValue qcnv,
 MakesValue protocol) =>
user -> qcnv -> protocol -> App Response
changeConversationName user
user conv
qcnv name
name = do
  (String
convDomain, String
convId) <- conv -> App (String, String)
forall a. (HasCallStack, MakesValue a) => a -> App (String, String)
objQid conv
qcnv
  let path :: String
path = [String] -> String
joinHttpPath [String
"conversations", String
convDomain, String
convId, String
"name"]
  Value
nameReq <- name -> App Value
forall a. (MakesValue a, HasCallStack) => a -> App Value
make name
name
  Request
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
  String -> Request -> App Response
submit String
"PUT" (Request
req Request -> (Request -> Request) -> Request
forall a b. a -> (a -> b) -> b
& [Pair] -> Request -> Request
addJSONObject [String
"name" String -> Value -> Pair
forall a. ToJSON a => String -> a -> Pair
.= Value
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
  (String
cnvDomain, String
cnvId) <- qcnv -> App (String, String)
forall a. (HasCallStack, MakesValue a) => a -> App (String, String)
objQid qcnv
qcnv
  (String
tarDomain, String
tarId) <- targetUser -> App (String, String)
forall a. (HasCallStack, MakesValue a) => a -> App (String, String)
objQid targetUser
target
  Value
roleReq <- roleUpdate -> App Value
forall a. (MakesValue a, HasCallStack) => a -> App Value
make roleUpdate
role
  Request
req <-
    callerUser -> Service -> Versioned -> String -> App Request
forall user.
(HasCallStack, MakesValue user) =>
user -> Service -> Versioned -> String -> App Request
baseRequest
      callerUser
caller
      Service
Galley
      Versioned
Versioned
      ( [String] -> String
joinHttpPath [String
"conversations", String
cnvDomain, String
cnvId, String
"members", String
tarDomain, String
tarId]
      )
  String -> Request -> App Response
submit String
"PUT" (Request
req Request -> (Request -> Request) -> Request
forall a b. a -> (a -> b) -> b
& [Pair] -> Request -> Request
addJSONObject [String
"conversation_role" String -> Value -> Pair
forall a. ToJSON a => String -> a -> Pair
.= Value
roleReq])

updateReceiptMode ::
  ( HasCallStack,
    MakesValue user,
    MakesValue conv,
    MakesValue mode
  ) =>
  user ->
  conv ->
  mode ->
  App Response
updateReceiptMode :: forall user qcnv protocol.
(HasCallStack, MakesValue user, MakesValue qcnv,
 MakesValue protocol) =>
user -> qcnv -> protocol -> App Response
updateReceiptMode user
user conv
qcnv mode
mode = do
  (String
cnvDomain, String
cnvId) <- conv -> App (String, String)
forall a. (HasCallStack, MakesValue a) => a -> App (String, String)
objQid conv
qcnv
  Value
modeReq <- mode -> App Value
forall a. (MakesValue a, HasCallStack) => a -> App Value
make mode
mode
  let path :: String
path = [String] -> String
joinHttpPath [String
"conversations", String
cnvDomain, String
cnvId, String
"receipt-mode"]
  Request
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
  String -> Request -> App Response
submit String
"PUT" (Request
req Request -> (Request -> Request) -> Request
forall a b. a -> (a -> b) -> b
& [Pair] -> Request -> Request
addJSONObject [String
"receipt_mode" String -> Value -> Pair
forall a. ToJSON a => String -> a -> Pair
.= Value
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
  (String
cnvDomain, String
cnvId) <- conv -> App (String, String)
forall a. (HasCallStack, MakesValue a) => a -> App (String, String)
objQid conv
qcnv
  let path :: String
path = [String] -> String
joinHttpPath [String
"conversations", String
cnvDomain, String
cnvId, String
"access"]
  Request
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
  String -> Request -> App Response
submit String
"PUT" (Request
req Request -> (Request -> Request) -> Request
forall a b. a -> (a -> b) -> b
& [Pair] -> Request -> Request
addJSONObject [Pair]
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
  (String
cnvDomain, String
cnvId) <- conv -> App (String, String)
forall a. (HasCallStack, MakesValue a) => a -> App (String, String)
objQid conv
qcnv
  Value
updateReq <- Word64 -> App Value
forall a. (MakesValue a, HasCallStack) => a -> App Value
make Word64
update
  let path :: String
path = [String] -> String
joinHttpPath [String
"conversations", String
cnvDomain, String
cnvId, String
"message-timer"]
  Request
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
  String -> Request -> App Response
submit String
"PUT" ([Pair] -> Request -> Request
addJSONObject [String
"message_timer" String -> Value -> Pair
forall a. ToJSON a => String -> a -> Pair
.= Value
updateReq] Request
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
  String
tidStr <- tid -> App String
forall a. (HasCallStack, MakesValue a) => a -> App String
asString tid
tid
  Request
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
tidStr])
  String -> Request -> App Response
submit String
"GET" Request
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
  String
tidStr <- tid -> App String
forall a. (HasCallStack, MakesValue a) => a -> App String
asString tid
tid
  Request
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
tidStr, String
"members"])
  String -> Request -> App Response
submit String
"GET" Request
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
  String
tidStr <- tid -> App String
forall a. (HasCallStack, MakesValue a) => a -> App String
asString tid
tid
  Request
req <- caller -> Service -> Versioned -> String -> App Request
forall user.
(HasCallStack, MakesValue user) =>
user -> Service -> Versioned -> String -> App Request
baseRequest caller
caller Service
Galley Versioned
Versioned ([String] -> String
joinHttpPath [String
"teams", String
tidStr, String
"features", String
"appLock"])
  String -> Request -> App Response
submit
    String
"PUT"
    ( [Pair] -> Request -> Request
addJSONObject
        [ String
"status" String -> String -> Pair
forall a. ToJSON a => String -> a -> Pair
.= AppLockSettings
settings.status,
          String
"ttl" String -> String -> Pair
forall a. ToJSON a => String -> a -> Pair
.= String
"unlimited",
          String
"config"
            String -> Value -> Pair
forall a. ToJSON a => String -> a -> Pair
.= [Pair] -> Value
object
              [ String
"enforceAppLock" String -> Bool -> Pair
forall a. ToJSON a => String -> a -> Pair
.= AppLockSettings
settings.enforce,
                String
"inactivityTimeoutSecs" String -> Int -> Pair
forall a. ToJSON a => String -> a -> Pair
.= AppLockSettings
settings.inactivityTimeoutSecs
              ]
        ]
        Request
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
  String
tidStr <- tid -> App String
forall a. (HasCallStack, MakesValue a) => a -> App String
asString tid
tid
  Request
req <- caller -> Service -> Versioned -> String -> App Request
forall user.
(HasCallStack, MakesValue user) =>
user -> Service -> Versioned -> String -> App Request
baseRequest caller
caller Service
Galley Versioned
Versioned ([String] -> String
joinHttpPath [String
"teams", String
tidStr])
  String -> Request -> App Response
submit
    String
"PUT"
    ( [Pair] -> Request -> Request
addJSONObject
        [ String
"icon" String -> String -> Pair
forall a. ToJSON a => String -> a -> Pair
.= TeamProperties
properties.icon,
          String
"icon_key" String -> String -> Pair
forall a. ToJSON a => String -> a -> Pair
.= TeamProperties
properties.iconKey,
          String
"name" String -> String -> Pair
forall a. ToJSON a => String -> a -> Pair
.= TeamProperties
properties.name,
          String
"splash_screen" String -> String -> Pair
forall a. ToJSON a => String -> a -> Pair
.= TeamProperties
properties.spashScreen
        ]
        Request
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
  String
tidS <- tid -> App String
forall a. (HasCallStack, MakesValue a) => a -> App String
asString tid
tid
  String
uid <- user -> App String
forall a. (HasCallStack, MakesValue a) => a -> App String
objId user
user
  Request
req <- owner -> Service -> Versioned -> String -> App Request
forall user.
(HasCallStack, MakesValue user) =>
user -> Service -> Versioned -> String -> App Request
baseRequest owner
ownerid Service
Galley Versioned
Versioned ([String] -> String
joinHttpPath [String
"teams", String
tidS, String
"legalhold", String
uid])
  String -> Request -> App Response
submit String
"GET" Request
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
  String
tidStr <- tid -> App String
forall a. (HasCallStack, MakesValue a) => a -> App String
asString tid
tid
  String
uidStr <- uid -> App String
forall a. (HasCallStack, MakesValue a) => a -> App String
objId uid
uid
  Request
req <- ownerid -> Service -> Versioned -> String -> App Request
forall user.
(HasCallStack, MakesValue user) =>
user -> Service -> Versioned -> String -> App Request
baseRequest ownerid
ownerid Service
Galley Versioned
Versioned ([String] -> String
joinHttpPath [String
"teams", String
tidStr, String
"legalhold", String
uidStr])
  String -> Request -> App Response
submit String
"DELETE" ([Pair] -> Request -> Request
addJSONObject [String
"password" String -> String -> Pair
forall a. ToJSON a => String -> a -> Pair
.= String
pw] Request
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
  String
tidStr <- tid -> App String
forall a. (HasCallStack, MakesValue a) => a -> App String
asString tid
tid
  Request
req <- zusr -> Service -> Versioned -> String -> App Request
forall user.
(HasCallStack, MakesValue user) =>
user -> Service -> Versioned -> String -> App Request
baseRequest zusr
zusr Service
Galley Versioned
Versioned ([String] -> String
joinHttpPath [String
"teams", String
tidStr, String
"legalhold", String
"consent"])
  String -> Request -> App Response
submit String
"POST" ([Pair] -> Request -> Request
addJSONObject [String
"password" String -> String -> Pair
forall a. ToJSON a => String -> a -> Pair
.= String
pwd] Request
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
  String
tidStr <- tid -> App String
forall a. (HasCallStack, MakesValue a) => a -> App String
asString tid
tid
  String
uidStr <- App Value -> App String
forall a. (HasCallStack, MakesValue a) => a -> App String
asString (App Value -> App String) -> App Value -> App String
forall a b. (a -> b) -> a -> b
$ zusr
zusr zusr -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"id"
  Request
req <- zusr -> Service -> Versioned -> String -> App Request
forall user.
(HasCallStack, MakesValue user) =>
user -> Service -> Versioned -> String -> App Request
baseRequest zusr
zusr Service
Galley Versioned
Versioned ([String] -> String
joinHttpPath [String
"teams", String
tidStr, String
"legalhold", String
uidStr])
  String -> Request -> App Response
submit String
"GET" Request
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
    String
tidStr <- tid -> App String
forall a. (HasCallStack, MakesValue a) => a -> App String
asString tid
tid
    Request
req <- ownerid -> Service -> Versioned -> String -> App Request
forall user.
(HasCallStack, MakesValue user) =>
user -> Service -> Versioned -> String -> App Request
baseRequest ownerid
owner Service
Galley Versioned
Versioned ([String] -> String
joinHttpPath [String
"teams", String
tidStr, String
"legalhold", String
"settings"])
    Value
newSettingsObj <- newService -> App Value
forall a. (MakesValue a, HasCallStack) => a -> App Value
make newService
newSettings
    String -> Request -> App Response
submit String
"POST" (Value -> Request -> Request
forall a. ToJSON a => a -> Request -> Request
addJSON Value
newSettingsObj Request
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 user qcnv protocol.
(HasCallStack, MakesValue user, MakesValue qcnv,
 MakesValue protocol) =>
user -> qcnv -> protocol -> App Response
requestLegalHoldDevice tid
tid ownerid
ownerid uid
uid = do
  String
tidStr <- tid -> App String
forall a. (HasCallStack, MakesValue a) => a -> App String
asString tid
tid
  String
uidStr <- uid -> App String
forall a. (HasCallStack, MakesValue a) => a -> App String
objId uid
uid
  Request
req <- ownerid -> Service -> Versioned -> String -> App Request
forall user.
(HasCallStack, MakesValue user) =>
user -> Service -> Versioned -> String -> App Request
baseRequest ownerid
ownerid Service
Galley Versioned
Versioned ([String] -> String
joinHttpPath [String
"teams", String
tidStr, String
"legalhold", String
uidStr])
  String -> Request -> App Response
submit String
"POST" Request
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
  String
tidStr <- tid -> App String
forall a. (HasCallStack, MakesValue a) => a -> App String
asString tid
tid
  String
uidStr <- App Value -> App String
forall a. (HasCallStack, MakesValue a) => a -> App String
asString (App Value -> App String) -> App Value -> App String
forall a b. (a -> b) -> a -> b
$ forUid
forUid forUid -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"id"
  Request
req <- uid -> Service -> Versioned -> String -> App Request
forall user.
(HasCallStack, MakesValue user) =>
user -> Service -> Versioned -> String -> App Request
baseRequest uid
uid Service
Galley Versioned
Versioned ([String] -> String
joinHttpPath [String
"teams", String
tidStr, String
"legalhold", String
uidStr, String
"approve"])
  String -> Request -> App Response
submit String
"PUT" ([Pair] -> Request -> Request
addJSONObject [String
"password" String -> String -> Pair
forall a. ToJSON a => String -> a -> Pair
.= String
pwd] Request
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
  String
tidStr <- tid -> App String
forall a. (HasCallStack, MakesValue a) => a -> App String
asString tid
tid

  usr -> Service -> Versioned -> String -> App Request
forall user.
(HasCallStack, MakesValue user) =>
user -> Service -> Versioned -> String -> App Request
baseRequest usr
usr Service
Galley Versioned
Versioned ([String] -> String
joinHttpPath [String
"teams", String
tidStr, String
"features", String
"legalhold"])
    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
"PUT"
    (Request -> App Response)
-> (Request -> Request) -> Request -> App Response
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Pair] -> Request -> Request
addJSONObject [String
"status" String -> String -> Pair
forall a. ToJSON a => String -> a -> Pair
.= String
status, String
"ttl" String -> String -> Pair
forall a. ToJSON a => String -> a -> Pair
.= String
"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
  Request
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"
  String -> Request -> App Response
submit String
"GET" Request
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
  String
tidStr <- tid -> App String
forall a. (HasCallStack, MakesValue a) => a -> App String
asString tid
tid
  Request
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
tidStr, String
"features"])
  String -> Request -> App Response
submit String
"GET" Request
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
  String
tidStr <- tid -> App String
forall a. (HasCallStack, MakesValue a) => a -> App String
asString tid
tid
  Request
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
tidStr, String
"features", String
featureName])
  String -> Request -> App Response
submit String
"GET" Request
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
  String
tid <- team -> App String
forall a. (HasCallStack, MakesValue a) => a -> App String
asString team
team
  String
fn <- featureName -> App String
forall a. (HasCallStack, MakesValue a) => a -> App String
asString featureName
featureName
  Value
p <- payload -> App Value
forall a. (MakesValue a, HasCallStack) => a -> App Value
make payload
payload
  Request
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
"teams", String
tid, String
"features", String
fn]
  String -> Request -> App Response
submit String
"PUT" (Request -> App Response) -> Request -> App Response
forall a b. (a -> b) -> a -> b
$ Request
req Request -> (Request -> Request) -> Request
forall a b. a -> (a -> b) -> b
& Value -> Request -> Request
forall a. ToJSON a => a -> Request -> Request
addJSON Value
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"