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

module Test.User where

import API.Brig
import API.BrigInternal
import API.Common
import API.GalleyInternal
import qualified API.Spar as Spar
import Control.Monad.Codensity
import Control.Monad.Reader
import qualified Data.Aeson as Aeson
import qualified Data.UUID as UUID
import qualified Data.UUID.V4 as UUID
import SetupHelpers
import Testlib.Prelude
import Testlib.ResourcePool
import Testlib.VersionedFed

testSupportedProtocols :: (HasCallStack) => OneOf Domain (FedDomain 1) -> App ()
testSupportedProtocols :: HasCallStack => OneOf Domain (FedDomain 1) -> App ()
testSupportedProtocols OneOf Domain (FedDomain 1)
bobDomain = do
  Value
alice <- Domain -> CreateUser -> App Value
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> CreateUser -> App Value
randomUser Domain
OwnDomain CreateUser
forall a. Default a => a
def
  Value
alice Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"supported_protocols" App Value -> [String] -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatchSet` [String
"proteus"]

  Value
bob <- OneOf Domain (FedDomain 1) -> CreateUser -> App Value
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> CreateUser -> App Value
randomUser OneOf Domain (FedDomain 1)
bobDomain CreateUser
forall a. Default a => a
def

  do
    -- bob sees default supported protocols for alice
    Value
u <- Value -> Value -> App Response
forall user target.
(HasCallStack, MakesValue user, MakesValue target) =>
user -> target -> App Response
getUser Value
bob Value
alice 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
    Value
u Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"supported_protocols" App Value -> [String] -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` [String
"proteus"]

    Value
p <- Value -> Value -> App Response
forall user target.
(HasCallStack, MakesValue user, MakesValue target) =>
user -> target -> App Response
getUserSupportedProtocols Value
bob Value
alice 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
    Value
p Value -> [String] -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` [String
"proteus"]

  -- alice updates her supported protocols
  App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse (Value -> [String] -> App Response
forall user.
(HasCallStack, MakesValue user) =>
user -> [String] -> App Response
putUserSupportedProtocols Value
alice [String
"proteus", String
"mls"]) ((Response -> App ()) -> App ()) -> (Response -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \Response
resp ->
    Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200

  do
    -- bob sees the updated list
    Value
u <- Value -> Value -> App Response
forall user target.
(HasCallStack, MakesValue user, MakesValue target) =>
user -> target -> App Response
getUser Value
bob Value
alice 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
    Value
u Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"supported_protocols" App Value -> [String] -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatchSet` [String
"proteus", String
"mls"]

    Value
p <- Value -> Value -> App Response
forall user target.
(HasCallStack, MakesValue user, MakesValue target) =>
user -> target -> App Response
getUserSupportedProtocols Value
bob Value
alice 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
    Value
p Value -> [String] -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` [String
"proteus", String
"mls"]

  -- invalid protocol name in update
  App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse (Value -> [String] -> App Response
forall user.
(HasCallStack, MakesValue user) =>
user -> [String] -> App Response
putUserSupportedProtocols Value
alice [String
"proteus", String
"mls", String
"mixed"]) ((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
"bad-request"

testCreateUserSupportedProtocols :: (HasCallStack) => App ()
testCreateUserSupportedProtocols :: HasCallStack => App ()
testCreateUserSupportedProtocols = do
  Value
alice <- Domain -> CreateUser -> App Value
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> CreateUser -> App Value
randomUser Domain
OwnDomain CreateUser
forall a. Default a => a
def {supportedProtocols = Just ["proteus", "mls"]}
  App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse (Value -> Value -> App Response
forall user target.
(HasCallStack, MakesValue user, MakesValue target) =>
user -> target -> App Response
getUserSupportedProtocols Value
alice Value
alice) ((Response -> App ()) -> App ()) -> (Response -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \Response
resp -> do
    Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200
    Response
resp.json App Value -> [String] -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatchSet` [String
"proteus", String
"mls"]

  App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse (Domain -> CreateUser -> App Response
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> CreateUser -> App Response
createUser Domain
OwnDomain CreateUser
forall a. Default a => a
def {supportedProtocols = Just ["proteus", "mixed"]}) ((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
"bad-request"

-- | For now this only tests attempts to update /self/handle in E2EId-enabled teams.  More
-- tests can be found under `/services/brig/test/integration` (and should be moved here).
testUpdateHandle :: (HasCallStack) => App ()
testUpdateHandle :: HasCallStack => App ()
testUpdateHandle = do
  -- create team with one member, without scim, but with `mlsE2EId` enabled.
  (Value
owner, String
team, [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
mem1id <- 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
mem1 Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"id"

  let featureName :: String
featureName = String
"mlsE2EId"
  App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse (Value -> String -> String -> App Response
forall domain_.
(HasCallStack, MakesValue domain_) =>
domain_ -> String -> String -> App Response
getTeamFeature Value
owner String
team String
featureName) ((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
"disabled"
  HasCallStack => Response -> App ()
Response -> App ()
assertSuccess (Response -> App ()) -> App Response -> App ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Value -> String -> String -> String -> App Response
forall domain team.
(HasCallStack, MakesValue domain, MakesValue team) =>
domain -> team -> String -> String -> App Response
setTeamFeatureStatus Value
owner String
team String
featureName String
"enabled"
  App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse (Value -> String -> String -> App Response
forall domain_.
(HasCallStack, MakesValue domain_) =>
domain_ -> String -> String -> App Response
getTeamFeature Value
owner String
team String
featureName) ((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
"enabled"

  -- all as expected here.  (see the second time we check this at the end of the test for an
  -- explanation why we care.)
  App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse (Value -> App Response
forall user.
(HasCallStack, MakesValue user) =>
user -> App Response
getSelf Value
mem1) ((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
"managed_by" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
"wire"
  App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse (Value -> [String] -> App Response
forall user.
(HasCallStack, MakesValue user) =>
user -> [String] -> App Response
getUsersId Value
owner [String
mem1id]) ((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
mb <- ([Value] -> App Value
forall (t :: * -> *) a. (HasCallStack, Foldable t) => t a -> App a
assertOne ([Value] -> App Value) -> App [Value] -> App Value
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< App Value -> App [Value]
forall a. (HasCallStack, MakesValue a) => a -> App [Value]
asList Response
resp.json) App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"managed_by"
    Value
mb Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
"wire"

  -- mem1 attempts to update handle for the first time => success
  --
  -- this is desired, because without SCIM users need to pick their own handles initially.
  -- moreover it is fine, because if `handle == NULL`, no mls E2Eid client certs can be
  -- created.
  String
handle <- UUID -> String
UUID.toString (UUID -> String) -> App UUID -> App String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO UUID -> App UUID
forall a. IO a -> App a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO UUID
UUID.nextRandom
  App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse (Value -> String -> App Response
forall user.
(HasCallStack, MakesValue user) =>
user -> String -> App Response
putHandle Value
mem1 String
handle) ((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 Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse (Value -> String -> App Response
forall user.
(HasCallStack, MakesValue user) =>
user -> String -> App Response
putHandle Value
mem1 String
handle) ((Response -> App ()) -> App ()) -> (Response -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \Response
resp -> do
    -- idempotency
    Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200

  -- mem1 attempts to update handle again => failure
  String
handle2 <- UUID -> String
UUID.toString (UUID -> String) -> App UUID -> App String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO UUID -> App UUID
forall a. IO a -> App a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO UUID
UUID.nextRandom
  App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse (Value -> String -> App Response
forall user.
(HasCallStack, MakesValue user) =>
user -> String -> App Response
putHandle Value
mem1 String
handle2) ((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
"managed-by-scim"

  -- now self thinks it is managed by "scim", so clients can block change attempts to handle,
  -- display name without adding E2EId-specific logic.  this is just a hack, though: `GET
  -- /self` is the only place where this is happening, other end-points still report the truth
  -- that is still stored correctly in the DB.
  --
  -- details: https://wearezeta.atlassian.net/browse/WPB-6189.
  -- FUTUREWORK: figure out a better way for clients to detect E2EId (V6?)
  App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse (Value -> App Response
forall user.
(HasCallStack, MakesValue user) =>
user -> App Response
getSelf Value
mem1) ((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
"managed_by" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
"scim"
  App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse (Value -> [String] -> App Response
forall user.
(HasCallStack, MakesValue user) =>
user -> [String] -> App Response
getUsersId Value
owner [String
mem1id]) ((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
mb <- ([Value] -> App Value
forall (t :: * -> *) a. (HasCallStack, Foldable t) => t a -> App a
assertOne ([Value] -> App Value) -> App [Value] -> App Value
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< App Value -> App [Value]
forall a. (HasCallStack, MakesValue a) => a -> App [Value]
asList Response
resp.json) App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"managed_by"
    Value
mb Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
"wire"
  App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse (Value -> App Response
forall user.
(HasCallStack, MakesValue user) =>
user -> App Response
Spar.getScimTokens Value
owner) ((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
"tokens" App Value -> [String] -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` ([] @String)

-- | For now this only tests attempts to update one's own display name, email address, or
-- language in E2EId-enabled teams (ie., everything except handle).  More tests can be found
-- under `/services/brig/test/integration` (and should be moved here).
testUpdateSelf :: (HasCallStack) => Tagged "mode" TestUpdateSelfMode -> App ()
testUpdateSelf :: HasCallStack => Tagged "mode" TestUpdateSelfMode -> App ()
testUpdateSelf (MkTagged TestUpdateSelfMode
mode) = do
  -- create team with one member, without scim, but with `mlsE2EId` enabled.
  (Value
owner, String
team, [Value
mem1]) <- Domain -> Int -> App (Value, String, [Value])
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> Int -> App (Value, String, [Value])
createTeam Domain
OwnDomain Int
2

  let featureName :: String
featureName = String
"mlsE2EId"
  App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse (Value -> String -> String -> App Response
forall domain_.
(HasCallStack, MakesValue domain_) =>
domain_ -> String -> String -> App Response
getTeamFeature Value
owner String
team String
featureName) ((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
"disabled"
  HasCallStack => Response -> App ()
Response -> App ()
assertSuccess (Response -> App ()) -> App Response -> App ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Value -> String -> String -> String -> App Response
forall domain team.
(HasCallStack, MakesValue domain, MakesValue team) =>
domain -> team -> String -> String -> App Response
setTeamFeatureStatus Value
owner String
team String
featureName String
"enabled"
  App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse (Value -> String -> String -> App Response
forall domain_.
(HasCallStack, MakesValue domain_) =>
domain_ -> String -> String -> App Response
getTeamFeature Value
owner String
team String
featureName) ((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
"enabled"

  case TestUpdateSelfMode
mode of
    TestUpdateSelfMode
TestUpdateDisplayName -> do
      -- blocked unconditionally
      String
someDisplayName <- UUID -> String
UUID.toString (UUID -> String) -> App UUID -> App String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO UUID -> App UUID
forall a. IO a -> App a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO UUID
UUID.nextRandom
      Response
before <- Value -> App Response
forall user.
(HasCallStack, MakesValue user) =>
user -> App Response
getSelf Value
mem1
      App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse (Value -> PutSelf -> App Response
forall caller.
(HasCallStack, MakesValue caller) =>
caller -> PutSelf -> App Response
putSelf Value
mem1 PutSelf
forall a. Default a => a
def {name = Just someDisplayName}) ((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
"managed-by-scim"
      Response
after <- Value -> App Response
forall user.
(HasCallStack, MakesValue user) =>
user -> App Response
getSelf Value
mem1
      App () -> App ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (App () -> App ()) -> App () -> App ()
forall a b. (a -> b) -> a -> b
$ (Response
before.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"name") App Value -> App Value -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` (Response
after.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"name")
    TestUpdateSelfMode
TestUpdateEmailAddress -> do
      -- allowed unconditionally *for owner* (this is a bit off-topic: team members can't
      -- change their email addresses themselves under any conditions)
      String
someEmail <- (String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"@example.com") (String -> String) -> (UUID -> String) -> UUID -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UUID -> String
UUID.toString (UUID -> String) -> App UUID -> App String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO UUID -> App UUID
forall a. IO a -> App a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO UUID
UUID.nextRandom
      App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse (Value -> String -> App Response
forall user.
(HasCallStack, MakesValue user) =>
user -> String -> App Response
putSelfEmail Value
owner String
someEmail) ((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
    TestUpdateSelfMode
TestUpdateLocale -> do
      -- scim maps "User.preferredLanguage" to brig's locale field.  allowed unconditionally.
      -- we try two languages to make sure it doesn't work because it's already the active
      -- locale.
      [String] -> (String -> App ()) -> App ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [String
"uk", String
"he"] ((String -> App ()) -> App ()) -> (String -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \String
someLocale ->
        App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse (Value -> String -> App Response
forall user.
(HasCallStack, MakesValue user) =>
user -> String -> App Response
putSelfLocale Value
mem1 String
someLocale) ((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

data TestUpdateSelfMode
  = TestUpdateDisplayName
  | TestUpdateEmailAddress
  | TestUpdateLocale
  deriving (TestUpdateSelfMode -> TestUpdateSelfMode -> Bool
(TestUpdateSelfMode -> TestUpdateSelfMode -> Bool)
-> (TestUpdateSelfMode -> TestUpdateSelfMode -> Bool)
-> Eq TestUpdateSelfMode
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TestUpdateSelfMode -> TestUpdateSelfMode -> Bool
== :: TestUpdateSelfMode -> TestUpdateSelfMode -> Bool
$c/= :: TestUpdateSelfMode -> TestUpdateSelfMode -> Bool
/= :: TestUpdateSelfMode -> TestUpdateSelfMode -> Bool
Eq, Int -> TestUpdateSelfMode -> String -> String
[TestUpdateSelfMode] -> String -> String
TestUpdateSelfMode -> String
(Int -> TestUpdateSelfMode -> String -> String)
-> (TestUpdateSelfMode -> String)
-> ([TestUpdateSelfMode] -> String -> String)
-> Show TestUpdateSelfMode
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: Int -> TestUpdateSelfMode -> String -> String
showsPrec :: Int -> TestUpdateSelfMode -> String -> String
$cshow :: TestUpdateSelfMode -> String
show :: TestUpdateSelfMode -> String
$cshowList :: [TestUpdateSelfMode] -> String -> String
showList :: [TestUpdateSelfMode] -> String -> String
Show, (forall x. TestUpdateSelfMode -> Rep TestUpdateSelfMode x)
-> (forall x. Rep TestUpdateSelfMode x -> TestUpdateSelfMode)
-> Generic TestUpdateSelfMode
forall x. Rep TestUpdateSelfMode x -> TestUpdateSelfMode
forall x. TestUpdateSelfMode -> Rep TestUpdateSelfMode x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. TestUpdateSelfMode -> Rep TestUpdateSelfMode x
from :: forall x. TestUpdateSelfMode -> Rep TestUpdateSelfMode x
$cto :: forall x. Rep TestUpdateSelfMode x -> TestUpdateSelfMode
to :: forall x. Rep TestUpdateSelfMode x -> TestUpdateSelfMode
Generic)

testActivateAccountWithPhoneV5 :: (HasCallStack) => App ()
testActivateAccountWithPhoneV5 :: HasCallStack => App ()
testActivateAccountWithPhoneV5 = do
  let dom :: Domain
dom = Domain
OwnDomain
  let phone :: String
phone = String
"+4912345678"
  let reqBody :: Value
reqBody = [Pair] -> Value
Aeson.object [String
"phone" String -> String -> Pair
forall a. ToJSON a => String -> a -> Pair
.= String
phone]
  Domain -> Value -> App Response
forall user target.
(HasCallStack, MakesValue user, MakesValue target) =>
user -> target -> App Response
activateUserV5 Domain
dom Value
reqBody App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
`bindResponse` \Response
resp -> do
    Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
400
    Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"label" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
"bad-request"

testMigratingPasswordHashingAlgorithm :: (HasCallStack) => App ()
testMigratingPasswordHashingAlgorithm :: HasCallStack => App ()
testMigratingPasswordHashingAlgorithm = do
  let argon2idOpts :: Value
argon2idOpts =
        [Pair] -> Value
object
          [ String
"algorithm" String -> String -> Pair
forall a. ToJSON a => String -> a -> Pair
.= String
"argon2id",
            String
"iterations" String -> Int -> Pair
forall a. ToJSON a => String -> a -> Pair
.= (Int
1 :: Int),
            String
"memory" String -> Int -> Pair
forall a. ToJSON a => String -> a -> Pair
.= (Int
128 :: Int),
            String
"parallelism" String -> Int -> Pair
forall a. ToJSON a => String -> a -> Pair
.= (Int
1 :: Int)
          ]
      cfgArgon2id :: ServiceOverrides
cfgArgon2id =
        ServiceOverrides
forall a. Default a => a
def
          { brigCfg = setField "settings.setPasswordHashingOptions" argon2idOpts,
            galleyCfg = setField "settings.passwordHashingOptions" argon2idOpts
          }
      cfgScrypt :: ServiceOverrides
cfgScrypt =
        ServiceOverrides
forall a. Default a => a
def
          { brigCfg = setField "settings.setPasswordHashingOptions.algorithm" "scrypt",
            galleyCfg = setField "settings.passwordHashingOptions.algorithm" "scrypt"
          }
  ResourcePool BackendResource
resourcePool <- (Env -> ResourcePool BackendResource)
-> App (ResourcePool BackendResource)
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (.resourcePool)
  Codensity App [BackendResource]
-> forall b. ([BackendResource] -> App b) -> App b
forall k (m :: k -> *) a.
Codensity m a -> forall (b :: k). (a -> m b) -> m b
runCodensity (Int
-> ResourcePool BackendResource -> Codensity App [BackendResource]
forall (m :: * -> *) a.
(Ord a, MonadIO m, MonadMask m, HasCallStack) =>
Int -> ResourcePool a -> Codensity m [a]
acquireResources Int
1 ResourcePool BackendResource
resourcePool) (([BackendResource] -> App ()) -> App ())
-> ([BackendResource] -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \[BackendResource
testBackend] -> do
    let domain :: String
domain = BackendResource
testBackend.berDomain
    String
email1 <- App String
randomEmail
    String
password1 <- Int -> App String
randomString Int
20

    String
email2 <- App String
randomEmail
    String
password2 <- Int -> App String
randomString Int
20

    Codensity App String -> forall b. (String -> App b) -> App b
forall k (m :: k -> *) a.
Codensity m a -> forall (b :: k). (a -> m b) -> m b
runCodensity (BackendResource -> ServiceOverrides -> Codensity App String
startDynamicBackend BackendResource
testBackend ServiceOverrides
cfgScrypt) ((String -> App ()) -> App ()) -> (String -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \String
_ -> do
      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
$ String -> CreateUser -> App Value
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> CreateUser -> App Value
randomUser String
domain (CreateUser
forall a. Default a => a
def {email = Just email1, password = Just password1})
      String -> String -> String -> App Response
forall domain_.
(HasCallStack, MakesValue domain_) =>
domain_ -> String -> String -> App Response
login String
domain String
email1 String
password1 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

    Codensity App String -> forall b. (String -> App b) -> App b
forall k (m :: k -> *) a.
Codensity m a -> forall (b :: k). (a -> m b) -> m b
runCodensity (BackendResource -> ServiceOverrides -> Codensity App String
startDynamicBackend BackendResource
testBackend ServiceOverrides
cfgArgon2id) ((String -> App ()) -> App ()) -> (String -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \String
_ -> do
      String -> String -> String -> App Response
forall domain_.
(HasCallStack, MakesValue domain_) =>
domain_ -> String -> String -> App Response
login String
domain String
email1 String
password1 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

      -- Create second user to ensure that we're testing migrating back. This is
      -- not really needed because the login above rehashes the password, but it
      -- makes the test clearer.
      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
$ String -> CreateUser -> App Value
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> CreateUser -> App Value
randomUser String
domain (CreateUser
forall a. Default a => a
def {email = Just email2, password = Just password2})
      String -> String -> String -> App Response
forall domain_.
(HasCallStack, MakesValue domain_) =>
domain_ -> String -> String -> App Response
login String
domain String
email2 String
password2 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

    -- Check that both users can still login with Scrypt in case the operator
    -- wants to rollback the config.
    Codensity App String -> forall b. (String -> App b) -> App b
forall k (m :: k -> *) a.
Codensity m a -> forall (b :: k). (a -> m b) -> m b
runCodensity (BackendResource -> ServiceOverrides -> Codensity App String
startDynamicBackend BackendResource
testBackend ServiceOverrides
cfgScrypt) ((String -> App ()) -> App ()) -> (String -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \String
_ -> do
      String -> String -> String -> App Response
forall domain_.
(HasCallStack, MakesValue domain_) =>
domain_ -> String -> String -> App Response
login String
domain String
email1 String
password1 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 -> String -> String -> App Response
forall domain_.
(HasCallStack, MakesValue domain_) =>
domain_ -> String -> String -> App Response
login String
domain String
email2 String
password2 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