Serve a custom /config to correctly setup websocket for proxies

This commit extends the reverse proxy for the microservices so that it
would serve a custom `/config` file which would contain the correct
baseUrl to initialise the websocket connection correctly.

bin/update-project-dependencies

@@ -18,8 +18,8 @@ fi
 # with the `sha256sum` result calculated on the `cabal.project` and
 # `cabal.project.freeze`. This ensures the files stay deterministic so that CI
 # cache can kick in.
-expected_cabal_project_hash="a05d90186f5c5d90cb6e806ffc38379af89a52d4289dd70def9e48ed8315fdd6"
-expected_cabal_project_freeze_hash="3c64f68973846df84c31708abefcc95119eef58317a569d9a5940821b27b9d66"
+expected_cabal_project_hash="22167800d98d4f204c85c49420eaee0618e749062b9ae9709719638e54319ae9"
+expected_cabal_project_freeze_hash="7bb3ba71d0a1881a5c4fd420b9988155586e0cf51e9b6d55867bce3d311d59a5"
 
 cabal --store-dir=$STORE_DIR v2-build --dry-run
 cabal2stack --system-ghc --allow-newer --resolver lts-21.17 --resolver-file devops/stack/lts-21.17.yaml -o stack.yaml

cabal.project

@@ -169,7 +169,7 @@ source-repository-package
 source-repository-package
     type: git
     location: https://github.com/adinapoli/http-reverse-proxy.git
-    tag: e746dfbe557ce131af1090e1c413fee16675c8e0
+    tag: c90b7bc55b0e628d0b71ccee4e222833a19792f8
 
 allow-older: *
 allow-newer: *

cabal.project.freeze

@@ -283,7 +283,7 @@ constraints: any.Cabal ==3.8.1.0,
              http-conduit +aeson,
              any.http-date ==0.0.11,
              any.http-media ==0.8.1.1,
-             any.http-reverse-proxy ==0.6.0.3,
+             any.http-reverse-proxy ==0.6.1.0,
              any.http-types ==0.12.3,
              any.http2 ==4.1.4,
              http2 -devel -h2spec,

gargantext-settings.toml

@@ -15,6 +15,7 @@ allowed-origins = [
   , "https://msh.sub.gargantext.org"
   , "https://dev.sub.gargantext.org"
   , "http://localhost:8008"
+  , "http://localhost:8009"
   ]
 
 use-origins-for-hosts = true

gargantext.cabal

@@ -564,7 +564,7 @@ library
     , http-conduit ^>= 2.3.8
     , http-media ^>= 0.8.0.0
     , http-types ^>= 0.12.3
-    , http-reverse-proxy
+    , http-reverse-proxy >= 0.6.1.0
     , hxt ^>= 9.3.1.22
     , ihaskell >= 0.11.0.0
     -- necessary for ihaskell to build
@@ -617,6 +617,7 @@ library
     , quickcheck-instances ^>= 0.3.25.2
     , rake ^>= 0.0.1
     , random ^>= 1.2.1
+    , raw-strings-qq
     , rdf4h ^>= 3.1.1
     , recover-rtti >= 0.4 && < 0.5
     , regex

src/Gargantext/Database/Action/Node.hs

@@ -97,7 +97,7 @@ mkNodeWithParent_ConfigureHyperdata    _ _ _ _ = nodeError NotImplYet
 
 internalNotesProxy :: MicroServicesSettings -> T.Text
 internalNotesProxy MicroServicesSettings{..} =
-  "http://localhost:" <> T.pack (show _msProxyPort)
+  "http://localhost:" <> T.pack (show _msProxyPort) <> "/notes"
 
 -- | Function not exposed
 mkNodeWithParent_ConfigureHyperdata' :: (HasNodeError err, HasDBid NodeType, HasSettings env)

src/Gargantext/MicroServices/ReverseProxy.hs

-{-# LANGUAGE TypeOperators #-}
 {-# LANGUAGE DeriveGeneric      #-}
+{-# LANGUAGE NumericUnderscores #-}
 {-# LANGUAGE QuasiQuotes        #-}
+{-# LANGUAGE TemplateHaskell    #-}
+{-# LANGUAGE TypeOperators      #-}
 
 module Gargantext.MicroServices.ReverseProxy (
   microServicesProxyApp
+
+  -- * Internals
+  , removeFromReferer
   ) where
 
 import Prelude
@@ -20,52 +25,98 @@ import GHC.Generics
 import Gargantext.API.Admin.EnvTypes
 import Gargantext.API.Admin.Settings.MicroServices
 import Gargantext.API.Admin.Types
+import Gargantext.API.Types (HTML)
 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, ResponseHeaders)
+import Network.HTTP.Types (hCacheControl, RequestHeaders, hReferer, ResponseHeaders, Header)
 import Network.HTTP.Types.Header (hHost)
-import Network.URI as URI
 import Network.Wai (Request, rawPathInfo, requestHeaders)
-import Servant
+import Servant hiding (Header)
 import Servant.Auth.Swagger ()
+import Servant.Client.Core.BaseUrl
 import Servant.Server.Generic
-import Text.RE.TDFA.ByteString
 import Text.RE.Replace hiding (Capture)
+import Text.RE.TDFA.ByteString
+import Text.RawString.QQ (r)
 
 --
 -- Types
 --
 
-data ProxyDestination =
-  ProxyDestination
-    { fwdProto :: C8.ByteString
-    , fwdHost  :: C8.ByteString
-    , fwdPort  :: PortNumber
-    }
+newtype FrameId = FrameId { _FrameId :: T.Text }
+  deriving (Show, Eq, Ord)
+
+-- | The service type that our microservices proxy will handle. At the moment
+-- we support only the \"notes\" one.
+data ServiceType
+  = ST_notes
+  deriving Generic
+
+-- | Renders a 'ServiceType' into a string.
+renderServiceType :: ServiceType -> String
+renderServiceType ST_notes = "notes"
+
+serviceTypeToProxyPath :: ServiceType -> String
+serviceTypeToProxyPath ST_notes = "/notes"
+
+instance FromHttpApiData ServiceType where
+  parseUrlPiece "notes" = Right ST_notes
+  parseUrlPiece x       = Left x
 
-renderProxyDestination :: ProxyDestination -> C8.ByteString
-renderProxyDestination ProxyDestination{..}
-  = fwdProto <> "//" <> fwdHost <> ":" <> C8.pack (Prelude.show fwdPort)
+instance FromHttpApiData FrameId where
+  parseUrlPiece txt
+    | T.all isHexDigit txt = Right (FrameId txt)
+    | otherwise            = Left "Invalid FrameId: must be a hexadecimal string"
+
+newtype ProxyDestination =
+  ProxyDestination { _ProxyDestination :: BaseUrl }
+
+fwdHost :: ProxyDestination -> C8.ByteString
+fwdHost = C8.pack . baseUrlHost . _ProxyDestination
+
+fwdPort :: ProxyDestination -> Int
+fwdPort = baseUrlPort . _ProxyDestination
 
 --
 -- The API
 --
 
 data ReverseProxyAPI mode = ReverseProxyAPI
-  { notesProxy    :: mode :- NamedRoutes NotesProxy
-  , notesSocketIo :: mode :- "socket.io"   :> NamedRoutes SocketIOProxy
-  , meEndpoint    :: mode :- "me"          :> Raw
+  { -- | The proxy routes for the \"notes\" microservice (e.g. \"write.frame.gargantext.org\").
+    notesServiceProxy :: mode :- "notes" :> NamedRoutes NotesProxy
+
+   -- | proxy everything else. CAREFUL! This has to be the last route, as it will always match.
+  , proxyPassAll      :: mode :- Raw
   } deriving Generic
 
 data NotesProxy mode = NotesProxy
-  { noteProxyEp :: mode :- Capture "frameId" T.Text :> Raw
-  , slideEp     :: mode :- Capture "frameId" T.Text :> "slide" :> Raw
+  { -- | Turn the notes into slides
+    slideEp     :: mode :- Capture "frameId" FrameId :> "slide" :> Raw
+
+  , publishEp   :: mode :- Capture "frameId" FrameId :> "publish" :> Raw
+
+  -- | The config file which contains the server settings for the websocket connection
+  -- that we have to overwrite with our settings.
+  , configFile    :: mode :- "config"    :> Get '[HTML] T.Text
+
+  -- | Once the connection has been established, this is the websocket endpoint to
+  -- poll edits.
+  , notesSocket :: mode :- "socket.io" :> NamedRoutes SocketIOProxy
+
+  -- | Called during the websocket connection
+  , meEndpoint  :: mode :- "me"        :> Raw
+
+  -- | The initial endpoint which will be hit the first time we want to access the /notes endpoint.
+  , notesEp     :: mode :- Capture "frameId" FrameId :> Raw
+
+  -- | The generic routes serving the assets.
+  , notesStaticAssets :: mode :- Raw
   } deriving Generic
 
 data SocketIOProxy mode = SocketIOProxy
-  { socketIoEp  :: mode :- QueryParam "noteId" T.Text :> Raw
+  { socketIoEp  :: mode :- QueryParam' '[Required] "noteId" FrameId :> Raw
   } deriving Generic
 
 --
@@ -77,92 +128,139 @@ microServicesProxyApp env = genericServe (server env)
 
 server :: Env -> ReverseProxyAPI AsServer
 server env = ReverseProxyAPI {
-    notesProxy    = notesProxyImplementation env
-  , notesSocketIo = socketIOProxyImplementation env
-  , meEndpoint    = proxyPassServer env
+    notesServiceProxy = notesProxyImplementation env
+  , proxyPassAll      = proxyPassServer ST_notes env
   }
 
+-- | A customised configuration file that the \"notes\" service would otherwise send us, that
+-- overrides the 'urlpath' to contain the proper service path, so that the websocket connection
+-- can be started correctly. If we do not override the 'urlpath', due to the way things work
+-- internally, the Javascript of CodiMD would otherwise take the first slice of the URL path
+-- (something like `/notes/<frameId>`) and use /that/ as the <frameId>, which would be wrong
+-- as it would try to establish a connection to `noteId=notes`.
+configJS :: ServiceType -> T.Text
+configJS st = T.pack $ [r|
+window.domain  = ''
+window.urlpath = '|] <> renderServiceType st <> [r|'
+window.debug   = false
+window.version = '1.2.0'
+
+window.allowedUploadMimeTypes = ["image/jpeg","image/png","image/jpg","image/gif","image/svg+xml"]
+
+window.DROPBOX_APP_KEY = ''
+|]
+
 notesProxyImplementation :: Env -> NotesProxy AsServer
 notesProxyImplementation env = NotesProxy {
-    noteProxyEp = \_frameId -> notesProxyServer env
-  , slideEp     = \frameId  -> slideProxyServer env frameId
+    slideEp     = \frameId  -> slideProxyServer env frameId
+  , publishEp   = \frameId  -> publishProxyServer env frameId
+  , configFile  = pure $ configJS sty
+  , notesSocket = socketIOProxyImplementation sty env
+  , meEndpoint  = proxyPassServer sty env
+  , notesEp     = \_frameId  -> defaultForwardServer sty id env
+  , notesStaticAssets = proxyPassServer sty env
   }
+  where
+    sty :: ServiceType
+    sty = ST_notes
 
-socketIOProxyImplementation :: Env -> SocketIOProxy AsServer
-socketIOProxyImplementation env = SocketIOProxy {
-    socketIoEp = \_noteId -> proxyPassServer env
+socketIOProxyImplementation :: ServiceType -> Env -> SocketIOProxy AsServer
+socketIOProxyImplementation sty env = SocketIOProxy {
+    socketIoEp = \_noteId -> defaultForwardServer sty id env
   }
 
-notesProxyServer :: Env -> ServerT Raw m
-notesProxyServer env = defaultForwardServer id env
+removeServiceFromPath :: ServiceType -> Request -> Request
+removeServiceFromPath sty = removeProxyPath (T.pack $ serviceTypeToProxyPath sty)
+  where
+    removeProxyPath :: T.Text -> Request -> Request
+    removeProxyPath pth originalRequest =
+      originalRequest { rawPathInfo = removePath pth (rawPathInfo originalRequest) }
 
-slideProxyServer :: Env -> T.Text -> ServerT Raw m
-slideProxyServer env frameId =
-  defaultForwardServer (\rq -> rq { rawPathInfo = changePath (rawPathInfo rq) }) env
+slideProxyServer :: Env -> FrameId -> ServerT Raw m
+slideProxyServer env (FrameId frameId) =
+  defaultForwardServer ST_notes (\rq -> rq { rawPathInfo = changePath (rawPathInfo rq) }) env
   where
     changePath :: ByteString -> ByteString
     changePath _ = TE.encodeUtf8 $ "/p/" <> frameId <> "#/"
 
--- Generic server forwarder
-proxyPassServer :: Env -> ServerT Raw m
-proxyPassServer env = defaultForwardServer id env
+publishProxyServer :: Env -> FrameId -> ServerT Raw m
+publishProxyServer env (FrameId frameId) =
+  defaultForwardServer ST_notes (\rq -> rq { rawPathInfo = changePath (rawPathInfo rq) }) env
+  where
+    changePath :: ByteString -> ByteString
+    changePath _ = TE.encodeUtf8 $ "/s/" <> frameId
 
+-- Generic server forwarder
+proxyPassServer :: ServiceType -> Env -> ServerT Raw m
+proxyPassServer sty env = defaultForwardServer sty id env
 
 mkProxyDestination :: Env -> ProxyDestination
 mkProxyDestination env = fromMaybe (panicTrace "Invalid URI found in the proxied Request.") $ do
-  URI{..} <- URI.parseURI (T.unpack $ env ^. hasConfig . gc_frame_write_url)
-  uriAut  <- uriAuthority
-  port    <- case uriPort uriAut of
-    "" -> pure 80
-    xs -> readMaybe (dropWhile (==':') xs)
-  pure $ ProxyDestination (C8.pack uriScheme) (C8.pack $ uriRegName uriAut) port
+  baseUrl <- parseBaseUrl (T.unpack $ env ^. hasConfig . gc_frame_write_url)
+  pure $ ProxyDestination baseUrl
 
 --
 -- Combinators over the input Request
 --
 
-removeProxyPath :: T.Text -> Request -> Request
-removeProxyPath pth originalRequest =
-  originalRequest { rawPathInfo = removePath (rawPathInfo originalRequest) }
+removeFromReferer :: T.Text -> Request -> Request
+removeFromReferer pth originalRequest =
+  originalRequest { requestHeaders = (Prelude.map tweakReferer (requestHeaders originalRequest))
+  }
   where
-    removePath :: ByteString -> ByteString
-    removePath = TE.encodeUtf8 . T.replace pth "" . TE.decodeUtf8
-
+    tweakReferer :: Header -> Header
+    tweakReferer (k,v)
+      | k == hReferer
+      = (hReferer, removePath pth v)
+      | otherwise
+      = (k,v)
 
-defaultForwardServer :: (Request -> Request) -> Env -> ServerT Raw m
-defaultForwardServer presendModifyRequest env =
-  Tagged $ waiProxyToSettings forwardRequest (proxySettings $ mkProxyDestination env) (env ^. env_manager)
+defaultForwardServer :: ServiceType
+                     -> (Request -> Request)
+                     -> Env
+                     -> ServerT Raw m
+defaultForwardServer sty presendModifyRequest env =
+  Tagged $ waiProxyToSettings forwardRequest (proxySettings) (env ^. env_manager)
   where
 
     proxyDestination :: ProxyDestination
     proxyDestination = mkProxyDestination env
 
+    proxyUrl :: BaseUrl
+    proxyUrl = fromMaybe (panicTrace "Couldn't parse proxy settings") $ do
+      url <- parseBaseUrl ("http://localhost:" <> Prelude.show proxyListeningPort) -- FIXME(adn)
+      pure url
+
+    proxyUrlStr :: String
+    proxyUrlStr = showBaseUrl proxyUrl
+
     microSrvSettings :: MicroServicesSettings
     microSrvSettings = env ^. env_settings . microservicesSettings
 
     proxyListeningPort :: Int
     proxyListeningPort = microSrvSettings ^. msProxyPort
 
-    proxySettings :: ProxyDestination -> WaiProxySettings
-    proxySettings proxyDestination =
+    proxySettings :: WaiProxySettings
+    proxySettings =
       defaultWaiProxySettings {
-          wpsProcessBody = \_req _res -> Just $ replaceRelativeLinks ("http://localhost:8009")
+          wpsProcessBody = \_req _res -> Just $ replaceRelativeLinks (C8.pack $ proxyUrlStr <> serviceTypeToProxyPath sty)
         , wpsModifyResponseHeaders = \_req _res -> tweakResponseHeaders
+        , wpsRedirectCounts = 2
         }
 
-    newHost :: ProxyDestination -> RequestHeaders -> RequestHeaders
-    newHost hst hdrs = (hHost, renderProxyDestination hst) : filter ((/=) hHost . fst) hdrs
+    setHost :: ProxyDestination -> RequestHeaders -> RequestHeaders
+    setHost hst hdrs = (hHost, fwdHost hst) : filter ((/=) hHost . fst) hdrs
 
-    newReferer :: RequestHeaders -> RequestHeaders
-    newReferer hdrs =
-      (hReferer, fromString $ "http://localhost:" <> Prelude.show proxyListeningPort) :
-      filter ((/=) hHost . fst) hdrs
+    setReferer :: RequestHeaders -> RequestHeaders
+    setReferer hdrs =
+        let hd = (hReferer, C8.pack (proxyUrlStr <> serviceTypeToProxyPath sty))
+        in hd : filter ((/=) hReferer . fst) hdrs
 
     -- | Forwards the request by substituting back the proxied address into the actual one.
     forwardRequest :: Request -> IO WaiProxyResponse
     forwardRequest originalRequest = do
-      let proxiedReq = presendModifyRequest $ originalRequest {
-                         requestHeaders = (newReferer . newHost proxyDestination . noCache $ (requestHeaders originalRequest))
+      let proxiedReq = presendModifyRequest . removeServiceFromPath sty $ originalRequest {
+                         requestHeaders = (setReferer $ setHost proxyDestination $ noCache $ (requestHeaders originalRequest))
                          }
       pure $ WPRModifiedRequest proxiedReq (ProxyDest (fwdHost proxyDestination) (fwdPort proxyDestination))
 
@@ -202,3 +300,6 @@ replaceRelativeLinks assetPath = CC.map flushReplace
           "src=\"/config"  -> Just $ "src=\"" <> assetPath <> "/config"
           "src=\"/js/"     -> Just $ "src=\"" <> assetPath <> "/js/"
           _                -> Just $ assetPath <> capturedText cap
+
+removePath :: T.Text -> ByteString -> ByteString
+removePath pth = TE.encodeUtf8 . T.replace pth "" . TE.decodeUtf8

stack.yaml

@@ -62,7 +62,7 @@
   git: "https://github.com/MercuryTechnologies/ekg-json.git"
   subdirs:
   - .
-- commit: e746dfbe557ce131af1090e1c413fee16675c8e0
+- commit: c90b7bc55b0e628d0b71ccee4e222833a19792f8
   git: "https://github.com/adinapoli/http-reverse-proxy.git"
   subdirs:
   - .