Servantify /connections endpoints

changelog.d/5-internal/servantify-connections

@@ -0,0 +1 @@
+Move /connections/* endpoints to Servant

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

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,16 +305,16 @@ 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
     -- - MemberJoin event to self and other, if joining an existing connect conversation (via galley)
     -- - 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,50 @@ data Api routes = Api
              '[JSON]
              (ResponsesForExistedCreated "Connection existed" "Connection was created" UserConnection)
              (ResponseForExistedCreated UserConnection),
+    listConnections ::
+      routes :- Summary "List the connections to other users."
+        :> Description "You can have no more than 1000 connections in accepted or sent state"
+        :> ZUser
+        :> "connections"
+        :> QueryParam' '[Optional, Strict, Description "User ID to start from"] "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

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 ::

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

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."
 

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 = unsafeRange 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

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")