Commit a317c4d9 authored by Przemyslaw Kaminski's avatar Przemyslaw Kaminski

[ngrams] fixes for list JSON import

parent 84c2a44a
...@@ -173,7 +173,7 @@ type ForgotPasswordAPI = Summary "Forgot password POST API" ...@@ -173,7 +173,7 @@ type ForgotPasswordAPI = Summary "Forgot password POST API"
:> QueryParam "uuid" Text :> QueryParam "uuid" Text
:> Get '[JSON] ForgotPasswordGet :> Get '[JSON] ForgotPasswordGet
forgotPassword :: GargServer ForgotPasswordAPI forgotPassword :: GargServer ForgotPasswordAPI
-- => ForgotPasswordRequest -> Cmd' env err ForgotPasswordResponse -- => ForgotPasswordRequest -> Cmd' env err ForgotPasswordResponse
forgotPassword = forgotPasswordPost :<|> forgotPasswordGet forgotPassword = forgotPasswordPost :<|> forgotPasswordGet
...@@ -211,18 +211,18 @@ forgotPasswordGetUser :: (HasSettings env, HasConnectionPool env, HasJoseError e ...@@ -211,18 +211,18 @@ forgotPasswordGetUser :: (HasSettings env, HasConnectionPool env, HasJoseError e
forgotPasswordGetUser (UserLight { .. }) = do forgotPasswordGetUser (UserLight { .. }) = do
-- pick some random password -- pick some random password
password <- liftBase gargPass password <- liftBase gargPass
-- set it as user's password -- set it as user's password
hashed <- liftBase $ Auth.hashPassword $ Auth.mkPassword password hashed <- liftBase $ Auth.hashPassword $ Auth.mkPassword password
let hashed' = Auth.unPasswordHash hashed let hashed' = Auth.unPasswordHash hashed
let userPassword = UserLight { userLight_password = GargPassword hashed', .. } let userPassword = UserLight { userLight_password = GargPassword hashed', .. }
_ <- updateUserPassword userPassword _ <- updateUserPassword userPassword
-- display this briefly in the html -- display this briefly in the html
-- clear the uuid so that the page can't be refreshed -- clear the uuid so that the page can't be refreshed
_ <- updateUserForgotPasswordUUID $ UserLight { userLight_forgot_password_uuid = Nothing, .. } _ <- updateUserForgotPasswordUUID $ UserLight { userLight_forgot_password_uuid = Nothing, .. }
pure $ ForgotPasswordGet password pure $ ForgotPasswordGet password
forgotUserPassword :: (HasConnectionPool env, HasConfig env, HasMail env) forgotUserPassword :: (HasConnectionPool env, HasConfig env, HasMail env)
......
...@@ -82,10 +82,10 @@ type JSONAPI = Summary "Update List" ...@@ -82,10 +82,10 @@ type JSONAPI = Summary "Update List"
:> "add" :> "add"
:> "form" :> "form"
:> "async" :> "async"
:> AsyncJobs JobLog '[FormUrlEncoded] WithFile JobLog :> AsyncJobs JobLog '[FormUrlEncoded] WithJsonFile JobLog
jsonApi :: ServerT JSONAPI (GargM Env GargError) jsonApi :: ServerT JSONAPI (GargM Env GargError)
jsonApi = postAsync jsonApi = jsonPostAsync
---------------------- ----------------------
type CSVAPI = Summary "Update List (legacy v3 CSV)" type CSVAPI = Summary "Update List (legacy v3 CSV)"
...@@ -203,14 +203,8 @@ toIndexedNgrams m t = Indexed <$> i <*> n ...@@ -203,14 +203,8 @@ toIndexedNgrams m t = Indexed <$> i <*> n
n = Just (text2ngrams t) n = Just (text2ngrams t)
------------------------------------------------------------------------ ------------------------------------------------------------------------
type PostAPI = Summary "Update List" jsonPostAsync :: ServerT JSONAPI (GargM Env GargError)
:> "add" jsonPostAsync lId =
:> "form"
:> "async"
:> AsyncJobs JobLog '[FormUrlEncoded] WithFile JobLog
postAsync :: ListId -> ServerT PostAPI (GargM Env GargError)
postAsync lId =
serveJobsAPI UpdateNgramsListJobJSON $ \f log' -> serveJobsAPI UpdateNgramsListJobJSON $ \f log' ->
let let
log'' x = do log'' x = do
...@@ -220,10 +214,10 @@ postAsync lId = ...@@ -220,10 +214,10 @@ postAsync lId =
postAsync' :: FlowCmdM env err m postAsync' :: FlowCmdM env err m
=> ListId => ListId
-> WithFile -> WithJsonFile
-> (JobLog -> m ()) -> (JobLog -> m ())
-> m JobLog -> m JobLog
postAsync' l (WithFile _ m _) logStatus = do postAsync' l (WithJsonFile m _) logStatus = do
logStatus JobLog { _scst_succeeded = Just 0 logStatus JobLog { _scst_succeeded = Just 0
, _scst_failed = Just 0 , _scst_failed = Just 0
...@@ -235,10 +229,10 @@ postAsync' l (WithFile _ m _) logStatus = do ...@@ -235,10 +229,10 @@ postAsync' l (WithFile _ m _) logStatus = do
-- printDebug "Done" r -- printDebug "Done" r
logStatus JobLog { _scst_succeeded = Just 1 logStatus JobLog { _scst_succeeded = Just 1
, _scst_failed = Just 0 , _scst_failed = Just 0
, _scst_remaining = Just 1 , _scst_remaining = Just 1
, _scst_events = Just [] , _scst_events = Just []
} }
corpus_node <- getNode l -- (Proxy :: Proxy HyperdataList) corpus_node <- getNode l -- (Proxy :: Proxy HyperdataList)
...@@ -253,12 +247,6 @@ postAsync' l (WithFile _ m _) logStatus = do ...@@ -253,12 +247,6 @@ postAsync' l (WithFile _ m _) logStatus = do
------------------------------------------------------------------------ ------------------------------------------------------------------------
type CSVPostAPI = Summary "Update List (legacy v3 CSV)"
:> "csv"
:> "add"
:> "form"
:> "async"
:> AsyncJobs JobLog '[FormUrlEncoded] WithFile JobLog
readCsvText :: Text -> [(Text, Text, Text)] readCsvText :: Text -> [(Text, Text, Text)]
readCsvText t = case eDec of readCsvText t = case eDec of
......
...@@ -18,10 +18,12 @@ module Gargantext.API.Ngrams.List.Types where ...@@ -18,10 +18,12 @@ module Gargantext.API.Ngrams.List.Types where
--import Control.Lens hiding (elements, Indexed) --import Control.Lens hiding (elements, Indexed)
import Data.Aeson import Data.Aeson
import qualified Data.ByteString.Lazy as BSL
import Data.Swagger (ToSchema, declareNamedSchema, genericDeclareNamedSchema) import Data.Swagger (ToSchema, declareNamedSchema, genericDeclareNamedSchema)
import Data.Text import Data.Text
import qualified Data.Text.Encoding as E
import Servant.Job.Utils (jsonOptions) import Servant.Job.Utils (jsonOptions)
import Web.FormUrlEncoded (FromForm, ToForm) import Web.FormUrlEncoded (FromForm(..), ToForm, parseUnique)
import Protolude import Protolude
...@@ -29,7 +31,7 @@ import Gargantext.API.Ngrams.Types (NgramsList) ...@@ -29,7 +31,7 @@ import Gargantext.API.Ngrams.Types (NgramsList)
import Gargantext.API.Node.Corpus.New.Types (FileType(..)) import Gargantext.API.Node.Corpus.New.Types (FileType(..))
import Gargantext.Core.Utils.Prefix (unPrefixSwagger) import Gargantext.Core.Utils.Prefix (unPrefixSwagger)
------------------------------------------------------------------------
data WithFile = WithFile data WithFile = WithFile
{ _wf_filetype :: !FileType { _wf_filetype :: !FileType
...@@ -38,7 +40,7 @@ data WithFile = WithFile ...@@ -38,7 +40,7 @@ data WithFile = WithFile
} deriving (Eq, Show, Generic) } deriving (Eq, Show, Generic)
--makeLenses ''WithFile --makeLenses ''WithFile
instance FromForm WithFile instance FromForm WithFile where
instance ToForm WithFile instance ToForm WithFile
instance FromJSON WithFile where instance FromJSON WithFile where
parseJSON = genericParseJSON $ jsonOptions "_wf_" parseJSON = genericParseJSON $ jsonOptions "_wf_"
...@@ -47,6 +49,30 @@ instance ToJSON WithFile where ...@@ -47,6 +49,30 @@ instance ToJSON WithFile where
instance ToSchema WithFile where instance ToSchema WithFile where
declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_wf_") declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_wf_")
------------------------------------------------------------------------
data WithJsonFile = WithJsonFile
{ _wjf_data :: !NgramsList
, _wjf_name :: !Text
} deriving (Eq, Show, Generic)
instance FromForm WithJsonFile where
fromForm f = do
d' <- parseUnique "_wjf_data" f
d <- case eitherDecode' (BSL.fromStrict $ E.encodeUtf8 d') of
Left s -> Left $ pack s
Right v -> Right v
n <- parseUnique "_wjf_name" f
pure $ WithJsonFile { _wjf_data = d
, _wjf_name = n }
instance ToForm WithJsonFile
instance FromJSON WithJsonFile where
parseJSON = genericParseJSON $ jsonOptions "_wjf_"
instance ToJSON WithJsonFile where
toJSON = genericToJSON $ jsonOptions "_wjf_"
instance ToSchema WithJsonFile where
declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_wjf_")
------------------------------------------------------------------------ ------------------------------------------------------------------------
...@@ -65,4 +91,3 @@ instance ToJSON WithTextFile where ...@@ -65,4 +91,3 @@ instance ToJSON WithTextFile where
toJSON = genericToJSON $ jsonOptions "_wtf_" toJSON = genericToJSON $ jsonOptions "_wtf_"
instance ToSchema WithTextFile where instance ToSchema WithTextFile where
declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_wtf_") declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_wtf_")
...@@ -88,4 +88,3 @@ addToAnnuaireWithForm _cid (AnnuaireWithForm { _wf_filetype }) logStatus = do ...@@ -88,4 +88,3 @@ addToAnnuaireWithForm _cid (AnnuaireWithForm { _wf_filetype }) logStatus = do
, _scst_remaining = Just 0 , _scst_remaining = Just 0
, _scst_events = Just [] , _scst_events = Just []
} }
...@@ -175,7 +175,7 @@ triggerSearxSearch user cId q l logStatus = do ...@@ -175,7 +175,7 @@ triggerSearxSearch user cId q l logStatus = do
listId <- getOrMkList cId uId listId <- getOrMkList cId uId
pure listId pure listId
Just listId -> pure listId Just listId -> pure listId
printDebug "[triggerSearxSearch] listId" listId printDebug "[triggerSearxSearch] listId" listId
manager <- liftBase $ newManager tlsManagerSettings manager <- liftBase $ newManager tlsManagerSettings
...@@ -220,4 +220,3 @@ hyperdataDocumentFromSearxResult l (SearxResult { _sr_content, _sr_engine, _sr_p ...@@ -220,4 +220,3 @@ hyperdataDocumentFromSearxResult l (SearxResult { _sr_content, _sr_engine, _sr_p
, _hd_publication_minute = Nothing , _hd_publication_minute = Nothing
, _hd_publication_second = Nothing , _hd_publication_second = Nothing
, _hd_language_iso2 = Just $ T.pack $ show l } , _hd_language_iso2 = Just $ T.pack $ show l }
...@@ -271,7 +271,7 @@ instance FromJSON UpdateNodeParams where ...@@ -271,7 +271,7 @@ instance FromJSON UpdateNodeParams where
instance ToJSON UpdateNodeParams where instance ToJSON UpdateNodeParams where
toJSON = genericToJSON (defaultOptions { sumEncoding = GUA.defaultTaggedObject }) toJSON = genericToJSON (defaultOptions { sumEncoding = GUA.defaultTaggedObject })
instance ToSchema UpdateNodeParams instance ToSchema UpdateNodeParams
instance Arbitrary UpdateNodeParams where instance Arbitrary UpdateNodeParams where
arbitrary = do arbitrary = do
......
...@@ -89,11 +89,12 @@ data NgramsType = Authors | Institutes | Sources | NgramsTerms ...@@ -89,11 +89,12 @@ data NgramsType = Authors | Institutes | Sources | NgramsTerms
instance Serialise NgramsType instance Serialise NgramsType
instance FromJSON NgramsType instance FromJSON NgramsType
where where
parseJSON (String "Authors") = pure Authors parseJSON (String "Authors") = pure Authors
parseJSON (String "Institutes") = pure Institutes parseJSON (String "Institutes") = pure Institutes
parseJSON (String "Sources") = pure Sources parseJSON (String "Sources") = pure Sources
parseJSON (String "Terms") = pure NgramsTerms parseJSON (String "Terms") = pure NgramsTerms
parseJSON _ = mzero parseJSON (String "NgramsTerms") = pure NgramsTerms
parseJSON _ = mzero
instance FromJSONKey NgramsType where instance FromJSONKey NgramsType where
fromJSONKey = FromJSONKeyTextParser (parseJSON . String) fromJSONKey = FromJSONKeyTextParser (parseJSON . String)
......
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