Add federation component for Cargohold

changelog.d/6-federation/add-cargohold-component

@@ -0,0 +1 @@
+Add cargohold as a new federated component

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:

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

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

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 <opensource@wire.com>
+--
+-- 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 <https://www.gnu.org/licenses/>.
+
+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)

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

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

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
 

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

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 <opensource@wire.com>
+--
+-- 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 <https://www.gnu.org/licenses/>.
+
+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

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)

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

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

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 <http://cr.yp.to/proto/netstrings.txt>)

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 {..}

services/federator/test/integration/Test/Federator/InwardSpec.hs

@@ -72,6 +72,11 @@ spec env =
             <!! const 200 === statusCode
         liftIO $ bdy `shouldBe` expectedProfile
 
+    it "should be able to call cargohold" $
+      runTestFederator env $ do
+        inwardCall "/federation/cargohold/get-asset" (encode ())
+          !!! const 403 === statusCode
+
     it "should return 404 'no-endpoint' response from Brig" $
       runTestFederator env $ do
         err <-

services/federator/test/integration/Test/Federator/Util.hs

@@ -58,6 +58,8 @@ import Wire.API.User.Auth
 
 type BrigReq = Request -> 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 {..}