{-| Module : Gargantext.API.Node.FrameCalcUpload Description : Copyright : (c) CNRS, 2017-Present License : AGPL + CECILL v3 Maintainer : team@gargantext.org Stability : experimental Portability : POSIX -} {-# LANGUAGE AllowAmbiguousTypes #-} {-# LANGUAGE MonoLocalBinds #-} {-# LANGUAGE TypeOperators #-} module Gargantext.API.Node.FrameCalcUpload where import Data.ByteString.Lazy qualified as BSL import Data.ByteString.UTF8 qualified as BSU8 import Data.Text qualified as T import Gargantext.API.Admin.Auth.Types ( auth_node_id, AuthenticatedUser ) import Gargantext.API.Admin.EnvTypes (GargJob(..), Env) import Gargantext.API.Admin.Orchestrator.Types (AsyncJobs(..)) import Gargantext.API.Errors.Types ( BackendInternalError ) import Gargantext.API.Node.Corpus.New (addToCorpusWithForm) import Gargantext.API.Node.Corpus.New.Types (FileFormat(..), FileType(..)) import Gargantext.API.Node.FrameCalcUpload.Types import Gargantext.API.Node.Types (NewWithForm(..)) import Gargantext.API.Prelude ( GargM ) import Gargantext.API.Routes.Named.FrameCalc qualified as Named import Gargantext.Core.NodeStory.Types ( HasNodeArchiveStoryImmediateSaver ) import Gargantext.Core.Types.Individu (User(..)) import Gargantext.Database.Action.Flow.Types ( FlowCmdM ) import Gargantext.Database.Admin.Types.Hyperdata.Frame ( HyperdataFrame(..) ) import Gargantext.Database.Admin.Types.Node ( NodeId, NodeType(NodeCorpus) ) import Gargantext.Database.Prelude (HasConfig) import Gargantext.Database.Query.Table.Node (getClosestParentIdByType, getNodeWith) import Gargantext.Database.Schema.Node (node_hyperdata) import Gargantext.Prelude import Gargantext.Utils.Jobs (serveJobsAPI, MonadJobStatus(..), markFailureNoErr) import Network.HTTP.Client (newManager, httpLbs, parseRequest, responseBody) import Network.HTTP.Client.TLS (tlsManagerSettings) import Servant.Server.Generic (AsServerT) api :: AuthenticatedUser -> NodeId -> Named.FrameCalcAPI (AsServerT (GargM Env BackendInternalError)) api authenticatedUser nId = Named.FrameCalcAPI $ AsyncJobs $ serveJobsAPI UploadFrameCalcJob $ \jHandle p -> frameCalcUploadAsync authenticatedUser nId p jHandle frameCalcUploadAsync :: ( HasConfig env , FlowCmdM env err m , MonadJobStatus m , HasNodeArchiveStoryImmediateSaver env ) => AuthenticatedUser -- ^ The logged-in user -> NodeId -> FrameCalcUpload -> JobHandle m -> m () frameCalcUploadAsync authenticatedUser nId (FrameCalcUpload _wf_lang _wf_selection) jobHandle = do markStarted 5 jobHandle -- printDebug "[frameCalcUploadAsync] uId" uId -- printDebug "[frameCalcUploadAsync] nId" nId node <- getNodeWith nId (Proxy :: Proxy HyperdataFrame) let (HyperdataFrame { _hf_base = base , _hf_frame_id = frame_id }) = node ^. node_hyperdata let csvUrl = base <> "/" <> frame_id <> ".csv" -- printDebug "[frameCalcUploadAsync] csvUrl" csvUrl res <- liftBase $ do manager <- newManager tlsManagerSettings req <- parseRequest $ T.unpack csvUrl httpLbs req manager let body = T.pack $ BSU8.toString $ BSL.toStrict $ responseBody res -- printDebug "body" body mCId <- getClosestParentIdByType nId NodeCorpus -- printDebug "[frameCalcUploadAsync] mCId" mCId case mCId of Nothing -> markFailureNoErr 1 jobHandle Just cId -> -- FIXME(adn) Audit this conversion. addToCorpusWithForm (RootId userNodeId) cId (NewWithForm { _wf_filetype = CSV , _wf_fileformat = Plain , _wf_data = body , _wf_lang , _wf_name = "calc-upload.csv" , _wf_selection }) jobHandle markComplete jobHandle where userNodeId = authenticatedUser ^. auth_node_id