Finish servantifying brig

changelog.d/5-internal/wpb8691

@@ -0,0 +1 @@
+Remove remaining splinters of wai-routing, wai-predicate from brig.

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

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. "
 

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

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

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
 

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 <https://www.gnu.org/licenses/>.
 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
 

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

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