Move reverse proxy on separate port

gargantext.cabal

@@ -249,6 +249,7 @@ library
       Gargantext.Database.Schema.Node
       Gargantext.Database.Schema.User
       Gargantext.Defaults
+      Gargantext.MicroServices.ReverseProxy
       Gargantext.System.Logging
       Gargantext.Utils.Dict
       Gargantext.Utils.Jobs

src/Gargantext/API.hs

@@ -35,6 +35,7 @@ module Gargantext.API
       where
 
 import Control.Concurrent
+import Control.Concurrent.Async qualified as Async
 import Control.Lens hiding (Level)
 import Data.List (lookup)
 import Data.Text (pack)
@@ -46,12 +47,13 @@ import Gargantext.API.Admin.EnvTypes (Env, Mode(..))
 import Gargantext.API.Admin.Settings (newEnv)
 import Gargantext.API.Admin.Settings.CORS
 import Gargantext.API.Admin.Types (FireWall(..), PortNumber, cookieSettings, jwtSettings, settings, corsSettings)
-import Gargantext.API.Routes.Named.EKG
 import Gargantext.API.Middleware (logStdoutDevSanitised)
 import Gargantext.API.Routes.Named (API)
+import Gargantext.API.Routes.Named.EKG
 import Gargantext.API.Server.Named (server)
 import Gargantext.API.Server.Named.EKG
 import Gargantext.Database.Prelude qualified as DB
+import Gargantext.MicroServices.ReverseProxy (microServicesProxyApp)
 import Gargantext.Prelude hiding (putStrLn)
 import Gargantext.System.Logging
 import Network.HTTP.Types hiding (Query)
@@ -73,7 +75,11 @@ startGargantext mode port file = withLoggerHoisted mode $ \logger -> do
   app <- makeApp env
   mid <- makeGargMiddleware (env ^. settings.corsSettings) mode
   periodicActions <- schedulePeriodicActions env
-  run port (mid app) `finally` stopGargantext periodicActions
+
+  let runServer = run port (mid app) `finally` stopGargantext periodicActions
+  let runProxy  = run (port + 1) (microServicesProxyApp env)
+
+  Async.race_ runServer runProxy
 
   where runDbCheck env = do
           r <- runExceptT (runReaderT DB.dbCheck env) `catch`
@@ -92,6 +98,7 @@ portRouteInfo port = do
   putStrLn $ " - Web GarganText Frontend..................: " <> "http://localhost:" <> toUrlPiece port <> "/index.html"
   putStrLn $ " - Swagger UI (API documentation)...........: " <> "http://localhost:" <> toUrlPiece port <> "/swagger-ui"
   putStrLn $ " - Playground GraphQL (API documentation)...: " <> "http://localhost:" <> toUrlPiece port <> "/gql"
+  putStrLn $ " - Microservices proxy .....................: " <> "http://localhost:" <> toUrlPiece (port +1)
   putStrLn   "=========================================================================================================="
 
 -- | Stops the gargantext server and cancels all the periodic actions

src/Gargantext/API/Routes/Named/Private.hs

@@ -95,9 +95,6 @@ data GargPrivateAPI' mode = GargPrivateAPI'
   , listJsonAPI    :: mode :- NamedRoutes List.JSONAPI
   , listTsvAPI     :: mode :- NamedRoutes List.TSVAPI
   , shareUrlEp     :: mode :- "shareurl" :> NamedRoutes ShareURL
-
-  -- Proxies for microservices
-  , notesProxy     :: mode :- "notes-proxy" :> NamedRoutes NotesProxy
   } deriving Generic
 
 

src/Gargantext/API/Server/Named.hs

@@ -38,7 +38,7 @@ serverGargAPI env
             , gargForgotPasswordAPI      = forgotPassword
             , gargForgotPasswordAsyncAPI = forgotPasswordAsync
             , gargVersionAPI             = gargVersion
-            , gargPrivateAPI             = serverPrivateGargAPI env
+            , gargPrivateAPI             = serverPrivateGargAPI
             , gargPublicAPI              = serverPublicGargAPI (env ^. hasConfig . gc_url_backend_api)
             }
   where

src/Gargantext/API/Server/Named/Private.hs

 {-# OPTIONS_GHC -Wno-deprecations #-}
 module Gargantext.API.Server.Named.Private where
 
-import Conduit
-import Data.ByteString qualified as B
-import Data.ByteString.Builder
-import Data.ByteString.Char8 qualified as C8
-import Data.Conduit.List qualified as CC
-import Data.String
-import Data.Text qualified as T
-import Data.Text.Encoding qualified as TE
 import Gargantext.API.Admin.Auth.Types (AuthenticatedUser(..))
-import Gargantext.API.Admin.EnvTypes (Env, env_manager)
+import Gargantext.API.Admin.EnvTypes (Env)
 import Gargantext.API.Context
 import Gargantext.API.Count qualified as Count
 import Gargantext.API.Errors.Types
@@ -30,15 +22,7 @@ import Gargantext.API.Server.Named.Ngrams
 import Gargantext.API.Server.Named.Viz qualified as Viz
 import Gargantext.Core.Types.Individu (User(..))
 import Gargantext.Database.Admin.Types.Hyperdata
-import Gargantext.Database.Prelude (hasConfig)
 import Gargantext.Prelude
-import Gargantext.Prelude.Config (gc_frame_write_url)
-import Network.HTTP.ReverseProxy
-import Network.HTTP.Types (hCacheControl, RequestHeaders, Header, HeaderName)
-import Network.HTTP.Types.Header (hHost)
-import Network.URI as URI
-import Network.Wai (Request, rawPathInfo, requestHeaders)
-import Servant hiding (Header)
 import Servant.Auth.Swagger ()
 import Servant.Server.Generic (AsServerT)
 
@@ -55,8 +39,8 @@ serverGargAdminAPI = Named.GargAdminAPI
 
 
 serverPrivateGargAPI'
-  :: Env -> AuthenticatedUser -> Named.GargPrivateAPI' (AsServerT (GargM Env BackendInternalError))
-serverPrivateGargAPI' env authenticatedUser@(AuthenticatedUser userNodeId userId)
+  :: AuthenticatedUser -> Named.GargPrivateAPI' (AsServerT (GargM Env BackendInternalError))
+serverPrivateGargAPI' authenticatedUser@(AuthenticatedUser userNodeId userId)
        =  Named.GargPrivateAPI'
        { gargAdminAPI      = serverGargAdminAPI
        , nodeEp            = nodeAPI authenticatedUser
@@ -80,78 +64,4 @@ serverPrivateGargAPI' env authenticatedUser@(AuthenticatedUser userNodeId userId
        , listJsonAPI       = List.jsonAPI
        , listTsvAPI        = List.tsvAPI
        , shareUrlEp        = shareURL
-       , notesProxy        = notesProxyImplementation env
        }
-
-notesProxyImplementation :: Env -> Named.NotesProxy (AsServerT (GargM Env BackendInternalError))
-notesProxyImplementation env = Named.NotesProxy $ \_frameId -> forwardServer env
-
-forwardServer :: Env -> ServerT Raw m
-forwardServer env =
-  Tagged $ waiProxyToSettings forwardRequest proxySettings (env ^. env_manager)
-  where
-    writeFrameURL :: T.Text
-    writeFrameURL = env ^. hasConfig . gc_frame_write_url
-
-    assetPath :: T.Text
-    assetPath
-      | snd forwardedHost /= 80
-      = writeFrameURL <> ":" <> T.pack (show $ snd forwardedHost)
-      | otherwise
-      = writeFrameURL
-
-    removeProxyPath :: ByteString -> ByteString
-    removeProxyPath = TE.encodeUtf8
-                    . T.replace "/api/v1.0/notes-proxy" ""
-                    . TE.decodeUtf8
-
-    proxySettings :: WaiProxySettings
-    proxySettings = defaultWaiProxySettings { wpsLogRequest = \req -> traceShow req $ pure ()
-                                            , wpsProcessBody =
-                                                \_req _res -> Just replaceRelativeLinks
-                                            }
-
-    replaceRelativeLinks :: ConduitT B.ByteString (Flush Builder) IO ()
-    replaceRelativeLinks = CC.map flushReplace
-      where
-        -- FIXME(adn) performance.
-        flushReplace :: B.ByteString -> Flush Builder
-        flushReplace bs = Chunk $ byteString $ traceShowId $ TE.encodeUtf8 . replaceIt . TE.decodeUtf8 $ bs
-
-        replaceIt :: T.Text -> T.Text
-        replaceIt t = t & T.replace "src=\"/build/" ("src=\"" <> assetPath <> "/build/")
-                        & T.replace "href=\"/build/" ("href=\"" <> assetPath <> "/build/")
-                        & T.replace "src=\"/config" ("src=\"" <> assetPath <> "/config")
-                        & T.replace "src=\"/js" ("src=\"" <> assetPath <> "/js")
-
-    noCache :: RequestHeaders -> RequestHeaders
-    noCache hdrs = (hCacheControl, fromString "no-cache") :
-      filter ((/=) hCacheControl . fst) hdrs
-
-    newHost :: RequestHeaders -> RequestHeaders
-    newHost hdrs =
-      (hHost, fromString $ fst forwardedHost <> ":" <> show (snd forwardedHost)) :
-      filter ((/=) hHost . fst) hdrs
-
-    forwardedHost :: (String, Int)
-    forwardedHost = fromMaybe (panicTrace "Invalid URI found in the proxied Request.") $ do
-      URI{..} <- URI.parseURI (T.unpack writeFrameURL)
-      uriAut  <- uriAuthority
-      port    <- case uriPort uriAut of
-        "" -> pure 80
-        xs -> readMaybe (dropWhile (==':') xs)
-      pure $ (uriRegName uriAut, port)
-
-    mkProxyDest :: ProxyDest
-    mkProxyDest =
-      let (hst, prt) = forwardedHost
-      in ProxyDest (C8.pack hst) prt
-
-    -- | Forwards the request by substituting back the proxied address into the actual one.
-    forwardRequest :: Request -> IO WaiProxyResponse
-    forwardRequest originalRequest = do
-      let proxiedReq = originalRequest {
-                           rawPathInfo = removeProxyPath (rawPathInfo originalRequest)
-                         , requestHeaders = (newHost $ noCache $ (requestHeaders originalRequest))
-                         }
-      pure $ WPRModifiedRequest (traceShowId proxiedReq) $ traceShowId $ mkProxyDest

src/Gargantext/API/ThrowAll.hs

@@ -49,11 +49,11 @@ throwAll' errCode server =
     f :: forall a. m a -> m a
     f = const (throwError errCode)
 
-serverPrivateGargAPI :: Env -> Named.GargPrivateAPI (AsServerT (GargM Env BackendInternalError))
-serverPrivateGargAPI env = Named.GargPrivateAPI $ \case
-  (Authenticated auser) -> Named.serverPrivateGargAPI' env auser
+serverPrivateGargAPI :: Named.GargPrivateAPI (AsServerT (GargM Env BackendInternalError))
+serverPrivateGargAPI = Named.GargPrivateAPI $ \case
+  (Authenticated auser) -> Named.serverPrivateGargAPI' auser
   -- In the code below we just needed a mock 'AuthenticatedUser' to make the type check, but
   -- they will never be evaluated.
   _                     -> throwAll' (_ServerError # err401)
-                             $ Named.serverPrivateGargAPI' env (AuthenticatedUser 0 (UnsafeMkUserId 0))
+                             $ Named.serverPrivateGargAPI' (AuthenticatedUser 0 (UnsafeMkUserId 0))
 -- Here throwAll' requires a concrete type for the monad.

src/Gargantext/Database/Action/Node.hs

@@ -94,7 +94,7 @@ mkNodeWithParent_ConfigureHyperdata NodeFrameNotebook (Just i) uId name = (:[])
 mkNodeWithParent_ConfigureHyperdata    _ _ _ _ = nodeError NotImplYet
 
 internalNotesProxy :: GargConfig -> T.Text
-internalNotesProxy cfg = _gc_url_backend_api cfg <> "/notes-proxy"
+internalNotesProxy cfg = "http://localhost:8009/notes-proxy"
 
 -- | Function not exposed
 mkNodeWithParent_ConfigureHyperdata' :: (HasNodeError err, HasDBid NodeType)

src/Gargantext/MicroServices/ReverseProxy.hs

+{-# LANGUAGE TypeOperators #-}
+{-# LANGUAGE DeriveGeneric #-}
+{-# OPTIONS_GHC -Wno-deprecations #-}
+
+module Gargantext.MicroServices.ReverseProxy (
+  microServicesProxyApp
+  ) where
+
+import Prelude
+
+import Conduit
+import Data.ByteString qualified as B
+import Data.ByteString.Builder
+import Data.ByteString.Char8 qualified as C8
+import Data.Conduit.List qualified as CC
+import Data.String
+import Data.Text qualified as T
+import Data.Text.Encoding qualified as TE
+import GHC.Generics
+import Gargantext.API.Admin.EnvTypes
+import Gargantext.Database.Prelude (hasConfig)
+import Gargantext.Prelude
+import Gargantext.Prelude.Config (gc_frame_write_url)
+import Network.HTTP.ReverseProxy
+import Network.HTTP.Types (hCacheControl, RequestHeaders, hReferer)
+import Network.HTTP.Types.Header (hHost)
+import Network.URI as URI
+import Network.Wai (Request, rawPathInfo, requestHeaders)
+import Servant
+import Servant.Auth.Swagger ()
+import Servant.Server.Generic
+
+--
+-- Types
+--
+
+data ReverseProxyAPI mode = ReverseProxyAPI
+  { notesProxy    :: mode :- "notes-proxy" :> NamedRoutes NotesProxy
+  , notesSocketIo :: mode :- "socket.io"   :> NamedRoutes SocketIOProxy
+  , meEndpoint    :: mode :- "me"          :> Raw
+  } deriving Generic
+
+data NotesProxy mode = NotesProxy
+  { noteProxyEp :: mode :- Capture "frameId" T.Text
+                        :> Raw
+  } deriving Generic
+
+data SocketIOProxy mode = SocketIOProxy
+  { socketIoEp  :: mode :- QueryParam "noteId" T.Text :> Raw
+  } deriving Generic
+
+--
+-- Server
+--
+
+microServicesProxyApp :: Env -> Application
+microServicesProxyApp env = genericServe (server env)
+
+server :: Env -> ReverseProxyAPI AsServer
+server env = ReverseProxyAPI {
+    notesProxy    = notesProxyImplementation env
+  , notesSocketIo = socketIOProxyImplementation env
+  , meEndpoint    = forwardServer env
+  }
+
+notesProxyImplementation :: Env -> NotesProxy AsServer
+notesProxyImplementation env = NotesProxy {
+    noteProxyEp = \_frameId -> forwardServer env
+  }
+
+socketIOProxyImplementation :: Env -> SocketIOProxy AsServer
+socketIOProxyImplementation env = SocketIOProxy {
+    socketIoEp = \_noteId -> forwardServer env
+  }
+
+forwardServer :: Env -> ServerT Raw m
+forwardServer env =
+  Tagged $ waiProxyToSettings forwardRequest proxySettings (env ^. env_manager)
+  where
+    writeFrameURL :: T.Text
+    writeFrameURL = env ^. hasConfig . gc_frame_write_url
+
+    assetPath :: T.Text
+    assetPath
+      | snd forwardedHost /= 80
+      = writeFrameURL <> ":" <> T.pack (Prelude.show $ snd forwardedHost)
+      | otherwise
+      = writeFrameURL
+
+    removeProxyPath :: ByteString -> ByteString
+    removeProxyPath = TE.encodeUtf8
+                    . T.replace "/notes-proxy" ""
+                    . TE.decodeUtf8
+
+    proxySettings :: WaiProxySettings
+    proxySettings = defaultWaiProxySettings { wpsLogRequest = \req -> traceShow req $ pure ()
+                                            , wpsProcessBody =
+                                                \_req _res -> Just replaceRelativeLinks
+                                            }
+
+    replaceRelativeLinks :: ConduitT B.ByteString (Flush Builder) IO ()
+    replaceRelativeLinks = CC.map flushReplace
+      where
+        -- FIXME(adn) performance.
+        flushReplace :: B.ByteString -> Flush Builder
+        flushReplace bs = Chunk $ byteString $ traceShowId $ TE.encodeUtf8 . replaceIt . TE.decodeUtf8 $ bs
+
+        replaceIt :: T.Text -> T.Text
+        replaceIt t = t & T.replace "src=\"/build/" ("src=\"" <> assetPath <> "/build/")
+                        & T.replace "href=\"/build/" ("href=\"" <> assetPath <> "/build/")
+                        & T.replace "src=\"/config" ("src=\"" <> assetPath <> "/config")
+                        & T.replace "src=\"/js" ("src=\"" <> assetPath <> "/js")
+
+    noCache :: RequestHeaders -> RequestHeaders
+    noCache hdrs = (hCacheControl, fromString "no-cache") :
+      filter ((/=) hCacheControl . fst) hdrs
+
+    newHost :: RequestHeaders -> RequestHeaders
+    newHost hdrs =
+      (hHost, fromString $ fst forwardedHost <> ":" <> Prelude.show (snd forwardedHost)) :
+      filter ((/=) hHost . fst) hdrs
+
+    newReferer :: RequestHeaders -> RequestHeaders
+    newReferer hdrs =
+      (hReferer, "http://localhost:8009") :
+      filter ((/=) hHost . fst) hdrs
+
+    forwardedHost :: (String, Int)
+    forwardedHost = fromMaybe (panicTrace "Invalid URI found in the proxied Request.") $ do
+      URI{..} <- URI.parseURI (T.unpack writeFrameURL)
+      uriAut  <- uriAuthority
+      port    <- case uriPort uriAut of
+        "" -> pure 80
+        xs -> readMaybe (dropWhile (==':') xs)
+      pure $ (uriRegName uriAut, port)
+
+    mkProxyDest :: ProxyDest
+    mkProxyDest =
+      let (hst, prt) = forwardedHost
+      in ProxyDest (C8.pack hst) prt
+
+    -- | Forwards the request by substituting back the proxied address into the actual one.
+    forwardRequest :: Request -> IO WaiProxyResponse
+    forwardRequest originalRequest = do
+      let proxiedReq = originalRequest {
+                           rawPathInfo = removeProxyPath (rawPathInfo originalRequest)
+                         , requestHeaders = (newReferer . newHost . noCache $ (requestHeaders originalRequest))
+                         }
+      pure $ traceShow ("I'm PROXYING ===> " <> (Prelude.show originalRequest)) $ WPRModifiedRequest (traceShowId proxiedReq) $ traceShowId $ mkProxyDest