From 7ac399b14098b4b408754194801cb091044ee0a3 Mon Sep 17 00:00:00 2001
From: Przemek Kaminski <pk@intrepidus.pl>
Date: Mon, 20 Jul 2020 17:01:45 +0200
Subject: [PATCH] [metrics] trying to get 304 status code to work
---
src/Gargantext/API/Metrics.hs | 27 ++++++++++++++++++++-------
src/Gargantext/API/Ngrams/List.hs | 20 ++++++++++----------
2 files changed, 30 insertions(+), 17 deletions(-)
diff --git a/src/Gargantext/API/Metrics.hs b/src/Gargantext/API/Metrics.hs
index ad901b8d..bc9d37bb 100644
--- a/src/Gargantext/API/Metrics.hs
+++ b/src/Gargantext/API/Metrics.hs
@@ -19,8 +19,11 @@ module Gargantext.API.Metrics
where
import Control.Lens
+import qualified Data.Map as Map
import Data.Time (UTCTime)
import Data.Text (Text)
+import Servant
+
import Gargantext.API.HashedResponse
import Gargantext.API.Ngrams
import Gargantext.API.Ngrams.NTree
@@ -39,8 +42,6 @@ import Gargantext.Prelude
import Gargantext.Text.Metrics (Scored(..))
import Gargantext.Viz.Chart
import Gargantext.Viz.Types
-import Servant
-import qualified Data.Map as Map
import qualified Gargantext.Database.Action.Metrics as Metrics
-------------------------------------------------------------
@@ -49,7 +50,8 @@ type ScatterAPI = Summary "SepGen IncExc metrics"
:> QueryParam "list" ListId
:> QueryParamR "ngramsType" TabType
:> QueryParam "limit" Int
- :> Get '[JSON] (HashedResponse Metrics)
+ :> Header "X-Hash" Text
+ :> Get '[JSON] (Headers '[Header "X-Hash" Text] (HashedResponse Metrics))
:<|> Summary "Scatter update"
:> QueryParam "list" ListId
:> QueryParamR "ngramsType" TabType
@@ -71,8 +73,9 @@ getScatter :: FlowCmdM env err m =>
-> Maybe ListId
-> TabType
-> Maybe Limit
- -> m (HashedResponse Metrics)
-getScatter cId maybeListId tabType _maybeLimit = do
+ -> Maybe Text
+ -> m (Headers '[Header "X-Hash" Text] (HashedResponse Metrics))
+getScatter cId maybeListId tabType _maybeLimit mhHash = do
listId <- case maybeListId of
Just lid -> pure lid
Nothing -> defaultList cId
@@ -84,7 +87,16 @@ getScatter cId maybeListId tabType _maybeLimit = do
Nothing -> do
updateScatter' cId maybeListId tabType Nothing
- pure $ constructHashedResponse chart
+ let r = constructHashedResponse chart
+
+ -- TODO send 304 if hashes equal, 200 with response otherwise
+ if mhHash == (Just $ hash r) then
+ throwError $ ServantErr { errHTTPCode = 304
+ , errReasonPhrase = "Hashes match"
+ , errBody = ""
+ , errHeaders = []}
+ else
+ pure $ addHeader (hash r) r
updateScatter :: FlowCmdM env err m =>
CorpusId
@@ -126,7 +138,8 @@ getScatterHash :: FlowCmdM env err m =>
-> TabType
-> m Text
getScatterHash cId maybeListId tabType = do
- hash <$> getScatter cId maybeListId tabType Nothing
+ r <- getScatter cId maybeListId tabType Nothing Nothing
+ pure $ hash $ getResponse r
-------------------------------------------------------------
diff --git a/src/Gargantext/API/Ngrams/List.hs b/src/Gargantext/API/Ngrams/List.hs
index 4bc0333b..d6fa1e97 100644
--- a/src/Gargantext/API/Ngrams/List.hs
+++ b/src/Gargantext/API/Ngrams/List.hs
@@ -56,8 +56,8 @@ instance ToJSON a => MimeRender HTML a where
------------------------------------------------------------------------
-get :: RepoCmdM env err m
- => ListId -> m (Headers '[Header "Content-Disposition" Text] NgramsList)
+get :: RepoCmdM env err m =>
+ ListId -> m (Headers '[Header "Content-Disposition" Text] NgramsList)
get lId = do
lst <- get' lId
let (NodeId id) = lId
@@ -108,17 +108,17 @@ postAsync' :: FlowCmdM env err m
postAsync' l (WithFile _ m _) logStatus = do
logStatus JobLog { _scst_succeeded = Just 0
- , _scst_failed = Just 0
- , _scst_remaining = Just 1
- , _scst_events = Just []
- }
+ , _scst_failed = Just 0
+ , _scst_remaining = Just 1
+ , _scst_events = Just []
+ }
_r <- post l m
pure JobLog { _scst_succeeded = Just 1
- , _scst_failed = Just 0
- , _scst_remaining = Just 0
- , _scst_events = Just []
- }
+ , _scst_failed = Just 0
+ , _scst_remaining = Just 0
+ , _scst_events = Just []
+ }
data WithFile = WithFile
{ _wf_filetype :: !FileType
--
2.21.0