Skip to content
Projects
Groups
Snippets
Help
Loading...
Help
Submit feedback
Contribute to GitLab
Sign in
Toggle navigation
haskell-gargantext
Project
Project
Details
Activity
Releases
Cycle Analytics
Repository
Repository
Files
Commits
Branches
Tags
Contributors
Graph
Compare
Charts
Issues
0
Issues
0
List
Board
Labels
Milestones
Merge Requests
0
Merge Requests
0
CI / CD
CI / CD
Pipelines
Jobs
Schedules
Charts
Wiki
Wiki
Snippets
Snippets
Members
Members
Collapse sidebar
Close sidebar
Activity
Graph
Charts
Create a new issue
Jobs
Commits
Issue Boards
Open sidebar
Grégoire Locqueville
haskell-gargantext
Commits
78687085
Commit
78687085
authored
Jun 17, 2024
by
Alfredo Di Napoli
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
Move reverse proxy on separate port
parent
b0be91da
Changes
8
Hide whitespace changes
Inline
Side-by-side
Showing
8 changed files
with
168 additions
and
104 deletions
+168
-104
gargantext.cabal
gargantext.cabal
+1
-0
API.hs
src/Gargantext/API.hs
+9
-2
Private.hs
src/Gargantext/API/Routes/Named/Private.hs
+0
-3
Named.hs
src/Gargantext/API/Server/Named.hs
+1
-1
Private.hs
src/Gargantext/API/Server/Named/Private.hs
+3
-93
ThrowAll.hs
src/Gargantext/API/ThrowAll.hs
+4
-4
Node.hs
src/Gargantext/Database/Action/Node.hs
+1
-1
ReverseProxy.hs
src/Gargantext/MicroServices/ReverseProxy.hs
+149
-0
No files found.
gargantext.cabal
View file @
78687085
...
...
@@ -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
View file @
78687085
...
...
@@ -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
View file @
78687085
...
...
@@ -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
View file @
78687085
...
...
@@ -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
View file @
78687085
{-# 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
View file @
78687085
...
...
@@ -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
View file @
78687085
...
...
@@ -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
0 → 100644
View file @
78687085
{-# 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
Write
Preview
Markdown
is supported
0%
Try again
or
attach a new file
Attach a file
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment