diff --git a/changelog.d/6-federation/add-cargohold-component b/changelog.d/6-federation/add-cargohold-component new file mode 100644 index 0000000000..47c17b41b8 --- /dev/null +++ b/changelog.d/6-federation/add-cargohold-component @@ -0,0 +1 @@ +Add cargohold as a new federated component diff --git a/charts/federator/templates/configmap.yaml b/charts/federator/templates/configmap.yaml index 1c151172e8..58c1310684 100644 --- a/charts/federator/templates/configmap.yaml +++ b/charts/federator/templates/configmap.yaml @@ -31,6 +31,10 @@ data: host: galley port: 8080 + cargohold: + host: cargohold + port: 8080 + {{- with .Values.config }} logNetStrings: True # log using netstrings encoding: diff --git a/charts/federator/templates/tests/configmap.yaml b/charts/federator/templates/tests/configmap.yaml index 31b26123dc..910411fe5d 100644 --- a/charts/federator/templates/tests/configmap.yaml +++ b/charts/federator/templates/tests/configmap.yaml @@ -16,6 +16,9 @@ data: galley: host: galley port: 8080 + cargohold: + host: cargohold + port: 8080 nginxIngress: host: federation-test-helper.{{ .Release.Namespace }}.svc.cluster.local port: 443 diff --git a/libs/wire-api-federation/src/Wire/API/Federation/API.hs b/libs/wire-api-federation/src/Wire/API/Federation/API.hs index b89d9698ee..961859a06f 100644 --- a/libs/wire-api-federation/src/Wire/API/Federation/API.hs +++ b/libs/wire-api-federation/src/Wire/API/Federation/API.hs @@ -26,6 +26,7 @@ where import Servant.Client.Generic import Wire.API.Federation.API.Brig +import Wire.API.Federation.API.Cargohold import Wire.API.Federation.API.Galley import Wire.API.Federation.Client import Wire.API.Federation.Component @@ -43,3 +44,7 @@ instance HasFederationAPI 'Galley where instance HasFederationAPI 'Brig where type FedApi 'Brig = BrigApi clientRoutes = genericClient + +instance HasFederationAPI 'Cargohold where + type FedApi 'Cargohold = CargoholdApi + clientRoutes = genericClient diff --git a/libs/wire-api-federation/src/Wire/API/Federation/API/Cargohold.hs b/libs/wire-api-federation/src/Wire/API/Federation/API/Cargohold.hs new file mode 100644 index 0000000000..4557347628 --- /dev/null +++ b/libs/wire-api-federation/src/Wire/API/Federation/API/Cargohold.hs @@ -0,0 +1,31 @@ +-- This file is part of the Wire Server implementation. +-- +-- Copyright (C) 2021 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 Wire.API.Federation.API.Cargohold where + +import Servant.API +import Servant.API.Generic +import Wire.API.Federation.API.Common + +data CargoholdApi routes = CargoholdApi + { getAsset :: + routes + :- "get-asset" + :> ReqBody '[JSON] () + :> Post '[JSON] EmptyResponse + } + deriving (Generic) diff --git a/libs/wire-api-federation/src/Wire/API/Federation/Component.hs b/libs/wire-api-federation/src/Wire/API/Federation/Component.hs index f2c997ee25..9f8c0acaf9 100644 --- a/libs/wire-api-federation/src/Wire/API/Federation/Component.hs +++ b/libs/wire-api-federation/src/Wire/API/Federation/Component.hs @@ -24,17 +24,20 @@ import Wire.API.Arbitrary (GenericUniform (..)) data Component = Brig | Galley + | Cargohold deriving (Show, Eq, Generic) deriving (Arbitrary) via (GenericUniform Component) parseComponent :: Text -> Maybe Component parseComponent "brig" = Just Brig parseComponent "galley" = Just Galley +parseComponent "cargohold" = Just Cargohold parseComponent _ = Nothing componentName :: Component -> Text componentName Brig = "brig" componentName Galley = "galley" +componentName Cargohold = "cargohold" class KnownComponent (c :: Component) where componentVal :: Component @@ -44,3 +47,6 @@ instance KnownComponent 'Brig where instance KnownComponent 'Galley where componentVal = Galley + +instance KnownComponent 'Cargohold where + componentVal = Cargohold diff --git a/libs/wire-api-federation/wire-api-federation.cabal b/libs/wire-api-federation/wire-api-federation.cabal index 3de5fe24a0..a1592e461e 100644 --- a/libs/wire-api-federation/wire-api-federation.cabal +++ b/libs/wire-api-federation/wire-api-federation.cabal @@ -4,7 +4,7 @@ cabal-version: 1.12 -- -- see: https://github.com/sol/hpack -- --- hash: 8aa2d2b311b92915ab23a4fb07be411b474f2819936b62f46e15b64c31d027fe +-- hash: 621c254076cf520b525269ca4fc550df57f410aea52a288f6cb68bd2d6f1ada3 name: wire-api-federation version: 0.1.0 @@ -22,6 +22,7 @@ library exposed-modules: Wire.API.Federation.API Wire.API.Federation.API.Brig + Wire.API.Federation.API.Cargohold Wire.API.Federation.API.Common Wire.API.Federation.API.Galley Wire.API.Federation.Client diff --git a/services/cargohold/cargohold.cabal b/services/cargohold/cargohold.cabal index e3bb71aed7..dd689436f5 100644 --- a/services/cargohold/cargohold.cabal +++ b/services/cargohold/cargohold.cabal @@ -4,7 +4,7 @@ cabal-version: 1.12 -- -- see: https://github.com/sol/hpack -- --- hash: 7476868d5acce0bd802155cbab24a29a80fd5eec48f540dd3e6dcb492a47d683 +-- hash: 43240dbac626b3b23a6c7631367cc8c708e417b55fa7b007b4a58885878f8911 name: cargohold version: 1.5.0 @@ -27,6 +27,7 @@ library exposed-modules: CargoHold.API CargoHold.API.Error + CargoHold.API.Federation CargoHold.API.Legacy CargoHold.API.Public CargoHold.API.V3 @@ -82,6 +83,8 @@ library , resourcet >=1.1 , retry >=0.5 , safe >=0.3 + , servant + , servant-server , swagger >=0.2 , text >=1.1 , time >=1.4 @@ -97,6 +100,7 @@ library , wai-routing >=0.12 , wai-utilities >=0.16.1 , wire-api + , wire-api-federation , yaml >=0.8 default-language: Haskell2010 diff --git a/services/cargohold/package.yaml b/services/cargohold/package.yaml index 4d9cdc6070..c73d7934df 100644 --- a/services/cargohold/package.yaml +++ b/services/cargohold/package.yaml @@ -49,6 +49,8 @@ library: - optparse-applicative >=0.10 - retry >=0.5 - resourcet >=1.1 + - servant + - servant-server - swagger >=0.2 - time >=1.4 - tinylog >=0.10 @@ -63,6 +65,7 @@ library: - wai-routing >=0.12 - wai-utilities >=0.16.1 - wire-api + - wire-api-federation executables: cargohold-integration: main: Main.hs diff --git a/services/cargohold/src/CargoHold/API/Federation.hs b/services/cargohold/src/CargoHold/API/Federation.hs new file mode 100644 index 0000000000..e0ff94dc59 --- /dev/null +++ b/services/cargohold/src/CargoHold/API/Federation.hs @@ -0,0 +1,44 @@ +-- This file is part of the Wire Server implementation. +-- +-- Copyright (C) 2021 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 CargoHold.API.Federation + ( FederationAPI, + federationSitemap, + ) +where + +import CargoHold.App +import Control.Error +import Imports +import Servant.API +import Servant.API.Generic +import Servant.Server hiding (Handler) +import Servant.Server.Generic +import Wire.API.Federation.API +import qualified Wire.API.Federation.API.Cargohold as F +import Wire.API.Federation.API.Common +import Wire.API.Federation.Error + +type FederationAPI = "federation" :> ToServantApi (FedApi 'Cargohold) + +federationSitemap :: ServerT FederationAPI Handler +federationSitemap = + genericServerT $ + F.CargoholdApi {F.getAsset = getAsset} + +getAsset :: () -> Handler EmptyResponse +getAsset _ = throwE federationNotImplemented diff --git a/services/cargohold/src/CargoHold/App.hs b/services/cargohold/src/CargoHold/App.hs index fe8364b24d..79aa9dddfa 100644 --- a/services/cargohold/src/CargoHold/App.hs +++ b/services/cargohold/src/CargoHold/App.hs @@ -49,7 +49,8 @@ import Bilge.RPC (HasRequestId (..)) import qualified CargoHold.AWS as AWS import CargoHold.Options as Opt import Control.Error (ExceptT, exceptT) -import Control.Lens (makeLenses, set, view, (^.)) +import Control.Exception (throw) +import Control.Lens (makeLenses, view, (^.)) import Control.Monad.Catch (MonadCatch, MonadMask, MonadThrow) import Control.Monad.Trans.Resource (ResourceT, runResourceT, transResourceT) import Data.Default (def) @@ -58,10 +59,7 @@ import qualified Data.Metrics.Middleware as Metrics import Imports hiding (log) import Network.HTTP.Client (ManagerSettings (..), requestHeaders, responseTimeoutMicro) import Network.HTTP.Client.OpenSSL -import Network.Wai (Request, ResponseReceived) -import Network.Wai.Routing (Continue) -import Network.Wai.Utilities (Error (..), lookupRequestId) -import qualified Network.Wai.Utilities.Server as Server +import Network.Wai.Utilities (Error (..)) import OpenSSL.Session (SSLContext, SSLOption (..)) import qualified OpenSSL.Session as SSL import qualified OpenSSL.X509.SystemStore as SSL @@ -185,7 +183,5 @@ runAppResourceT e rma = liftIO . runResourceT $ transResourceT (runAppT e) rma type Handler = ExceptT Error App -runHandler :: Env -> Request -> Handler ResponseReceived -> Continue IO -> IO ResponseReceived -runHandler e r h k = - let e' = set requestId (maybe def RequestId (lookupRequestId r)) e - in runAppT e' (exceptT (Server.onError (_appLogger e) [Right $ _metrics e] r k) return h) +runHandler :: Env -> Handler a -> IO a +runHandler e h = runAppT e (exceptT throw pure h) diff --git a/services/cargohold/src/CargoHold/Run.hs b/services/cargohold/src/CargoHold/Run.hs index 150ba36b45..bf305eb2d0 100644 --- a/services/cargohold/src/CargoHold/Run.hs +++ b/services/cargohold/src/CargoHold/Run.hs @@ -21,24 +21,34 @@ module CargoHold.Run where import CargoHold.API (sitemap) +import CargoHold.API.Federation import CargoHold.App import CargoHold.Options -import Control.Lens ((^.)) +import Control.Lens (set, (^.)) import Control.Monad.Catch (finally) +import Data.Default +import Data.Id import Data.Metrics.Middleware.Prometheus (waiPrometheusMiddleware) +import Data.Proxy import Data.Text (unpack) import Imports import qualified Network.Wai as Wai import qualified Network.Wai.Middleware.Gzip as GZip +import Network.Wai.Utilities.Request import Network.Wai.Utilities.Server import qualified Network.Wai.Utilities.Server as Server +import Servant (hoistServer) +import qualified Servant +import Servant.API import Util.Options +type CombinedAPI = FederationAPI :<|> Servant.Raw + run :: Opts -> IO () run o = do e <- newEnv o s <- Server.newSettings (server e) - runSettingsWithShutdown s (middleware e $ serve e) 5 + runSettingsWithShutdown s (middleware e $ servantApp e) 5 `finally` closeEnv e where rtree = compile sitemap @@ -48,4 +58,15 @@ run o = do waiPrometheusMiddleware sitemap . GZip.gzip GZip.def . catchErrors (e ^. appLogger) [Right $ e ^. metrics] - serve e r k = runHandler e r (Server.route rtree r k) k + serve e r k = runHandler e (Server.route rtree r k) + servantApp e0 r = + let e = set requestId (maybe def RequestId (lookupRequestId r)) e0 + in Servant.serve + (Proxy @CombinedAPI) + ( hoistServer (Proxy @FederationAPI) (toServantHandler e) federationSitemap + :<|> Servant.Tagged (serve e) + ) + r + +toServantHandler :: Env -> Handler a -> Servant.Handler a +toServantHandler env = liftIO . runHandler env diff --git a/services/federator/federator.integration.yaml b/services/federator/federator.integration.yaml index 8559f53624..42e08d35c5 100644 --- a/services/federator/federator.integration.yaml +++ b/services/federator/federator.integration.yaml @@ -7,6 +7,9 @@ federatorExternal: brig: host: 0.0.0.0 port: 8082 +cargohold: + host: 0.0.0.0 + port: 8084 galley: host: 0.0.0.0 port: 8085 diff --git a/services/federator/src/Federator/Options.hs b/services/federator/src/Federator/Options.hs index 6df11978d8..4904cc4e58 100644 --- a/services/federator/src/Federator/Options.hs +++ b/services/federator/src/Federator/Options.hs @@ -83,6 +83,8 @@ data Opts = Opts brig :: Endpoint, -- | Host and port of galley galley :: Endpoint, + -- | Host and port of cargohold + cargohold :: Endpoint, -- | Log level (Debug, Info, etc) logLevel :: Level, -- | Use netstrings encoding (see ) diff --git a/services/federator/src/Federator/Run.hs b/services/federator/src/Federator/Run.hs index fafb629671..3e9312a460 100644 --- a/services/federator/src/Federator/Run.hs +++ b/services/federator/src/Federator/Run.hs @@ -97,6 +97,7 @@ newEnv o _dnsResolver = do let _runSettings = Opt.optSettings o let _service Brig = mkEndpoint (Opt.brig o) _service Galley = mkEndpoint (Opt.galley o) + _service Cargohold = mkEndpoint (Opt.cargohold o) _httpManager <- initHttpManager _tls <- mkTLSSettingsOrThrow _runSettings >>= newIORef return Env {..} diff --git a/services/federator/test/integration/Test/Federator/InwardSpec.hs b/services/federator/test/integration/Test/Federator/InwardSpec.hs index 6216db63f9..782a5a9554 100644 --- a/services/federator/test/integration/Test/Federator/InwardSpec.hs +++ b/services/federator/test/integration/Test/Federator/InwardSpec.hs @@ -72,6 +72,11 @@ spec env = Request +type CargoholdReq = Request -> Request + newtype TestFederator m a = TestFederator {unwrapTestFederator :: ReaderT TestEnv m a} deriving newtype ( Functor, @@ -88,6 +90,7 @@ data TestEnv = TestEnv { _teMgr :: Manager, _teTLSSettings :: TLSSettings, _teBrig :: BrigReq, + _teCargohold :: CargoholdReq, -- | federator config _teOpts :: Opts, -- | integration test config @@ -98,6 +101,7 @@ type Select = TestEnv -> (Request -> Request) data IntegrationConfig = IntegrationConfig { cfgBrig :: Endpoint, + cfgCargohold :: Endpoint, cfgFederatorExternal :: Endpoint, cfgNginxIngress :: Endpoint, cfgOriginDomain :: Text @@ -145,6 +149,7 @@ mkEnv _teTstOpts _teOpts = do let managerSettings = mkManagerSettings (Network.Connection.TLSSettingsSimple True False False) Nothing _teMgr :: Manager <- newManager managerSettings let _teBrig = endpointToReq (cfgBrig _teTstOpts) + _teCargohold = endpointToReq (cfgCargohold _teTstOpts) _teTLSSettings <- mkTLSSettingsOrThrow (optSettings _teOpts) pure TestEnv {..}