]> Git — Sourcephile - gargantext.git/blob - src/Gargantext/API/Node/File.hs
[API] document upload endpoint
[gargantext.git] / 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 }