@@ -72,6 +72,7 @@ app req send =
72
72
[" data" , " upload" , id ] -> upload req send
73
73
[" data" , " download" ] -> download req send
74
74
[" data" , " delete" , id ] -> delete req send
75
+ [" data" ," preview" ,id ] -> preview req send
75
76
[" data" , " health" ] -> health req send
76
77
-- anything else: 404
77
78
missingEndpoint ->
@@ -237,8 +238,63 @@ getApi allHeaders param restUrl = runReq (defaultHttpConfig {httpConfigCheckResp
237
238
bsResponse -- specify how to interpret response
238
239
(header " X-FF-IDS" (getOneHeader allHeaders " X-FF-IDS" ) <> header " Cookie" (getOneHeader allHeaders " Cookie" ) <> port 8080 <> (=:) " ids" param) -- PORT !!
239
240
-- mempty -- query params, headers, explicit port number, etc.
241
+ liftIO $ logStdOut $ show (getOneHeader allHeaders " Cookie" )
240
242
return (responseBody r, responseStatusCode r, responseStatusMessage r, responseHeader r " X-FF-NAME" )
241
243
244
+
245
+
246
+ preview :: Application
247
+ preview req send = do
248
+ let headers = requestHeaders req
249
+ id = pathInfo req !! 2
250
+ restUrl <- getRestUrl
251
+ (responseBody, responseStatusCode, responseStatusMessage) <- previewApi headers id restUrl
252
+ case responseStatusCode of
253
+ 200 -> do
254
+ let decoded = (eitherDecode $ L. fromStrict responseBody) :: (Either String RestResponseFile )
255
+ case decoded of
256
+ Left err ->
257
+ send $
258
+ responseLBS
259
+ HttpTypes. status500
260
+ [(" Content-Type" , " application/json; charset=utf-8" )]
261
+ (encode $ RestApiStatus err " Internal Server Error" )
262
+ Right file -> do
263
+ let fileID = fileSystemId file
264
+ fileMimeType = fromMaybe " application/octet-stream" (mimeType file)
265
+ path = getPathFromFileId $ show fileID
266
+ send $
267
+ responseFile
268
+ HttpTypes. status200
269
+ [ (" Content-Type" , S8. pack fileMimeType)
270
+ ]
271
+ path
272
+ Nothing
273
+ _ ->
274
+ send $
275
+ responseLBS
276
+ (HttpTypes. mkStatus responseStatusCode responseStatusMessage)
277
+ [(" Content-Type" , " application/json; charset=utf-8" )]
278
+ (L. fromStrict responseBody)
279
+
280
+
281
+
282
+
283
+ previewApi :: [HttpTypes. Header ] -> DataText. Text -> String -> IO (S8. ByteString , Int , S8. ByteString )
284
+ previewApi allHeaders id restUrl = runReq (defaultHttpConfig {httpConfigCheckResponse = httpConfigDontCheckResponse}) $ do
285
+ r <-
286
+ req
287
+ GET -- method
288
+ (http (DataText. pack restUrl) /: " api" /: " v1" /: " filesystem" /: id /: " info" ) -- safe by construction URL
289
+ -- (http (DataText.pack restUrl) /: "v1" /: "filesystem" /: id /: "info" ) -- safe by construction URL
290
+ NoReqBody -- use built-in options or add your own
291
+ bsResponse -- specify how to interpret response
292
+ (header " Cookie" (getOneHeader allHeaders " Cookie" ) <> port 8080 ) -- PORT !!
293
+ -- mempty -- query params, headers, explicit port number, etc.
294
+ liftIO $ logStdOut $ show (getOneHeader allHeaders " Cookie" )
295
+ return (responseBody r, responseStatusCode r, responseStatusMessage r)
296
+
297
+
242
298
delete :: Application
243
299
delete req send = do
244
300
logStdOut " requesting delete"
0 commit comments