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