diff --git a/changelog.d/5-internal/servantify-register b/changelog.d/5-internal/servantify-register new file mode 100644 index 0000000000..f2c8d856df --- /dev/null +++ b/changelog.d/5-internal/servantify-register @@ -0,0 +1 @@ +Servantify `POST /register` and `POST /i/users` endpoints \ No newline at end of file diff --git a/libs/wire-api/package.yaml b/libs/wire-api/package.yaml index 02215683ab..2620d9b381 100644 --- a/libs/wire-api/package.yaml +++ b/libs/wire-api/package.yaml @@ -123,6 +123,7 @@ tests: - pretty - proto-lens - QuickCheck + - schema-profunctor - string-conversions - swagger2 - tasty diff --git a/libs/wire-api/src/Wire/API/ErrorDescription.hs b/libs/wire-api/src/Wire/API/ErrorDescription.hs index 49870a480f..73301bda8e 100644 --- a/libs/wire-api/src/Wire/API/ErrorDescription.hs +++ b/libs/wire-api/src/Wire/API/ErrorDescription.hs @@ -387,3 +387,29 @@ type MLSIdentityMismatch = 403 "mls-identity-mismatch" "Prekey credential does not match qualified client ID" + +type WhitelistError = ErrorDescription 403 "unauthorized" "Unauthorized e-mail address or phone number." + +type InvalidInvitationCode = ErrorDescription 400 "invalid-invitation-code" "Invalid invitation code." + +type MissingIdentity = ErrorDescription 403 "missing-identity" "Using an invitation code requires registering the given email and/or phone." + +type BlacklistedEmail = + ErrorDescription + 403 + "blacklisted-email" + "The given e-mail address has been blacklisted due to a permanent bounce \ + \or a complaint." + +type InvalidEmail = ErrorDescription 400 "invalid-email" "Invalid e-mail address." + +type InvalidActivationCode msg = ErrorDescription 404 "invalid-code" msg + +type InvalidActivationCodeWrongUser = InvalidActivationCode "User does not exist." + +type InvalidActivationCodeWrongCode = InvalidActivationCode "Invalid activation code" + +type TooManyTeamMembers = ErrorDescription 403 "too-many-team-members" "Too many members in this team." + +-- | docs/reference/user/registration.md {#RefRestrictRegistration}. +type UserCreationRestricted = ErrorDescription 403 "user-creation-restricted" "This instance does not allow creation of personal users or teams." diff --git a/libs/wire-api/src/Wire/API/Routes/Internal/Brig.hs b/libs/wire-api/src/Wire/API/Routes/Internal/Brig.hs index 8665d12ca7..e8747fb173 100644 --- a/libs/wire-api/src/Wire/API/Routes/Internal/Brig.hs +++ b/libs/wire-api/src/Wire/API/Routes/Internal/Brig.hs @@ -17,6 +17,8 @@ module Wire.API.Routes.Internal.Brig ( API, + EJPD_API, + AccountAPI, EJPDRequest, GetAccountFeatureConfig, PutAccountFeatureConfig, @@ -39,7 +41,10 @@ import Servant.Swagger.UI import Wire.API.Connection import Wire.API.Routes.Internal.Brig.Connection import Wire.API.Routes.Internal.Brig.EJPD +import Wire.API.Routes.MultiVerb +import Wire.API.Routes.Named import qualified Wire.API.Team.Feature as ApiFt +import Wire.API.User type EJPDRequest = Summary @@ -109,15 +114,29 @@ type GetAllConnections = :> ReqBody '[Servant.JSON] ConnectionsStatusRequestV2 :> Post '[Servant.JSON] [ConnectionStatusV2] +type EJPD_API = + ( EJPDRequest + :<|> GetAccountFeatureConfig + :<|> PutAccountFeatureConfig + :<|> DeleteAccountFeatureConfig + :<|> GetAllConnectionsUnqualified + :<|> GetAllConnections + ) + +type AccountAPI = + -- This endpoint can lead to the following events being sent: + -- - UserActivated event to created user, if it is a team invitation or user has an SSO ID + -- - UserIdentityUpdated event to created user, if email or phone get activated + Named + "createUserNoVerify" + ( "users" + :> ReqBody '[Servant.JSON] NewUser + :> MultiVerb 'POST '[Servant.JSON] RegisterInternalResponses (Either RegisterError SelfProfile) + ) + type API = "i" - :> ( EJPDRequest - :<|> GetAccountFeatureConfig - :<|> PutAccountFeatureConfig - :<|> DeleteAccountFeatureConfig - :<|> GetAllConnectionsUnqualified - :<|> GetAllConnections - ) + :> (EJPD_API :<|> AccountAPI) type SwaggerDocsAPI = "api" :> "internal" :> SwaggerSchemaUI "swagger-ui" "swagger.json" diff --git a/libs/wire-api/src/Wire/API/Routes/Named.hs b/libs/wire-api/src/Wire/API/Routes/Named.hs index 9688ef75f1..4e132b7f76 100644 --- a/libs/wire-api/src/Wire/API/Routes/Named.hs +++ b/libs/wire-api/src/Wire/API/Routes/Named.hs @@ -22,6 +22,7 @@ import Data.Proxy import GHC.TypeLits import Imports import Servant +import Servant.Client import Servant.Swagger newtype Named named x = Named {unnamed :: x} @@ -40,6 +41,11 @@ instance HasServer api ctx => HasServer (Named name api) ctx where instance RoutesToPaths api => RoutesToPaths (Named name api) where getRoutes = getRoutes @api +instance HasClient m api => HasClient m (Named n api) where + type Client m (Named n api) = Client m api + clientWithRoute pm _ req = clientWithRoute pm (Proxy @api) req + hoistClientMonad pm _ f = hoistClientMonad pm (Proxy @api) f + type family FindName n (api :: *) :: (n, *) where FindName n (Named name api) = '(name, api) FindName n (x :> api) = AddPrefix x (FindName n api) 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 9181305a43..83463b2133 100644 --- a/libs/wire-api/src/Wire/API/Routes/Public/Brig.hs +++ b/libs/wire-api/src/Wire/API/Routes/Public/Brig.hs @@ -312,6 +312,24 @@ type SelfAPI = :> MultiVerb 'PUT '[JSON] ChangeHandleResponses (Maybe ChangeHandleError) ) +type AccountAPI = + -- docs/reference/user/registration.md {#RefRegistration} + -- + -- This endpoint can lead to the following events being sent: + -- - UserActivated event to created user, if it is a team invitation or user has an SSO ID + -- - UserIdentityUpdated event to created user, if email code or phone code is provided + Named + "register" + ( Summary "Register a new user." + :> Description + "If the environment where the registration takes \ + \place is private and a registered email address or phone \ + \number is not whitelisted, a 403 error is returned." + :> "register" + :> ReqBody '[JSON] NewUserPublic + :> MultiVerb 'POST '[JSON] RegisterResponses (Either RegisterError RegisterSuccess) + ) + type PrekeyAPI = Named "get-users-prekeys-client-unqualified" @@ -714,6 +732,7 @@ type MLSAPI = LiftNamed (ZLocalUser :> "mls" :> MLSKeyPackageAPI) type BrigAPI = UserAPI :<|> SelfAPI + :<|> AccountAPI :<|> ClientAPI :<|> PrekeyAPI :<|> UserClientAPI diff --git a/libs/wire-api/src/Wire/API/Swagger.hs b/libs/wire-api/src/Wire/API/Swagger.hs index 4fbc4ed77c..89cfe1f3f4 100644 --- a/libs/wire-api/src/Wire/API/Swagger.hs +++ b/libs/wire-api/src/Wire/API/Swagger.hs @@ -113,7 +113,6 @@ models = Push.Token.modelPushTokenList, Team.modelTeam, Team.modelTeamList, - Team.modelNewBindingTeam, Team.modelNewNonBindingTeam, Team.modelUpdateData, Team.modelTeamDelete, @@ -141,7 +140,6 @@ models = Team.SearchVisibility.modelTeamSearchVisibility, User.modelUserIdList, User.modelUser, - User.modelNewUser, User.modelEmailUpdate, User.modelDelete, User.modelVerifyDelete, diff --git a/libs/wire-api/src/Wire/API/Team.hs b/libs/wire-api/src/Wire/API/Team.hs index 5b3563e181..8fb331559c 100644 --- a/libs/wire-api/src/Wire/API/Team.hs +++ b/libs/wire-api/src/Wire/API/Team.hs @@ -39,6 +39,7 @@ module Wire.API.Team -- * NewTeam BindingNewTeam (..), + bindingNewTeamObjectSchema, NonBindingNewTeam (..), NewTeam (..), newNewTeam, @@ -62,7 +63,6 @@ module Wire.API.Team -- * Swagger modelTeam, modelTeamList, - modelNewBindingTeam, modelNewNonBindingTeam, modelUpdateData, modelTeamDelete, @@ -181,24 +181,14 @@ newtype BindingNewTeam = BindingNewTeam (NewTeam ()) deriving stock (Eq, Show, Generic) deriving (ToJSON, FromJSON, S.ToSchema) via (Schema BindingNewTeam) -modelNewBindingTeam :: Doc.Model -modelNewBindingTeam = Doc.defineModel "NewBindingTeam" $ do - Doc.description "Required data when creating new teams" - Doc.property "name" Doc.string' $ - Doc.description "team name" - Doc.property "icon" Doc.string' $ - Doc.description "team icon (asset ID)" - Doc.property "icon_key" Doc.string' $ do - Doc.description "team icon asset key" - Doc.optional - instance ToSchema BindingNewTeam where - schema = BindingNewTeam <$> unwrap .= newTeamSchema "BindingNewTeam" sch - where - unwrap (BindingNewTeam nt) = nt + schema = object "BindingNewTeam" bindingNewTeamObjectSchema - sch :: ValueSchema SwaggerDoc () - sch = null_ +bindingNewTeamObjectSchema :: ObjectSchema SwaggerDoc BindingNewTeam +bindingNewTeamObjectSchema = + BindingNewTeam <$> unwrap .= newTeamObjectSchema null_ + where + unwrap (BindingNewTeam nt) = nt -- FUTUREWORK: since new team members do not get serialized, we zero them here. -- it may be worth looking into how this can be solved in the types. @@ -214,7 +204,10 @@ newtype NonBindingNewTeam = NonBindingNewTeam (NewTeam (Range 1 127 [TeamMember] deriving (FromJSON, ToJSON, S.ToSchema) via (Schema NonBindingNewTeam) instance ToSchema NonBindingNewTeam where - schema = NonBindingNewTeam <$> unwrap .= newTeamSchema "NonBindingNewTeam" sch + schema = + object "NonBindingNewTeam" $ + NonBindingNewTeam + <$> unwrap .= newTeamObjectSchema sch where unwrap (NonBindingNewTeam nt) = nt @@ -247,14 +240,13 @@ data NewTeam a = NewTeam newNewTeam :: Range 1 256 Text -> Range 1 256 Text -> NewTeam a newNewTeam nme ico = NewTeam nme ico Nothing Nothing -newTeamSchema :: HasSchemaRef d => Text -> ValueSchema d a -> ValueSchema NamedSwaggerDoc (NewTeam a) -newTeamSchema name sch = - object name $ - NewTeam - <$> _newTeamName .= field "name" schema - <*> _newTeamIcon .= field "icon" schema - <*> _newTeamIconKey .= maybe_ (optField "icon_key" schema) - <*> _newTeamMembers .= maybe_ (optField "members" sch) +newTeamObjectSchema :: ValueSchema SwaggerDoc a -> ObjectSchema SwaggerDoc (NewTeam a) +newTeamObjectSchema sch = + NewTeam + <$> _newTeamName .= field "name" schema + <*> _newTeamIcon .= field "icon" schema + <*> _newTeamIconKey .= maybe_ (optField "icon_key" schema) + <*> _newTeamMembers .= maybe_ (optField "members" sch) -------------------------------------------------------------------------------- -- TeamUpdateData diff --git a/libs/wire-api/src/Wire/API/User.hs b/libs/wire-api/src/Wire/API/User.hs index f097607fd7..148fd4a702 100644 --- a/libs/wire-api/src/Wire/API/User.hs +++ b/libs/wire-api/src/Wire/API/User.hs @@ -37,6 +37,10 @@ module Wire.API.User -- * NewUser NewUserPublic (..), + RegisterError (..), + RegisterSuccess (..), + RegisterResponses, + RegisterInternalResponses, NewUser (..), emptyNewUser, ExpiresIn, @@ -83,9 +87,6 @@ module Wire.API.User -- * List Users ListUsersQuery (..), - -- * helpers - parseIdentity, - -- * re-exports module Wire.API.User.Identity, module Wire.API.User.Profile, @@ -93,7 +94,6 @@ module Wire.API.User -- * Swagger modelDelete, modelEmailUpdate, - modelNewUser, modelUser, modelUserIdList, modelVerifyDelete, @@ -107,9 +107,8 @@ where import Control.Applicative import Control.Error.Safe (rightMay) -import Control.Lens (over, view, (.~), (?~)) +import Control.Lens (over, (.~), (?~)) import Data.Aeson (FromJSON (..), ToJSON (..)) -import qualified Data.Aeson.KeyMap as KeyMap import qualified Data.Aeson.Types as A import Data.ByteString.Conversion import qualified Data.CaseInsensitive as CI @@ -121,7 +120,6 @@ import qualified Data.HashMap.Strict.InsOrd as InsOrdHashMap import Data.Id import Data.Json.Util (UTCTimeMillis, (#)) import Data.LegalHold (UserLegalHoldStatus) -import qualified Data.List as List import Data.Misc (PlainTextPassword (..)) import Data.Qualified import Data.Range @@ -139,11 +137,12 @@ import Imports import qualified SAML2.WebSSO as SAML import Servant (type (.++)) import qualified Test.QuickCheck as QC +import qualified Web.Cookie as Web 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.Team (BindingNewTeam, bindingNewTeamObjectSchema) import Wire.API.User.Activation (ActivationCode) import Wire.API.User.Auth (CookieLabel) import Wire.API.User.Identity @@ -338,77 +337,28 @@ data User = User } deriving stock (Eq, Show, Generic) deriving (Arbitrary) via (GenericUniform User) + deriving (ToJSON, FromJSON, S.ToSchema) via (Schema User) --- Cannot use deriving (ToSchema) via (CustomSwagger ...) because we need to --- mark 'deleted' as optional, but it is not a 'Maybe' --- and we need to manually add the identity schema fields at the top level --- instead of nesting them under the 'identity' field. -instance S.ToSchema User where - declareNamedSchema _ = do - identityProperties <- view (S.schema . S.properties) <$> S.declareNamedSchema (Proxy @UserIdentity) - genericSchema <- - S.genericDeclareNamedSchema - ( swaggerOptions - @'[ FieldLabelModifier - ( StripPrefix "user", - CamelToSnake, - LabelMappings - '[ "pict" ':-> "picture", - "expire" ':-> "expires_at", - "display_name" ':-> "name" - ] - ) - ] - ) - (Proxy @User) - pure $ - genericSchema - & over (S.schema . S.required) (List.delete "deleted") - -- The UserIdentity fields need to be flat-included, not be in a sub-object - & over (S.schema . S.properties) (InsOrdHashMap.delete "identity") - & over (S.schema . S.properties) (InsOrdHashMap.union identityProperties) - --- FUTUREWORK: --- disentangle json serializations for 'User', 'NewUser', 'UserIdentity', 'NewUserOrigin'. -instance ToJSON User where - toJSON u = - A.object $ - "id" A..= userId u - # "qualified_id" A..= userQualifiedId u - # "name" A..= userDisplayName u - # "picture" A..= userPict u - # "assets" A..= userAssets u - # "email" A..= userEmail u - # "phone" A..= userPhone u - # "accent_id" A..= userAccentId u - # "deleted" A..= (if userDeleted u then Just True else Nothing) - # "locale" A..= userLocale u - # "service" A..= userService u - # "handle" A..= userHandle u - # "expires_at" A..= userExpire u - # "team" A..= userTeam u - # "sso_id" A..= userSSOId u - # "managed_by" A..= userManagedBy u - # [] - -instance FromJSON User where - parseJSON = A.withObject "user" $ \o -> do - ssoid <- o A..:? "sso_id" - User - <$> o A..: "id" - <*> o A..: "qualified_id" - <*> parseIdentity ssoid o - <*> o A..: "name" - <*> o A..:? "picture" A..!= noPict - <*> o A..:? "assets" A..!= [] - <*> o A..: "accent_id" - <*> o A..:? "deleted" A..!= False - <*> o A..: "locale" - <*> o A..:? "service" - <*> o A..:? "handle" - <*> o A..:? "expires_at" - <*> o A..:? "team" - <*> o A..:? "managed_by" A..!= ManagedByWire +-- -- FUTUREWORK: +-- -- disentangle json serializations for 'User', 'NewUser', 'UserIdentity', 'NewUserOrigin'. +instance ToSchema User where + schema = + object "User" $ + User + <$> userId .= field "id" schema + <*> userQualifiedId .= field "qualified_id" schema + <*> userIdentity .= maybeUserIdentityObjectSchema + <*> userDisplayName .= field "name" schema + <*> userPict .= (fromMaybe noPict <$> optField "picture" schema) + <*> userAssets .= (fromMaybe [] <$> optField "assets" (array schema)) + <*> userAccentId .= field "accent_id" schema + <*> (fromMaybe False <$> (\u -> if userDeleted u then Just True else Nothing) .= maybe_ (optField "deleted" schema)) + <*> userLocale .= field "locale" schema + <*> userService .= maybe_ (optField "service" schema) + <*> userHandle .= maybe_ (optField "handle" schema) + <*> userExpire .= maybe_ (optField "expires_at" schema) + <*> userTeam .= maybe_ (optField "team" schema) + <*> userManagedBy .= (fromMaybe ManagedByWire <$> optField "managed_by" schema) userEmail :: User -> Maybe Email userEmail = emailIdentity <=< userIdentity @@ -502,56 +452,13 @@ publicProfile u legalHoldStatus = -- SCIM-managed user) newtype NewUserPublic = NewUserPublic NewUser deriving stock (Eq, Show, Generic) - deriving newtype (ToJSON) + deriving (ToJSON, FromJSON, S.ToSchema) via (Schema NewUserPublic) -modelNewUser :: Doc.Model -modelNewUser = Doc.defineModel "NewUser" $ do - Doc.description "New User Data" - Doc.property "name" Doc.string' $ - Doc.description "Name (1 - 128 characters)" - Doc.property "email" Doc.string' $ do - Doc.description "Email address" - Doc.optional - Doc.property "password" Doc.string' $ do - Doc.description "Password (6 - 1024 characters)" - Doc.optional - Doc.property "assets" (Doc.array (Doc.ref modelAsset)) $ do - Doc.description "Profile assets" - Doc.optional - Doc.property "phone" Doc.string' $ do - Doc.description "E.164 phone number" - Doc.optional - Doc.property "accent_id" Doc.int32' $ do - Doc.description "Accent colour ID" - Doc.optional - Doc.property "email_code" Doc.bytes' $ do - Doc.description "Email activation code" - Doc.optional - Doc.property "phone_code" Doc.bytes' $ do - Doc.description "Phone activation code" - Doc.optional - Doc.property "invitation_code" Doc.bytes' $ do - Doc.description "Invitation code. Mutually exclusive with team|team_code" - Doc.optional - Doc.property "locale" Doc.string' $ do - Doc.description "Locale in format." - Doc.optional - Doc.property "label" Doc.string' $ do - Doc.description - "An optional label to associate with the access cookie, \ - \if one is granted during account creation." - Doc.optional - Doc.property "team_code" Doc.string' $ do - Doc.description "Team invitation code. Mutually exclusive with team|invitation_code" - Doc.optional - Doc.property "team" (Doc.ref modelNewBindingTeam) $ do - Doc.description "New team information. Mutually exclusive with team_code|invitation_code" - Doc.optional - -instance FromJSON NewUserPublic where - parseJSON val = do - nu <- parseJSON val - either fail pure $ validateNewUserPublic nu +instance ToSchema NewUserPublic where + schema = + unwrap .= withParser schema (either fail pure . validateNewUserPublic) + where + unwrap (NewUserPublic nu) = nu validateNewUserPublic :: NewUser -> Either String NewUserPublic validateNewUserPublic nu @@ -586,6 +493,75 @@ isNewUserTeamMember u = case newUserTeam u of instance Arbitrary NewUserPublic where arbitrary = arbitrary `QC.suchThatMap` (rightMay . validateNewUserPublic) +data RegisterError + = RegisterErrorWhitelistError + | RegisterErrorInvalidInvitationCode + | RegisterErrorMissingIdentity + | RegisterErrorUserKeyExists + | RegisterErrorInvalidActivationCodeWrongUser + | RegisterErrorInvalidActivationCodeWrongCode + | RegisterErrorInvalidEmail + | RegisterErrorInvalidPhone + | RegisterErrorBlacklistedPhone + | RegisterErrorBlacklistedEmail + | RegisterErrorTooManyTeamMembers + | RegisterErrorUserCreationRestricted + deriving (Generic) + deriving (AsUnion RegisterErrorResponses) via GenericAsUnion RegisterErrorResponses RegisterError + +instance GSOP.Generic RegisterError + +type RegisterErrorResponses = + '[ WhitelistError, + InvalidInvitationCode, + MissingIdentity, + UserKeyExists, + InvalidActivationCodeWrongUser, + InvalidActivationCodeWrongCode, + InvalidEmail, + InvalidPhone, + BlacklistedPhone, + BlacklistedEmail, + TooManyTeamMembers, + UserCreationRestricted + ] + +type RegisterResponses = + RegisterErrorResponses + .++ '[ WithHeaders + '[ DescHeader "Set-Cookie" "Cookie" Web.SetCookie, + DescHeader "Location" "UserId" UserId + ] + RegisterSuccess + (Respond 201 "User created and pending activation" SelfProfile) + ] + +instance AsHeaders '[Web.SetCookie, UserId] SelfProfile RegisterSuccess where + fromHeaders (I cookie :* (_ :* Nil), sp) = RegisterSuccess cookie sp + toHeaders (RegisterSuccess cookie sp) = (I cookie :* (I (userId (selfUser sp)) :* Nil), sp) + +data RegisterSuccess = RegisterSuccess Web.SetCookie SelfProfile + +instance (res ~ RegisterResponses) => AsUnion res (Either RegisterError RegisterSuccess) where + toUnion = eitherToUnion (toUnion @RegisterErrorResponses) (Z . I) + fromUnion = eitherFromUnion (fromUnion @RegisterErrorResponses) (unI . unZ) + +type RegisterInternalResponses = + RegisterErrorResponses + .++ '[ WithHeaders + '[DescHeader "Location" "UserId" UserId] + SelfProfile + (Respond 201 "User created and pending activation" SelfProfile) + ] + +instance AsHeaders '[UserId] SelfProfile SelfProfile where + fromHeaders (_ :* Nil, sp) = sp + toHeaders sp = (I (userId (selfUser sp)) :* Nil, sp) + +instance (res ~ RegisterInternalResponses) => AsUnion res (Either RegisterError SelfProfile) where + toUnion = eitherToUnion (toUnion @RegisterErrorResponses) (Z . I) + fromUnion = eitherFromUnion (fromUnion @RegisterErrorResponses) (unI . unZ) + data NewUser = NewUser { newUserDisplayName :: Name, -- | use this as 'UserId' (if 'Nothing', call 'Data.UUID.nextRandom'). @@ -605,6 +581,7 @@ data NewUser = NewUser newUserManagedBy :: Maybe ManagedBy } deriving stock (Eq, Show, Generic) + deriving (ToJSON, FromJSON, S.ToSchema) via (Schema NewUser) emptyNewUser :: Name -> NewUser emptyNewUser name = @@ -628,47 +605,112 @@ emptyNewUser name = -- | 1 second - 1 week type ExpiresIn = Range 1 604800 Integer -instance ToJSON NewUser where - toJSON u = - A.object $ - "name" A..= newUserDisplayName u - # "uuid" A..= newUserUUID u - # "email" A..= newUserEmail u - # "email_code" A..= newUserEmailCode u - # "picture" A..= newUserPict u - # "assets" A..= newUserAssets u - # "phone" A..= newUserPhone u - # "phone_code" A..= newUserPhoneCode u - # "accent_id" A..= newUserAccentId u - # "label" A..= newUserLabel u - # "locale" A..= newUserLocale u - # "password" A..= newUserPassword u - # "expires_in" A..= newUserExpiresIn u - # "sso_id" A..= newUserSSOId u - # "managed_by" A..= newUserManagedBy u - # maybe [] jsonNewUserOrigin (newUserOrigin u) - -instance FromJSON NewUser where - parseJSON = A.withObject "new-user" $ \o -> do - ssoid <- o A..:? "sso_id" - newUserDisplayName <- o A..: "name" - newUserUUID <- o A..:? "uuid" - newUserIdentity <- parseIdentity ssoid o - newUserPict <- o A..:? "picture" - newUserAssets <- o A..:? "assets" A..!= [] - newUserAccentId <- o A..:? "accent_id" - newUserEmailCode <- o A..:? "email_code" - newUserPhoneCode <- o A..:? "phone_code" - newUserLabel <- o A..:? "label" - newUserLocale <- o A..:? "locale" - newUserPassword <- o A..:? "password" - newUserOrigin <- parseNewUserOrigin newUserPassword newUserIdentity ssoid o - newUserExpires <- o A..:? "expires_in" - newUserExpiresIn <- case (newUserExpires, newUserIdentity) of +-- | Raw representation of 'NewUser' to help with writing Schema instances. +data NewUserRaw = NewUserRaw + { newUserRawDisplayName :: Name, + newUserRawUUID :: Maybe UUID, + newUserRawEmail :: Maybe Email, + newUserRawPhone :: Maybe Phone, + newUserRawSSOId :: Maybe UserSSOId, + -- | DEPRECATED + newUserRawPict :: Maybe Pict, + newUserRawAssets :: [Asset], + newUserRawAccentId :: Maybe ColourId, + newUserRawEmailCode :: Maybe ActivationCode, + newUserRawPhoneCode :: Maybe ActivationCode, + newUserRawInvitationCode :: Maybe InvitationCode, + newUserRawTeamCode :: Maybe InvitationCode, + newUserRawTeam :: Maybe BindingNewTeamUser, + newUserRawTeamId :: Maybe TeamId, + newUserRawLabel :: Maybe CookieLabel, + newUserRawLocale :: Maybe Locale, + newUserRawPassword :: Maybe PlainTextPassword, + newUserRawExpiresIn :: Maybe ExpiresIn, + newUserRawManagedBy :: Maybe ManagedBy + } + +newUserRawObjectSchema :: ObjectSchema SwaggerDoc NewUserRaw +newUserRawObjectSchema = + NewUserRaw + <$> newUserRawDisplayName .= field "name" schema + <*> newUserRawUUID .= maybe_ (optField "uuid" genericToSchema) + <*> newUserRawEmail .= maybe_ (optField "email" schema) + <*> newUserRawPhone .= maybe_ (optField "phone" schema) + <*> newUserRawSSOId .= maybe_ (optField "sso_id" genericToSchema) + <*> newUserRawPict .= maybe_ (optField "picture" schema) + <*> newUserRawAssets .= (fromMaybe [] <$> optField "assets" (array schema)) + <*> newUserRawAccentId .= maybe_ (optField "accent_id" schema) + <*> newUserRawEmailCode .= maybe_ (optField "email_code" schema) + <*> newUserRawPhoneCode .= maybe_ (optField "phone_code" schema) + <*> newUserRawInvitationCode .= maybe_ (optField "invitation_code" schema) + <*> newUserRawTeamCode .= maybe_ (optField "team_code" schema) + <*> newUserRawTeam .= maybe_ (optField "team" schema) + <*> newUserRawTeamId .= maybe_ (optField "team_id" schema) + <*> newUserRawLabel .= maybe_ (optField "label" schema) + <*> newUserRawLocale .= maybe_ (optField "locale" schema) + <*> newUserRawPassword .= maybe_ (optField "password" schema) + <*> newUserRawExpiresIn .= maybe_ (optField "expires_in" schema) + <*> newUserRawManagedBy .= maybe_ (optField "managed_by" schema) + +instance ToSchema NewUser where + schema = + object "NewUser" $ newUserToRaw .= withParser newUserRawObjectSchema newUserFromRaw + +newUserToRaw :: NewUser -> NewUserRaw +newUserToRaw NewUser {..} = + let maybeOriginNTU = newUserOriginNewTeamUser =<< newUserOrigin + in NewUserRaw + { newUserRawDisplayName = newUserDisplayName, + newUserRawUUID = newUserUUID, + newUserRawEmail = emailIdentity =<< newUserIdentity, + newUserRawPhone = phoneIdentity =<< newUserIdentity, + newUserRawSSOId = ssoIdentity =<< newUserIdentity, + newUserRawPict = newUserPict, + newUserRawAssets = newUserAssets, + newUserRawAccentId = newUserAccentId, + newUserRawEmailCode = newUserEmailCode, + newUserRawPhoneCode = newUserPhoneCode, + newUserRawInvitationCode = newUserOriginInvitationCode =<< newUserOrigin, + newUserRawTeamCode = newTeamUserCode =<< maybeOriginNTU, + newUserRawTeam = newTeamUserCreator =<< maybeOriginNTU, + newUserRawTeamId = newTeamUserTeamId =<< maybeOriginNTU, + newUserRawLabel = newUserLabel, + newUserRawLocale = newUserLocale, + newUserRawPassword = newUserPassword, + newUserRawExpiresIn = newUserExpiresIn, + newUserRawManagedBy = newUserManagedBy + } + +newUserFromRaw :: NewUserRaw -> A.Parser NewUser +newUserFromRaw NewUserRaw {..} = do + origin <- + either fail pure $ + maybeNewUserOriginFromComponents + (isJust newUserRawPassword) + (isJust newUserRawSSOId) + (newUserRawInvitationCode, newUserRawTeamCode, newUserRawTeam, newUserRawTeamId) + let identity = maybeUserIdentityFromComponents (newUserRawEmail, newUserRawPhone, newUserRawSSOId) + expiresIn <- + case (newUserRawExpiresIn, identity) of (Just _, Just _) -> fail "Only users without an identity can expire" - _ -> return newUserExpires - newUserManagedBy <- o A..:? "managed_by" - return NewUser {..} + _ -> pure newUserRawExpiresIn + pure $ + NewUser + { newUserDisplayName = newUserRawDisplayName, + newUserUUID = newUserRawUUID, + newUserIdentity = identity, + newUserPict = newUserRawPict, + newUserAssets = newUserRawAssets, + newUserAccentId = newUserRawAccentId, + newUserEmailCode = newUserRawEmailCode, + newUserPhoneCode = newUserRawPhoneCode, + newUserOrigin = origin, + newUserLabel = newUserRawLabel, + newUserLocale = newUserRawLocale, + newUserPassword = newUserRawPassword, + newUserExpiresIn = expiresIn, + newUserManagedBy = newUserRawManagedBy + } -- FUTUREWORK: align more with FromJSON instance? instance Arbitrary NewUser where @@ -739,56 +781,46 @@ data NewUserOrigin deriving stock (Eq, Show, Generic) deriving (Arbitrary) via (GenericUniform NewUserOrigin) -jsonNewUserOrigin :: NewUserOrigin -> [A.Pair] -jsonNewUserOrigin = \case - NewUserOriginInvitationCode inv -> ["invitation_code" A..= inv] - NewUserOriginTeamUser (NewTeamMember tc) -> ["team_code" A..= tc] - NewUserOriginTeamUser (NewTeamCreator team) -> ["team" A..= team] - NewUserOriginTeamUser (NewTeamMemberSSO ti) -> ["team_id" A..= ti] - -parseNewUserOrigin :: - Maybe PlainTextPassword -> - Maybe UserIdentity -> - Maybe UserSSOId -> - A.Object -> - A.Parser (Maybe NewUserOrigin) -parseNewUserOrigin pass uid ssoid o = do - invcode <- o A..:? "invitation_code" - teamcode <- o A..:? "team_code" - team <- o A..:? "team" - teamid <- o A..:? "team_id" - result <- case (invcode, teamcode, team, ssoid, teamid) of - (Just a, Nothing, Nothing, Nothing, Nothing) -> return . Just . NewUserOriginInvitationCode $ a - (Nothing, Just a, Nothing, Nothing, Nothing) -> return . Just . NewUserOriginTeamUser $ NewTeamMember a - (Nothing, Nothing, Just a, Nothing, Nothing) -> return . Just . NewUserOriginTeamUser $ NewTeamCreator a - (Nothing, Nothing, Nothing, Just _, Just t) -> return . Just . NewUserOriginTeamUser $ NewTeamMemberSSO t - (Nothing, Nothing, Nothing, Nothing, Nothing) -> return Nothing - (_, _, _, Just _, Nothing) -> fail "sso_id, team_id must be either both present or both absent." - (_, _, _, Nothing, Just _) -> fail "sso_id, team_id must be either both present or both absent." - _ -> fail "team_code, team, invitation_code, sso_id, and the pair (sso_id, team_id) are mutually exclusive" - case (result, pass, uid) of - (_, _, Just SSOIdentity {}) -> pure result - (Just (NewUserOriginTeamUser _), Nothing, _) -> fail "all team users must set a password on creation" +type NewUserOriginComponents = (Maybe InvitationCode, Maybe InvitationCode, Maybe BindingNewTeamUser, Maybe TeamId) + +newUserOriginInvitationCode :: NewUserOrigin -> Maybe InvitationCode +newUserOriginInvitationCode = \case + NewUserOriginInvitationCode ic -> Just ic + NewUserOriginTeamUser _ -> Nothing + +newUserOriginNewTeamUser :: NewUserOrigin -> Maybe NewTeamUser +newUserOriginNewTeamUser = \case + NewUserOriginInvitationCode _ -> Nothing + NewUserOriginTeamUser ntu -> Just ntu + +maybeNewUserOriginFromComponents :: + -- | Does the user have a password + Bool -> + -- | Does the user have an SSO Identity + Bool -> + NewUserOriginComponents -> + Either String (Maybe NewUserOrigin) +maybeNewUserOriginFromComponents hasPassword hasSSO (invcode, teamcode, team, teamid) = do + result <- case (invcode, teamcode, team, hasSSO, teamid) of + (Just a, Nothing, Nothing, False, Nothing) -> Right . Just . NewUserOriginInvitationCode $ a + (Nothing, Just a, Nothing, False, Nothing) -> Right . Just . NewUserOriginTeamUser $ NewTeamMember a + (Nothing, Nothing, Just a, False, Nothing) -> Right . Just . NewUserOriginTeamUser $ NewTeamCreator a + (Nothing, Nothing, Nothing, True, Just t) -> Right . Just . NewUserOriginTeamUser $ NewTeamMemberSSO t + (Nothing, Nothing, Nothing, False, Nothing) -> Right Nothing + (_, _, _, True, Nothing) -> Left "sso_id, team_id must be either both present or both absent." + (_, _, _, False, Just _) -> Left "sso_id, team_id must be either both present or both absent." + _ -> Left "team_code, team, invitation_code, sso_id, and the pair (sso_id, team_id) are mutually exclusive" + case (result, hasPassword, hasSSO) of + (_, _, True) -> Right result + (Just (NewUserOriginTeamUser _), False, _) -> Left "all team users must set a password on creation" _ -> pure result -- | A random invitation code for use during registration newtype InvitationCode = InvitationCode {fromInvitationCode :: AsciiBase64Url} deriving stock (Eq, Show, Generic) - deriving newtype (FromJSON, ToJSON, ToByteString, FromByteString, Arbitrary) - --------------------------------------------------------------------------------- --- helpers - --- | Fails if email or phone or ssoid are present but invalid. --- If neither are present, it will not fail, but return Nothing. --- --- FUTUREWORK: Why is the SSO ID passed separately? -parseIdentity :: Maybe UserSSOId -> A.Object -> A.Parser (Maybe UserIdentity) -parseIdentity ssoid o = - if isJust (KeyMap.lookup "email" o <|> KeyMap.lookup "phone" o) || isJust ssoid - then Just <$> parseJSON (A.Object o) - else pure Nothing + deriving newtype (ToSchema, ToByteString, FromByteString, Arbitrary) + deriving (FromJSON, ToJSON, S.ToSchema) via Schema InvitationCode -------------------------------------------------------------------------------- -- NewTeamUser @@ -802,6 +834,24 @@ data NewTeamUser deriving stock (Eq, Show, Generic) deriving (Arbitrary) via (GenericUniform NewTeamUser) +newTeamUserCode :: NewTeamUser -> Maybe InvitationCode +newTeamUserCode = \case + NewTeamMember ic -> Just ic + NewTeamCreator _ -> Nothing + NewTeamMemberSSO _ -> Nothing + +newTeamUserCreator :: NewTeamUser -> Maybe BindingNewTeamUser +newTeamUserCreator = \case + NewTeamMember _ -> Nothing + NewTeamCreator bntu -> Just bntu + NewTeamMemberSSO _ -> Nothing + +newTeamUserTeamId :: NewTeamUser -> Maybe TeamId +newTeamUserTeamId = \case + NewTeamMember _ -> Nothing + NewTeamCreator _ -> Nothing + NewTeamMemberSSO tid -> Just tid + data BindingNewTeamUser = BindingNewTeamUser { bnuTeam :: BindingNewTeam, bnuCurrency :: Maybe Currency.Alpha @@ -810,28 +860,14 @@ data BindingNewTeamUser = BindingNewTeamUser } deriving stock (Eq, Show, Generic) deriving (Arbitrary) via (GenericUniform BindingNewTeamUser) + deriving (ToJSON, FromJSON, S.ToSchema) via (Schema BindingNewTeamUser) -instance ToJSON BindingNewTeamUser where - toJSON (BindingNewTeamUser (BindingNewTeam t) c) = - A.object $ - "currency" A..= c - # newTeamJson t - where - -- FUTUREWORK(leif): this was originally defined in libs/wire-api/src/Wire/API/Team.hs and I moved it here - -- during the process of servantifying, it should go away when servantification is complete - newTeamJson :: NewTeam a -> [A.Pair] - newTeamJson (NewTeam n i ik _) = - "name" A..= fromRange n - # "icon" A..= fromRange i - # "icon_key" A..= (fromRange <$> ik) - # [] - -instance FromJSON BindingNewTeamUser where - parseJSON j@(A.Object o) = do - c <- o A..:? "currency" - t <- parseJSON j - return $ BindingNewTeamUser t c - parseJSON _ = fail "parseJSON BindingNewTeamUser: must be an object" +instance ToSchema BindingNewTeamUser where + schema = + object "BindingNewTeamUser" $ + BindingNewTeamUser + <$> bnuTeam .= bindingNewTeamObjectSchema + <*> bnuCurrency .= maybe_ (optField "currency" genericToSchema) -------------------------------------------------------------------------------- -- Profile Updates diff --git a/libs/wire-api/src/Wire/API/User/Activation.hs b/libs/wire-api/src/Wire/API/User/Activation.hs index a4a2f2a056..d97b12eb70 100644 --- a/libs/wire-api/src/Wire/API/User/Activation.hs +++ b/libs/wire-api/src/Wire/API/User/Activation.hs @@ -43,6 +43,8 @@ where import Data.Aeson import Data.ByteString.Conversion import Data.Json.Util ((#)) +import Data.Schema (Schema (..), ToSchema, schemaIn) +import qualified Data.Swagger as S import qualified Data.Swagger.Build.Api as Doc import Data.Text.Ascii import Imports @@ -84,7 +86,8 @@ newtype ActivationKey = ActivationKey newtype ActivationCode = ActivationCode {fromActivationCode :: AsciiBase64Url} deriving stock (Eq, Show, Generic) - deriving newtype (ToByteString, FromByteString, ToJSON, FromJSON, Arbitrary) + deriving newtype (ToByteString, FromByteString, ToSchema, Arbitrary) + deriving (ToJSON, FromJSON, S.ToSchema) via Schema ActivationCode -------------------------------------------------------------------------------- -- Activate @@ -181,7 +184,7 @@ instance ToJSON ActivationResponse where instance FromJSON ActivationResponse where parseJSON = withObject "ActivationResponse" $ \o -> ActivationResponse - <$> parseJSON (Object o) + <$> schemaIn userIdentityObjectSchema o <*> o .:? "first" .!= False -------------------------------------------------------------------------------- diff --git a/libs/wire-api/src/Wire/API/User/Identity.hs b/libs/wire-api/src/Wire/API/User/Identity.hs index 07ca0f4bc9..4b1e2fcc27 100644 --- a/libs/wire-api/src/Wire/API/User/Identity.hs +++ b/libs/wire-api/src/Wire/API/User/Identity.hs @@ -26,6 +26,9 @@ module Wire.API.User.Identity emailIdentity, phoneIdentity, ssoIdentity, + userIdentityObjectSchema, + maybeUserIdentityObjectSchema, + maybeUserIdentityFromComponents, -- * Email Email (..), @@ -50,7 +53,7 @@ module Wire.API.User.Identity where import Control.Applicative (optional) -import Control.Lens (over, (.~), (?~), (^.)) +import Control.Lens (dimap, over, (.~), (?~), (^.)) import Data.Aeson (FromJSON (..), ToJSON (..)) import qualified Data.Aeson as A import qualified Data.Aeson.Types as A @@ -65,6 +68,7 @@ import qualified Data.Swagger as S import qualified Data.Text as Text import Data.Text.Encoding (decodeUtf8', encodeUtf8) import Data.Time.Clock +import Data.Tuple.Extra (fst3, snd3, thd3) import Imports import SAML2.WebSSO.Test.Arbitrary () import qualified SAML2.WebSSO.Types as SAML @@ -91,40 +95,37 @@ data UserIdentity deriving stock (Eq, Show, Generic) deriving (Arbitrary) via (GenericUniform UserIdentity) -instance S.ToSchema UserIdentity where - declareNamedSchema _ = do - emailSchema <- S.declareSchemaRef (Proxy @Email) - phoneSchema <- S.declareSchemaRef (Proxy @Phone) - ssoSchema <- S.declareSchemaRef (Proxy @UserSSOId) - return $ - S.NamedSchema (Just "userIdentity") $ - mempty - & S.type_ ?~ S.SwaggerObject - & S.properties - .~ [ ("email", emailSchema), - ("phone", phoneSchema), - ("sso_id", ssoSchema) - ] - -instance ToJSON UserIdentity where - toJSON = \case - FullIdentity em ph -> go (Just em) (Just ph) Nothing - EmailIdentity em -> go (Just em) Nothing Nothing - PhoneIdentity ph -> go Nothing (Just ph) Nothing - SSOIdentity si em ph -> go em ph (Just si) - where - go :: Maybe Email -> Maybe Phone -> Maybe UserSSOId -> A.Value - go em ph si = A.object ["email" A..= em, "phone" A..= ph, "sso_id" A..= si] - -instance FromJSON UserIdentity where - parseJSON = A.withObject "UserIdentity" $ \o -> do - email <- o A..:? "email" - phone <- o A..:? "phone" - ssoid <- o A..:? "sso_id" - maybe - (fail "Missing 'email' or 'phone' or 'sso_id'.") - return - (newIdentity email phone ssoid) +userIdentityObjectSchema :: ObjectSchema SwaggerDoc UserIdentity +userIdentityObjectSchema = + Just .= withParser maybeUserIdentityObjectSchema (maybe (fail "Missing 'email' or 'phone' or 'sso_id'.") pure) + +maybeUserIdentityObjectSchema :: ObjectSchema SwaggerDoc (Maybe UserIdentity) +maybeUserIdentityObjectSchema = + dimap maybeUserIdentityToComponents maybeUserIdentityFromComponents userIdentityComponentsObjectSchema + +type UserIdentityComponents = (Maybe Email, Maybe Phone, Maybe UserSSOId) + +userIdentityComponentsObjectSchema :: ObjectSchema SwaggerDoc UserIdentityComponents +userIdentityComponentsObjectSchema = + (,,) + <$> fst3 .= maybe_ (optField "email" schema) + <*> snd3 .= maybe_ (optField "phone" schema) + <*> thd3 .= maybe_ (optField "sso_id" genericToSchema) + +maybeUserIdentityFromComponents :: UserIdentityComponents -> Maybe UserIdentity +maybeUserIdentityFromComponents = \case + (maybeEmail, maybePhone, Just ssoid) -> Just $ SSOIdentity ssoid maybeEmail maybePhone + (Just email, Just phone, Nothing) -> Just $ FullIdentity email phone + (Just email, Nothing, Nothing) -> Just $ EmailIdentity email + (Nothing, Just phone, Nothing) -> Just $ PhoneIdentity phone + (Nothing, Nothing, Nothing) -> Nothing + +maybeUserIdentityToComponents :: Maybe UserIdentity -> UserIdentityComponents +maybeUserIdentityToComponents Nothing = (Nothing, Nothing, Nothing) +maybeUserIdentityToComponents (Just (FullIdentity email phone)) = (Just email, Just phone, Nothing) +maybeUserIdentityToComponents (Just (EmailIdentity email)) = (Just email, Nothing, Nothing) +maybeUserIdentityToComponents (Just (PhoneIdentity phone)) = (Nothing, Just phone, Nothing) +maybeUserIdentityToComponents (Just (SSOIdentity ssoid m_email m_phone)) = (m_email, m_phone, Just ssoid) newIdentity :: Maybe Email -> Maybe Phone -> Maybe UserSSOId -> Maybe UserIdentity newIdentity email phone (Just sso) = Just $! SSOIdentity sso email phone diff --git a/libs/wire-api/src/Wire/API/User/Orphans.hs b/libs/wire-api/src/Wire/API/User/Orphans.hs index 232d4f1f85..7dd5e5dfd2 100644 --- a/libs/wire-api/src/Wire/API/User/Orphans.hs +++ b/libs/wire-api/src/Wire/API/User/Orphans.hs @@ -21,6 +21,7 @@ module Wire.API.User.Orphans where import Control.Lens +import qualified Data.Currency as Currency import Data.ISO3166_CountryCodes import Data.LanguageCodes import Data.Proxy @@ -121,3 +122,6 @@ instance ToParamSchema URI where instance ToSchema X509.SignedCertificate where declareNamedSchema _ = declareNamedSchema (Proxy @String) + +instance ToSchema Currency.Alpha where + declareNamedSchema = genericDeclareNamedSchema defaultSchemaOptions diff --git a/libs/wire-api/src/Wire/API/User/Profile.hs b/libs/wire-api/src/Wire/API/User/Profile.hs index b5950500fe..5327fce297 100644 --- a/libs/wire-api/src/Wire/API/User/Profile.hs +++ b/libs/wire-api/src/Wire/API/User/Profile.hs @@ -67,7 +67,6 @@ import Data.Schema import qualified Data.Swagger as S import qualified Data.Swagger.Build.Api as Doc import qualified Data.Text as Text -import Deriving.Swagger (CamelToSnake, ConstructorTagModifier, CustomSwagger, StripPrefix) import Imports import Wire.API.Arbitrary (Arbitrary (arbitrary), GenericUniform (..)) import Wire.API.User.Orphans () @@ -252,7 +251,7 @@ data ManagedBy ManagedByScim deriving stock (Eq, Bounded, Enum, Show, Generic) deriving (Arbitrary) via (GenericUniform ManagedBy) - deriving (S.ToSchema) via (CustomSwagger '[ConstructorTagModifier (StripPrefix "ManagedBy", CamelToSnake)] ManagedBy) + deriving (ToJSON, FromJSON, S.ToSchema) via (Schema ManagedBy) typeManagedBy :: Doc.DataType typeManagedBy = @@ -262,17 +261,13 @@ typeManagedBy = "scim" ] -instance ToJSON ManagedBy where - toJSON = - A.String . \case - ManagedByWire -> "wire" - ManagedByScim -> "scim" - -instance FromJSON ManagedBy where - parseJSON = A.withText "ManagedBy" $ \case - "wire" -> pure ManagedByWire - "scim" -> pure ManagedByScim - other -> fail $ "Invalid ManagedBy: " ++ show other +instance ToSchema ManagedBy where + schema = + enum @Text "ManagedBy" $ + mconcat + [ element "wire" ManagedByWire, + element "scim" ManagedByScim + ] instance ToByteString ManagedBy where builder ManagedByWire = "wire" diff --git a/libs/wire-api/test/golden/Test/Wire/API/Golden/Generated.hs b/libs/wire-api/test/golden/Test/Wire/API/Golden/Generated.hs index f0f20bc7e3..798a88c877 100644 --- a/libs/wire-api/test/golden/Test/Wire/API/Golden/Generated.hs +++ b/libs/wire-api/test/golden/Test/Wire/API/Golden/Generated.hs @@ -225,7 +225,6 @@ import qualified Test.Wire.API.Golden.Generated.UserClients_user import qualified Test.Wire.API.Golden.Generated.UserConnectionList_user import qualified Test.Wire.API.Golden.Generated.UserConnection_user import qualified Test.Wire.API.Golden.Generated.UserHandleInfo_user -import qualified Test.Wire.API.Golden.Generated.UserIdentity_user import qualified Test.Wire.API.Golden.Generated.UserLegalHoldStatusResponse_team import qualified Test.Wire.API.Golden.Generated.UserProfile_user import qualified Test.Wire.API.Golden.Generated.UserSSOId_user @@ -1028,8 +1027,6 @@ tests = testObjects [(Test.Wire.API.Golden.Generated.Phone_user.testObject_Phone_user_1, "testObject_Phone_user_1.json"), (Test.Wire.API.Golden.Generated.Phone_user.testObject_Phone_user_2, "testObject_Phone_user_2.json"), (Test.Wire.API.Golden.Generated.Phone_user.testObject_Phone_user_3, "testObject_Phone_user_3.json"), (Test.Wire.API.Golden.Generated.Phone_user.testObject_Phone_user_4, "testObject_Phone_user_4.json"), (Test.Wire.API.Golden.Generated.Phone_user.testObject_Phone_user_5, "testObject_Phone_user_5.json"), (Test.Wire.API.Golden.Generated.Phone_user.testObject_Phone_user_6, "testObject_Phone_user_6.json"), (Test.Wire.API.Golden.Generated.Phone_user.testObject_Phone_user_7, "testObject_Phone_user_7.json"), (Test.Wire.API.Golden.Generated.Phone_user.testObject_Phone_user_8, "testObject_Phone_user_8.json"), (Test.Wire.API.Golden.Generated.Phone_user.testObject_Phone_user_9, "testObject_Phone_user_9.json"), (Test.Wire.API.Golden.Generated.Phone_user.testObject_Phone_user_10, "testObject_Phone_user_10.json"), (Test.Wire.API.Golden.Generated.Phone_user.testObject_Phone_user_11, "testObject_Phone_user_11.json"), (Test.Wire.API.Golden.Generated.Phone_user.testObject_Phone_user_12, "testObject_Phone_user_12.json"), (Test.Wire.API.Golden.Generated.Phone_user.testObject_Phone_user_13, "testObject_Phone_user_13.json"), (Test.Wire.API.Golden.Generated.Phone_user.testObject_Phone_user_14, "testObject_Phone_user_14.json"), (Test.Wire.API.Golden.Generated.Phone_user.testObject_Phone_user_15, "testObject_Phone_user_15.json"), (Test.Wire.API.Golden.Generated.Phone_user.testObject_Phone_user_16, "testObject_Phone_user_16.json"), (Test.Wire.API.Golden.Generated.Phone_user.testObject_Phone_user_17, "testObject_Phone_user_17.json"), (Test.Wire.API.Golden.Generated.Phone_user.testObject_Phone_user_18, "testObject_Phone_user_18.json"), (Test.Wire.API.Golden.Generated.Phone_user.testObject_Phone_user_19, "testObject_Phone_user_19.json"), (Test.Wire.API.Golden.Generated.Phone_user.testObject_Phone_user_20, "testObject_Phone_user_20.json")], testGroup "Golden: UserSSOId_user" $ testObjects [(Test.Wire.API.Golden.Generated.UserSSOId_user.testObject_UserSSOId_user_2, "testObject_UserSSOId_user_2.json"), (Test.Wire.API.Golden.Generated.UserSSOId_user.testObject_UserSSOId_user_9, "testObject_UserSSOId_user_9.json"), (Test.Wire.API.Golden.Generated.UserSSOId_user.testObject_UserSSOId_user_13, "testObject_UserSSOId_user_13.json")], - testGroup "Golden: UserIdentity_user" $ - testObjects [(Test.Wire.API.Golden.Generated.UserIdentity_user.testObject_UserIdentity_user_1, "testObject_UserIdentity_user_1.json"), (Test.Wire.API.Golden.Generated.UserIdentity_user.testObject_UserIdentity_user_2, "testObject_UserIdentity_user_2.json"), (Test.Wire.API.Golden.Generated.UserIdentity_user.testObject_UserIdentity_user_3, "testObject_UserIdentity_user_3.json"), (Test.Wire.API.Golden.Generated.UserIdentity_user.testObject_UserIdentity_user_4, "testObject_UserIdentity_user_4.json"), (Test.Wire.API.Golden.Generated.UserIdentity_user.testObject_UserIdentity_user_6, "testObject_UserIdentity_user_6.json"), (Test.Wire.API.Golden.Generated.UserIdentity_user.testObject_UserIdentity_user_7, "testObject_UserIdentity_user_7.json"), (Test.Wire.API.Golden.Generated.UserIdentity_user.testObject_UserIdentity_user_9, "testObject_UserIdentity_user_9.json"), (Test.Wire.API.Golden.Generated.UserIdentity_user.testObject_UserIdentity_user_10, "testObject_UserIdentity_user_10.json"), (Test.Wire.API.Golden.Generated.UserIdentity_user.testObject_UserIdentity_user_11, "testObject_UserIdentity_user_11.json"), (Test.Wire.API.Golden.Generated.UserIdentity_user.testObject_UserIdentity_user_12, "testObject_UserIdentity_user_12.json"), (Test.Wire.API.Golden.Generated.UserIdentity_user.testObject_UserIdentity_user_13, "testObject_UserIdentity_user_13.json"), (Test.Wire.API.Golden.Generated.UserIdentity_user.testObject_UserIdentity_user_14, "testObject_UserIdentity_user_14.json"), (Test.Wire.API.Golden.Generated.UserIdentity_user.testObject_UserIdentity_user_15, "testObject_UserIdentity_user_15.json"), (Test.Wire.API.Golden.Generated.UserIdentity_user.testObject_UserIdentity_user_17, "testObject_UserIdentity_user_17.json"), (Test.Wire.API.Golden.Generated.UserIdentity_user.testObject_UserIdentity_user_18, "testObject_UserIdentity_user_18.json"), (Test.Wire.API.Golden.Generated.UserIdentity_user.testObject_UserIdentity_user_19, "testObject_UserIdentity_user_19.json"), (Test.Wire.API.Golden.Generated.UserIdentity_user.testObject_UserIdentity_user_20, "testObject_UserIdentity_user_20.json")], testGroup "Golden: NewPasswordReset_user" $ testObjects [(Test.Wire.API.Golden.Generated.NewPasswordReset_user.testObject_NewPasswordReset_user_1, "testObject_NewPasswordReset_user_1.json"), (Test.Wire.API.Golden.Generated.NewPasswordReset_user.testObject_NewPasswordReset_user_2, "testObject_NewPasswordReset_user_2.json"), (Test.Wire.API.Golden.Generated.NewPasswordReset_user.testObject_NewPasswordReset_user_3, "testObject_NewPasswordReset_user_3.json"), (Test.Wire.API.Golden.Generated.NewPasswordReset_user.testObject_NewPasswordReset_user_4, "testObject_NewPasswordReset_user_4.json"), (Test.Wire.API.Golden.Generated.NewPasswordReset_user.testObject_NewPasswordReset_user_5, "testObject_NewPasswordReset_user_5.json"), (Test.Wire.API.Golden.Generated.NewPasswordReset_user.testObject_NewPasswordReset_user_6, "testObject_NewPasswordReset_user_6.json"), (Test.Wire.API.Golden.Generated.NewPasswordReset_user.testObject_NewPasswordReset_user_7, "testObject_NewPasswordReset_user_7.json"), (Test.Wire.API.Golden.Generated.NewPasswordReset_user.testObject_NewPasswordReset_user_8, "testObject_NewPasswordReset_user_8.json"), (Test.Wire.API.Golden.Generated.NewPasswordReset_user.testObject_NewPasswordReset_user_9, "testObject_NewPasswordReset_user_9.json"), (Test.Wire.API.Golden.Generated.NewPasswordReset_user.testObject_NewPasswordReset_user_10, "testObject_NewPasswordReset_user_10.json"), (Test.Wire.API.Golden.Generated.NewPasswordReset_user.testObject_NewPasswordReset_user_11, "testObject_NewPasswordReset_user_11.json"), (Test.Wire.API.Golden.Generated.NewPasswordReset_user.testObject_NewPasswordReset_user_12, "testObject_NewPasswordReset_user_12.json"), (Test.Wire.API.Golden.Generated.NewPasswordReset_user.testObject_NewPasswordReset_user_13, "testObject_NewPasswordReset_user_13.json"), (Test.Wire.API.Golden.Generated.NewPasswordReset_user.testObject_NewPasswordReset_user_14, "testObject_NewPasswordReset_user_14.json"), (Test.Wire.API.Golden.Generated.NewPasswordReset_user.testObject_NewPasswordReset_user_15, "testObject_NewPasswordReset_user_15.json"), (Test.Wire.API.Golden.Generated.NewPasswordReset_user.testObject_NewPasswordReset_user_16, "testObject_NewPasswordReset_user_16.json"), (Test.Wire.API.Golden.Generated.NewPasswordReset_user.testObject_NewPasswordReset_user_17, "testObject_NewPasswordReset_user_17.json"), (Test.Wire.API.Golden.Generated.NewPasswordReset_user.testObject_NewPasswordReset_user_18, "testObject_NewPasswordReset_user_18.json"), (Test.Wire.API.Golden.Generated.NewPasswordReset_user.testObject_NewPasswordReset_user_19, "testObject_NewPasswordReset_user_19.json"), (Test.Wire.API.Golden.Generated.NewPasswordReset_user.testObject_NewPasswordReset_user_20, "testObject_NewPasswordReset_user_20.json")], testGroup "Golden: PasswordResetKey_user" $ diff --git a/libs/wire-api/test/golden/Test/Wire/API/Golden/Generated/AccessRoleLegacy_user.hs b/libs/wire-api/test/golden/Test/Wire/API/Golden/Generated/AccessRoleLegacy_user.hs index ad1587d065..8331b06be8 100644 --- a/libs/wire-api/test/golden/Test/Wire/API/Golden/Generated/AccessRoleLegacy_user.hs +++ b/libs/wire-api/test/golden/Test/Wire/API/Golden/Generated/AccessRoleLegacy_user.hs @@ -14,6 +14,7 @@ -- -- You should have received a copy of the GNU Affero General Public License along -- with this program. If not, see . + module Test.Wire.API.Golden.Generated.AccessRoleLegacy_user where import Wire.API.Conversation (AccessRoleLegacy (..)) diff --git a/libs/wire-api/test/golden/Test/Wire/API/Golden/Generated/UserIdentity_user.hs b/libs/wire-api/test/golden/Test/Wire/API/Golden/Generated/UserIdentity_user.hs deleted file mode 100644 index 27eb136725..0000000000 --- a/libs/wire-api/test/golden/Test/Wire/API/Golden/Generated/UserIdentity_user.hs +++ /dev/null @@ -1,137 +0,0 @@ -{-# LANGUAGE OverloadedLists #-} - --- This file is part of the Wire Server implementation. --- --- Copyright (C) 2022 Wire Swiss GmbH --- --- This program is free software: you can redistribute it and/or modify it under --- the terms of the GNU Affero General Public License as published by the Free --- Software Foundation, either version 3 of the License, or (at your option) any --- later version. --- --- This program is distributed in the hope that it will be useful, but WITHOUT --- ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS --- FOR A PARTICULAR PURPOSE. See the GNU Affero General Public License for more --- details. --- --- You should have received a copy of the GNU Affero General Public License along --- with this program. If not, see . - -module Test.Wire.API.Golden.Generated.UserIdentity_user where - -import Imports (Maybe (Just, Nothing)) -import Wire.API.User - ( Email (Email, emailDomain, emailLocal), - Phone (Phone, fromPhone), - UserIdentity (..), - UserSSOId (UserSSOId, UserScimExternalId), - ) -import Wire.API.User.Identity (mkSimpleSampleUref) - -testObject_UserIdentity_user_1 :: UserIdentity -testObject_UserIdentity_user_1 = - EmailIdentity (Email {emailLocal = "S\ENQX\1076723$\STX\"\1110507e\1015716\24831\1031964L\ETB", emailDomain = "P.b"}) - -testObject_UserIdentity_user_2 :: UserIdentity -testObject_UserIdentity_user_2 = - EmailIdentity - ( Email - { emailLocal = "\1061008\1068189\1013266\EOT\vE\ENQW\SYNO\DC3X_F\9141\STX $}\179559\USJ3\128480S?", - emailDomain = "4WL;'\DLEl1]x\119077" - } - ) - -testObject_UserIdentity_user_3 :: UserIdentity -testObject_UserIdentity_user_3 = - EmailIdentity - ( Email - { emailLocal = "\10821:\DC4E\60072i\1074224P\1054022\1037567\&6phe\DC3\ETXH,\CAN\v\145604\v>", - emailDomain = "bwtC\1110390z2RT28\STX\1049837<3Y" - } - ) - -testObject_UserIdentity_user_4 :: UserIdentity -testObject_UserIdentity_user_4 = - FullIdentity - (Email {emailLocal = "\rH)\65718", emailDomain = ")\1107842\US\27126\t\ACK\1111725_{\154804\&7#"}) - (Phone {fromPhone = "+2559583362"}) - -testObject_UserIdentity_user_5 :: UserIdentity -testObject_UserIdentity_user_5 = - SSOIdentity (UserSSOId mkSimpleSampleUref) Nothing (Just (Phone {fromPhone = "+49198172826"})) - -testObject_UserIdentity_user_6 :: UserIdentity -testObject_UserIdentity_user_6 = PhoneIdentity (Phone {fromPhone = "+03038459796465"}) - -testObject_UserIdentity_user_7 :: UserIdentity -testObject_UserIdentity_user_7 = PhoneIdentity (Phone {fromPhone = "+805676294"}) - -testObject_UserIdentity_user_8 :: UserIdentity -testObject_UserIdentity_user_8 = SSOIdentity (UserSSOId mkSimpleSampleUref) Nothing (Just (Phone {fromPhone = "+149548802116267"})) - -testObject_UserIdentity_user_9 :: UserIdentity -testObject_UserIdentity_user_9 = - EmailIdentity - ( Email - { emailLocal = "'\ACKB\1000542\&90\NAKKK\EOTin\1096701r\EOT", - emailDomain = "Jj\\\172302>nY\9522\987654VO\DC2Q\r_:$\7618\EOTc~H8e}{g" - } - ) - -testObject_UserIdentity_user_10 :: UserIdentity -testObject_UserIdentity_user_10 = - EmailIdentity - ( Email - { emailLocal = "No\b\1006784b=`yl\133702p.w\1048001\142089\DC4\149735lm\183993&j9\a", - emailDomain = "\1054243.1\1031882\ETB_\1053320Q\1087931z.Ywe\1016096\39626>" - } - ) - -testObject_UserIdentity_user_11 :: UserIdentity -testObject_UserIdentity_user_11 = PhoneIdentity (Phone {fromPhone = "+755837448"}) - -testObject_UserIdentity_user_12 :: UserIdentity -testObject_UserIdentity_user_12 = - EmailIdentity (Email {emailLocal = "K\1012027\DC2", emailDomain = "\DC4N0Q\4986rva\NAK5\1080896+S\1070062;\FS%\NAK"}) - -testObject_UserIdentity_user_13 :: UserIdentity -testObject_UserIdentity_user_13 = - FullIdentity - (Email {emailLocal = "e\ACK\1036331\1062258vN:%\1058229\SUBSi\1035816Qq", emailDomain = ""}) - (Phone {fromPhone = "+387350906"}) - -testObject_UserIdentity_user_14 :: UserIdentity -testObject_UserIdentity_user_14 = - FullIdentity - ( Email - { emailLocal = "\1004575\184062\CAN\92545\&3\US<=gg", - emailDomain = "\1035369\1022539Nbo\tQ:\1085902f\136614L\1009643" - } - ) - (Phone {fromPhone = "+79378139213406"}) - -testObject_UserIdentity_user_15 :: UserIdentity -testObject_UserIdentity_user_15 = PhoneIdentity (Phone {fromPhone = "+092380942233194"}) - -testObject_UserIdentity_user_16 :: UserIdentity -testObject_UserIdentity_user_16 = - SSOIdentity - (UserSSOId mkSimpleSampleUref) - (Just (Email {emailLocal = "%x\DC3\1049873\EOT.", emailDomain = "G\48751t.6"})) - (Just (Phone {fromPhone = "+298116118047"})) - -testObject_UserIdentity_user_17 :: UserIdentity -testObject_UserIdentity_user_17 = - SSOIdentity (UserScimExternalId "") (Just (Email {emailLocal = "\GS\FS1k", emailDomain = "CV7\147439K"})) Nothing - -testObject_UserIdentity_user_18 :: UserIdentity -testObject_UserIdentity_user_18 = PhoneIdentity (Phone {fromPhone = "+7322674905"}) - -testObject_UserIdentity_user_19 :: UserIdentity -testObject_UserIdentity_user_19 = PhoneIdentity (Phone {fromPhone = "+133514352685272"}) - -testObject_UserIdentity_user_20 :: UserIdentity -testObject_UserIdentity_user_20 = - FullIdentity - (Email {emailLocal = "\133292A", emailDomain = "|\1083873\1005880N<\DC3z9\NAKV;^\1015230"}) - (Phone {fromPhone = "+926403020"}) diff --git a/libs/wire-api/test/golden/testObject_UserIdentity_user_1.json b/libs/wire-api/test/golden/testObject_UserIdentity_user_1.json deleted file mode 100644 index 029c472a9d..0000000000 --- a/libs/wire-api/test/golden/testObject_UserIdentity_user_1.json +++ /dev/null @@ -1,5 +0,0 @@ -{ - "email": "S\u0005X􆷳$\u0002\"􏇫e󷾤惿󻼜L\u0017@P.b", - "phone": null, - "sso_id": null -} diff --git a/libs/wire-api/test/golden/testObject_UserIdentity_user_10.json b/libs/wire-api/test/golden/testObject_UserIdentity_user_10.json deleted file mode 100644 index 0142780ab7..0000000000 --- a/libs/wire-api/test/golden/testObject_UserIdentity_user_10.json +++ /dev/null @@ -1,5 +0,0 @@ -{ - "email": "No\u0008󵳀b=`yl𠩆p.w󿷁𢬉\u0014𤣧lm𬺹&j9\u0007@􁘣.1󻻊\u0017_􁊈Q􉦻z.Ywe󸄠髊>", - "phone": null, - "sso_id": null -} diff --git a/libs/wire-api/test/golden/testObject_UserIdentity_user_11.json b/libs/wire-api/test/golden/testObject_UserIdentity_user_11.json deleted file mode 100644 index bff6512261..0000000000 --- a/libs/wire-api/test/golden/testObject_UserIdentity_user_11.json +++ /dev/null @@ -1,5 +0,0 @@ -{ - "email": null, - "phone": "+755837448", - "sso_id": null -} diff --git a/libs/wire-api/test/golden/testObject_UserIdentity_user_12.json b/libs/wire-api/test/golden/testObject_UserIdentity_user_12.json deleted file mode 100644 index 6d4144937f..0000000000 --- a/libs/wire-api/test/golden/testObject_UserIdentity_user_12.json +++ /dev/null @@ -1,5 +0,0 @@ -{ - "email": "K󷄻\u0012@\u0014N0Q፺rva\u00155􇹀+S􅏮;\u001c%\u0015", - "phone": null, - "sso_id": null -} diff --git a/libs/wire-api/test/golden/testObject_UserIdentity_user_13.json b/libs/wire-api/test/golden/testObject_UserIdentity_user_13.json deleted file mode 100644 index c4632b61e5..0000000000 --- a/libs/wire-api/test/golden/testObject_UserIdentity_user_13.json +++ /dev/null @@ -1,5 +0,0 @@ -{ - "email": "e\u0006󽀫􃕲vN:%􂖵\u001aSi󼸨Qq@", - "phone": "+387350906", - "sso_id": null -} diff --git a/libs/wire-api/test/golden/testObject_UserIdentity_user_14.json b/libs/wire-api/test/golden/testObject_UserIdentity_user_14.json deleted file mode 100644 index 5d2a9ce392..0000000000 --- a/libs/wire-api/test/golden/testObject_UserIdentity_user_14.json +++ /dev/null @@ -1,5 +0,0 @@ -{ - "email": "󵐟𬻾\u0018𖦁3\u001f<=gg@󼱩󹩋Nbo\tQ:􉇎f𡖦L󶟫", - "phone": "+79378139213406", - "sso_id": null -} diff --git a/libs/wire-api/test/golden/testObject_UserIdentity_user_15.json b/libs/wire-api/test/golden/testObject_UserIdentity_user_15.json deleted file mode 100644 index 35fa355d0f..0000000000 --- a/libs/wire-api/test/golden/testObject_UserIdentity_user_15.json +++ /dev/null @@ -1,5 +0,0 @@ -{ - "email": null, - "phone": "+092380942233194", - "sso_id": null -} diff --git a/libs/wire-api/test/golden/testObject_UserIdentity_user_17.json b/libs/wire-api/test/golden/testObject_UserIdentity_user_17.json deleted file mode 100644 index de51e10642..0000000000 --- a/libs/wire-api/test/golden/testObject_UserIdentity_user_17.json +++ /dev/null @@ -1,7 +0,0 @@ -{ - "email": "\u001d\u001c1k@CV7𣿯K", - "phone": null, - "sso_id": { - "scim_external_id": "" - } -} diff --git a/libs/wire-api/test/golden/testObject_UserIdentity_user_18.json b/libs/wire-api/test/golden/testObject_UserIdentity_user_18.json deleted file mode 100644 index 4c7aa3559a..0000000000 --- a/libs/wire-api/test/golden/testObject_UserIdentity_user_18.json +++ /dev/null @@ -1,5 +0,0 @@ -{ - "email": null, - "phone": "+7322674905", - "sso_id": null -} diff --git a/libs/wire-api/test/golden/testObject_UserIdentity_user_19.json b/libs/wire-api/test/golden/testObject_UserIdentity_user_19.json deleted file mode 100644 index 2d276e9f0a..0000000000 --- a/libs/wire-api/test/golden/testObject_UserIdentity_user_19.json +++ /dev/null @@ -1,5 +0,0 @@ -{ - "email": null, - "phone": "+133514352685272", - "sso_id": null -} diff --git a/libs/wire-api/test/golden/testObject_UserIdentity_user_2.json b/libs/wire-api/test/golden/testObject_UserIdentity_user_2.json deleted file mode 100644 index ed26790334..0000000000 --- a/libs/wire-api/test/golden/testObject_UserIdentity_user_2.json +++ /dev/null @@ -1,5 +0,0 @@ -{ - "email": "􃂐􄲝󷘒\u0004\u000bE\u0005W\u0016O\u0013X_F⎵\u0002 $}𫵧\u001fJ3🗠S?@4WL;'\u0010l1]x𝄥", - "phone": null, - "sso_id": null -} diff --git a/libs/wire-api/test/golden/testObject_UserIdentity_user_20.json b/libs/wire-api/test/golden/testObject_UserIdentity_user_20.json deleted file mode 100644 index c2b067e0ec..0000000000 --- a/libs/wire-api/test/golden/testObject_UserIdentity_user_20.json +++ /dev/null @@ -1,5 +0,0 @@ -{ - "email": "𠢬A@|􈧡󵤸N<\u0013z9\u0015V;^󷶾", - "phone": "+926403020", - "sso_id": null -} diff --git a/libs/wire-api/test/golden/testObject_UserIdentity_user_3.json b/libs/wire-api/test/golden/testObject_UserIdentity_user_3.json deleted file mode 100644 index 12387a4c4e..0000000000 --- a/libs/wire-api/test/golden/testObject_UserIdentity_user_3.json +++ /dev/null @@ -1,5 +0,0 @@ -{ - "email": "⩅:\u0014Ei􆐰P􁕆󽓿6phe\u0013\u0003H,\u0018\u000b𣣄\u000b>@bwtC􏅶z2RT28\u0002􀓭<3Y", - "phone": null, - "sso_id": null -} diff --git a/libs/wire-api/test/golden/testObject_UserIdentity_user_4.json b/libs/wire-api/test/golden/testObject_UserIdentity_user_4.json deleted file mode 100644 index 19e7f13385..0000000000 --- a/libs/wire-api/test/golden/testObject_UserIdentity_user_4.json +++ /dev/null @@ -1,5 +0,0 @@ -{ - "email": "\rH)𐂶@)􎞂\u001f槶\t\u0006􏚭_{𥲴7#", - "phone": "+2559583362", - "sso_id": null -} diff --git a/libs/wire-api/test/golden/testObject_UserIdentity_user_6.json b/libs/wire-api/test/golden/testObject_UserIdentity_user_6.json deleted file mode 100644 index c841bfca76..0000000000 --- a/libs/wire-api/test/golden/testObject_UserIdentity_user_6.json +++ /dev/null @@ -1,5 +0,0 @@ -{ - "email": null, - "phone": "+03038459796465", - "sso_id": null -} diff --git a/libs/wire-api/test/golden/testObject_UserIdentity_user_7.json b/libs/wire-api/test/golden/testObject_UserIdentity_user_7.json deleted file mode 100644 index 5edc20024a..0000000000 --- a/libs/wire-api/test/golden/testObject_UserIdentity_user_7.json +++ /dev/null @@ -1,5 +0,0 @@ -{ - "email": null, - "phone": "+805676294", - "sso_id": null -} diff --git a/libs/wire-api/test/golden/testObject_UserIdentity_user_9.json b/libs/wire-api/test/golden/testObject_UserIdentity_user_9.json deleted file mode 100644 index 2500b91fd2..0000000000 --- a/libs/wire-api/test/golden/testObject_UserIdentity_user_9.json +++ /dev/null @@ -1,5 +0,0 @@ -{ - "email": "'\u0006B󴑞90\u0015KK\u0004in􋯽r\u0004@Jj\\𪄎>nY┲󱈆VO\u0012Q\r_:$᷂\u0004c~H8e}{g", - "phone": null, - "sso_id": null -} diff --git a/libs/wire-api/test/unit/Test/Wire/API/Conversation.hs b/libs/wire-api/test/unit/Test/Wire/API/Conversation.hs index 27d198a22f..f9df9a9af2 100644 --- a/libs/wire-api/test/unit/Test/Wire/API/Conversation.hs +++ b/libs/wire-api/test/unit/Test/Wire/API/Conversation.hs @@ -3,7 +3,7 @@ -- This file is part of the Wire Server implementation. -- --- Copyright (C) 2020 Wire Swiss GmbH +-- Copyright (C) 2022 Wire Swiss GmbH -- -- This program is free software: you can redistribute it and/or modify it under -- the terms of the GNU Affero General Public License as published by the Free diff --git a/libs/wire-api/test/unit/Test/Wire/API/Roundtrip/Aeson.hs b/libs/wire-api/test/unit/Test/Wire/API/Roundtrip/Aeson.hs index 5ff334d8a1..b63079c202 100644 --- a/libs/wire-api/test/unit/Test/Wire/API/Roundtrip/Aeson.hs +++ b/libs/wire-api/test/unit/Test/Wire/API/Roundtrip/Aeson.hs @@ -297,7 +297,6 @@ tests = testRoundTrip @User.Identity.Email, testRoundTrip @User.Identity.Phone, testRoundTrip @User.Identity.UserSSOId, - testRoundTrip @User.Identity.UserIdentity, testRoundTrip @User.Password.NewPasswordReset, testRoundTrip @User.Password.PasswordResetKey, -- FUTUREWORK: this should probably be tested individually, diff --git a/libs/wire-api/test/unit/Test/Wire/API/User.hs b/libs/wire-api/test/unit/Test/Wire/API/User.hs index 2b23905559..5c05e6a619 100644 --- a/libs/wire-api/test/unit/Test/Wire/API/User.hs +++ b/libs/wire-api/test/unit/Test/Wire/API/User.hs @@ -26,6 +26,7 @@ import Data.Domain import Data.Id import Data.LegalHold (UserLegalHoldStatus (UserLegalHoldNoConsent)) import Data.Qualified +import Data.Schema (schemaIn) import qualified Data.UUID.V4 as UUID import Imports import Test.Tasty @@ -53,28 +54,28 @@ testUserProfile = do parseIdentityTests :: [TestTree] parseIdentityTests = - [ let (=#=) :: Either String (Maybe UserIdentity) -> (Maybe UserSSOId, [Pair]) -> Assertion - (=#=) uid (mssoid, object -> Object obj) = assertEqual "=#=" uid (parseEither (parseIdentity mssoid) obj) + [ let (=#=) :: Either String (Maybe UserIdentity) -> [Pair] -> Assertion + (=#=) uid (object -> Object obj) = assertEqual "=#=" uid (parseEither (schemaIn maybeUserIdentityObjectSchema) obj) (=#=) _ bad = error $ "=#=: impossible: " <> show bad in testGroup "parseIdentity" [ testCase "FullIdentity" $ - Right (Just (FullIdentity hemail hphone)) =#= (Nothing, [email, phone]), + Right (Just (FullIdentity hemail hphone)) =#= [email, phone], testCase "EmailIdentity" $ - Right (Just (EmailIdentity hemail)) =#= (Nothing, [email]), + Right (Just (EmailIdentity hemail)) =#= [email], testCase "PhoneIdentity" $ - Right (Just (PhoneIdentity hphone)) =#= (Nothing, [phone]), + Right (Just (PhoneIdentity hphone)) =#= [phone], testCase "SSOIdentity" $ do - Right (Just (SSOIdentity hssoid Nothing Nothing)) =#= (Just hssoid, [ssoid]) - Right (Just (SSOIdentity hssoid Nothing (Just hphone))) =#= (Just hssoid, [ssoid, phone]) - Right (Just (SSOIdentity hssoid (Just hemail) Nothing)) =#= (Just hssoid, [ssoid, email]) - Right (Just (SSOIdentity hssoid (Just hemail) (Just hphone))) =#= (Just hssoid, [ssoid, email, phone]), + Right (Just (SSOIdentity hssoid Nothing Nothing)) =#= [ssoid] + Right (Just (SSOIdentity hssoid Nothing (Just hphone))) =#= [ssoid, phone] + Right (Just (SSOIdentity hssoid (Just hemail) Nothing)) =#= [ssoid, email] + Right (Just (SSOIdentity hssoid (Just hemail) (Just hphone))) =#= [ssoid, email, phone], testCase "Bad phone" $ - Left "Error in $.phone: Invalid phone number. Expected E.164 format." =#= (Nothing, [badphone]), + Left "Error in $.phone: Invalid phone number. Expected E.164 format." =#= [badphone], testCase "Bad email" $ - Left "Error in $.email: Invalid email. Expected '@'." =#= (Nothing, [bademail]), + Left "Error in $.email: Invalid email. Expected '@'." =#= [bademail], testCase "Nothing" $ - Right Nothing =#= (Nothing, [("something_unrelated", "#")]) + Right Nothing =#= [("something_unrelated", "#")] ] ] where diff --git a/libs/wire-api/wire-api.cabal b/libs/wire-api/wire-api.cabal index 8fd943c89c..caabffd61a 100644 --- a/libs/wire-api/wire-api.cabal +++ b/libs/wire-api/wire-api.cabal @@ -452,7 +452,6 @@ test-suite wire-api-golden-tests Test.Wire.API.Golden.Generated.UserConnection_user Test.Wire.API.Golden.Generated.UserConnectionList_user Test.Wire.API.Golden.Generated.UserHandleInfo_user - Test.Wire.API.Golden.Generated.UserIdentity_user Test.Wire.API.Golden.Generated.UserLegalHoldStatusResponse_team Test.Wire.API.Golden.Generated.UserProfile_user Test.Wire.API.Golden.Generated.UserSSOId_user @@ -656,6 +655,7 @@ test-suite wire-api-tests , pretty , proto-lens , saml2-web-sso + , schema-profunctor , servant , servant-swagger-ui , string-conversions diff --git a/services/brig/src/Brig/API/Error.hs b/services/brig/src/Brig/API/Error.hs index bb97ae837a..f1f4ef9773 100644 --- a/services/brig/src/Brig/API/Error.hs +++ b/services/brig/src/Brig/API/Error.hs @@ -112,7 +112,7 @@ connError NotConnected {} = StdError (errorDescriptionTypeToWai @NotConnected) connError InvalidUser {} = StdError (errorDescriptionTypeToWai @InvalidUser) connError ConnectNoIdentity {} = StdError (errorDescriptionToWai (noIdentity 0)) connError (ConnectBlacklistedUserKey k) = StdError $ foldKey (const blacklistedEmail) (const (errorDescriptionTypeToWai @BlacklistedPhone)) k -connError (ConnectInvalidEmail _ _) = StdError invalidEmail +connError (ConnectInvalidEmail _ _) = StdError (errorDescriptionTypeToWai @InvalidEmail) connError ConnectInvalidPhone {} = StdError (errorDescriptionTypeToWai @InvalidPhone) connError ConnectSameBindingTeamUsers = StdError sameBindingTeamUsers connError ConnectMissingLegalholdConsent = StdError (errorDescriptionTypeToWai @MissingLegalholdConsent) @@ -120,8 +120,9 @@ connError (ConnectFederationError e) = fedError e actError :: ActivationError -> Error actError (UserKeyExists _) = StdError (errorDescriptionTypeToWai @UserKeyExists) -actError (InvalidActivationCode e) = StdError (invalidActivationCode e) -actError (InvalidActivationEmail _ _) = StdError invalidEmail +actError InvalidActivationCodeWrongUser = StdError (errorDescriptionTypeToWai @InvalidActivationCodeWrongUser) +actError InvalidActivationCodeWrongCode = StdError (errorDescriptionTypeToWai @InvalidActivationCodeWrongCode) +actError (InvalidActivationEmail _ _) = StdError (errorDescriptionTypeToWai @InvalidEmail) actError (InvalidActivationPhone _) = StdError (errorDescriptionTypeToWai @InvalidPhone) pwResetError :: PasswordResetError -> Error @@ -135,30 +136,17 @@ pwResetError (PasswordResetInProgress (Just t)) = [("Retry-After", toByteString' t)] pwResetError ResetPasswordMustDiffer = StdError resetPasswordMustDiffer -newUserError :: CreateUserError -> Error -newUserError InvalidInvitationCode = StdError invalidInvitationCode -newUserError MissingIdentity = StdError missingIdentity -newUserError (InvalidEmail _ _) = StdError invalidEmail -newUserError (InvalidPhone _) = StdError (errorDescriptionTypeToWai @InvalidPhone) -newUserError (DuplicateUserKey _) = StdError (errorDescriptionTypeToWai @UserKeyExists) -newUserError (EmailActivationError e) = actError e -newUserError (PhoneActivationError e) = actError e -newUserError (BlacklistedUserKey k) = StdError $ foldKey (const blacklistedEmail) (const (errorDescriptionTypeToWai @BlacklistedPhone)) k -newUserError TooManyTeamMembers = StdError tooManyTeamMembers -newUserError UserCreationRestricted = StdError userCreationRestricted -newUserError (ExternalPreconditionFailed e) = StdError e - sendLoginCodeError :: SendLoginCodeError -> Error sendLoginCodeError (SendLoginInvalidPhone _) = StdError (errorDescriptionTypeToWai @InvalidPhone) sendLoginCodeError SendLoginPasswordExists = StdError passwordExists sendActCodeError :: SendActivationCodeError -> Error -sendActCodeError (InvalidRecipient k) = StdError $ foldKey (const invalidEmail) (const (errorDescriptionTypeToWai @InvalidPhone)) k +sendActCodeError (InvalidRecipient k) = StdError $ foldKey (const (errorDescriptionTypeToWai @InvalidEmail)) (const (errorDescriptionTypeToWai @InvalidPhone)) k sendActCodeError (UserKeyInUse _) = StdError (errorDescriptionTypeToWai @UserKeyExists) sendActCodeError (ActivationBlacklistedUserKey k) = StdError $ foldKey (const blacklistedEmail) (const (errorDescriptionTypeToWai @BlacklistedPhone)) k changeEmailError :: ChangeEmailError -> Error -changeEmailError (InvalidNewEmail _ _) = StdError invalidEmail +changeEmailError (InvalidNewEmail _ _) = StdError (errorDescriptionTypeToWai @InvalidEmail) changeEmailError (EmailExists _) = StdError (errorDescriptionTypeToWai @UserKeyExists) changeEmailError (ChangeBlacklistedEmail _) = StdError blacklistedEmail changeEmailError EmailManagedByScim = StdError $ propertyManagedByScim "email" @@ -267,21 +255,12 @@ clientCapabilitiesCannotBeRemoved = Wai.mkError status409 "client-capabilities-c noEmail :: Wai.Error noEmail = Wai.mkError status403 "no-email" "This operation requires the user to have a verified email address." -invalidEmail :: Wai.Error -invalidEmail = Wai.mkError status400 "invalid-email" "Invalid e-mail address." - invalidPwResetKey :: Wai.Error invalidPwResetKey = Wai.mkError status400 "invalid-key" "Invalid email or mobile number for password reset." resetPasswordMustDiffer :: Wai.Error resetPasswordMustDiffer = Wai.mkError status409 "password-must-differ" "For password reset, new and old password must be different." -invalidInvitationCode :: Wai.Error -invalidInvitationCode = Wai.mkError status400 "invalid-invitation-code" "Invalid invitation code." - -missingIdentity :: Wai.Error -missingIdentity = Wai.mkError status403 "missing-identity" "Using an invitation code requires registering the given email and/or phone." - invalidPwResetCode :: Wai.Error invalidPwResetCode = Wai.mkError status400 "invalid-code" "Invalid password reset code." @@ -414,13 +393,6 @@ sameBindingTeamUsers = Wai.mkError status403 "same-binding-team-users" "Operatio tooManyTeamInvitations :: Wai.Error tooManyTeamInvitations = Wai.mkError status403 "too-many-team-invitations" "Too many team invitations for this team." -tooManyTeamMembers :: Wai.Error -tooManyTeamMembers = Wai.mkError status403 "too-many-team-members" "Too many members in this team." - --- | docs/reference/user/registration.md {#RefRestrictRegistration}. -userCreationRestricted :: Wai.Error -userCreationRestricted = Wai.mkError status403 "user-creation-restricted" "This instance does not allow creation of personal users or teams." - -- | In contrast to 'tooManyFailedLogins', this is about too many *successful* logins. loginsTooFrequent :: Wai.Error loginsTooFrequent = Wai.mkError status429 "client-error" "Logins too frequent" diff --git a/services/brig/src/Brig/API/Handler.hs b/services/brig/src/Brig/API/Handler.hs index 967e2afefb..9cbfec7a6a 100644 --- a/services/brig/src/Brig/API/Handler.hs +++ b/services/brig/src/Brig/API/Handler.hs @@ -25,10 +25,13 @@ module Brig.API.Handler JSON, parseJsonBody, checkWhitelist, + checkWhitelistWithError, + isWhiteListed, + UserNotAllowedToJoinTeam (..), ) where -import Bilge (RequestId (..)) +import Bilge (MonadHttp, RequestId (..)) import Brig.API.Error import qualified Brig.AWS as AWS import Brig.App (AppIO, Env, applog, requestId, runAppT, settings) @@ -40,6 +43,7 @@ import Control.Error import Control.Lens (set, view) import Control.Monad.Catch (catches, throwM) import qualified Control.Monad.Catch as Catch +import Control.Monad.Except (MonadError, throwError) import Data.Aeson (FromJSON) import qualified Data.Aeson as Aeson import Data.Default (def) @@ -60,6 +64,7 @@ import Network.Wai.Utilities.Response (addHeader, json, setStatus) import qualified Network.Wai.Utilities.Server as Server import qualified Servant import System.Logger.Class (Logger) +import Wire.API.ErrorDescription (InvalidEmail) ------------------------------------------------------------------------------- -- HTTP Handler Monad @@ -96,6 +101,11 @@ toServantHandler env action = do Servant.throwError $ Servant.ServerError (mkCode werr) (mkPhrase (WaiError.code werr)) (Aeson.encode body) headers +newtype UserNotAllowedToJoinTeam = UserNotAllowedToJoinTeam WaiError.Error + deriving (Show) + +instance Exception UserNotAllowedToJoinTeam + brigErrorHandlers :: [Catch.Handler IO (Either Error a)] brigErrorHandlers = [ Catch.Handler $ \(ex :: PhoneException) -> @@ -104,8 +114,10 @@ brigErrorHandlers = pure (Left (zauthError ex)), Catch.Handler $ \(ex :: AWS.Error) -> case ex of - AWS.SESInvalidDomain -> pure (Left (StdError invalidEmail)) - _ -> throwM ex + AWS.SESInvalidDomain -> pure (Left (StdError (errorDescriptionTypeToWai @InvalidEmail))) + _ -> throwM ex, + Catch.Handler $ \(UserNotAllowedToJoinTeam e) -> + pure (Left $ StdError e) ] onError :: Logger -> Request -> Continue IO -> Error -> IO ResponseReceived @@ -140,10 +152,16 @@ parseJsonBody req = parseBody req !>> StdError . badRequest -- | If a whitelist is configured, consult it, otherwise a no-op. {#RefActivationWhitelist} checkWhitelist :: Either Email Phone -> (Handler r) () -checkWhitelist key = do +checkWhitelist = checkWhitelistWithError (StdError whitelistError) + +checkWhitelistWithError :: (Monad m, MonadReader Env m, MonadIO m, Catch.MonadMask m, MonadHttp m, MonadError e m) => e -> Either Email Phone -> m () +checkWhitelistWithError e key = do + ok <- isWhiteListed key + unless ok (throwError e) + +isWhiteListed :: (Monad m, MonadReader Env m, MonadIO m, Catch.MonadMask m, MonadHttp m) => Either Email Phone -> m Bool +isWhiteListed key = do eb <- setWhitelist <$> view settings case eb of - Nothing -> return () - Just b -> do - ok <- lift $ Whitelist.verify b key - unless ok (throwStd whitelistError) + Nothing -> pure True + Just b -> Whitelist.verify b key diff --git a/services/brig/src/Brig/API/Internal.hs b/services/brig/src/Brig/API/Internal.hs index 7e21804bf7..a2fc26916f 100644 --- a/services/brig/src/Brig/API/Internal.hs +++ b/services/brig/src/Brig/API/Internal.hs @@ -32,6 +32,7 @@ import Brig.API.Types import qualified Brig.API.User as API import Brig.API.Util (validateHandle) import Brig.App +import Brig.Data.Activation import qualified Brig.Data.Client as Data import qualified Brig.Data.Connection as Data import qualified Brig.Data.User as Data @@ -73,6 +74,7 @@ import qualified System.Logger.Class as Log import Wire.API.ErrorDescription import qualified Wire.API.Routes.Internal.Brig as BrigIRoutes import Wire.API.Routes.Internal.Brig.Connection +import Wire.API.Routes.Named import qualified Wire.API.Team.Feature as ApiFt import Wire.API.User import Wire.API.User.Client (UserClientsFull (..)) @@ -82,7 +84,10 @@ import Wire.API.User.RichInfo -- Sitemap (servant) servantSitemap :: ServerT BrigIRoutes.API (Handler r) -servantSitemap = +servantSitemap = ejpdAPI :<|> accountAPI + +ejpdAPI :: ServerT BrigIRoutes.EJPD_API (Handler r) +ejpdAPI = Brig.User.EJPD.ejpdRequest :<|> getAccountFeatureConfig :<|> putAccountFeatureConfig @@ -90,6 +95,9 @@ servantSitemap = :<|> getConnectionsStatusUnqualified :<|> getConnectionsStatus +accountAPI :: ServerT BrigIRoutes.AccountAPI (Handler r) +accountAPI = Named @"createUserNoVerify" createUserNoVerify + -- | Responds with 'Nothing' if field is NULL in existing user or user does not exist. getAccountFeatureConfig :: UserId -> (Handler r) ApiFt.TeamFeatureStatusNoConfig getAccountFeatureConfig uid = @@ -115,13 +123,6 @@ sitemap = do get "/i/status" (continue $ const $ return empty) true head "/i/status" (continue $ const $ return empty) true - -- This endpoint can lead to the following events being sent: - -- - UserActivated event to created user, if it is a team invitation or user has an SSO ID - -- - UserIdentityUpdated event to created user, if email or phone get activated - post "/i/users" (continue createUserNoVerifyH) $ - accept "application" "json" - .&. jsonRequest @NewUser - -- internal email activation (used in tests and in spar for validating emails obtained as -- SAML user identifiers). if the validate query parameter is false or missing, only set -- the activation timeout, but do not send an email, and do not do anything about activating @@ -316,18 +317,9 @@ internalListFullClients :: UserSet -> (AppIO r) UserClientsFull internalListFullClients (UserSet usrs) = UserClientsFull <$> Data.lookupClientsBulk (Set.toList usrs) -createUserNoVerifyH :: JSON ::: JsonRequest NewUser -> (Handler r) Response -createUserNoVerifyH (_ ::: req) = do - CreateUserNoVerifyResponse uid prof <- createUserNoVerify =<< parseJsonBody req - return . setStatus status201 - . addHeader "Location" (toByteString' uid) - $ json prof - -data CreateUserNoVerifyResponse = CreateUserNoVerifyResponse UserId SelfProfile - -createUserNoVerify :: NewUser -> (Handler r) CreateUserNoVerifyResponse -createUserNoVerify uData = do - result <- API.createUser uData !>> newUserError +createUserNoVerify :: NewUser -> (Handler r) (Either RegisterError SelfProfile) +createUserNoVerify uData = lift . runExceptT $ do + result <- API.createUser uData let acc = createdAccount result let usr = accountUser acc let uid = userId usr @@ -336,8 +328,8 @@ createUserNoVerify uData = do for_ (catMaybes [eac, pac]) $ \adata -> let key = ActivateKey $ activationKey adata code = activationCode adata - in API.activate key code (Just uid) !>> actError - return $ CreateUserNoVerifyResponse uid (SelfProfile usr) + in API.activate key code (Just uid) !>> activationErrorToRegisterError + pure (SelfProfile usr) deleteUserNoVerifyH :: UserId -> (Handler r) Response deleteUserNoVerifyH uid = do diff --git a/services/brig/src/Brig/API/Public.hs b/services/brig/src/Brig/API/Public.hs index 30d3d4b1df..453adbb751 100644 --- a/services/brig/src/Brig/API/Public.hs +++ b/services/brig/src/Brig/API/Public.hs @@ -61,7 +61,6 @@ import Control.Error hiding (bool) import Control.Lens (view, (%~), (.~), (?~), (^.), _Just) import Control.Monad.Catch (throwM) import Data.Aeson hiding (json) -import Data.ByteString.Conversion import qualified Data.ByteString.Lazy as Lazy import qualified Data.ByteString.Lazy.Char8 as LBS import qualified Data.Code as Code @@ -113,6 +112,7 @@ import Wire.API.Routes.Version import qualified Wire.API.Swagger as Public.Swagger (models) import qualified Wire.API.Team as Public import Wire.API.Team.LegalHold (LegalholdProtectee (..)) +import Wire.API.User (RegisterError (RegisterErrorWhitelistError)) import qualified Wire.API.User as Public import qualified Wire.API.User.Activation as Public import qualified Wire.API.User.Auth as Public @@ -162,7 +162,7 @@ swaggerDocsAPI = . (S.enum_ . _Just %~ nub) servantSitemap :: ServerT BrigAPI (Handler r) -servantSitemap = userAPI :<|> selfAPI :<|> clientAPI :<|> prekeyAPI :<|> userClientAPI :<|> connectionAPI :<|> mlsAPI +servantSitemap = userAPI :<|> selfAPI :<|> accountAPI :<|> clientAPI :<|> prekeyAPI :<|> userClientAPI :<|> connectionAPI :<|> mlsAPI where userAPI :: ServerT UserAPI (Handler r) userAPI = @@ -188,6 +188,9 @@ servantSitemap = userAPI :<|> selfAPI :<|> clientAPI :<|> prekeyAPI :<|> userCli :<|> Named @"change-locale" changeLocale :<|> Named @"change-handle" changeHandle + accountAPI :: ServerT AccountAPI (Handler r) + accountAPI = Named @"register" createUser + clientAPI :: ServerT ClientAPI (Handler r) clientAPI = Named @"get-user-clients-unqualified" getUserClientsUnqualified @@ -365,34 +368,7 @@ sitemap = do Doc.response 200 "Object with properties as attributes." Doc.end -- TODO: put delete here, too? - -- /register, /activate, /password-reset ---------------------------------- - - -- docs/reference/user/registration.md {#RefRegistration} - -- - -- This endpoint can lead to the following events being sent: - -- - UserActivated event to created user, if it is a team invitation or user has an SSO ID - -- - UserIdentityUpdated event to created user, if email code or phone code is provided - post "/register" (continue createUserH) $ - accept "application" "json" - .&. jsonRequest @Public.NewUserPublic - document "POST" "register" $ do - Doc.summary "Register a new user." - Doc.notes - "If the environment where the registration takes \ - \place is private and a registered email address or phone \ - \number is not whitelisted, a 403 error is returned." - Doc.body (Doc.ref Public.modelNewUser) $ - Doc.description "JSON body" - -- FUTUREWORK: I think this should be 'Doc.self' instead of 'user' - Doc.returns (Doc.ref Public.modelUser) - Doc.response 201 "User created and pending activation." Doc.end - Doc.errorResponse whitelistError - Doc.errorResponse invalidInvitationCode - Doc.errorResponse missingIdentity - Doc.errorResponse (errorDescriptionTypeToWai @UserKeyExists) - Doc.errorResponse activationCodeNotFound - Doc.errorResponse blacklistedEmail - Doc.errorResponse (errorDescriptionTypeToWai @BlacklistedPhone) + -- /activate, /password-reset ---------------------------------- -- This endpoint can lead to the following events being sent: -- - UserActivated event to the user, if account gets activated @@ -440,7 +416,7 @@ sitemap = do Doc.body (Doc.ref Public.modelSendActivationCode) $ Doc.description "JSON body" Doc.response 200 "Activation code sent." Doc.end - Doc.errorResponse invalidEmail + Doc.errorResponse (errorDescriptionTypeToWai @InvalidEmail) Doc.errorResponse (errorDescriptionTypeToWai @InvalidPhone) Doc.errorResponse (errorDescriptionTypeToWai @UserKeyExists) Doc.errorResponse blacklistedEmail @@ -675,24 +651,13 @@ getRichInfo self user = do getClientPrekeys :: UserId -> ClientId -> (Handler r) [Public.PrekeyId] getClientPrekeys usr clt = lift (API.lookupPrekeyIds usr clt) --- docs/reference/user/registration.md {#RefRegistration} -createUserH :: JSON ::: JsonRequest Public.NewUserPublic -> (Handler r) Response -createUserH (_ ::: req) = do - CreateUserResponse cok loc prof <- createUser =<< parseJsonBody req - lift . Auth.setResponseCookie cok - . setStatus status201 - . addHeader "Location" (toByteString' loc) - $ json prof - -data CreateUserResponse - = CreateUserResponse (Public.Cookie (ZAuth.Token ZAuth.User)) UserId Public.SelfProfile - -createUser :: Public.NewUserPublic -> (Handler r) CreateUserResponse -createUser (Public.NewUserPublic new) = do - API.checkRestrictedUserCreation new !>> newUserError - for_ (Public.newUserEmail new) $ checkWhitelist . Left - for_ (Public.newUserPhone new) $ checkWhitelist . Right - result <- API.createUser new !>> newUserError +-- | docs/reference/user/registration.md {#RefRegistration} +createUser :: Public.NewUserPublic -> (Handler r) (Either Public.RegisterError Public.RegisterSuccess) +createUser (Public.NewUserPublic new) = lift . runExceptT $ do + API.checkRestrictedUserCreation new + for_ (Public.newUserEmail new) $ checkWhitelistWithError RegisterErrorWhitelistError . Left + for_ (Public.newUserPhone new) $ checkWhitelistWithError RegisterErrorWhitelistError . Right + result <- API.createUser new let acc = createdAccount result let eac = createdEmailActivation result @@ -726,10 +691,12 @@ createUser (Public.NewUserPublic new) = do sendActivationSms p c (Just userLocale) for_ (liftM3 (,,) userEmail (createdUserTeam result) newUserTeam) $ \(e, ct, ut) -> sendWelcomeEmail e ct ut (Just userLocale) - cok <- case acc of - UserAccount _ Ephemeral -> lift $ Auth.newCookie @ZAuth.User userId Public.SessionCookie newUserLabel - UserAccount _ _ -> lift $ Auth.newCookie @ZAuth.User userId Public.PersistentCookie newUserLabel - pure $ CreateUserResponse cok userId (Public.SelfProfile usr) + cok <- + Auth.toWebCookie =<< case acc of + UserAccount _ Ephemeral -> lift $ Auth.newCookie @ZAuth.User userId Public.SessionCookie newUserLabel + UserAccount _ _ -> lift $ Auth.newCookie @ZAuth.User userId Public.PersistentCookie newUserLabel + -- pure $ CreateUserResponse cok userId (Public.SelfProfile usr) + pure $ Public.RegisterSuccess cok (Public.SelfProfile usr) where sendActivationEmail :: Public.Email -> Public.Name -> ActivationPair -> Maybe Public.Locale -> Maybe Public.NewTeamUser -> (AppIO r) () sendActivationEmail e u p l mTeamUser diff --git a/services/brig/src/Brig/API/User.hs b/services/brig/src/Brig/API/User.hs index 447cc3b3ef..1598be9006 100644 --- a/services/brig/src/Brig/API/User.hs +++ b/services/brig/src/Brig/API/User.hs @@ -88,13 +88,14 @@ module Brig.API.User ) where +import Brig.API.Error (errorDescriptionTypeToWai) import qualified Brig.API.Error as Error -import qualified Brig.API.Handler as API (Handler) +import qualified Brig.API.Handler as API (Handler, UserNotAllowedToJoinTeam (..)) import Brig.API.Types import Brig.API.Util import Brig.App import qualified Brig.Code as Code -import Brig.Data.Activation (ActivationEvent (..)) +import Brig.Data.Activation (ActivationEvent (..), activationErrorToRegisterError) import qualified Brig.Data.Activation as Data import qualified Brig.Data.Blacklist as Blacklist import qualified Brig.Data.Client as Data @@ -150,6 +151,7 @@ import Network.Wai.Utilities import qualified System.Logger.Class as Log import System.Logger.Message import UnliftIO.Async +import Wire.API.ErrorDescription import Wire.API.Federation.Error import Wire.API.Routes.Internal.Brig.Connection import Wire.API.Team.Member (legalHoldStatus) @@ -163,21 +165,37 @@ data AllowSCIMUpdates ------------------------------------------------------------------------------- -- Create User -verifyUniquenessAndCheckBlacklist :: UserKey -> ExceptT CreateUserError (AppIO r) () +data IdentityError + = IdentityErrorBlacklistedEmail + | IdentityErrorBlacklistedPhone + | IdentityErrorUserKeyExists + +identityErrorToRegisterError :: IdentityError -> RegisterError +identityErrorToRegisterError = \case + IdentityErrorBlacklistedEmail -> RegisterErrorBlacklistedEmail + IdentityErrorBlacklistedPhone -> RegisterErrorBlacklistedPhone + IdentityErrorUserKeyExists -> RegisterErrorUserKeyExists + +identityErrorToBrigError :: IdentityError -> Error.Error +identityErrorToBrigError = \case + IdentityErrorBlacklistedEmail -> Error.StdError $ errorDescriptionTypeToWai @BlacklistedEmail + IdentityErrorBlacklistedPhone -> Error.StdError $ errorDescriptionTypeToWai @BlacklistedPhone + IdentityErrorUserKeyExists -> Error.StdError $ errorDescriptionTypeToWai @UserKeyExists + +verifyUniquenessAndCheckBlacklist :: UserKey -> ExceptT IdentityError (AppIO r) () verifyUniquenessAndCheckBlacklist uk = do checkKey Nothing uk blacklisted <- lift $ Blacklist.exists uk when blacklisted $ - throwE (BlacklistedUserKey uk) + throwE (foldKey (const IdentityErrorBlacklistedEmail) (const IdentityErrorBlacklistedPhone) uk) where checkKey u k = do av <- lift $ Data.keyAvailable k u unless av $ - throwE $ - DuplicateUserKey k + throwE IdentityErrorUserKeyExists -- docs/reference/user/registration.md {#RefRegistration} -createUser :: NewUser -> ExceptT CreateUserError (AppIO r) CreateUserResult +createUser :: NewUser -> ExceptT RegisterError (AppIO r) CreateUserResult createUser new = do (email, phone) <- validateEmailAndPhone new @@ -276,29 +294,29 @@ createUser new = do where -- NOTE: all functions in the where block don't use any arguments of createUser - validateEmailAndPhone :: NewUser -> ExceptT CreateUserError (AppT r IO) (Maybe Email, Maybe Phone) + validateEmailAndPhone :: NewUser -> ExceptT RegisterError (AppT r IO) (Maybe Email, Maybe Phone) validateEmailAndPhone newUser = do -- Validate e-mail email <- for (newUserEmail newUser) $ \e -> either - (throwE . InvalidEmail e) + (const $ throwE RegisterErrorInvalidEmail) return (validateEmail e) -- Validate phone phone <- for (newUserPhone newUser) $ \p -> maybe - (throwE (InvalidPhone p)) + (throwE RegisterErrorInvalidPhone) return =<< lift (validatePhone p) - for_ (catMaybes [userEmailKey <$> email, userPhoneKey <$> phone]) $ do - verifyUniquenessAndCheckBlacklist + for_ (catMaybes [userEmailKey <$> email, userPhoneKey <$> phone]) $ \k -> + verifyUniquenessAndCheckBlacklist k !>> identityErrorToRegisterError pure (email, phone) - findTeamInvitation :: Maybe UserKey -> InvitationCode -> ExceptT CreateUserError (AppIO r) (Maybe (Team.Invitation, Team.InvitationInfo, TeamId)) - findTeamInvitation Nothing _ = throwE MissingIdentity + findTeamInvitation :: Maybe UserKey -> InvitationCode -> ExceptT RegisterError (AppIO r) (Maybe (Team.Invitation, Team.InvitationInfo, TeamId)) + findTeamInvitation Nothing _ = throwE RegisterErrorMissingIdentity findTeamInvitation (Just e) c = lift (Team.lookupInvitationInfo c) >>= \case Just ii -> do @@ -308,20 +326,20 @@ createUser new = do | e == userEmailKey em -> do _ <- ensureMemberCanJoin (Team.iiTeam ii) return $ Just (invite, ii, Team.iiTeam ii) - _ -> throwE InvalidInvitationCode - Nothing -> throwE InvalidInvitationCode + _ -> throwE RegisterErrorInvalidInvitationCode + Nothing -> throwE RegisterErrorInvalidInvitationCode - ensureMemberCanJoin :: TeamId -> ExceptT CreateUserError (AppIO r) () + ensureMemberCanJoin :: TeamId -> ExceptT RegisterError (AppIO r) () ensureMemberCanJoin tid = do maxSize <- fromIntegral . setMaxTeamSize <$> view settings (TeamSize teamSize) <- TeamSize.teamSize tid when (teamSize >= maxSize) $ - throwE TooManyTeamMembers + throwE RegisterErrorTooManyTeamMembers -- FUTUREWORK: The above can easily be done/tested in the intra call. -- Remove after the next release. canAdd <- lift $ Intra.checkUserCanJoinTeam tid case canAdd of - Just e -> throwE (ExternalPreconditionFailed e) + Just e -> throwM $ API.UserNotAllowedToJoinTeam e Nothing -> pure () acceptTeamInvitation :: @@ -330,18 +348,17 @@ createUser new = do Team.InvitationInfo -> UserKey -> UserIdentity -> - ExceptT CreateUserError (AppT r IO) () + ExceptT RegisterError (AppT r IO) () acceptTeamInvitation account inv ii uk ident = do let uid = userId (accountUser account) ok <- lift $ Data.claimKey uk uid unless ok $ - throwE $ - DuplicateUserKey uk + throwE RegisterErrorUserKeyExists let minvmeta :: (Maybe (UserId, UTCTimeMillis), Team.Role) minvmeta = ((,inCreatedAt inv) <$> inCreatedBy inv, Team.inRole inv) added <- lift $ Intra.addTeamMember uid (Team.iiTeam ii) minvmeta unless added $ - throwE TooManyTeamMembers + throwE RegisterErrorTooManyTeamMembers lift $ do activateUser uid ident -- ('insertAccount' sets column activated to False; here it is set to True.) void $ onActivated (AccountActivated account) @@ -352,12 +369,12 @@ createUser new = do Data.usersPendingActivationRemove uid Team.deleteInvitation (Team.inTeam inv) (Team.inInvitation inv) - addUserToTeamSSO :: UserAccount -> TeamId -> UserIdentity -> ExceptT CreateUserError (AppIO r) CreateUserTeam + addUserToTeamSSO :: UserAccount -> TeamId -> UserIdentity -> ExceptT RegisterError (AppIO r) CreateUserTeam addUserToTeamSSO account tid ident = do let uid = userId (accountUser account) added <- lift $ Intra.addTeamMember uid tid (Nothing, Team.defaultRole) unless added $ - throwE TooManyTeamMembers + throwE RegisterErrorTooManyTeamMembers lift $ do activateUser uid ident void $ onActivated (AccountActivated account) @@ -369,7 +386,7 @@ createUser new = do pure $ CreateUserTeam tid nm -- Handle e-mail activation (deprecated, see #RefRegistrationNoPreverification in /docs/reference/user/registration.md) - handleEmailActivation :: Maybe Email -> UserId -> Maybe BindingNewTeamUser -> ExceptT CreateUserError (AppT r IO) (Maybe Activation) + handleEmailActivation :: Maybe Email -> UserId -> Maybe BindingNewTeamUser -> ExceptT RegisterError (AppT r IO) (Maybe Activation) handleEmailActivation email uid newTeam = do fmap join . for (userEmailKey <$> email) $ \ek -> case newUserEmailCode new of Nothing -> do @@ -382,13 +399,15 @@ createUser new = do return $ Just edata Just c -> do ak <- liftIO $ Data.mkActivationKey ek - void $ activateWithCurrency (ActivateKey ak) c (Just uid) (bnuCurrency =<< newTeam) !>> EmailActivationError + void $ + activateWithCurrency (ActivateKey ak) c (Just uid) (bnuCurrency =<< newTeam) + !>> activationErrorToRegisterError return Nothing -- Handle phone activation (deprecated, see #RefRegistrationNoPreverification in /docs/reference/user/registration.md) - handlePhoneActivation :: Maybe Phone -> UserId -> ExceptT CreateUserError (AppT r IO) (Maybe Activation) + handlePhoneActivation :: Maybe Phone -> UserId -> ExceptT RegisterError (AppT r IO) (Maybe Activation) handlePhoneActivation phone uid = do - pdata <- fmap join . for (userPhoneKey <$> phone) $ \pk -> case newUserPhoneCode new of + fmap join . for (userPhoneKey <$> phone) $ \pk -> case newUserPhoneCode new of Nothing -> do timeout <- setActivationTimeout <$> view settings pdata <- lift $ Data.newActivation pk timeout (Just uid) @@ -399,9 +418,8 @@ createUser new = do return $ Just pdata Just c -> do ak <- liftIO $ Data.mkActivationKey pk - void $ activate (ActivateKey ak) c (Just uid) !>> PhoneActivationError + void $ activate (ActivateKey ak) c (Just uid) !>> activationErrorToRegisterError return Nothing - pure pdata initAccountFeatureConfig :: UserId -> (AppIO r) () initAccountFeatureConfig uid = do @@ -412,10 +430,10 @@ initAccountFeatureConfig uid = do -- all over the place there, we add a new function that handles just the one new flow where -- users are invited to the team via scim. createUserInviteViaScim :: UserId -> NewUserScimInvitation -> ExceptT Error.Error (AppIO r) UserAccount -createUserInviteViaScim uid (NewUserScimInvitation tid loc name rawEmail) = (`catchE` (throwE . Error.newUserError)) $ do - email <- either (throwE . InvalidEmail rawEmail) pure (validateEmail rawEmail) +createUserInviteViaScim uid (NewUserScimInvitation tid loc name rawEmail) = do + email <- either (const . throwE . Error.StdError $ errorDescriptionTypeToWai @InvalidEmail) pure (validateEmail rawEmail) let emKey = userEmailKey email - verifyUniquenessAndCheckBlacklist emKey + verifyUniquenessAndCheckBlacklist emKey !>> identityErrorToBrigError account <- lift $ newAccountInviteViaScim uid tid loc name email Log.debug $ field "user" (toByteString . userId . accountUser $ account) . field "action" (Log.val "User.createUserInviteViaScim") @@ -428,7 +446,6 @@ createUserInviteViaScim uid (NewUserScimInvitation tid loc name rawEmail) = (`ca lift $ Data.usersPendingActivationAdd (UserPendingActivation uid expiresAt) let activated = - -- It would be nice to set this to 'False' to make sure we're not accidentally -- treating 'PendingActivation' as 'Active', but then 'Brig.Data.User.toIdentity' -- would not produce an identity, and so we won't have the email address to construct -- the SCIM user. @@ -438,7 +455,7 @@ createUserInviteViaScim uid (NewUserScimInvitation tid loc name rawEmail) = (`ca return account -- | docs/reference/user/registration.md {#RefRestrictRegistration}. -checkRestrictedUserCreation :: NewUser -> ExceptT CreateUserError (AppIO r) () +checkRestrictedUserCreation :: NewUser -> ExceptT RegisterError (AppIO r) () checkRestrictedUserCreation new = do restrictPlease <- lift . asks $ fromMaybe False . setRestrictUserCreation . view settings when @@ -446,7 +463,7 @@ checkRestrictedUserCreation new = do && not (isNewUserTeamMember new) && not (isNewUserEphemeral new) ) - $ throwE UserCreationRestricted + $ throwE RegisterErrorUserCreationRestricted ------------------------------------------------------------------------------- -- Update Profile diff --git a/services/brig/src/Brig/Data/Activation.hs b/services/brig/src/Brig/Data/Activation.hs index 919f93df76..41c99b08b0 100644 --- a/services/brig/src/Brig/Data/Activation.hs +++ b/services/brig/src/Brig/Data/Activation.hs @@ -22,6 +22,7 @@ module Brig.Data.Activation ActivationCode (..), ActivationEvent (..), ActivationError (..), + activationErrorToRegisterError, newActivation, mkActivationKey, lookupActivationCode, @@ -48,6 +49,7 @@ import Imports import OpenSSL.BN (randIntegerZeroToNMinusOne) import OpenSSL.EVP.Digest (digestBS, getDigestByName) import Text.Printf (printf) +import Wire.API.User -- | The information associated with the pending activation of a 'UserKey'. data Activation = Activation @@ -60,10 +62,19 @@ data Activation = Activation data ActivationError = UserKeyExists !LT.Text - | InvalidActivationCode !LT.Text + | InvalidActivationCodeWrongUser + | InvalidActivationCodeWrongCode | InvalidActivationEmail !Email !String | InvalidActivationPhone !Phone +activationErrorToRegisterError :: ActivationError -> RegisterError +activationErrorToRegisterError = \case + UserKeyExists _ -> RegisterErrorUserKeyExists + InvalidActivationCodeWrongUser -> RegisterErrorInvalidActivationCodeWrongUser + InvalidActivationCodeWrongCode -> RegisterErrorInvalidActivationCodeWrongCode + InvalidActivationEmail _ _ -> RegisterErrorInvalidEmail + InvalidActivationPhone _ -> RegisterErrorInvalidPhone + data ActivationEvent = AccountActivated !UserAccount | EmailActivated !UserId !Email @@ -189,10 +200,10 @@ deleteActivationPair :: ActivationKey -> (AppIO r) () deleteActivationPair = write keyDelete . params LocalQuorum . Identity invalidUser :: ActivationError -invalidUser = InvalidActivationCode "User does not exist." +invalidUser = InvalidActivationCodeWrongUser -- "User does not exist." invalidCode :: ActivationError -invalidCode = InvalidActivationCode "Invalid activation code" +invalidCode = InvalidActivationCodeWrongCode -- "Invalid activation code" keyInsert :: PrepQuery W (ActivationKey, Text, Text, ActivationCode, Maybe UserId, Int32, Int32) () keyInsert = diff --git a/services/brig/src/Brig/Provider/API.hs b/services/brig/src/Brig/Provider/API.hs index 8c50699662..f6028eafba 100644 --- a/services/brig/src/Brig/Provider/API.hs +++ b/services/brig/src/Brig/Provider/API.hs @@ -324,7 +324,7 @@ newAccount :: Public.NewProvider -> (Handler r) Public.NewProviderResponse newAccount new = do email <- case validateEmail (Public.newProviderEmail new) of Right em -> return em - Left _ -> throwStd invalidEmail + Left _ -> throwStd (errorDescriptionTypeToWai @InvalidEmail) let name = Public.newProviderName new let pass = Public.newProviderPassword new let descr = fromRange (Public.newProviderDescr new) @@ -386,7 +386,7 @@ getActivationCode :: Public.Email -> (Handler r) FoundActivationCode getActivationCode e = do email <- case validateEmail e of Right em -> return em - Left _ -> throwStd invalidEmail + Left _ -> throwStd (errorDescriptionTypeToWai @InvalidEmail) gen <- Code.mkGen (Code.ForEmail email) code <- Code.lookup (Code.genKey gen) Code.IdentityVerification maybe (throwStd activationKeyNotFound) (return . FoundActivationCode) code @@ -496,7 +496,7 @@ updateAccountEmail :: ProviderId -> Public.EmailUpdate -> (Handler r) () updateAccountEmail pid (Public.EmailUpdate new) = do email <- case validateEmail new of Right em -> return em - Left _ -> throwStd invalidEmail + Left _ -> throwStd (errorDescriptionTypeToWai @InvalidEmail) let emailKey = mkEmailKey email DB.lookupKey emailKey >>= mapM_ (const $ throwStd emailExists) gen <- Code.mkGen (Code.ForEmail email) diff --git a/services/brig/src/Brig/Team/API.hs b/services/brig/src/Brig/Team/API.hs index 4ebdb9c2f9..5b18709bf0 100644 --- a/services/brig/src/Brig/Team/API.hs +++ b/services/brig/src/Brig/Team/API.hs @@ -90,7 +90,7 @@ routesPublic = do Doc.response 201 "Invitation was created and sent." Doc.end Doc.errorResponse noEmail Doc.errorResponse (errorDescriptionToWai (noIdentity 6)) - Doc.errorResponse invalidEmail + Doc.errorResponse (errorDescriptionTypeToWai @InvalidEmail) Doc.errorResponse blacklistedEmail Doc.errorResponse tooManyTeamInvitations @@ -149,7 +149,7 @@ routesPublic = do Doc.description "Invitation code" Doc.returns (Doc.ref Public.modelTeamInvitation) Doc.response 200 "Invitation successful." Doc.end - Doc.errorResponse invalidInvitationCode + Doc.errorResponse (errorDescriptionTypeToWai @InvalidInvitationCode) -- FUTUREWORK: Add another endpoint to allow resending of invitation codes head "/teams/invitations/by-email" (continue headInvitationByEmailH) $ @@ -228,7 +228,7 @@ getInvitationCodeH (_ ::: t ::: r) = do getInvitationCode :: TeamId -> InvitationId -> (Handler r) FoundInvitationCode getInvitationCode t r = do code <- lift $ DB.lookupInvitationCode t r - maybe (throwStd invalidInvitationCode) (return . FoundInvitationCode) code + maybe (throwStd $ errorDescriptionTypeToWai @InvalidInvitationCode) (return . FoundInvitationCode) code data FoundInvitationCode = FoundInvitationCode InvitationCode deriving (Eq, Show, Generic) @@ -321,7 +321,7 @@ createInvitation' tid inviteeRole mbInviterUid fromEmail body = do -- sendActivationCode. Refactor this to a single place -- Validate e-mail - inviteeEmail <- either (const $ throwStd invalidEmail) return (Email.validateEmail (irInviteeEmail body)) + inviteeEmail <- either (const $ throwStd (errorDescriptionTypeToWai @InvalidEmail)) return (Email.validateEmail (irInviteeEmail body)) let uke = userEmailKey inviteeEmail blacklistedEm <- lift $ Blacklist.exists uke when blacklistedEm $ @@ -404,7 +404,7 @@ getInvitationByCodeH (_ ::: c) = do getInvitationByCode :: Public.InvitationCode -> (Handler r) Public.Invitation getInvitationByCode c = do inv <- lift $ DB.lookupInvitationByCode c - maybe (throwStd invalidInvitationCode) return inv + maybe (throwStd $ errorDescriptionTypeToWai @InvalidInvitationCode) return inv headInvitationByEmailH :: JSON ::: Email -> (Handler r) Response headInvitationByEmailH (_ ::: e) = do diff --git a/services/brig/src/Brig/User/API/Auth.hs b/services/brig/src/Brig/User/API/Auth.hs index fdd67fd5fd..101c0e46e9 100644 --- a/services/brig/src/Brig/User/API/Auth.hs +++ b/services/brig/src/Brig/User/API/Auth.hs @@ -155,7 +155,7 @@ routesPublic = do Doc.description "JSON body" Doc.response 202 "Update accepted and pending activation of the new email." Doc.end Doc.response 204 "No update, current and new email address are the same." Doc.end - Doc.errorResponse invalidEmail + Doc.errorResponse (errorDescriptionTypeToWai @InvalidEmail) Doc.errorResponse (errorDescriptionTypeToWai @UserKeyExists) Doc.errorResponse blacklistedEmail Doc.errorResponse (errorDescriptionTypeToWai @BlacklistedPhone) diff --git a/services/brig/src/Brig/User/Auth/Cookie.hs b/services/brig/src/Brig/User/Auth/Cookie.hs index 28023f5863..2cd821f9af 100644 --- a/services/brig/src/Brig/User/Auth/Cookie.hs +++ b/services/brig/src/Brig/User/Auth/Cookie.hs @@ -32,6 +32,7 @@ module Brig.User.Auth.Cookie -- * HTTP setResponseCookie, + toWebCookie, -- * Re-exports Cookie (..), @@ -226,22 +227,24 @@ setResponseCookie :: Response -> m Response setResponseCookie c r = do - s <- view settings - let hdr = toByteString' (WebCookie.renderSetCookie (cookie s)) + hdr <- toByteString' . WebCookie.renderSetCookie <$> toWebCookie c return (addHeader "Set-Cookie" hdr r) - where - cookie s = - WebCookie.def - { WebCookie.setCookieName = "zuid", - WebCookie.setCookieValue = toByteString' (cookieValue c), - WebCookie.setCookiePath = Just "/access", - WebCookie.setCookieExpires = - if cookieType c == PersistentCookie - then Just (cookieExpires c) - else Nothing, - WebCookie.setCookieSecure = not (setCookieInsecure s), - WebCookie.setCookieHttpOnly = True - } + +toWebCookie :: (Monad m, MonadReader Env m, ZAuth.UserTokenLike u) => Cookie (ZAuth.Token u) -> m WebCookie.SetCookie +toWebCookie c = do + s <- view settings + pure $ + WebCookie.def + { WebCookie.setCookieName = "zuid", + WebCookie.setCookieValue = toByteString' (cookieValue c), + WebCookie.setCookiePath = Just "/access", + WebCookie.setCookieExpires = + if cookieType c == PersistentCookie + then Just (cookieExpires c) + else Nothing, + WebCookie.setCookieSecure = not (setCookieInsecure s), + WebCookie.setCookieHttpOnly = True + } -------------------------------------------------------------------------------- -- Tracking diff --git a/services/brig/test/integration/API/User/Account.hs b/services/brig/test/integration/API/User/Account.hs index 808f075999..5483a76403 100644 --- a/services/brig/test/integration/API/User/Account.hs +++ b/services/brig/test/integration/API/User/Account.hs @@ -1,20 +1,4 @@ {-# LANGUAGE NumericUnderscores #-} --- This file is part of the Wire Server implementation. --- --- Copyright (C) 2020 Wire Swiss GmbH --- --- This program is free software: you can redistribute it and/or modify it under --- the terms of the GNU Affero General Public License as published by the Free --- Software Foundation, either version 3 of the License, or (at your option) any --- later version. --- --- This program is distributed in the hope that it will be useful, but WITHOUT --- ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS --- FOR A PARTICULAR PURPOSE. See the GNU Affero General Public License for more --- details. --- --- You should have received a copy of the GNU Affero General Public License along --- with this program. If not, see . {-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-} -- This file is part of the Wire Server implementation. @@ -73,6 +57,7 @@ import Data.Range (Range (fromRange)) import qualified Data.Set as Set import Data.String.Conversions (cs) import qualified Data.Text as T +import qualified Data.Text as Text import qualified Data.Text.Encoding as T import Data.Time (UTCTime, getCurrentTime) import Data.Time.Clock (diffUTCTime) @@ -84,21 +69,24 @@ import Federator.MockServer (FederatedRequest (..), MockException (..)) import Galley.Types.Teams (noPermissions) import Gundeck.Types.Notification import Imports hiding (head) +import qualified Network.HTTP.Types as HTTP import qualified Network.HTTP.Types as Http import qualified Network.Wai as Wai import qualified Network.Wai.Utilities.Error as Error +import qualified Network.Wai.Utilities.Error as Wai import Test.Tasty hiding (Timeout) import Test.Tasty.Cannon hiding (Cannon) import qualified Test.Tasty.Cannon as WS import Test.Tasty.HUnit import UnliftIO (mapConcurrently_) -import Util as Util +import Util import Util.AWS as Util import Web.Cookie (parseSetCookie) import qualified Wire.API.Asset as Asset import Wire.API.Federation.API.Brig (UserDeletedConnectionsNotification (..)) import qualified Wire.API.Federation.API.Brig as FedBrig import Wire.API.Federation.API.Common (EmptyResponse (EmptyResponse)) +import Wire.API.Team.Invitation (Invitation (inInvitation)) import Wire.API.User (ListUsersQuery (..)) import Wire.API.User.Identity (mkSampleUref, mkSimpleSampleUref) @@ -121,6 +109,7 @@ tests _ at opts p b c ch g aws = test' aws p "post /register - 403 blacklist" $ testCreateUserBlacklist opts b aws, test' aws p "post /register - 400 external-SSO" $ testCreateUserExternalSSO b, test' aws p "post /register - 403 restricted user creation" $ testRestrictedUserCreation opts b, + test' aws p "post /register - 403 too many members for legalhold" $ testTooManyMembersForLegalhold opts b, test' aws p "post /activate - 200/204 + expiry" $ testActivateWithExpiry opts b at, test' aws p "get /users/:uid - 404" $ testNonExistingUserUnqualified b, test' aws p "get /users//:uid - 404" $ testNonExistingUser b, @@ -1586,6 +1575,47 @@ testRestrictedUserCreation opts brig = do ] postUserRegister' ssoUser brig !!! const 400 === statusCode +-- | FUTUREWORK: @setRestrictUserCreation@ perhaps needs to be tested in one place only, since it's the +-- first thing that we check on the /register endpoint. Other tests that make use of @setRestrictUserCreation@ +-- can probably be removed and simplified. It's probably a good candidate for Quickcheck. +testTooManyMembersForLegalhold :: Opt.Opts -> Brig -> Http () +testTooManyMembersForLegalhold opts brig = do + (owner, tid) <- createUserWithTeam brig + + -- Invite a user with mocked galley which tells us that the user cannot be + -- added. We cannot use real galley here as the real galley has legalhold set + -- to "whitelist-teams-and-implicit-consent". In this mode this error is not + -- thrown, so in order to emulate other modes, we just emulate what galley + -- would return in that case. + inviteeEmail <- randomEmail + let invite = stdInvitationRequest inviteeEmail + inv <- + responseJsonError =<< postInvitation brig tid owner invite + Cannon -> User -> [UserId] -> AWS.Env -> (UserId -> HttpT IO ()) -> Http () diff --git a/services/galley/schema/src/V58_ConversationAccessRoleV2.hs b/services/galley/schema/src/V58_ConversationAccessRoleV2.hs index 0d1248f070..a477e9b152 100644 --- a/services/galley/schema/src/V58_ConversationAccessRoleV2.hs +++ b/services/galley/schema/src/V58_ConversationAccessRoleV2.hs @@ -1,6 +1,6 @@ -- This file is part of the Wire Server implementation. -- --- Copyright (C) 2020 Wire Swiss GmbH +-- Copyright (C) 2022 Wire Swiss GmbH -- -- This program is free software: you can redistribute it and/or modify it under -- the terms of the GNU Affero General Public License as published by the Free diff --git a/services/galley/schema/src/V59_FileSharingLockStatus.hs b/services/galley/schema/src/V59_FileSharingLockStatus.hs index 8195f186b3..d1b8392482 100644 --- a/services/galley/schema/src/V59_FileSharingLockStatus.hs +++ b/services/galley/schema/src/V59_FileSharingLockStatus.hs @@ -1,6 +1,6 @@ -- This file is part of the Wire Server implementation. -- --- Copyright (C) 2020 Wire Swiss GmbH +-- Copyright (C) 2022 Wire Swiss GmbH -- -- This program is free software: you can redistribute it and/or modify it under -- the terms of the GNU Affero General Public License as published by the Free diff --git a/services/galley/src/Galley/API/Teams.hs b/services/galley/src/Galley/API/Teams.hs index bac8563893..00a6947684 100644 --- a/services/galley/src/Galley/API/Teams.hs +++ b/services/galley/src/Galley/API/Teams.hs @@ -1429,6 +1429,18 @@ canUserJoinTeamH :: canUserJoinTeamH tid = canUserJoinTeam tid >> pure empty -- This could be extended for more checks, for now we test only legalhold +-- +-- Brig's `POST /register` endpoint throws the errors returned by this endpoint +-- verbatim. +-- +-- FUTUREWORK: When this enpoint gets Servantified, it should have a more +-- precise list of errors, LegalHoldError is too wide, currently this can +-- actaully only error with TooManyTeamMembersOnTeamWithLegalhold. Once we have +-- a more precise list of errors and the endpoint is servantified, we can use +-- those to enrich 'Wire.API.User.RegisterError' and ensure that these errors +-- also show up in swagger. Currently, the error returned by this endpoint is +-- thrown in IO, we could then refactor that to be thrown in `ExceptT +-- RegisterError`. canUserJoinTeam :: Members '[ BrigAccess, diff --git a/services/galley/src/Galley/Intra/User.hs b/services/galley/src/Galley/Intra/User.hs index ad4482370f..efc2597b3d 100644 --- a/services/galley/src/Galley/Intra/User.hs +++ b/services/galley/src/Galley/Intra/User.hs @@ -234,9 +234,10 @@ getAccountFeatureConfigClient uid = getAccountFeatureConfigClientM :: UserId -> Client.ClientM TeamFeatureStatusNoConfig -( _ - :<|> getAccountFeatureConfigClientM - :<|> _ +( ( _ + :<|> getAccountFeatureConfigClientM + :<|> _ + ) :<|> _ ) = Client.client (Proxy @IAPI.API)