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