src/Gargantext/API/Node/File.hs

   1 {-# OPTIONS_GHC -fno-warn-orphans -fno-warn-unused-matches #-}
   2
   3 {-# LANGUAGE AllowAmbiguousTypes     #-}
   4 {-# LANGUAGE TypeOperators     #-}
   5
   6 module Gargantext.API.Node.File where
   7
   8 import Control.Lens ((^.))
   9 import Data.Swagger
  10 import Data.Text
  11 import GHC.Generics (Generic)
  12 import Gargantext.API.Admin.Orchestrator.Types (JobLog(..), AsyncJobs)
  13 import Gargantext.API.Admin.Types (HasSettings)
  14 import Gargantext.API.Node.Types
  15 import Gargantext.API.Prelude
  16 import Gargantext.Core.Types (TODO)
  17 import Gargantext.Database.Action.Flow.Types
  18 import Gargantext.Database.Action.Node (mkNodeWithParent)
  19 import Gargantext.Database.Admin.Types.Hyperdata.File
  20 import Gargantext.Database.Admin.Types.Node
  21 import Gargantext.Database.Query.Table.Node (getNodeWith)
  22 import Gargantext.Database.Query.Table.Node.UpdateOpaleye (updateHyperdata)
  23 import Gargantext.Database.Schema.Node (node_hyperdata)
  24 import Gargantext.Prelude
  25 import Servant
  26 import Servant.Job.Async (JobFunction(..), serveJobsAPI)
  27 import qualified Data.ByteString as BS
  28 import qualified Data.ByteString.Lazy as BSL
  29 import qualified Data.MIME.Types as DMT
  30 import qualified Gargantext.Prelude.GargDB as GargDB
  31 import qualified Network.HTTP.Media as M
  32
  33 data RESPONSE deriving Typeable
  34
  35 instance Accept RESPONSE where
  36   contentType _ = "text" M.// "*"
  37
  38 instance MimeRender RESPONSE BSResponse where
  39   mimeRender _ (BSResponse val) = BSL.fromStrict $ val
  40
  41 type FileApi = Summary "File download"
  42             :> "download"
  43             :> Get '[RESPONSE] (Headers '[Servant.Header "Content-Type" Text] BSResponse)
  44
  45 fileApi :: UserId -> NodeId -> GargServer FileApi
  46 fileApi uId nId = fileDownload uId nId
  47
  48 newtype Contents = Contents BS.ByteString
  49
  50 instance GargDB.ReadFile Contents where
  51   readFile' fp = do
  52     c <- BS.readFile fp
  53     pure $ Contents c
  54
  55 newtype BSResponse = BSResponse BS.ByteString
  56   deriving (Generic)
  57
  58 instance ToSchema BSResponse  where
  59   declareNamedSchema _ = declareNamedSchema (Proxy :: Proxy TODO)
  60
  61 fileDownload :: (HasSettings env, FlowCmdM env err m)
  62              => UserId
  63              -> NodeId
  64              -> m (Headers '[Servant.Header "Content-Type" Text] BSResponse)
  65 fileDownload uId nId = do
  66   printDebug "[fileDownload] uId" uId
  67   printDebug "[fileDownload] nId" nId
  68
  69   node <- getNodeWith nId (Proxy :: Proxy HyperdataFile)
  70   let (HyperdataFile { _hff_name = name'
  71                      , _hff_path = path }) = node ^. node_hyperdata
  72
  73   Contents c <- GargDB.readFile $ unpack path
  74
  75   let (mMime, _) = DMT.guessType DMT.defaultmtd False $ unpack name'
  76       mime = case mMime of
  77         Just m  -> m
  78         Nothing -> "text/plain"
  79
  80   pure $ addHeader (pack mime) $ BSResponse c
  81
  82   --pure c
  83
  84   -- let settings = embeddedSettings [("", encodeUtf8 c)]
  85
  86   -- Tagged $ staticApp settings
  87
  88   -- let settings = embeddedSettings [("", "hello")]
  89   -- Tagged $ staticApp settings
  90
  91 type FileAsyncApi = Summary "File Async Api"
  92                  :> "file"
  93                  :> "add"
  94                  :> AsyncJobs JobLog '[FormUrlEncoded] NewWithFile JobLog
  95
  96 fileAsyncApi :: UserId -> NodeId -> GargServer FileAsyncApi
  97 fileAsyncApi uId nId =
  98   serveJobsAPI $
  99     JobFunction (\i l ->
 100       let
 101         log' x = do
 102           printDebug "addWithFile" x
 103           liftBase $ l x
 104       in addWithFile uId nId i log')
 105
 106
 107 addWithFile :: (HasSettings env, FlowCmdM env err m)
 108             => UserId
 109             -> NodeId
 110             -> NewWithFile
 111             -> (JobLog -> m ())
 112             -> m JobLog
 113 addWithFile uId nId nwf@(NewWithFile _d _l fName) logStatus = do
 114
 115   printDebug "[addWithFile] Uploading file: " nId
 116   logStatus JobLog { _scst_succeeded = Just 0
 117                    , _scst_failed    = Just 0
 118                    , _scst_remaining = Just 1
 119                    , _scst_events    = Just []
 120                    }
 121
 122   fPath <- GargDB.writeFile nwf
 123   printDebug "[addWithFile] File saved as: " fPath
 124
 125   nIds <- mkNodeWithParent NodeFile (Just nId) uId fName
 126
 127   _ <- case nIds of
 128     [nId'] -> do
 129         node <- getNodeWith nId' (Proxy :: Proxy HyperdataFile)
 130         let hl = node ^. node_hyperdata
 131         _ <- updateHyperdata nId' $ hl { _hff_name = fName
 132                                        , _hff_path = pack fPath }
 133
 134         printDebug "[addWithFile] Created node with id: " nId'
 135     _     -> pure ()
 136
 137   printDebug "[addWithFile] File upload finished: " nId
 138   pure $ JobLog { _scst_succeeded = Just 1
 139                 , _scst_failed    = Just 0
 140                 , _scst_remaining = Just 0
 141                 , _scst_events    = Just []
 142                 }