src/Gargantext/API/Node/FrameCalcUpload.hs

   1 {-# LANGUAGE AllowAmbiguousTypes #-}
   2 {-# LANGUAGE MonoLocalBinds      #-}
   3 {-# LANGUAGE TypeOperators       #-}
   4
   5 module Gargantext.API.Node.FrameCalcUpload where
   6
   7 import Control.Lens ((^.))
   8 import Data.Aeson
   9 import qualified Data.ByteString.Lazy as BSL
  10 import qualified Data.ByteString.UTF8 as BSU8
  11 import Data.Swagger
  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)
  16 import Servant
  17 import Servant.Job.Async
  18 import Web.FormUrlEncoded (FromForm)
  19
  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.File (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.Query.Table.Node (getClosestParentIdByType, getNodeWith)
  31 import Gargantext.Database.Schema.Node (node_hyperdata)
  32 import Gargantext.Prelude
  33
  34 data FrameCalcUpload = FrameCalcUpload ()
  35   deriving (Generic)
  36
  37 instance FromForm FrameCalcUpload
  38 instance FromJSON FrameCalcUpload
  39 instance ToJSON FrameCalcUpload
  40 instance ToSchema FrameCalcUpload
  41
  42 type FrameCalcUploadAPI = Summary " FrameCalc upload"
  43                         :> "add"
  44                         :> "framecalc"
  45                         :> "async"
  46                         :> AsyncJobs JobLog '[JSON] FrameCalcUpload JobLog
  47
  48 frameCalcUploadAPI :: UserId -> NodeId -> GargServer FrameCalcUploadAPI
  49 frameCalcUploadAPI uId nId =
  50   serveJobsAPI $
  51     JobFunction (\p logs ->
  52                    frameCalcUploadAsync uId nId p (liftBase . logs) (jobLogInit 5)
  53                 )
  54
  55
  56 frameCalcUploadAsync :: FlowCmdM env err m
  57                      => UserId
  58                      -> NodeId
  59                      -> FrameCalcUpload
  60                      -> (JobLog -> m ())
  61                      -> JobLog
  62                      -> m JobLog
  63 frameCalcUploadAsync uId nId _f logStatus jobLog = do
  64   logStatus jobLog
  65
  66   -- printDebug "[frameCalcUploadAsync] uId" uId
  67   -- printDebug "[frameCalcUploadAsync] nId" nId
  68
  69   node <- getNodeWith nId (Proxy :: Proxy HyperdataFrame)
  70   let (HyperdataFrame { _hf_base = base
  71                       , _hf_frame_id = frame_id }) = node ^. node_hyperdata
  72
  73   let csvUrl = base <> "/" <> frame_id <> ".csv"
  74   -- printDebug "[frameCalcUploadAsync] csvUrl" csvUrl
  75
  76   res <- liftBase $ do
  77     manager <- newManager tlsManagerSettings
  78     req <- parseRequest $ T.unpack csvUrl
  79     httpLbs req manager
  80   let body = T.pack $ BSU8.toString $ BSL.toStrict $ responseBody res
  81
  82   mCId <- getClosestParentIdByType nId NodeCorpus
  83   -- printDebug "[frameCalcUploadAsync] mCId" mCId
  84
  85   jobLog2 <- case mCId of
  86     Nothing -> pure $ jobLogFail jobLog
  87     Just cId ->
  88       addToCorpusWithForm (RootId (NodeId uId)) cId (NewWithForm CSV body Nothing "calc-upload.csv") logStatus jobLog
  89
  90   pure $ jobLogSuccess jobLog2