module Test.MLS.Clients where

import qualified API.BrigInternal as I
import MLS.Util
import SetupHelpers
import Testlib.Prelude

testGetMLSClients :: (HasCallStack) => App ()
testGetMLSClients :: HasCallStack => App ()
testGetMLSClients = do
  Value
alice <- Domain -> CreateUser -> App Value
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> CreateUser -> App Value
randomUser Domain
OwnDomain CreateUser
forall a. Default a => a
def
  ClientIdentity
alice1 <- Value -> AddClient -> App ClientIdentity
forall u.
(MakesValue u, HasCallStack) =>
u -> AddClient -> App ClientIdentity
createWireClient Value
alice AddClient
forall a. Default a => a
def

  App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse (Value -> Ciphersuite -> App Response
forall user.
(HasCallStack, MakesValue user) =>
user -> Ciphersuite -> App Response
I.getMLSClients Value
alice Ciphersuite
forall a. Default a => a
def) ((Response -> App ()) -> App ()) -> (Response -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \Response
resp -> do
    Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200
    [Value]
cs <- Response
resp.json App Value -> (App Value -> App [Value]) -> App [Value]
forall a b. a -> (a -> b) -> b
& App Value -> App [Value]
forall a. (HasCallStack, MakesValue a) => a -> App [Value]
asList
    Value
c <- [Value] -> App Value
forall (t :: * -> *) a. (HasCallStack, Foldable t) => t a -> App a
assertOne [Value]
cs
    Value
c
      Value -> Value -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` [Pair] -> Value
object
        [ String
"mls" String -> Bool -> Pair
forall a. ToJSON a => String -> a -> Pair
.= Bool
False,
          String
"id" String -> String -> Pair
forall a. ToJSON a => String -> a -> Pair
.= ClientIdentity
alice1.client
        ]

  Value
keys <- InitMLSClient -> ClientIdentity -> App Value
initMLSClient InitMLSClient
forall a. Default a => a
def ClientIdentity
alice1
  Value
ss <- Value
keys Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. Ciphersuite -> String
csSignatureScheme Ciphersuite
forall a. Default a => a
def

  App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse (Value -> Ciphersuite -> App Response
forall user.
(HasCallStack, MakesValue user) =>
user -> Ciphersuite -> App Response
I.getMLSClients Value
alice Ciphersuite
forall a. Default a => a
def) ((Response -> App ()) -> App ()) -> (Response -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \Response
resp -> do
    Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200
    [Value]
cs <- Response
resp.json App Value -> (App Value -> App [Value]) -> App [Value]
forall a b. a -> (a -> b) -> b
& App Value -> App [Value]
forall a. (HasCallStack, MakesValue a) => a -> App [Value]
asList
    Value
c <- [Value] -> App Value
forall (t :: * -> *) a. (HasCallStack, Foldable t) => t a -> App a
assertOne [Value]
cs
    Value
c
      Value -> Value -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` [Pair] -> Value
object
        [ String
"mls" String -> Bool -> Pair
forall a. ToJSON a => String -> a -> Pair
.= Bool
False,
          String
"id" String -> String -> Pair
forall a. ToJSON a => String -> a -> Pair
.= ClientIdentity
alice1.client,
          String
"mls_signature_key" String -> Value -> Pair
forall a. ToJSON a => String -> a -> Pair
.= Value
ss
        ]

  App String -> App ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (App String -> App ()) -> App String -> App ()
forall a b. (a -> b) -> a -> b
$ HasCallStack => Ciphersuite -> ClientIdentity -> App String
Ciphersuite -> ClientIdentity -> App String
uploadNewKeyPackage Ciphersuite
forall a. Default a => a
def ClientIdentity
alice1

  App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse (Value -> Ciphersuite -> App Response
forall user.
(HasCallStack, MakesValue user) =>
user -> Ciphersuite -> App Response
I.getMLSClients Value
alice Ciphersuite
forall a. Default a => a
def) ((Response -> App ()) -> App ()) -> (Response -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \Response
resp -> do
    Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200
    [Value]
cs <- Response
resp.json App Value -> (App Value -> App [Value]) -> App [Value]
forall a b. a -> (a -> b) -> b
& App Value -> App [Value]
forall a. (HasCallStack, MakesValue a) => a -> App [Value]
asList
    Value
c <- [Value] -> App Value
forall (t :: * -> *) a. (HasCallStack, Foldable t) => t a -> App a
assertOne [Value]
cs
    Value
c
      Value -> Value -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` [Pair] -> Value
object
        [ String
"mls" String -> Bool -> Pair
forall a. ToJSON a => String -> a -> Pair
.= Bool
True,
          String
"id" String -> String -> Pair
forall a. ToJSON a => String -> a -> Pair
.= ClientIdentity
alice1.client,
          String
"mls_signature_key" String -> Value -> Pair
forall a. ToJSON a => String -> a -> Pair
.= Value
ss
        ]