diff --git a/changelog.d/5-internal/servantify-connections b/changelog.d/5-internal/servantify-connections new file mode 100644 index 0000000000..d99ace3e49 --- /dev/null +++ b/changelog.d/5-internal/servantify-connections @@ -0,0 +1 @@ +Move /connections/* endpoints to Servant diff --git a/libs/wire-api/src/Wire/API/ErrorDescription.hs b/libs/wire-api/src/Wire/API/ErrorDescription.hs index d9c0def1b3..7f58762ec4 100644 --- a/libs/wire-api/src/Wire/API/ErrorDescription.hs +++ b/libs/wire-api/src/Wire/API/ErrorDescription.hs @@ -231,6 +231,11 @@ type InvalidUser = ErrorDescription 400 "invalid-user" "Invalid user." invalidUser :: InvalidUser invalidUser = mkErrorDescription +type InvalidTransition = ErrorDescription 403 "bad-conn-update" "Invalid status transition." + +invalidTransition :: InvalidTransition +invalidTransition = mkErrorDescription + type NoIdentity = ErrorDescription 403 "no-identity" "The user has no verified identity (email or phone number)." noIdentity :: forall code lbl desc. (NoIdentity ~ ErrorDescription code lbl desc) => Int -> NoIdentity @@ -275,6 +280,11 @@ type UserNotFound = ErrorDescription 404 "not-found" "User not found" userNotFound :: UserNotFound userNotFound = mkErrorDescription +type ConnectionNotFound = ErrorDescription 404 "not-found" "Connection not found" + +connectionNotFound :: ConnectionNotFound +connectionNotFound = mkErrorDescription + type HandleNotFound = ErrorDescription 404 "not-found" "Handle not found" handleNotFound :: HandleNotFound diff --git a/libs/wire-api/src/Wire/API/Routes/Public/Brig.hs b/libs/wire-api/src/Wire/API/Routes/Public/Brig.hs index b31097c67a..47ebc4b773 100644 --- a/libs/wire-api/src/Wire/API/Routes/Public/Brig.hs +++ b/libs/wire-api/src/Wire/API/Routes/Public/Brig.hs @@ -65,6 +65,8 @@ type CaptureClientId name = Capture' '[Description "ClientId"] name ClientId type NewClientResponse = Headers '[Header "Location" ClientId] Client +type ConnectionUpdateResponses = UpdateResponses "Connection unchanged" "Connection updated" UserConnection + data Api routes = Api { -- See Note [ephemeral user sideeffect] getUserUnqualified :: @@ -303,6 +305,7 @@ data Api routes = Api :> CaptureClientId "client" :> "prekeys" :> Get '[JSON] [PrekeyId], + -- Connection API ----------------------------------------------------- -- -- This endpoint can lead to the following events being sent: -- - ConnectionUpdated event to self and other, if any side's connection state changes @@ -310,9 +313,8 @@ data Api routes = Api -- - ConvCreate event to self, if creating a connect conversation (via galley) -- - ConvConnect event to self, in some cases (via galley), -- for details see 'Galley.API.Create.createConnectConversation' - -- - createConnection :: - routes :- Summary "Create a connection to another user." + createConnectionUnqualified :: + routes :- Summary "Create a connection to another user. (deprecated)" :> CanThrow MissingLegalholdConsent :> CanThrow InvalidUser :> CanThrow ConnectionLimitReached @@ -331,6 +333,49 @@ data Api routes = Api '[JSON] (ResponsesForExistedCreated "Connection existed" "Connection was created" UserConnection) (ResponseForExistedCreated UserConnection), + listConnections :: + routes :- Summary "List the connections to other users." + :> ZUser + :> "connections" + :> QueryParam' '[Optional, Strict, Description "User ID to start from when paginating"] "start" UserId + :> QueryParam' '[Optional, Strict, Description "Number of results to return (default 100, max 500)"] "size" (Range 1 500 Int32) + :> Get '[JSON] UserConnectionList, + getConnectionUnqualified :: + routes :- Summary "Get an existing connection to another user. (deprecated)" + :> ZUser + :> "connections" + :> CaptureUserId "uid" + :> MultiVerb + 'GET + '[JSON] + '[ EmptyErrorForLegacyReasons 404 "Connection not found", + Respond 200 "Connection found" UserConnection + ] + (Maybe UserConnection), + -- This endpoint can lead to the following events being sent: + -- - ConnectionUpdated event to self and other, if their connection states change + -- + -- When changing the connection state to Sent or Accepted, this can cause events to be sent + -- when joining the connect conversation: + -- - MemberJoin event to self and other (via galley) + updateConnectionUnqualified :: + routes :- Summary "Update a connection to another user. (deprecated)" + :> CanThrow MissingLegalholdConsent + :> CanThrow InvalidUser + :> CanThrow ConnectionLimitReached + :> CanThrow NotConnected + :> CanThrow InvalidTransition + :> CanThrow NoIdentity + :> ZUser + :> ZConn + :> "connections" + :> CaptureUserId "uid" + :> ReqBody '[JSON] ConnectionUpdate + :> MultiVerb + 'PUT + '[JSON] + ConnectionUpdateResponses + (UpdateResult UserConnection), searchContacts :: routes :- Summary "Search for users" :> ZUser diff --git a/libs/wire-api/src/Wire/API/Routes/Public/Galley.hs b/libs/wire-api/src/Wire/API/Routes/Public/Galley.hs index 3ded88e773..fab65f297a 100644 --- a/libs/wire-api/src/Wire/API/Routes/Public/Galley.hs +++ b/libs/wire-api/src/Wire/API/Routes/Public/Galley.hs @@ -25,7 +25,6 @@ import Data.CommaSeparatedList import Data.Id (ConvId, TeamId, UserId) import Data.Qualified (Qualified (..)) import Data.Range -import Data.SOP (I (..), NS (..)) import qualified Data.Swagger as Swagger import GHC.TypeLits (AppendSymbol) import Imports hiding (head) @@ -71,22 +70,7 @@ type ConversationVerb = ] ConversationResponse -type UpdateResponses = - '[ RespondEmpty 204 "Conversation unchanged", - Respond 200 "Conversation updated" Event - ] - -data UpdateResult - = Unchanged - | Updated Event - -instance AsUnion UpdateResponses UpdateResult where - toUnion Unchanged = inject (I ()) - toUnion (Updated e) = inject (I e) - - fromUnion (Z (I ())) = Unchanged - fromUnion (S (Z (I e))) = Updated e - fromUnion (S (S x)) = case x of +type ConvUpdateResponses = UpdateResponses "Conversation unchanged" "Conversation updated" Event data Api routes = Api { -- Conversations @@ -249,7 +233,7 @@ data Api routes = Api :> "members" :> "v2" :> ReqBody '[Servant.JSON] InviteQualified - :> MultiVerb 'POST '[Servant.JSON] UpdateResponses UpdateResult, + :> MultiVerb 'POST '[Servant.JSON] ConvUpdateResponses (UpdateResult Event), -- This endpoint can lead to the following events being sent: -- - MemberLeave event to members removeMemberUnqualified :: diff --git a/libs/wire-api/src/Wire/API/Routes/Public/Util.hs b/libs/wire-api/src/Wire/API/Routes/Public/Util.hs index e3efc84ba1..fc54cdf9ad 100644 --- a/libs/wire-api/src/Wire/API/Routes/Public/Util.hs +++ b/libs/wire-api/src/Wire/API/Routes/Public/Util.hs @@ -21,6 +21,7 @@ module Wire.API.Routes.Public.Util where import Data.SOP (I (..), NS (..)) +import Servant import Servant.Swagger.Internal.Orphans () import Wire.API.Routes.MultiVerb @@ -46,3 +47,23 @@ type ResponsesForExistedCreated eDesc cDesc a = '[ Respond 200 eDesc a, Respond 201 cDesc a ] + +data UpdateResult a + = Unchanged + | Updated !a + +type UpdateResponses unchangedDesc updatedDesc a = + '[ RespondEmpty 204 unchangedDesc, + Respond 200 updatedDesc a + ] + +instance + (ResponseType r1 ~ (), ResponseType r2 ~ a) => + AsUnion '[r1, r2] (UpdateResult a) + where + toUnion Unchanged = inject (I ()) + toUnion (Updated a) = inject (I a) + + fromUnion (Z (I ())) = Unchanged + fromUnion (S (Z (I a))) = Updated a + fromUnion (S (S x)) = case x of diff --git a/services/brig/src/Brig/API/Error.hs b/services/brig/src/Brig/API/Error.hs index f4c63aa811..63f2bd5b68 100644 --- a/services/brig/src/Brig/API/Error.hs +++ b/services/brig/src/Brig/API/Error.hs @@ -86,7 +86,7 @@ instance ToJSON Error where connError :: ConnectionError -> Error connError TooManyConnections {} = StdError (errorDescriptionToWai connectionLimitReached) -connError InvalidTransition {} = StdError invalidTransition +connError InvalidTransition {} = StdError (errorDescriptionToWai invalidTransition) connError NotConnected {} = StdError (errorDescriptionToWai notConnected) connError InvalidUser {} = StdError (errorDescriptionToWai invalidUser) connError ConnectNoIdentity {} = StdError (errorDescriptionToWai (noIdentity 0)) @@ -257,9 +257,6 @@ propertyValueTooLarge = Wai.mkError status403 "property-value-too-large" "The pr clientCapabilitiesCannotBeRemoved :: Wai.Error clientCapabilitiesCannotBeRemoved = Wai.mkError status409 "client-capabilities-cannot-be-removed" "You can only add capabilities to a client, not remove them." -invalidTransition :: Wai.Error -invalidTransition = Wai.mkError status403 "bad-conn-update" "Invalid status transition." - noEmail :: Wai.Error noEmail = Wai.mkError status403 "no-email" "This operation requires the user to have a verified email address." diff --git a/services/brig/src/Brig/API/Public.hs b/services/brig/src/Brig/API/Public.hs index e2ce8904ba..e3a0fe1198 100644 --- a/services/brig/src/Brig/API/Public.hs +++ b/services/brig/src/Brig/API/Public.hs @@ -252,7 +252,10 @@ servantSitemap = BrigAPI.getClient = getClient, BrigAPI.getClientCapabilities = getClientCapabilities, BrigAPI.getClientPrekeys = getClientPrekeys, - BrigAPI.createConnection = createConnection, + BrigAPI.createConnectionUnqualified = createConnection, + BrigAPI.listConnections = listConnections, + BrigAPI.getConnectionUnqualified = getConnection, + BrigAPI.updateConnectionUnqualified = updateConnection, BrigAPI.searchContacts = Search.search } @@ -446,64 +449,6 @@ sitemap = do Doc.response 200 "Deletion is initiated." Doc.end Doc.errorResponse invalidCode - -- Connection API ----------------------------------------------------- - - -- This endpoint is used to test /i/metrics, when this is servantified, please - -- make sure some other endpoint is used to test that routes defined in this - -- function are recorded and reported correctly in /i/metrics. - get "/connections" (continue listConnectionsH) $ - accept "application" "json" - .&. zauthUserId - .&. opt (query "start") - .&. def (unsafeRange 100) (query "size") - document "GET" "connections" $ do - Doc.summary "List the connections to other users." - Doc.parameter Doc.Query "start" Doc.string' $ do - Doc.description "User ID to start from" - Doc.optional - Doc.parameter Doc.Query "size" Doc.int32' $ do - Doc.description "Number of results to return (default 100, max 500)." - Doc.optional - Doc.returns (Doc.ref Public.modelConnectionList) - Doc.response 200 "List of connections" Doc.end - - -- This endpoint can lead to the following events being sent: - -- - ConnectionUpdated event to self and other, if their connection states change - -- - -- When changing the connection state to Sent or Accepted, this can cause events to be sent - -- when joining the connect conversation: - -- - MemberJoin event to self and other (via galley) - put "/connections/:id" (continue updateConnectionH) $ - accept "application" "json" - .&. zauthUserId - .&. zauthConnId - .&. capture "id" - .&. jsonRequest @Public.ConnectionUpdate - document "PUT" "updateConnection" $ do - Doc.summary "Update a connection." - Doc.parameter Doc.Path "id" Doc.bytes' $ - Doc.description "User ID" - Doc.body (Doc.ref Public.modelConnectionUpdate) $ - Doc.description "JSON body" - Doc.returns (Doc.ref Public.modelConnection) - Doc.response 200 "Connection updated." Doc.end - Doc.response 204 "No change." Doc.end - Doc.errorResponse (errorDescriptionToWai connectionLimitReached) - Doc.errorResponse invalidTransition - Doc.errorResponse (errorDescriptionToWai notConnected) - Doc.errorResponse (errorDescriptionToWai invalidUser) - - get "/connections/:id" (continue getConnectionH) $ - accept "application" "json" - .&. zauthUserId - .&. capture "id" - document "GET" "connection" $ do - Doc.summary "Get an existing connection to another user." - Doc.parameter Doc.Path "id" Doc.bytes' $ - Doc.description "User ID" - Doc.returns (Doc.ref Public.modelConnection) - Doc.response 200 "Connection" Doc.end - -- Properties API ----------------------------------------------------- -- This endpoint can lead to the following events being sent: @@ -553,6 +498,10 @@ sitemap = do Doc.returns (Doc.ref Public.modelPropertyValue) Doc.response 200 "The property value." Doc.end + -- This endpoint is used to test /i/metrics, when this is servantified, please + -- make sure some other endpoint is used to test that routes defined in this + -- function are recorded and reported correctly in /i/metrics. + -- see test/integration/API/Metrics.hs get "/properties" (continue listPropertyKeysH) $ zauthUserId .&. accept "application" "json" @@ -1150,25 +1099,19 @@ createConnection :: UserId -> ConnId -> Public.ConnectionRequest -> Handler (Pub createConnection self conn cr = do API.createConnection self cr conn !>> connError -updateConnectionH :: JSON ::: UserId ::: ConnId ::: UserId ::: JsonRequest Public.ConnectionUpdate -> Handler Response -updateConnectionH (_ ::: self ::: conn ::: other ::: req) = do - newStatus <- Public.cuStatus <$> parseJsonBody req +updateConnection :: UserId -> ConnId -> UserId -> Public.ConnectionUpdate -> Handler (Public.UpdateResult Public.UserConnection) +updateConnection self conn other update = do + let newStatus = Public.cuStatus update mc <- API.updateConnection self other newStatus (Just conn) !>> connError - return $ case mc of - Just c -> json (c :: Public.UserConnection) - Nothing -> setStatus status204 empty - -listConnectionsH :: JSON ::: UserId ::: Maybe UserId ::: Range 1 500 Int32 -> Handler Response -listConnectionsH (_ ::: uid ::: start ::: size) = - json @Public.UserConnectionList - <$> lift (API.lookupConnections uid start size) - -getConnectionH :: JSON ::: UserId ::: UserId -> Handler Response -getConnectionH (_ ::: uid ::: uid') = lift $ do - conn <- API.lookupConnection uid uid' - return $ case conn of - Just c -> json (c :: Public.UserConnection) - Nothing -> setStatus status404 empty + return $ maybe Public.Unchanged Public.Updated mc + +listConnections :: UserId -> Maybe UserId -> Maybe (Range 1 500 Int32) -> Handler Public.UserConnectionList +listConnections uid start msize = do + let defaultSize = toRange (Proxy @100) + lift $ API.lookupConnections uid start (fromMaybe defaultSize msize) + +getConnection :: UserId -> UserId -> Handler (Maybe Public.UserConnection) +getConnection uid uid' = lift $ API.lookupConnection uid uid' deleteUserH :: UserId ::: JsonRequest Public.DeleteUser ::: JSON -> Handler Response deleteUserH (u ::: r ::: _) = do diff --git a/services/brig/test/integration/API/Metrics.hs b/services/brig/test/integration/API/Metrics.hs index c57d419947..461a25b2c0 100644 --- a/services/brig/test/integration/API/Metrics.hs +++ b/services/brig/test/integration/API/Metrics.hs @@ -57,23 +57,23 @@ testMetricsEndpoint :: Brig -> Http () testMetricsEndpoint brig = do let p1 = "/self" p2 uid = "/users/" <> uid <> "/clients" - p3 = "/connections" + p3 = "/properties" beforeSelf <- getCount "/self" beforeClients <- getCount "/users/:uid/clients" - beforeConnections <- getCount "/connections" + beforeProperties <- getCount "/properties" uid <- userId <$> randomUser brig uid' <- userId <$> randomUser brig _ <- get (brig . path p1 . zAuthAccess uid "conn" . expect2xx) _ <- get (brig . path (p2 $ toByteString' uid) . zAuthAccess uid "conn" . expect2xx) _ <- get (brig . path (p2 $ toByteString' uid') . zAuthAccess uid "conn" . expect2xx) - _ <- get (brig . path p3 . zAuthAccess uid "conn" . queryItem "size" "10" . expect2xx) - _ <- get (brig . path p3 . zAuthAccess uid "conn" . queryItem "extra-undefined" "42" . expect2xx) + _ <- get (brig . path p3 . zAuthAccess uid "conn" . expect2xx) + _ <- get (brig . path p3 . zAuthAccess uid "conn" . expect2xx) countSelf <- getCount "/self" liftIO $ assertEqual "/self was called once" (beforeSelf + 1) countSelf countClients <- getCount "/users/:uid/clients" liftIO $ assertEqual "/users/:uid/clients was called twice" (beforeClients + 2) countClients - countConnections <- getCount "/connections" - liftIO $ assertEqual "/connections was called twice" (beforeConnections + 2) countConnections + countProperties <- getCount "/properties" + liftIO $ assertEqual "/properties was called twice" (beforeProperties + 2) countProperties where getCount endpoint = do rsp <- responseBody <$> get (brig . path "i/metrics") diff --git a/services/galley/src/Galley/API/Update.hs b/services/galley/src/Galley/API/Update.hs index 0d2ea6c72e..8a16b281b6 100644 --- a/services/galley/src/Galley/API/Update.hs +++ b/services/galley/src/Galley/API/Update.hs @@ -124,8 +124,8 @@ import qualified Wire.API.Event.Conversation as Public import qualified Wire.API.Federation.API.Galley as FederatedGalley import Wire.API.Federation.Error (federationNotImplemented) import qualified Wire.API.Message as Public -import Wire.API.Routes.Public.Galley (UpdateResult (..)) import Wire.API.Routes.Public.Galley.Responses +import Wire.API.Routes.Public.Util (UpdateResult (..)) import Wire.API.ServantProto (RawProto (..)) import Wire.API.Team.LegalHold (LegalholdProtectee (..)) import Wire.API.User.Client @@ -168,7 +168,7 @@ unblockConv usr conn cnv = do -- conversation updates -handleUpdateResult :: UpdateResult -> Response +handleUpdateResult :: UpdateResult Event -> Response handleUpdateResult = \case Updated ev -> json ev & setStatus status200 Unchanged -> empty & setStatus status204 @@ -178,7 +178,7 @@ updateConversationAccessH (usr ::: zcon ::: cnv ::: req) = do update <- fromJsonBody req handleUpdateResult <$> updateConversationAccess usr zcon cnv update -updateConversationAccess :: UserId -> ConnId -> ConvId -> Public.ConversationAccessUpdate -> Galley UpdateResult +updateConversationAccess :: UserId -> ConnId -> ConvId -> Public.ConversationAccessUpdate -> Galley (UpdateResult Event) updateConversationAccess usr zcon cnv update = do let targetAccess = Set.fromList (toList (cupAccess update)) targetRole = cupAccessRole update @@ -298,7 +298,7 @@ updateConversationReceiptModeH (usr ::: zcon ::: cnv ::: req ::: _) = do update <- fromJsonBody req handleUpdateResult <$> updateConversationReceiptMode usr zcon cnv update -updateConversationReceiptMode :: UserId -> ConnId -> ConvId -> Public.ConversationReceiptModeUpdate -> Galley UpdateResult +updateConversationReceiptMode :: UserId -> ConnId -> ConvId -> Public.ConversationReceiptModeUpdate -> Galley (UpdateResult Event) updateConversationReceiptMode usr zcon cnv receiptModeUpdate@(Public.ConversationReceiptModeUpdate target) = do localDomain <- viewFederationDomain let qcnv = Qualified cnv localDomain @@ -323,7 +323,7 @@ updateConversationMessageTimerH (usr ::: zcon ::: cnv ::: req) = do timerUpdate <- fromJsonBody req handleUpdateResult <$> updateConversationMessageTimer usr zcon cnv timerUpdate -updateConversationMessageTimer :: UserId -> ConnId -> ConvId -> Public.ConversationMessageTimerUpdate -> Galley UpdateResult +updateConversationMessageTimer :: UserId -> ConnId -> ConvId -> Public.ConversationMessageTimerUpdate -> Galley (UpdateResult Event) updateConversationMessageTimer usr zcon cnv timerUpdate@(Public.ConversationMessageTimerUpdate target) = do localDomain <- viewFederationDomain let qcnv = Qualified cnv localDomain @@ -441,7 +441,7 @@ joinConversationByReusableCodeH (zusr ::: zcon ::: req) = do convCode <- fromJsonBody req handleUpdateResult <$> joinConversationByReusableCode zusr zcon convCode -joinConversationByReusableCode :: UserId -> ConnId -> Public.ConversationCode -> Galley UpdateResult +joinConversationByReusableCode :: UserId -> ConnId -> Public.ConversationCode -> Galley (UpdateResult Event) joinConversationByReusableCode zusr zcon convCode = do c <- verifyReusableCode convCode joinConversation zusr zcon (codeConversation c) CodeAccess @@ -450,11 +450,11 @@ joinConversationByIdH :: UserId ::: ConnId ::: ConvId ::: JSON -> Galley Respons joinConversationByIdH (zusr ::: zcon ::: cnv ::: _) = handleUpdateResult <$> joinConversationById zusr zcon cnv -joinConversationById :: UserId -> ConnId -> ConvId -> Galley UpdateResult +joinConversationById :: UserId -> ConnId -> ConvId -> Galley (UpdateResult Event) joinConversationById zusr zcon cnv = joinConversation zusr zcon cnv LinkAccess -joinConversation :: UserId -> ConnId -> ConvId -> Access -> Galley UpdateResult +joinConversation :: UserId -> ConnId -> ConvId -> Access -> Galley (UpdateResult Event) joinConversation zusr zcon cnv access = do conv <- ensureConversationAccess zusr cnv access let newUsers = filter (notIsMember conv) [zusr] @@ -474,7 +474,7 @@ addMembersH (zusr ::: zcon ::: cid ::: req) = do let qInvite = Public.InviteQualified (flip Qualified domain <$> toNonEmpty u) r handleUpdateResult <$> addMembers zusr zcon cid qInvite -addMembers :: UserId -> ConnId -> ConvId -> Public.InviteQualified -> Galley UpdateResult +addMembers :: UserId -> ConnId -> ConvId -> Public.InviteQualified -> Galley (UpdateResult Event) addMembers zusr zcon convId invite = do conv <- Data.conversation convId >>= ifNothing (errorDescriptionToWai convNotFound) let mems = localBotsAndUsers (Data.convLocalMembers conv) @@ -998,7 +998,7 @@ rmBotH (zusr ::: zcon ::: req) = do bot <- fromJsonBody req handleUpdateResult <$> rmBot zusr zcon bot -rmBot :: UserId -> Maybe ConnId -> RemoveBot -> Galley UpdateResult +rmBot :: UserId -> Maybe ConnId -> RemoveBot -> Galley (UpdateResult Event) rmBot zusr zcon b = do c <- Data.conversation (b ^. rmBotConv) >>= ifNothing (errorDescriptionToWai convNotFound) localDomain <- viewFederationDomain @@ -1038,7 +1038,7 @@ addToConversation :: [(Remote UserId, RoleName)] -> -- | The conversation to modify Data.Conversation -> - Galley UpdateResult + Galley (UpdateResult Event) addToConversation _ _ _ _ [] [] _ = pure Unchanged addToConversation (bots, existingLocals) existingRemotes (usr, usrRole) conn newLocals newRemotes c = do ensureGroupConvThrowing c