src/Gargantext/API/Node/File.hs

   1 {-# LANGUAGE AllowAmbiguousTypes     #-}
   2 {-# LANGUAGE TypeOperators     #-}
   3 {-# OPTIONS_GHC -fno-warn-orphans -fno-warn-unused-matches -fno-warn-unused-imports #-}
   4
   5 module Gargantext.API.Node.File where
   6
   7 import Control.Lens ((^.))
   8 import qualified Data.ByteString as BS
   9 import qualified Data.ByteString.Lazy as BSL
  10 import qualified Data.MIME.Types as DMT
  11 import Data.Monoid (mempty)
  12 import Data.Swagger
  13 import Data.Text
  14 import Data.Text.Encoding
  15 import qualified Data.Text.IO as TIO
  16 import GHC.Generics (Generic)
  17 import qualified Network.HTTP.Media as M
  18 import Network.Wai.Application.Static
  19 import Servant
  20 import Servant.API.Raw (Raw)
  21 import Servant.Server.Internal
  22
  23 import Gargantext.Prelude
  24 import qualified Gargantext.Prelude.Utils as GPU
  25
  26 import Gargantext.API.Admin.Settings (HasSettings)
  27 import Gargantext.API.Prelude
  28 import Gargantext.Database.Action.Flow.Types
  29 import Gargantext.Database.Admin.Types.Hyperdata.File
  30 import Gargantext.Database.Admin.Types.Node
  31 import Gargantext.Database.Query.Table.Node (getNodeWith)
  32 import Gargantext.Database.Schema.Node (node_hyperdata)
  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 GPU.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 BSResponse)
  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 <- GPU.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