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
160
Issues
160
List
Board
Labels
Milestones
Merge Requests
14
Merge Requests
14
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
gargantext
haskell-gargantext
Commits
ecc36158
Commit
ecc36158
authored
Feb 05, 2024
by
Alfredo Di Napoli
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
Remove dead (and confusing) code from Gargantext.API
parent
a0e96032
Changes
1
Hide whitespace changes
Inline
Side-by-side
Showing
1 changed file
with
3 additions
and
95 deletions
+3
-95
API.hs
src/Gargantext/API.hs
+3
-95
No files found.
src/Gargantext/API.hs
View file @
ecc36158
...
...
@@ -70,7 +70,7 @@ startGargantext mode port file = withLoggerHoisted mode $ \logger -> do
runDbCheck
env
portRouteInfo
port
app
<-
makeApp
env
mid
<-
make
Dev
Middleware
mode
mid
<-
make
Garg
Middleware
mode
periodicActions
<-
schedulePeriodicActions
env
run
port
(
mid
app
)
`
finally
`
stopGargantext
env
periodicActions
...
...
@@ -98,14 +98,6 @@ stopGargantext env scheduledPeriodicActions = do
putStrLn
"----- Stopping gargantext -----"
runReaderT
saveNodeStoryImmediate
env
{-
startGargantextMock :: PortNumber -> IO ()
startGargantextMock port = do
portRouteInfo port
application <- makeMockApp . MockEnv $ FireWall False
run port application
-}
-- | Schedules all sorts of useful periodic actions to be run while
-- the server is alive accepting requests.
schedulePeriodicActions
::
DB
.
CmdCommon
env
=>
env
->
IO
[
ThreadId
]
...
...
@@ -145,53 +137,8 @@ fireWall req fw = do
then
pure
True
else
pure
False
{-
-- makeMockApp :: Env -> IO (Warp.Settings, Application)
makeMockApp :: MockEnv -> IO Application
makeMockApp env = do
let serverApp = appMock
-- logWare <- mkRequestLogger def { destination = RequestLogger.Logger $ env^.logger }
--logWare <- mkRequestLogger def { destination = RequestLogger.Logger "/tmp/logs.txt" }
let checkOriginAndHost app req resp = do
blocking <- fireWall req (env ^. menv_firewall)
case blocking of
True -> app req resp
False -> resp ( responseLBS status401 []
"Invalid Origin or Host header")
let corsMiddleware = cors $ \_ -> Just CorsResourcePolicy
-- { corsOrigins = Just ([env^.settings.allowedOrigin], False)
{ corsOrigins = Nothing -- == /*
, corsMethods = [ methodGet , methodPost , methodPut
, methodDelete, methodOptions, methodHead]
, corsRequestHeaders = ["authorization", "content-type"]
, corsExposedHeaders = Nothing
, corsMaxAge = Just ( 60*60*24 ) -- one day
, corsVaryOrigin = False
, corsRequireOrigin = False
, corsIgnoreFailures = False
}
--let warpS = Warp.setPort (8008 :: Int) -- (env^.settings.appPort)
-- $ Warp.defaultSettings
--pure (warpS, logWare $ checkOriginAndHost $ corsMiddleware $ serverApp)
pure $ logStdoutDev $ checkOriginAndHost $ corsMiddleware $ serverApp
-}
makeDevMiddleware
::
Mode
->
IO
Middleware
makeDevMiddleware
mode
=
do
-- logWare <- mkRequestLogger def { destination = RequestLogger.Logger $ env^.logger }
-- logWare <- mkRequestLogger def { destination = RequestLogger.Logger "/tmp/logs.txt" }
-- let checkOriginAndHost app req resp = do
-- blocking <- fireWall req (env ^. menv_firewall)
-- case blocking of
-- True -> app req resp
-- False -> resp ( responseLBS status401 []
-- "Invalid Origin or Host header")
--
makeGargMiddleware
::
Mode
->
IO
Middleware
makeGargMiddleware
mode
=
do
let
corsMiddleware
=
cors
$
\
_
->
Just
CorsResourcePolicy
-- { corsOrigins = Just ([env^.settings.allowedOrigin], False)
{
corsOrigins
=
Nothing
-- == /*
...
...
@@ -205,10 +152,6 @@ makeDevMiddleware mode = do
,
corsIgnoreFailures
=
False
}
--let warpS = Warp.setPort (8008 :: Int) -- (env^.settings.appPort)
-- $ Warp.defaultSettings
--pure (warpS, logWare . checkOriginAndHost . corsMiddleware)
case
mode
of
Prod
->
pure
$
logStdout
.
corsMiddleware
_
->
do
...
...
@@ -220,22 +163,6 @@ makeDevMiddleware mode = do
-- | API Global
---------------------------------------------------------------------
---------------------------
-- TODO-SECURITY admin only: withAdmin
-- Question: How do we mark admins?
{-
serverGargAdminAPI :: GargServer GargAdminAPI
serverGargAdminAPI = roots
:<|> nodesAPI
-}
---------------------------------------------------------------------
--gargMock :: Server GargAPI
--gargMock = mock apiGarg Proxy
---------------------------------------------------------------------
makeApp
::
Env
->
IO
Application
makeApp
env
=
do
serv
<-
server
env
...
...
@@ -247,11 +174,8 @@ makeApp env = do
cfg
::
Servant
.
Context
AuthContext
cfg
=
env
^.
settings
.
jwtSettings
:.
env
^.
settings
.
cookieSettings
-- :. authCheck env
:.
EmptyContext
--appMock :: Application
--appMock = serve api (swaggerFront :<|> gargMock :<|> serverStatic)
---------------------------------------------------------------------
api
::
Proxy
API
api
=
Proxy
...
...
@@ -262,19 +186,3 @@ apiWithEkg = Proxy
apiGarg
::
Proxy
GargAPI
apiGarg
=
Proxy
---------------------------------------------------------------------
{- UNUSED
--import GHC.Generics (D1, Meta (..), Rep, Generic)
--import GHC.TypeLits (AppendSymbol, Symbol)
---------------------------------------------------------------------
-- Type Family for the Documentation
type family TypeName (x :: *) :: Symbol where
TypeName Int = "Int"
TypeName Text = "Text"
TypeName x = GenericTypeName x (Rep x ())
type family GenericTypeName t (r :: *) :: Symbol where
GenericTypeName t (D1 ('MetaData name mod pkg nt) f x) = name
type Desc t n = Description (AppendSymbol (TypeName t) (AppendSymbol " | " n))
-}
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