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