Skip to content
Projects
Groups
Snippets
Help
Loading...
Help
Submit feedback
Contribute to GitLab
Sign in
Toggle navigation
H
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
Przemyslaw Kaminski
haskell-gargantext
Commits
9676e879
Unverified
Commit
9676e879
authored
5 years ago
by
Nicolas Pouillard
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
Disable the Mock mode which is currently incompatible with servant-multipart
parent
45b48498
Changes
3
Hide whitespace changes
Inline
Side-by-side
Showing
3 changed files
with
47 additions
and
27 deletions
+47
-27
Main.hs
bin/gargantext-server/Main.hs
+4
-2
API.hs
src/Gargantext/API.hs
+9
-8
Upload.hs
src/Gargantext/API/Upload.hs
+34
-17
No files found.
bin/gargantext-server/Main.hs
View file @
9676e879
...
...
@@ -27,7 +27,7 @@ import Options.Generic
import
Data.Text
(
unpack
)
import
Gargantext.Prelude
import
Gargantext.API
(
startGargantext
,
startGargantextMock
)
import
Gargantext.API
(
startGargantext
)
--
, startGargantextMock)
--------------------------------------------------------
-- Graph Tests
...
...
@@ -73,7 +73,9 @@ main = do
myIniFile'
=
case
myIniFile
of
Nothing
->
panic
"[ERROR] gargantext.ini needed"
Just
i
->
i
_
->
startGargantextMock
myPort'
Dev
->
panic
"[ERROR] Dev mode unsupported"
Mock
->
panic
"[ERROR] Mock mode unsupported"
-- _ -> startGargantextMock myPort'
putStrLn
$
"Starting with "
<>
show
myMode
<>
" mode."
start
...
...
This diff is collapsed.
Click to expand it.
src/Gargantext/API.hs
View file @
9676e879
...
...
@@ -56,7 +56,7 @@ import Network.Wai.Handler.Warp hiding (defaultSettings)
import
Servant
import
Servant.HTML.Blaze
(
HTML
)
import
Servant.Mock
(
mock
)
--
import Servant.Mock (mock)
--import Servant.Job.Server (WithCallbacks)
import
Servant.Static.TH.Internal.Server
(
fileTreeToServer
)
import
Servant.Static.TH.Internal.FileTree
(
fileTypeToFileTree
,
FileType
(
FileTypeFile
))
...
...
@@ -145,7 +145,7 @@ fireWall req fw = do
then
pure
True
else
pure
False
{-
-- makeMockApp :: Env -> IO (Warp.Settings, Application)
makeMockApp :: MockEnv -> IO Application
makeMockApp env = do
...
...
@@ -178,7 +178,7 @@ makeMockApp env = do
--pure (warpS, logWare $ checkOriginAndHost $ corsMiddleware $ serverApp)
pure $ logStdoutDev $ checkOriginAndHost $ corsMiddleware $ serverApp
-}
makeDevMiddleware
::
IO
Middleware
...
...
@@ -340,16 +340,16 @@ swaggerFront :: Server SwaggerFrontAPI
swaggerFront
=
schemaUiServer
swaggerDoc
:<|>
frontEndServer
gargMock
::
Server
GargAPI
gargMock
=
mock
apiGarg
Proxy
--
gargMock :: Server GargAPI
--
gargMock = mock apiGarg Proxy
---------------------------------------------------------------------
makeApp
::
(
HasConnection
env
,
HasRepo
env
,
HasSettings
env
)
=>
env
->
IO
Application
makeApp
=
fmap
(
serve
api
)
.
server
appMock
::
Application
appMock
=
serve
api
(
swaggerFront
:<|>
gargMock
:<|>
serverStatic
)
--
appMock :: Application
--
appMock = serve api (swaggerFront :<|> gargMock :<|> serverStatic)
---------------------------------------------------------------------
api
::
Proxy
API
...
...
@@ -414,9 +414,10 @@ startGargantext port file = do
mid
<-
makeDevMiddleware
run
port
(
mid
app
)
`
finally
`
stopGargantext
env
{-
startGargantextMock :: PortNumber -> IO ()
startGargantextMock port = do
portRouteInfo port
application <- makeMockApp . MockEnv $ FireWall False
run port application
-}
This diff is collapsed.
Click to expand it.
src/Gargantext/API/Upload.hs
View file @
9676e879
...
...
@@ -11,14 +11,16 @@ Portability : POSIX
{-# OPTIONS_GHC -fno-warn-orphans #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeOperators #-}
module
Gargantext.API.Upload
where
...
...
@@ -28,27 +30,42 @@ import Gargantext.Prelude
import
Data.Text
(
Text
)
import
Servant
import
Servant.Multipart
--import Servant.Mock (HasMock(mock))
import
Servant.Swagger
(
HasSwagger
(
toSwagger
))
import
qualified
Data.ByteString.Lazy
as
LBS
import
Control.Monad
import
Control.Monad.IO.Class
import
Gargantext.API.Types
import
Test.QuickCheck.Arbitrary
(
Arbitrary
,
arbitrary
)
import
Data.Swagger
--import Test.QuickCheck.Arbitrary (Arbitrary, arbitrary)
--import Data.Swagger
--import Gargantext.API.Ngrams (TODO)
-- | Upload files
-- TODO Is it possible to adapt the function according to iValue input ?
--type API = MultipartForm Mem (MultipartData Mem) :> Post '[JSON] Integer
instance
Generic
Mem
--
instance Generic Mem
instance
ToSchema
Mem
instance
Arbitrary
Mem
--
instance ToSchema Mem
--
instance Arbitrary Mem
instance
ToSchema
(
MultipartData
Mem
)
instance
Arbitrary
(
MultipartData
Mem
)
--
instance ToSchema (MultipartData Mem)
--
instance Arbitrary ( MultipartData Mem)
instance
ToSchema
(
MultipartForm
Mem
(
MultipartData
Mem
))
instance
Arbitrary
(
MultipartForm
Mem
(
MultipartData
Mem
))
instance
HasSwagger
(
MultipartForm
tag
a
:>
sub
)
where
-- TODO
toSwagger
_
=
undefined
-- toSwagger (Proxy :: Proxy (TODO :> Post '[JSON] ()))
--declareNamedSchema _ = declareNamedSchema (Proxy :: Proxy TODO)
--instance Arbitrary (MultipartForm Mem (MultipartData Mem))
{-
instance (FromMultipart tag a, MultipartBackend tag, Servant.Multipart.LookupContext context (MultipartOptions tag))
=> HasMock (MultipartForm tag a :> sub) context where
mock _ _ = undefined
instance HasMock (MultipartForm Mem (MultipartData Mem) :> sub) context where
mock _ _ = undefined
-}
type
ApiUpload
=
MultipartForm
Mem
(
MultipartData
Mem
)
:>
Post
'[
J
SON
]
Integer
-- MultipartData consists in textual inputs,
...
...
This diff is collapsed.
Click to expand it.
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