1 {-# LANGUAGE AllowAmbiguousTypes #-}
2 {-# LANGUAGE MonoLocalBinds #-}
3 {-# LANGUAGE TypeOperators #-}
5 module Gargantext.API.Node.FrameCalcUpload where
7 import Control.Lens ((^.))
9 import qualified Data.ByteString.Lazy as BSL
10 import qualified Data.ByteString.UTF8 as BSU8
12 import qualified Data.Text as T
13 import GHC.Generics (Generic)
14 import Network.HTTP.Client (newManager, httpLbs, parseRequest, responseBody)
15 import Network.HTTP.Client.TLS (tlsManagerSettings)
17 import Servant.Job.Async
18 import Web.FormUrlEncoded (FromForm)
20 import Gargantext.API.Admin.Orchestrator.Types (JobLog(..), AsyncJobs)
21 import Gargantext.API.Job (jobLogInit, jobLogSuccess, jobLogFail)
22 import Gargantext.API.Node.Corpus.New (addToCorpusWithForm)
23 import Gargantext.API.Node.Corpus.New.Types (FileFormat(..), FileType(..))
24 import Gargantext.API.Node.Types (NewWithForm(..))
25 import Gargantext.API.Prelude
26 import Gargantext.Core.Types.Individu (User(..))
27 import Gargantext.Database.Action.Flow.Types
28 import Gargantext.Database.Admin.Types.Hyperdata.Frame
29 import Gargantext.Database.Admin.Types.Node
30 import Gargantext.Database.Prelude (HasConfig)
31 import Gargantext.Database.Query.Table.Node (getClosestParentIdByType, getNodeWith)
32 import Gargantext.Database.Schema.Node (node_hyperdata)
33 import Gargantext.Prelude
35 data FrameCalcUpload = FrameCalcUpload ()
38 instance FromForm FrameCalcUpload
39 instance FromJSON FrameCalcUpload
40 instance ToJSON FrameCalcUpload
41 instance ToSchema FrameCalcUpload
43 type API = Summary " FrameCalc upload"
47 :> AsyncJobs JobLog '[JSON] FrameCalcUpload JobLog
49 api :: UserId -> NodeId -> GargServer API
52 JobFunction (\p logs ->
53 frameCalcUploadAsync uId nId p (liftBase . logs) (jobLogInit 5)
57 frameCalcUploadAsync :: (HasConfig env, FlowCmdM env err m)
64 frameCalcUploadAsync uId nId _f logStatus jobLog = do
67 -- printDebug "[frameCalcUploadAsync] uId" uId
68 -- printDebug "[frameCalcUploadAsync] nId" nId
70 node <- getNodeWith nId (Proxy :: Proxy HyperdataFrame)
71 let (HyperdataFrame { _hf_base = base
72 , _hf_frame_id = frame_id }) = node ^. node_hyperdata
74 let csvUrl = base <> "/" <> frame_id <> ".csv"
75 -- printDebug "[frameCalcUploadAsync] csvUrl" csvUrl
78 manager <- newManager tlsManagerSettings
79 req <- parseRequest $ T.unpack csvUrl
81 let body = T.pack $ BSU8.toString $ BSL.toStrict $ responseBody res
83 -- printDebug "body" body
84 mCId <- getClosestParentIdByType nId NodeCorpus
85 -- printDebug "[frameCalcUploadAsync] mCId" mCId
87 jobLog2 <- case mCId of
88 Nothing -> pure $ jobLogFail jobLog
90 addToCorpusWithForm (RootId (NodeId uId)) cId (NewWithForm CSV Plain body Nothing "calc-upload.csv") logStatus jobLog
92 pure $ jobLogSuccess jobLog2