User subsystem: add profile update operations

changelog.d/5-internal/WPB-8880

@@ -0,0 +1 @@
+Added profile update operations to the user subsystem.

libs/bilge/src/Bilge/Response.hs

@@ -131,7 +131,7 @@ responseJsonUnsafe ::
   (HasCallStack, Typeable a, FromJSON a) =>
   ResponseLBS ->
   a
-responseJsonUnsafe = responseJsonUnsafeWithMsg ""
+responseJsonUnsafe resp = responseJsonUnsafeWithMsg (show resp) resp
 
 {-# INLINE responseJsonUnsafeWithMsg #-}
 responseJsonUnsafeWithMsg ::

libs/types-common/src/Data/Handle.hs

@@ -22,10 +22,12 @@ module Data.Handle
     parseHandle,
     parseHandleEither,
     isValidHandle,
+    BadHandle (..),
   )
 where
 
 import Cassandra qualified as C
+import Control.Lens (ix, (.~))
 import Data.Aeson (FromJSON (..), ToJSON (..))
 import Data.Attoparsec.ByteString.Char8 qualified as Atto
 import Data.Bifunctor (Bifunctor (first))
@@ -101,3 +103,24 @@ instance Arbitrary Handle where
     Handle . Text.pack <$> do
       len <- oneof [choose (2, 10), choose (2, 256)] -- prefer short handles
       replicateM len (elements $ ['a' .. 'z'] <> ['0' .. '9'] <> "_-.")
+
+-- | for testing
+newtype BadHandle = BadHandle {fromBadHandle :: Text}
+  deriving newtype (Eq, Show)
+
+instance Arbitrary BadHandle where
+  arbitrary = oneof [tooShort, tooLong, badBytes]
+    where
+      tooShort = (BadHandle . Text.pack . (: [])) <$> elements validChar
+      tooLong = (BadHandle . Text.pack) <$> replicateM 258 (elements validChar)
+      badBytes =
+        BadHandle <$> do
+          totalLen :: Int <- choose (2, 256)
+          invalidCharPos :: Int <- choose (0, totalLen - 1)
+          invalidCharContent <- elements invalidChar
+          good :: Text <- Text.pack <$> replicateM totalLen (elements validChar)
+          let bad :: Text = good & ix invalidCharPos .~ invalidCharContent
+          pure bad
+
+      validChar :: [Char] = ['a' .. 'z'] <> ['0' .. '9'] <> "_-."
+      invalidChar :: [Char] = [minBound ..] \\ validChar

libs/types-common/test/Test/Handle.hs

@@ -20,7 +20,7 @@ module Test.Handle
   )
 where
 
-import Data.Handle (Handle (fromHandle), parseHandleEither)
+import Data.Handle (BadHandle (fromBadHandle), Handle (fromHandle), parseHandleEither)
 import Data.Text qualified as Text
 import Imports
 import Test.Tasty
@@ -67,5 +67,8 @@ testHandleSerialization =
           Right parsed -> assertFailure $ "invalid handle parsed successfully: " <> show (h, parsed),
     testProperty "roundtrip for Handle" $
       \(x :: Handle) ->
-        parseHandleEither (fromHandle x) === Right x
+        parseHandleEither (fromHandle x) === Right x,
+    testProperty "roundtrip for BadHandle" $
+      \(x :: BadHandle) ->
+        property . isLeft . parseHandleEither $ fromBadHandle x
   ]

libs/wire-api/default.nix

@@ -29,6 +29,7 @@
 , crypton
 , crypton-x509
 , currency-codes
+, data-default
 , deriving-aeson
 , deriving-swagger2
 , either
@@ -139,6 +140,7 @@ mkDerivation {
     crypton
     crypton-x509
     currency-codes
+    data-default
     deriving-aeson
     deriving-swagger2
     either

libs/wire-api/src/Wire/API/Error/Brig.hs

@@ -65,6 +65,7 @@ data BrigError
   | UserKeyExists
   | NameManagedByScim
   | HandleManagedByScim
+  | LocaleManagedByScim
   | LastIdentity
   | NoPassword
   | ChangePasswordMustDiffer
@@ -172,7 +173,7 @@ type instance MapError 'NoIdentity = 'StaticError 403 "no-identity" "The user ha
 
 type instance MapError 'HandleExists = 'StaticError 409 "handle-exists" "The given handle is already taken"
 
-type instance MapError 'InvalidHandle = 'StaticError 400 "invalid-handle" "The given handle is invalid"
+type instance MapError 'InvalidHandle = 'StaticError 400 "invalid-handle" "The given handle is invalid (less than 2 or more than 256 characters; chars not in \"a-z0-9_.-\"; or on the blocklist)"
 
 type instance MapError 'HandleNotFound = 'StaticError 404 "not-found" "Handle not found"
 
@@ -238,9 +239,11 @@ type instance MapError 'AccountPending = 'StaticError 403 "pending-activation" "
 
 type instance MapError 'UserKeyExists = 'StaticError 409 "key-exists" "The given e-mail address or phone number is in use."
 
-type instance MapError 'NameManagedByScim = 'StaticError 403 "managed-by-scim" "Updating name is not allowed, because it is managed by SCIM"
+type instance MapError 'NameManagedByScim = 'StaticError 403 "managed-by-scim" "Updating name is not allowed, because it is managed by SCIM, or E2EId is enabled"
 
-type instance MapError 'HandleManagedByScim = 'StaticError 403 "managed-by-scim" "Updating handle is not allowed, because it is managed by SCIM"
+type instance MapError 'HandleManagedByScim = 'StaticError 403 "managed-by-scim" "Updating handle is not allowed, because it is managed by SCIM, or E2EId is enabled"
+
+type instance MapError 'LocaleManagedByScim = 'StaticError 403 "managed-by-scim" "Updating locale is not allowed, because it is managed by SCIM, or E2EId is enabled"
 
 type instance MapError 'LastIdentity = 'StaticError 403 "last-identity" "The last user identity (email or phone number) cannot be removed."
 

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

@@ -395,7 +395,7 @@ type AccountAPI =
                :> Put '[Servant.JSON] NoContent
            )
     :<|> Named
-           "iPutHandle"
+           "iPutUserName"
            ( "users"
                :> Capture "uid" UserId
                :> "name"

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

@@ -297,7 +297,7 @@ type SelfAPI =
     "get-self"
     ( Summary "Get your own profile"
         :> DescriptionOAuthScope 'ReadSelf
-        :> ZUser
+        :> ZLocalUser
         :> "self"
         :> Get '[JSON] SelfProfile
     )
@@ -334,11 +334,11 @@ type SelfAPI =
       "put-self"
       ( Summary "Update your profile."
           :> MakesFederatedCall 'Brig "send-connection-action"
-          :> ZUser
+          :> ZLocalUser
           :> ZConn
           :> "self"
           :> ReqBody '[JSON] UserUpdate
-          :> MultiVerb 'PUT '[JSON] PutSelfResponses (Maybe UpdateProfileError)
+          :> MultiVerb1 'PUT '[JSON] (RespondEmpty 200 "User updated")
       )
     :<|> Named
            "change-phone"
@@ -409,24 +409,24 @@ type SelfAPI =
            "change-locale"
            ( Summary "Change your locale."
                :> MakesFederatedCall 'Brig "send-connection-action"
-               :> ZUser
+               :> ZLocalUser
                :> ZConn
                :> "self"
                :> "locale"
                :> ReqBody '[JSON] LocaleUpdate
-               :> MultiVerb 'PUT '[JSON] '[RespondEmpty 200 "Local Changed"] ()
+               :> MultiVerb1 'PUT '[JSON] (RespondEmpty 200 "Local Changed")
            )
     :<|> Named
            "change-handle"
            ( Summary "Change your handle."
                :> MakesFederatedCall 'Brig "send-connection-action"
                :> MakesFederatedCall 'Brig "send-connection-action"
-               :> ZUser
+               :> ZLocalUser
                :> ZConn
                :> "self"
                :> "handle"
                :> ReqBody '[JSON] HandleUpdate
-               :> MultiVerb 'PUT '[JSON] ChangeHandleResponses (Maybe ChangeHandleError)
+               :> MultiVerb1 'PUT '[JSON] (RespondEmpty 200 "Handle Changed")
            )
     :<|> Named
            "change-supported-protocols"

libs/wire-api/src/Wire/API/Team/Feature.hs

@@ -97,6 +97,7 @@ import Data.Attoparsec.ByteString qualified as Parser
 import Data.ByteString (fromStrict)
 import Data.ByteString.Conversion
 import Data.ByteString.UTF8 qualified as UTF8
+import Data.Default
 import Data.Domain (Domain)
 import Data.Either.Extra (maybeToEither)
 import Data.Id
@@ -1242,6 +1243,31 @@ data AllFeatureConfigs = AllFeatureConfigs
   deriving stock (Eq, Show)
   deriving (FromJSON, ToJSON, S.ToSchema) via (Schema AllFeatureConfigs)
 
+instance Default AllFeatureConfigs where
+  def =
+    AllFeatureConfigs
+      { afcLegalholdStatus = defFeatureStatus,
+        afcSSOStatus = defFeatureStatus,
+        afcTeamSearchVisibilityAvailable = defFeatureStatus,
+        afcSearchVisibilityInboundConfig = defFeatureStatus,
+        afcValidateSAMLEmails = defFeatureStatus,
+        afcDigitalSignatures = defFeatureStatus,
+        afcAppLock = defFeatureStatus,
+        afcFileSharing = defFeatureStatus,
+        afcClassifiedDomains = defFeatureStatus,
+        afcConferenceCalling = defFeatureStatus,
+        afcSelfDeletingMessages = defFeatureStatus,
+        afcGuestLink = defFeatureStatus,
+        afcSndFactorPasswordChallenge = defFeatureStatus,
+        afcMLS = defFeatureStatus,
+        afcExposeInvitationURLsToTeamAdmin = defFeatureStatus,
+        afcOutlookCalIntegration = defFeatureStatus,
+        afcMlsE2EId = defFeatureStatus,
+        afcMlsMigration = defFeatureStatus,
+        afcEnforceFileDownloadLocation = defFeatureStatus,
+        afcLimitedEventFanout = defFeatureStatus
+      }
+
 instance ToSchema AllFeatureConfigs where
   schema =
     object "AllFeatureConfigs" $

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

@@ -2045,7 +2045,7 @@ instance ToSchema SendVerificationCode where
 -- Unlike 'ProtocolTag', this does not include any transitional protocols used
 -- for migration.
 data BaseProtocolTag = BaseProtocolProteusTag | BaseProtocolMLSTag
-  deriving stock (Eq, Ord, Show, Generic)
+  deriving stock (Eq, Ord, Enum, Bounded, Show, Generic)
   deriving (Arbitrary) via (GenericUniform BaseProtocolTag)
   deriving (FromJSON, ToJSON, S.ToSchema) via (Schema BaseProtocolTag)
 

libs/wire-api/wire-api.cabal

@@ -268,6 +268,7 @@ library
     , crypton
     , crypton-x509
     , currency-codes             >=2.0
+    , data-default
     , deriving-aeson             >=0.2
     , deriving-swagger2
     , either

libs/wire-subsystems/default.nix

@@ -18,6 +18,7 @@
 , cql
 , currency-codes
 , data-default
+, data-timeout
 , errors
 , exceptions
 , extended
@@ -56,6 +57,7 @@
 , transitive-anns
 , types-common
 , unliftio
+, unordered-containers
 , uuid
 , wai-utilities
 , wire-api
@@ -81,6 +83,7 @@ mkDerivation {
     cql
     currency-codes
     data-default
+    data-timeout
     errors
     exceptions
     extended
@@ -114,6 +117,7 @@ mkDerivation {
     transitive-anns
     types-common
     unliftio
+    unordered-containers
     uuid
     wai-utilities
     wire-api
@@ -127,11 +131,13 @@ mkDerivation {
     bytestring
     containers
     data-default
+    errors
     extended
     gundeck-types
     hspec
     imports
     iso639
+    lens
     polysemy
     polysemy-plugin
     polysemy-time
@@ -140,6 +146,7 @@ mkDerivation {
     quickcheck-instances
     servant-client-core
     string-conversions
+    text
     time
     transformers
     types-common