Commit 775049e4 authored by Alexandre Delanoë's avatar Alexandre Delanoë

Merge branch 'dev-list-downloadable-with-content-type' into dev

parents 989cc231 6755aad5
...@@ -208,7 +208,7 @@ type GargAPI' = ...@@ -208,7 +208,7 @@ type GargAPI' =
-- auth and capabilities. -- auth and capabilities.
:<|> GargPrivateAPI :<|> GargPrivateAPI
type GargPrivateAPI = SA.Auth '[SA.JWT] AuthenticatedUser :> GargPrivateAPI' type GargPrivateAPI = SA.Auth '[SA.JWT, SA.Cookie] AuthenticatedUser :> GargPrivateAPI'
type GargAdminAPI type GargAdminAPI
-- Roots endpoint -- Roots endpoint
......
...@@ -12,6 +12,8 @@ Portability : POSIX ...@@ -12,6 +12,8 @@ Portability : POSIX
{-# LANGUAGE DataKinds #-} {-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-} {-# LANGUAGE RankNTypes #-}
...@@ -21,31 +23,48 @@ Portability : POSIX ...@@ -21,31 +23,48 @@ Portability : POSIX
module Gargantext.API.Ngrams.List module Gargantext.API.Ngrams.List
where where
import Gargantext.Prelude import Data.Text (Text, concat, pack)
import Gargantext.API.Ngrams import Data.Aeson
import Servant
import Data.List (zip) import Data.List (zip)
import Data.Map (Map, toList, fromList) import Data.Map (Map, toList, fromList)
import Gargantext.Database.Types.Node import Network.HTTP.Media ((//), (/:))
import Gargantext.Database.Schema.Ngrams (NgramsType(..), ngramsTypes) import Servant
import Gargantext.Database.Flow (FlowCmdM)
import Gargantext.Prelude
import Gargantext.API.Ngrams
import Gargantext.API.Types (GargServer) import Gargantext.API.Types (GargServer)
import Gargantext.API.Ngrams (putListNgrams') import Gargantext.Database.Flow (FlowCmdM)
import Gargantext.Database.Schema.Ngrams (NgramsType(..), ngramsTypes)
import Gargantext.Database.Types.Node
type NgramsList = (Map NgramsType (Versioned NgramsTableMap)) type NgramsList = (Map NgramsType (Versioned NgramsTableMap))
type API = Get '[JSON] NgramsList data HTML
:<|> ReqBody '[JSON] NgramsList :> Put '[JSON] Bool instance Accept HTML where
contentType _ = "text" // "html" /: ("charset", "utf-8")
instance ToJSON a => MimeRender HTML a where
mimeRender _ = encode
type API = ReqBody '[JSON] NgramsList :> Put '[JSON] Bool
:<|> Get '[HTML] (Headers '[Header "Content-Disposition" Text] NgramsList)
api :: ListId -> GargServer API api :: ListId -> GargServer API
api l = get l :<|> put l api l = put l :<|> getHtml l
get :: RepoCmdM env err m get :: RepoCmdM env err m
=> ListId -> m NgramsList => ListId -> m NgramsList
get lId = fromList get lId = fromList
<$> zip ngramsTypes <$> zip ngramsTypes
<$> mapM (getNgramsTableMap lId) ngramsTypes <$> mapM (getNgramsTableMap lId) ngramsTypes
getHtml :: RepoCmdM env err m
=> ListId -> m (Headers '[Header "Content-Disposition" Text] NgramsList)
getHtml lId = do
lst <- get lId
let (NodeId id) = lId
return $ addHeader (concat ["attachment; filename=GarganText_NgramsList-", pack $ show id, ".json"]) lst
-- TODO : purge list -- TODO : purge list
put :: FlowCmdM env err m put :: FlowCmdM env err m
=> ListId => ListId
......
...@@ -48,7 +48,7 @@ import Data.ByteString (ByteString) ...@@ -48,7 +48,7 @@ import Data.ByteString (ByteString)
import qualified Data.ByteString.Lazy as L import qualified Data.ByteString.Lazy as L
import Servant import Servant
import Servant.Auth.Server (defaultJWTSettings, JWTSettings, CookieSettings, defaultCookieSettings, readKey, writeKey) import Servant.Auth.Server (defaultJWTSettings, JWTSettings, CookieSettings(..), XsrfCookieSettings(..), defaultCookieSettings, defaultXsrfCookieSettings, readKey, writeKey)
import Servant.Client (BaseUrl, parseBaseUrl) import Servant.Client (BaseUrl, parseBaseUrl)
import qualified Servant.Job.Core import qualified Servant.Job.Core
import Servant.Job.Async (newJobEnv, defaultSettings, HasJobEnv(..), Job) import Servant.Job.Async (newJobEnv, defaultSettings, HasJobEnv(..), Job)
...@@ -106,9 +106,11 @@ devSettings jwkFile = do ...@@ -106,9 +106,11 @@ devSettings jwkFile = do
, _sendLoginEmails = LogEmailToConsole , _sendLoginEmails = LogEmailToConsole
, _scrapydUrl = fromMaybe (panic "Invalid scrapy URL") $ parseBaseUrl "http://localhost:6800" , _scrapydUrl = fromMaybe (panic "Invalid scrapy URL") $ parseBaseUrl "http://localhost:6800"
, _fileFolder = "data" , _fileFolder = "data"
, _cookieSettings = defaultCookieSettings -- TODO-SECURITY tune , _cookieSettings = defaultCookieSettings { cookieXsrfSetting = Just xsrfCookieSetting } -- TODO-SECURITY tune
, _jwtSettings = defaultJWTSettings jwk -- TODO-SECURITY tune , _jwtSettings = defaultJWTSettings jwk -- TODO-SECURITY tune
} }
where
xsrfCookieSetting = defaultXsrfCookieSettings { xsrfExcludeGet = True }
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment