Merge remote-tracking branch 'origin/adinapoli/issue-370' into dev

bin/update-project-dependencies

@@ -19,7 +19,7 @@ fi
 # `cabal.project.freeze`. This ensures the files stay deterministic so that CI
 # cache can kick in.
 expected_cabal_project_hash="ec368714e0d4213dcc60e7c98344ab9a4ecbcff522deb4c57a12490e3b048585"
-expected_cabal_project_freeze_hash="ca1592c985ffead024c6635eb39b293e2525a547fe93293fdee9ce1148083f22"
+expected_cabal_project_freeze_hash="0999af7642e822e6b4e2996b743c8f924cdfa406c9b2941bb53f1ca7b3a0737d"
 
 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.freeze

@@ -545,6 +545,8 @@ constraints: any.Cabal ==3.8.1.0,
              streaming-commons -use-bytestring-builder,
              any.strict ==0.5,
              any.string-conversions ==0.4.0.1,
+             any.stringsearch ==0.3.6.6,
+             stringsearch -base3 +base4,
              any.swagger2 ==2.8.7,
              any.syb ==0.7.2.4,
              any.system-cxx-std-lib ==1.0,

gargantext-settings.toml

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

gargantext.cabal

@@ -662,6 +662,7 @@ library
     , split ^>= 0.2.3.4
     , stemmer ^>= 0.5.2
     , stm ^>= 2.5.0.1
+    , stringsearch >= 0.3.6.6
     , swagger2 ^>= 2.6
     , taggy-lens ^>= 0.1.2
     , tagsoup ^>= 0.14.8

src/Gargantext/API.hs

@@ -38,6 +38,7 @@ import Control.Concurrent
 import Control.Concurrent.Async qualified as Async
 import Control.Lens hiding (Level)
 import Data.List (lookup)
+import Data.Set qualified as Set
 import Data.Text (pack)
 import Data.Text.Encoding qualified as TE
 import Data.Text.IO (putStrLn)
@@ -64,6 +65,7 @@ import Network.Wai.Middleware.Cors
 import Network.Wai.Middleware.RequestLogger
 import Paths_gargantext (getDataDir)
 import Servant hiding (Header)
+import Servant.Client.Core.BaseUrl (showBaseUrl)
 import System.Cron.Schedule qualified as Cron
 import System.FilePath
 
@@ -154,7 +156,7 @@ makeGargMiddleware :: CORSSettings -> Mode -> IO Middleware
 makeGargMiddleware crsSettings mode = do
     let corsMiddleware = cors $ \_incomingRq -> Just
           simpleCorsResourcePolicy
-            { corsOrigins = Just (map mkCorsOrigin (crsSettings ^. corsAllowedOrigins), True)
+            { corsOrigins = Just $ (Set.toList $ Set.fromList $ map mkCorsOrigin (crsSettings ^. corsAllowedOrigins), True)
             , corsMethods = [ methodGet   , methodPost   , methodPut
                             , methodDelete, methodOptions, methodHead]
             , corsIgnoreFailures = False
@@ -168,7 +170,7 @@ makeGargMiddleware crsSettings mode = do
         pure $ loggerMiddleware . corsMiddleware
   where
     mkCorsOrigin :: CORSOrigin -> Origin
-    mkCorsOrigin = TE.encodeUtf8 . _CORSOrigin
+    mkCorsOrigin (CORSOrigin u) = TE.encodeUtf8 . pack . showBaseUrl $ u
 
 ---------------------------------------------------------------------
 -- | API Global

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

@@ -2,6 +2,7 @@
 
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE TemplateHaskell   #-}
+{-# LANGUAGE ViewPatterns      #-}
 module Gargantext.API.Admin.Settings.CORS where
 
 import Prelude
@@ -10,10 +11,11 @@ import Control.Arrow
 import Data.Text qualified as T
 import Toml
 import Control.Lens hiding (iso, (.=))
-import Data.String (IsString)
+import Servant.Client.Core
+import Data.Maybe (fromMaybe)
 
-newtype CORSOrigin = CORSOrigin { _CORSOrigin :: T.Text }
-  deriving (Show, Eq, IsString)
+newtype CORSOrigin = CORSOrigin { _CORSOrigin :: BaseUrl }
+  deriving (Show, Eq)
 
 data CORSSettings =
   CORSSettings {
@@ -30,7 +32,8 @@ corsOriginCodec :: TomlBiMap CORSOrigin AnyValue
 corsOriginCodec = _Orig >>> _Text
   where
    _Orig :: BiMap e CORSOrigin T.Text
-   _Orig = iso _CORSOrigin CORSOrigin
+   _Orig = iso (T.pack . showBaseUrl . _CORSOrigin)
+               (\(T.unpack -> u) -> CORSOrigin . fromMaybe (error $ "invalid origin: " <> u) . parseBaseUrl $ u)
 
 corsSettingsCodec :: TomlCodec CORSSettings
 corsSettingsCodec = CORSSettings

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

@@ -33,9 +33,7 @@ addProxyToAllowedOrigins stgs =
     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 }
+          mkUrl (CORSOrigin bh) = CORSOrigin $ bh { baseUrlPort = port }
       in cors { _corsAllowedOrigins = origins <> Prelude.map mkUrl origins }
 
 -- | Loads the 'CORSSettings' from the 'toml' file.
@@ -48,5 +46,7 @@ loadGargTomlSettings tomlFile = 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 $ addProxyToAllowedOrigins $ settings0 & over (gargCorsSettings . corsAllowedHosts) (\_ -> "http://localhost:3000" : (settings0 ^. gargCorsSettings . corsAllowedOrigins))
-        False -> pure $ addProxyToAllowedOrigins $ settings0 & over (gargCorsSettings . corsAllowedHosts) ("http://localhost:3000" :)
+        True  -> pure $ addProxyToAllowedOrigins $
+                   settings0 & over (gargCorsSettings . corsAllowedHosts)
+                     (\_ -> (settings0 ^. gargCorsSettings . corsAllowedOrigins))
+        False -> pure $ addProxyToAllowedOrigins settings0

src/Gargantext/MicroServices/ReverseProxy.hs

@@ -24,11 +24,14 @@ import Conduit
 import Data.ByteString qualified as B
 import Data.ByteString.Builder
 import Data.ByteString.Char8 qualified as C8
+import Data.ByteString.Lazy qualified as BL
+import Data.ByteString.Search qualified as BS
 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.Auth.Types (AuthContext)
 import Gargantext.API.Admin.EnvTypes
 import Gargantext.API.Admin.Settings.MicroServices
 import Gargantext.API.Admin.Types
@@ -41,17 +44,16 @@ import Gargantext.Prelude hiding (Handler)
 import Network.HTTP.ReverseProxy
 import Network.HTTP.Types (hCacheControl, RequestHeaders, hReferer, ResponseHeaders, Header)
 import Network.HTTP.Types.Header (hHost)
+import Network.Wai
 import Servant hiding (Header)
 import Servant.Auth.Server
+import Servant.Auth.Server.Internal.AddSetCookie
 import Servant.Auth.Swagger ()
 import Servant.Client.Core.BaseUrl
 import Servant.Server.Generic
 import Text.RE.Replace hiding (Capture)
 import Text.RE.TDFA.ByteString
 import Text.RawString.QQ (r)
-import Gargantext.API.Admin.Auth.Types (AuthContext)
-import Servant.Auth.Server.Internal.AddSetCookie
-import Network.Wai
 
 -- See https://github.com/haskell-servant/servant/issues/1601#issue-1338013029
 instance {-# OVERLAPPING #-}
@@ -266,10 +268,13 @@ defaultForwardServer sty presendModifyRequest env =
     proxySettings :: WaiProxySettings
     proxySettings =
       defaultWaiProxySettings {
-          wpsProcessBody = \_req _res -> Just $ replaceRelativeLinks (C8.pack $ proxyUrlStr <> serviceTypeToProxyPath sty)
+          wpsProcessBody = \_req _res -> Just $ replaceRelativeLinks microURL proxyPath
         , wpsModifyResponseHeaders = \_req _res -> tweakResponseHeaders
         , wpsRedirectCounts = 5
         }
+        where
+          microURL  = proxyDestination
+          proxyPath = C8.pack $ proxyUrlStr <> serviceTypeToProxyPath sty
 
     setHost :: ProxyDestination -> RequestHeaders -> RequestHeaders
     setHost hst hdrs = (hHost, fwdHost hst) : filter ((/=) hHost . fst) hdrs
@@ -306,12 +311,15 @@ tweakResponseHeaders = Prelude.map tweakHeader
       = (k,v)
 
 -- | Replaces the relative links in any HTML blob returned by the proxy.
-replaceRelativeLinks :: B.ByteString -> ConduitT B.ByteString (Flush Builder) IO ()
-replaceRelativeLinks assetPath = CC.map flushReplace
+replaceRelativeLinks :: ProxyDestination -> B.ByteString -> ConduitT B.ByteString (Flush Builder) IO ()
+replaceRelativeLinks proxyTarget assetPath = CC.map flushReplace
   where
     --  Replaces the relative links in the proxied page content with proper urls.
     flushReplace :: B.ByteString -> Flush Builder
-    flushReplace = Chunk . byteString . replaceIt
+    flushReplace = Chunk . byteString
+                         . BL.toStrict
+                         . BS.replace (C8.pack . showBaseUrl . _ProxyDestination $ proxyTarget) assetPath
+                         . replaceIt
 
     replaceIt :: B.ByteString -> B.ByteString
     replaceIt htmlBlob =

stack.yaml

@@ -513,6 +513,9 @@ flags:
     "optimised-mixer": false
   "streaming-commons":
     "use-bytestring-builder": false
+  stringsearch:
+    base3: false
+    base4: true
   tagged:
     deepseq: true
     transformers: true