From d8fac9875d6bf98547ec1d144ad714eae8ea43ad Mon Sep 17 00:00:00 2001 From: Leif Battermann Date: Fri, 16 Sep 2022 14:32:16 +0000 Subject: [PATCH 1/4] post send activation --- libs/wire-api/src/Wire/API/Error/Brig.hs | 10 + .../src/Wire/API/Routes/Public/Brig.hs | 15 ++ libs/wire-api/src/Wire/API/Swagger.hs | 3 - libs/wire-api/src/Wire/API/User/Activation.hs | 184 ++++++++---------- services/brig/src/Brig/API/Public.hs | 27 +-- 5 files changed, 111 insertions(+), 128 deletions(-) diff --git a/libs/wire-api/src/Wire/API/Error/Brig.hs b/libs/wire-api/src/Wire/API/Error/Brig.hs index 6e5e8a03ebb..ab251a2bc08 100644 --- a/libs/wire-api/src/Wire/API/Error/Brig.hs +++ b/libs/wire-api/src/Wire/API/Error/Brig.hs @@ -66,6 +66,7 @@ data BrigError | InsufficientTeamPermissions | KeyPackageDecodingError | InvalidKeyPackageRef + | CustomerExtensionBlockedDomain instance KnownError (MapError e) => IsSwaggerError (e :: BrigError) where addToSwagger = addStaticErrorToSwagger @(MapError e) @@ -178,3 +179,12 @@ type instance MapError 'InsufficientTeamPermissions = 'StaticError 403 "insuffic type instance MapError 'KeyPackageDecodingError = 'StaticError 409 "decoding-error" "Key package could not be TLS-decoded" type instance MapError 'InvalidKeyPackageRef = 'StaticError 409 "invalid-reference" "Key package's reference does not match its data" + +type instance + MapError 'CustomerExtensionBlockedDomain = + 'StaticError + 451 + "domain-blocked-for-registration" + "[Customer extension] the email domain example.com \ + \that you are attempting to register a user with has been \ + \blocked for creating wire users. Please contact your IT department." 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 0b39efda323..ea553494153 100644 --- a/libs/wire-api/src/Wire/API/Routes/Public/Brig.hs +++ b/libs/wire-api/src/Wire/API/Routes/Public/Brig.hs @@ -442,6 +442,21 @@ type AccountAPI = GetActivateResponse ActivationRespWithStatus ) + -- docs/reference/user/activation.md {#RefActivationRequest} + :<|> Named + "post-activate-send" + ( Summary "Send (or resend) an email or phone activation code." + :> CanThrow 'UserKeyExists + :> CanThrow 'InvalidEmail + :> CanThrow 'InvalidPhone + :> CanThrow 'BlacklistedEmail + :> CanThrow 'BlacklistedPhone + :> CanThrow 'CustomerExtensionBlockedDomain + :> "activate" + :> "send" + :> ReqBody '[JSON] SendActivationCode + :> MultiVerb 'POST '[JSON] '[RespondEmpty 200 "Activation code sent."] () + ) data ActivationRespWithStatus = ActivationResp ActivationResponse diff --git a/libs/wire-api/src/Wire/API/Swagger.hs b/libs/wire-api/src/Wire/API/Swagger.hs index 53796f33058..79992799efc 100644 --- a/libs/wire-api/src/Wire/API/Swagger.hs +++ b/libs/wire-api/src/Wire/API/Swagger.hs @@ -36,7 +36,6 @@ import qualified Wire.API.Team.Conversation as Team.Conversation import qualified Wire.API.Team.Invitation as Team.Invitation import qualified Wire.API.Team.Permission as Team.Permission import qualified Wire.API.User as User -import qualified Wire.API.User.Activation as User.Activation import qualified Wire.API.User.Auth as User.Auth import qualified Wire.API.User.Client as User.Client import qualified Wire.API.User.Client.Prekey as User.Client.Prekey @@ -102,8 +101,6 @@ models = User.modelUser, User.modelEmailUpdate, User.modelDelete, - User.Activation.modelSendActivationCode, - User.Activation.modelActivationResponse, User.Auth.modelSendLoginCode, User.Auth.modelLoginCodeResponse, User.Auth.modelLogin, diff --git a/libs/wire-api/src/Wire/API/User/Activation.hs b/libs/wire-api/src/Wire/API/User/Activation.hs index c42c16e7b2c..4ec40cb6d3f 100644 --- a/libs/wire-api/src/Wire/API/User/Activation.hs +++ b/libs/wire-api/src/Wire/API/User/Activation.hs @@ -32,24 +32,17 @@ module Wire.API.User.Activation -- * SendActivationCode SendActivationCode (..), - - -- * Swagger - modelSendActivationCode, - modelActivationResponse, ) where import Control.Lens ((?~)) -import Data.Aeson +import qualified Data.Aeson as A import Data.Aeson.Types (Parser) import Data.ByteString.Conversion import Data.Data (Proxy (Proxy)) -import Data.Json.Util ((#)) -import Data.Schema as Schema (Schema (..), ToSchema (..), description) -import qualified Data.Schema as Schema +import Data.Schema import Data.Swagger (ToParamSchema) import qualified Data.Swagger as S -import qualified Data.Swagger.Build.Api as Doc import Data.Text.Ascii import Data.Tuple.Extra (fst3, snd3, thd3) import Imports @@ -81,7 +74,7 @@ instance ToByteString ActivationTarget where newtype ActivationKey = ActivationKey {fromActivationKey :: AsciiBase64Url} deriving stock (Eq, Show, Generic) - deriving newtype (ToSchema, ToByteString, FromByteString, ToJSON, FromJSON, Arbitrary) + deriving newtype (ToSchema, ToByteString, FromByteString, A.ToJSON, A.FromJSON, Arbitrary) instance ToParamSchema ActivationKey where toParamSchema _ = S.toParamSchema (Proxy @Text) @@ -89,34 +82,6 @@ instance ToParamSchema ActivationKey where instance FromHttpApiData ActivationKey where parseUrlPiece = fmap ActivationKey . parseUrlPiece -maybeActivationKeyObjectSchema :: Schema.ObjectSchemaP Schema.SwaggerDoc (Maybe ActivationKey, Maybe Phone, Maybe Email) ActivationTarget -maybeActivationKeyObjectSchema = - Schema.withParser activationKeyTupleObjectSchema maybeActivationKeyTargetFromTuple - where - activationKeyTupleObjectSchema :: Schema.ObjectSchema Schema.SwaggerDoc (Maybe ActivationKey, Maybe Phone, Maybe Email) - activationKeyTupleObjectSchema = - (,,) - <$> fst3 Schema..= Schema.maybe_ (Schema.optFieldWithDocModifier "key" keyDocs Schema.schema) - <*> snd3 Schema..= Schema.maybe_ (Schema.optFieldWithDocModifier "phone" phoneDocs Schema.schema) - <*> thd3 Schema..= Schema.maybe_ (Schema.optFieldWithDocModifier "email" emailDocs Schema.schema) - where - keyDocs = description ?~ "An opaque key to activate, as it was sent by the API." - phoneDocs = description ?~ "A known phone number to activate." - emailDocs = description ?~ "A known email address to activate." - - maybeActivationKeyTargetFromTuple :: (Maybe ActivationKey, Maybe Phone, Maybe Email) -> Parser ActivationTarget - maybeActivationKeyTargetFromTuple = \case - (Just key, _, _) -> pure $ ActivateKey key - (_, _, Just email) -> pure $ ActivateEmail email - (_, Just phone, _) -> pure $ ActivatePhone phone - _ -> fail "key, email or phone must be present" - -maybeActivationTargetToTuple :: ActivationTarget -> (Maybe ActivationKey, Maybe Phone, Maybe Email) -maybeActivationTargetToTuple = \case - ActivateKey key -> (Just key, Nothing, Nothing) - ActivatePhone phone -> (Nothing, Just phone, Nothing) - ActivateEmail email -> (Nothing, Nothing, Just email) - -------------------------------------------------------------------------------- -- ActivationCode @@ -127,7 +92,7 @@ newtype ActivationCode = ActivationCode {fromActivationCode :: AsciiBase64Url} deriving stock (Eq, Show, Generic) deriving newtype (ToByteString, FromByteString, ToSchema, Arbitrary) - deriving (ToJSON, FromJSON, S.ToSchema) via Schema ActivationCode + deriving (A.ToJSON, A.FromJSON, S.ToSchema) via Schema ActivationCode instance ToParamSchema ActivationCode where toParamSchema _ = S.toParamSchema (Proxy @Text) @@ -146,19 +111,24 @@ data Activate = Activate } deriving stock (Eq, Show, Generic) deriving (Arbitrary) via (GenericUniform Activate) - deriving (ToJSON, FromJSON, S.ToSchema) via Schema Activate + deriving (A.ToJSON, A.FromJSON, S.ToSchema) via Schema Activate instance ToSchema Activate where schema = - Schema.objectWithDocModifier "Activate" objectDocs $ + objectWithDocModifier "Activate" objectDocs $ Activate - <$> (maybeActivationTargetToTuple . activateTarget) Schema..= maybeActivationKeyObjectSchema - <*> activateCode Schema..= Schema.fieldWithDocModifier "code" codeDocs schema - <*> activateDryrun Schema..= Schema.fieldWithDocModifier "dryrun" dryrunDocs schema + <$> (maybeActivationTargetToTuple . activateTarget) .= maybeActivationTargetObjectSchema + <*> activateCode .= fieldWithDocModifier "code" codeDocs schema + <*> activateDryrun .= fieldWithDocModifier "dryrun" dryRunDocs schema where + objectDocs :: NamedSwaggerDoc -> NamedSwaggerDoc objectDocs = description ?~ "Data for an activation request." + + codeDocs :: NamedSwaggerDoc -> NamedSwaggerDoc codeDocs = description ?~ "The activation code." - dryrunDocs = + + dryRunDocs :: NamedSwaggerDoc -> NamedSwaggerDoc + dryRunDocs = description ?~ "At least one of key, email, or phone has to be present \ \while key takes precedence over email, and email takes precedence over phone. \ @@ -167,6 +137,34 @@ instance ToSchema Activate where \cookies or tokens on success but failures still count \ \towards the maximum failure count." + maybeActivationTargetObjectSchema :: ObjectSchemaP SwaggerDoc (Maybe ActivationKey, Maybe Phone, Maybe Email) ActivationTarget + maybeActivationTargetObjectSchema = + withParser activationTargetTupleObjectSchema maybeActivationTargetTargetFromTuple + where + activationTargetTupleObjectSchema :: ObjectSchema SwaggerDoc (Maybe ActivationKey, Maybe Phone, Maybe Email) + activationTargetTupleObjectSchema = + (,,) + <$> fst3 .= maybe_ (optFieldWithDocModifier "key" keyDocs schema) + <*> snd3 .= maybe_ (optFieldWithDocModifier "phone" phoneDocs schema) + <*> thd3 .= maybe_ (optFieldWithDocModifier "email" emailDocs schema) + where + keyDocs = description ?~ "An opaque key to activate, as it was sent by the API." + phoneDocs = description ?~ "A known phone number to activate." + emailDocs = description ?~ "A known email address to activate." + + maybeActivationTargetTargetFromTuple :: (Maybe ActivationKey, Maybe Phone, Maybe Email) -> Parser ActivationTarget + maybeActivationTargetTargetFromTuple = \case + (Just key, _, _) -> pure $ ActivateKey key + (_, _, Just email) -> pure $ ActivateEmail email + (_, Just phone, _) -> pure $ ActivatePhone phone + _ -> fail "key, email or phone must be present" + + maybeActivationTargetToTuple :: ActivationTarget -> (Maybe ActivationKey, Maybe Phone, Maybe Email) + maybeActivationTargetToTuple = \case + ActivateKey key -> (Just key, Nothing, Nothing) + ActivatePhone phone -> (Nothing, Just phone, Nothing) + ActivateEmail email -> (Nothing, Nothing, Just email) + -- | Information returned as part of a successful activation. data ActivationResponse = ActivationResponse { -- | The activated / verified user identity. @@ -176,26 +174,14 @@ data ActivationResponse = ActivationResponse } deriving stock (Eq, Show, Generic) deriving (Arbitrary) via (GenericUniform ActivationResponse) - deriving (ToJSON, FromJSON, S.ToSchema) via Schema ActivationResponse + deriving (A.ToJSON, A.FromJSON, S.ToSchema) via Schema ActivationResponse instance ToSchema ActivationResponse where schema = - Schema.objectWithDocModifier "ActivationResponse" (description ?~ "Response body of a successful activation request") $ + objectWithDocModifier "ActivationResponse" (description ?~ "Response body of a successful activation request") $ ActivationResponse - <$> activatedIdentity Schema..= userIdentityObjectSchema - <*> activatedFirst Schema..= (fromMaybe False <$> Schema.optFieldWithDocModifier "first" (description ?~ "Whether this is the first successful activation (i.e. account activation).") Schema.schema) - -modelActivationResponse :: Doc.Model -modelActivationResponse = Doc.defineModel "ActivationResponse" $ do - Doc.description "Response body of a successful activation request" - Doc.property "email" Doc.string' $ do - Doc.description "The email address that was activated." - Doc.optional - Doc.property "phone" Doc.string' $ do - Doc.description "The phone number that was activated." - Doc.optional - Doc.property "first" Doc.bool' $ - Doc.description "Whether this is the first successful activation (i.e. account activation)." + <$> activatedIdentity .= userIdentityObjectSchema + <*> activatedFirst .= (fromMaybe False <$> optFieldWithDocModifier "first" (description ?~ "Whether this is the first successful activation (i.e. account activation).") schema) -------------------------------------------------------------------------------- -- SendActivationCode @@ -210,43 +196,43 @@ data SendActivationCode = SendActivationCode } deriving stock (Eq, Show, Generic) deriving (Arbitrary) via (GenericUniform SendActivationCode) + deriving (A.ToJSON, A.FromJSON, S.ToSchema) via Schema SendActivationCode -modelSendActivationCode :: Doc.Model -modelSendActivationCode = Doc.defineModel "SendActivationCode" $ do - Doc.description - "Data for requesting an email or phone activation code to be sent. \ - \One of 'email' or 'phone' must be present." - Doc.property "email" Doc.string' $ do - Doc.description "Email address to send the code to." - Doc.optional - Doc.property "phone" Doc.string' $ do - Doc.description "E.164 phone number to send the code to." - Doc.optional - Doc.property "locale" Doc.string' $ do - Doc.description "Locale to use for the activation code template." - Doc.optional - Doc.property "voice_call" Doc.bool' $ do - Doc.description "Request the code with a call instead (default is SMS)." - Doc.optional - -instance ToJSON SendActivationCode where - toJSON (SendActivationCode userKey locale call) = - object $ - either ("email" .=) ("phone" .=) userKey - # "locale" .= locale - # "voice_call" .= call - # [] - -instance FromJSON SendActivationCode where - parseJSON = withObject "SendActivationCode" $ \o -> do - e <- o .:? "email" - p <- o .:? "phone" - SendActivationCode - <$> key e p - <*> o .:? "locale" - <*> o .:? "voice_call" .!= False +instance ToSchema SendActivationCode where + schema = + objectWithDocModifier "SendActivationCode" objectDesc $ + SendActivationCode + <$> (maybeUserKeyToTuple . saUserKey) .= userKeyObjectSchema + <*> saLocale .= maybe_ (optFieldWithDocModifier "locale" (description ?~ "Locale to use for the activation code template.") schema) + <*> saCall .= (fromMaybe False <$> optFieldWithDocModifier "voice_call" (description ?~ "Request the code with a call instead (default is SMS).") schema) where - key (Just _) (Just _) = fail "Only one of 'email' or 'phone' allowed." - key Nothing Nothing = fail "One of 'email' or 'phone' required." - key (Just e) Nothing = pure $ Left e - key Nothing (Just p) = pure $ Right p + maybeUserKeyToTuple :: Either Email Phone -> (Maybe Email, Maybe Phone) + maybeUserKeyToTuple = \case + Left email -> (Just email, Nothing) + Right phone -> (Nothing, Just phone) + + objectDesc :: NamedSwaggerDoc -> NamedSwaggerDoc + objectDesc = + description + ?~ "Data for requesting an email or phone activation code to be sent. \ + \One of 'email' or 'phone' must be present." + + userKeyObjectSchema :: ObjectSchemaP SwaggerDoc (Maybe Email, Maybe Phone) (Either Email Phone) + userKeyObjectSchema = + withParser userKeyTupleObjectSchema maybeUserKeyFromTuple + where + userKeyTupleObjectSchema :: ObjectSchema SwaggerDoc (Maybe Email, Maybe Phone) + userKeyTupleObjectSchema = + (,) + <$> fst .= maybe_ (optFieldWithDocModifier "email" phoneDocs schema) + <*> snd .= maybe_ (optFieldWithDocModifier "phone" emailDocs schema) + where + emailDocs = description ?~ "Email address to send the code to." + phoneDocs = description ?~ "E.164 phone number to send the code to." + + maybeUserKeyFromTuple :: (Maybe Email, Maybe Phone) -> Parser (Either Email Phone) + maybeUserKeyFromTuple = \case + (Just _, Just _) -> fail "Only one of 'email' or 'phone' allowed." + (Just email, Nothing) -> pure $ Left email + (Nothing, Just phone) -> pure $ Right phone + (Nothing, Nothing) -> fail "One of 'email' or 'phone' required." diff --git a/services/brig/src/Brig/API/Public.hs b/services/brig/src/Brig/API/Public.hs index d563434c0e4..5db6b5516e5 100644 --- a/services/brig/src/Brig/API/Public.hs +++ b/services/brig/src/Brig/API/Public.hs @@ -227,6 +227,7 @@ servantSitemap = userAPI :<|> selfAPI :<|> accountAPI :<|> clientAPI :<|> prekey :<|> Named @"verify-delete" verifyDeleteUser :<|> Named @"get-activate" activate :<|> Named @"post-activate" activateKey + :<|> Named @"post-activate-send" sendActivationCode clientAPI :: ServerT ClientAPI (Handler r) clientAPI = @@ -315,21 +316,6 @@ sitemap :: sitemap = do -- /activate, /password-reset ---------------------------------- - -- docs/reference/user/activation.md {#RefActivationRequest} - post "/activate/send" (continue sendActivationCodeH) $ - jsonRequest @Public.SendActivationCode - document "POST" "sendActivationCode" $ do - Doc.summary "Send (or resend) an email or phone activation code." - Doc.body (Doc.ref Public.modelSendActivationCode) $ - Doc.description "JSON body" - Doc.response 200 "Activation code sent." Doc.end - Doc.errorResponse (errorToWai @'E.InvalidEmail) - Doc.errorResponse (errorToWai @'E.InvalidPhone) - Doc.errorResponse (errorToWai @'E.UserKeyExists) - Doc.errorResponse blacklistedEmail - Doc.errorResponse (errorToWai @'E.BlacklistedPhone) - Doc.errorResponse (customerExtensionBlockedDomain (either undefined id $ mkDomain "example.com")) - post "/password-reset" (continue beginPasswordResetH) $ accept "application" "json" .&. jsonRequest @Public.NewPasswordReset @@ -812,17 +798,6 @@ completePasswordResetH (_ ::: req) = do API.completePasswordReset cpwrIdent cpwrCode cpwrPassword !>> pwResetError pure empty -sendActivationCodeH :: - Members - '[ BlacklistStore, - BlacklistPhonePrefixStore - ] - r => - JsonRequest Public.SendActivationCode -> - (Handler r) Response -sendActivationCodeH req = - empty <$ (sendActivationCode =<< parseJsonBody req) - -- docs/reference/user/activation.md {#RefActivationRequest} -- docs/reference/user/registration.md {#RefRegistration} sendActivationCode :: From 3fad7f5dbed922896ebd0b4189fd6a26211515d6 Mon Sep 17 00:00:00 2001 From: Leif Battermann Date: Mon, 19 Sep 2022 08:18:36 +0000 Subject: [PATCH 2/4] changelog --- changelog.d/5-internal/pr-2702 | 1 + 1 file changed, 1 insertion(+) create mode 100644 changelog.d/5-internal/pr-2702 diff --git a/changelog.d/5-internal/pr-2702 b/changelog.d/5-internal/pr-2702 new file mode 100644 index 00000000000..110b73f20fe --- /dev/null +++ b/changelog.d/5-internal/pr-2702 @@ -0,0 +1 @@ +The `POST /activate/send` endpoint of the account API is now migrated to servant From b5faf740e8718869d1a9d4719696f9085fac9f9e Mon Sep 17 00:00:00 2001 From: Leif Battermann Date: Wed, 21 Sep 2022 11:00:19 +0000 Subject: [PATCH 3/4] hi ci From c6375812820336203087a7f22d30d1dfd0c53b4c Mon Sep 17 00:00:00 2001 From: Leif Battermann Date: Wed, 21 Sep 2022 13:03:47 +0000 Subject: [PATCH 4/4] hi ci