{-# OPTIONS_GHC -Wno-ambiguous-fields #-}
{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}
module SetupHelpers where
import API.Brig
import API.BrigInternal
import API.Cargohold
import API.Common
import API.Galley
import API.GalleyInternal (legalholdWhitelistTeam)
import Control.Monad.Reader
import Crypto.Random (getRandomBytes)
import Data.Aeson hiding ((.=))
import qualified Data.Aeson.Types as Aeson
import qualified Data.ByteString.Base16 as Base16
import qualified Data.ByteString.Base64.URL as B64Url
import Data.ByteString.Char8 (unpack)
import qualified Data.CaseInsensitive as CI
import Data.Default
import Data.Function
import Data.String.Conversions (cs)
import qualified Data.Text as Text
import Data.Text.Encoding (decodeUtf8)
import Data.UUID.V1 (nextUUID)
import Data.UUID.V4 (nextRandom)
import Data.Vector (fromList)
import GHC.Stack
import Testlib.MockIntegrationService (mkLegalHoldSettings)
import Testlib.Prelude
randomUser :: (HasCallStack, MakesValue domain) => domain -> CreateUser -> App Value
randomUser :: forall domain.
(HasCallStack, MakesValue domain) =>
domain -> CreateUser -> App Value
randomUser domain
domain CreateUser
cu = App Response -> (Response -> App Value) -> App Value
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
domain CreateUser
cu) ((Response -> App Value) -> App Value)
-> (Response -> App Value) -> App Value
forall a b. (a -> b) -> a -> b
$ \Response
resp -> do
Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
201
Response
resp.json
deleteUser :: (HasCallStack, MakesValue user) => user -> App ()
deleteUser :: forall user. (HasCallStack, MakesValue user) => user -> App ()
deleteUser user
user = App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse (user -> App Response
forall user.
(HasCallStack, MakesValue user) =>
user -> App Response
API.Brig.deleteUser user
user) ((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
createTeam :: (HasCallStack, MakesValue domain) => domain -> Int -> App (Value, String, [Value])
createTeam :: forall domain.
(HasCallStack, MakesValue domain) =>
domain -> Int -> App (Value, String, [Value])
createTeam domain
domain Int
memberCount = do
Value
owner <- domain -> CreateUser -> App Response
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> CreateUser -> App Response
createUser domain
domain CreateUser
forall a. Default a => a
def {team = True} 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
tid <- Value
owner Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"team" 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]
members <- [Int] -> (Int -> App Value) -> App [Value]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for [Int
2 .. Int
memberCount] ((Int -> App Value) -> App [Value])
-> (Int -> App Value) -> App [Value]
forall a b. (a -> b) -> a -> b
$ \Int
_ -> Value -> CreateTeamMember -> App Value
forall inviter.
(HasCallStack, MakesValue inviter) =>
inviter -> CreateTeamMember -> App Value
createTeamMember Value
owner CreateTeamMember
forall a. Default a => a
def
(Value, String, [Value]) -> App (Value, String, [Value])
forall a. a -> App a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Value
owner, String
tid, [Value]
members)
data CreateTeamMember = CreateTeamMember
{ CreateTeamMember -> String
role :: String
}
instance Default CreateTeamMember where
def :: CreateTeamMember
def = CreateTeamMember {$sel:role:CreateTeamMember :: String
role = String
"member"}
createTeamMember ::
(HasCallStack, MakesValue inviter) =>
inviter ->
CreateTeamMember ->
App Value
createTeamMember :: forall inviter.
(HasCallStack, MakesValue inviter) =>
inviter -> CreateTeamMember -> App Value
createTeamMember inviter
inviter CreateTeamMember
args = do
String
newUserEmail <- App String
randomEmail
Value
invitation <-
inviter -> PostInvitation -> App Response
forall user.
(HasCallStack, MakesValue user) =>
user -> PostInvitation -> App Response
postInvitation
inviter
inviter
PostInvitation
forall a. Default a => a
def
{ email = Just newUserEmail,
role = Just args.role
}
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
invitationCode <-
(inviter -> Value -> App Response
forall user inv.
(HasCallStack, MakesValue user, MakesValue inv) =>
user -> inv -> App Response
getInvitationCode inviter
inviter Value
invitation 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
"code"
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
let body :: AddUser
body =
AddUser
{ $sel:name:AddUser :: Maybe String
name = String -> Maybe String
forall a. a -> Maybe a
Just String
newUserEmail,
$sel:email:AddUser :: Maybe String
email = String -> Maybe String
forall a. a -> Maybe a
Just String
newUserEmail,
$sel:password:AddUser :: Maybe String
password = String -> Maybe String
forall a. a -> Maybe a
Just String
defPassword,
$sel:teamCode:AddUser :: Maybe String
teamCode = String -> Maybe String
forall a. a -> Maybe a
Just String
invitationCode
}
inviter -> AddUser -> App Response
forall dom.
(HasCallStack, MakesValue dom) =>
dom -> AddUser -> App Response
addUser inviter
inviter AddUser
body 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
connectTwoUsers ::
( HasCallStack,
MakesValue alice,
MakesValue bob
) =>
alice ->
bob ->
App ()
connectTwoUsers :: forall alice bob.
(HasCallStack, MakesValue alice, MakesValue bob) =>
alice -> bob -> App ()
connectTwoUsers alice
alice bob
bob = do
alice -> bob -> App Response
forall user inv.
(HasCallStack, MakesValue user, MakesValue inv) =>
user -> inv -> App Response
postConnection alice
alice bob
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
bob -> alice -> String -> App Response
forall userFrom userTo status.
(HasCallStack, MakesValue userFrom, MakesValue userTo,
MakesValue status) =>
userFrom -> userTo -> status -> App Response
putConnection bob
bob alice
alice String
"accepted" 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
connectUsers :: (HasCallStack, MakesValue usr) => [usr] -> App ()
connectUsers :: forall usr. (HasCallStack, MakesValue usr) => [usr] -> App ()
connectUsers [usr]
users = ((usr, usr) -> App ()) -> [(usr, usr)] -> App ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ ((usr -> usr -> App ()) -> (usr, usr) -> App ()
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry usr -> usr -> App ()
forall alice bob.
(HasCallStack, MakesValue alice, MakesValue bob) =>
alice -> bob -> App ()
connectTwoUsers) ([(usr, usr)] -> App ()) -> [(usr, usr)] -> App ()
forall a b. (a -> b) -> a -> b
$ do
[usr]
t <- [usr] -> [[usr]]
forall a. [a] -> [[a]]
tails [usr]
users
(usr
a, [usr]
others) <- Maybe (usr, [usr]) -> [(usr, [usr])]
forall a. Maybe a -> [a]
maybeToList ([usr] -> Maybe (usr, [usr])
forall a. [a] -> Maybe (a, [a])
uncons [usr]
t)
usr
b <- [usr]
others
(usr, usr) -> [(usr, usr)]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (usr
a, usr
b)
assertConnection :: (HasCallStack, MakesValue alice, MakesValue bob) => alice -> bob -> String -> App ()
assertConnection :: forall alice bob.
(HasCallStack, MakesValue alice, MakesValue bob) =>
alice -> bob -> String -> App ()
assertConnection alice
alice bob
bob String
status =
alice -> bob -> App Response
forall user inv.
(HasCallStack, MakesValue user, MakesValue inv) =>
user -> inv -> App Response
getConnection alice
alice bob
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
createAndConnectUsers :: (HasCallStack, MakesValue domain) => [domain] -> App [Value]
createAndConnectUsers :: forall domain.
(HasCallStack, MakesValue domain) =>
[domain] -> App [Value]
createAndConnectUsers [domain]
domains = do
[Value]
users <- [domain] -> (domain -> App Value) -> App [Value]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for [domain]
domains ((domain -> CreateUser -> App Value)
-> CreateUser -> domain -> App Value
forall a b c. (a -> b -> c) -> b -> a -> c
flip domain -> CreateUser -> App Value
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> CreateUser -> App Value
randomUser CreateUser
forall a. Default a => a
def)
[Value] -> App ()
forall usr. (HasCallStack, MakesValue usr) => [usr] -> App ()
connectUsers [Value]
users
[Value] -> App [Value]
forall a. a -> App a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [Value]
users
createUsers :: (HasCallStack, MakesValue domain) => [domain] -> App [Value]
createUsers :: forall domain.
(HasCallStack, MakesValue domain) =>
[domain] -> App [Value]
createUsers [domain]
domains = [domain] -> (domain -> App Value) -> App [Value]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for [domain]
domains ((domain -> CreateUser -> App Value)
-> CreateUser -> domain -> App Value
forall a b c. (a -> b -> c) -> b -> a -> c
flip domain -> CreateUser -> App Value
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> CreateUser -> App Value
randomUser CreateUser
forall a. Default a => a
def)
getAllConvs :: (HasCallStack, MakesValue u) => u -> App [Value]
getAllConvs :: forall u. (HasCallStack, MakesValue u) => u -> App [Value]
getAllConvs u
u = do
Value
page <- App Response -> (Response -> App Value) -> App Value
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse (u -> ListConversationIds -> App Response
forall user.
MakesValue user =>
user -> ListConversationIds -> App Response
listConversationIds u
u ListConversationIds
forall a. Default a => a
def) ((Response -> App Value) -> App Value)
-> (Response -> App Value) -> App Value
forall a b. (a -> b) -> a -> b
$ \Response
resp -> do
Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200
Response
resp.json
[Value]
ids <- Value
page Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"qualified_conversations" App Value -> (App Value -> App [Value]) -> App [Value]
forall a b. a -> (a -> b) -> b
& App Value -> App [Value]
forall u. (HasCallStack, MakesValue u) => u -> App [Value]
asList
Value
result <- App Response -> (Response -> App Value) -> App Value
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse (u -> [Value] -> App Response
forall user. MakesValue user => user -> [Value] -> App Response
listConversations u
u [Value]
ids) ((Response -> App Value) -> App Value)
-> (Response -> App Value) -> App Value
forall a b. (a -> b) -> a -> b
$ \Response
resp -> do
Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200
Response
resp.json
Value
result Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"found" App Value -> (App Value -> App [Value]) -> App [Value]
forall a b. a -> (a -> b) -> b
& App Value -> App [Value]
forall u. (HasCallStack, MakesValue u) => u -> App [Value]
asList
simpleMixedConversationSetup ::
(HasCallStack, MakesValue domain) =>
domain ->
App (Value, Value, Value)
simpleMixedConversationSetup :: forall domain.
(HasCallStack, MakesValue domain) =>
domain -> App (Value, Value, Value)
simpleMixedConversationSetup domain
secondDomain = do
(Value
alice, String
tid, [Value]
_) <- 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
secondDomain CreateUser
forall a. Default a => a
def
[Value] -> App ()
forall usr. (HasCallStack, MakesValue usr) => [usr] -> App ()
connectUsers [Value
alice, Value
bob]
Value
conv <-
Value -> CreateConv -> App Response
forall user.
(HasCallStack, MakesValue user) =>
user -> CreateConv -> App Response
postConversation Value
alice CreateConv
defProteus {qualifiedUsers = [bob], 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
App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse (Value -> Value -> String -> App Response
forall userFrom userTo status.
(HasCallStack, MakesValue userFrom, MakesValue userTo,
MakesValue status) =>
userFrom -> userTo -> status -> App Response
putConversationProtocol Value
bob Value
conv 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
200
(MLSState -> MLSState) -> App ()
modifyMLSState ((MLSState -> MLSState) -> App ())
-> (MLSState -> MLSState) -> App ()
forall a b. (a -> b) -> a -> b
$ \MLSState
mls -> MLSState
mls {protocol = MLSProtocolMixed}
Value
conv' <- Value -> Value -> App Response
forall user inv.
(HasCallStack, MakesValue user, MakesValue inv) =>
user -> inv -> App Response
getConversation Value
alice Value
conv 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, Value, Value) -> App (Value, Value, Value)
forall a. a -> App a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Value
alice, Value
bob, Value
conv')
supportMLS :: (HasCallStack, MakesValue u) => u -> App ()
supportMLS :: forall user. (HasCallStack, MakesValue user) => user -> App ()
supportMLS u
u = do
[String]
prots <- App Response -> (Response -> App [String]) -> App [String]
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse (u -> u -> App Response
forall user inv.
(HasCallStack, MakesValue user, MakesValue inv) =>
user -> inv -> App Response
getUserSupportedProtocols u
u u
u) ((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
200
[Value]
prots <- Response
resp.json App Value -> (App Value -> App [Value]) -> App [Value]
forall a b. a -> (a -> b) -> b
& App Value -> App [Value]
forall u. (HasCallStack, MakesValue u) => u -> App [Value]
asList
(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
asString [Value]
prots
let prots' :: [String]
prots' = String
"mls" String -> [String] -> [String]
forall a. a -> [a] -> [a]
: [String]
prots
App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse (u -> [String] -> App Response
forall user.
(HasCallStack, MakesValue user) =>
user -> [String] -> App Response
putUserSupportedProtocols u
u [String]
prots') ((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
addUserToTeam :: (HasCallStack, MakesValue u) => u -> App Value
addUserToTeam :: forall u. (HasCallStack, MakesValue u) => u -> App Value
addUserToTeam u
u = do
Value
inv <- u -> PostInvitation -> App Response
forall user.
(HasCallStack, MakesValue user) =>
user -> PostInvitation -> App Response
postInvitation u
u PostInvitation
forall a. Default a => a
def 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
email <- Value
inv 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
Value
resp <- u -> Value -> App Response
forall user inv.
(HasCallStack, MakesValue user, MakesValue inv) =>
user -> inv -> App Response
getInvitationCode u
u Value
inv 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
code <- Value
resp Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"code" 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
u -> AddUser -> App Response
forall dom.
(HasCallStack, MakesValue dom) =>
dom -> AddUser -> App Response
addUser u
u AddUser
forall a. Default a => a
def {email = Just email, teamCode = Just code} 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
createMLSOne2OnePartner ::
(MakesValue user, MakesValue domain, MakesValue convDomain, HasCallStack) =>
domain ->
user ->
convDomain ->
App Value
createMLSOne2OnePartner :: forall user domain convDomain.
(MakesValue user, MakesValue domain, MakesValue convDomain,
HasCallStack) =>
domain -> user -> convDomain -> App Value
createMLSOne2OnePartner domain
domain user
other convDomain
convDomain = App Value
loop
where
loop :: App Value
loop = do
Value
u <- domain -> CreateUser -> App Value
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> CreateUser -> App Value
randomUser domain
domain CreateUser
forall a. Default a => a
def
Value -> user -> App ()
forall alice bob.
(HasCallStack, MakesValue alice, MakesValue bob) =>
alice -> bob -> App ()
connectTwoUsers Value
u user
other
Int
apiVersion <- domain -> App Int
forall domain. MakesValue domain => domain -> App Int
getAPIVersionFor domain
domain
Value
conv <-
if Int
apiVersion Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
6
then user -> Value -> App Response
forall user inv.
(HasCallStack, MakesValue user, MakesValue inv) =>
user -> inv -> App Response
getMLSOne2OneConversation user
other Value
u 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
else user -> Value -> App Response
forall user inv.
(HasCallStack, MakesValue user, MakesValue inv) =>
user -> inv -> App Response
getMLSOne2OneConversation user
other Value
u 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 -> (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 -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"conversation")
String
desiredConvDomain <- convDomain -> App Value
forall a. (MakesValue a, HasCallStack) => a -> App Value
make convDomain
convDomain 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
actualConvDomain <- Value
conv Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"qualified_id.domain" 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
if String
desiredConvDomain String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
actualConvDomain
then Value -> App Value
forall a. a -> App a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Value
u
else App Value
loop
randomToken :: (HasCallStack) => App String
randomToken :: HasCallStack => App String
randomToken = ByteString -> String
unpack (ByteString -> String)
-> (ByteString -> ByteString) -> ByteString -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
B64Url.encode (ByteString -> String) -> App ByteString -> App String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO ByteString -> App ByteString
forall a. IO a -> App a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Int -> IO ByteString
forall byteArray. ByteArray byteArray => Int -> IO byteArray
forall (m :: * -> *) byteArray.
(MonadRandom m, ByteArray byteArray) =>
Int -> m byteArray
getRandomBytes Int
16)
data TokenLength = GCM | APNS
randomSnsToken :: (HasCallStack) => TokenLength -> App String
randomSnsToken :: HasCallStack => TokenLength -> App String
randomSnsToken = \case
TokenLength
GCM -> Int -> App String
mkTok Int
16
TokenLength
APNS -> Int -> App String
mkTok Int
32
where
mkTok :: Int -> App String
mkTok = (ByteString -> String) -> App ByteString -> App String
forall a b. (a -> b) -> App a -> App b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Text -> String
Text.unpack (Text -> String) -> (ByteString -> Text) -> ByteString -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
decodeUtf8 (ByteString -> Text)
-> (ByteString -> ByteString) -> ByteString -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
Base16.encode) (App ByteString -> App String)
-> (Int -> App ByteString) -> Int -> App String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> App ByteString
randomBytes
randomId :: (HasCallStack) => App String
randomId :: HasCallStack => App String
randomId = IO String -> App String
forall a. IO a -> App a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (UUID -> String
forall a. Show a => a -> String
show (UUID -> String) -> IO UUID -> IO String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO UUID
nextRandom)
randomUUIDv1 :: (HasCallStack) => App String
randomUUIDv1 :: HasCallStack => App String
randomUUIDv1 = IO String -> App String
forall a. IO a -> App a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (UUID -> String
forall a. Show a => a -> String
show (UUID -> String) -> (Maybe UUID -> UUID) -> Maybe UUID -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe UUID -> UUID
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe UUID -> String) -> IO (Maybe UUID) -> IO String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO (Maybe UUID)
nextUUID)
randomUserId :: (HasCallStack, MakesValue domain) => domain -> App Value
randomUserId :: forall u. (HasCallStack, MakesValue u) => u -> App Value
randomUserId domain
domain = do
Value
d <- domain -> App Value
forall a. (MakesValue a, HasCallStack) => a -> App Value
make domain
domain
String
uid <- App String
HasCallStack => App String
randomId
Value -> App Value
forall a. a -> App a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Value -> App Value) -> Value -> App Value
forall a b. (a -> b) -> a -> b
$ [Pair] -> Value
object [String
"id" String -> String -> Pair
forall a. ToJSON a => String -> a -> Pair
.= String
uid, String
"domain" String -> Value -> Pair
forall a. ToJSON a => String -> a -> Pair
.= Value
d]
withFederatingBackendsAllowDynamic :: (HasCallStack) => ((String, String, String) -> App a) -> App a
withFederatingBackendsAllowDynamic :: forall a.
HasCallStack =>
((String, String, String) -> App a) -> App a
withFederatingBackendsAllowDynamic (String, String, String) -> App a
k = do
let setFederationConfig :: Value -> App Value
setFederationConfig =
String -> String -> Value -> App Value
forall a b.
(HasCallStack, MakesValue a, ToJSON b) =>
String -> b -> a -> App Value
setField String
"optSettings.setFederationStrategy" String
"allowDynamic"
(Value -> App Value) -> (Value -> App Value) -> Value -> App Value
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> String -> Value -> Value -> App Value
forall a b.
(HasCallStack, MakesValue a, ToJSON b) =>
String -> b -> a -> App Value
setField String
"optSettings.setFederationDomainConfigsUpdateFreq" (Scientific -> Value
Aeson.Number Scientific
1)
[ServiceOverrides] -> ([String] -> App a) -> App a
forall a. [ServiceOverrides] -> ([String] -> App a) -> App a
startDynamicBackends
[ ServiceOverrides
forall a. Default a => a
def {brigCfg = setFederationConfig},
ServiceOverrides
forall a. Default a => a
def {brigCfg = setFederationConfig},
ServiceOverrides
forall a. Default a => a
def {brigCfg = setFederationConfig}
]
(([String] -> App a) -> App a) -> ([String] -> App a) -> App a
forall a b. (a -> b) -> a -> b
$ \[String
domainA, String
domainB, String
domainC] -> (String, String, String) -> App a
k (String
domainA, String
domainB, String
domainC)
createOne2OneConversation ::
(HasCallStack, MakesValue domain1, MakesValue domain2) =>
domain1 ->
domain2 ->
App (Value, Value, Value)
createOne2OneConversation :: forall domain1 domain2.
(HasCallStack, MakesValue domain1, MakesValue domain2) =>
domain1 -> domain2 -> App (Value, Value, Value)
createOne2OneConversation domain1
owningDomain domain2
otherDomain = do
Value
owningUser <- domain1 -> CreateUser -> App Value
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> CreateUser -> App Value
randomUser domain1
owningDomain CreateUser
forall a. Default a => a
def
Value
domainName <- Value
owningUser Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"qualified_id.domain"
let go :: App (Value, Value, Value)
go = do
Value
otherUser <- domain2 -> CreateUser -> App Value
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> CreateUser -> App Value
randomUser domain2
otherDomain CreateUser
forall a. Default a => a
def
Value
otherUserId <- Value
otherUser Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"qualified_id"
Value
conn <-
Value -> Value -> App Response
forall user inv.
(HasCallStack, MakesValue user, MakesValue inv) =>
user -> inv -> App Response
postConnection Value
owningUser Value
otherUser App Response -> (Response -> App Value) -> App Value
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
`bindResponse` \Response
resp -> do
Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
201
Value
payload <- Response
resp.json
Value
payload 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
"sent"
Value
payload Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"qualified_to" App Value -> Value -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` Value
otherUserId
Value -> App Value
forall a. a -> App a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Value
payload
Value
one2one <- Value
conn Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"qualified_conversation"
Value
one2oneDomain <- Value
one2one Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"domain"
if Value
domainName Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
== Value
one2oneDomain
then (Value, Value, Value) -> App (Value, Value, Value)
forall a. a -> App a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Value
owningUser, Value
otherUser, Value
one2one)
else Value -> App ()
forall user. (HasCallStack, MakesValue user) => user -> App ()
SetupHelpers.deleteUser Value
otherUser App () -> App (Value, Value, Value) -> App (Value, Value, Value)
forall a b. App a -> App b -> App b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> App (Value, Value, Value)
go
App (Value, Value, Value)
go
data One2OneConvState = Established | Connect
toConvType :: One2OneConvState -> Int
toConvType :: One2OneConvState -> Int
toConvType = \case
One2OneConvState
Established -> Int
2
One2OneConvState
Connect -> Int
3
getOne2OneConversation :: (HasCallStack) => Value -> Value -> One2OneConvState -> App Value
getOne2OneConversation :: HasCallStack => Value -> Value -> One2OneConvState -> App Value
getOne2OneConversation Value
user1 Value
user2 One2OneConvState
cnvState = do
[Value]
l <- Value -> App [Value]
forall u. (HasCallStack, MakesValue u) => u -> App [Value]
getAllConvs Value
user1
let isWith :: [Value] -> Value -> App Bool
isWith [Value]
users Value
c = do
Bool
t <- (Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== One2OneConvState -> Int
toConvType One2OneConvState
cnvState) (Int -> Bool) -> App Int -> App Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Value
c Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"type" App Value -> (App Value -> App Int) -> App Int
forall a b. a -> (a -> b) -> b
& App Value -> App Int
forall a. (HasCallStack, MakesValue a) => a -> App Int
asInt)
[Value]
others <- Value
c 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 u. (HasCallStack, MakesValue u) => u -> App [Value]
asList
[Value]
qIds <- [Value] -> (Value -> App Value) -> App [Value]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for [Value]
others (Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"qualified_id")
Bool -> App Bool
forall a. a -> App a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bool -> App Bool) -> Bool -> App Bool
forall a b. (a -> b) -> a -> b
$ [Value]
qIds [Value] -> [Value] -> Bool
forall a. Eq a => a -> a -> Bool
== [Value]
users Bool -> Bool -> Bool
&& Bool
t
[Value] -> Value
forall a. HasCallStack => [a] -> a
head ([Value] -> Value) -> App [Value] -> App Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Value -> App Bool) -> [Value] -> App [Value]
forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM ([Value] -> Value -> App Bool
isWith [Value
user2]) [Value]
l
setupProvider ::
( HasCallStack,
MakesValue user
) =>
user ->
NewProvider ->
App Value
setupProvider :: forall user.
(HasCallStack, MakesValue user) =>
user -> NewProvider -> App Value
setupProvider user
u np :: NewProvider
np@(NewProvider {String
Maybe String
newProviderName :: String
newProviderDesc :: String
newProviderEmail :: String
newProviderPassword :: Maybe String
newProviderUrl :: String
$sel:newProviderName:NewProvider :: NewProvider -> String
$sel:newProviderDesc:NewProvider :: NewProvider -> String
$sel:newProviderEmail:NewProvider :: NewProvider -> String
$sel:newProviderPassword:NewProvider :: NewProvider -> Maybe String
$sel:newProviderUrl:NewProvider :: NewProvider -> String
..}) = do
String
dom <- user -> App String
forall a. (HasCallStack, MakesValue a) => a -> App String
objDomain user
u
Value
provider <- user -> NewProvider -> App Value
forall provider user.
(HasCallStack, MakesValue provider, MakesValue user) =>
user -> provider -> App Value
newProvider user
u NewProvider
np
String
pass <- case Maybe String
newProviderPassword of
Maybe String
Nothing -> Value
provider Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"password" 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
Just String
pass -> String -> App String
forall a. a -> App a
forall (f :: * -> *) a. Applicative f => a -> f a
pure String
pass
(String
key, String
code) <- do
Value
pair <-
String -> String -> App Response
forall dom.
(HasCallStack, MakesValue dom) =>
dom -> String -> App Response
getProviderActivationCodeInternal String
dom String
newProviderEmail App Response -> (Response -> App Value) -> App Value
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
String
k <- Value
pair Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"key" 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
c <- Value
pair Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"code" 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, String) -> App (String, String)
forall a. a -> App a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (String
k, String
c)
String -> String -> String -> App ()
forall dom.
(HasCallStack, MakesValue dom) =>
dom -> String -> String -> App ()
activateProvider String
dom String
key String
code
String -> String -> String -> App ByteString
forall dom.
(HasCallStack, MakesValue dom) =>
dom -> String -> String -> App ByteString
loginProvider String
dom String
newProviderEmail String
pass App ByteString -> Value -> App Value
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Value
provider
setUpLHDevice ::
(HasCallStack, MakesValue tid, MakesValue owner, MakesValue uid) =>
tid ->
owner ->
uid ->
(String, Int) ->
App ()
setUpLHDevice :: forall tid owner uid.
(HasCallStack, MakesValue tid, MakesValue owner, MakesValue uid) =>
tid -> owner -> uid -> (String, Int) -> App ()
setUpLHDevice tid
tid owner
alice uid
bob (String, Int)
lhPort = do
tid -> owner -> App Response
forall uid tid.
(HasCallStack, MakesValue uid, MakesValue tid) =>
tid -> uid -> App Response
legalholdWhitelistTeam tid
tid owner
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
tid -> owner -> Value -> App Response
forall ownerid tid newService.
(HasCallStack, MakesValue ownerid, MakesValue tid,
MakesValue newService) =>
tid -> ownerid -> newService -> App Response
postLegalHoldSettings tid
tid owner
alice ((String, Int) -> Value
mkLegalHoldSettings (String, Int)
lhPort)
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
tid -> owner -> uid -> App Response
forall userFrom userTo status.
(HasCallStack, MakesValue userFrom, MakesValue userTo,
MakesValue status) =>
userFrom -> userTo -> status -> App Response
requestLegalHoldDevice tid
tid owner
alice uid
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
tid -> uid -> String -> App Response
forall tid uid.
(HasCallStack, MakesValue tid, MakesValue uid) =>
tid -> uid -> String -> App Response
approveLegalHoldDevice tid
tid uid
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
lhDeviceIdOf :: (MakesValue user) => user -> App String
lhDeviceIdOf :: forall user. MakesValue user => user -> App String
lhDeviceIdOf user
bob = do
String
bobId <- user -> App String
forall a. (HasCallStack, MakesValue a) => a -> App String
objId user
bob
user -> [String] -> App Response
forall uid tid.
(HasCallStack, MakesValue uid, MakesValue tid) =>
tid -> uid -> App Response
getClientsFull user
bob [String
bobId] App Response -> (Response -> App String) -> App String
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 u. (HasCallStack, MakesValue u) => u -> 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)
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
forall (t :: * -> *) a. (HasCallStack, Foldable t) => t a -> App a
assertOne
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 -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"id")
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
randomScimUser :: App Value
randomScimUser :: App Value
randomScimUser = do
String
email <- App String
randomEmail
HasCallStack => String -> String -> App Value
String -> String -> App Value
randomScimUserWith String
email String
email
randomScimUserWith :: (HasCallStack) => String -> String -> App Value
randomScimUserWith :: HasCallStack => String -> String -> App Value
randomScimUserWith String
extId String
email = do
String
handle <- Int -> Int -> App String
randomHandleWithRange Int
12 Int
128
Value -> App Value
forall a. a -> App a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Value -> App Value) -> Value -> App Value
forall a b. (a -> b) -> a -> b
$
[Pair] -> Value
object
[ String
"schemas" String -> [String] -> Pair
forall a. ToJSON a => String -> a -> Pair
.= [String
"urn:ietf:params:scim:schemas:core:2.0:User"],
String
"externalId" String -> String -> Pair
forall a. ToJSON a => String -> a -> Pair
.= String
extId,
String
"emails" String -> Value -> Pair
forall a. ToJSON a => String -> a -> Pair
.= Array -> Value
Array ([Value] -> Array
forall a. [a] -> Vector a
fromList [[Pair] -> Value
object [String
"value" String -> String -> Pair
forall a. ToJSON a => String -> a -> Pair
.= String
email]]),
String
"userName" String -> String -> Pair
forall a. ToJSON a => String -> a -> Pair
.= String
handle,
String
"displayName" String -> String -> Pair
forall a. ToJSON a => String -> a -> Pair
.= String
handle
]
uploadProfilePicture :: (HasCallStack, MakesValue usr) => usr -> App (String, String, String)
uploadProfilePicture :: forall usr.
(HasCallStack, MakesValue usr) =>
usr -> App (String, String, String)
uploadProfilePicture usr
usr = do
String
payload <- (String
"asset_contents=" <>) (String -> String) -> App String -> App String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> App String
HasCallStack => App String
randomId
Value
asset <- App Response -> (Response -> App Value) -> App Value
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse (usr -> String -> App Response
forall dom.
(HasCallStack, MakesValue dom) =>
dom -> String -> App Response
uploadFreshAsset usr
usr String
payload) (HasCallStack => Int -> Response -> App Value
Int -> Response -> App Value
getJSON Int
201)
String
dom <- Value
asset Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"domain" 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
key <- Value
asset Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"key" 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
Success ([Value]
oldAssets :: [Value]) <- App Response
-> (Response -> App (Result [Value])) -> App (Result [Value])
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse (usr -> App Response
forall user.
(HasCallStack, MakesValue user) =>
user -> App Response
getSelf usr
usr) ((Response -> App (Result [Value])) -> App (Result [Value]))
-> (Response -> App (Result [Value])) -> App (Result [Value])
forall a b. (a -> b) -> a -> b
$ \Response
resp -> do
Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200
Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"assets" App Value -> (Value -> Result [Value]) -> App (Result [Value])
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> Value -> Result [Value]
forall a. FromJSON a => Value -> Result a
fromJSON
App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse
(usr -> PutSelf -> App Response
forall caller.
(HasCallStack, MakesValue caller) =>
caller -> PutSelf -> App Response
putSelf usr
usr PutSelf
forall a. Default a => a
def {assets = Just (object ["key" .= key, "size" .= "preview", "type" .= "image"] : oldAssets)})
HasCallStack => Response -> App ()
Response -> App ()
assertSuccess
(String, String, String) -> App (String, String, String)
forall a. a -> App a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (String
dom, String
key, String
payload)
downloadProfilePicture :: (HasCallStack, MakesValue caller) => caller -> String -> String -> App (String, String)
downloadProfilePicture :: forall caller.
(HasCallStack, MakesValue caller) =>
caller -> String -> String -> App (String, String)
downloadProfilePicture caller
caller String
assetDomain String
assetKey = do
String
locurl <- App Response -> (Response -> App String) -> App String
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse (caller
-> caller
-> String
-> String
-> (Request -> Request)
-> App Response
forall user key assetDomain.
(HasCallStack, MakesValue user, MakesValue key,
MakesValue assetDomain) =>
user
-> assetDomain
-> key
-> String
-> (Request -> Request)
-> App Response
downloadAsset caller
caller caller
caller String
assetKey String
assetDomain Request -> Request
noRedirect) ((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
302
App String
-> (ByteString -> App String) -> Maybe ByteString -> App String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
(String -> App String
forall a. HasCallStack => String -> a
error String
"no location header in 302 response!?")
(String -> App String
forall a. a -> App a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (String -> App String)
-> (ByteString -> String) -> ByteString -> App String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> String
forall a b. ConvertibleStrings a b => a -> b
cs)
(CI ByteString -> [(CI ByteString, ByteString)] -> Maybe ByteString
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup (ByteString -> CI ByteString
forall s. FoldCase s => s -> CI s
CI.mk (String -> ByteString
forall a b. ConvertibleStrings a b => a -> b
cs String
"Location")) Response
resp.headers)
String
payload <- App Response -> (Response -> App String) -> App String
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse (caller
-> caller
-> String
-> String
-> (Request -> Request)
-> App Response
forall user key assetDomain.
(HasCallStack, MakesValue user, MakesValue key,
MakesValue assetDomain) =>
user
-> assetDomain
-> key
-> String
-> (Request -> Request)
-> App Response
downloadAsset caller
caller caller
caller String
assetKey String
assetDomain Request -> Request
forall a. a -> a
id) ((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
200
String -> App String
forall a. a -> App a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (String -> App String) -> String -> App String
forall a b. (a -> b) -> a -> b
$ ByteString -> String
forall a b. ConvertibleStrings a b => a -> b
cs Response
resp.body
(String, String) -> App (String, String)
forall a. a -> App a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (String
locurl, String
payload)
uploadDownloadProfilePicture :: (HasCallStack, MakesValue usr) => usr -> App (String, String)
uploadDownloadProfilePicture :: forall usr.
(HasCallStack, MakesValue usr) =>
usr -> App (String, String)
uploadDownloadProfilePicture usr
usr = do
(String
dom, String
key, String
_payload) <- usr -> App (String, String, String)
forall usr.
(HasCallStack, MakesValue usr) =>
usr -> App (String, String, String)
uploadProfilePicture usr
usr
usr -> String -> String -> App (String, String)
forall caller.
(HasCallStack, MakesValue caller) =>
caller -> String -> String -> App (String, String)
downloadProfilePicture usr
usr String
dom String
key