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