Brig: Servantify self API

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

@@ -334,3 +334,5 @@ type AssetTooLarge = ErrorDescription 413 "client-error" "Asset too large"
 type InvalidLength = ErrorDescription 400 "invalid-length" "Invalid content length"
 
 type AssetNotFound = ErrorDescription 404 "not-found" "Asset not found"
+
+type NameManagedByScim = ErrorDescription 403 "managed-by-scim" "Updating name is not allowed, because it is managed by SCIM"

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

@@ -135,6 +135,16 @@ data Api routes = Api
         :> "self"
         :> ReqBody '[JSON] DeleteUser
         :> MultiVerb 'DELETE '[JSON] DeleteSelfResponses (Maybe Timeout),
+    -- This endpoint can lead to the following events being sent:
+    -- - UserUpdated event to contacts of self
+    putSelf ::
+      routes
+        :- Summary "Update your profile"
+        :> ZUser
+        :> ZConn
+        :> "self"
+        :> ReqBody '[JSON] UserUpdate
+        :> MultiVerb 'PUT '[JSON] PutSelfResponses (Maybe UpdateProfileError),
     updateUserEmail ::
       routes
         :- Summary "Resend email address validation email."

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

@@ -56,6 +56,8 @@ module Wire.API.User
 
     -- * Profile Updates
     UserUpdate (..),
+    UpdateProfileError (..),
+    PutSelfResponses,
     PasswordChange (..),
     LocaleUpdate (..),
     EmailUpdate (..),
@@ -113,9 +115,9 @@ import Data.Json.Util (UTCTimeMillis, (#))
 import Data.LegalHold (UserLegalHoldStatus)
 import qualified Data.List as List
 import Data.Misc (PlainTextPassword (..))
-import Data.Proxy (Proxy (..))
 import Data.Qualified
 import Data.Range
+import Data.SOP
 import Data.Schema
 import qualified Data.Swagger as S
 import qualified Data.Swagger.Build.Api as Doc
@@ -128,7 +130,9 @@ import Imports
 import qualified SAML2.WebSSO as SAML
 import qualified Test.QuickCheck as QC
 import Wire.API.Arbitrary (Arbitrary (arbitrary), GenericUniform (..))
+import Wire.API.ErrorDescription
 import Wire.API.Provider.Service (ServiceRef, modelServiceRef)
+import Wire.API.Routes.MultiVerb
 import Wire.API.Team (BindingNewTeam (BindingNewTeam), NewTeam (..), modelNewBindingTeam)
 import Wire.API.User.Activation (ActivationCode)
 import Wire.API.User.Auth (CookieLabel)
@@ -830,6 +834,7 @@ data UserUpdate = UserUpdate
     uupAccentId :: Maybe ColourId
   }
   deriving stock (Eq, Show, Generic)
+  deriving (ToJSON, FromJSON, S.ToSchema) via (Schema UserUpdate)
   deriving (Arbitrary) via (GenericUniform UserUpdate)
 
 modelUserUpdate :: Doc.Model
@@ -845,22 +850,33 @@ modelUserUpdate = Doc.defineModel "UserUpdate" $ do
     Doc.description "Accent colour ID"
     Doc.optional
 
-instance ToJSON UserUpdate where
-  toJSON u =
-    A.object $
-      "name" A..= uupName u
-        # "picture" A..= uupPict u
-        # "assets" A..= uupAssets u
-        # "accent_id" A..= uupAccentId u
-        # []
-
-instance FromJSON UserUpdate where
-  parseJSON = A.withObject "UserUpdate" $ \o ->
-    UserUpdate
-      <$> o A..:? "name"
-      <*> o A..:? "picture"
-      <*> o A..:? "assets"
-      <*> o A..:? "accent_id"
+instance ToSchema UserUpdate where
+  schema =
+    object "UserUpdate" $
+      UserUpdate
+        <$> uupName .= maybe_ (optField "name" schema)
+        <*> uupPict .= maybe_ (optField "picture" schema)
+        <*> uupAssets .= maybe_ (optField "assets" (array schema))
+        <*> uupAccentId .= maybe_ (optField "accent_id" schema)
+
+data UpdateProfileError
+  = DisplayNameManagedByScim
+  | ProfileNotFound
+
+type PutSelfResponses =
+  '[ UserNotFound,
+     NameManagedByScim,
+     RespondEmpty 200 "User updated"
+   ]
+
+instance AsUnion PutSelfResponses (Maybe UpdateProfileError) where
+  toUnion (Just ProfileNotFound) = Z (I mkErrorDescription)
+  toUnion (Just DisplayNameManagedByScim) = S (Z (I mkErrorDescription))
+  toUnion Nothing = S (S (Z (I ())))
+  fromUnion (Z (I _)) = Just ProfileNotFound
+  fromUnion (S (Z (I _))) = Just DisplayNameManagedByScim
+  fromUnion (S (S (Z (I _)))) = Nothing
+  fromUnion (S (S (S x))) = case x of
 
 -- | The payload for setting or changing a password.
 data PasswordChange = PasswordChange

services/brig/src/Brig/API/Error.hs

@@ -39,6 +39,7 @@ import qualified Network.Wai.Utilities.Error as Wai
 import Servant.API.Status
 import Wire.API.ErrorDescription
 import Wire.API.Federation.Error
+import Wire.API.User (UpdateProfileError (..))
 
 errorDescriptionToWai ::
   forall (code :: Nat) (lbl :: Symbol) (desc :: Symbol).
@@ -262,7 +263,7 @@ phoneError (PhoneBudgetExhausted t) = RichError phoneBudgetExhausted (PhoneBudge
 
 updateProfileError :: UpdateProfileError -> Error
 updateProfileError DisplayNameManagedByScim = StdError (propertyManagedByScim "name")
-updateProfileError (ProfileNotFound _) = StdError (errorDescriptionTypeToWai @UserNotFound)
+updateProfileError ProfileNotFound = StdError (errorDescriptionTypeToWai @UserNotFound)
 
 -- WAI Errors -----------------------------------------------------------------
 

services/brig/src/Brig/API/Public.hs

@@ -170,6 +170,7 @@ servantSitemap =
         BrigAPI.getUserQualified = getUser,
         BrigAPI.getSelf = getSelf,
         BrigAPI.deleteSelf = deleteUser,
+        BrigAPI.putSelf = updateUser,
         BrigAPI.updateUserEmail = updateUserEmail,
         BrigAPI.getHandleInfoUnqualified = getHandleInfoUnqualifiedH,
         BrigAPI.getUserByHandleQualified = Handle.getHandleInfo,
@@ -255,18 +256,6 @@ sitemap = do
 
   -- User Self API ------------------------------------------------------
 
-  -- This endpoint can lead to the following events being sent:
-  -- - UserUpdated event to contacts of self
-  put "/self" (continue updateUserH) $
-    zauthUserId
-      .&. zauthConnId
-      .&. jsonRequest @Public.UserUpdate
-  document "PUT" "updateSelf" $ do
-    Doc.summary "Update your profile"
-    Doc.body (Doc.ref Public.modelUserUpdate) $
-      Doc.description "JSON body"
-    Doc.response 200 "Update successful." Doc.end
-
   get "/self/name" (continue getUserDisplayNameH) $
     accept "application" "json"
       .&. zauthUserId
@@ -894,11 +883,10 @@ newtype GetActivationCodeResp
 instance ToJSON GetActivationCodeResp where
   toJSON (GetActivationCodeResp (k, c)) = object ["key" .= k, "code" .= c]
 
-updateUserH :: UserId ::: ConnId ::: JsonRequest Public.UserUpdate -> Handler Response
-updateUserH (uid ::: conn ::: req) = do
-  uu <- parseJsonBody req
-  API.updateUser uid (Just conn) uu API.ForbidSCIMUpdates !>> updateProfileError
-  return empty
+updateUser :: UserId -> ConnId -> Public.UserUpdate -> Handler (Maybe Public.UpdateProfileError)
+updateUser uid conn uu = do
+  eithErr <- lift $ runExceptT $ API.updateUser uid (Just conn) uu API.ForbidSCIMUpdates
+  pure $ either Just (const Nothing) eithErr
 
 changePhoneH :: UserId ::: ConnId ::: JsonRequest Public.PhoneUpdate -> Handler Response
 changePhoneH (u ::: c ::: req) =

services/brig/src/Brig/API/Types.hs

@@ -101,10 +101,6 @@ data CreateUserError
   | -- | Some precondition on another Wire service failed. We propagate this error.
     ExternalPreconditionFailed Wai.Error
 
-data UpdateProfileError
-  = DisplayNameManagedByScim
-  | ProfileNotFound UserId
-
 data InvitationError
   = InviteeEmailExists UserId
   | InviteInvalidEmail Email

services/brig/src/Brig/API/User.hs

@@ -153,6 +153,7 @@ import UnliftIO.Async
 import Wire.API.Federation.Error
 import Wire.API.Routes.Internal.Brig.Connection
 import Wire.API.Team.Member (legalHoldStatus)
+import Wire.API.User (UpdateProfileError (..))
 
 data AllowSCIMUpdates
   = AllowSCIMUpdates
@@ -454,7 +455,7 @@ updateUser :: UserId -> Maybe ConnId -> UserUpdate -> AllowSCIMUpdates -> Except
 updateUser uid mconn uu allowScim = do
   for_ (uupName uu) $ \newName -> do
     mbUser <- lift $ Data.lookupUser WithPendingInvitations uid
-    user <- maybe (throwE (ProfileNotFound uid)) pure mbUser
+    user <- maybe (throwE ProfileNotFound) pure mbUser
     unless
       ( userManagedBy user /= ManagedByScim
           || userDisplayName user == newName