-- This file is part of the Wire Server implementation.
--
-- Copyright (C) 2023 Wire Swiss GmbH <opensource@wire.com>
--
-- This program is free software: you can redistribute it and/or modify it under
-- the terms of the GNU Affero General Public License as published by the Free
-- Software Foundation, either version 3 of the License, or (at your option) any
-- later version.
--
-- This program is distributed in the hope that it will be useful, but WITHOUT
-- ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
-- FOR A PARTICULAR PURPOSE. See the GNU Affero General Public License for more
-- details.
--
-- You should have received a copy of the GNU Affero General Public License along
-- with this program. If not, see <https://www.gnu.org/licenses/>.
module Test.LegalHold where

import API.Brig
import API.BrigCommon as BrigC
import qualified API.BrigInternal as BrigI
import API.Common
import API.Galley
import API.GalleyInternal
import Control.Error (MaybeT (MaybeT), runMaybeT)
import Control.Lens ((.~), (^?), (^?!))
import Control.Monad.Reader (asks, local)
import Control.Monad.Trans.Class (lift)
import Data.Aeson.Lens
import qualified Data.ByteString.Char8 as BS8
import Data.ByteString.Lazy (LazyByteString)
import Data.List.Extra (trim)
import qualified Data.Map as Map
import qualified Data.ProtoLens as Proto
import Data.ProtoLens.Labels ()
import qualified Data.Set as Set
import qualified Data.Text as T
import GHC.Stack
import MLS.Util
import Network.Wai (Request (pathInfo, requestMethod))
import Notifications
import Numeric.Lens (hex)
import qualified Proto.Otr as Proto
import qualified Proto.Otr_Fields as Proto
import SetupHelpers
import Testlib.MockIntegrationService
import Testlib.Prekeys
import Testlib.Prelude
import UnliftIO (Chan, readChan, timeout)

testLHPreventAddingNonConsentingUsers :: (HasCallStack) => LhApiVersion -> App ()
testLHPreventAddingNonConsentingUsers :: HasCallStack => LhApiVersion -> App ()
testLHPreventAddingNonConsentingUsers LhApiVersion
v = do
  MockServerSettings
-> (Chan (Request, ByteString) -> LiftedApplication)
-> ((String, Int) -> Chan (Request, ByteString) -> App ())
-> App ()
forall e a.
HasCallStack =>
MockServerSettings
-> (Chan e -> LiftedApplication)
-> ((String, Int) -> Chan e -> App a)
-> App a
withMockServer MockServerSettings
forall a. Default a => a
def (LhApiVersion -> Chan (Request, ByteString) -> LiftedApplication
lhMockAppV LhApiVersion
v) (((String, Int) -> Chan (Request, ByteString) -> App ()) -> App ())
-> ((String, Int) -> Chan (Request, ByteString) -> App ())
-> App ()
forall a b. (a -> b) -> a -> b
$ \(String, Int)
lhDomAndPort Chan (Request, ByteString)
_chan -> do
    (Value
owner, String
tid, [Value
alice, Value
alex]) <- Domain -> Int -> App (Value, String, [Value])
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> Int -> App (Value, String, [Value])
createTeam Domain
OwnDomain Int
3

    String -> Value -> App Response
forall uid tid.
(HasCallStack, MakesValue uid, MakesValue tid) =>
tid -> uid -> App Response
legalholdWhitelistTeam String
tid Value
owner App Response -> (Response -> 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
>>= HasCallStack => Response -> App ()
Response -> App ()
assertSuccess
    String -> Value -> App Response
forall uid tid.
(HasCallStack, MakesValue uid, MakesValue tid) =>
tid -> uid -> App Response
legalholdIsTeamInWhitelist String
tid Value
owner App Response -> (Response -> 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
>>= HasCallStack => Response -> App ()
Response -> App ()
assertSuccess
    String -> Value -> Value -> App Response
forall ownerid tid newService.
(HasCallStack, MakesValue ownerid, MakesValue tid,
 MakesValue newService) =>
tid -> ownerid -> newService -> App Response
postLegalHoldSettings String
tid Value
owner ((String, Int) -> Value
mkLegalHoldSettings (String, Int)
lhDomAndPort) App Response -> (Response -> 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
>>= HasCallStack => Int -> Response -> App ()
Int -> Response -> App ()
assertStatus Int
201

    Value
george <- Domain -> CreateUser -> App Value
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> CreateUser -> App Value
randomUser Domain
OwnDomain CreateUser
forall a. Default a => a
def
    Value
georgeQId <- Value -> App Value
forall a. (HasCallStack, MakesValue a) => a -> App Value
objQidObject Value
george
    Value
hannes <- Domain -> CreateUser -> App Value
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> CreateUser -> App Value
randomUser Domain
OwnDomain CreateUser
forall a. Default a => a
def
    Value
hannesQId <- Value -> App Value
forall a. (HasCallStack, MakesValue a) => a -> App Value
objQidObject Value
hannes

    [Value] -> App ()
forall usr. (HasCallStack, MakesValue usr) => [usr] -> App ()
connectUsers [Value
alice, Value
george, Value
hannes]
    [Value] -> App ()
forall usr. (HasCallStack, MakesValue usr) => [usr] -> App ()
connectUsers [Value
alex, Value
george, Value
hannes]
    Value
conv <- Value -> CreateConv -> App Response
forall user.
(HasCallStack, MakesValue user) =>
user -> CreateConv -> App Response
postConversation Value
alice (CreateConv
defProteus {qualifiedUsers = [alex], team = Just tid}) App Response -> (Response -> App Value) -> App Value
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 Value
Int -> Response -> App Value
getJSON Int
201

    -- the guest should be added to the conversation
    App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse (Value -> Value -> AddMembers -> App Response
forall user conv.
(HasCallStack, MakesValue user, MakesValue conv) =>
user -> conv -> AddMembers -> App Response
addMembers Value
alice Value
conv AddMembers
forall a. Default a => a
def {users = [georgeQId]}) ((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
"type" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
"conversation.member-join"

    -- assert that the guest is in the conversation
    HasCallStack => Value -> Value -> [Value] -> App ()
Value -> Value -> [Value] -> App ()
checkConvHasOtherMembers Value
conv Value
alice [Value
alex, Value
george]

    -- now request legalhold for alex (but not alice)
    String -> Value -> Value -> App Response
forall tid ownerid uid.
(HasCallStack, MakesValue tid, MakesValue ownerid,
 MakesValue uid) =>
tid -> ownerid -> uid -> App Response
requestLegalHoldDevice String
tid Value
owner Value
alex App Response -> (Response -> 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
>>= HasCallStack => Response -> App ()
Response -> App ()
assertSuccess

    -- the guest should not be removed from the conversation before approving
    HasCallStack => Value -> Value -> [Value] -> App ()
Value -> Value -> [Value] -> App ()
checkConvHasOtherMembers Value
conv Value
alice [Value
alex, Value
george]

    -- it should be possible to add the another guest while the LH device is not approved
    Value -> Value -> AddMembers -> App Response
forall user conv.
(HasCallStack, MakesValue user, MakesValue conv) =>
user -> conv -> AddMembers -> App Response
addMembers Value
alex Value
conv AddMembers
forall a. Default a => a
def {users = [hannesQId]} 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
"type" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
"conversation.member-join"
    HasCallStack => Value -> Value -> [Value] -> App ()
Value -> Value -> [Value] -> App ()
checkConvHasOtherMembers Value
conv Value
alice [Value
alex, Value
george, Value
hannes]

    String -> Value -> String -> App Response
forall tid uid.
(HasCallStack, MakesValue tid, MakesValue uid) =>
tid -> uid -> String -> App Response
approveLegalHoldDevice String
tid Value
alex String
defPassword App Response -> (Response -> 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
>>= HasCallStack => Response -> App ()
Response -> App ()
assertSuccess
    -- the guest should be removed from the conversation
    HasCallStack => Value -> Value -> [Value] -> App ()
Value -> Value -> [Value] -> App ()
checkConvHasOtherMembers Value
conv Value
alice [Value
alex]

    -- it should not be possible neither for alex nor for alice to add the guest back
    Value -> Value -> AddMembers -> App Response
forall user conv.
(HasCallStack, MakesValue user, MakesValue conv) =>
user -> conv -> AddMembers -> App Response
addMembers Value
alex Value
conv AddMembers
forall a. Default a => a
def {users = [georgeQId]}
      App Response -> (Response -> 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
>>= HasCallStack => Int -> String -> Response -> App ()
Int -> String -> Response -> App ()
assertLabel Int
403 String
"not-connected"

    Value -> Value -> AddMembers -> App Response
forall user conv.
(HasCallStack, MakesValue user, MakesValue conv) =>
user -> conv -> AddMembers -> App Response
addMembers Value
alice Value
conv AddMembers
forall a. Default a => a
def {users = [georgeQId]}
      App Response -> (Response -> 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
>>= HasCallStack => Int -> String -> Response -> App ()
Int -> String -> Response -> App ()
assertLabel Int
403 String
"missing-legalhold-consent"
  where
    checkConvHasOtherMembers :: (HasCallStack) => Value -> Value -> [Value] -> App ()
    checkConvHasOtherMembers :: HasCallStack => Value -> Value -> [Value] -> App ()
checkConvHasOtherMembers Value
conv Value
u [Value]
us =
      App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse (Value -> Value -> App Response
forall user qcnv.
(HasCallStack, MakesValue user, MakesValue qcnv) =>
user -> qcnv -> App Response
getConversation Value
u Value
conv) ((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]
mems <-
          Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"members.others"
            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] -> App [Value]) -> App [Value]
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Value -> App Value) -> [Value] -> App [Value]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse \Value
m -> do
              Value
m Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"qualified_id"
        [Value]
mems [Value] -> App [Value] -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatchSet` [Value] -> (Value -> App Value) -> App [Value]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [Value]
us (\Value
m -> Value
m Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"qualified_id")

testLHGetAndUpdateSettings :: (HasCallStack) => ImplicitConsent -> LhApiVersion -> App ()
testLHGetAndUpdateSettings :: HasCallStack => ImplicitConsent -> LhApiVersion -> App ()
testLHGetAndUpdateSettings ImplicitConsent
implicitConsent LhApiVersion
v = ImplicitConsent -> (String -> App ()) -> App ()
ensureLHFeatureConfigForServer ImplicitConsent
implicitConsent ((String -> App ()) -> App ()) -> (String -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \String
dom -> do
  MockServerSettings
-> (Chan (Request, ByteString) -> LiftedApplication)
-> ((String, Int) -> Chan (Request, ByteString) -> App ())
-> App ()
forall e a.
HasCallStack =>
MockServerSettings
-> (Chan e -> LiftedApplication)
-> ((String, Int) -> Chan e -> App a)
-> App a
withMockServer MockServerSettings
forall a. Default a => a
def (LhApiVersion -> Chan (Request, ByteString) -> LiftedApplication
lhMockAppV LhApiVersion
v) (((String, Int) -> Chan (Request, ByteString) -> App ()) -> App ())
-> ((String, Int) -> Chan (Request, ByteString) -> App ())
-> App ()
forall a b. (a -> b) -> a -> b
$ \(String, Int)
lhDomAndPort Chan (Request, ByteString)
_chan -> do
    (Value
owner, String
tid, [Value
alice]) <- String -> Int -> App (Value, String, [Value])
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> Int -> App (Value, String, [Value])
createTeam String
dom Int
2
    Value
stranger <- String -> CreateUser -> App Value
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> CreateUser -> App Value
randomUser String
dom CreateUser
forall a. Default a => a
def

    let getSettingsWorks :: (HasCallStack) => Value -> String -> App ()
        getSettingsWorks :: HasCallStack => Value -> String -> App ()
getSettingsWorks Value
target String
status = App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse (String -> Value -> App Response
forall user qcnv.
(HasCallStack, MakesValue user, MakesValue qcnv) =>
user -> qcnv -> App Response
getLegalHoldSettings String
tid Value
target) ((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
"status" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
status

        getSettingsFails :: (HasCallStack) => Value -> App ()
        getSettingsFails :: HasCallStack => Value -> App ()
getSettingsFails Value
target = App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse (String -> Value -> App Response
forall user qcnv.
(HasCallStack, MakesValue user, MakesValue qcnv) =>
user -> qcnv -> App Response
getLegalHoldSettings String
tid Value
target) ((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
403
          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
"no-team-member"

    HasCallStack => Value -> App ()
Value -> App ()
getSettingsFails Value
stranger
    HasCallStack => Value -> String -> App ()
Value -> String -> App ()
getSettingsWorks Value
owner String
"disabled"
    HasCallStack => Value -> String -> App ()
Value -> String -> App ()
getSettingsWorks Value
alice String
"disabled"

    case ImplicitConsent
implicitConsent of
      ImplicitConsent
ImplicitConsent -> do
        String -> Value -> App Response
forall uid tid.
(HasCallStack, MakesValue uid, MakesValue tid) =>
tid -> uid -> App Response
legalholdWhitelistTeam String
tid Value
owner App Response -> (Response -> 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
>>= HasCallStack => Response -> App ()
Response -> App ()
assertSuccess
        String -> Value -> App Response
forall uid tid.
(HasCallStack, MakesValue uid, MakesValue tid) =>
tid -> uid -> App Response
legalholdIsTeamInWhitelist String
tid Value
owner App Response -> (Response -> 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
>>= HasCallStack => Response -> App ()
Response -> App ()
assertSuccess
      ImplicitConsent
ExplicitConsent -> do
        let payload :: Value
payload = [Pair] -> Value
object [String
"status" String -> String -> Pair
forall a. ToJSON a => String -> a -> Pair
.= String
"enabled"] -- legalhold has implicit lock status "unlocked"
        String -> String -> String -> Value -> App Response
forall domain team featureName payload.
(HasCallStack, MakesValue domain, MakesValue team,
 MakesValue featureName, MakesValue payload) =>
domain -> team -> featureName -> payload -> App Response
API.GalleyInternal.setTeamFeatureConfig String
dom String
tid String
"legalhold" Value
payload App Response -> (Response -> 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
>>= HasCallStack => Response -> App ()
Response -> App ()
assertSuccess

    HasCallStack => Value -> App ()
Value -> App ()
getSettingsFails Value
stranger
    HasCallStack => Value -> String -> App ()
Value -> String -> App ()
getSettingsWorks Value
owner String
"not_configured"
    HasCallStack => Value -> String -> App ()
Value -> String -> App ()
getSettingsWorks Value
alice String
"not_configured"

    let lhSettings :: Value
lhSettings = (String, Int) -> Value
mkLegalHoldSettings (String, Int)
lhDomAndPort
    App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse (String -> Value -> Value -> App Response
forall ownerid tid newService.
(HasCallStack, MakesValue ownerid, MakesValue tid,
 MakesValue newService) =>
tid -> ownerid -> newService -> App Response
postLegalHoldSettings String
tid Value
owner Value
lhSettings) ((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 (String -> Value -> App Response
forall user qcnv.
(HasCallStack, MakesValue user, MakesValue qcnv) =>
user -> qcnv -> App Response
getLegalHoldSettings String
tid 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
        App Value -> String -> App ()
forall a. (HasCallStack, MakesValue a) => a -> String -> App ()
assertFieldMissing Response
resp.json String
"label"
        (Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"settings" App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"auth_token") App Value -> App Value -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` (Value
lhSettings Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"auth_token")
        (Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"settings" App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"base_url") App Value -> App Value -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` (Value
lhSettings Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"base_url")
        (Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"settings" App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"public_key" App Value -> (Value -> App String) -> App String
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Value -> App String
forall a. (HasCallStack, MakesValue a) => a -> App String
asString App String -> (String -> String) -> App String
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> String -> String
trim)
          App String -> App Value -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` (Value
lhSettings Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"public_key")
        (Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"settings" App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"team_id") App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
tid
        (Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"settings" App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"fingerprint" App Value -> (Value -> App String) -> App String
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Value -> App String
forall a. (HasCallStack, MakesValue a) => a -> App String
asString App String -> (String -> Int) -> App Int
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length)
          App Int -> Int -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldNotMatch` (Int
0 :: Int)

testLHMessageExchange ::
  (HasCallStack) =>
  TaggedBool "clients1New" ->
  TaggedBool "clients2New" ->
  App ()
testLHMessageExchange :: HasCallStack =>
TaggedBool "clients1New" -> TaggedBool "clients2New" -> App ()
testLHMessageExchange (TaggedBool Bool
clients1New) (TaggedBool Bool
clients2New) = do
  -- We used to throw LegalholdConflictsOldClients if clients didn't have LH capability, but we
  -- don't do that any more because that broke things.
  -- Related: https://github.com/wireapp/wire-server/pull/4056
  MockServerSettings
-> (Chan (Request, ByteString) -> LiftedApplication)
-> ((String, Int) -> Chan (Request, ByteString) -> App ())
-> App ()
forall e a.
HasCallStack =>
MockServerSettings
-> (Chan e -> LiftedApplication)
-> ((String, Int) -> Chan e -> App a)
-> App a
withMockServer MockServerSettings
forall a. Default a => a
def Chan (Request, ByteString) -> LiftedApplication
lhMockApp (((String, Int) -> Chan (Request, ByteString) -> App ()) -> App ())
-> ((String, Int) -> Chan (Request, ByteString) -> App ())
-> App ()
forall a b. (a -> b) -> a -> b
$ \(String, Int)
lhDomAndPort Chan (Request, ByteString)
_chan -> do
    (Value
owner, String
tid, [Value
mem1, Value
mem2]) <- Domain -> Int -> App (Value, String, [Value])
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> Int -> App (Value, String, [Value])
createTeam Domain
OwnDomain Int
3

    let clientSettings :: Bool -> AddClient
        clientSettings :: Bool -> AddClient
clientSettings Bool
allnew =
          if Bool
allnew
            then AddClient
forall a. Default a => a
def {acapabilities = Just ["legalhold-implicit-consent"]} -- (is should be the default)
            else AddClient
forall a. Default a => a
def {acapabilities = Nothing}
    App Value -> App ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (App Value -> App ()) -> App Value -> App ()
forall a b. (a -> b) -> a -> b
$ App Value -> AddClient -> App Response
forall user.
(HasCallStack, MakesValue user) =>
user -> AddClient -> App Response
addClient (Value
mem1 Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"qualified_id") (Bool -> AddClient
clientSettings Bool
clients1New) App Response -> (Response -> App Value) -> App Value
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 Value
Int -> Response -> App Value
getJSON Int
201
    App Value -> App ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (App Value -> App ()) -> App Value -> App ()
forall a b. (a -> b) -> a -> b
$ App Value -> AddClient -> App Response
forall user.
(HasCallStack, MakesValue user) =>
user -> AddClient -> App Response
addClient (Value
mem2 Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"qualified_id") (Bool -> AddClient
clientSettings Bool
clients2New) App Response -> (Response -> App Value) -> App Value
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 Value
Int -> Response -> App Value
getJSON Int
201

    String -> Value -> App Response
forall uid tid.
(HasCallStack, MakesValue uid, MakesValue tid) =>
tid -> uid -> App Response
legalholdWhitelistTeam String
tid Value
owner App Response -> (Response -> 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
>>= HasCallStack => Response -> App ()
Response -> App ()
assertSuccess
    String -> Value -> App Response
forall uid tid.
(HasCallStack, MakesValue uid, MakesValue tid) =>
tid -> uid -> App Response
legalholdIsTeamInWhitelist String
tid Value
owner App Response -> (Response -> 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
>>= HasCallStack => Response -> App ()
Response -> App ()
assertSuccess
    String -> Value -> Value -> App Response
forall ownerid tid newService.
(HasCallStack, MakesValue ownerid, MakesValue tid,
 MakesValue newService) =>
tid -> ownerid -> newService -> App Response
postLegalHoldSettings String
tid Value
owner ((String, Int) -> Value
mkLegalHoldSettings (String, Int)
lhDomAndPort) App Response -> (Response -> 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
>>= HasCallStack => Int -> Response -> App ()
Int -> Response -> App ()
assertStatus Int
201

    Value
conv <- Value -> CreateConv -> App Response
forall user.
(HasCallStack, MakesValue user) =>
user -> CreateConv -> App Response
postConversation Value
mem1 (CreateConv
defProteus {qualifiedUsers = [mem2], team = Just tid}) App Response -> (Response -> App Value) -> App Value
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 Value
Int -> Response -> App Value
getJSON Int
201

    let getClients :: Value -> App [Value]
        getClients :: Value -> App [Value]
getClients Value
mem = do
          Response
res <- Value -> Domain -> Value -> App Response
forall tid ownerid uid.
(HasCallStack, MakesValue tid, MakesValue ownerid,
 MakesValue uid) =>
tid -> ownerid -> uid -> App Response
getClientsQualified Value
mem Domain
OwnDomain Value
mem
          Value
val <- HasCallStack => Int -> Response -> App Value
Int -> Response -> App Value
getJSON Int
200 Response
res
          Value -> App [Value]
forall a. (HasCallStack, MakesValue a) => a -> App [Value]
asList Value
val

        assertMessageSendingWorks :: (HasCallStack) => App ()
        assertMessageSendingWorks :: HasCallStack => App ()
assertMessageSendingWorks = do
          [Value]
clients1 <- Value -> App [Value]
getClients Value
mem1
          [Value]
clients2 <- Value -> App [Value]
getClients Value
mem2

          [String]
clientIds1 <- (Value -> App String) -> [Value] -> App [String]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse Value -> App String
forall a. (HasCallStack, MakesValue a) => a -> App String
objId [Value]
clients1
          [String]
clientIds2 <- (Value -> App String) -> [Value] -> App [String]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse Value -> App String
forall a. (HasCallStack, MakesValue a) => a -> App String
objId [Value]
clients2

          QualifiedUserEntry
proteusRecipients <- Value -> [(Value, [String])] -> String -> App QualifiedUserEntry
forall domain user client.
(HasCallStack, MakesValue domain, MakesValue user,
 MakesValue client) =>
domain -> [(user, [client])] -> String -> App QualifiedUserEntry
mkProteusRecipients Value
mem1 [(Value
mem1, [String]
clientIds1), (Value
mem2, [String]
clientIds2)] String
"hey there"

          let proteusMsg :: String -> QualifiedNewOtrMessage
proteusMsg String
senderClient =
                forall msg. Message msg => msg
Proto.defMessage @Proto.QualifiedNewOtrMessage
                  QualifiedNewOtrMessage
-> (QualifiedNewOtrMessage -> QualifiedNewOtrMessage)
-> QualifiedNewOtrMessage
forall a b. a -> (a -> b) -> b
& (ClientId -> Identity ClientId)
-> QualifiedNewOtrMessage -> Identity QualifiedNewOtrMessage
#sender ((ClientId -> Identity ClientId)
 -> QualifiedNewOtrMessage -> Identity QualifiedNewOtrMessage)
-> ((Word64 -> Identity Word64) -> ClientId -> Identity ClientId)
-> (Word64 -> Identity Word64)
-> QualifiedNewOtrMessage
-> Identity QualifiedNewOtrMessage
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word64 -> Identity Word64) -> ClientId -> Identity ClientId
forall (f :: * -> *) s a.
(Functor f, HasField s "client" a) =>
LensLike' f s a
Proto.client ((Word64 -> Identity Word64)
 -> QualifiedNewOtrMessage -> Identity QualifiedNewOtrMessage)
-> Word64 -> QualifiedNewOtrMessage -> QualifiedNewOtrMessage
forall s t a b. ASetter s t a b -> b -> s -> t
.~ (String
senderClient 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)
                  QualifiedNewOtrMessage
-> (QualifiedNewOtrMessage -> QualifiedNewOtrMessage)
-> QualifiedNewOtrMessage
forall a b. a -> (a -> b) -> b
& ASetter
  QualifiedNewOtrMessage
  QualifiedNewOtrMessage
  [QualifiedUserEntry]
  [QualifiedUserEntry]
#recipients ASetter
  QualifiedNewOtrMessage
  QualifiedNewOtrMessage
  [QualifiedUserEntry]
  [QualifiedUserEntry]
-> [QualifiedUserEntry]
-> QualifiedNewOtrMessage
-> QualifiedNewOtrMessage
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [QualifiedUserEntry
proteusRecipients]
                  QualifiedNewOtrMessage
-> (QualifiedNewOtrMessage -> QualifiedNewOtrMessage)
-> QualifiedNewOtrMessage
forall a b. a -> (a -> b) -> b
& ASetter
  QualifiedNewOtrMessage
  QualifiedNewOtrMessage
  ClientMismatchStrategy'ReportAll
  ClientMismatchStrategy'ReportAll
#reportAll ASetter
  QualifiedNewOtrMessage
  QualifiedNewOtrMessage
  ClientMismatchStrategy'ReportAll
  ClientMismatchStrategy'ReportAll
-> ClientMismatchStrategy'ReportAll
-> QualifiedNewOtrMessage
-> QualifiedNewOtrMessage
forall s t a b. ASetter s t a b -> b -> s -> t
.~ ClientMismatchStrategy'ReportAll
forall msg. Message msg => msg
Proto.defMessage

              sender :: [s] -> String
sender [s]
clients =
                let senderClient :: s
senderClient = [s] -> s
forall a. HasCallStack => [a] -> a
head ([s] -> s) -> [s] -> s
forall a b. (a -> b) -> a -> b
$ (s -> Bool) -> [s] -> [s]
forall a. (a -> Bool) -> [a] -> [a]
filter (\s
c -> s
c s -> Getting (First Value) s Value -> Maybe Value
forall s a. s -> Getting (First a) s a -> Maybe a
^? Key -> Traversal' s Value
forall t. AsValue t => Key -> Traversal' t Value
key (String -> Key
forall a. IsString a => String -> a
fromString String
"type") Maybe Value -> Maybe Value -> Bool
forall a. Eq a => a -> a -> Bool
/= Value -> Maybe Value
forall a. a -> Maybe a
Just (String -> Value
forall a. ToJSON a => a -> Value
toJSON String
"legalhold")) [s]
clients
                 in Text -> String
T.unpack (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$ s
senderClient s -> Getting (Endo Text) s Text -> Text
forall s a. HasCallStack => s -> Getting (Endo a) s a -> a
^?! Key -> Traversal' s Value
forall t. AsValue t => Key -> Traversal' t Value
key (String -> Key
forall a. IsString a => String -> a
fromString String
"id") ((Value -> Const (Endo Text) Value) -> s -> Const (Endo Text) s)
-> ((Text -> Const (Endo Text) Text)
    -> Value -> Const (Endo Text) Value)
-> Getting (Endo Text) s Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Const (Endo Text) Text)
-> Value -> Const (Endo Text) Value
forall t. AsValue t => Prism' t Text
Prism' Value Text
_String
          Value -> App Value -> QualifiedNewOtrMessage -> App Response
forall user conv.
(HasCallStack, MakesValue user, MakesValue conv) =>
user -> conv -> QualifiedNewOtrMessage -> App Response
postProteusMessage Value
mem1 (Value
conv Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"qualified_id") (String -> QualifiedNewOtrMessage
proteusMsg ([Value] -> String
forall {s}. AsValue s => [s] -> String
sender [Value]
clients1)) App Response -> (Response -> 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
>>= HasCallStack => Response -> App ()
Response -> App ()
assertSuccess
          Value -> App Value -> QualifiedNewOtrMessage -> App Response
forall user conv.
(HasCallStack, MakesValue user, MakesValue conv) =>
user -> conv -> QualifiedNewOtrMessage -> App Response
postProteusMessage Value
mem2 (Value
conv Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"qualified_id") (String -> QualifiedNewOtrMessage
proteusMsg ([Value] -> String
forall {s}. AsValue s => [s] -> String
sender [Value]
clients2)) App Response -> (Response -> 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
>>= HasCallStack => Response -> App ()
Response -> App ()
assertSuccess

    App ()
HasCallStack => App ()
assertMessageSendingWorks

    String -> Value -> Value -> App Response
forall tid ownerid uid.
(HasCallStack, MakesValue tid, MakesValue ownerid,
 MakesValue uid) =>
tid -> ownerid -> uid -> App Response
requestLegalHoldDevice String
tid Value
owner Value
mem1 App Response -> (Response -> 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
>>= HasCallStack => Response -> App ()
Response -> App ()
assertSuccess
    App ()
HasCallStack => App ()
assertMessageSendingWorks

    String -> Value -> Value -> App Response
forall tid ownerid uid.
(HasCallStack, MakesValue tid, MakesValue ownerid,
 MakesValue uid) =>
tid -> ownerid -> uid -> App Response
requestLegalHoldDevice String
tid Value
owner Value
mem2 App Response -> (Response -> 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
>>= HasCallStack => Response -> App ()
Response -> App ()
assertSuccess
    App ()
HasCallStack => App ()
assertMessageSendingWorks

    String -> App Value -> String -> App Response
forall tid uid.
(HasCallStack, MakesValue tid, MakesValue uid) =>
tid -> uid -> String -> App Response
approveLegalHoldDevice String
tid (Value
mem1 Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"qualified_id") String
defPassword App Response -> (Response -> 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
>>= HasCallStack => Response -> App ()
Response -> App ()
assertSuccess
    ([Value] -> Int) -> App [Value] -> App Int
forall a b. (a -> b) -> App a -> App b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Value] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (Value -> App [Value]
getClients Value
mem1) App Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
2
    App ()
HasCallStack => App ()
assertMessageSendingWorks

    String -> App Value -> String -> App Response
forall tid uid.
(HasCallStack, MakesValue tid, MakesValue uid) =>
tid -> uid -> String -> App Response
approveLegalHoldDevice String
tid (Value
mem2 Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"qualified_id") String
defPassword App Response -> (Response -> 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
>>= HasCallStack => Response -> App ()
Response -> App ()
assertSuccess
    ([Value] -> Int) -> App [Value] -> App Int
forall a b. (a -> b) -> App a -> App b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Value] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (Value -> App [Value]
getClients Value
mem2) App Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
2
    App ()
HasCallStack => App ()
assertMessageSendingWorks

data TestClaimKeys
  = TCKConsentMissing -- (team not whitelisted, that is)
  | TCKConsentAndNewClients
  deriving (Int -> TestClaimKeys -> String -> String
[TestClaimKeys] -> String -> String
TestClaimKeys -> String
(Int -> TestClaimKeys -> String -> String)
-> (TestClaimKeys -> String)
-> ([TestClaimKeys] -> String -> String)
-> Show TestClaimKeys
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: Int -> TestClaimKeys -> String -> String
showsPrec :: Int -> TestClaimKeys -> String -> String
$cshow :: TestClaimKeys -> String
show :: TestClaimKeys -> String
$cshowList :: [TestClaimKeys] -> String -> String
showList :: [TestClaimKeys] -> String -> String
Show, (forall x. TestClaimKeys -> Rep TestClaimKeys x)
-> (forall x. Rep TestClaimKeys x -> TestClaimKeys)
-> Generic TestClaimKeys
forall x. Rep TestClaimKeys x -> TestClaimKeys
forall x. TestClaimKeys -> Rep TestClaimKeys x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. TestClaimKeys -> Rep TestClaimKeys x
from :: forall x. TestClaimKeys -> Rep TestClaimKeys x
$cto :: forall x. Rep TestClaimKeys x -> TestClaimKeys
to :: forall x. Rep TestClaimKeys x -> TestClaimKeys
Generic)

data LHApprovedOrPending
  = LHApproved
  | LHPending
  deriving (Int -> LHApprovedOrPending -> String -> String
[LHApprovedOrPending] -> String -> String
LHApprovedOrPending -> String
(Int -> LHApprovedOrPending -> String -> String)
-> (LHApprovedOrPending -> String)
-> ([LHApprovedOrPending] -> String -> String)
-> Show LHApprovedOrPending
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: Int -> LHApprovedOrPending -> String -> String
showsPrec :: Int -> LHApprovedOrPending -> String -> String
$cshow :: LHApprovedOrPending -> String
show :: LHApprovedOrPending -> String
$cshowList :: [LHApprovedOrPending] -> String -> String
showList :: [LHApprovedOrPending] -> String -> String
Show, (forall x. LHApprovedOrPending -> Rep LHApprovedOrPending x)
-> (forall x. Rep LHApprovedOrPending x -> LHApprovedOrPending)
-> Generic LHApprovedOrPending
forall x. Rep LHApprovedOrPending x -> LHApprovedOrPending
forall x. LHApprovedOrPending -> Rep LHApprovedOrPending x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. LHApprovedOrPending -> Rep LHApprovedOrPending x
from :: forall x. LHApprovedOrPending -> Rep LHApprovedOrPending x
$cto :: forall x. Rep LHApprovedOrPending x -> LHApprovedOrPending
to :: forall x. Rep LHApprovedOrPending x -> LHApprovedOrPending
Generic)

-- | Cannot fetch prekeys of LH users if requester has not given consent or has old clients.
testLHClaimKeys :: LHApprovedOrPending -> TestClaimKeys -> App ()
testLHClaimKeys :: LHApprovedOrPending -> TestClaimKeys -> App ()
testLHClaimKeys LHApprovedOrPending
approvedOrPending TestClaimKeys
testmode = do
  MockServerSettings
-> (Chan (Request, ByteString) -> LiftedApplication)
-> ((String, Int) -> Chan (Request, ByteString) -> App ())
-> App ()
forall e a.
HasCallStack =>
MockServerSettings
-> (Chan e -> LiftedApplication)
-> ((String, Int) -> Chan e -> App a)
-> App a
withMockServer MockServerSettings
forall a. Default a => a
def Chan (Request, ByteString) -> LiftedApplication
lhMockApp (((String, Int) -> Chan (Request, ByteString) -> App ()) -> App ())
-> ((String, Int) -> Chan (Request, ByteString) -> App ())
-> App ()
forall a b. (a -> b) -> a -> b
$ \(String, Int)
lhDomAndPort Chan (Request, ByteString)
_chan -> do
    (Value
lowner, String
ltid, [Value
lmem]) <- Domain -> Int -> App (Value, String, [Value])
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> Int -> App (Value, String, [Value])
createTeam Domain
OwnDomain Int
2
    (Value
powner, String
ptid, [Value
pmem]) <- Domain -> Int -> App (Value, String, [Value])
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> Int -> App (Value, String, [Value])
createTeam Domain
OwnDomain Int
2

    String -> Value -> App Response
forall uid tid.
(HasCallStack, MakesValue uid, MakesValue tid) =>
tid -> uid -> App Response
legalholdWhitelistTeam String
ltid Value
lowner App Response -> (Response -> 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
>>= HasCallStack => Response -> App ()
Response -> App ()
assertSuccess
    String -> Value -> App Response
forall uid tid.
(HasCallStack, MakesValue uid, MakesValue tid) =>
tid -> uid -> App Response
legalholdIsTeamInWhitelist String
ltid Value
lowner App Response -> (Response -> 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
>>= HasCallStack => Response -> App ()
Response -> App ()
assertSuccess
    String -> Value -> Value -> App Response
forall ownerid tid newService.
(HasCallStack, MakesValue ownerid, MakesValue tid,
 MakesValue newService) =>
tid -> ownerid -> newService -> App Response
postLegalHoldSettings String
ltid Value
lowner ((String, Int) -> Value
mkLegalHoldSettings (String, Int)
lhDomAndPort) App Response -> (Response -> 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
>>= HasCallStack => Int -> Response -> App ()
Int -> Response -> App ()
assertStatus Int
201

    String -> Value -> Value -> App Response
forall tid ownerid uid.
(HasCallStack, MakesValue tid, MakesValue ownerid,
 MakesValue uid) =>
tid -> ownerid -> uid -> App Response
requestLegalHoldDevice String
ltid Value
lowner Value
lmem App Response -> (Response -> 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
>>= HasCallStack => Response -> App ()
Response -> App ()
assertSuccess
    case LHApprovedOrPending
approvedOrPending of
      LHApprovedOrPending
LHApproved -> String -> App Value -> String -> App Response
forall tid uid.
(HasCallStack, MakesValue tid, MakesValue uid) =>
tid -> uid -> String -> App Response
approveLegalHoldDevice String
ltid (Value
lmem Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"qualified_id") String
defPassword App Response -> (Response -> 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
>>= HasCallStack => Response -> App ()
Response -> App ()
assertSuccess
      LHApprovedOrPending
LHPending -> () -> App ()
forall a. a -> App a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

    let addc :: Maybe [String] -> App ()
addc Maybe [String]
caps = Value -> AddClient -> App Response
forall user.
(HasCallStack, MakesValue user) =>
user -> AddClient -> App Response
addClient Value
pmem (Maybe [String] -> AddClient
settings Maybe [String]
caps) App Response -> (Response -> 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
>>= HasCallStack => Response -> App ()
Response -> App ()
assertSuccess
        settings :: Maybe [String] -> AddClient
settings Maybe [String]
caps =
          AddClient
forall a. Default a => a
def
            { prekeys = Just $ take 10 somePrekeysRendered,
              lastPrekey = Just $ head someLastPrekeysRendered,
              acapabilities = caps
            }
     in Maybe [String] -> App ()
addc (Maybe [String] -> App ()) -> Maybe [String] -> App ()
forall a b. (a -> b) -> a -> b
$ [String] -> Maybe [String]
forall a. a -> Maybe a
Just [String
"legalhold-implicit-consent"]

    case TestClaimKeys
testmode of
      TestClaimKeys
TCKConsentMissing -> () -> App ()
forall a. a -> App a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
      TestClaimKeys
TCKConsentAndNewClients -> do
        String -> Value -> App Response
forall uid tid.
(HasCallStack, MakesValue uid, MakesValue tid) =>
tid -> uid -> App Response
legalholdWhitelistTeam String
ptid Value
powner App Response -> (Response -> 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
>>= HasCallStack => Response -> App ()
Response -> App ()
assertSuccess
        String -> Value -> App Response
forall uid tid.
(HasCallStack, MakesValue uid, MakesValue tid) =>
tid -> uid -> App Response
legalholdIsTeamInWhitelist String
ptid Value
powner App Response -> (Response -> 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
>>= HasCallStack => Response -> App ()
Response -> App ()
assertSuccess

    [String]
llhdevs :: [String] <- do
      let getCls :: Value -> App [String]
          getCls :: Value -> App [String]
getCls Value
mem = do
            Response
res <- Value -> Domain -> Value -> App Response
forall tid ownerid uid.
(HasCallStack, MakesValue tid, MakesValue ownerid,
 MakesValue uid) =>
tid -> ownerid -> uid -> App Response
getClientsQualified Value
mem Domain
OwnDomain Value
mem
            Value
val <- HasCallStack => Int -> Response -> App Value
Int -> Response -> App Value
getJSON Int
200 Response
res
            [Value]
cls <- Value -> App [Value]
forall a. (HasCallStack, MakesValue a) => a -> App [Value]
asList Value
val
            Value -> App String
forall a. (HasCallStack, MakesValue a) => a -> App String
objId (Value -> App String) -> [Value] -> App [String]
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]
cls
      Value -> App [String]
getCls Value
lmem

    let assertResp :: (HasCallStack) => Response -> App ()
        assertResp :: HasCallStack => Response -> App ()
assertResp Response
resp = case (TestClaimKeys
testmode, [String]
llhdevs) of
          (TestClaimKeys
TCKConsentMissing, (String
_ : [String]
_)) -> do
            Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
403
            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
"missing-legalhold-consent"
          (TestClaimKeys
TCKConsentAndNewClients, (String
_ : [String]
_)) -> do
            Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200
          (TestClaimKeys
_, []) -> do
            -- no lh devices: no reason to be shy!
            Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200

    App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse (Value -> App Value -> App Response
forall user qcnv.
(HasCallStack, MakesValue user, MakesValue qcnv) =>
user -> qcnv -> App Response
getUsersPrekeyBundle Value
pmem (Value
lmem Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"qualified_id")) HasCallStack => Response -> App ()
Response -> App ()
assertResp
    case [String]
llhdevs of
      [String
llhdev] ->
        -- retrieve lh client if /a
        App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse (Value -> App Value -> String -> App Response
forall tid uid.
(HasCallStack, MakesValue tid, MakesValue uid) =>
tid -> uid -> String -> App Response
getUsersPrekeysClient Value
pmem (Value
lmem Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"qualified_id") String
llhdev) HasCallStack => Response -> App ()
Response -> App ()
assertResp
      [] ->
        -- we're probably doing the LHPending thing right now
        () -> App ()
forall a. a -> App a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
      bad :: [String]
bad@(String
_ : String
_ : [String]
_) ->
        -- fail if there is more than one.
        String -> App ()
forall a. HasCallStack => String -> App a
assertFailure (String
"impossible -- more than one LH device: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> [String] -> String
forall a. Show a => a -> String
show [String]
bad)

    String
slmemdom <- 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
$ Value
lmem Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"qualified_id.domain"
    String
slmemid <- 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
$ Value
lmem Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"qualified_id.id"
    let userClients :: Map String (Map String (Set String))
userClients = [(String, Map String (Set String))]
-> Map String (Map String (Set String))
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(String
slmemdom, [(String, Set String)] -> Map String (Set String)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(String
slmemid, [String] -> Set String
forall a. Ord a => [a] -> Set a
Set.fromList [String]
llhdevs)])]
    App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse (Value -> Map String (Map String (Set String)) -> App Response
forall caller userClients.
(HasCallStack, MakesValue caller, ToJSON userClients) =>
caller -> userClients -> App Response
getMultiUserPrekeyBundle Value
pmem Map String (Map String (Set String))
userClients) ((Response -> App ()) -> App ()) -> (Response -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ HasCallStack => Response -> App ()
Response -> App ()
assertResp

testLHAddClientManually :: App ()
testLHAddClientManually :: App ()
testLHAddClientManually = do
  (Value
_owner, String
_tid, [Value
mem1]) <- Domain -> Int -> App (Value, String, [Value])
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> Int -> App (Value, String, [Value])
createTeam Domain
OwnDomain Int
2
  App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse (Value -> AddClient -> App Response
forall user.
(HasCallStack, MakesValue user) =>
user -> AddClient -> App Response
addClient Value
mem1 AddClient
forall a. Default a => a
def {ctype = "legalhold"}) ((Response -> App ()) -> App ()) -> (Response -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \Response
resp -> do
    HasCallStack => Int -> String -> Response -> App ()
Int -> String -> Response -> App ()
assertLabel Int
400 String
"client-error" Response
resp
    -- we usually don't test the human-readable "message", but in this case it is important to
    -- make sure the reason is the right one, and not eg. "LH service not present", or some
    -- other unspecific client error.
    Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"message" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
"LegalHold clients cannot be added manually. LegalHold must be enabled on this user by an admin"

testLHDeleteClientManually :: App ()
testLHDeleteClientManually :: App ()
testLHDeleteClientManually = do
  (Value
_owner, String
_tid, [Value
mem1]) <- Domain -> Int -> App (Value, String, [Value])
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> Int -> App (Value, String, [Value])
createTeam Domain
OwnDomain Int
2
  String
cid <- App Response -> (Response -> App String) -> App String
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse (Value -> AddClient -> App Response
forall user.
(HasCallStack, MakesValue user) =>
user -> AddClient -> App Response
BrigI.addClient Value
mem1 AddClient
forall a. Default a => a
def {ctype = "legalhold"}) ((Response -> App String) -> App String)
-> (Response -> App String) -> App String
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
    Value -> App String
forall a. (HasCallStack, MakesValue a) => a -> App String
asString (Value -> App String) -> App Value -> App String
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"id"
  App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse (Value -> String -> App Response
forall user qcnv.
(HasCallStack, MakesValue user, MakesValue qcnv) =>
user -> qcnv -> App Response
deleteClient Value
mem1 String
cid) ((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
"client-error"
    -- we usually don't test the human-readable "message", but in this case it is important to
    -- make sure the reason is the right one, and not eg. "LH service not present", or some
    -- other unspecific client error.
    Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"message" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
"LegalHold clients cannot be deleted. LegalHold must be disabled on this user by an admin"

testLHRequestDevice :: LhApiVersion -> App ()
testLHRequestDevice :: LhApiVersion -> App ()
testLHRequestDevice LhApiVersion
v = do
  (Value
alice, String
tid, [Value
bob]) <- Domain -> Int -> App (Value, String, [Value])
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> Int -> App (Value, String, [Value])
createTeam Domain
OwnDomain Int
2
  let reqNotEnabled :: Value -> Value -> App ()
reqNotEnabled Value
requester Value
requestee =
        String -> Value -> Value -> App Response
forall tid ownerid uid.
(HasCallStack, MakesValue tid, MakesValue ownerid,
 MakesValue uid) =>
tid -> ownerid -> uid -> App Response
requestLegalHoldDevice String
tid Value
requester Value
requestee
          App Response -> (Response -> 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
>>= HasCallStack => Int -> String -> Response -> App ()
Int -> String -> Response -> App ()
assertLabel Int
403 String
"legalhold-not-enabled"

  Value -> Value -> App ()
reqNotEnabled Value
alice Value
bob

  Value
lpk <- App Value
getLastPrekey
  [Value]
pks <- Int -> App Value -> App [Value]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
3 App Value
getPrekey

  MockServerSettings
-> (Chan (Request, ByteString) -> LiftedApplication)
-> ((String, Int) -> Chan (Request, ByteString) -> App ())
-> App ()
forall e a.
HasCallStack =>
MockServerSettings
-> (Chan e -> LiftedApplication)
-> ((String, Int) -> Chan e -> App a)
-> App a
withMockServer MockServerSettings
forall a. Default a => a
def (LhApiVersion
-> CreateMock App
-> Chan (Request, ByteString)
-> LiftedApplication
lhMockAppWithPrekeys LhApiVersion
v MkCreateMock {$sel:nextLastPrey:MkCreateMock :: App Value
nextLastPrey = Value -> App Value
forall a. a -> App a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Value
lpk, $sel:somePrekeys:MkCreateMock :: App [Value]
somePrekeys = [Value] -> App [Value]
forall a. a -> App a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [Value]
pks}) \(String, Int)
lhDomAndPort Chan (Request, ByteString)
_chan -> do
    let statusShouldBe :: String -> App ()
        statusShouldBe :: String -> App ()
statusShouldBe String
status =
          String -> Value -> Value -> App Response
forall tid user owner.
(HasCallStack, MakesValue tid, MakesValue user,
 MakesValue owner) =>
tid -> owner -> user -> App Response
legalholdUserStatus String
tid Value
alice Value
bob 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
"status" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
status

    -- the user has not agreed to be under legalhold
    [Value] -> (Value -> App ()) -> App ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ [Value
alice, Value
bob] \Value
requester -> do
      Value -> Value -> App ()
reqNotEnabled Value
requester Value
bob
      String -> App ()
statusShouldBe String
"no_consent"

    String -> Value -> App Response
forall uid tid.
(HasCallStack, MakesValue uid, MakesValue tid) =>
tid -> uid -> App Response
legalholdWhitelistTeam String
tid Value
alice App Response -> (Response -> 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
>>= HasCallStack => Response -> App ()
Response -> App ()
assertSuccess
    String -> Value -> Value -> App Response
forall ownerid tid newService.
(HasCallStack, MakesValue ownerid, MakesValue tid,
 MakesValue newService) =>
tid -> ownerid -> newService -> App Response
postLegalHoldSettings String
tid Value
alice ((String, Int) -> Value
mkLegalHoldSettings (String, Int)
lhDomAndPort) App Response -> (Response -> 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
>>= HasCallStack => Response -> App ()
Response -> App ()
assertSuccess

    String -> App ()
statusShouldBe String
"disabled"

    String -> Value -> Value -> App Response
forall tid ownerid uid.
(HasCallStack, MakesValue tid, MakesValue ownerid,
 MakesValue uid) =>
tid -> ownerid -> uid -> App Response
requestLegalHoldDevice String
tid Value
alice Value
bob App Response -> (Response -> 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
>>= HasCallStack => Int -> Response -> App ()
Int -> Response -> App ()
assertStatus Int
201
    String -> App ()
statusShouldBe String
"pending"

    -- requesting twice should be idempotent wrt the approval
    -- mind that requesting twice means two "user.legalhold-request" notifications
    -- for the clients of the user under legalhold (bob)
    String -> Value -> Value -> App Response
forall tid ownerid uid.
(HasCallStack, MakesValue tid, MakesValue ownerid,
 MakesValue uid) =>
tid -> ownerid -> uid -> App Response
requestLegalHoldDevice String
tid Value
alice Value
bob App Response -> (Response -> 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
>>= HasCallStack => Int -> Response -> App ()
Int -> Response -> App ()
assertStatus Int
204
    String -> App ()
statusShouldBe String
"pending"

    [String
bobc1, String
bobc2] <- Int -> App String -> App [String]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
2 do
      App Value -> App String
forall a. (HasCallStack, MakesValue a) => a -> App String
objId (App Value -> App String) -> App Value -> App String
forall a b. (a -> b) -> a -> b
$ Value -> AddClient -> App Response
forall user.
(HasCallStack, MakesValue user) =>
user -> AddClient -> App Response
addClient Value
bob AddClient
forall a. Default a => a
def App Response -> (Response -> App Value) -> App Value
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
`bindResponse` HasCallStack => Int -> Response -> App Value
Int -> Response -> App Value
getJSON Int
201
    [String] -> (String -> App ()) -> App ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ [String
bobc1, String
bobc2] \String
client ->
      Value -> String -> Maybe Value -> (Value -> App Bool) -> App Value
forall user client lastNotifId.
(HasCallStack, MakesValue user, MakesValue client,
 MakesValue lastNotifId) =>
user
-> client -> Maybe lastNotifId -> (Value -> App Bool) -> App Value
awaitNotificationClient Value
bob String
client Maybe Value
noValue Value -> App Bool
forall a. MakesValue a => a -> App Bool
isUserLegalholdRequestNotif 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
notif -> do
        Value
notif Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"payload.0.last_prekey" App Value -> Value -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` Value
lpk
        Value
notif Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"payload.0.id" App Value -> App String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` Value -> App String
forall a. (HasCallStack, MakesValue a) => a -> App String
objId Value
bob

-- | pops a channel until it finds an event that returns a 'Just'
--   upon running the matcher function
checkChan :: (HasCallStack) => Chan t -> (t -> App (Maybe a)) -> App a
checkChan :: forall t a. HasCallStack => Chan t -> (t -> App (Maybe a)) -> App a
checkChan Chan t
chan t -> App (Maybe a)
match = do
  Int
tSecs <- (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 a -> (a -> App a) -> Maybe a -> App a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> App a
forall a. HasCallStack => String -> App a
assertFailure String
"checkChan: timed out") a -> App a
forall a. a -> App a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe a -> App a) -> App (Maybe a) -> App a
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Int -> App a -> App (Maybe a)
forall (m :: * -> *) a.
MonadUnliftIO m =>
Int -> m a -> m (Maybe a)
timeout Int
tSecs do
    let go :: App a
go = Chan t -> App t
forall (m :: * -> *) a. MonadIO m => Chan a -> m a
readChan Chan t
chan App t -> (t -> App (Maybe a)) -> App (Maybe a)
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= t -> App (Maybe a)
match App (Maybe a) -> (Maybe a -> App a) -> App a
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= App a -> (a -> App a) -> Maybe a -> App a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe App a
go a -> App a
forall a. a -> App a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
    App a
go

-- | like 'checkChan' but throws away the request and decodes the body
checkChanVal :: (HasCallStack) => Chan (t, LazyByteString) -> (Value -> MaybeT App a) -> App a
checkChanVal :: forall t a.
HasCallStack =>
Chan (t, ByteString) -> (Value -> MaybeT App a) -> App a
checkChanVal Chan (t, ByteString)
chan Value -> MaybeT App a
match = Chan (t, ByteString) -> ((t, ByteString) -> App (Maybe a)) -> App a
forall t a. HasCallStack => Chan t -> (t -> App (Maybe a)) -> App a
checkChan Chan (t, ByteString)
chan \(t
_, ByteString
bs) -> MaybeT App a -> App (Maybe a)
forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT do
  App (Maybe Value) -> MaybeT App Value
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (Maybe Value -> App (Maybe Value)
forall a. a -> App a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ByteString -> Maybe Value
forall a. FromJSON a => ByteString -> Maybe a
decode ByteString
bs)) MaybeT App Value -> (Value -> MaybeT App a) -> MaybeT App a
forall a b. MaybeT App a -> (a -> MaybeT App b) -> MaybeT App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Value -> MaybeT App a
match

testLHApproveDevice :: App ()
testLHApproveDevice :: App ()
testLHApproveDevice = do
  -- team users
  -- alice (boss) and bob and charlie (member)
  (Value
alice, String
tid, [Value
bob, Value
charlie]) <- Domain -> Int -> App (Value, String, [Value])
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> Int -> App (Value, String, [Value])
createTeam Domain
OwnDomain Int
3

  -- ollie the outsider
  Value
ollie <- do
    Value
o <- Domain -> CreateUser -> App Value
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> CreateUser -> App Value
randomUser Domain
OwnDomain CreateUser
forall a. Default a => a
def
    Value -> Value -> App ()
forall alice bob.
(HasCallStack, MakesValue alice, MakesValue bob) =>
alice -> bob -> App ()
connectTwoUsers Value
o Value
alice
    Value -> App Value
forall a. a -> App a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Value
o

  -- sandy the stranger
  Value
sandy <- Domain -> CreateUser -> App Value
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> CreateUser -> App Value
randomUser Domain
OwnDomain CreateUser
forall a. Default a => a
def

  String -> Value -> App Response
forall uid tid.
(HasCallStack, MakesValue uid, MakesValue tid) =>
tid -> uid -> App Response
legalholdWhitelistTeam String
tid Value
alice App Response -> (Response -> 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
>>= HasCallStack => Int -> Response -> App ()
Int -> Response -> App ()
assertStatus Int
200
  String -> App Value -> String -> App Response
forall tid uid.
(HasCallStack, MakesValue tid, MakesValue uid) =>
tid -> uid -> String -> App Response
approveLegalHoldDevice String
tid (Value
bob Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"qualified_id") String
defPassword
    App Response -> (Response -> 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
>>= HasCallStack => Int -> String -> Response -> App ()
Int -> String -> Response -> App ()
assertLabel Int
412 String
"legalhold-not-pending"

  MockServerSettings
-> (Chan (Request, ByteString) -> LiftedApplication)
-> ((String, Int) -> Chan (Request, ByteString) -> App ())
-> App ()
forall e a.
HasCallStack =>
MockServerSettings
-> (Chan e -> LiftedApplication)
-> ((String, Int) -> Chan e -> App a)
-> App a
withMockServer MockServerSettings
forall a. Default a => a
def Chan (Request, ByteString) -> LiftedApplication
lhMockApp \(String, Int)
lhDomAndPort Chan (Request, ByteString)
chan -> do
    String -> Value -> App Response
forall uid tid.
(HasCallStack, MakesValue uid, MakesValue tid) =>
tid -> uid -> App Response
legalholdWhitelistTeam String
tid Value
alice
      App Response -> (Response -> 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
>>= HasCallStack => Int -> Response -> App ()
Int -> Response -> App ()
assertStatus Int
200
    String -> Value -> Value -> App Response
forall ownerid tid newService.
(HasCallStack, MakesValue ownerid, MakesValue tid,
 MakesValue newService) =>
tid -> ownerid -> newService -> App Response
postLegalHoldSettings String
tid Value
alice ((String, Int) -> Value
mkLegalHoldSettings (String, Int)
lhDomAndPort)
      App Response -> (Response -> 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
>>= HasCallStack => Int -> Response -> App ()
Int -> Response -> App ()
assertStatus Int
201
    String -> Value -> Value -> App Response
forall tid ownerid uid.
(HasCallStack, MakesValue tid, MakesValue ownerid,
 MakesValue uid) =>
tid -> ownerid -> uid -> App Response
requestLegalHoldDevice String
tid Value
alice Value
bob
      App Response -> (Response -> 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
>>= HasCallStack => Int -> Response -> App ()
Int -> Response -> App ()
assertStatus Int
201

    let uidsAndTidMatch :: Value -> MaybeT App ()
uidsAndTidMatch Value
val = do
          String
actualTid <-
            Value -> String -> MaybeT App Value
forall a.
(HasCallStack, MakesValue a) =>
a -> String -> MaybeT App Value
lookupFieldM Value
val String
"team_id"
              MaybeT App Value
-> (Value -> MaybeT App String) -> MaybeT App String
forall a b. MaybeT App a -> (a -> MaybeT App b) -> MaybeT App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= App String -> MaybeT App String
forall (m :: * -> *) a. Monad m => m a -> MaybeT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift
              (App String -> MaybeT App String)
-> (Value -> App String) -> Value -> MaybeT App String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> App String
forall a. (HasCallStack, MakesValue a) => a -> App String
asString
          String
actualUid <-
            Value -> String -> MaybeT App Value
forall a.
(HasCallStack, MakesValue a) =>
a -> String -> MaybeT App Value
lookupFieldM Value
val String
"user_id"
              MaybeT App Value
-> (Value -> MaybeT App String) -> MaybeT App String
forall a b. MaybeT App a -> (a -> MaybeT App b) -> MaybeT App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= App String -> MaybeT App String
forall (m :: * -> *) a. Monad m => m a -> MaybeT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift
              (App String -> MaybeT App String)
-> (Value -> App String) -> Value -> MaybeT App String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> App String
forall a. (HasCallStack, MakesValue a) => a -> App String
asString
          String
bobUid <- App String -> MaybeT App String
forall (m :: * -> *) a. Monad m => m a -> MaybeT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (App String -> MaybeT App String)
-> App String -> MaybeT App String
forall a b. (a -> b) -> a -> b
$ Value -> App String
forall a. (HasCallStack, MakesValue a) => a -> App String
objId Value
bob

          -- we pass the check on equality
          Bool -> MaybeT App () -> MaybeT App ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ((String
actualTid, String
actualUid) (String, String) -> (String, String) -> Bool
forall a. Eq a => a -> a -> Bool
== (String
tid, String
bobUid)) do
            MaybeT App ()
forall a. MaybeT App a
forall (m :: * -> *) a. MonadPlus m => m a
mzero

    Chan (Request, ByteString) -> (Value -> MaybeT App ()) -> App ()
forall t a.
HasCallStack =>
Chan (t, ByteString) -> (Value -> MaybeT App a) -> App a
checkChanVal Chan (Request, ByteString)
chan Value -> MaybeT App ()
uidsAndTidMatch

    -- the team owner cannot approve for bob
    String -> Value -> Value -> String -> App Response
forall tid uid forUid.
(HasCallStack, MakesValue tid, MakesValue uid,
 MakesValue forUid) =>
tid -> uid -> forUid -> String -> App Response
approveLegalHoldDevice' String
tid Value
alice Value
bob String
defPassword
      App Response -> (Response -> 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
>>= HasCallStack => Int -> String -> Response -> App ()
Int -> String -> Response -> App ()
assertLabel Int
403 String
"access-denied"
    -- bob needs to provide a password
    String -> Value -> String -> App Response
forall tid uid.
(HasCallStack, MakesValue tid, MakesValue uid) =>
tid -> uid -> String -> App Response
approveLegalHoldDevice String
tid Value
bob String
"wrong-password"
      App Response -> (Response -> 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
>>= HasCallStack => Int -> String -> Response -> App ()
Int -> String -> Response -> App ()
assertLabel Int
403 String
"access-denied"
    -- now bob finally found his password
    String -> Value -> String -> App Response
forall tid uid.
(HasCallStack, MakesValue tid, MakesValue uid) =>
tid -> uid -> String -> App Response
approveLegalHoldDevice String
tid Value
bob String
defPassword
      App Response -> (Response -> 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
>>= HasCallStack => Int -> Response -> App ()
Int -> Response -> App ()
assertStatus Int
200

    let matchAuthToken :: a -> MaybeT App String
matchAuthToken a
val =
          a -> String -> MaybeT App Value
forall a.
(HasCallStack, MakesValue a) =>
a -> String -> MaybeT App Value
lookupFieldM a
val String
"refresh_token"
            MaybeT App Value
-> (Value -> MaybeT App String) -> MaybeT App String
forall a b. MaybeT App a -> (a -> MaybeT App b) -> MaybeT App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= App String -> MaybeT App String
forall (m :: * -> *) a. Monad m => m a -> MaybeT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift
            (App String -> MaybeT App String)
-> (Value -> App String) -> Value -> MaybeT App String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> App String
forall a. (HasCallStack, MakesValue a) => a -> App String
asString

    Chan (Request, ByteString)
-> (Value -> MaybeT App String) -> App String
forall t a.
HasCallStack =>
Chan (t, ByteString) -> (Value -> MaybeT App a) -> App a
checkChanVal Chan (Request, ByteString)
chan Value -> MaybeT App String
forall {a}. MakesValue a => a -> MaybeT App String
matchAuthToken
      App String -> (String -> 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
>>= Value -> String -> App Response
forall uid.
(HasCallStack, MakesValue uid) =>
uid -> String -> App Response
renewToken Value
bob
      App Response -> (Response -> 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
>>= HasCallStack => Int -> Response -> App ()
Int -> Response -> App ()
assertStatus Int
200

    String
lhdId <- Value -> App String
forall user. MakesValue user => user -> App String
lhDeviceIdOf Value
bob

    String -> Value -> Value -> App Response
forall tid user owner.
(HasCallStack, MakesValue tid, MakesValue user,
 MakesValue owner) =>
tid -> owner -> user -> App Response
legalholdUserStatus String
tid Value
alice Value
bob 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
"client.id" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
lhdId
      Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"status" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
"enabled"

    Int -> App String -> App [String]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
2 do
      App Value -> App String
forall a. (HasCallStack, MakesValue a) => a -> App String
objId (App Value -> App String) -> App Value -> App String
forall a b. (a -> b) -> a -> b
$ Value -> AddClient -> App Response
forall user.
(HasCallStack, MakesValue user) =>
user -> AddClient -> App Response
addClient Value
bob AddClient
forall a. Default a => a
def App Response -> (Response -> App Value) -> App Value
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
`bindResponse` HasCallStack => Int -> Response -> App Value
Int -> Response -> App Value
getJSON Int
201
      App [String] -> ([String] -> 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
>>= (String -> App ()) -> [String] -> App ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ \String
client ->
        Value -> String -> Maybe Value -> (Value -> App Bool) -> App Value
forall user client lastNotifId.
(HasCallStack, MakesValue user, MakesValue client,
 MakesValue lastNotifId) =>
user
-> client -> Maybe lastNotifId -> (Value -> App Bool) -> App Value
awaitNotificationClient Value
bob String
client Maybe Value
noValue Value -> App Bool
forall a. MakesValue a => a -> App Bool
isUserClientAddNotif 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
notif -> do
          Value
notif Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"payload.0.client.type" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
"legalhold"
          Value
notif Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"payload.0.client.class" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
"legalhold"

    -- the other team members receive a notification about the
    -- legalhold device being approved in their team
    [Value] -> (Value -> App ()) -> App ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ [Value
alice, Value
charlie] \Value
user -> do
      Value -> Maybe Value -> (Value -> App Bool) -> App Value
forall user lastNotifId.
(HasCallStack, MakesValue user, MakesValue lastNotifId) =>
user -> Maybe lastNotifId -> (Value -> App Bool) -> App Value
awaitNotification Value
user Maybe Value
noValue Value -> App Bool
forall a. MakesValue a => a -> App Bool
isUserLegalholdEnabledNotif 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
notif -> do
        Value
notif Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"payload.0.id" App Value -> App String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` Value -> App String
forall a. (HasCallStack, MakesValue a) => a -> App String
objId Value
bob
    [Value] -> (Value -> App ()) -> App ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ [Value
ollie, Value
sandy] \Value
outsider -> do
      String
outsiderClient <- App Value -> App String
forall a. (HasCallStack, MakesValue a) => a -> App String
objId (App Value -> App String) -> App Value -> App String
forall a b. (a -> b) -> a -> b
$ Value -> AddClient -> App Response
forall user.
(HasCallStack, MakesValue user) =>
user -> AddClient -> App Response
addClient Value
outsider AddClient
forall a. Default a => a
def App Response -> (Response -> App Value) -> App Value
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
`bindResponse` HasCallStack => Int -> Response -> App Value
Int -> Response -> App Value
getJSON Int
201
      Value -> String -> Maybe String -> (Value -> App Bool) -> App ()
forall user client.
(HasCallStack, MakesValue user, MakesValue client) =>
user -> client -> Maybe String -> (Value -> App Bool) -> App ()
assertNoNotifications Value
outsider String
outsiderClient Maybe String
forall a. Maybe a
Nothing Value -> App Bool
forall a. MakesValue a => a -> App Bool
isUserLegalholdEnabledNotif

testLHGetDeviceStatus :: LhApiVersion -> App ()
testLHGetDeviceStatus :: LhApiVersion -> App ()
testLHGetDeviceStatus LhApiVersion
v = do
  -- team users
  -- alice (team owner) and bob (member)
  (Value
alice, String
tid, [Value
bob]) <- Domain -> Int -> App (Value, String, [Value])
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> Int -> App (Value, String, [Value])
createTeam Domain
OwnDomain Int
2
  [Value] -> (Value -> App ()) -> App ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ [Value
alice, Value
bob] \Value
user -> do
    String -> Value -> Value -> App Response
forall tid user owner.
(HasCallStack, MakesValue tid, MakesValue user,
 MakesValue owner) =>
tid -> owner -> user -> App Response
legalholdUserStatus String
tid Value
alice Value
user 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
"status" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
"no_consent"

  Value
lpk <- App Value
getLastPrekey
  [Value]
pks <- Int -> App Value -> App [Value]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
3 App Value
getPrekey

  MockServerSettings
-> (Chan (Request, ByteString) -> LiftedApplication)
-> ((String, Int) -> Chan (Request, ByteString) -> App ())
-> App ()
forall e a.
HasCallStack =>
MockServerSettings
-> (Chan e -> LiftedApplication)
-> ((String, Int) -> Chan e -> App a)
-> App a
withMockServer
    MockServerSettings
forall a. Default a => a
def
    do LhApiVersion
-> CreateMock App
-> Chan (Request, ByteString)
-> LiftedApplication
lhMockAppWithPrekeys LhApiVersion
v MkCreateMock {$sel:nextLastPrey:MkCreateMock :: App Value
nextLastPrey = Value -> App Value
forall a. a -> App a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Value
lpk, $sel:somePrekeys:MkCreateMock :: App [Value]
somePrekeys = [Value] -> App [Value]
forall a. a -> App a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [Value]
pks}
    \(String, Int)
lhDomAndPort Chan (Request, ByteString)
_chan -> do
      String -> Value -> App Response
forall uid tid.
(HasCallStack, MakesValue uid, MakesValue tid) =>
tid -> uid -> App Response
legalholdWhitelistTeam String
tid Value
alice
        App Response -> (Response -> 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
>>= HasCallStack => Int -> Response -> App ()
Int -> Response -> App ()
assertStatus Int
200

      String -> Value -> Value -> App Response
forall tid user owner.
(HasCallStack, MakesValue tid, MakesValue user,
 MakesValue owner) =>
tid -> owner -> user -> App Response
legalholdUserStatus String
tid Value
alice Value
bob 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
"status" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
"disabled"
        App Value -> String -> App (Maybe Value)
forall a.
(HasCallStack, MakesValue a) =>
a -> String -> App (Maybe Value)
lookupField Response
resp.json String
"last_prekey"
          App (Maybe Value) -> (Maybe 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
>>= Maybe Value -> App ()
forall a. HasCallStack => Maybe a -> App ()
assertNothing
        MaybeT App Value -> App (Maybe Value)
forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT (App Value -> String -> MaybeT App Value
forall a.
(HasCallStack, MakesValue a) =>
a -> String -> MaybeT App Value
lookupFieldM Response
resp.json String
"client" MaybeT App Value -> (Value -> MaybeT App Value) -> MaybeT App Value
forall a b. MaybeT App a -> (a -> MaybeT App b) -> MaybeT App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Value -> String -> MaybeT App Value)
-> String -> Value -> MaybeT App Value
forall a b c. (a -> b -> c) -> b -> a -> c
flip Value -> String -> MaybeT App Value
forall a.
(HasCallStack, MakesValue a) =>
a -> String -> MaybeT App Value
lookupFieldM String
"id")
          App (Maybe Value) -> (Maybe 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
>>= Maybe Value -> App ()
forall a. HasCallStack => Maybe a -> App ()
assertNothing

      -- the status messages for these have already been tested
      String -> Value -> Value -> App Response
forall ownerid tid newService.
(HasCallStack, MakesValue ownerid, MakesValue tid,
 MakesValue newService) =>
tid -> ownerid -> newService -> App Response
postLegalHoldSettings String
tid Value
alice ((String, Int) -> Value
mkLegalHoldSettings (String, Int)
lhDomAndPort)
        App Response -> (Response -> 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
>>= HasCallStack => Int -> Response -> App ()
Int -> Response -> App ()
assertStatus Int
201

      String -> Value -> Value -> App Response
forall tid ownerid uid.
(HasCallStack, MakesValue tid, MakesValue ownerid,
 MakesValue uid) =>
tid -> ownerid -> uid -> App Response
requestLegalHoldDevice String
tid Value
alice Value
bob
        App Response -> (Response -> 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
>>= HasCallStack => Int -> Response -> App ()
Int -> Response -> App ()
assertStatus Int
201

      String -> Value -> String -> App Response
forall tid uid.
(HasCallStack, MakesValue tid, MakesValue uid) =>
tid -> uid -> String -> App Response
approveLegalHoldDevice String
tid Value
bob String
defPassword
        App Response -> (Response -> 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
>>= HasCallStack => Int -> Response -> App ()
Int -> Response -> App ()
assertStatus Int
200

      String
lhdId <- Value -> App String
forall user. MakesValue user => user -> App String
lhDeviceIdOf Value
bob
      String -> Value -> Value -> App Response
forall tid user owner.
(HasCallStack, MakesValue tid, MakesValue user,
 MakesValue owner) =>
tid -> owner -> user -> App Response
legalholdUserStatus String
tid Value
alice Value
bob 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
"status" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
"enabled"
        Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"last_prekey" App Value -> Value -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` Value
lpk
        Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"client.id" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
lhdId

      String -> Value -> Value -> App Response
forall tid ownerid uid.
(HasCallStack, MakesValue tid, MakesValue ownerid,
 MakesValue uid) =>
tid -> ownerid -> uid -> App Response
requestLegalHoldDevice String
tid Value
alice Value
bob
        App Response -> (Response -> 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
>>= HasCallStack => Int -> String -> Response -> App ()
Int -> String -> Response -> App ()
assertLabel Int
409 String
"legalhold-already-enabled"

-- | this sets the timeout to a higher number; we need
--   this because the SQS queue on the brig is super slow
--   and that's why client.remove events arrive really late
--
--   FUTUREWORK(mangoiv): improve the speed of internal
--   event queuing
setTimeoutTo :: Int -> Env -> Env
setTimeoutTo :: Int -> Env -> Env
setTimeoutTo Int
tSecs Env
env = Env
env {timeOutSeconds = tSecs}

testLHDisableForUser :: App ()
testLHDisableForUser :: App ()
testLHDisableForUser = do
  (Value
alice, String
tid, [Value
bob]) <- Domain -> Int -> App (Value, String, [Value])
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> Int -> App (Value, String, [Value])
createTeam Domain
OwnDomain Int
2

  MockServerSettings
-> (Chan (Request, ByteString) -> LiftedApplication)
-> ((String, Int) -> Chan (Request, ByteString) -> App ())
-> App ()
forall e a.
HasCallStack =>
MockServerSettings
-> (Chan e -> LiftedApplication)
-> ((String, Int) -> Chan e -> App a)
-> App a
withMockServer MockServerSettings
forall a. Default a => a
def Chan (Request, ByteString) -> LiftedApplication
lhMockApp \(String, Int)
lhDomAndPort Chan (Request, ByteString)
chan -> do
    String -> Value -> Value -> (String, Int) -> App ()
forall tid owner uid.
(HasCallStack, MakesValue tid, MakesValue owner, MakesValue uid) =>
tid -> owner -> uid -> (String, Int) -> App ()
setUpLHDevice String
tid Value
alice Value
bob (String, Int)
lhDomAndPort

    Value -> Maybe Value -> (Value -> App Bool) -> App Value
forall user lastNotifId.
(HasCallStack, MakesValue user, MakesValue lastNotifId) =>
user -> Maybe lastNotifId -> (Value -> App Bool) -> App Value
awaitNotification Value
bob Maybe Value
noValue Value -> App Bool
forall a. MakesValue a => a -> App Bool
isUserClientAddNotif 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
notif -> do
      Value
notif Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"payload.0.client.type" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
"legalhold"
      Value
notif Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"payload.0.client.class" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
"legalhold"

    -- only an admin can disable legalhold
    String -> Value -> Value -> String -> App Response
forall tid uid forUid.
(HasCallStack, MakesValue tid, MakesValue uid,
 MakesValue forUid) =>
tid -> uid -> forUid -> String -> App Response
disableLegalHold String
tid Value
bob Value
bob String
defPassword
      App Response -> (Response -> 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
>>= HasCallStack => Int -> String -> Response -> App ()
Int -> String -> Response -> App ()
assertLabel Int
403 String
"operation-denied"

    String -> Value -> Value -> String -> App Response
forall tid uid forUid.
(HasCallStack, MakesValue tid, MakesValue uid,
 MakesValue forUid) =>
tid -> uid -> forUid -> String -> App Response
disableLegalHold String
tid Value
alice Value
bob String
"fix ((\"the password always is \" <>) . show)"
      App Response -> (Response -> 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
>>= HasCallStack => Int -> String -> Response -> App ()
Int -> String -> Response -> App ()
assertLabel Int
403 String
"access-denied"

    String -> Value -> Value -> String -> App Response
forall tid uid forUid.
(HasCallStack, MakesValue tid, MakesValue uid,
 MakesValue forUid) =>
tid -> uid -> forUid -> String -> App Response
disableLegalHold String
tid Value
alice Value
bob String
defPassword
      App Response -> (Response -> 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
>>= HasCallStack => Int -> Response -> App ()
Int -> Response -> App ()
assertStatus Int
200

    Chan (Request, ByteString)
-> ((Request, ByteString) -> App (Maybe ())) -> App ()
forall t a. HasCallStack => Chan t -> (t -> App (Maybe a)) -> App a
checkChan Chan (Request, ByteString)
chan \(Request
req, ByteString
_) -> MaybeT App () -> App (Maybe ())
forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT do
      Bool -> MaybeT App () -> MaybeT App ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless
        do
          ByteString -> String
BS8.unpack Request
req.requestMethod
            String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"POST"
            Bool -> Bool -> Bool
&& Request
req.pathInfo
            [Text] -> [Text] -> Bool
forall a. Eq a => a -> a -> Bool
== (String -> Text
T.pack (String -> Text) -> [String] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [String
"legalhold", String
"remove"])
        MaybeT App ()
forall a. MaybeT App a
forall (m :: * -> *) a. MonadPlus m => m a
mzero

    App Value -> App ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (App Value -> App ()) -> App Value -> App ()
forall a b. (a -> b) -> a -> b
$ (Env -> Env) -> App Value -> App Value
forall a. (Env -> Env) -> App a -> App a
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local (Int -> Env -> Env
setTimeoutTo Int
90) do
      Value -> Maybe Value -> (Value -> App Bool) -> App Value
forall user lastNotifId.
(HasCallStack, MakesValue user, MakesValue lastNotifId) =>
user -> Maybe lastNotifId -> (Value -> App Bool) -> App Value
awaitNotification Value
bob Maybe Value
noValue Value -> App Bool
forall a. MakesValue a => a -> App Bool
isUserClientRemoveNotif
        App Value -> App Value -> App Value
forall a b. App a -> App b -> App b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Value -> Maybe Value -> (Value -> App Bool) -> App Value
forall user lastNotifId.
(HasCallStack, MakesValue user, MakesValue lastNotifId) =>
user -> Maybe lastNotifId -> (Value -> App Bool) -> App Value
awaitNotification Value
bob Maybe Value
noValue Value -> App Bool
forall a. MakesValue a => a -> App Bool
isUserLegalholdDisabledNotif

    String
bobId <- Value -> App String
forall a. (HasCallStack, MakesValue a) => a -> App String
objId Value
bob
    [Value]
lhClients <-
      Value -> [String] -> App Response
forall uid tid.
(HasCallStack, MakesValue uid, MakesValue tid) =>
tid -> uid -> App Response
BrigI.getClientsFull Value
bob [String
bobId] App Response -> (Response -> App [Value]) -> App [Value]
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
bobId
          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] -> App [Value]) -> App [Value]
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Value -> App Bool) -> [Value] -> App [Value]
forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM \Value
val -> (String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"legalhold") (String -> Bool) -> App String -> App Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Value
val Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"type" 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)

    [Value] -> App ()
forall a. (MakesValue a, HasCallStack) => a -> App ()
shouldBeEmpty [Value]
lhClients

testLHEnablePerTeam :: LhApiVersion -> App ()
testLHEnablePerTeam :: LhApiVersion -> App ()
testLHEnablePerTeam LhApiVersion
v = do
  -- team users
  -- alice (team owner) and bob (member)
  (Value
alice, String
tid, [Value
bob]) <- Domain -> Int -> App (Value, String, [Value])
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> Int -> App (Value, String, [Value])
createTeam Domain
OwnDomain Int
2
  String -> Value -> App Response
forall user qcnv.
(HasCallStack, MakesValue user, MakesValue qcnv) =>
user -> qcnv -> App Response
legalholdIsEnabled String
tid 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
"lockStatus" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
"unlocked"
    Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"status" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
"disabled"

  MockServerSettings
-> (Chan (Request, ByteString) -> LiftedApplication)
-> ((String, Int) -> Chan (Request, ByteString) -> App ())
-> App ()
forall e a.
HasCallStack =>
MockServerSettings
-> (Chan e -> LiftedApplication)
-> ((String, Int) -> Chan e -> App a)
-> App a
withMockServer MockServerSettings
forall a. Default a => a
def (LhApiVersion -> Chan (Request, ByteString) -> LiftedApplication
lhMockAppV LhApiVersion
v) \(String, Int)
lhDomAndPort Chan (Request, ByteString)
_chan -> do
    String -> Value -> Value -> (String, Int) -> App ()
forall tid owner uid.
(HasCallStack, MakesValue tid, MakesValue owner, MakesValue uid) =>
tid -> owner -> uid -> (String, Int) -> App ()
setUpLHDevice String
tid Value
alice Value
bob (String, Int)
lhDomAndPort

    String -> Value -> Value -> App Response
forall tid user owner.
(HasCallStack, MakesValue tid, MakesValue user,
 MakesValue owner) =>
tid -> owner -> user -> App Response
legalholdUserStatus String
tid Value
alice Value
bob 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
"status" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
"enabled"

      String -> Value -> String -> App Response
forall tid uid.
(HasCallStack, MakesValue tid, MakesValue uid) =>
tid -> uid -> String -> App Response
putLegalholdStatus String
tid Value
alice String
"disabled"
        App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
`bindResponse` HasCallStack => Int -> String -> Response -> App ()
Int -> String -> Response -> App ()
assertLabel Int
403 String
"legalhold-whitelisted-only"

    -- the put doesn't have any influence on the status being "enabled"
    String -> Value -> Value -> App Response
forall tid user owner.
(HasCallStack, MakesValue tid, MakesValue user,
 MakesValue owner) =>
tid -> owner -> user -> App Response
legalholdUserStatus String
tid Value
alice Value
bob 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
"status" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
"enabled"

testLHGetMembersIncludesStatus :: LhApiVersion -> App ()
testLHGetMembersIncludesStatus :: LhApiVersion -> App ()
testLHGetMembersIncludesStatus LhApiVersion
v = do
  -- team users
  -- alice (team owner) and bob (member)
  (Value
alice, String
tid, [Value
bob]) <- Domain -> Int -> App (Value, String, [Value])
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> Int -> App (Value, String, [Value])
createTeam Domain
OwnDomain Int
2

  let statusShouldBe :: String -> App ()
      statusShouldBe :: String -> App ()
statusShouldBe String
status = do
        Value -> String -> App Response
forall user qcnv.
(HasCallStack, MakesValue user, MakesValue qcnv) =>
user -> qcnv -> App Response
getTeamMembers Value
alice String
tid 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
          [Value
bobMember] <-
            Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"members"
              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] -> App [Value]) -> App [Value]
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Value -> App Bool) -> [Value] -> App [Value]
forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM \Value
u -> do
                String -> String -> Bool
forall a. Eq a => a -> a -> Bool
(==) (String -> String -> Bool) -> App String -> App (String -> Bool)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> App Value -> App String
forall a. (HasCallStack, MakesValue a) => a -> App String
asString (Value
u Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"user") App (String -> Bool) -> App String -> App Bool
forall a b. App (a -> b) -> App a -> App b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Value -> App String
forall a. (HasCallStack, MakesValue a) => a -> App String
objId Value
bob
          Value
bobMember Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"legalhold_status" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
status

  String -> App ()
statusShouldBe String
"no_consent"
  MockServerSettings
-> (Chan (Request, ByteString) -> LiftedApplication)
-> ((String, Int) -> Chan (Request, ByteString) -> App ())
-> App ()
forall e a.
HasCallStack =>
MockServerSettings
-> (Chan e -> LiftedApplication)
-> ((String, Int) -> Chan e -> App a)
-> App a
withMockServer MockServerSettings
forall a. Default a => a
def (LhApiVersion -> Chan (Request, ByteString) -> LiftedApplication
lhMockAppV LhApiVersion
v) \(String, Int)
lhDomAndPort Chan (Request, ByteString)
_chan -> do
    String -> App ()
statusShouldBe String
"no_consent"

    String -> Value -> App Response
forall uid tid.
(HasCallStack, MakesValue uid, MakesValue tid) =>
tid -> uid -> App Response
legalholdWhitelistTeam String
tid Value
alice
      App Response -> (Response -> 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
>>= HasCallStack => Int -> Response -> App ()
Int -> Response -> App ()
assertStatus Int
200

    -- the status messages for these have already been tested
    String -> Value -> Value -> App Response
forall ownerid tid newService.
(HasCallStack, MakesValue ownerid, MakesValue tid,
 MakesValue newService) =>
tid -> ownerid -> newService -> App Response
postLegalHoldSettings String
tid Value
alice ((String, Int) -> Value
mkLegalHoldSettings (String, Int)
lhDomAndPort)
      App Response -> (Response -> 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
>>= HasCallStack => Int -> Response -> App ()
Int -> Response -> App ()
assertStatus Int
201

    -- legalhold has been requested but is disabled
    String -> App ()
statusShouldBe String
"disabled"

    String -> Value -> Value -> App Response
forall tid ownerid uid.
(HasCallStack, MakesValue tid, MakesValue ownerid,
 MakesValue uid) =>
tid -> ownerid -> uid -> App Response
requestLegalHoldDevice String
tid Value
alice Value
bob
      App Response -> (Response -> 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
>>= HasCallStack => Int -> Response -> App ()
Int -> Response -> App ()
assertStatus Int
201

    -- legalhold has been set to pending after requesting device
    String -> App ()
statusShouldBe String
"pending"

    String -> Value -> String -> App Response
forall tid uid.
(HasCallStack, MakesValue tid, MakesValue uid) =>
tid -> uid -> String -> App Response
approveLegalHoldDevice String
tid Value
bob String
defPassword
      App Response -> (Response -> 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
>>= HasCallStack => Int -> Response -> App ()
Int -> Response -> App ()
assertStatus Int
200

    -- bob has accepted the legalhold device
    String -> App ()
statusShouldBe String
"enabled"

testLHConnectionsWithNonConsentingUsers :: LhApiVersion -> App ()
testLHConnectionsWithNonConsentingUsers :: LhApiVersion -> App ()
testLHConnectionsWithNonConsentingUsers LhApiVersion
v = do
  (Value
alice, String
tid, []) <- Domain -> Int -> App (Value, String, [Value])
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> Int -> App (Value, String, [Value])
createTeam Domain
OwnDomain Int
1
  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
  Value
carl <- Domain -> CreateUser -> App Value
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> CreateUser -> App Value
randomUser Domain
OwnDomain CreateUser
forall a. Default a => a
def
  Value
dee <- Domain -> CreateUser -> App Value
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> CreateUser -> App Value
randomUser Domain
OwnDomain CreateUser
forall a. Default a => a
def

  String -> Value -> App Response
forall uid tid.
(HasCallStack, MakesValue uid, MakesValue tid) =>
tid -> uid -> App Response
legalholdWhitelistTeam String
tid Value
alice
    App Response -> (Response -> 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
>>= HasCallStack => Int -> Response -> App ()
Int -> Response -> App ()
assertStatus Int
200

  MockServerSettings
-> (Chan (Request, ByteString) -> LiftedApplication)
-> ((String, Int) -> Chan (Request, ByteString) -> App ())
-> App ()
forall e a.
HasCallStack =>
MockServerSettings
-> (Chan e -> LiftedApplication)
-> ((String, Int) -> Chan e -> App a)
-> App a
withMockServer MockServerSettings
forall a. Default a => a
def (LhApiVersion -> Chan (Request, ByteString) -> LiftedApplication
lhMockAppV LhApiVersion
v) \(String, Int)
lhDomAndPort Chan (Request, ByteString)
_chan -> do
    String -> Value -> Value -> App Response
forall ownerid tid newService.
(HasCallStack, MakesValue ownerid, MakesValue tid,
 MakesValue newService) =>
tid -> ownerid -> newService -> App Response
postLegalHoldSettings String
tid Value
alice ((String, Int) -> Value
mkLegalHoldSettings (String, Int)
lhDomAndPort)
      App Response -> (Response -> 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
>>= HasCallStack => Int -> Response -> App ()
Int -> Response -> App ()
assertStatus Int
201

    String -> Value -> Value -> App Response
forall tid ownerid uid.
(HasCallStack, MakesValue tid, MakesValue ownerid,
 MakesValue uid) =>
tid -> ownerid -> uid -> App Response
requestLegalHoldDevice String
tid Value
alice Value
alice
      App Response -> (Response -> 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
>>= HasCallStack => Int -> Response -> App ()
Int -> Response -> App ()
assertStatus Int
201

    -- Connections are not blocked before LH is approved by alice
    Value -> Value -> App ()
forall alice bob.
(HasCallStack, MakesValue alice, MakesValue bob) =>
alice -> bob -> App ()
connectTwoUsers Value
alice Value
bob
    Value
bobConvId <- Value -> Value -> App Response
forall user qcnv.
(HasCallStack, MakesValue user, MakesValue qcnv) =>
user -> qcnv -> App Response
getConnection Value
alice Value
bob App Response -> (Response -> App Value) -> App Value
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
`bindResponse` \Response
resp -> Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"qualified_conversation"

    Value -> Value -> App Response
forall user qcnv.
(HasCallStack, MakesValue user, MakesValue qcnv) =>
user -> qcnv -> App Response
postConnection Value
dee Value
alice App Response -> (Response -> 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
>>= HasCallStack => Response -> App ()
Response -> App ()
assertSuccess
    Value
deeConvId <- Value -> Value -> App Response
forall user qcnv.
(HasCallStack, MakesValue user, MakesValue qcnv) =>
user -> qcnv -> App Response
getConnection Value
alice Value
dee App Response -> (Response -> App Value) -> App Value
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
`bindResponse` \Response
resp -> Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"qualified_conversation"

    String -> Value -> String -> App Response
forall tid uid.
(HasCallStack, MakesValue tid, MakesValue uid) =>
tid -> uid -> String -> App Response
approveLegalHoldDevice String
tid Value
alice String
defPassword
      App Response -> (Response -> 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
>>= HasCallStack => Int -> Response -> App ()
Int -> Response -> App ()
assertStatus Int
200

    -- Connections with bob and dee are now in missing-legalhold-consent state
    -- and the 1:1 convs are broken
    Value -> Value -> String -> App ()
forall alice bob.
(HasCallStack, MakesValue alice, MakesValue bob) =>
alice -> bob -> String -> App ()
assertConnection Value
alice Value
bob String
"missing-legalhold-consent"
    Value -> Value -> String -> App ()
forall alice bob.
(HasCallStack, MakesValue alice, MakesValue bob) =>
alice -> bob -> String -> App ()
assertConnection Value
bob Value
alice String
"missing-legalhold-consent"
    Value -> Value -> App Response
forall user qcnv.
(HasCallStack, MakesValue user, MakesValue qcnv) =>
user -> qcnv -> App Response
getConversation Value
bob Value
bobConvId
      App Response -> (Response -> 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
>>= HasCallStack => Int -> String -> Response -> App ()
Int -> String -> Response -> App ()
assertLabel Int
403 String
"access-denied"

    Value -> Value -> String -> App ()
forall alice bob.
(HasCallStack, MakesValue alice, MakesValue bob) =>
alice -> bob -> String -> App ()
assertConnection Value
alice Value
dee String
"missing-legalhold-consent"
    Value -> Value -> String -> App ()
forall alice bob.
(HasCallStack, MakesValue alice, MakesValue bob) =>
alice -> bob -> String -> App ()
assertConnection Value
dee Value
alice String
"missing-legalhold-consent"
    Value -> Value -> App Response
forall user qcnv.
(HasCallStack, MakesValue user, MakesValue qcnv) =>
user -> qcnv -> App Response
getConversation Value
dee Value
deeConvId
      App Response -> (Response -> 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
>>= HasCallStack => Int -> String -> Response -> App ()
Int -> String -> Response -> App ()
assertLabel Int
403 String
"access-denied"

    -- Connections are blocked after alice approves the LH device
    Value -> Value -> App Response
forall user qcnv.
(HasCallStack, MakesValue user, MakesValue qcnv) =>
user -> qcnv -> App Response
postConnection Value
carl Value
alice
      App Response -> (Response -> 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
>>= HasCallStack => Int -> String -> Response -> App ()
Int -> String -> Response -> App ()
assertLabel Int
403 String
"missing-legalhold-consent"
    Value -> Value -> App Response
forall user qcnv.
(HasCallStack, MakesValue user, MakesValue qcnv) =>
user -> qcnv -> App Response
postConnection Value
alice Value
carl
      App Response -> (Response -> 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
>>= HasCallStack => Int -> String -> Response -> App ()
Int -> String -> Response -> App ()
assertLabel Int
403 String
"missing-legalhold-consent"

    String -> Value -> Value -> String -> App Response
forall tid uid forUid.
(HasCallStack, MakesValue tid, MakesValue uid,
 MakesValue forUid) =>
tid -> uid -> forUid -> String -> App Response
disableLegalHold String
tid Value
alice Value
alice String
defPassword
      App Response -> (Response -> 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
>>= HasCallStack => Int -> Response -> App ()
Int -> Response -> App ()
assertStatus Int
200

    -- Disabling LH restores connection status and 1:1 convs
    Value -> Value -> String -> App ()
forall alice bob.
(HasCallStack, MakesValue alice, MakesValue bob) =>
alice -> bob -> String -> App ()
assertConnection Value
alice Value
bob String
"accepted"
    Value -> Value -> String -> App ()
forall alice bob.
(HasCallStack, MakesValue alice, MakesValue bob) =>
alice -> bob -> String -> App ()
assertConnection Value
bob Value
alice String
"accepted"
    Value -> Value -> App Response
forall user qcnv.
(HasCallStack, MakesValue user, MakesValue qcnv) =>
user -> qcnv -> App Response
getConversation Value
bob Value
bobConvId 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
"members.others.0.qualified_id" App Value -> App Value -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` Value -> App Value
forall a. (HasCallStack, MakesValue a) => a -> App Value
objQidObject Value
alice

    Value -> Value -> String -> App ()
forall alice bob.
(HasCallStack, MakesValue alice, MakesValue bob) =>
alice -> bob -> String -> App ()
assertConnection Value
alice Value
dee String
"pending"
    Value -> Value -> String -> App ()
forall alice bob.
(HasCallStack, MakesValue alice, MakesValue bob) =>
alice -> bob -> String -> App ()
assertConnection Value
dee Value
alice String
"sent"
    Value -> Value -> App Response
forall user qcnv.
(HasCallStack, MakesValue user, MakesValue qcnv) =>
user -> qcnv -> App Response
getConversation Value
dee Value
deeConvId 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
"members.others.0.qualified_id" App Value -> App Value -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` Value -> App Value
forall a. (HasCallStack, MakesValue a) => a -> App Value
objQidObject Value
alice

testLHConnectionsWithConsentingUsers :: LhApiVersion -> App ()
testLHConnectionsWithConsentingUsers :: LhApiVersion -> App ()
testLHConnectionsWithConsentingUsers LhApiVersion
v = do
  (Value
alice, String
teamA, []) <- Domain -> Int -> App (Value, String, [Value])
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> Int -> App (Value, String, [Value])
createTeam Domain
OwnDomain Int
1
  (Value
bob, String
teamB, [Value
barbara]) <- Domain -> Int -> App (Value, String, [Value])
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> Int -> App (Value, String, [Value])
createTeam Domain
OwnDomain Int
2

  String -> Value -> App Response
forall uid tid.
(HasCallStack, MakesValue uid, MakesValue tid) =>
tid -> uid -> App Response
legalholdWhitelistTeam String
teamA Value
alice
    App Response -> (Response -> 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
>>= HasCallStack => Int -> Response -> App ()
Int -> Response -> App ()
assertStatus Int
200
  String -> Value -> App Response
forall uid tid.
(HasCallStack, MakesValue uid, MakesValue tid) =>
tid -> uid -> App Response
legalholdWhitelistTeam String
teamB Value
bob
    App Response -> (Response -> 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
>>= HasCallStack => Int -> Response -> App ()
Int -> Response -> App ()
assertStatus Int
200

  MockServerSettings
-> (Chan (Request, ByteString) -> LiftedApplication)
-> ((String, Int) -> Chan (Request, ByteString) -> App ())
-> App ()
forall e a.
HasCallStack =>
MockServerSettings
-> (Chan e -> LiftedApplication)
-> ((String, Int) -> Chan e -> App a)
-> App a
withMockServer MockServerSettings
forall a. Default a => a
def (LhApiVersion -> Chan (Request, ByteString) -> LiftedApplication
lhMockAppV LhApiVersion
v) \(String, Int)
lhDomAndPort Chan (Request, ByteString)
_chan -> do
    String -> Value -> Value -> App Response
forall ownerid tid newService.
(HasCallStack, MakesValue ownerid, MakesValue tid,
 MakesValue newService) =>
tid -> ownerid -> newService -> App Response
postLegalHoldSettings String
teamA Value
alice ((String, Int) -> Value
mkLegalHoldSettings (String, Int)
lhDomAndPort)
      App Response -> (Response -> 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
>>= HasCallStack => Int -> Response -> App ()
Int -> Response -> App ()
assertStatus Int
201

    String -> Value -> Value -> App Response
forall tid ownerid uid.
(HasCallStack, MakesValue tid, MakesValue ownerid,
 MakesValue uid) =>
tid -> ownerid -> uid -> App Response
requestLegalHoldDevice String
teamA Value
alice Value
alice
      App Response -> (Response -> 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
>>= HasCallStack => Int -> Response -> App ()
Int -> Response -> App ()
assertStatus Int
201

    -- Connections are not blocked before LH is approved by alice
    Value -> Value -> App ()
forall alice bob.
(HasCallStack, MakesValue alice, MakesValue bob) =>
alice -> bob -> App ()
connectTwoUsers Value
alice Value
bob

    String -> Value -> String -> App Response
forall tid uid.
(HasCallStack, MakesValue tid, MakesValue uid) =>
tid -> uid -> String -> App Response
approveLegalHoldDevice String
teamA Value
alice String
defPassword
      App Response -> (Response -> 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
>>= HasCallStack => Int -> Response -> App ()
Int -> Response -> App ()
assertStatus Int
200

    -- Connection with bob is now in whatever state
    Value -> Value -> App Response
forall user qcnv.
(HasCallStack, MakesValue user, MakesValue qcnv) =>
user -> qcnv -> App Response
getConnection Value
bob 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
"status" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
"accepted"

    -- Connections are not blocked after alice approves the LH device because
    -- teamB has implicit consent
    Value -> Value -> App ()
forall alice bob.
(HasCallStack, MakesValue alice, MakesValue bob) =>
alice -> bob -> App ()
connectTwoUsers Value
alice Value
barbara

data GroupConvAdmin
  = LegalholderIsAdmin
  | PeerIsAdmin
  | BothAreAdmins
  deriving (Int -> GroupConvAdmin -> String -> String
[GroupConvAdmin] -> String -> String
GroupConvAdmin -> String
(Int -> GroupConvAdmin -> String -> String)
-> (GroupConvAdmin -> String)
-> ([GroupConvAdmin] -> String -> String)
-> Show GroupConvAdmin
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: Int -> GroupConvAdmin -> String -> String
showsPrec :: Int -> GroupConvAdmin -> String -> String
$cshow :: GroupConvAdmin -> String
show :: GroupConvAdmin -> String
$cshowList :: [GroupConvAdmin] -> String -> String
showList :: [GroupConvAdmin] -> String -> String
Show, (forall x. GroupConvAdmin -> Rep GroupConvAdmin x)
-> (forall x. Rep GroupConvAdmin x -> GroupConvAdmin)
-> Generic GroupConvAdmin
forall x. Rep GroupConvAdmin x -> GroupConvAdmin
forall x. GroupConvAdmin -> Rep GroupConvAdmin x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. GroupConvAdmin -> Rep GroupConvAdmin x
from :: forall x. GroupConvAdmin -> Rep GroupConvAdmin x
$cto :: forall x. Rep GroupConvAdmin x -> GroupConvAdmin
to :: forall x. Rep GroupConvAdmin x -> GroupConvAdmin
Generic)

-- | If a member of an existing conversation is assigned a LH device, users are removed from
-- the conversation until policy conflicts are resolved.
--
-- As to who gets to stay:
-- - admins will stay over members
-- - local members will stay over remote members.
testLHNoConsentRemoveFromGroup :: LHApprovedOrPending -> GroupConvAdmin -> App ()
testLHNoConsentRemoveFromGroup :: LHApprovedOrPending -> GroupConvAdmin -> App ()
testLHNoConsentRemoveFromGroup LHApprovedOrPending
approvedOrPending GroupConvAdmin
admin = do
  (Value
alice, String
tidAlice, []) <- Domain -> Int -> App (Value, String, [Value])
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> Int -> App (Value, String, [Value])
createTeam Domain
OwnDomain Int
1
  (Value
bob, String
tidBob, []) <- Domain -> Int -> App (Value, String, [Value])
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> Int -> App (Value, String, [Value])
createTeam Domain
OwnDomain Int
1
  String -> Value -> App Response
forall uid tid.
(HasCallStack, MakesValue uid, MakesValue tid) =>
tid -> uid -> App Response
legalholdWhitelistTeam String
tidAlice Value
alice App Response -> (Response -> 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
>>= HasCallStack => Int -> Response -> App ()
Int -> Response -> App ()
assertStatus Int
200
  MockServerSettings
-> (Chan (Request, ByteString) -> LiftedApplication)
-> ((String, Int) -> Chan (Request, ByteString) -> App ())
-> App ()
forall e a.
HasCallStack =>
MockServerSettings
-> (Chan e -> LiftedApplication)
-> ((String, Int) -> Chan e -> App a)
-> App a
withMockServer MockServerSettings
forall a. Default a => a
def Chan (Request, ByteString) -> LiftedApplication
lhMockApp \(String, Int)
lhDomAndPort Chan (Request, ByteString)
_chan -> do
    String -> Value -> Value -> App Response
forall ownerid tid newService.
(HasCallStack, MakesValue ownerid, MakesValue tid,
 MakesValue newService) =>
tid -> ownerid -> newService -> App Response
postLegalHoldSettings String
tidAlice Value
alice ((String, Int) -> Value
mkLegalHoldSettings (String, Int)
lhDomAndPort) App Response -> (Response -> 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
>>= HasCallStack => Int -> Response -> App ()
Int -> Response -> App ()
assertStatus Int
201
    [Value] -> ([WebSocket] -> App ()) -> App ()
forall a w.
(HasCallStack, ToWSConnect w) =>
[w] -> ([WebSocket] -> App a) -> App a
withWebSockets [Value
alice, Value
bob] \[WebSocket
aws, WebSocket
bws] -> do
      Value -> Value -> App ()
forall alice bob.
(HasCallStack, MakesValue alice, MakesValue bob) =>
alice -> bob -> App ()
connectTwoUsers Value
alice Value
bob
      (Value
convId, Value
qConvId) <- do
        let (Value
inviter, String
tidInviter, Value
invitee, String
inviteeRole) = case GroupConvAdmin
admin of
              GroupConvAdmin
LegalholderIsAdmin -> (Value
alice, String
tidAlice, Value
bob, String
"wire_member")
              GroupConvAdmin
BothAreAdmins -> (Value
alice, String
tidAlice, Value
bob, String
"wire_admin")
              GroupConvAdmin
PeerIsAdmin -> (Value
bob, String
tidBob, Value
alice, String
"wire_member")

        let createConv :: CreateConv
createConv = CreateConv
defProteus {qualifiedUsers = [invitee], newUsersRole = inviteeRole, team = Just tidInviter}
        Value -> CreateConv -> App Response
forall user.
(HasCallStack, MakesValue user) =>
user -> CreateConv -> App Response
postConversation Value
inviter CreateConv
createConv App Response
-> (Response -> App (Value, Value)) -> App (Value, Value)
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
"members.self.conversation_role" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
"wire_admin"
          Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"members.others.0.conversation_role" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` case GroupConvAdmin
admin of
            GroupConvAdmin
BothAreAdmins -> String
"wire_admin"
            GroupConvAdmin
PeerIsAdmin -> String
"wire_member"
            GroupConvAdmin
LegalholderIsAdmin -> String
"wire_member"
          (,) (Value -> Value -> (Value, Value))
-> App Value -> App (Value -> (Value, Value))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"id" App (Value -> (Value, Value)) -> App Value -> App (Value, Value)
forall a b. App (a -> b) -> App a -> App b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"qualified_id"
      [WebSocket] -> (WebSocket -> App ()) -> App ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ [WebSocket
aws, WebSocket
bws] \WebSocket
ws -> do
        HasCallStack => (Value -> App Bool) -> WebSocket -> App Value
(Value -> App Bool) -> WebSocket -> App Value
awaitMatch Value -> App Bool
forall a. MakesValue a => a -> App Bool
isConvCreateNotifNotSelf WebSocket
ws 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
pl -> Value
pl Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"payload.0.conversation" App Value -> Value -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` Value
convId

      [Value] -> (Value -> App ()) -> App ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ [Value
alice, Value
bob] \Value
user ->
        Value -> Value -> App Response
forall user qcnv.
(HasCallStack, MakesValue user, MakesValue qcnv) =>
user -> qcnv -> App Response
getConversation Value
user Value
qConvId App Response -> (Response -> 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
>>= HasCallStack => Int -> Response -> App ()
Int -> Response -> App ()
assertStatus Int
200

      String -> Value -> Value -> App Response
forall tid ownerid uid.
(HasCallStack, MakesValue tid, MakesValue ownerid,
 MakesValue uid) =>
tid -> ownerid -> uid -> App Response
requestLegalHoldDevice String
tidAlice Value
alice Value
alice App Response -> (Response -> 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
>>= HasCallStack => Int -> Response -> App ()
Int -> Response -> App ()
assertStatus Int
201
      case LHApprovedOrPending
approvedOrPending of
        LHApprovedOrPending
LHApproved -> String -> Value -> String -> App Response
forall tid uid.
(HasCallStack, MakesValue tid, MakesValue uid) =>
tid -> uid -> String -> App Response
approveLegalHoldDevice String
tidAlice Value
alice String
defPassword App Response -> (Response -> 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
>>= HasCallStack => Int -> Response -> App ()
Int -> Response -> App ()
assertStatus Int
200
        LHApprovedOrPending
LHPending -> () -> App ()
forall a. a -> App a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

      String -> Value -> Value -> App Response
forall tid user owner.
(HasCallStack, MakesValue tid, MakesValue user,
 MakesValue owner) =>
tid -> owner -> user -> App Response
legalholdUserStatus String
tidAlice Value
alice 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
"status" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` case LHApprovedOrPending
approvedOrPending of
          LHApprovedOrPending
LHApproved -> String
"enabled"
          LHApprovedOrPending
LHPending -> String
"pending"

      case GroupConvAdmin
admin of
        GroupConvAdmin
LegalholderIsAdmin -> do
          case LHApprovedOrPending
approvedOrPending of
            LHApprovedOrPending
LHApproved -> [WebSocket] -> (WebSocket -> App Value) -> App ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ [WebSocket
aws, WebSocket
bws] do HasCallStack => (Value -> App Bool) -> WebSocket -> App Value
(Value -> App Bool) -> WebSocket -> App Value
awaitMatch (Value -> Value -> App Bool
forall user a.
(MakesValue user, MakesValue a) =>
user -> a -> App Bool
isConvLeaveNotifWithLeaver Value
bob)
            LHApprovedOrPending
LHPending -> () -> App ()
forall a. a -> App a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
          Value -> Value -> App Response
forall user qcnv.
(HasCallStack, MakesValue user, MakesValue qcnv) =>
user -> qcnv -> App Response
getConversation Value
alice Value
qConvId App Response -> (Response -> 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
>>= HasCallStack => Int -> Response -> App ()
Int -> Response -> App ()
assertStatus Int
200
          Value -> Value -> App Response
forall user qcnv.
(HasCallStack, MakesValue user, MakesValue qcnv) =>
user -> qcnv -> App Response
getConversation Value
bob Value
qConvId App Response -> (Response -> 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
>>= case LHApprovedOrPending
approvedOrPending of
            LHApprovedOrPending
LHApproved -> HasCallStack => Int -> String -> Response -> App ()
Int -> String -> Response -> App ()
assertLabel Int
403 String
"access-denied"
            LHApprovedOrPending
LHPending -> HasCallStack => Int -> Response -> App ()
Int -> Response -> App ()
assertStatus Int
200
        GroupConvAdmin
PeerIsAdmin -> do
          case LHApprovedOrPending
approvedOrPending of
            LHApprovedOrPending
LHApproved -> [WebSocket] -> (WebSocket -> App Value) -> App ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ [WebSocket
aws, WebSocket
bws] do HasCallStack => (Value -> App Bool) -> WebSocket -> App Value
(Value -> App Bool) -> WebSocket -> App Value
awaitMatch (Value -> Value -> App Bool
forall user a.
(MakesValue user, MakesValue a) =>
user -> a -> App Bool
isConvLeaveNotifWithLeaver Value
alice)
            LHApprovedOrPending
LHPending -> () -> App ()
forall a. a -> App a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
          Value -> Value -> App Response
forall user qcnv.
(HasCallStack, MakesValue user, MakesValue qcnv) =>
user -> qcnv -> App Response
getConversation Value
bob Value
qConvId App Response -> (Response -> 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
>>= HasCallStack => Int -> Response -> App ()
Int -> Response -> App ()
assertStatus Int
200
          Value -> Value -> App Response
forall user qcnv.
(HasCallStack, MakesValue user, MakesValue qcnv) =>
user -> qcnv -> App Response
getConversation Value
alice Value
qConvId App Response -> (Response -> 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
>>= case LHApprovedOrPending
approvedOrPending of
            LHApprovedOrPending
LHApproved -> HasCallStack => Int -> String -> Response -> App ()
Int -> String -> Response -> App ()
assertLabel Int
403 String
"access-denied"
            LHApprovedOrPending
LHPending -> HasCallStack => Int -> Response -> App ()
Int -> Response -> App ()
assertStatus Int
200
        GroupConvAdmin
BothAreAdmins -> do
          case LHApprovedOrPending
approvedOrPending of
            LHApprovedOrPending
LHApproved -> [WebSocket] -> (WebSocket -> App Value) -> App ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ [WebSocket
aws, WebSocket
bws] do HasCallStack => (Value -> App Bool) -> WebSocket -> App Value
(Value -> App Bool) -> WebSocket -> App Value
awaitMatch (Value -> Value -> App Bool
forall user a.
(MakesValue user, MakesValue a) =>
user -> a -> App Bool
isConvLeaveNotifWithLeaver Value
bob)
            LHApprovedOrPending
LHPending -> () -> App ()
forall a. a -> App a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
          Value -> Value -> App Response
forall user qcnv.
(HasCallStack, MakesValue user, MakesValue qcnv) =>
user -> qcnv -> App Response
getConversation Value
alice Value
qConvId App Response -> (Response -> 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
>>= HasCallStack => Int -> Response -> App ()
Int -> Response -> App ()
assertStatus Int
200
          Value -> Value -> App Response
forall user qcnv.
(HasCallStack, MakesValue user, MakesValue qcnv) =>
user -> qcnv -> App Response
getConversation Value
bob Value
qConvId App Response -> (Response -> 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
>>= case LHApprovedOrPending
approvedOrPending of
            LHApprovedOrPending
LHApproved -> HasCallStack => Int -> String -> Response -> App ()
Int -> String -> Response -> App ()
assertLabel Int
403 String
"access-denied"
            LHApprovedOrPending
LHPending -> HasCallStack => Int -> Response -> App ()
Int -> Response -> App ()
assertStatus Int
200

testLHHappyFlow :: LhApiVersion -> App ()
testLHHappyFlow :: LhApiVersion -> App ()
testLHHappyFlow LhApiVersion
v = do
  (Value
alice, String
tid, [Value
bob]) <- Domain -> Int -> App (Value, String, [Value])
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> Int -> App (Value, String, [Value])
createTeam Domain
OwnDomain Int
2
  let statusShouldBe :: String -> App ()
      statusShouldBe :: String -> App ()
statusShouldBe String
status =
        String -> Value -> Value -> App Response
forall tid user owner.
(HasCallStack, MakesValue tid, MakesValue user,
 MakesValue owner) =>
tid -> owner -> user -> App Response
legalholdUserStatus String
tid Value
alice Value
bob 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
"status" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
status

  String -> Value -> App Response
forall uid tid.
(HasCallStack, MakesValue uid, MakesValue tid) =>
tid -> uid -> App Response
legalholdWhitelistTeam String
tid Value
alice App Response -> (Response -> 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
>>= HasCallStack => Int -> Response -> App ()
Int -> Response -> App ()
assertStatus Int
200
  Value
lpk <- App Value
getLastPrekey
  [Value]
pks <- Int -> App Value -> App [Value]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
3 App Value
getPrekey

  MockServerSettings
-> (Chan (Request, ByteString) -> LiftedApplication)
-> ((String, Int) -> Chan (Request, ByteString) -> App ())
-> App ()
forall e a.
HasCallStack =>
MockServerSettings
-> (Chan e -> LiftedApplication)
-> ((String, Int) -> Chan e -> App a)
-> App a
withMockServer MockServerSettings
forall a. Default a => a
def (LhApiVersion
-> CreateMock App
-> Chan (Request, ByteString)
-> LiftedApplication
lhMockAppWithPrekeys LhApiVersion
v MkCreateMock {$sel:nextLastPrey:MkCreateMock :: App Value
nextLastPrey = Value -> App Value
forall a. a -> App a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Value
lpk, $sel:somePrekeys:MkCreateMock :: App [Value]
somePrekeys = [Value] -> App [Value]
forall a. a -> App a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [Value]
pks}) \(String, Int)
lhDomAndPort Chan (Request, ByteString)
_chan -> do
    String -> Value -> Value -> App Response
forall ownerid tid newService.
(HasCallStack, MakesValue ownerid, MakesValue tid,
 MakesValue newService) =>
tid -> ownerid -> newService -> App Response
postLegalHoldSettings String
tid Value
alice ((String, Int) -> Value
mkLegalHoldSettings (String, Int)
lhDomAndPort) App Response -> (Response -> 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
>>= HasCallStack => Int -> Response -> App ()
Int -> Response -> App ()
assertStatus Int
201

    -- implicit consent
    String -> App ()
statusShouldBe String
"disabled"
    -- whitelisting is idempotent
    String -> Value -> App Response
forall uid tid.
(HasCallStack, MakesValue uid, MakesValue tid) =>
tid -> uid -> App Response
legalholdWhitelistTeam String
tid Value
alice App Response -> (Response -> 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
>>= HasCallStack => Int -> Response -> App ()
Int -> Response -> App ()
assertStatus Int
200
    String -> App ()
statusShouldBe String
"disabled"

    -- memmbers cannot request LH devices
    String -> Value -> Value -> App Response
forall tid ownerid uid.
(HasCallStack, MakesValue tid, MakesValue ownerid,
 MakesValue uid) =>
tid -> ownerid -> uid -> App Response
requestLegalHoldDevice String
tid Value
bob Value
alice App Response -> (Response -> 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
>>= HasCallStack => Int -> String -> Response -> App ()
Int -> String -> Response -> App ()
assertLabel Int
403 String
"operation-denied"

    -- owners can; bob should now have a pending request
    String -> Value -> Value -> App Response
forall tid ownerid uid.
(HasCallStack, MakesValue tid, MakesValue ownerid,
 MakesValue uid) =>
tid -> ownerid -> uid -> App Response
requestLegalHoldDevice String
tid Value
alice Value
bob App Response -> (Response -> 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
>>= HasCallStack => Int -> Response -> App ()
Int -> Response -> App ()
assertStatus Int
201
    String -> App ()
statusShouldBe String
"pending"

    -- owner cannot approve on behalf on user under legalhold
    String -> Value -> Value -> String -> App Response
forall tid uid forUid.
(HasCallStack, MakesValue tid, MakesValue uid,
 MakesValue forUid) =>
tid -> uid -> forUid -> String -> App Response
approveLegalHoldDevice' String
tid Value
alice Value
bob String
defPassword App Response -> (Response -> 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
>>= HasCallStack => Int -> String -> Response -> App ()
Int -> String -> Response -> App ()
assertLabel Int
403 String
"access-denied"

    -- user can approve the request, however
    String -> Value -> String -> App Response
forall tid uid.
(HasCallStack, MakesValue tid, MakesValue uid) =>
tid -> uid -> String -> App Response
approveLegalHoldDevice String
tid Value
bob String
defPassword 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

    String -> Value -> Value -> App Response
forall tid user owner.
(HasCallStack, MakesValue tid, MakesValue user,
 MakesValue owner) =>
tid -> owner -> user -> App Response
legalholdUserStatus String
tid Value
alice Value
bob 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
"status" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
"enabled"
      Value
_ <-
        Response
resp.json
          App Value -> String -> App (Maybe Value)
forall a.
(HasCallStack, MakesValue a) =>
a -> String -> App (Maybe Value)
`lookupField` String
"client.id"
          App (Maybe Value) -> (Maybe Value -> App Value) -> App Value
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> Maybe Value -> App Value
forall a. HasCallStack => String -> Maybe a -> App a
assertJust String
"client id is present"
      Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"last_prekey" App Value -> Value -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` Value
lpk

testLHGetStatus :: LhApiVersion -> App ()
testLHGetStatus :: LhApiVersion -> App ()
testLHGetStatus LhApiVersion
v = do
  (Value
alice, String
tid, [Value
bob]) <- Domain -> Int -> App (Value, String, [Value])
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> Int -> App (Value, String, [Value])
createTeam Domain
OwnDomain Int
2
  (Value
charlie, String
_tidCharlie, [Value
debora]) <- Domain -> Int -> App (Value, String, [Value])
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> Int -> App (Value, String, [Value])
createTeam Domain
OwnDomain Int
2
  Value
emil <- Domain -> CreateUser -> App Value
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> CreateUser -> App Value
randomUser Domain
OwnDomain CreateUser
forall a. Default a => a
def

  let check :: (HasCallStack) => (MakesValue getter, MakesValue target) => getter -> target -> String -> App ()
      check :: forall alice bob.
(HasCallStack, MakesValue alice, MakesValue bob) =>
alice -> bob -> String -> App ()
check getter
getter target
target String
status = do
        Value
profile <- getter -> target -> App Response
forall user qcnv.
(HasCallStack, MakesValue user, MakesValue qcnv) =>
user -> qcnv -> App Response
getUser getter
getter target
target App Response -> (Response -> App Value) -> App Value
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 Value
Int -> Response -> App Value
getJSON Int
200
        String
pStatus <- Value
profile Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"legalhold_status" 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
        String
status String -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
pStatus

  [Value] -> (Value -> App ()) -> App ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ [Value
alice, Value
bob, Value
charlie, Value
debora, Value
emil] \Value
u -> do
    Value -> Value -> String -> App ()
forall alice bob.
(HasCallStack, MakesValue alice, MakesValue bob) =>
alice -> bob -> String -> App ()
check Value
u Value
bob String
"no_consent"
    Value -> Value -> String -> App ()
forall alice bob.
(HasCallStack, MakesValue alice, MakesValue bob) =>
alice -> bob -> String -> App ()
check Value
u Value
emil String
"no_consent"
  String -> Value -> App Response
forall uid tid.
(HasCallStack, MakesValue uid, MakesValue tid) =>
tid -> uid -> App Response
legalholdWhitelistTeam String
tid Value
alice App Response -> (Response -> 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
>>= HasCallStack => Int -> Response -> App ()
Int -> Response -> App ()
assertStatus Int
200
  MockServerSettings
-> (Chan (Request, ByteString) -> LiftedApplication)
-> ((String, Int) -> Chan (Request, ByteString) -> App ())
-> App ()
forall e a.
HasCallStack =>
MockServerSettings
-> (Chan e -> LiftedApplication)
-> ((String, Int) -> Chan e -> App a)
-> App a
withMockServer MockServerSettings
forall a. Default a => a
def (LhApiVersion -> Chan (Request, ByteString) -> LiftedApplication
lhMockAppV LhApiVersion
v) \(String, Int)
lhDomAndPort Chan (Request, ByteString)
_chan -> do
    String -> Value -> Value -> App Response
forall ownerid tid newService.
(HasCallStack, MakesValue ownerid, MakesValue tid,
 MakesValue newService) =>
tid -> ownerid -> newService -> App Response
postLegalHoldSettings String
tid Value
alice ((String, Int) -> Value
mkLegalHoldSettings (String, Int)
lhDomAndPort) App Response -> (Response -> 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
>>= HasCallStack => Int -> Response -> App ()
Int -> Response -> App ()
assertStatus Int
201
    [Value] -> (Value -> App ()) -> App ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ [Value
alice, Value
bob, Value
charlie, Value
debora, Value
emil] \Value
u -> do
      Value -> Value -> String -> App ()
forall alice bob.
(HasCallStack, MakesValue alice, MakesValue bob) =>
alice -> bob -> String -> App ()
check Value
u Value
bob String
"disabled"
    String -> Value -> Value -> App Response
forall tid ownerid uid.
(HasCallStack, MakesValue tid, MakesValue ownerid,
 MakesValue uid) =>
tid -> ownerid -> uid -> App Response
requestLegalHoldDevice String
tid Value
alice Value
bob App Response -> (Response -> 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
>>= HasCallStack => Int -> Response -> App ()
Int -> Response -> App ()
assertStatus Int
201
    Value -> Value -> String -> App ()
forall alice bob.
(HasCallStack, MakesValue alice, MakesValue bob) =>
alice -> bob -> String -> App ()
check Value
debora Value
bob String
"pending"
    String -> Value -> String -> App Response
forall tid uid.
(HasCallStack, MakesValue tid, MakesValue uid) =>
tid -> uid -> String -> App Response
approveLegalHoldDevice String
tid Value
bob String
defPassword App Response -> (Response -> 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
>>= HasCallStack => Int -> Response -> App ()
Int -> Response -> App ()
assertStatus Int
200
    Value -> Value -> String -> App ()
forall alice bob.
(HasCallStack, MakesValue alice, MakesValue bob) =>
alice -> bob -> String -> App ()
check Value
debora Value
bob String
"enabled"

testLHCannotCreateGroupWithUsersInConflict :: LhApiVersion -> App ()
testLHCannotCreateGroupWithUsersInConflict :: LhApiVersion -> App ()
testLHCannotCreateGroupWithUsersInConflict LhApiVersion
v = do
  (Value
alice, String
tidAlice, [Value
bob]) <- Domain -> Int -> App (Value, String, [Value])
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> Int -> App (Value, String, [Value])
createTeam Domain
OwnDomain Int
2
  (Value
charlie, String
_tidCharlie, [Value
debora]) <- Domain -> Int -> App (Value, String, [Value])
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> Int -> App (Value, String, [Value])
createTeam Domain
OwnDomain Int
2
  String -> Value -> App Response
forall uid tid.
(HasCallStack, MakesValue uid, MakesValue tid) =>
tid -> uid -> App Response
legalholdWhitelistTeam String
tidAlice Value
alice App Response -> (Response -> 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
>>= HasCallStack => Int -> Response -> App ()
Int -> Response -> App ()
assertStatus Int
200
  Value -> Value -> App ()
forall alice bob.
(HasCallStack, MakesValue alice, MakesValue bob) =>
alice -> bob -> App ()
connectTwoUsers Value
bob Value
charlie
  Value -> Value -> App ()
forall alice bob.
(HasCallStack, MakesValue alice, MakesValue bob) =>
alice -> bob -> App ()
connectTwoUsers Value
bob Value
debora
  MockServerSettings
-> (Chan (Request, ByteString) -> LiftedApplication)
-> ((String, Int) -> Chan (Request, ByteString) -> App ())
-> App ()
forall e a.
HasCallStack =>
MockServerSettings
-> (Chan e -> LiftedApplication)
-> ((String, Int) -> Chan e -> App a)
-> App a
withMockServer MockServerSettings
forall a. Default a => a
def (LhApiVersion -> Chan (Request, ByteString) -> LiftedApplication
lhMockAppV LhApiVersion
v) \(String, Int)
lhDomAndPort Chan (Request, ByteString)
_chan -> do
    String -> Value -> Value -> App Response
forall ownerid tid newService.
(HasCallStack, MakesValue ownerid, MakesValue tid,
 MakesValue newService) =>
tid -> ownerid -> newService -> App Response
postLegalHoldSettings String
tidAlice Value
alice ((String, Int) -> Value
mkLegalHoldSettings (String, Int)
lhDomAndPort) App Response -> (Response -> 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
>>= HasCallStack => Int -> Response -> App ()
Int -> Response -> App ()
assertStatus Int
201
    Value -> CreateConv -> App Response
forall user.
(HasCallStack, MakesValue user) =>
user -> CreateConv -> App Response
postConversation Value
bob CreateConv
defProteus {qualifiedUsers = [charlie, alice], newUsersRole = "wire_member", team = Just tidAlice}
      App Response -> (Response -> 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
>>= HasCallStack => Int -> Response -> App ()
Int -> Response -> App ()
assertStatus Int
201

    String -> Value -> Value -> App Response
forall tid ownerid uid.
(HasCallStack, MakesValue tid, MakesValue ownerid,
 MakesValue uid) =>
tid -> ownerid -> uid -> App Response
requestLegalHoldDevice String
tidAlice Value
alice Value
alice App Response -> (Response -> 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
>>= HasCallStack => Int -> Response -> App ()
Int -> Response -> App ()
assertStatus Int
201
    String -> Value -> String -> App Response
forall tid uid.
(HasCallStack, MakesValue tid, MakesValue uid) =>
tid -> uid -> String -> App Response
approveLegalHoldDevice String
tidAlice Value
alice String
defPassword App Response -> (Response -> 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
>>= HasCallStack => Int -> Response -> App ()
Int -> Response -> App ()
assertStatus Int
200
    String -> Value -> Value -> App Response
forall tid user owner.
(HasCallStack, MakesValue tid, MakesValue user,
 MakesValue owner) =>
tid -> owner -> user -> App Response
legalholdUserStatus String
tidAlice Value
alice 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
"status" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
"enabled"

    Value -> CreateConv -> App Response
forall user.
(HasCallStack, MakesValue user) =>
user -> CreateConv -> App Response
postConversation Value
bob CreateConv
defProteus {qualifiedUsers = [debora, alice], newUsersRole = "wire_member", team = Just tidAlice}
      App Response -> (Response -> 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
>>= HasCallStack => Int -> String -> Response -> App ()
Int -> String -> Response -> App ()
assertLabel Int
403 String
"missing-legalhold-consent"

testLHNoConsentCannotBeInvited :: (HasCallStack) => LhApiVersion -> App ()
testLHNoConsentCannotBeInvited :: HasCallStack => LhApiVersion -> App ()
testLHNoConsentCannotBeInvited LhApiVersion
v = do
  -- team that is legalhold whitelisted
  (Value
legalholder, String
tidLH, Value
userLHNotActivated : [Value]
_) <- Domain -> Int -> App (Value, String, [Value])
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> Int -> App (Value, String, [Value])
createTeam Domain
OwnDomain Int
2
  String -> Value -> App Response
forall uid tid.
(HasCallStack, MakesValue uid, MakesValue tid) =>
tid -> uid -> App Response
legalholdWhitelistTeam String
tidLH Value
legalholder App Response -> (Response -> 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
>>= HasCallStack => Int -> Response -> App ()
Int -> Response -> App ()
assertStatus Int
200

  -- team without legalhold
  (Value
peer, String
_tidPeer, [Value
peer2, Value
peer3]) <- Domain -> Int -> App (Value, String, [Value])
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> Int -> App (Value, String, [Value])
createTeam Domain
OwnDomain Int
3

  [Value] -> App ()
forall usr. (HasCallStack, MakesValue usr) => [usr] -> App ()
connectUsers [Value
peer, Value
userLHNotActivated]
  [Value] -> App ()
forall usr. (HasCallStack, MakesValue usr) => [usr] -> App ()
connectUsers [Value
peer2, Value
userLHNotActivated]

  MockServerSettings
-> (Chan (Request, ByteString) -> LiftedApplication)
-> ((String, Int) -> Chan (Request, ByteString) -> App ())
-> App ()
forall e a.
HasCallStack =>
MockServerSettings
-> (Chan e -> LiftedApplication)
-> ((String, Int) -> Chan e -> App a)
-> App a
withMockServer MockServerSettings
forall a. Default a => a
def (LhApiVersion -> Chan (Request, ByteString) -> LiftedApplication
lhMockAppV LhApiVersion
v) \(String, Int)
lhDomAndPort Chan (Request, ByteString)
_chan -> do
    String -> Value -> Value -> App Response
forall ownerid tid newService.
(HasCallStack, MakesValue ownerid, MakesValue tid,
 MakesValue newService) =>
tid -> ownerid -> newService -> App Response
postLegalHoldSettings String
tidLH Value
legalholder ((String, Int) -> Value
mkLegalHoldSettings (String, Int)
lhDomAndPort) App Response -> (Response -> 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
>>= HasCallStack => Int -> Response -> App ()
Int -> Response -> App ()
assertStatus Int
201
    Value
cid <- Value -> CreateConv -> App Response
forall user.
(HasCallStack, MakesValue user) =>
user -> CreateConv -> App Response
postConversation Value
userLHNotActivated CreateConv
defProteus {qualifiedUsers = [legalholder], newUsersRole = "wire_admin", team = Just tidLH} App Response -> (Response -> App Value) -> App Value
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 Value
Int -> Response -> App Value
getJSON Int
201
    Value -> Value -> AddMembers -> App Response
forall user conv.
(HasCallStack, MakesValue user, MakesValue conv) =>
user -> conv -> AddMembers -> App Response
addMembers Value
userLHNotActivated Value
cid (AddMembers
forall a. Default a => a
def {users = [peer], role = Just "wire_admin"}) App Response -> (Response -> 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
>>= HasCallStack => Response -> App ()
Response -> App ()
assertSuccess

    -- activate legalhold for legalholder
    String -> Value -> Value -> App Response
forall tid ownerid uid.
(HasCallStack, MakesValue tid, MakesValue ownerid,
 MakesValue uid) =>
tid -> ownerid -> uid -> App Response
requestLegalHoldDevice String
tidLH Value
legalholder Value
legalholder App Response -> (Response -> 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
>>= HasCallStack => Response -> App ()
Response -> App ()
assertSuccess
    String -> Value -> Value -> App Response
forall tid user owner.
(HasCallStack, MakesValue tid, MakesValue user,
 MakesValue owner) =>
tid -> owner -> user -> App Response
legalholdUserStatus String
tidLH Value
legalholder Value
legalholder 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
"status" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
"pending"

    Value -> Value -> AddMembers -> App Response
forall user conv.
(HasCallStack, MakesValue user, MakesValue conv) =>
user -> conv -> AddMembers -> App Response
addMembers Value
userLHNotActivated Value
cid (AddMembers
forall a. Default a => a
def {users = [peer2]}) App Response -> (Response -> 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
>>= HasCallStack => Response -> App ()
Response -> App ()
assertSuccess

    String -> App Value -> String -> App Response
forall tid uid.
(HasCallStack, MakesValue tid, MakesValue uid) =>
tid -> uid -> String -> App Response
approveLegalHoldDevice String
tidLH (Value
legalholder Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"qualified_id") String
defPassword App Response -> (Response -> 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
>>= HasCallStack => Response -> App ()
Response -> App ()
assertSuccess
    String -> Value -> Value -> App Response
forall tid user owner.
(HasCallStack, MakesValue tid, MakesValue user,
 MakesValue owner) =>
tid -> owner -> user -> App Response
legalholdUserStatus String
tidLH Value
legalholder Value
legalholder 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
"status" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
"enabled"

    Value -> Value -> AddMembers -> App Response
forall user conv.
(HasCallStack, MakesValue user, MakesValue conv) =>
user -> conv -> AddMembers -> App Response
addMembers Value
userLHNotActivated Value
cid (AddMembers
forall a. Default a => a
def {users = [peer3]}) App Response -> (Response -> 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
>>= HasCallStack => Int -> String -> Response -> App ()
Int -> String -> Response -> App ()
assertLabel Int
403 String
"not-connected"

testLHDisableBeforeApproval :: (HasCallStack) => LhApiVersion -> App ()
testLHDisableBeforeApproval :: HasCallStack => LhApiVersion -> App ()
testLHDisableBeforeApproval LhApiVersion
v = do
  (Value
alice, String
tid, [Value
bob]) <- Domain -> Int -> App (Value, String, [Value])
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> Int -> App (Value, String, [Value])
createTeam Domain
OwnDomain Int
2
  String -> Value -> App Response
forall uid tid.
(HasCallStack, MakesValue uid, MakesValue tid) =>
tid -> uid -> App Response
legalholdWhitelistTeam String
tid Value
alice App Response -> (Response -> 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
>>= HasCallStack => Int -> Response -> App ()
Int -> Response -> App ()
assertStatus Int
200

  MockServerSettings
-> (Chan (Request, ByteString) -> LiftedApplication)
-> ((String, Int) -> Chan (Request, ByteString) -> App ())
-> App ()
forall e a.
HasCallStack =>
MockServerSettings
-> (Chan e -> LiftedApplication)
-> ((String, Int) -> Chan e -> App a)
-> App a
withMockServer MockServerSettings
forall a. Default a => a
def (LhApiVersion -> Chan (Request, ByteString) -> LiftedApplication
lhMockAppV LhApiVersion
v) \(String, Int)
lhDomAndPort Chan (Request, ByteString)
_chan -> do
    String -> Value -> Value -> App Response
forall ownerid tid newService.
(HasCallStack, MakesValue ownerid, MakesValue tid,
 MakesValue newService) =>
tid -> ownerid -> newService -> App Response
postLegalHoldSettings String
tid Value
alice ((String, Int) -> Value
mkLegalHoldSettings (String, Int)
lhDomAndPort) App Response -> (Response -> 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
>>= HasCallStack => Int -> Response -> App ()
Int -> Response -> App ()
assertStatus Int
201

    -- alice requests a legalhold device for bob and sets his status to "pending"
    String -> Value -> Value -> App Response
forall tid ownerid uid.
(HasCallStack, MakesValue tid, MakesValue ownerid,
 MakesValue uid) =>
tid -> ownerid -> uid -> App Response
requestLegalHoldDevice String
tid Value
alice Value
bob App Response -> (Response -> 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
>>= HasCallStack => Response -> App ()
Response -> App ()
assertSuccess
    let getBob'sStatus :: App String
getBob'sStatus = (Value -> Value -> App Response
forall user qcnv.
(HasCallStack, MakesValue user, MakesValue qcnv) =>
user -> qcnv -> App Response
getUser Value
bob Value
bob App Response -> (Response -> App Value) -> App Value
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 Value
Int -> Response -> App Value
getJSON Int
200) App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"legalhold_status" 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
    App String
getBob'sStatus App String -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
"pending"

    -- alice disables legalhold. the status for bob should now not be pending anymore
    String -> Value -> Value -> String -> App Response
forall tid uid forUid.
(HasCallStack, MakesValue tid, MakesValue uid,
 MakesValue forUid) =>
tid -> uid -> forUid -> String -> App Response
disableLegalHold String
tid Value
alice Value
bob String
defPassword
      App Response -> (Response -> 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
>>= HasCallStack => Int -> Response -> App ()
Int -> Response -> App ()
assertStatus Int
200
    App String
getBob'sStatus App String -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
"disabled"

-- ---------
-- WPB-10783
-- ---------
testBlockLHForMLSUsers :: (HasCallStack) => App ()
testBlockLHForMLSUsers :: HasCallStack => App ()
testBlockLHForMLSUsers = do
  -- scenario 1:
  -- if charlie is in any MLS conversation, he cannot approve to be put under legalhold
  (Value
charlie, String
tid, []) <- Domain -> Int -> App (Value, String, [Value])
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> Int -> App (Value, String, [Value])
createTeam Domain
OwnDomain Int
1
  [ClientIdentity
charlie1] <- (Value -> App ClientIdentity) -> [Value] -> App [ClientIdentity]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse (Ciphersuite -> InitMLSClient -> Value -> App ClientIdentity
forall u.
(MakesValue u, HasCallStack) =>
Ciphersuite -> InitMLSClient -> u -> App ClientIdentity
createMLSClient Ciphersuite
forall a. Default a => a
def InitMLSClient
forall a. Default a => a
def) [Value
charlie]
  ConvId
convId <- HasCallStack => Ciphersuite -> ClientIdentity -> App ConvId
Ciphersuite -> ClientIdentity -> App ConvId
createNewGroup Ciphersuite
forall a. Default a => a
def ClientIdentity
charlie1
  App Value -> App ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (App Value -> App ()) -> App Value -> App ()
forall a b. (a -> b) -> a -> b
$ HasCallStack =>
ClientIdentity -> ConvId -> [Value] -> App MessagePackage
ClientIdentity -> ConvId -> [Value] -> App MessagePackage
createAddCommit ClientIdentity
charlie1 ConvId
convId [Value
charlie] App MessagePackage -> (MessagePackage -> App Value) -> App Value
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => MessagePackage -> App Value
MessagePackage -> App Value
sendAndConsumeCommitBundle

  String -> Value -> App Response
forall uid tid.
(HasCallStack, MakesValue uid, MakesValue tid) =>
tid -> uid -> App Response
legalholdWhitelistTeam String
tid Value
charlie App Response -> (Response -> 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
>>= HasCallStack => Int -> Response -> App ()
Int -> Response -> App ()
assertStatus Int
200
  MockServerSettings
-> (Chan (Request, ByteString) -> LiftedApplication)
-> ((String, Int) -> Chan (Request, ByteString) -> App ())
-> App ()
forall e a.
HasCallStack =>
MockServerSettings
-> (Chan e -> LiftedApplication)
-> ((String, Int) -> Chan e -> App a)
-> App a
withMockServer MockServerSettings
forall a. Default a => a
def Chan (Request, ByteString) -> LiftedApplication
lhMockApp \(String, Int)
lhDomAndPort Chan (Request, ByteString)
_chan -> do
    String -> Value -> Value -> App Response
forall ownerid tid newService.
(HasCallStack, MakesValue ownerid, MakesValue tid,
 MakesValue newService) =>
tid -> ownerid -> newService -> App Response
postLegalHoldSettings String
tid Value
charlie ((String, Int) -> Value
mkLegalHoldSettings (String, Int)
lhDomAndPort) App Response -> (Response -> 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
>>= HasCallStack => Int -> Response -> App ()
Int -> Response -> App ()
assertStatus Int
201
    String -> Value -> Value -> App Response
forall tid ownerid uid.
(HasCallStack, MakesValue tid, MakesValue ownerid,
 MakesValue uid) =>
tid -> ownerid -> uid -> App Response
requestLegalHoldDevice String
tid Value
charlie Value
charlie App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
`bindResponse` do
      HasCallStack => Int -> String -> Response -> App ()
Int -> String -> Response -> App ()
assertLabel Int
409 String
"mls-legal-hold-not-allowed"

-- ---------
-- WPB-10772
-- ---------

--  | scenario 2.1:
-- charlie first is put under legalhold and after that wants to join an MLS conversation
-- claiming a keypackage of charlie to add them to a conversation should not be possible
testBlockClaimingKeyPackageForLHUsers :: (HasCallStack) => App ()
testBlockClaimingKeyPackageForLHUsers :: HasCallStack => App ()
testBlockClaimingKeyPackageForLHUsers = do
  (Value
alice, String
tid, [Value
charlie]) <- Domain -> Int -> App (Value, String, [Value])
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> Int -> App (Value, String, [Value])
createTeam Domain
OwnDomain Int
2
  [ClientIdentity
alice1, ClientIdentity
charlie1] <- (Value -> App ClientIdentity) -> [Value] -> App [ClientIdentity]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse (Ciphersuite -> InitMLSClient -> Value -> App ClientIdentity
forall u.
(MakesValue u, HasCallStack) =>
Ciphersuite -> InitMLSClient -> u -> App ClientIdentity
createMLSClient Ciphersuite
forall a. Default a => a
def InitMLSClient
forall a. Default a => a
def) [Value
alice, Value
charlie]
  String
_ <- HasCallStack => Ciphersuite -> ClientIdentity -> App String
Ciphersuite -> ClientIdentity -> App String
uploadNewKeyPackage Ciphersuite
forall a. Default a => a
def ClientIdentity
charlie1
  ConvId
_ <- HasCallStack => Ciphersuite -> ClientIdentity -> App ConvId
Ciphersuite -> ClientIdentity -> App ConvId
createNewGroup Ciphersuite
forall a. Default a => a
def ClientIdentity
alice1
  String -> Value -> App Response
forall uid tid.
(HasCallStack, MakesValue uid, MakesValue tid) =>
tid -> uid -> App Response
legalholdWhitelistTeam String
tid Value
alice App Response -> (Response -> 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
>>= HasCallStack => Int -> Response -> App ()
Int -> Response -> App ()
assertStatus Int
200
  MockServerSettings
-> (Chan (Request, ByteString) -> LiftedApplication)
-> ((String, Int) -> Chan (Request, ByteString) -> App ())
-> App ()
forall e a.
HasCallStack =>
MockServerSettings
-> (Chan e -> LiftedApplication)
-> ((String, Int) -> Chan e -> App a)
-> App a
withMockServer MockServerSettings
forall a. Default a => a
def Chan (Request, ByteString) -> LiftedApplication
lhMockApp \(String, Int)
lhDomAndPort Chan (Request, ByteString)
_chan -> do
    String -> Value -> Value -> App Response
forall ownerid tid newService.
(HasCallStack, MakesValue ownerid, MakesValue tid,
 MakesValue newService) =>
tid -> ownerid -> newService -> App Response
postLegalHoldSettings String
tid Value
alice ((String, Int) -> Value
mkLegalHoldSettings (String, Int)
lhDomAndPort) App Response -> (Response -> 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
>>= HasCallStack => Int -> Response -> App ()
Int -> Response -> App ()
assertStatus Int
201
    String -> Value -> Value -> App Response
forall tid ownerid uid.
(HasCallStack, MakesValue tid, MakesValue ownerid,
 MakesValue uid) =>
tid -> ownerid -> uid -> App Response
requestLegalHoldDevice String
tid Value
alice Value
charlie App Response -> (Response -> 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
>>= HasCallStack => Response -> App ()
Response -> App ()
assertSuccess
    String -> App Value -> String -> App Response
forall tid uid.
(HasCallStack, MakesValue tid, MakesValue uid) =>
tid -> uid -> String -> App Response
approveLegalHoldDevice String
tid (Value
charlie Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"qualified_id") String
defPassword App Response -> (Response -> 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
>>= HasCallStack => Response -> App ()
Response -> App ()
assertSuccess
    Value
profile <- Value -> Value -> App Response
forall user qcnv.
(HasCallStack, MakesValue user, MakesValue qcnv) =>
user -> qcnv -> App Response
getUser Value
alice Value
charlie App Response -> (Response -> App Value) -> App Value
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 Value
Int -> Response -> App Value
getJSON Int
200
    String
pStatus <- Value
profile Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"legalhold_status" 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
    String
pStatus String -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
"enabled"

    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
charlie
      App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
`bindResponse` HasCallStack => Int -> String -> Response -> App ()
Int -> String -> Response -> App ()
assertLabel Int
409 String
"mls-legal-hold-not-allowed"

-- | scenario 2.2:
-- charlie is put under legalhold but creates an MLS Group himself
-- since he doesn't need to claim his own keypackage to do so, this would succeed
-- we need to check upon group creation if the user is under legalhold and reject
-- the operation if they are
testBlockCreateMLSConvForLHUsers :: (HasCallStack) => LhApiVersion -> App ()
testBlockCreateMLSConvForLHUsers :: HasCallStack => LhApiVersion -> App ()
testBlockCreateMLSConvForLHUsers LhApiVersion
v = do
  (Value
alice, String
tid, [Value
charlie]) <- Domain -> Int -> App (Value, String, [Value])
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> Int -> App (Value, String, [Value])
createTeam Domain
OwnDomain Int
2
  [ClientIdentity
alice1, ClientIdentity
charlie1] <- (Value -> App ClientIdentity) -> [Value] -> App [ClientIdentity]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse (Ciphersuite -> InitMLSClient -> Value -> App ClientIdentity
forall u.
(MakesValue u, HasCallStack) =>
Ciphersuite -> InitMLSClient -> u -> App ClientIdentity
createMLSClient Ciphersuite
forall a. Default a => a
def InitMLSClient
forall a. Default a => a
def) [Value
alice, Value
charlie]
  String
_ <- HasCallStack => Ciphersuite -> ClientIdentity -> App String
Ciphersuite -> ClientIdentity -> App String
uploadNewKeyPackage Ciphersuite
forall a. Default a => a
def ClientIdentity
alice1
  String -> Value -> App Response
forall uid tid.
(HasCallStack, MakesValue uid, MakesValue tid) =>
tid -> uid -> App Response
legalholdWhitelistTeam String
tid Value
alice App Response -> (Response -> 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
>>= HasCallStack => Int -> Response -> App ()
Int -> Response -> App ()
assertStatus Int
200
  MockServerSettings
-> (Chan (Request, ByteString) -> LiftedApplication)
-> ((String, Int) -> Chan (Request, ByteString) -> App ())
-> App ()
forall e a.
HasCallStack =>
MockServerSettings
-> (Chan e -> LiftedApplication)
-> ((String, Int) -> Chan e -> App a)
-> App a
withMockServer MockServerSettings
forall a. Default a => a
def (LhApiVersion -> Chan (Request, ByteString) -> LiftedApplication
lhMockAppV LhApiVersion
v) \(String, Int)
lhDomAndPort Chan (Request, ByteString)
_chan -> do
    String -> Value -> Value -> App Response
forall ownerid tid newService.
(HasCallStack, MakesValue ownerid, MakesValue tid,
 MakesValue newService) =>
tid -> ownerid -> newService -> App Response
postLegalHoldSettings String
tid Value
alice ((String, Int) -> Value
mkLegalHoldSettings (String, Int)
lhDomAndPort) App Response -> (Response -> 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
>>= HasCallStack => Int -> Response -> App ()
Int -> Response -> App ()
assertStatus Int
201
    String -> Value -> Value -> App Response
forall tid ownerid uid.
(HasCallStack, MakesValue tid, MakesValue ownerid,
 MakesValue uid) =>
tid -> ownerid -> uid -> App Response
requestLegalHoldDevice String
tid Value
alice Value
charlie App Response -> (Response -> 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
>>= HasCallStack => Response -> App ()
Response -> App ()
assertSuccess
    String -> App Value -> String -> App Response
forall tid uid.
(HasCallStack, MakesValue tid, MakesValue uid) =>
tid -> uid -> String -> App Response
approveLegalHoldDevice String
tid (Value
charlie Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"qualified_id") String
defPassword App Response -> (Response -> 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
>>= HasCallStack => Response -> App ()
Response -> App ()
assertSuccess
    Value
profile <- Value -> Value -> App Response
forall user qcnv.
(HasCallStack, MakesValue user, MakesValue qcnv) =>
user -> qcnv -> App Response
getUser Value
alice Value
charlie App Response -> (Response -> App Value) -> App Value
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 Value
Int -> Response -> App Value
getJSON Int
200
    String
pStatus <- Value
profile Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"legalhold_status" 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
    String
pStatus String -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
"enabled"

    -- charlie tries to create a group and should fail when POSTing the add commit
    ConvId
convId <- HasCallStack => Ciphersuite -> ClientIdentity -> App ConvId
Ciphersuite -> ClientIdentity -> App ConvId
createNewGroup Ciphersuite
forall a. Default a => a
def ClientIdentity
charlie1

    App () -> App ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void
      -- we try to add alice since adding charlie himself would trigger 2.1
      -- since he'd try to claim his own keypackages
      (App () -> App ()) -> App () -> App ()
forall a b. (a -> b) -> a -> b
$ HasCallStack =>
ClientIdentity -> ConvId -> [Value] -> App MessagePackage
ClientIdentity -> ConvId -> [Value] -> App MessagePackage
createAddCommit ClientIdentity
charlie1 ConvId
convId [Value
alice]
      App MessagePackage -> (MessagePackage -> 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
>>= \MessagePackage
mp ->
        HasCallStack => ClientIdentity -> ByteString -> App Response
ClientIdentity -> ByteString -> App Response
postMLSCommitBundle MessagePackage
mp.sender (MessagePackage -> ByteString
mkBundle MessagePackage
mp)
          App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
`bindResponse` HasCallStack => Int -> String -> Response -> App ()
Int -> String -> Response -> App ()
assertLabel Int
409 String
"mls-legal-hold-not-allowed"

    -- (unsurprisingly) this same thing should also work in the one2one case

    Value
respJson <- Value -> Value -> App Response
forall user qcnv.
(HasCallStack, MakesValue user, MakesValue qcnv) =>
user -> qcnv -> App Response
getMLSOne2OneConversation Value
alice Value
charlie App Response -> (Response -> App Value) -> App Value
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 Value
Int -> Response -> App Value
getJSON Int
200
    Ciphersuite -> ClientIdentity -> ConvId -> App ()
createGroup Ciphersuite
forall a. Default a => a
def ClientIdentity
alice1 (ConvId -> App ()) -> App ConvId -> App ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< App Value -> App ConvId
forall conv. (HasCallStack, MakesValue conv) => conv -> App ConvId
objConvId (Value
respJson Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"conversation")

    App () -> App ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void
      -- we try to add alice since adding charlie himself would trigger 2.1
      -- since he'd try to claim his own keypackages
      (App () -> App ()) -> App () -> App ()
forall a b. (a -> b) -> a -> b
$ HasCallStack =>
ClientIdentity -> ConvId -> [Value] -> App MessagePackage
ClientIdentity -> ConvId -> [Value] -> App MessagePackage
createAddCommit ClientIdentity
charlie1 ConvId
convId [Value
alice]
      App MessagePackage -> (MessagePackage -> 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
>>= \MessagePackage
mp ->
        HasCallStack => ClientIdentity -> ByteString -> App Response
ClientIdentity -> ByteString -> App Response
postMLSCommitBundle MessagePackage
mp.sender (MessagePackage -> ByteString
mkBundle MessagePackage
mp)
          App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
`bindResponse` HasCallStack => Int -> String -> Response -> App ()
Int -> String -> Response -> App ()
assertLabel Int
409 String
"mls-legal-hold-not-allowed"

testLHApiV1 :: App ()
testLHApiV1 :: App ()
testLHApiV1 = do
  (Value
alice, String
tid, [Value
bob]) <- Domain -> Int -> App (Value, String, [Value])
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> Int -> App (Value, String, [Value])
createTeam Domain
OwnDomain Int
2

  String -> Value -> App Response
forall uid tid.
(HasCallStack, MakesValue uid, MakesValue tid) =>
tid -> uid -> App Response
legalholdWhitelistTeam String
tid Value
alice App Response -> (Response -> 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
>>= HasCallStack => Response -> App ()
Response -> App ()
assertSuccess

  MockServerSettings
-> (Chan (Request, ByteString) -> LiftedApplication)
-> ((String, Int) -> Chan (Request, ByteString) -> App ())
-> App ()
forall e a.
HasCallStack =>
MockServerSettings
-> (Chan e -> LiftedApplication)
-> ((String, Int) -> Chan e -> App a)
-> App a
withMockServer MockServerSettings
forall a. Default a => a
def (LhApiVersion -> Chan (Request, ByteString) -> LiftedApplication
lhMockAppV LhApiVersion
V1) \(String, Int)
lhDomAndPort Chan (Request, ByteString)
chan -> do
    String -> Value -> Value -> App Response
forall ownerid tid newService.
(HasCallStack, MakesValue ownerid, MakesValue tid,
 MakesValue newService) =>
tid -> ownerid -> newService -> App Response
postLegalHoldSettings String
tid Value
alice ((String, Int) -> Value
mkLegalHoldSettings (String, Int)
lhDomAndPort) App Response -> (Response -> 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
>>= HasCallStack => Int -> Response -> App ()
Int -> Response -> App ()
assertStatus Int
201

    Chan (Request, ByteString)
-> ((Request, ByteString) -> App (Maybe ())) -> App ()
forall t a. HasCallStack => Chan t -> (t -> App (Maybe a)) -> App a
checkChan Chan (Request, ByteString)
chan \(Request
req, ByteString
_) -> MaybeT App () -> App (Maybe ())
forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT (MaybeT App () -> App (Maybe ()))
-> (App () -> MaybeT App ()) -> App () -> App (Maybe ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. App () -> MaybeT App ()
forall (m :: * -> *) a. Monad m => m a -> MaybeT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (App () -> App (Maybe ())) -> App () -> App (Maybe ())
forall a b. (a -> b) -> a -> b
$ do
      ByteString -> String
BS8.unpack Request
req.requestMethod String -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
"GET"
      Request
req.pathInfo [Text] -> [Text] -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` (String -> Text
T.pack (String -> Text) -> [String] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [String
"legalhold", String
"status"])

    String -> Value -> Value -> App Response
forall tid ownerid uid.
(HasCallStack, MakesValue tid, MakesValue ownerid,
 MakesValue uid) =>
tid -> ownerid -> uid -> App Response
requestLegalHoldDevice String
tid Value
alice Value
bob App Response -> (Response -> 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
>>= HasCallStack => Int -> Response -> App ()
Int -> Response -> App ()
assertStatus Int
201

    Chan (Request, ByteString)
-> ((Request, ByteString) -> App (Maybe ())) -> App ()
forall t a. HasCallStack => Chan t -> (t -> App (Maybe a)) -> App a
checkChan Chan (Request, ByteString)
chan \(Request
req, ByteString
_) -> MaybeT App () -> App (Maybe ())
forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT (MaybeT App () -> App (Maybe ()))
-> (App () -> MaybeT App ()) -> App () -> App (Maybe ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. App () -> MaybeT App ()
forall (m :: * -> *) a. Monad m => m a -> MaybeT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (App () -> App (Maybe ())) -> App () -> App (Maybe ())
forall a b. (a -> b) -> a -> b
$ do
      ByteString -> String
BS8.unpack Request
req.requestMethod String -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
"GET"
      Request
req.pathInfo [Text] -> [Text] -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` (String -> Text
T.pack (String -> Text) -> [String] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [String
"legalhold", String
"api-version"])

    Chan (Request, ByteString)
-> ((Request, ByteString) -> App (Maybe ())) -> App ()
forall t a. HasCallStack => Chan t -> (t -> App (Maybe a)) -> App a
checkChan Chan (Request, ByteString)
chan \(Request
req, ByteString
body) -> MaybeT App () -> App (Maybe ())
forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT (MaybeT App () -> App (Maybe ()))
-> (App () -> MaybeT App ()) -> App () -> App (Maybe ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. App () -> MaybeT App ()
forall (m :: * -> *) a. Monad m => m a -> MaybeT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (App () -> App (Maybe ())) -> App () -> App (Maybe ())
forall a b. (a -> b) -> a -> b
$ do
      ByteString -> String
BS8.unpack Request
req.requestMethod String -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
"POST"
      Request
req.pathInfo [Text] -> [Text] -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` (String -> Text
T.pack (String -> Text) -> [String] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [String
"legalhold", String
"v1", String
"initiate"])
      let (Just (Value
value :: Value)) = ByteString -> Maybe Value
forall a. FromJSON a => ByteString -> Maybe a
decode ByteString
body
      Value
value Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"team_id" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
tid
      Value
value Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"qualified_user_id.id" App Value -> App String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` Value -> App String
forall a. (HasCallStack, MakesValue a) => a -> App String
objId Value
bob
      Value
value Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"qualified_user_id.domain" App Value -> App String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` Value -> App String
forall a. (HasCallStack, MakesValue a) => a -> App String
objDomain Value
bob

    String -> App Value -> String -> App Response
forall tid uid.
(HasCallStack, MakesValue tid, MakesValue uid) =>
tid -> uid -> String -> App Response
approveLegalHoldDevice String
tid (Value
bob Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"qualified_id") String
defPassword App Response -> (Response -> 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
>>= HasCallStack => Response -> App ()
Response -> App ()
assertSuccess

    Chan (Request, ByteString)
-> ((Request, ByteString) -> App (Maybe ())) -> App ()
forall t a. HasCallStack => Chan t -> (t -> App (Maybe a)) -> App a
checkChan Chan (Request, ByteString)
chan \(Request
req, ByteString
_) -> MaybeT App () -> App (Maybe ())
forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT (MaybeT App () -> App (Maybe ()))
-> (App () -> MaybeT App ()) -> App () -> App (Maybe ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. App () -> MaybeT App ()
forall (m :: * -> *) a. Monad m => m a -> MaybeT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (App () -> App (Maybe ())) -> App () -> App (Maybe ())
forall a b. (a -> b) -> a -> b
$ do
      ByteString -> String
BS8.unpack Request
req.requestMethod String -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
"GET"
      Request
req.pathInfo [Text] -> [Text] -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` (String -> Text
T.pack (String -> Text) -> [String] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [String
"legalhold", String
"api-version"])

    Chan (Request, ByteString)
-> ((Request, ByteString) -> App (Maybe ())) -> App ()
forall t a. HasCallStack => Chan t -> (t -> App (Maybe a)) -> App a
checkChan Chan (Request, ByteString)
chan \(Request
req, ByteString
body) -> MaybeT App () -> App (Maybe ())
forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT (MaybeT App () -> App (Maybe ()))
-> (App () -> MaybeT App ()) -> App () -> App (Maybe ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. App () -> MaybeT App ()
forall (m :: * -> *) a. Monad m => m a -> MaybeT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (App () -> App (Maybe ())) -> App () -> App (Maybe ())
forall a b. (a -> b) -> a -> b
$ do
      ByteString -> String
BS8.unpack Request
req.requestMethod String -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
"POST"
      Request
req.pathInfo [Text] -> [Text] -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` (String -> Text
T.pack (String -> Text) -> [String] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [String
"legalhold", String
"v1", String
"confirm"])
      let (Just (Value
value :: Value)) = ByteString -> Maybe Value
forall a. FromJSON a => ByteString -> Maybe a
decode ByteString
body
      Value
value Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"team_id" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
tid
      Value
value Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"qualified_user_id.id" App Value -> App String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` Value -> App String
forall a. (HasCallStack, MakesValue a) => a -> App String
objId Value
bob
      Value
value Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"qualified_user_id.domain" App Value -> App String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` Value -> App String
forall a. (HasCallStack, MakesValue a) => a -> App String
objDomain Value
bob
      (Maybe Value -> Bool
forall a. Maybe a -> Bool
isJust (Maybe Value -> Bool) -> App (Maybe Value) -> App Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value
value Value -> String -> App (Maybe Value)
forall a.
(HasCallStack, MakesValue a) =>
a -> String -> App (Maybe Value)
`lookupField` String
"client_id") App Bool -> Bool -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` Bool
True

    String -> Value -> Value -> String -> App Response
forall tid uid forUid.
(HasCallStack, MakesValue tid, MakesValue uid,
 MakesValue forUid) =>
tid -> uid -> forUid -> String -> App Response
disableLegalHold String
tid Value
alice Value
bob String
defPassword App Response -> (Response -> 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
>>= HasCallStack => Int -> Response -> App ()
Int -> Response -> App ()
assertStatus Int
200

    Chan (Request, ByteString)
-> ((Request, ByteString) -> App (Maybe ())) -> App ()
forall t a. HasCallStack => Chan t -> (t -> App (Maybe a)) -> App a
checkChan Chan (Request, ByteString)
chan \(Request
req, ByteString
_) -> MaybeT App () -> App (Maybe ())
forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT (MaybeT App () -> App (Maybe ()))
-> (App () -> MaybeT App ()) -> App () -> App (Maybe ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. App () -> MaybeT App ()
forall (m :: * -> *) a. Monad m => m a -> MaybeT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (App () -> App (Maybe ())) -> App () -> App (Maybe ())
forall a b. (a -> b) -> a -> b
$ do
      ByteString -> String
BS8.unpack Request
req.requestMethod String -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
"GET"
      Request
req.pathInfo [Text] -> [Text] -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` (String -> Text
T.pack (String -> Text) -> [String] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [String
"legalhold", String
"api-version"])

    Chan (Request, ByteString)
-> ((Request, ByteString) -> App (Maybe ())) -> App ()
forall t a. HasCallStack => Chan t -> (t -> App (Maybe a)) -> App a
checkChan Chan (Request, ByteString)
chan \(Request
req, ByteString
body) -> MaybeT App () -> App (Maybe ())
forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT (MaybeT App () -> App (Maybe ()))
-> (App () -> MaybeT App ()) -> App () -> App (Maybe ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. App () -> MaybeT App ()
forall (m :: * -> *) a. Monad m => m a -> MaybeT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (App () -> App (Maybe ())) -> App () -> App (Maybe ())
forall a b. (a -> b) -> a -> b
$ do
      ByteString -> String
BS8.unpack Request
req.requestMethod String -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
"POST"
      Request
req.pathInfo [Text] -> [Text] -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` (String -> Text
T.pack (String -> Text) -> [String] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [String
"legalhold", String
"v1", String
"remove"])
      let (Just (Value
value :: Value)) = ByteString -> Maybe Value
forall a. FromJSON a => ByteString -> Maybe a
decode ByteString
body
      Value
value Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"team_id" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
tid
      Value
value Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"qualified_user_id.id" App Value -> App String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` Value -> App String
forall a. (HasCallStack, MakesValue a) => a -> App String
objId Value
bob
      Value
value Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"qualified_user_id.domain" App Value -> App String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` Value -> App String
forall a. (HasCallStack, MakesValue a) => a -> App String
objDomain Value
bob

testNoCommonVersion :: App ()
testNoCommonVersion :: App ()
testNoCommonVersion = do
  (Value
alice, String
tid, [Value
bob]) <- Domain -> Int -> App (Value, String, [Value])
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> Int -> App (Value, String, [Value])
createTeam Domain
OwnDomain Int
2

  String -> Value -> App Response
forall uid tid.
(HasCallStack, MakesValue uid, MakesValue tid) =>
tid -> uid -> App Response
legalholdWhitelistTeam String
tid Value
alice App Response -> (Response -> 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
>>= HasCallStack => Response -> App ()
Response -> App ()
assertSuccess

  MockServerSettings
-> (Chan () -> LiftedApplication)
-> ((String, Int) -> Chan () -> App ())
-> App ()
forall e a.
HasCallStack =>
MockServerSettings
-> (Chan e -> LiftedApplication)
-> ((String, Int) -> Chan e -> App a)
-> App a
withMockServer MockServerSettings
forall a. Default a => a
def Chan () -> LiftedApplication
lhMockNoCommonVersion \(String, Int)
lhDomAndPort Chan ()
_ -> do
    String -> Value -> App Response
forall uid tid.
(HasCallStack, MakesValue uid, MakesValue tid) =>
tid -> uid -> App Response
legalholdWhitelistTeam String
tid Value
alice App Response -> (Response -> 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
>>= HasCallStack => Int -> Response -> App ()
Int -> Response -> App ()
assertStatus Int
200
    String -> Value -> Value -> App Response
forall ownerid tid newService.
(HasCallStack, MakesValue ownerid, MakesValue tid,
 MakesValue newService) =>
tid -> ownerid -> newService -> App Response
postLegalHoldSettings String
tid Value
alice ((String, Int) -> Value
mkLegalHoldSettings (String, Int)
lhDomAndPort) App Response -> (Response -> 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
>>= HasCallStack => Response -> App ()
Response -> App ()
assertSuccess

    App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse (String -> Value -> Value -> App Response
forall tid ownerid uid.
(HasCallStack, MakesValue tid, MakesValue ownerid,
 MakesValue uid) =>
tid -> ownerid -> uid -> App Response
requestLegalHoldDevice String
tid Value
alice Value
bob) ((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
500
      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
"server-error"

-- | LH can be configured in a way that does not require users to give preliminary consent to
-- LH when being added to a team.  The user still has to approve the LH device before the
-- recording starts.  This is called "implicit consent", was introduced to accomodate specific
-- work flows, and there is some hope that it'll be removed in the future.
--
-- Explicit consent requires users to consent on entering the team, and then approve the
-- actual being put under recording again if it happens.
--
-- This flag allows to make tests run through both configurations with minimal adjustment.
data ImplicitConsent = ImplicitConsent | ExplicitConsent
  deriving (ImplicitConsent -> ImplicitConsent -> Bool
(ImplicitConsent -> ImplicitConsent -> Bool)
-> (ImplicitConsent -> ImplicitConsent -> Bool)
-> Eq ImplicitConsent
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ImplicitConsent -> ImplicitConsent -> Bool
== :: ImplicitConsent -> ImplicitConsent -> Bool
$c/= :: ImplicitConsent -> ImplicitConsent -> Bool
/= :: ImplicitConsent -> ImplicitConsent -> Bool
Eq, Int -> ImplicitConsent -> String -> String
[ImplicitConsent] -> String -> String
ImplicitConsent -> String
(Int -> ImplicitConsent -> String -> String)
-> (ImplicitConsent -> String)
-> ([ImplicitConsent] -> String -> String)
-> Show ImplicitConsent
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: Int -> ImplicitConsent -> String -> String
showsPrec :: Int -> ImplicitConsent -> String -> String
$cshow :: ImplicitConsent -> String
show :: ImplicitConsent -> String
$cshowList :: [ImplicitConsent] -> String -> String
showList :: [ImplicitConsent] -> String -> String
Show, (forall x. ImplicitConsent -> Rep ImplicitConsent x)
-> (forall x. Rep ImplicitConsent x -> ImplicitConsent)
-> Generic ImplicitConsent
forall x. Rep ImplicitConsent x -> ImplicitConsent
forall x. ImplicitConsent -> Rep ImplicitConsent x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ImplicitConsent -> Rep ImplicitConsent x
from :: forall x. ImplicitConsent -> Rep ImplicitConsent x
$cto :: forall x. Rep ImplicitConsent x -> ImplicitConsent
to :: forall x. Rep ImplicitConsent x -> ImplicitConsent
Generic)

-- | Ensure that the LH config is as expected: Either by expecting it from the
-- current server's config. Or, by creating a new one.
ensureLHFeatureConfigForServer :: ImplicitConsent -> (String {- domain -} -> App ()) -> App ()
ensureLHFeatureConfigForServer :: ImplicitConsent -> (String -> App ()) -> App ()
ensureLHFeatureConfigForServer ImplicitConsent
ImplicitConsent String -> App ()
app = do
  -- This should be set in the server's config file. Thus, we only assert here
  -- (to guard against accidential change.)
  Value
cfg <- Service -> App Value
readServiceConfig Service
Galley
  (Value
cfg Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"settings.featureFlags.legalhold") App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
"whitelist-teams-and-implicit-consent"
  String -> App ()
app (String -> App ()) -> App String -> App ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Domain -> App String
forall a. (HasCallStack, MakesValue a) => a -> App String
asString Domain
OwnDomain
ensureLHFeatureConfigForServer ImplicitConsent
ExplicitConsent String -> App ()
app =
  ServiceOverrides -> (HasCallStack => String -> App ()) -> App ()
forall a.
HasCallStack =>
ServiceOverrides -> (HasCallStack => String -> App a) -> App a
withModifiedBackend (ServiceOverrides
forall a. Default a => a
def {galleyCfg = upd}) HasCallStack => String -> App ()
String -> App ()
app
  where
    upd :: Value -> App Value
upd = String -> String -> Value -> App Value
forall a b.
(HasCallStack, MakesValue a, ToJSON b) =>
String -> b -> a -> App Value
setField String
"settings.featureFlags.legalhold" String
"disabled-by-default"