{-| Module : Gargantext.API.Node.File Description : Copyright : (c) CNRS, 2017 License : AGPL + CECILL v3 Maintainer : team@gargantext.org Stability : experimental Portability : POSIX -} {-# OPTIONS_GHC -fno-warn-orphans -fno-warn-unused-matches #-} {-# LANGUAGE AllowAmbiguousTypes #-} {-# LANGUAGE TypeOperators #-} {-# LANGUAGE IncoherentInstances #-} module Gargantext.API.Node.File where import Data.MIME.Types qualified as DMT import Data.Text qualified as T import Gargantext.API.Admin.Auth.Types ( AuthenticatedUser, auth_user_id ) import Gargantext.API.Admin.EnvTypes (GargJob(..), Env) import Gargantext.API.Admin.Orchestrator.Types (AsyncJobs(..)) import Gargantext.API.Admin.Types (HasSettings) import Gargantext.API.Errors.Types ( BackendInternalError ) import Gargantext.API.Node.File.Types import Gargantext.API.Node.Types ( NewWithFile(NewWithFile) ) import Gargantext.API.Prelude ( GargM ) import Gargantext.API.Routes.Named.File qualified as Named import Gargantext.Database.Action.Flow.Types ( FlowCmdM ) import Gargantext.Database.Action.Node (mkNodeWithParent) import Gargantext.Database.Admin.Types.Hyperdata.File ( HyperdataFile(..) ) import Gargantext.Database.Admin.Types.Node ( NodeId, NodeType(..) ) import Gargantext.Database.GargDB qualified as GargDB import Gargantext.Database.Query.Table.Node (getNodeWith) import Gargantext.Database.Query.Table.Node.UpdateOpaleye (updateHyperdata) import Gargantext.Database.Schema.Node (node_hyperdata) import Gargantext.Prelude import Gargantext.Utils.Jobs (serveJobsAPI, MonadJobStatus(..)) import Servant import Servant.Server.Generic (AsServerT) fileApi :: (HasSettings env, FlowCmdM env err m) => NodeId -> m (Headers '[Servant.Header "Content-Type" Text] BSResponse) fileApi nId = fileDownload nId fileDownload :: (HasSettings env, FlowCmdM env err m) => NodeId -> m (Headers '[Servant.Header "Content-Type" Text] BSResponse) fileDownload nId = do -- printDebug "[fileDownload] uId" uId -- printDebug "[fileDownload] nId" nId node <- getNodeWith nId (Proxy :: Proxy HyperdataFile) let (HyperdataFile { _hff_name = name' , _hff_path = path }) = node ^. node_hyperdata Contents c <- GargDB.readGargFile $ T.unpack path let (mMime, _) = DMT.guessType DMT.defaultmtd False $ T.unpack name' mime = case mMime of Just m -> m Nothing -> "text/plain" pure $ addHeader (T.pack mime) $ BSResponse c --pure c -- let settings = embeddedSettings [("", encodeUtf8 c)] -- Tagged $ staticApp settings -- let settings = embeddedSettings [("", "hello")] -- Tagged $ staticApp settings fileAsyncApi :: AuthenticatedUser -- ^ The logged-in user -> NodeId -> Named.FileAsyncAPI (AsServerT (GargM Env BackendInternalError)) fileAsyncApi authenticatedUser nId = Named.FileAsyncAPI $ AsyncJobs $ serveJobsAPI AddFileJob $ \jHandle i -> addWithFile authenticatedUser nId i jHandle addWithFile :: (HasSettings env, FlowCmdM env err m, MonadJobStatus m) => AuthenticatedUser -- ^ The logged-in user -> NodeId -> NewWithFile -> JobHandle m -> m () addWithFile authenticatedUser nId nwf@(NewWithFile _d _l fName) jobHandle = do -- printDebug "[addWithFile] Uploading file: " nId markStarted 1 jobHandle fPath <- GargDB.writeFile nwf -- printDebug "[addWithFile] File saved as: " fPath nIds <- mkNodeWithParent NodeFile (Just nId) userId fName _ <- case nIds of [nId'] -> do node <- getNodeWith nId' (Proxy :: Proxy HyperdataFile) let hl = node ^. node_hyperdata _ <- updateHyperdata nId' $ hl { _hff_name = fName , _hff_path = T.pack fPath } -- printDebug "[addWithFile] Created node with id: " nId' pure () _ -> pure () -- printDebug "[addWithFile] File upload finished: " nId markComplete jobHandle where userId = authenticatedUser ^. auth_user_id