module Test.Provider where

import API.Brig
import API.BrigInternal
import qualified API.Cargohold as Cargohold
import API.Common
import qualified API.Nginz as Nginz
import Data.String.Conversions (cs)
import SetupHelpers
import Testlib.Prelude

testProviderUploadAsset :: (HasCallStack) => App ()
testProviderUploadAsset :: HasCallStack => App ()
testProviderUploadAsset = 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
provider <- Value -> NewProvider -> App Value
forall user.
(HasCallStack, MakesValue user) =>
user -> NewProvider -> App Value
setupProvider Value
alice NewProvider
forall a. Default a => a
def {newProviderPassword = Just defPassword}
  String
providerEmail <- Value
provider Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"email" 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
pid <- Value
provider Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"id" App Value -> (App Value -> App String) -> App String
forall a b. a -> (a -> b) -> b
& App Value -> App String
forall a. (HasCallStack, MakesValue a) => a -> App String
asString
  -- test cargohold API
  App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse (Domain -> String -> String -> App Response
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> String -> String -> App Response
Cargohold.uploadProviderAsset Domain
OwnDomain String
pid String
"profile pic") ((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
  ByteString
cookie <-
    Domain -> String -> String -> App Response
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> String -> String -> App Response
loginProvider Domain
OwnDomain String
providerEmail String
defPassword App Response -> (Response -> App ByteString) -> App ByteString
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
      let hs :: [Header]
hs = Response -> [Header]
headers Response
resp
          setCookieHeader :: HeaderName
setCookieHeader = String -> HeaderName
forall a. IsString a => String -> a
fromString String
"Set-Cookie"
      ByteString -> App ByteString
forall a. a -> App a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ByteString -> App ByteString)
-> ([Header] -> ByteString) -> [Header] -> App ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe ByteString -> ByteString
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe ByteString -> ByteString)
-> ([Header] -> Maybe ByteString) -> [Header] -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Header -> Maybe ByteString) -> [Header] -> Maybe ByteString
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (\(HeaderName
k, ByteString
v) -> Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (HeaderName
k HeaderName -> HeaderName -> Bool
forall a. Eq a => a -> a -> Bool
== HeaderName
setCookieHeader) Maybe () -> ByteString -> Maybe ByteString
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> ByteString
v) ([Header] -> App ByteString) -> [Header] -> App ByteString
forall a b. (a -> b) -> a -> b
$ [Header]
hs

  -- test Nginz API
  App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse (Domain -> String -> String -> App Response
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> String -> String -> App Response
Nginz.uploadProviderAsset Domain
OwnDomain (ByteString -> String
forall a b. ConvertibleStrings a b => a -> b
cs ByteString
cookie) String
"another profile pic") ((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

testProviderPasswordReset :: (HasCallStack) => App ()
testProviderPasswordReset :: HasCallStack => App ()
testProviderPasswordReset = do
  ServiceOverrides -> (HasCallStack => String -> App ()) -> App ()
forall a.
HasCallStack =>
ServiceOverrides -> (HasCallStack => String -> App a) -> App a
withModifiedBackend
    ServiceOverrides
forall a. Default a => a
def
      { brigCfg =
          -- Disable password hashing rate limiting, so we can create enable services quickly
          setField @_ @Int "optSettings.setPasswordHashingRateLimit.userLimit.inverseRate" 0
      }
    ((HasCallStack => String -> App ()) -> App ())
-> (HasCallStack => String -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \String
domain -> do
      Value
provider <- String -> NewProvider -> App Value
forall user.
(HasCallStack, MakesValue user) =>
user -> NewProvider -> App Value
setupProvider String
domain NewProvider
forall a. Default a => a
def {newProviderPassword = Just defPassword}
      String
email <- 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
provider Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"email"
      String -> String -> App Response
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> String -> App Response
requestProviderPasswordResetCode String
domain String
email 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
resetCode <- String -> String -> App Response
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> String -> App Response
getProviderPasswordResetCodeInternal String
domain String
email 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 -> Value -> String -> App Response
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> Value -> String -> App Response
completeProviderPasswordReset String
domain Value
resetCode 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
409
        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
"password-must-differ"

      String -> Value -> String -> App Response
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> Value -> String -> App Response
completeProviderPasswordReset String
domain Value
resetCode String
"shiny-new-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 => Response -> App ()
Response -> App ()
assertSuccess
      String -> String -> String -> App Response
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> String -> String -> App Response
loginProvider String
domain String
email String
"shiny-new-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 => Response -> App ()
Response -> App ()
assertSuccess
      String -> String -> String -> App Response
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> String -> String -> App Response
loginProvider String
domain String
email 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
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
"invalid-credentials"

testProviderPasswordResetAfterEmailUpdate :: (HasCallStack) => App ()
testProviderPasswordResetAfterEmailUpdate :: HasCallStack => App ()
testProviderPasswordResetAfterEmailUpdate = do
  ServiceOverrides -> (HasCallStack => String -> App ()) -> App ()
forall a.
HasCallStack =>
ServiceOverrides -> (HasCallStack => String -> App a) -> App a
withModifiedBackend
    ServiceOverrides
forall a. Default a => a
def
      { brigCfg =
          -- Disable password hashing rate limiting, so we can create enable services quickly
          setField @_ @Int "optSettings.setPasswordHashingRateLimit.userLimit.inverseRate" 0
      }
    ((HasCallStack => String -> App ()) -> App ())
-> (HasCallStack => String -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \String
domain -> do
      Value
provider <- String -> NewProvider -> App Value
forall user.
(HasCallStack, MakesValue user) =>
user -> NewProvider -> App Value
setupProvider String
domain NewProvider
forall a. Default a => a
def {newProviderPassword = Just defPassword}
      String
origEmail <- 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
provider Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"email"
      String
pid <- 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
provider Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"id"
      String
newEmail <- App String
randomEmail
      String -> String -> App Response
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> String -> App Response
requestProviderPasswordResetCode String
domain String
origEmail 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
requestProviderEmailUpdateCode String
domain String
pid String
newEmail 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
passwordResetCode <- String -> String -> App Response
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> String -> App Response
getProviderPasswordResetCodeInternal String
domain String
origEmail 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
emailUpdateKeyCodePair <- String -> String -> App Response
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> String -> App Response
getProviderActivationCodeInternal String
domain String
newEmail 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
emailUpdateKey <- 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
emailUpdateKeyCodePair Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"key"
      String
emailUpdateCode <- 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
emailUpdateKeyCodePair Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"code"

      String -> String -> String -> App ()
forall dom.
(HasCallStack, MakesValue dom) =>
dom -> String -> String -> App ()
activateProvider String
domain String
emailUpdateKey String
emailUpdateCode

      String -> Value -> String -> App Response
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> Value -> String -> App Response
completeProviderPasswordReset String
domain Value
passwordResetCode String
"shiny-new-password" 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
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
"invalid-code"

      String -> String -> String -> App Response
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> String -> String -> App Response
loginProvider String
domain String
origEmail 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
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
"invalid-credentials"
      String -> String -> String -> App Response
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> String -> String -> App Response
loginProvider String
domain String
newEmail 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 -> String -> App Response
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> String -> App Response
requestProviderPasswordResetCode String
domain String
newEmail 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
newPasswordResetCode <- String -> String -> App Response
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> String -> App Response
getProviderPasswordResetCodeInternal String
domain String
newEmail 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 -> Value -> String -> App Response
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> Value -> String -> App Response
completeProviderPasswordReset String
domain Value
newPasswordResetCode String
"shiny-new-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 => Response -> App ()
Response -> App ()
assertSuccess
      String -> String -> String -> App Response
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> String -> String -> App Response
loginProvider String
domain String
newEmail String
"shiny-new-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 => Response -> App ()
Response -> App ()
assertSuccess

testProviderSearchWhitelist :: (HasCallStack) => App ()
testProviderSearchWhitelist :: HasCallStack => App ()
testProviderSearchWhitelist =
  ServiceOverrides -> (HasCallStack => String -> App ()) -> App ()
forall a.
HasCallStack =>
ServiceOverrides -> (HasCallStack => String -> App a) -> App a
withModifiedBackend
    ServiceOverrides
forall a. Default a => a
def
      { brigCfg =
          -- Disable password hashing rate limiting, so we can create enable services quickly
          setField @_ @Int "optSettings.setPasswordHashingRateLimit.userLimit.inverseRate" 0
      }
    ((HasCallStack => String -> App ()) -> App ())
-> (HasCallStack => String -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \String
domain -> do
      (Value
owner, String
tid, [Value
user]) <- String -> Int -> App (Value, String, [Value])
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> Int -> App (Value, String, [Value])
createTeam String
domain Int
2
      Value
provider <- Value -> NewProvider -> App Value
forall user.
(HasCallStack, MakesValue user) =>
user -> NewProvider -> App Value
setupProvider Value
owner NewProvider
forall a. Default a => a
def {newProviderPassword = Just defPassword}
      String
pid <- 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
provider Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"id"
      String
namePrefix <- Int -> App String
randomString Int
10

      [Value]
services <-
        [(String, [String])]
-> ((String, [String]) -> App Value) -> App [Value]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM (String -> [(String, [String])]
taggedServiceNames String
namePrefix) (((String, [String]) -> App Value) -> App [Value])
-> ((String, [String]) -> App Value) -> App [Value]
forall a b. (a -> b) -> a -> b
$ \(String
name, [String]
tags) -> do
          String -> Value -> String -> String -> NewService -> App Value
forall domain user.
(MakesValue domain, MakesValue user) =>
domain -> user -> String -> String -> NewService -> App Value
createAndEnableService String
domain Value
owner String
tid String
pid NewService
forall a. Default a => a
def {newServiceName = name, newServiceTags = tags}

      [Value]
allServiceIds <- (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 -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"id") [Value]
services

      -- Searching with the common prefix shows all of them
      Value -> String -> Maybe String -> Bool -> Int -> App Response
forall user.
MakesValue user =>
user -> String -> Maybe String -> Bool -> Int -> App Response
listTeamServiceProfilesByPrefix Value
user String
tid (String -> Maybe String
forall a. a -> Maybe a
Just String
namePrefix) Bool
False Int
20 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 -> App Value)
-> MakesValue (App Value) => App Value -> App [Value]
forall b a.
HasCallStack =>
(Value -> App b) -> MakesValue a => a -> App [b]
asListOf (Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"id") (Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"services") App [Value] -> [Value] -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` [Value]
allServiceIds

      -- Searching without filtering returns all of them because all are enabled
      Value -> String -> Maybe String -> Bool -> Int -> App Response
forall user.
MakesValue user =>
user -> String -> Maybe String -> Bool -> Int -> App Response
listTeamServiceProfilesByPrefix Value
user String
tid (String -> Maybe String
forall a. a -> Maybe a
Just String
namePrefix) Bool
True Int
20 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 -> App Value)
-> MakesValue (App Value) => App Value -> App [Value]
forall b a.
HasCallStack =>
(Value -> App b) -> MakesValue a => a -> App [b]
asListOf (Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"id") (Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"services") App [Value] -> [Value] -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` [Value]
allServiceIds

      -- Search should yield services ordered by named
      Value
zerosPrefixedService <- do
        String
serviceSuffix <- Int -> App String
randomString Int
10
        String -> Value -> String -> String -> NewService -> App Value
forall domain user.
(MakesValue domain, MakesValue user) =>
domain -> user -> String -> String -> NewService -> App Value
createAndEnableService String
domain Value
owner String
tid String
pid NewService
forall a. Default a => a
def {newServiceName = "0000000000|" <> serviceSuffix, newServiceTags = ["social"]}
      Value -> String -> Maybe String -> Bool -> Int -> App Response
forall user.
MakesValue user =>
user -> String -> Maybe String -> Bool -> Int -> App Response
listTeamServiceProfilesByPrefix Value
user String
tid Maybe String
forall a. Maybe a
Nothing Bool
True Int
20 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
firstServiceId <- (Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"id") (Value -> App Value) -> ([Value] -> Value) -> [Value] -> App Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Value] -> Value
forall a. HasCallStack => [a] -> a
head ([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
"services")
        Value
firstServiceId Value -> App Value -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` (Value
zerosPrefixedService Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"id")

      -- Search by exact name yields only one service
      [Value] -> (Value -> App ()) -> App ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (Int -> [Value] -> [Value]
forall a. Int -> [a] -> [a]
take Int
3 [Value]
services) ((Value -> App ()) -> App ()) -> (Value -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \Value
service -> do
        String
name <- 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
service Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"name"
        Value -> String -> Maybe String -> Bool -> Int -> App Response
forall user.
MakesValue user =>
user -> String -> Maybe String -> Bool -> Int -> App Response
listTeamServiceProfilesByPrefix Value
user String
tid (String -> Maybe String
forall a. a -> Maybe a
Just String
name) Bool
False Int
20 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
"has_more" App Value -> Bool -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` Bool
False
          (Value -> App Value)
-> MakesValue (App Value) => App Value -> App [Value]
forall b a.
HasCallStack =>
(Value -> App b) -> MakesValue a => a -> App [b]
asListOf (Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"name") (Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"services") App [Value] -> [String] -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` [String
name]

      -- Search by prefix, case insensitve, doesn't asciify special characters
      -- like name search
      [(String, String)] -> ((String, String) -> App ()) -> App ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [(String
"Bjø", String
"Bjørn"), (String
"Bjo", String
"bjorn"), (String
"chris", String
"CHRISTMAS")] (((String, String) -> App ()) -> App ())
-> ((String, String) -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \(String
searchTerm, String
hardcodedName) ->
        Value -> String -> Maybe String -> Bool -> Int -> App Response
forall user.
MakesValue user =>
user -> String -> Maybe String -> Bool -> Int -> App Response
listTeamServiceProfilesByPrefix Value
user String
tid (String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String) -> String -> Maybe String
forall a b. (a -> b) -> a -> b
$ String
namePrefix String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"|" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
searchTerm) Bool
False Int
20 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
"has_more" App Value -> Bool -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` Bool
False
          (Value -> App Value)
-> MakesValue (App Value) => App Value -> App [Value]
forall b a.
HasCallStack =>
(Value -> App b) -> MakesValue a => a -> App [b]
asListOf (Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"name") (Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"services") App [Value] -> [String] -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` [(String
namePrefix String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"|" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
hardcodedName)]

      -- Search works even after changing name
      let alphaService :: Value
alphaService = [Value] -> Value
forall a. HasCallStack => [a] -> a
head [Value]
services
          newAlphaName :: String
newAlphaName = String
namePrefix String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"|" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"NotAlphaAnyMore"
      Value
alphaServiceId <- Value
alphaService Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"id"
      String
-> String -> Value -> Maybe String -> Maybe String -> App Response
forall dom serviceId.
(HasCallStack, MakesValue dom, MakesValue serviceId) =>
dom
-> String
-> serviceId
-> Maybe String
-> Maybe String
-> App Response
updateService String
domain String
pid Value
alphaServiceId Maybe String
forall a. Maybe a
Nothing (String -> Maybe String
forall a. a -> Maybe a
Just String
newAlphaName)
        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 -> String -> Maybe String -> Bool -> Int -> App Response
forall user.
MakesValue user =>
user -> String -> Maybe String -> Bool -> Int -> App Response
listTeamServiceProfilesByPrefix Value
user String
tid (String -> Maybe String
forall a. a -> Maybe a
Just String
newAlphaName) Bool
False Int
20 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
"services.0.id" App Value -> Value -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` Value
alphaServiceId
        Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"services.0.name" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
newAlphaName

createAndEnableService ::
  (MakesValue domain, MakesValue user) =>
  domain ->
  user ->
  String ->
  String ->
  NewService ->
  App Value
createAndEnableService :: forall domain user.
(MakesValue domain, MakesValue user) =>
domain -> user -> String -> String -> NewService -> App Value
createAndEnableService domain
domain user
teamAdmin String
tid String
pid NewService
newSvc = do
  String
serviceId <- (domain -> String -> NewService -> App Value
forall dom.
(HasCallStack, MakesValue dom) =>
dom -> String -> NewService -> App Value
newService domain
domain String
pid NewService
newSvc) App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"id" App Value -> (App Value -> App String) -> App String
forall a b. a -> (a -> b) -> b
& App Value -> App String
forall a. (HasCallStack, MakesValue a) => a -> App String
asString
  -- serviceId <- asString $ service %. "id"
  domain -> String -> String -> Value -> App Response
forall domain conn.
(HasCallStack, MakesValue domain, MakesValue conn) =>
domain -> String -> String -> conn -> App Response
updateServiceConn domain
domain String
pid String
serviceId ([Pair] -> Value
object [String
"password" String -> String -> Pair
forall a. ToJSON a => String -> a -> Pair
.= String
defPassword, String
"enabled" String -> Bool -> Pair
forall a. ToJSON a => String -> a -> Pair
.= Bool
True])
    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
  user -> String -> Value -> App Response
forall user tid update.
(HasCallStack, MakesValue user, MakesValue tid,
 MakesValue update) =>
user -> tid -> update -> App Response
postServiceWhitelist user
teamAdmin String
tid ([Pair] -> Value
object [String
"id" String -> String -> Pair
forall a. ToJSON a => String -> a -> Pair
.= String
serviceId, String
"provider" String -> String -> Pair
forall a. ToJSON a => String -> a -> Pair
.= String
pid, String
"whitelisted" String -> Bool -> Pair
forall a. ToJSON a => String -> a -> Pair
.= Bool
True])
    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
  domain -> String -> String -> App Response
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> String -> String -> App Response
getService domain
domain String
pid String
serviceId 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

-- | A list of 20 services ordered alphabetically, all having names that begin
-- with the given prefix.
--
-- NB: in some of the tests above, we depend on the fact that there are exactly
-- 20 services here and the fact that they are ordered alphabetically.
taggedServiceNames :: String -> [(String, [String])]
taggedServiceNames :: String -> [(String, [String])]
taggedServiceNames String
prefix =
  [ (String -> String
prefixed String
"Alpha", [String
"social", String
"quiz", String
"business"]),
    (String -> String
prefixed String
"Beta", [String
"social", String
"music", String
"lifestyle"]),
    (String -> String
prefixed String
"bjorn", [String
"social", String
"quiz", String
"travel"]),
    (String -> String
prefixed String
"Bjørn", [String
"social", String
"music", String
"lifestyle"]),
    (String -> String
prefixed String
"CHRISTMAS", [String
"social", String
"quiz", String
"weather"]),
    (String -> String
prefixed String
"Delta", [String
"social", String
"music", String
"lifestyle"]),
    (String -> String
prefixed String
"Epsilon", [String
"social", String
"quiz", String
"business"]),
    (String -> String
prefixed String
"Freer", [String
"social", String
"music", String
"lifestyle"]),
    (String -> String
prefixed String
"Gamma", [String
"social", String
"quiz", String
"weather"]),
    (String -> String
prefixed String
"Gramma", [String
"social", String
"music", String
"lifestyle"]),
    (String -> String
prefixed String
"Hera", [String
"social", String
"quiz", String
"travel"]),
    (String -> String
prefixed String
"Io", [String
"social", String
"music", String
"lifestyle"]),
    (String -> String
prefixed String
"Jojo", [String
"social", String
"quiz", String
"weather"]),
    (String -> String
prefixed String
"Kuba", [String
"social", String
"music", String
"lifestyle"]),
    (String -> String
prefixed String
"Lawn", [String
"social", String
"quiz", String
"travel"]),
    (String -> String
prefixed String
"Mango", [String
"social", String
"music", String
"lifestyle"]),
    (String -> String
prefixed String
"North", [String
"social", String
"quiz", String
"weather"]),
    (String -> String
prefixed String
"Yak", [String
"social", String
"music", String
"lifestyle"]),
    (String -> String
prefixed String
"Zeta", [String
"social", String
"quiz", String
"travel"]),
    (String -> String
prefixed String
"Zulu", [String
"social", String
"music", String
"lifestyle"])
  ]
  where
    prefixed :: String -> String
prefixed String
n = (String
prefix String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"|" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
n)