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