Hook CORS and middleware

gargantext-settings.toml

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

src/Gargantext/API.hs

@@ -79,7 +79,7 @@ startGargantext mode port file = withLoggerHoisted mode $ \logger -> do
   periodicActions <- schedulePeriodicActions env
 
   let runServer = run port (mid app) `finally` stopGargantext periodicActions
-  let runProxy  = run proxyPort (microServicesProxyApp env)
+  let runProxy  = run proxyPort (mid (microServicesProxyApp env))
 
   Async.race_ runServer runProxy
 

src/Gargantext/API/Admin/Settings/MicroServices.hs

@@ -4,8 +4,11 @@ module Gargantext.API.Admin.Settings.MicroServices where
 
 import Prelude
 
-import Toml
 import Control.Lens.TH
+import Data.Text qualified as T
+import Gargantext.Prelude.Config
+import Servant.Client.Core.BaseUrl
+import Toml
 
 data MicroServicesSettings =
   MicroServicesSettings {
@@ -17,4 +20,11 @@ microServicesSettingsCodec :: TomlCodec MicroServicesSettings
 microServicesSettingsCodec = MicroServicesSettings
   <$> Toml.int "proxy-port" .= _msProxyPort
 
+mkProxyUrl :: GargConfig -> MicroServicesSettings -> BaseUrl
+mkProxyUrl GargConfig{..} MicroServicesSettings{..} =
+  case parseBaseUrl (T.unpack _gc_url) of
+    Nothing -> BaseUrl Http "localhost" 80 ""
+    Just bh -> bh { baseUrlPort = _msProxyPort }
+
+
 makeLenses ''MicroServicesSettings

src/Gargantext/API/Admin/Settings/TOML.hs

@@ -10,6 +10,7 @@ import Gargantext.System.Logging
 import Paths_gargantext
 import Prelude
 import Toml
+import Servant.Client.Core.BaseUrl
 
 -- | Compatibility bridge until we fix #304 (move to Toml)
 data GargTomlSettings = GargTomlSettings
@@ -24,6 +25,20 @@ settingsCodec = GargTomlSettings
   <$> (Toml.table corsSettingsCodec "cors" .= _gargCorsSettings)
   <*> (Toml.table  microServicesSettingsCodec "microservices" .= _gargMicroServicesSettings)
 
+-- | Extends the 'allowed-origins' in the CORSettings with the URLs embellished
+-- with the proxy port.
+addProxyToAllowedOrigins :: GargTomlSettings -> GargTomlSettings
+addProxyToAllowedOrigins stgs =
+  stgs & over gargCorsSettings (addProxies $ stgs ^. gargMicroServicesSettings . msProxyPort)
+  where
+    addProxies :: Int -> CORSSettings -> CORSSettings
+    addProxies port cors =
+      let origins = _corsAllowedOrigins cors
+          mkUrl (CORSOrigin u) = case parseBaseUrl (T.unpack u) of
+            Nothing -> CORSOrigin u
+            Just bh -> CORSOrigin $ T.pack $ showBaseUrl $ bh { baseUrlPort = port }
+      in cors { _corsAllowedOrigins = origins <> Prelude.map mkUrl origins }
+
 -- | Loads the 'CORSSettings' from the 'toml' file.
 loadGargTomlSettings :: IO GargTomlSettings
 loadGargTomlSettings = do
@@ -35,5 +50,5 @@ loadGargTomlSettings = do
           logMsg ioLogger ERROR $ T.unpack $ "Error, gargantext-settings.toml parsing failed: " <> Toml.prettyTomlDecodeErrors errs
           panicTrace "Please fix the errors in your gargantext-settings.toml file."
       Right settings0 -> case settings0 ^. gargCorsSettings . corsUseOriginsForHosts of
-        True  -> pure $ settings0 & over (gargCorsSettings . corsAllowedHosts) (\_ -> "http://localhost:3000" : (settings0 ^. gargCorsSettings . corsAllowedOrigins))
-        False -> pure $ settings0 & over (gargCorsSettings . corsAllowedHosts) ("http://localhost:3000" :)
+        True  -> pure $ addProxyToAllowedOrigins $ settings0 & over (gargCorsSettings . corsAllowedHosts) (\_ -> "http://localhost:3000" : (settings0 ^. gargCorsSettings . corsAllowedOrigins))
+        False -> pure $ addProxyToAllowedOrigins $ settings0 & over (gargCorsSettings . corsAllowedHosts) ("http://localhost:3000" :)

src/Gargantext/Database/Action/Node.hs

@@ -36,6 +36,7 @@ import Gargantext.Database.Query.Table.Node.UpdateOpaleye (updateHyperdata)
 import Gargantext.Prelude hiding (hash)
 import Gargantext.Prelude.Config (GargConfig(..))
 import Gargantext.Prelude.Crypto.Hash (hash)
+import Servant.Client.Core.BaseUrl
 
 ------------------------------------------------------------------------
 -- | TODO mk all others nodes
@@ -95,9 +96,8 @@ mkNodeWithParent_ConfigureHyperdata NodeFrameNotebook (Just i) uId name = (:[])
 
 mkNodeWithParent_ConfigureHyperdata    _ _ _ _ = nodeError NotImplYet
 
-internalNotesProxy :: MicroServicesSettings -> T.Text
-internalNotesProxy MicroServicesSettings{..} =
-  "http://localhost:" <> T.pack (show _msProxyPort) <> "/notes"
+internalNotesProxy :: BaseUrl -> T.Text
+internalNotesProxy proxyUrl = T.pack $ showBaseUrl proxyUrl <> "/notes"
 
 -- | Function not exposed
 mkNodeWithParent_ConfigureHyperdata' :: (HasNodeError err, HasDBid NodeType, HasSettings env)
@@ -116,7 +116,7 @@ mkNodeWithParent_ConfigureHyperdata' nt (Just i) uId name = do
   cfg <- view hasConfig
   stt <- view settings
   u <- case nt of
-        Notes -> pure $ internalNotesProxy (_microservicesSettings stt)
+        Notes -> pure $ internalNotesProxy (mkProxyUrl cfg $ _microservicesSettings stt)
         Calc  -> pure $ _gc_frame_calc_url  cfg
         NodeFrameVisio -> pure $ _gc_frame_visio_url  cfg
         _              -> nodeError NeedsConfiguration

src/Gargantext/MicroServices/ReverseProxy.hs

@@ -138,9 +138,9 @@ server env = ReverseProxyAPI {
 -- 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  = ''
+configJS :: BaseUrl -> ServiceType -> T.Text
+configJS bu st = T.pack $ [r|
+window.domain  = '|] <> (baseUrlHost bu) <> [r|'
 window.urlpath = '|] <> renderServiceType st <> [r|'
 window.debug   = false
 window.version = '1.2.0'
@@ -154,7 +154,7 @@ notesProxyImplementation :: Env -> NotesProxy AsServer
 notesProxyImplementation env = NotesProxy {
     slideEp     = \frameId  -> slideProxyServer env frameId
   , publishEp   = \frameId  -> publishProxyServer env frameId
-  , configFile  = pure $ configJS sty
+  , configFile  = pure $ configJS (proxyUrl env) sty
   , notesSocket = socketIOProxyImplementation sty env
   , meEndpoint  = proxyPassServer sty env
   , notesEp     = \_frameId  -> defaultForwardServer sty id env
@@ -215,6 +215,10 @@ removeFromReferer pth originalRequest =
       | otherwise
       = (k,v)
 
+proxyUrl :: Env -> BaseUrl
+proxyUrl env = mkProxyUrl (env ^. hasConfig) (env ^. env_settings . microservicesSettings)
+
+
 defaultForwardServer :: ServiceType
                      -> (Request -> Request)
                      -> Env
@@ -226,26 +230,15 @@ defaultForwardServer sty presendModifyRequest env =
     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
+    proxyUrlStr = showBaseUrl (proxyUrl env)
 
     proxySettings :: WaiProxySettings
     proxySettings =
       defaultWaiProxySettings {
           wpsProcessBody = \_req _res -> Just $ replaceRelativeLinks (C8.pack $ proxyUrlStr <> serviceTypeToProxyPath sty)
         , wpsModifyResponseHeaders = \_req _res -> tweakResponseHeaders
-        , wpsRedirectCounts = 2
+        , wpsRedirectCounts = 5
         }
 
     setHost :: ProxyDestination -> RequestHeaders -> RequestHeaders