fraport/fradrive
3
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

fix(files): fix download of non-injected files

Browse Source
This commit is contained in:
Gregor Kleen 2020-09-11 16:15:33 +02:00
parent 3866f80c8c
commit ce54adce6b
1 changed files with 15 additions and 7 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

22
src/Handler/Utils/Files.hs
View File

@ -17,7 +17,8 @@ import qualified Network.Minio as Minio
import qualified Database.Esqueleto as E import qualified Database.Esqueleto as E
import qualified Database.Esqueleto.Utils as E import qualified Database.Esqueleto.Utils as E
import System.FilePath (normalise) import System.FilePath (normalise, makeValid)
import Data.List (dropWhileEnd)
data SourceFilesException data SourceFilesException
@ -74,13 +75,14 @@ sourceFile FileReference{..} = File
uploadBucket <- getsYesod $ views appSettings appUploadCacheBucket uploadBucket <- getsYesod $ views appSettings appUploadCacheBucket
hoistMaybe <=< runAppMinio . runMaybeT $ do hoistMaybe <=< runAppMinio . runMaybeT $ do
objRes <- catchIfMaybeT minioIsDoesNotExist $ Minio.getObject uploadBucket uploadName Minio.defaultGetObjectOptions objRes <- catchIfMaybeT minioIsDoesNotExist $ Minio.getObject uploadBucket uploadName Minio.defaultGetObjectOptions
lift . runConduit $ Minio.gorObjectStream objRes .| C.mapM_ (atomically . putTMVar chunkVar . Just) lift . runConduit $ Minio.gorObjectStream objRes .| C.mapM_ (atomically . putTMVar chunkVar)
atomically $ putTMVar chunkVar Nothing
let go = do let go = do
mChunk <- atomically $ readTMVar chunkVar mChunk <- atomically $ Right <$> takeTMVar chunkVar
<|> Left <$> waitCatchSTM minioAsync
case mChunk of case mChunk of
Nothing -> waitAsync minioAsync Right chunk -> yield chunk >> go
Just chunk -> yield chunk >> go Left (Right ()) -> return ()
Left (Left exc) -> throwM exc
in go in go
sourceFiles' :: forall file m. (HasFileReference file, Monad m) => ConduitT file DBFile m () sourceFiles' :: forall file m. (HasFileReference file, Monad m) => ConduitT file DBFile m ()
@ -92,7 +94,13 @@ sourceFile' = sourceFile . view (_FileReference . _1)
acceptFile :: (MonadResource m, MonadResource m') => FileInfo -> m (File m') acceptFile :: (MonadResource m, MonadResource m') => FileInfo -> m (File m')
acceptFile fInfo = do acceptFile fInfo = do
let fileTitle = dropWhile isPathSeparator . dropTrailingPathSeparator . normalise . unpack $ fileName fInfo let fileTitle = "." <//> unpack (fileName fInfo)
& normalise
& makeValid
& dropWhile isPathSeparator
& dropWhileEnd isPathSeparator
& normalise
& makeValid
fileContent = Just $ fileSource fInfo fileContent = Just $ fileSource fInfo
fileModified <- liftIO getCurrentTime fileModified <- liftIO getCurrentTime
return File{..} return File{..}