diff --git a/changelog.d/5-internal/wpb8691 b/changelog.d/5-internal/wpb8691 new file mode 100644 index 00000000000..de783e455e1 --- /dev/null +++ b/changelog.d/5-internal/wpb8691 @@ -0,0 +1 @@ +Remove remaining splinters of wai-routing, wai-predicate from brig. diff --git a/libs/types-common/src/Data/Code.hs b/libs/types-common/src/Data/Code.hs index ba176629701..c745b752caa 100644 --- a/libs/types-common/src/Data/Code.hs +++ b/libs/types-common/src/Data/Code.hs @@ -3,7 +3,6 @@ {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE StandaloneDeriving #-} -{-# LANGUAGE TemplateHaskell #-} -- This file is part of the Wire Server implementation. -- @@ -27,10 +26,8 @@ module Data.Code where import Cassandra hiding (Value) import Data.Aeson qualified as A -import Data.Aeson.TH import Data.Bifunctor (Bifunctor (first)) import Data.ByteString.Conversion -import Data.Json.Util import Data.OpenApi qualified as S import Data.OpenApi.ParamSchema import Data.Proxy (Proxy (Proxy)) @@ -123,5 +120,11 @@ data KeyValuePair = KeyValuePair code :: !Value } deriving (Eq, Generic, Show) - -deriveJSON toJSONFieldName ''KeyValuePair + deriving (A.ToJSON, A.FromJSON, S.ToSchema) via Schema KeyValuePair + +instance ToSchema KeyValuePair where + schema = + object "KeyValuePair" $ + KeyValuePair + <$> key .= field "key" schema + <*> code .= field "code" schema 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 42af0b8ca40..43ca007abb1 100644 --- a/libs/wire-api/src/Wire/API/Routes/Internal/Brig.hs +++ b/libs/wire-api/src/Wire/API/Routes/Internal/Brig.hs @@ -30,6 +30,7 @@ module Wire.API.Routes.Internal.Brig FederationRemotesAPI, EJPDRequest, ISearchIndexAPI, + ProviderAPI, GetAccountConferenceCallingConfig, PutAccountConferenceCallingConfig, DeleteAccountConferenceCallingConfig, @@ -538,6 +539,7 @@ type API = :<|> OAuthAPI :<|> ISearchIndexAPI :<|> FederationRemotesAPI + :<|> ProviderAPI ) type IStatusAPI = @@ -766,6 +768,17 @@ type FederationRemotesAPI = :> Delete '[JSON] () ) +type ProviderAPI = + ( Named + "get-provider-activation-code" + ( Summary "Retrieve activation code via api instead of email (for testing only)" + :> "provider" + :> "activation-code" + :> QueryParam' '[Required, Strict] "email" Email + :> MultiVerb1 'GET '[JSON] (Respond 200 "" Code.KeyValuePair) + ) + ) + type FederationRemotesAPIDescription = "See https://docs.wire.com/understand/federation/backend-communication.html#configuring-remote-connections for background. " diff --git a/services/brig/brig.cabal b/services/brig/brig.cabal index 4e0c272153d..f24644d2d67 100644 --- a/services/brig/brig.cabal +++ b/services/brig/brig.cabal @@ -77,7 +77,6 @@ library -- cabal-fmt: expand src exposed-modules: Brig.Allowlists - Brig.API Brig.API.Auth Brig.API.Client Brig.API.Connection @@ -358,8 +357,6 @@ library , wai >=3.0 , wai-extra >=3.0 , wai-middleware-gunzip >=0.0.2 - , wai-predicates >=0.8 - , wai-routing >=0.12 , wai-utilities >=0.16 , wire-api , wire-api-federation diff --git a/services/brig/default.nix b/services/brig/default.nix index 6c13f6194ea..37c5d355190 100644 --- a/services/brig/default.nix +++ b/services/brig/default.nix @@ -149,9 +149,7 @@ , wai , wai-extra , wai-middleware-gunzip -, wai-predicates , wai-route -, wai-routing , wai-utilities , warp , warp-tls @@ -284,8 +282,6 @@ mkDerivation { wai wai-extra wai-middleware-gunzip - wai-predicates - wai-routing wai-utilities wire-api wire-api-federation diff --git a/services/brig/src/Brig/API.hs b/services/brig/src/Brig/API.hs deleted file mode 100644 index ba318c3f2b5..00000000000 --- a/services/brig/src/Brig/API.hs +++ /dev/null @@ -1,31 +0,0 @@ --- 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 Brig.API - ( sitemap, - ) -where - -import Brig.API.Handler (Handler) -import Brig.API.Internal qualified as Internal -import Brig.Effects.GalleyProvider (GalleyProvider) -import Network.Wai.Routing (Routes) -import Polysemy - -sitemap :: forall r. (Member GalleyProvider r) => Routes () (Handler r) () -sitemap = do - Internal.sitemap diff --git a/services/brig/src/Brig/API/Handler.hs b/services/brig/src/Brig/API/Handler.hs index bbea923f517..4c6e92e341a 100644 --- a/services/brig/src/Brig/API/Handler.hs +++ b/services/brig/src/Brig/API/Handler.hs @@ -18,11 +18,9 @@ module Brig.API.Handler ( -- * Handler Monad Handler, - runHandler, toServantHandler, -- * Utilities - JSON, parseJsonBody, checkAllowlist, checkAllowlistWithError, @@ -53,13 +51,9 @@ import Data.Text.Encoding qualified as Text import Data.ZAuth.Validation qualified as ZV import Imports import Network.HTTP.Types (Status (statusCode, statusMessage)) -import Network.Wai (Request, ResponseReceived) -import Network.Wai.Predicate (Media) -import Network.Wai.Routing (Continue) import Network.Wai.Utilities.Error ((!>>)) import Network.Wai.Utilities.Error qualified as WaiError import Network.Wai.Utilities.Request (JsonRequest, parseBody) -import Network.Wai.Utilities.Response (addHeader, json, setStatus) import Network.Wai.Utilities.Server qualified as Server import Servant qualified import System.Logger qualified as Log @@ -72,18 +66,6 @@ import Wire.API.Error.Brig type Handler r = ExceptT Error (AppT r) -runHandler :: - Env -> - Request -> - (Handler BrigCanonicalEffects) ResponseReceived -> - Continue IO -> - IO ResponseReceived -runHandler e r h k = do - a <- - runBrigToIO e (runExceptT h) - `catches` brigErrorHandlers (view applog e) (unRequestId (view requestId e)) - either (onError (view applog e) r k) pure a - toServantHandler :: Env -> (Handler BrigCanonicalEffects) a -> Servant.Handler a toServantHandler env action = do let logger = view applog env @@ -135,33 +117,12 @@ brigErrorHandlers logger reqId = throwIO e ] -onError :: Logger -> Request -> Continue IO -> Error -> IO ResponseReceived -onError g r k e = do - Server.logError g (Just r) we - -- This function exists to workaround a problem that existed in nginx 5 years - -- ago. Context here: - -- https://github.com/zinfra/wai-utilities/commit/3d7e8349d3463e5ee2c3ebe89c717baeef1a8241 - -- So, this can probably be deleted and is not part of the new servant - -- handler. - Server.flushRequestBody r - k - $ setStatus (WaiError.code we) - . appEndo (foldMap (Endo . uncurry addHeader) hs) - $ json e - where - (we, hs) = case e of - StdError x -> (x, []) - RichError x _ h -> (x, h) - ------------------------------------------------------------------------------- -- Utilities --- TODO: move to libs/wai-utilities? -type JSON = Media "application" "json" - --- TODO: move to libs/wai-utilities? there is a parseJson' in "Network.Wai.Utilities.Request", --- but adjusting its signature to this here would require to move more code out of brig (at least --- badRequest and probably all the other errors). +-- This could go to libs/wai-utilities. There is a `parseJson'` in +-- "Network.Wai.Utilities.Request", but adding `parseJsonBody` there would require to move +-- more code out of brig. parseJsonBody :: (FromJSON a, MonadIO m) => JsonRequest a -> ExceptT Error m a parseJsonBody req = parseBody req !>> StdError . badRequest diff --git a/services/brig/src/Brig/API/Internal.hs b/services/brig/src/Brig/API/Internal.hs index 75c4d6a3976..28d004f2ec8 100644 --- a/services/brig/src/Brig/API/Internal.hs +++ b/services/brig/src/Brig/API/Internal.hs @@ -15,9 +15,7 @@ -- You should have received a copy of the GNU Affero General Public License along -- with this program. If not, see . module Brig.API.Internal - ( sitemap, - servantSitemap, - BrigIRoutes.API, + ( servantSitemap, getMLSClients, ) where @@ -74,7 +72,6 @@ import Data.Set qualified as Set import Data.Time.Clock (UTCTime) import Data.Time.Clock.System import Imports hiding (head) -import Network.Wai.Routing hiding (toList) import Network.Wai.Utilities as Utilities import Polysemy import Polysemy.Input (Input) @@ -104,9 +101,6 @@ import Wire.Rpc import Wire.Sem.Concurrency import Wire.Sem.Paging.Cassandra (InternalPaging) ---------------------------------------------------------------------------- --- Sitemap (servant) - servantSitemap :: forall r p. ( Member BlacklistPhonePrefixStore r, @@ -139,6 +133,7 @@ servantSitemap = :<|> internalOauthAPI :<|> internalSearchIndexAPI :<|> federationRemotesAPI + :<|> Provider.internalProviderAPI istatusAPI :: forall r. ServerT BrigIRoutes.IStatusAPI (Handler r) istatusAPI = Named @"get-status" (pure NoContent) @@ -373,16 +368,6 @@ internalSearchIndexAPI = :<|> Named @"indexReindex" (NoContent <$ lift (wrapClient Search.reindexAll)) :<|> Named @"indexReindexIfSameOrNewer" (NoContent <$ lift (wrapClient Search.reindexAllIfSameOrNewer)) ---------------------------------------------------------------------------- --- Sitemap (wai-route) - -sitemap :: - ( Member GalleyProvider r - ) => - Routes a (Handler r) () -sitemap = unsafeCallsFed @'Brig @"on-user-deleted-connections" $ do - Provider.routesInternal - --------------------------------------------------------------------------- -- Handlers diff --git a/services/brig/src/Brig/Code.hs b/services/brig/src/Brig/Code.hs index 2d0fc50485c..7840b8e3cb5 100644 --- a/services/brig/src/Brig/Code.hs +++ b/services/brig/src/Brig/Code.hs @@ -40,6 +40,7 @@ module Brig.Code codeForPhone, codeKey, codeValue, + codeToKeyValuePair, codeTTL, codeAccount, scopeFromAction, @@ -114,6 +115,9 @@ scopeFromAction = \case User.Login -> AccountLogin User.DeleteTeam -> DeleteTeam +codeToKeyValuePair :: Code -> KeyValuePair +codeToKeyValuePair code = KeyValuePair code.codeKey code.codeValue + -- | The same 'Key' can exist with different 'Value's in different -- 'Scope's at the same time. data Scope diff --git a/services/brig/src/Brig/Provider/API.hs b/services/brig/src/Brig/Provider/API.hs index 535ad5c9750..c59e561e4cb 100644 --- a/services/brig/src/Brig/Provider/API.hs +++ b/services/brig/src/Brig/Provider/API.hs @@ -17,10 +17,10 @@ module Brig.Provider.API ( -- * Main stuff - routesInternal, botAPI, servicesAPI, providerAPI, + internalProviderAPI, -- * Event handlers finishDeleteService, @@ -58,7 +58,6 @@ import Control.Exception.Enclosed (handleAny) import Control.Lens (view, (^.)) import Control.Monad.Catch (MonadMask) import Control.Monad.Except -import Data.Aeson hiding (json) import Data.ByteString.Conversion import Data.ByteString.Lazy.Char8 qualified as LC8 import Data.CommaSeparatedList (CommaSeparatedList (fromCommaSeparatedList)) @@ -79,14 +78,9 @@ import Data.Text.Encoding qualified as Text import Data.Text.Lazy qualified as Text import GHC.TypeNats import Imports -import Network.HTTP.Types.Status -import Network.Wai (Response) -import Network.Wai.Predicate (accept) -import Network.Wai.Routing +import Network.HTTP.Types import Network.Wai.Utilities.Error ((!>>)) import Network.Wai.Utilities.Error qualified as Wai -import Network.Wai.Utilities.Response (json) -import Network.Wai.Utilities.ZAuth import OpenSSL.EVP.Digest qualified as SSL import OpenSSL.EVP.PKey qualified as SSL import OpenSSL.PEM qualified as SSL @@ -114,6 +108,7 @@ import Wire.API.Provider.External qualified as Ext import Wire.API.Provider.Service import Wire.API.Provider.Service qualified as Public import Wire.API.Provider.Service.Tag qualified as Public +import Wire.API.Routes.Internal.Brig qualified as BrigIRoutes import Wire.API.Routes.Named (Named (Named)) import Wire.API.Routes.Public.Brig.Bot (BotAPI) import Wire.API.Routes.Public.Brig.Provider (ProviderAPI) @@ -177,11 +172,8 @@ providerAPI = :<|> Named @"provider-get-account" getAccount :<|> Named @"provider-get-profile" getProviderProfile -routesInternal :: Member GalleyProvider r => Routes a (Handler r) () -routesInternal = do - get "/i/provider/activation-code" (continue getActivationCodeH) $ - accept "application" "json" - .&> param "email" +internalProviderAPI :: Member GalleyProvider r => ServerT BrigIRoutes.ProviderAPI (Handler r) +internalProviderAPI = Named @"get-provider-activation-code" getActivationCodeH -------------------------------------------------------------------------------- -- Public API (Unauthenticated) @@ -242,26 +234,15 @@ activateAccountKey key val = do lift $ sendApprovalConfirmMail name email pure . Just $ Public.ProviderActivationResponse email -getActivationCodeH :: Member GalleyProvider r => Public.Email -> (Handler r) Response +getActivationCodeH :: Member GalleyProvider r => Public.Email -> (Handler r) Code.KeyValuePair getActivationCodeH e = do guardSecondFactorDisabled Nothing - json <$> getActivationCode e - -getActivationCode :: Public.Email -> (Handler r) FoundActivationCode -getActivationCode e = do email <- case validateEmail e of Right em -> pure em Left _ -> throwStd (errorToWai @'E.InvalidEmail) gen <- Code.mkGen (Code.ForEmail email) code <- wrapClientE $ Code.lookup (Code.genKey gen) Code.IdentityVerification - maybe (throwStd activationKeyNotFound) (pure . FoundActivationCode) code - -newtype FoundActivationCode = FoundActivationCode Code.Code - -instance ToJSON FoundActivationCode where - toJSON (FoundActivationCode vcode) = - toJSON $ - Code.KeyValuePair (Code.codeKey vcode) (Code.codeValue vcode) + maybe (throwStd activationKeyNotFound) (pure . Code.codeToKeyValuePair) code login :: Member GalleyProvider r => ProviderLogin -> Handler r ProviderTokenCookie login l = do diff --git a/services/brig/src/Brig/Run.hs b/services/brig/src/Brig/Run.hs index b74e58081c2..90316762356 100644 --- a/services/brig/src/Brig/Run.hs +++ b/services/brig/src/Brig/Run.hs @@ -22,7 +22,6 @@ module Brig.Run where import AWS.Util (readAuthExpiration) -import Brig.API (sitemap) import Brig.API.Federation import Brig.API.Handler import Brig.API.Internal qualified as IAPI @@ -59,8 +58,6 @@ import Network.HTTP.Types qualified as HTTP import Network.Wai qualified as Wai import Network.Wai.Middleware.Gunzip qualified as GZip import Network.Wai.Middleware.Gzip qualified as GZip -import Network.Wai.Routing (Tree) -import Network.Wai.Routing.Route (App) import Network.Wai.Utilities (lookupRequestId) import Network.Wai.Utilities.Server import Network.Wai.Utilities.Server qualified as Server @@ -72,6 +69,7 @@ import System.Logger qualified as Log import System.Logger.Class (MonadLogger, err) import Util.Options import Wire.API.Routes.API +import Wire.API.Routes.Internal.Brig qualified as IAPI import Wire.API.Routes.Public.Brig import Wire.API.Routes.Version import Wire.API.Routes.Version.Wai @@ -119,22 +117,16 @@ mkApp o = do e <- newEnv o pure (middleware e $ \reqId -> servantApp (e & requestId .~ reqId), e) where - rtree :: Tree (App (Handler BrigCanonicalEffects)) - rtree = compile sitemap - middleware :: Env -> (RequestId -> Wai.Application) -> Wai.Application middleware e = -- this rewrites the request, so it must be at the top (i.e. applied last) versionMiddleware (e ^. disabledVersions) - . Metrics.servantPlusWAIPrometheusMiddleware (sitemap @BrigCanonicalEffects) (Proxy @ServantCombinedAPI) + . Metrics.servantPrometheusMiddleware (Proxy @ServantCombinedAPI) . GZip.gunzip . GZip.gzip GZip.def . catchErrors (e ^. applog) [Right $ e ^. metrics] . lookupRequestIdMiddleware (e ^. applog) - app :: Env -> Wai.Request -> (Wai.Response -> IO Wai.ResponseReceived) -> IO Wai.ResponseReceived - app e r k = runHandler e r (Server.route rtree r k) k - -- the servant API wraps the one defined using wai-routing servantApp :: Env -> Wai.Application servantApp e = @@ -147,7 +139,6 @@ mkApp o = do :<|> hoistServerWithDomain @IAPI.API (toServantHandler e) IAPI.servantSitemap :<|> hoistServerWithDomain @FederationAPI (toServantHandler e) federationSitemap :<|> hoistServerWithDomain @VersionAPI (toServantHandler e) versionAPI - :<|> Servant.Tagged (app e) ) type ServantCombinedAPI = @@ -156,7 +147,6 @@ type ServantCombinedAPI = :<|> IAPI.API :<|> FederationAPI :<|> VersionAPI - :<|> Servant.Raw ) lookupRequestIdMiddleware :: Logger -> (RequestId -> Wai.Application) -> Wai.Application diff --git a/services/brig/test/integration/API/Provider.hs b/services/brig/test/integration/API/Provider.hs index a2479df44e8..538453d1aed 100644 --- a/services/brig/test/integration/API/Provider.hs +++ b/services/brig/test/integration/API/Provider.hs @@ -1680,10 +1680,10 @@ testRegisterProvider db' brig = do activateProvider brig (Code.codeKey vcode) (Code.codeValue vcode) !!! const 200 === statusCode Nothing -> do - _rs <- + rs <- getProviderActivationCodeInternal brig email