-- 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
  alice <- Domain -> CreateUser -> App Value
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> CreateUser -> App Value
randomUser Domain
OwnDomain CreateUser
forall a. Default a => a
def
  alice1 <- createMLSClient def alice
  kps <- replicateM 3 (uploadNewKeyPackage def alice1)

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

  bindResponse (deleteKeyPackages def alice1 kps') $ \Response
resp -> do
    Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
201

  bindResponse (countKeyPackages def alice1) $ \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
  let suite :: Ciphersuite
suite = Ciphersuite
forall a. Default a => a
def
      altSuite :: Ciphersuite
altSuite = String -> Ciphersuite
Ciphersuite String
"0x0007"
  alice <- Domain -> CreateUser -> App Value
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> CreateUser -> App Value
randomUser Domain
OwnDomain CreateUser
forall a. Default a => a
def
  [alice1, alice2] <- replicateM 2 (createMLSClient def {ciphersuites = [suite, altSuite]} alice)

  kp <- uploadNewKeyPackage suite alice2

  void $ uploadNewKeyPackage altSuite alice2

  -- count key packages with the client's default ciphersuite
  bindResponse (countKeyPackages suite alice2) $ \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 the client's default ciphersuite
  bindResponse (claimKeyPackages suite alice1 alice) $ \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
  bindResponse (countKeyPackages altSuite alice2) $ \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
  alice <- Domain -> CreateUser -> App Value
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> CreateUser -> App Value
randomUser Domain
OwnDomain CreateUser
forall a. Default a => a
def
  alice1 <- createWireClient alice def

  (kp, _) <- generateKeyPackage alice1 def

  -- if we upload a keypackage without a key,
  -- we get a bad request
  uploadKeyPackages alice1 [kp] `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
  countKeyPackages def alice1 `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
  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@[alice1, _alice2] <- replicateM 2 do
    createMLSClient def alice

  for_ alices \ClientIdentity
alicei -> Int -> App String -> App [String]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
3 do
    HasCallStack => Ciphersuite -> ClientIdentity -> App String
Ciphersuite -> ClientIdentity -> App String
uploadNewKeyPackage Ciphersuite
forall a. Default a => a
def ClientIdentity
alicei

  bob <- randomUser OwnDomain def
  bobs <- replicateM 3 do
    createMLSClient def bob

  for_ 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
      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
      for_ 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
      for ks (%. "client")
        >>= (`shouldMatchSet` map (.client) alices)

      -- claiming keypckages should return 200
      resp.status `shouldMatchInt` 200

  -- bob has claimed all keypackages by alice, so there should
  -- be none left
  countKeyPackages def alice1 `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
  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@[alice1, alice2] <- replicateM 2 do
    createMLSClient def alice
  for_ alices \ClientIdentity
alicei -> Int -> App String -> App [String]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
3 do
    HasCallStack => Ciphersuite -> ClientIdentity -> App String
Ciphersuite -> ClientIdentity -> App String
uploadNewKeyPackage Ciphersuite
forall a. Default a => a
def ClientIdentity
alicei

  -- claim own keypackages
  claimKeyPackages def alice1 alice `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
  for_ (zip alices [3, 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

  bob <- randomUser OwnDomain def
  bobs <- replicateM 2 do
    createMLSClient def bob

  -- skip own should only apply to own keypackages, hence
  -- bob claiming alices keypackages should work as normal
  a1s <- alice1 %. "client_id" & asString
  for_ 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
  for_ (zip alices [1, 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
  alice <- Domain -> CreateUser -> App Value
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> CreateUser -> App Value
randomUser Domain
OwnDomain CreateUser
forall a. Default a => a
def
  alice1 <- createMLSClient def alice

  charlie <- randomUser OtherDomain def
  charlie1 <- createMLSClient def charlie

  refCharlie <- uploadNewKeyPackage def charlie1
  refAlice <- uploadNewKeyPackage def alice1

  -- the user should be able to claim the keypackage of
  -- a remote user and vice versa
  for_
    [ (alice1, charlie, charlie1, refCharlie),
      (charlie1, alice, alice1, 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
        [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
        kp %. "key_package_ref" `shouldMatch` reference
        resp.status `shouldMatchInt` 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
suite = do
  alice <- Domain -> CreateUser -> App Value
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> CreateUser -> App Value
randomUser Domain
OwnDomain CreateUser
forall a. Default a => a
def
  alice1 <- createMLSClient def {ciphersuites = [suite]} alice

  bindResponse (countKeyPackages suite alice1) $ \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
10
  kps <- map fst <$> replicateM count (generateKeyPackage alice1 suite)
  void $ uploadKeyPackages alice1 kps >>= getBody 201

  bindResponse (countKeyPackages suite alice1) $ \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"
  bob <- Domain -> CreateUser -> App Value
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> CreateUser -> App Value
randomUser Domain
OwnDomain CreateUser
forall a. Default a => a
def
  bob1 <- createMLSClient def {ciphersuites = [suite]} bob
  (kp, _) <- generateKeyPackage bob1 suite
  bindResponse (uploadKeyPackages bob1 [kp]) $ \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
  let suite :: Ciphersuite
suite = Ciphersuite
forall a. Default a => a
def
      altSuite :: Ciphersuite
altSuite = String -> Ciphersuite
Ciphersuite String
"0x0007"
  alice <- Domain -> CreateUser -> App Value
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> CreateUser -> App Value
randomUser Domain
OwnDomain CreateUser
forall a. Default a => a
def
  [alice1, alice2] <- replicateM 2 $ createMLSClient def {ciphersuites = [suite, altSuite]} alice

  let checkCount :: (HasCallStack) => 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
  void
    $ replicateM 4 (fmap fst (generateKeyPackage alice1 suite))
    >>= uploadKeyPackages alice1
    >>= getBody 201
  void
    $ replicateM 5 (fmap fst (generateKeyPackage alice1 altSuite))
    >>= uploadKeyPackages alice1
    >>= getBody 201

  checkCount suite 4
  checkCount altSuite 5

  do
    -- generate a new batch of key packages
    (kps, refs) <- unzip <$> replicateM 3 (generateKeyPackage alice1 altSuite)

    -- replace old key packages with new
    void $ replaceKeyPackages alice1 [altSuite] kps >>= getBody 201

    checkCount suite 4
    checkCount altSuite 3

    -- claim all key packages one by one
    claimed <-
      replicateM 3
        $ bindResponse (claimKeyPackages altSuite alice2 alice)
        $ \Response
resp -> do
          Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200
          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
          k <- assertOne ks
          k %. "key_package_ref"

    refs `shouldMatchSet` claimed

    checkCount suite 4
    checkCount altSuite 0

  do
    -- replenish key packages for the second ciphersuite
    void
      $ replicateM 5 (fmap fst (generateKeyPackage alice1 altSuite))
      >>= uploadKeyPackages alice1
      >>= getBody 201

    checkCount suite 4
    checkCount altSuite 5

    -- replace all key packages with fresh ones
    kps1 <- replicateM 3 (fmap fst (generateKeyPackage alice1 suite))
    kps2 <- replicateM 2 (fmap fst (generateKeyPackage alice1 altSuite))

    void $ replaceKeyPackages alice1 [suite, altSuite] (kps1 <> kps2) >>= getBody 201

    checkCount suite 3
    checkCount altSuite 2

  do
    suiteKeyPackages <- replicateM 3 (fmap fst (generateKeyPackage alice1 suite))
    altSuiteKeyPackages <- replicateM 3 (fmap fst (generateKeyPackage alice1 altSuite))

    void
      $ replaceKeyPackages alice1 [] []
      `bindResponse` \Response
resp -> do
        Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
201

    checkCount suite 3
    checkCount altSuite 2

    let testErrorCases :: (HasCallStack) => [Ciphersuite] -> [ByteString] -> App ()
        testErrorCases [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 -> [Ciphersuite] -> [ByteString] -> App Response
replaceKeyPackages ClientIdentity
alice1 [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"
          HasCallStack => Ciphersuite -> Int -> App ()
Ciphersuite -> Int -> App ()
checkCount Ciphersuite
suite Int
3
          HasCallStack => Ciphersuite -> Int -> App ()
Ciphersuite -> Int -> App ()
checkCount Ciphersuite
altSuite Int
2

    testErrorCases [] suiteKeyPackages
    testErrorCases [] altSuiteKeyPackages

    testErrorCases [altSuite] suiteKeyPackages
    testErrorCases [altSuite] (altSuiteKeyPackages <> suiteKeyPackages)
    testErrorCases [altSuite] []

    testErrorCases [suite] altSuiteKeyPackages
    testErrorCases [suite] (altSuiteKeyPackages <> suiteKeyPackages)
    testErrorCases [suite] []

testReplaceKeyPackagesV7 :: (HasCallStack) => App ()
testReplaceKeyPackagesV7 :: HasCallStack => App ()
testReplaceKeyPackagesV7 = do
  let suite :: Ciphersuite
suite = Ciphersuite
forall a. Default a => a
def
      altSuite :: Ciphersuite
altSuite = String -> Ciphersuite
Ciphersuite String
"0x0007"
      oldSuite :: Ciphersuite
oldSuite = String -> Ciphersuite
Ciphersuite String
"0x0001"
  alice <- Domain -> CreateUser -> App Value
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> CreateUser -> App Value
randomUser Domain
OwnDomain CreateUser
forall a. Default a => a
def
  [alice1, alice2] <- replicateM 2 $ createMLSClient def {ciphersuites = [suite, altSuite, oldSuite]} alice

  let checkCount :: (HasCallStack) => 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
  void
    $ replicateM 4 (fmap fst (generateKeyPackage alice1 suite))
    >>= uploadKeyPackages alice1
    >>= getBody 201
  void
    $ replicateM 5 (fmap fst (generateKeyPackage alice1 altSuite))
    >>= uploadKeyPackages alice1
    >>= getBody 201
  void
    $ replicateM 6 (fmap fst (generateKeyPackage alice1 oldSuite))
    >>= uploadKeyPackages alice1
    >>= getBody 201

  checkCount suite 4
  checkCount altSuite 5
  checkCount oldSuite 6

  do
    -- generate a new batch of key packages
    (kps, refs) <- unzip <$> replicateM 3 (generateKeyPackage alice1 altSuite)

    -- replace old key packages with new
    void $ replaceKeyPackagesV7 alice1 (Just [altSuite]) kps >>= getBody 201

    checkCount suite 4
    checkCount altSuite 3

    -- claim all key packages one by one
    claimed <-
      replicateM 3
        $ bindResponse (claimKeyPackages altSuite alice2 alice)
        $ \Response
resp -> do
          Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200
          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
          k <- assertOne ks
          k %. "key_package_ref"

    refs `shouldMatchSet` claimed

    checkCount suite 4
    checkCount altSuite 0

  do
    -- replenish key packages for the second ciphersuite
    void
      $ replicateM 5 (fmap fst (generateKeyPackage alice1 altSuite))
      >>= uploadKeyPackages alice1
      >>= getBody 201

    checkCount suite 4
    checkCount altSuite 5

    -- replace all key packages with fresh ones
    kps1 <- replicateM 3 (fmap fst (generateKeyPackage alice1 suite))
    kps2 <- replicateM 2 (fmap fst (generateKeyPackage alice1 altSuite))

    void $ replaceKeyPackagesV7 alice1 (Just [suite, altSuite]) (kps1 <> kps2) >>= getBody 201

    checkCount suite 3
    checkCount altSuite 2

  do
    suiteKeyPackages <- replicateM 3 (fmap fst (generateKeyPackage alice1 suite))
    altSuiteKeyPackages <- replicateM 3 (fmap fst (generateKeyPackage alice1 altSuite))
    oldSuiteKeyPackages <- replicateM 4 (fmap fst (generateKeyPackage alice1 oldSuite))

    void
      $ replaceKeyPackagesV7 alice1 (Just []) []
      `bindResponse` \Response
resp -> do
        Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
201

    void
      $ replaceKeyPackagesV7 alice1 Nothing oldSuiteKeyPackages
      `bindResponse` \Response
resp -> do
        Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
201

    checkCount suite 3
    checkCount altSuite 2
    checkCount oldSuite 4

    let 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
replaceKeyPackagesV7 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"
          HasCallStack => Ciphersuite -> Int -> App ()
Ciphersuite -> Int -> App ()
checkCount Ciphersuite
suite Int
3
          HasCallStack => Ciphersuite -> Int -> App ()
Ciphersuite -> Int -> App ()
checkCount Ciphersuite
altSuite Int
2
          HasCallStack => Ciphersuite -> Int -> App ()
Ciphersuite -> Int -> App ()
checkCount Ciphersuite
oldSuite Int
4

    testErrorCases (Just []) suiteKeyPackages
    testErrorCases (Just []) altSuiteKeyPackages
    testErrorCases Nothing []
    testErrorCases Nothing altSuiteKeyPackages
    testErrorCases Nothing (oldSuiteKeyPackages <> altSuiteKeyPackages <> suiteKeyPackages)

    testErrorCases (Just [altSuite]) suiteKeyPackages
    testErrorCases (Just [altSuite]) (oldSuiteKeyPackages <> altSuiteKeyPackages <> suiteKeyPackages)
    testErrorCases (Just [altSuite]) []

    testErrorCases (Just [suite]) altSuiteKeyPackages
    testErrorCases (Just [suite]) (oldSuiteKeyPackages <> altSuiteKeyPackages <> suiteKeyPackages)
    testErrorCases (Just [suite]) []