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