-- FUTUREWORK:
-- GET /mls/key-packages/self/:client/count should be
-- tested with expired package

module Test.MLS.KeyPackage where

import API.Brig
import MLS.Util
import SetupHelpers
import Testlib.Prelude

testDeleteKeyPackages :: App ()
testDeleteKeyPackages :: App ()
testDeleteKeyPackages = 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 <- InitMLSClient -> Value -> App ClientIdentity
forall u.
(MakesValue u, HasCallStack) =>
InitMLSClient -> u -> App ClientIdentity
createMLSClient InitMLSClient
forall a. Default a => a
def Value
alice
  [String]
kps <- Int -> App String -> App [String]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
3 (HasCallStack => ClientIdentity -> App String
ClientIdentity -> App String
uploadNewKeyPackage ClientIdentity
alice1)

  -- add an extra non-existing key package to the delete request
  let kps' :: [String]
kps' = String
"4B701F521EBE82CEC4AD5CB67FDD8E1C43FC4868DE32D03933CE4993160B75E8" String -> [String] -> [String]
forall a. a -> [a] -> [a]
: [String]
kps

  App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse (ClientIdentity -> [String] -> App Response
deleteKeyPackages ClientIdentity
alice1 [String]
kps') ((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
201

  App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse (Ciphersuite -> ClientIdentity -> App Response
countKeyPackages Ciphersuite
forall a. Default a => a
def ClientIdentity
alice1) ((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
    Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"count" App Value -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
0

testKeyPackageMultipleCiphersuites :: App ()
testKeyPackageMultipleCiphersuites :: App ()
testKeyPackageMultipleCiphersuites = 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, ClientIdentity
alice2] <- Int -> App ClientIdentity -> App [ClientIdentity]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
2 (InitMLSClient -> Value -> App ClientIdentity
forall u.
(MakesValue u, HasCallStack) =>
InitMLSClient -> u -> App ClientIdentity
createMLSClient InitMLSClient
forall a. Default a => a
def Value
alice)

  String
kp <- HasCallStack => ClientIdentity -> App String
ClientIdentity -> App String
uploadNewKeyPackage ClientIdentity
alice2

  let suite :: Ciphersuite
suite = String -> Ciphersuite
Ciphersuite String
"0xf031"
  Ciphersuite -> App ()
setMLSCiphersuite Ciphersuite
suite
  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 => ClientIdentity -> App String
ClientIdentity -> App String
uploadNewKeyPackage ClientIdentity
alice2

  -- count key packages with default ciphersuite
  App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse (Ciphersuite -> ClientIdentity -> App Response
countKeyPackages Ciphersuite
forall a. Default a => a
def ClientIdentity
alice2) ((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
    Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"count" App Value -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
1

  -- claim key packages with default ciphersuite
  App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse (Ciphersuite -> ClientIdentity -> Value -> App Response
forall u v.
(HasCallStack, MakesValue u, MakesValue v) =>
Ciphersuite -> u -> v -> App Response
claimKeyPackages Ciphersuite
forall a. Default a => a
def ClientIdentity
alice1 Value
alice) ((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
    Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"key_packages.0.key_package_ref" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
kp

  -- count key package with the other ciphersuite
  App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse (Ciphersuite -> ClientIdentity -> App Response
countKeyPackages Ciphersuite
suite ClientIdentity
alice2) ((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
    Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"count" App Value -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
1

testKeyPackageUploadNoKey :: App ()
testKeyPackageUploadNoKey :: App ()
testKeyPackageUploadNoKey = 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 -> App ClientIdentity
forall u. (MakesValue u, HasCallStack) => u -> App ClientIdentity
createWireClient Value
alice

  (ByteString
kp, String
_) <- HasCallStack => ClientIdentity -> App (ByteString, String)
ClientIdentity -> App (ByteString, String)
generateKeyPackage ClientIdentity
alice1

  -- if we upload a keypackage without a key,
  -- we get a bad request
  ClientIdentity -> [ByteString] -> App Response
uploadKeyPackages ClientIdentity
alice1 [ByteString
kp] App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
`bindResponse` \Response
resp -> do
    Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
400

  -- there should be no keypackages after getting
  -- a rejection by the backend
  Ciphersuite -> ClientIdentity -> App Response
countKeyPackages 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` \Response
resp -> do
    Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"count" App Value -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
0
    Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200

testKeyPackageClaim :: App ()
testKeyPackageClaim :: App ()
testKeyPackageClaim = 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
  alices :: [ClientIdentity]
alices@[ClientIdentity
alice1, ClientIdentity
_alice2] <- Int -> App ClientIdentity -> App [ClientIdentity]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
2 do
    InitMLSClient -> Value -> App ClientIdentity
forall u.
(MakesValue u, HasCallStack) =>
InitMLSClient -> u -> App ClientIdentity
createMLSClient InitMLSClient
forall a. Default a => a
def Value
alice

  [ClientIdentity] -> (ClientIdentity -> App [String]) -> App ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ [ClientIdentity]
alices \ClientIdentity
alicei -> Int -> App String -> App [String]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
3 do
    HasCallStack => ClientIdentity -> App String
ClientIdentity -> App String
uploadNewKeyPackage ClientIdentity
alicei

  Value
bob <- Domain -> CreateUser -> App Value
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> CreateUser -> App Value
randomUser Domain
OwnDomain CreateUser
forall a. Default a => a
def
  [ClientIdentity]
bobs <- Int -> App ClientIdentity -> App [ClientIdentity]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
3 do
    InitMLSClient -> Value -> App ClientIdentity
forall u.
(MakesValue u, HasCallStack) =>
InitMLSClient -> u -> App ClientIdentity
createMLSClient InitMLSClient
forall a. Default a => a
def Value
bob

  [ClientIdentity] -> (ClientIdentity -> App ()) -> App ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ [ClientIdentity]
bobs \ClientIdentity
bobi ->
    Ciphersuite -> ClientIdentity -> Value -> App Response
forall u v.
(HasCallStack, MakesValue u, MakesValue v) =>
Ciphersuite -> u -> v -> App Response
claimKeyPackages Ciphersuite
forall a. Default a => a
def ClientIdentity
bobi Value
alice App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
`bindResponse` \Response
resp -> do
      [Value]
ks <- Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"key_packages" 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

      -- all of the keypackages should by issued by alice
      [Value] -> (Value -> App ()) -> App ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ [Value]
ks \Value
k ->
        (Value
k Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"user") App Value -> App Value -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` (Value
alice Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"id")

      -- every claimed keypackage bundle should contain
      -- exactly one of each of the keypackages issued by
      -- alice
      [Value] -> (Value -> App Value) -> App [Value]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for [Value]
ks (Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"client")
        App [Value] -> ([Value] -> App ()) -> App ()
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ([Value] -> [String] -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatchSet` (ClientIdentity -> String) -> [ClientIdentity] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (.client) [ClientIdentity]
alices)

      -- claiming keypckages should return 200
      Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200

  -- bob has claimed all keypackages by alice, so there should
  -- be none left
  Ciphersuite -> ClientIdentity -> App Response
countKeyPackages 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` \Response
resp -> do
    Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"count" App Value -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
0
    Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200

testKeyPackageSelfClaim :: App ()
testKeyPackageSelfClaim :: App ()
testKeyPackageSelfClaim = 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
  alices :: [ClientIdentity]
alices@[ClientIdentity
alice1, ClientIdentity
alice2] <- Int -> App ClientIdentity -> App [ClientIdentity]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
2 do
    InitMLSClient -> Value -> App ClientIdentity
forall u.
(MakesValue u, HasCallStack) =>
InitMLSClient -> u -> App ClientIdentity
createMLSClient InitMLSClient
forall a. Default a => a
def Value
alice
  [ClientIdentity] -> (ClientIdentity -> App [String]) -> App ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ [ClientIdentity]
alices \ClientIdentity
alicei -> Int -> App String -> App [String]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
3 do
    HasCallStack => ClientIdentity -> App String
ClientIdentity -> App String
uploadNewKeyPackage ClientIdentity
alicei

  -- claim own keypackages
  Ciphersuite -> ClientIdentity -> Value -> App Response
forall u v.
(HasCallStack, MakesValue u, MakesValue v) =>
Ciphersuite -> u -> v -> App Response
claimKeyPackages Ciphersuite
forall a. Default a => a
def ClientIdentity
alice1 Value
alice App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
`bindResponse` \Response
resp -> do
    Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200

    Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"key_packages"
      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
        -- the keypackage claimed by client 1 should be issued by
        -- client 2
        App [Value] -> ([Value] -> App ()) -> App ()
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \[Value
v] -> Value
v Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"client" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` ClientIdentity
alice2.client

  -- - the keypackages of client 1 (claimer) should still be there
  -- - two of the keypackages of client 2 (claimee) should be stil
  --   there
  [(ClientIdentity, Int)]
-> ((ClientIdentity, Int) -> App ()) -> App ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ ([ClientIdentity] -> [Int] -> [(ClientIdentity, Int)]
forall a b. [a] -> [b] -> [(a, b)]
zip [ClientIdentity]
alices [Int
3, Int
2]) \(ClientIdentity
alicei, Int
n) ->
    Ciphersuite -> ClientIdentity -> App Response
countKeyPackages Ciphersuite
forall a. Default a => a
def ClientIdentity
alicei App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
`bindResponse` \Response
resp -> do
      Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"count" App Value -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
n
      Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200

  Value
bob <- Domain -> CreateUser -> App Value
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> CreateUser -> App Value
randomUser Domain
OwnDomain CreateUser
forall a. Default a => a
def
  [ClientIdentity]
bobs <- Int -> App ClientIdentity -> App [ClientIdentity]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
2 do
    InitMLSClient -> Value -> App ClientIdentity
forall u.
(MakesValue u, HasCallStack) =>
InitMLSClient -> u -> App ClientIdentity
createMLSClient InitMLSClient
forall a. Default a => a
def Value
bob

  -- skip own should only apply to own keypackages, hence
  -- bob claiming alices keypackages should work as normal
  String
a1s <- ClientIdentity
alice1 ClientIdentity -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"client_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
  [ClientIdentity] -> (ClientIdentity -> App ()) -> App ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ [ClientIdentity]
bobs \ClientIdentity
bobi ->
    Ciphersuite
-> ClientIdentity -> Value -> [(String, String)] -> App Response
forall u v.
(MakesValue u, MakesValue v) =>
Ciphersuite -> u -> v -> [(String, String)] -> App Response
claimKeyPackagesWithParams Ciphersuite
forall a. Default a => a
def ClientIdentity
bobi Value
alice [(String
"skip_own", String
a1s)] App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
`bindResponse` \Response
resp -> do
      (Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"key_packages" 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 App [Value] -> ([Value] -> Int) -> App Int
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> [Value] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length) App Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
2
      Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200

  -- alices keypackages should be gone after bob claimed them
  [(ClientIdentity, Int)]
-> ((ClientIdentity, Int) -> App ()) -> App ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ ([ClientIdentity] -> [Int] -> [(ClientIdentity, Int)]
forall a b. [a] -> [b] -> [(a, b)]
zip [ClientIdentity]
alices [Int
1, Int
0]) \(ClientIdentity
alicei, Int
n) ->
    Ciphersuite -> ClientIdentity -> App Response
countKeyPackages Ciphersuite
forall a. Default a => a
def ClientIdentity
alicei App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
`bindResponse` \Response
resp -> do
      Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"count" App Value -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
n
      Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200

testKeyPackageRemoteClaim :: App ()
testKeyPackageRemoteClaim :: App ()
testKeyPackageRemoteClaim = 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 <- InitMLSClient -> Value -> App ClientIdentity
forall u.
(MakesValue u, HasCallStack) =>
InitMLSClient -> u -> App ClientIdentity
createMLSClient InitMLSClient
forall a. Default a => a
def Value
alice

  Value
charlie <- Domain -> CreateUser -> App Value
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> CreateUser -> App Value
randomUser Domain
OtherDomain CreateUser
forall a. Default a => a
def
  ClientIdentity
charlie1 <- InitMLSClient -> Value -> App ClientIdentity
forall u.
(MakesValue u, HasCallStack) =>
InitMLSClient -> u -> App ClientIdentity
createMLSClient InitMLSClient
forall a. Default a => a
def Value
charlie

  String
refCharlie <- HasCallStack => ClientIdentity -> App String
ClientIdentity -> App String
uploadNewKeyPackage ClientIdentity
charlie1
  String
refAlice <- HasCallStack => ClientIdentity -> App String
ClientIdentity -> App String
uploadNewKeyPackage ClientIdentity
alice1

  -- the user should be able to claim the keypackage of
  -- a remote user and vice versa
  [(ClientIdentity, Value, ClientIdentity, String)]
-> ((ClientIdentity, Value, ClientIdentity, String) -> App ())
-> App ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_
    [ (ClientIdentity
alice1, Value
charlie, ClientIdentity
charlie1, String
refCharlie),
      (ClientIdentity
charlie1, Value
alice, ClientIdentity
alice1, String
refAlice)
    ]
    \(ClientIdentity
claimer, Value
claimee, ClientIdentity
uploader, String
reference) -> do
      Ciphersuite -> ClientIdentity -> Value -> App Response
forall u v.
(HasCallStack, MakesValue u, MakesValue v) =>
Ciphersuite -> u -> v -> App Response
claimKeyPackages Ciphersuite
forall a. Default a => a
def ClientIdentity
claimer Value
claimee App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
`bindResponse` \Response
resp -> do
        -- make sure that the reference match on the keypackages
        [Value
kp] <- Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"key_packages" 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
kp Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"key_package_ref" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
reference
        Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200

      -- the key package of the uploading client should be gone
      -- after claiming
      Ciphersuite -> ClientIdentity -> App Response
countKeyPackages Ciphersuite
forall a. Default a => a
def ClientIdentity
uploader App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
`bindResponse` \Response
resp -> do
        Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"count" App Value -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
0
        Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200

testKeyPackageCount :: (HasCallStack) => Ciphersuite -> App ()
testKeyPackageCount :: HasCallStack => Ciphersuite -> App ()
testKeyPackageCount Ciphersuite
cs = do
  Ciphersuite -> App ()
setMLSCiphersuite Ciphersuite
cs
  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 <- InitMLSClient -> Value -> App ClientIdentity
forall u.
(MakesValue u, HasCallStack) =>
InitMLSClient -> u -> App ClientIdentity
createMLSClient InitMLSClient
forall a. Default a => a
def Value
alice

  App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse (Ciphersuite -> ClientIdentity -> App Response
countKeyPackages Ciphersuite
cs ClientIdentity
alice1) ((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
    Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"count" App Value -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
0

  let count :: Int
count = Int
10
  [ByteString]
kps <- ((ByteString, String) -> ByteString)
-> [(ByteString, String)] -> [ByteString]
forall a b. (a -> b) -> [a] -> [b]
map (ByteString, String) -> ByteString
forall a b. (a, b) -> a
fst ([(ByteString, String)] -> [ByteString])
-> App [(ByteString, String)] -> App [ByteString]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> App (ByteString, String) -> App [(ByteString, String)]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
count (HasCallStack => ClientIdentity -> App (ByteString, String)
ClientIdentity -> App (ByteString, String)
generateKeyPackage ClientIdentity
alice1)
  App ByteString -> App ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (App ByteString -> App ()) -> App ByteString -> App ()
forall a b. (a -> b) -> a -> b
$ ClientIdentity -> [ByteString] -> App Response
uploadKeyPackages ClientIdentity
alice1 [ByteString]
kps App Response -> (Response -> App ByteString) -> App ByteString
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => Int -> Response -> App ByteString
Int -> Response -> App ByteString
getBody Int
201

  App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse (Ciphersuite -> ClientIdentity -> App Response
countKeyPackages Ciphersuite
cs ClientIdentity
alice1) ((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
    Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"count" App Value -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
count

testUnsupportedCiphersuite :: (HasCallStack) => App ()
testUnsupportedCiphersuite :: HasCallStack => App ()
testUnsupportedCiphersuite = do
  let suite :: Ciphersuite
suite = String -> Ciphersuite
Ciphersuite String
"0x0003"
  Ciphersuite -> App ()
setMLSCiphersuite Ciphersuite
suite
  Value
bob <- Domain -> CreateUser -> App Value
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> CreateUser -> App Value
randomUser Domain
OwnDomain CreateUser
forall a. Default a => a
def
  ClientIdentity
bob1 <- InitMLSClient -> Value -> App ClientIdentity
forall u.
(MakesValue u, HasCallStack) =>
InitMLSClient -> u -> App ClientIdentity
createMLSClient InitMLSClient
forall a. Default a => a
def Value
bob
  (ByteString
kp, String
_) <- HasCallStack => ClientIdentity -> App (ByteString, String)
ClientIdentity -> App (ByteString, String)
generateKeyPackage ClientIdentity
bob1
  App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse (ClientIdentity -> [ByteString] -> App Response
uploadKeyPackages ClientIdentity
bob1 [ByteString
kp]) ((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
400
    Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"label" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
"mls-protocol-error"

testReplaceKeyPackages :: (HasCallStack) => App ()
testReplaceKeyPackages :: HasCallStack => App ()
testReplaceKeyPackages = 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, ClientIdentity
alice2] <- Int -> App ClientIdentity -> App [ClientIdentity]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
2 (App ClientIdentity -> App [ClientIdentity])
-> App ClientIdentity -> App [ClientIdentity]
forall a b. (a -> b) -> a -> b
$ InitMLSClient -> Value -> App ClientIdentity
forall u.
(MakesValue u, HasCallStack) =>
InitMLSClient -> u -> App ClientIdentity
createMLSClient InitMLSClient
forall a. Default a => a
def Value
alice
  let suite :: Ciphersuite
suite = String -> Ciphersuite
Ciphersuite String
"0xf031"

  let checkCount :: Ciphersuite -> Int -> App ()
checkCount Ciphersuite
cs Int
n =
        App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse (Ciphersuite -> ClientIdentity -> App Response
countKeyPackages Ciphersuite
cs ClientIdentity
alice1) ((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
          Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"count" App Value -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
n

  -- setup: upload a batch of key packages for each ciphersuite
  App ByteString -> App ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void
    (App ByteString -> App ()) -> App ByteString -> App ()
forall a b. (a -> b) -> a -> b
$ Int -> App ByteString -> App [ByteString]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
4 (((ByteString, String) -> ByteString)
-> App (ByteString, String) -> App ByteString
forall a b. (a -> b) -> App a -> App b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (ByteString, String) -> ByteString
forall a b. (a, b) -> a
fst (HasCallStack => ClientIdentity -> App (ByteString, String)
ClientIdentity -> App (ByteString, String)
generateKeyPackage ClientIdentity
alice1))
    App [ByteString] -> ([ByteString] -> 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
>>= ClientIdentity -> [ByteString] -> App Response
uploadKeyPackages ClientIdentity
alice1
    App Response -> (Response -> App ByteString) -> App ByteString
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => Int -> Response -> App ByteString
Int -> Response -> App ByteString
getBody Int
201
  Ciphersuite -> App ()
setMLSCiphersuite Ciphersuite
suite
  App ByteString -> App ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void
    (App ByteString -> App ()) -> App ByteString -> App ()
forall a b. (a -> b) -> a -> b
$ Int -> App ByteString -> App [ByteString]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
5 (((ByteString, String) -> ByteString)
-> App (ByteString, String) -> App ByteString
forall a b. (a -> b) -> App a -> App b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (ByteString, String) -> ByteString
forall a b. (a, b) -> a
fst (HasCallStack => ClientIdentity -> App (ByteString, String)
ClientIdentity -> App (ByteString, String)
generateKeyPackage ClientIdentity
alice1))
    App [ByteString] -> ([ByteString] -> 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
>>= ClientIdentity -> [ByteString] -> App Response
uploadKeyPackages ClientIdentity
alice1
    App Response -> (Response -> App ByteString) -> App ByteString
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => Int -> Response -> App ByteString
Int -> Response -> App ByteString
getBody Int
201

  Ciphersuite -> Int -> App ()
checkCount Ciphersuite
forall a. Default a => a
def Int
4
  Ciphersuite -> Int -> App ()
checkCount Ciphersuite
suite Int
5

  do
    -- generate a new batch of key packages
    ([ByteString]
kps, [String]
refs) <- [(ByteString, String)] -> ([ByteString], [String])
forall a b. [(a, b)] -> ([a], [b])
unzip ([(ByteString, String)] -> ([ByteString], [String]))
-> App [(ByteString, String)] -> App ([ByteString], [String])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> App (ByteString, String) -> App [(ByteString, String)]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
3 (HasCallStack => ClientIdentity -> App (ByteString, String)
ClientIdentity -> App (ByteString, String)
generateKeyPackage ClientIdentity
alice1)

    -- replace old key packages with new
    App ByteString -> App ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (App ByteString -> App ()) -> App ByteString -> App ()
forall a b. (a -> b) -> a -> b
$ ClientIdentity
-> Maybe [Ciphersuite] -> [ByteString] -> App Response
replaceKeyPackages ClientIdentity
alice1 ([Ciphersuite] -> Maybe [Ciphersuite]
forall a. a -> Maybe a
Just [Ciphersuite
suite]) [ByteString]
kps App Response -> (Response -> App ByteString) -> App ByteString
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => Int -> Response -> App ByteString
Int -> Response -> App ByteString
getBody Int
201

    Ciphersuite -> Int -> App ()
checkCount Ciphersuite
forall a. Default a => a
def Int
4
    Ciphersuite -> Int -> App ()
checkCount Ciphersuite
suite Int
3

    -- claim all key packages one by one
    [Value]
claimed <-
      Int -> App Value -> App [Value]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
3
        (App Value -> App [Value]) -> App Value -> App [Value]
forall a b. (a -> b) -> a -> b
$ App Response -> (Response -> App Value) -> App Value
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse (Ciphersuite -> ClientIdentity -> Value -> App Response
forall u v.
(HasCallStack, MakesValue u, MakesValue v) =>
Ciphersuite -> u -> v -> App Response
claimKeyPackages Ciphersuite
suite ClientIdentity
alice2 Value
alice)
        ((Response -> App Value) -> App Value)
-> (Response -> App Value) -> App Value
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]
ks <- Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"key_packages" 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
k <- [Value] -> App Value
forall (t :: * -> *) a. (HasCallStack, Foldable t) => t a -> App a
assertOne [Value]
ks
          Value
k Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"key_package_ref"

    [String]
refs [String] -> [Value] -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatchSet` [Value]
claimed

    Ciphersuite -> Int -> App ()
checkCount Ciphersuite
forall a. Default a => a
def Int
4
    Ciphersuite -> Int -> App ()
checkCount Ciphersuite
suite Int
0

  do
    -- replenish key packages for the second ciphersuite
    App ByteString -> App ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void
      (App ByteString -> App ()) -> App ByteString -> App ()
forall a b. (a -> b) -> a -> b
$ Int -> App ByteString -> App [ByteString]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
5 (((ByteString, String) -> ByteString)
-> App (ByteString, String) -> App ByteString
forall a b. (a -> b) -> App a -> App b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (ByteString, String) -> ByteString
forall a b. (a, b) -> a
fst (HasCallStack => ClientIdentity -> App (ByteString, String)
ClientIdentity -> App (ByteString, String)
generateKeyPackage ClientIdentity
alice1))
      App [ByteString] -> ([ByteString] -> 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
>>= ClientIdentity -> [ByteString] -> App Response
uploadKeyPackages ClientIdentity
alice1
      App Response -> (Response -> App ByteString) -> App ByteString
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => Int -> Response -> App ByteString
Int -> Response -> App ByteString
getBody Int
201

    Ciphersuite -> Int -> App ()
checkCount Ciphersuite
forall a. Default a => a
def Int
4
    Ciphersuite -> Int -> App ()
checkCount Ciphersuite
suite Int
5

    -- replace all key packages with fresh ones
    Ciphersuite -> App ()
setMLSCiphersuite Ciphersuite
forall a. Default a => a
def
    [ByteString]
kps1 <- Int -> App ByteString -> App [ByteString]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
2 (((ByteString, String) -> ByteString)
-> App (ByteString, String) -> App ByteString
forall a b. (a -> b) -> App a -> App b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (ByteString, String) -> ByteString
forall a b. (a, b) -> a
fst (HasCallStack => ClientIdentity -> App (ByteString, String)
ClientIdentity -> App (ByteString, String)
generateKeyPackage ClientIdentity
alice1))
    Ciphersuite -> App ()
setMLSCiphersuite Ciphersuite
suite
    [ByteString]
kps2 <- Int -> App ByteString -> App [ByteString]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
2 (((ByteString, String) -> ByteString)
-> App (ByteString, String) -> App ByteString
forall a b. (a -> b) -> App a -> App b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (ByteString, String) -> ByteString
forall a b. (a, b) -> a
fst (HasCallStack => ClientIdentity -> App (ByteString, String)
ClientIdentity -> App (ByteString, String)
generateKeyPackage ClientIdentity
alice1))

    App ByteString -> App ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (App ByteString -> App ()) -> App ByteString -> App ()
forall a b. (a -> b) -> a -> b
$ ClientIdentity
-> Maybe [Ciphersuite] -> [ByteString] -> App Response
replaceKeyPackages ClientIdentity
alice1 ([Ciphersuite] -> Maybe [Ciphersuite]
forall a. a -> Maybe a
Just [Ciphersuite
forall a. Default a => a
def, Ciphersuite
suite]) ([ByteString]
kps1 [ByteString] -> [ByteString] -> [ByteString]
forall a. Semigroup a => a -> a -> a
<> [ByteString]
kps2) App Response -> (Response -> App ByteString) -> App ByteString
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => Int -> Response -> App ByteString
Int -> Response -> App ByteString
getBody Int
201

    Ciphersuite -> Int -> App ()
checkCount Ciphersuite
forall a. Default a => a
def Int
2
    Ciphersuite -> Int -> App ()
checkCount Ciphersuite
suite Int
2

  do
    Ciphersuite -> App ()
setMLSCiphersuite Ciphersuite
forall a. Default a => a
def
    [ByteString]
defKeyPackages <- Int -> App ByteString -> App [ByteString]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
3 (((ByteString, String) -> ByteString)
-> App (ByteString, String) -> App ByteString
forall a b. (a -> b) -> App a -> App b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (ByteString, String) -> ByteString
forall a b. (a, b) -> a
fst (HasCallStack => ClientIdentity -> App (ByteString, String)
ClientIdentity -> App (ByteString, String)
generateKeyPackage ClientIdentity
alice1))
    Ciphersuite -> App ()
setMLSCiphersuite Ciphersuite
suite
    [ByteString]
suiteKeyPackages <- Int -> App ByteString -> App [ByteString]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
3 (((ByteString, String) -> ByteString)
-> App (ByteString, String) -> App ByteString
forall a b. (a -> b) -> App a -> App b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (ByteString, String) -> ByteString
forall a b. (a, b) -> a
fst (HasCallStack => ClientIdentity -> App (ByteString, String)
ClientIdentity -> App (ByteString, String)
generateKeyPackage ClientIdentity
alice1))

    App () -> App ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void
      (App () -> App ()) -> App () -> App ()
forall a b. (a -> b) -> a -> b
$ ClientIdentity
-> Maybe [Ciphersuite] -> [ByteString] -> App Response
replaceKeyPackages ClientIdentity
alice1 ([Ciphersuite] -> Maybe [Ciphersuite]
forall a. a -> Maybe a
Just []) []
      App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
`bindResponse` \Response
resp -> do
        Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
201

    App () -> App ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void
      (App () -> App ()) -> App () -> App ()
forall a b. (a -> b) -> a -> b
$ ClientIdentity
-> Maybe [Ciphersuite] -> [ByteString] -> App Response
replaceKeyPackages ClientIdentity
alice1 Maybe [Ciphersuite]
forall a. Maybe a
Nothing [ByteString]
defKeyPackages
      App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
`bindResponse` \Response
resp -> do
        Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
201

    Ciphersuite -> Int -> App ()
checkCount Ciphersuite
forall a. Default a => a
def Int
3
    Ciphersuite -> Int -> App ()
checkCount Ciphersuite
suite Int
2

    let testErrorCases :: (HasCallStack) => Maybe [Ciphersuite] -> [ByteString] -> App ()
        testErrorCases :: HasCallStack => Maybe [Ciphersuite] -> [ByteString] -> App ()
testErrorCases Maybe [Ciphersuite]
ciphersuites [ByteString]
keyPackages = do
          App () -> App ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void
            (App () -> App ()) -> App () -> App ()
forall a b. (a -> b) -> a -> b
$ ClientIdentity
-> Maybe [Ciphersuite] -> [ByteString] -> App Response
replaceKeyPackages ClientIdentity
alice1 Maybe [Ciphersuite]
ciphersuites [ByteString]
keyPackages
            App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
`bindResponse` \Response
resp -> do
              Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
400
              Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"label" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
"mls-protocol-error"
          Ciphersuite -> Int -> App ()
checkCount Ciphersuite
forall a. Default a => a
def Int
3
          Ciphersuite -> Int -> App ()
checkCount Ciphersuite
suite Int
2

    HasCallStack => Maybe [Ciphersuite] -> [ByteString] -> App ()
Maybe [Ciphersuite] -> [ByteString] -> App ()
testErrorCases ([Ciphersuite] -> Maybe [Ciphersuite]
forall a. a -> Maybe a
Just []) [ByteString]
defKeyPackages
    HasCallStack => Maybe [Ciphersuite] -> [ByteString] -> App ()
Maybe [Ciphersuite] -> [ByteString] -> App ()
testErrorCases ([Ciphersuite] -> Maybe [Ciphersuite]
forall a. a -> Maybe a
Just []) [ByteString]
suiteKeyPackages
    HasCallStack => Maybe [Ciphersuite] -> [ByteString] -> App ()
Maybe [Ciphersuite] -> [ByteString] -> App ()
testErrorCases Maybe [Ciphersuite]
forall a. Maybe a
Nothing []
    HasCallStack => Maybe [Ciphersuite] -> [ByteString] -> App ()
Maybe [Ciphersuite] -> [ByteString] -> App ()
testErrorCases Maybe [Ciphersuite]
forall a. Maybe a
Nothing [ByteString]
suiteKeyPackages
    HasCallStack => Maybe [Ciphersuite] -> [ByteString] -> App ()
Maybe [Ciphersuite] -> [ByteString] -> App ()
testErrorCases Maybe [Ciphersuite]
forall a. Maybe a
Nothing ([ByteString]
suiteKeyPackages [ByteString] -> [ByteString] -> [ByteString]
forall a. Semigroup a => a -> a -> a
<> [ByteString]
defKeyPackages)

    HasCallStack => Maybe [Ciphersuite] -> [ByteString] -> App ()
Maybe [Ciphersuite] -> [ByteString] -> App ()
testErrorCases ([Ciphersuite] -> Maybe [Ciphersuite]
forall a. a -> Maybe a
Just [Ciphersuite
suite]) [ByteString]
defKeyPackages
    HasCallStack => Maybe [Ciphersuite] -> [ByteString] -> App ()
Maybe [Ciphersuite] -> [ByteString] -> App ()
testErrorCases ([Ciphersuite] -> Maybe [Ciphersuite]
forall a. a -> Maybe a
Just [Ciphersuite
suite]) ([ByteString]
suiteKeyPackages [ByteString] -> [ByteString] -> [ByteString]
forall a. Semigroup a => a -> a -> a
<> [ByteString]
defKeyPackages)
    HasCallStack => Maybe [Ciphersuite] -> [ByteString] -> App ()
Maybe [Ciphersuite] -> [ByteString] -> App ()
testErrorCases ([Ciphersuite] -> Maybe [Ciphersuite]
forall a. a -> Maybe a
Just [Ciphersuite
suite]) []

    HasCallStack => Maybe [Ciphersuite] -> [ByteString] -> App ()
Maybe [Ciphersuite] -> [ByteString] -> App ()
testErrorCases ([Ciphersuite] -> Maybe [Ciphersuite]
forall a. a -> Maybe a
Just [Ciphersuite
forall a. Default a => a
def]) [ByteString]
suiteKeyPackages
    HasCallStack => Maybe [Ciphersuite] -> [ByteString] -> App ()
Maybe [Ciphersuite] -> [ByteString] -> App ()
testErrorCases ([Ciphersuite] -> Maybe [Ciphersuite]
forall a. a -> Maybe a
Just [Ciphersuite
forall a. Default a => a
def]) ([ByteString]
suiteKeyPackages [ByteString] -> [ByteString] -> [ByteString]
forall a. Semigroup a => a -> a -> a
<> [ByteString]
defKeyPackages)
    HasCallStack => Maybe [Ciphersuite] -> [ByteString] -> App ()
Maybe [Ciphersuite] -> [ByteString] -> App ()
testErrorCases ([Ciphersuite] -> Maybe [Ciphersuite]
forall a. a -> Maybe a
Just [Ciphersuite
forall a. Default a => a
def]) []