Servantify POST /connections endpoint; remove deprecated 'message' field

CHANGELOG-draft.md

@@ -6,6 +6,7 @@ THIS FILE ACCUMULATES THE RELEASE NOTES FOR THE UPCOMING RELEASE.
 
 ## API Changes
 
+* Remove the long-deprecated `message` field in `POST /connections` (#1726)
 * Add `PUT /conversations/:domain/:cnv/name` (#1737)
 * Deprecate `PUT /conversations/:cnv/name` (#1737)
 
@@ -17,6 +18,8 @@ THIS FILE ACCUMULATES THE RELEASE NOTES FOR THE UPCOMING RELEASE.
 
 ## Internal changes
 
+* Rewrite the `POST /connections` endpoint to Servant (#1726)
+
 ## Federation changes
 
-* Ensure clients only receive messages meant for them in remote convs (#1739)
+* Ensure clients only receive messages meant for them in remote convs (#1739)

libs/brig-types/src/Brig/Types/Connection.hs

@@ -29,7 +29,6 @@ module Brig.Types.Connection
     UpdateConnectionsInternal (..),
 
     -- * re-exports
-    Message (..),
     Relation (..),
     UserConnection (..),
     ConnectionRequest (..),

libs/wire-api/src/Wire/API/Connection.hs

@@ -1,5 +1,4 @@
-{-# LANGUAGE GeneralizedNewtypeDeriving #-}
-{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE StrictData #-}
 
 -- This file is part of the Wire Server implementation.
@@ -26,7 +25,6 @@ module Wire.API.Connection
   ( -- * UserConnection
     UserConnection (..),
     UserConnectionList (..),
-    Message (..),
     Relation (..),
     RelationWithHistory (..),
     relationDropHistory,
@@ -38,24 +36,23 @@ module Wire.API.Connection
     -- * Swagger
     modelConnectionList,
     modelConnection,
-    modelConnectionRequest,
     modelConnectionUpdate,
   )
 where
 
-import Data.Aeson
-import Data.Aeson.Types (Parser)
+import Control.Lens ((?~))
+import Data.Aeson as Aeson
 import Data.Attoparsec.ByteString (takeByteString)
 import Data.ByteString.Conversion
 import Data.Id
 import Data.Json.Util (UTCTimeMillis)
 import Data.Range
+import qualified Data.Schema as P
 import qualified Data.Swagger.Build.Api as Doc
-import Data.Swagger.Schema
+import Data.Swagger.Schema as S
 import Data.Text as Text
-import Deriving.Swagger (CamelToKebab, ConstructorTagModifier, CustomSwagger)
 import Imports
-import Wire.API.Arbitrary (Arbitrary (arbitrary), GenericUniform (..))
+import Wire.API.Arbitrary (Arbitrary (..), GenericUniform (..))
 
 --------------------------------------------------------------------------------
 -- UserConnectionList
@@ -68,6 +65,14 @@ data UserConnectionList = UserConnectionList
   }
   deriving stock (Eq, Show, Generic)
   deriving (Arbitrary) via (GenericUniform UserConnectionList)
+  deriving (FromJSON, ToJSON, S.ToSchema) via (P.Schema UserConnectionList)
+
+instance P.ToSchema UserConnectionList where
+  schema =
+    P.object "UserConnectionList" $
+      UserConnectionList
+        <$> clConnections P..= P.field "connections" (P.array P.schema)
+        <*> clHasMore P..= P.fieldWithDocModifier "has_more" (P.description ?~ "Indicator that the server has more connections than returned.") P.schema
 
 modelConnectionList :: Doc.Model
 modelConnectionList = Doc.defineModel "UserConnectionList" $ do
@@ -76,19 +81,6 @@ modelConnectionList = Doc.defineModel "UserConnectionList" $ do
   Doc.property "has_more" Doc.bool' $
     Doc.description "Indicator that the server has more connections than returned."
 
-instance ToJSON UserConnectionList where
-  toJSON (UserConnectionList l m) =
-    object
-      [ "connections" .= l,
-        "has_more" .= m
-      ]
-
-instance FromJSON UserConnectionList where
-  parseJSON = withObject "UserConnectionList" $ \o ->
-    UserConnectionList
-      <$> o .: "connections"
-      <*> o .: "has_more"
-
 --------------------------------------------------------------------------------
 -- UserConnection
 
@@ -103,11 +95,21 @@ data UserConnection = UserConnection
     ucStatus :: Relation,
     -- | When 'ucStatus' was last changed
     ucLastUpdate :: UTCTimeMillis,
-    ucMessage :: Maybe Message,
     ucConvId :: Maybe ConvId
   }
   deriving stock (Eq, Show, Generic)
   deriving (Arbitrary) via (GenericUniform UserConnection)
+  deriving (FromJSON, ToJSON, S.ToSchema) via (P.Schema UserConnection)
+
+instance P.ToSchema UserConnection where
+  schema =
+    P.object "UserConnection" $
+      UserConnection
+        <$> ucFrom P..= P.field "from" P.schema
+        <*> ucTo P..= P.field "to" P.schema
+        <*> ucStatus P..= P.field "status" P.schema
+        <*> ucLastUpdate P..= P.field "last_update" P.schema
+        <*> ucConvId P..= P.optField "conversation" Nothing P.schema
 
 modelConnection :: Doc.Model
 modelConnection = Doc.defineModel "Connection" $ do
@@ -127,27 +129,6 @@ modelConnection = Doc.defineModel "Connection" $ do
     Doc.description "Conversation ID"
     Doc.optional
 
-instance ToJSON UserConnection where
-  toJSON uc =
-    object
-      [ "from" .= ucFrom uc,
-        "to" .= ucTo uc,
-        "status" .= ucStatus uc,
-        "last_update" .= ucLastUpdate uc,
-        "message" .= ucMessage uc,
-        "conversation" .= ucConvId uc
-      ]
-
-instance FromJSON UserConnection where
-  parseJSON = withObject "user-connection" $ \o ->
-    UserConnection
-      <$> o .: "from"
-      <*> o .: "to"
-      <*> o .: "status"
-      <*> o .: "last_update"
-      <*> o .:? "message"
-      <*> o .:? "conversation"
-
 --------------------------------------------------------------------------------
 -- Relation
 
@@ -165,7 +146,7 @@ data Relation
     MissingLegalholdConsent
   deriving stock (Eq, Ord, Show, Generic)
   deriving (Arbitrary) via (GenericUniform Relation)
-  deriving (ToSchema) via (CustomSwagger '[ConstructorTagModifier CamelToKebab] Relation)
+  deriving (FromJSON, ToJSON, S.ToSchema) via (P.Schema Relation)
 
 -- | 'updateConnectionInternal', requires knowledge of the previous state (before
 -- 'MissingLegalholdConsent'), but the clients don't need that information.  To avoid having
@@ -215,29 +196,22 @@ typeRelation =
         "missing-legalhold-consent"
       ]
 
-instance ToJSON Relation where
-  toJSON = \case
-    Accepted -> "accepted"
-    Blocked -> "blocked"
-    Pending -> "pending"
-    Ignored -> "ignored"
-    Sent -> "sent"
-    Cancelled -> "cancelled"
-    MissingLegalholdConsent -> "missing-legalhold-consent"
-
-instance FromJSON Relation where
-  parseJSON (String "accepted") = return Accepted
-  parseJSON (String "blocked") = return Blocked
-  parseJSON (String "pending") = return Pending
-  parseJSON (String "ignored") = return Ignored
-  parseJSON (String "sent") = return Sent
-  parseJSON (String "cancelled") = return Cancelled
-  parseJSON (String "missing-legalhold-consent") = return MissingLegalholdConsent
-  parseJSON _ = mzero
+instance P.ToSchema Relation where
+  schema =
+    P.enum @Text "Relation" $
+      mconcat
+        [ P.element "accepted" Accepted,
+          P.element "blocked" Blocked,
+          P.element "pending" Pending,
+          P.element "ignored" Ignored,
+          P.element "sent" Sent,
+          P.element "cancelled" Cancelled,
+          P.element "missing-legalhold-consent" MissingLegalholdConsent
+        ]
 
 instance FromByteString Relation where
   parser =
-    takeByteString >>= \b -> case b of
+    takeByteString >>= \case
       "accepted" -> return Accepted
       "blocked" -> return Blocked
       "pending" -> return Pending
@@ -257,21 +231,6 @@ instance ToByteString Relation where
     Cancelled -> "cancelled"
     MissingLegalholdConsent -> "missing-legalhold-consent"
 
---------------------------------------------------------------------------------
--- Message
-
--- | Initial message sent along with a connection request. 1-256 characters.
---
--- /Note 2019-03-28:/ some clients send it, but we have hidden it anyway in the UI since it
--- works as a nice source of spam. TODO deprecate and remove.
-newtype Message = Message {messageText :: Text}
-  deriving stock (Eq, Ord, Show, Generic)
-  deriving newtype (ToJSON)
-  deriving (Arbitrary) via (Ranged 1 256 Text)
-
-instance FromJSON Message where
-  parseJSON x = Message . fromRange <$> (parseJSON x :: Parser (Range 1 256 Text))
-
 --------------------------------------------------------------------------------
 -- Requests
 
@@ -280,61 +239,36 @@ data ConnectionRequest = ConnectionRequest
   { -- | Connection recipient
     crUser :: UserId,
     -- | Name of the conversation to be created
-    crName :: Text,
-    -- | Initial message
-    crMessage :: Message
+    -- FUTUREWORK investigate: shouldn't this name be optional? Do we use this name actually anywhere?
+    crName :: Range 1 256 Text
   }
   deriving stock (Eq, Show, Generic)
+  deriving (Arbitrary) via (GenericUniform ConnectionRequest)
+  deriving (FromJSON, ToJSON, S.ToSchema) via (P.Schema ConnectionRequest)
 
-modelConnectionRequest :: Doc.Model
-modelConnectionRequest = Doc.defineModel "ConnectionRequest" $ do
-  Doc.description "Connection request from one user to another"
-  Doc.property "user" Doc.bytes' $
-    Doc.description "User ID of the user to request a connection with"
-  Doc.property "name" Doc.string' $
-    Doc.description "Name of the (pending) conversation being initiated (1 - 256 characters)."
-  Doc.property "message" Doc.string' $
-    Doc.description "The initial message in the request (1 - 256 characters)."
-
-instance ToJSON ConnectionRequest where
-  toJSON c =
-    object
-      [ "user" .= crUser c,
-        "name" .= crName c,
-        "message" .= crMessage c
-      ]
-
-instance FromJSON ConnectionRequest where
-  parseJSON = withObject "connection-request" $ \o ->
-    ConnectionRequest
-      <$> o .: "user"
-      <*> (fromRange <$> ((o .: "name") :: Parser (Range 1 256 Text)))
-      <*> o .: "message"
-
--- | TODO: make 'crName :: Range 1 256 Text' and derive this instance.
-instance Arbitrary ConnectionRequest where
-  arbitrary =
-    ConnectionRequest
-      <$> arbitrary
-      <*> (fromRange <$> arbitrary @(Range 1 256 Text))
-      <*> arbitrary
+instance P.ToSchema ConnectionRequest where
+  schema =
+    P.object "ConnectionRequest" $
+      ConnectionRequest
+        <$> crUser P..= P.fieldWithDocModifier "user" (P.description ?~ "user ID of the user to request a connection with") P.schema
+        <*> crName P..= P.fieldWithDocModifier "name" (P.description ?~ "Name of the (pending) conversation being initiated (1 - 256) characters)") P.schema
 
 -- | Payload type for "please change the status of this connection".
-data ConnectionUpdate = ConnectionUpdate
+newtype ConnectionUpdate = ConnectionUpdate
   { cuStatus :: Relation
   }
   deriving stock (Eq, Show, Generic)
   deriving (Arbitrary) via (GenericUniform ConnectionUpdate)
+  deriving (FromJSON, ToJSON, S.ToSchema) via (P.Schema ConnectionUpdate)
+
+instance P.ToSchema ConnectionUpdate where
+  schema =
+    P.object "ConnectionUpdate" $
+      ConnectionUpdate
+        <$> cuStatus P..= P.fieldWithDocModifier "status" (P.description ?~ "New relation status") P.schema
 
 modelConnectionUpdate :: Doc.Model
 modelConnectionUpdate = Doc.defineModel "ConnectionUpdate" $ do
   Doc.description "Connection update"
   Doc.property "status" typeRelation $
     Doc.description "New relation status"
-
-instance ToJSON ConnectionUpdate where
-  toJSON c = object ["status" .= cuStatus c]
-
-instance FromJSON ConnectionUpdate where
-  parseJSON = withObject "connection-update" $ \o ->
-    ConnectionUpdate <$> o .: "status"

libs/wire-api/src/Wire/API/ErrorDescription.hs

@@ -221,6 +221,21 @@ type NotConnected = ErrorDescription 403 "not-connected" "Users are not connecte
 notConnected :: NotConnected
 notConnected = mkErrorDescription
 
+type ConnectionLimitReached = ErrorDescription 403 "connection-limit" "Too many sent/accepted connections."
+
+connectionLimitReached :: ConnectionLimitReached
+connectionLimitReached = mkErrorDescription
+
+type InvalidUser = ErrorDescription 400 "invalid-user" "Invalid user."
+
+invalidUser :: InvalidUser
+invalidUser = 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
+noIdentity n = ErrorDescription (Text.pack (symbolVal (Proxy @desc)) <> " (code " <> Text.pack (show n) <> ")")
+
 type OperationDenied = ErrorDescription 403 "operation-denied" "Insufficient permissions"
 
 operationDenied :: Show perm => perm -> OperationDenied

libs/wire-api/src/Wire/API/Event/Conversation.hs

@@ -337,6 +337,9 @@ instance ToSchema SimpleMember where
 
 data Connect = Connect
   { cRecipient :: UserId,
+    -- FUTUREWORK: As a follow-up from
+    -- https://github.com/wireapp/wire-server/pull/1726, the message field can
+    -- be removed from this event.
     cMessage :: Maybe Text,
     cName :: Maybe Text,
     cEmail :: Maybe Text

libs/wire-api/src/Wire/API/Routes/Public/Brig.hs

@@ -33,17 +33,11 @@ import Servant hiding (Handler, JSON, addHeader, respond)
 import Servant.API.Generic
 import Servant.Swagger (HasSwagger (toSwagger))
 import Servant.Swagger.Internal.Orphans ()
+import Wire.API.Connection
 import Wire.API.ErrorDescription
-  ( CanThrow,
-    EmptyErrorForLegacyReasons,
-    HandleNotFound,
-    MalformedPrekeys,
-    MissingAuth,
-    TooManyClients,
-    UserNotFound,
-  )
 import Wire.API.Routes.MultiVerb
 import Wire.API.Routes.Public (ZConn, ZUser)
+import Wire.API.Routes.Public.Util
 import Wire.API.Routes.QualifiedCapture
 import Wire.API.User
 import Wire.API.User.Client
@@ -309,6 +303,34 @@ data Api routes = Api
         :> CaptureClientId "client"
         :> "prekeys"
         :> Get '[JSON] [PrekeyId],
+    --
+    -- 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."
+        :> CanThrow MissingLegalholdConsent
+        :> CanThrow InvalidUser
+        :> CanThrow ConnectionLimitReached
+        :> CanThrow NoIdentity
+        -- Config value 'setUserMaxConnections' value in production/by default
+        -- is currently 1000 and has not changed in the last few years.
+        -- While it would be more correct to use the config value here, that
+        -- might not be time well spent.
+        :> Description "You can have no more than 1000 connections in accepted or sent state"
+        :> ZUser
+        :> ZConn
+        :> "connections"
+        :> ReqBody '[JSON] ConnectionRequest
+        :> MultiVerb
+             'POST
+             '[JSON]
+             (ResponsesForExistedCreated "Connection existed" "Connection was created" UserConnection)
+             (ResponseForExistedCreated UserConnection),
     searchContacts ::
       routes :- Summary "Search for users"
         :> ZUser