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