Commit 6421aac1 authored by Przemyslaw Kaminski's avatar Przemyslaw Kaminski

[nodeStory] implement history in the DB

parent 1b2ff615
Pipeline #3039 failed with stage
in 60 minutes and 39 seconds
...@@ -117,9 +117,9 @@ makeMockApp env = do ...@@ -117,9 +117,9 @@ makeMockApp env = do
blocking <- fireWall req (env ^. menv_firewall) blocking <- fireWall req (env ^. menv_firewall)
case blocking of case blocking of
True -> app req resp True -> app req resp
False -> resp ( responseLBS status401 [] False -> resp ( responseLBS status401 []
"Invalid Origin or Host header") "Invalid Origin or Host header")
let corsMiddleware = cors $ \_ -> Just CorsResourcePolicy let corsMiddleware = cors $ \_ -> Just CorsResourcePolicy
-- { corsOrigins = Just ([env^.settings.allowedOrigin], False) -- { corsOrigins = Just ([env^.settings.allowedOrigin], False)
{ corsOrigins = Nothing -- == /* { corsOrigins = Nothing -- == /*
...@@ -135,7 +135,7 @@ makeMockApp env = do ...@@ -135,7 +135,7 @@ makeMockApp env = do
--let warpS = Warp.setPort (8008 :: Int) -- (env^.settings.appPort) --let warpS = Warp.setPort (8008 :: Int) -- (env^.settings.appPort)
-- $ Warp.defaultSettings -- $ Warp.defaultSettings
--pure (warpS, logWare $ checkOriginAndHost $ corsMiddleware $ serverApp) --pure (warpS, logWare $ checkOriginAndHost $ corsMiddleware $ serverApp)
pure $ logStdoutDev $ checkOriginAndHost $ corsMiddleware $ serverApp pure $ logStdoutDev $ checkOriginAndHost $ corsMiddleware $ serverApp
-} -}
...@@ -149,7 +149,7 @@ makeDevMiddleware mode = do ...@@ -149,7 +149,7 @@ makeDevMiddleware mode = do
-- blocking <- fireWall req (env ^. menv_firewall) -- blocking <- fireWall req (env ^. menv_firewall)
-- case blocking of -- case blocking of
-- True -> app req resp -- True -> app req resp
-- False -> resp ( responseLBS status401 [] -- False -> resp ( responseLBS status401 []
-- "Invalid Origin or Host header") -- "Invalid Origin or Host header")
-- --
let corsMiddleware = cors $ \_ -> Just CorsResourcePolicy let corsMiddleware = cors $ \_ -> Just CorsResourcePolicy
......
...@@ -11,7 +11,7 @@ Ngrams API ...@@ -11,7 +11,7 @@ Ngrams API
-- | TODO -- | TODO
get ngrams filtered by NgramsType get ngrams filtered by NgramsType
add get add get
-} -}
...@@ -284,13 +284,16 @@ commitStatePatch :: (HasNodeStory env err m, HasMail env) ...@@ -284,13 +284,16 @@ commitStatePatch :: (HasNodeStory env err m, HasMail env)
=> ListId => ListId
-> Versioned NgramsStatePatch' -> Versioned NgramsStatePatch'
-> m (Versioned NgramsStatePatch') -> m (Versioned NgramsStatePatch')
commitStatePatch listId (Versioned p_version p) = do commitStatePatch listId (Versioned _p_version p) = do
-- printDebug "[commitStatePatch]" listId -- printDebug "[commitStatePatch]" listId
var <- getNodeStoryVar [listId] var <- getNodeStoryVar [listId]
vq' <- liftBase $ modifyMVar var $ \ns -> do vq' <- liftBase $ modifyMVar var $ \ns -> do
let let
a = ns ^. unNodeStory . at listId . _Just a = ns ^. unNodeStory . at listId . _Just
q = mconcat $ take (a ^. a_version - p_version) (a ^. a_history) -- apply patches from version p_version to a ^. a_version
-- TODO Check this
--q = mconcat $ take (a ^. a_version - p_version) (a ^. a_history)
q = mconcat $ a ^. a_history
(p', q') = transformWith ngramsStatePatchConflictResolution p q (p', q') = transformWith ngramsStatePatchConflictResolution p q
a' = a & a_version +~ 1 a' = a & a_version +~ 1
& a_state %~ act p' & a_state %~ act p'
...@@ -810,5 +813,3 @@ listNgramsChangedSince listId ngramsType version ...@@ -810,5 +813,3 @@ listNgramsChangedSince listId ngramsType version
Versioned <$> currentVersion listId <*> pure True Versioned <$> currentVersion listId <*> pure True
| otherwise = | otherwise =
tableNgramsPull listId ngramsType version & mapped . v_data %~ (== mempty) tableNgramsPull listId ngramsType version & mapped . v_data %~ (== mempty)
...@@ -28,7 +28,8 @@ import Data.String (IsString, fromString) ...@@ -28,7 +28,8 @@ import Data.String (IsString, fromString)
import Data.Swagger hiding (version, patch) import Data.Swagger hiding (version, patch)
import Data.Text (Text, pack, strip) import Data.Text (Text, pack, strip)
import Data.Validity import Data.Validity
import Database.PostgreSQL.Simple.FromField (FromField, fromField, ResultError(ConversionFailed), returnError) import Database.PostgreSQL.Simple.FromField (FromField, fromField, fromJSONField, ResultError(ConversionFailed), returnError)
import Database.PostgreSQL.Simple.ToField (ToField, toJSONField, toField)
import GHC.Generics (Generic) import GHC.Generics (Generic)
import Gargantext.Core.Text (size) import Gargantext.Core.Text (size)
import Gargantext.Core.Types (ListType(..), ListId, NodeId, TODO) import Gargantext.Core.Types (ListType(..), ListId, NodeId, TODO)
...@@ -524,7 +525,11 @@ instance Serialise (PatchMap NgramsTerm NgramsPatch) ...@@ -524,7 +525,11 @@ instance Serialise (PatchMap NgramsTerm NgramsPatch)
instance FromField NgramsTablePatch instance FromField NgramsTablePatch
where where
fromField = fromField' fromField = fromJSONField
--fromField = fromField'
instance ToField NgramsTablePatch
where
toField = toJSONField
instance FromField (PatchMap TableNgrams.NgramsType (PatchMap NodeId NgramsTablePatch)) instance FromField (PatchMap TableNgrams.NgramsType (PatchMap NodeId NgramsTablePatch))
where where
......
This diff is collapsed.
...@@ -68,5 +68,3 @@ history' types lists = (Map.map (Map.unionsWith (<>))) ...@@ -68,5 +68,3 @@ history' types lists = (Map.map (Map.unionsWith (<>)))
-> Map NgramsType [HashMap NgramsTerm NgramsPatch] -> Map NgramsType [HashMap NgramsTerm NgramsPatch]
toMap m = Map.map (cons . unNgramsTablePatch) toMap m = Map.map (cons . unNgramsTablePatch)
$ unPatchMapToMap m $ unPatchMapToMap m
...@@ -210,4 +210,3 @@ putListNgrams nodeId ngramsType nes = putListNgrams' nodeId ngramsType m ...@@ -210,4 +210,3 @@ putListNgrams nodeId ngramsType nes = putListNgrams' nodeId ngramsType m
& unNodeStory . at listId . _Just . a_history %~ (p :) & unNodeStory . at listId . _Just . a_history %~ (p :)
& unNodeStory . at listId . _Just . a_state . at ngramsType' .~ Just ns & unNodeStory . at listId . _Just . a_state . at ngramsType' .~ Just ns
saveNodeStory saveNodeStory
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