diff --git a/src/Handler/Utils/Files.hs b/src/Handler/Utils/Files.hs index d53cc24ec..33e1518e9 100644 --- a/src/Handler/Utils/Files.hs +++ b/src/Handler/Utils/Files.hs @@ -17,7 +17,8 @@ import qualified Network.Minio as Minio import qualified Database.Esqueleto as E import qualified Database.Esqueleto.Utils as E -import System.FilePath (normalise) +import System.FilePath (normalise, makeValid) +import Data.List (dropWhileEnd) data SourceFilesException @@ -74,13 +75,14 @@ sourceFile FileReference{..} = File uploadBucket <- getsYesod $ views appSettings appUploadCacheBucket hoistMaybe <=< runAppMinio . runMaybeT $ do objRes <- catchIfMaybeT minioIsDoesNotExist $ Minio.getObject uploadBucket uploadName Minio.defaultGetObjectOptions - lift . runConduit $ Minio.gorObjectStream objRes .| C.mapM_ (atomically . putTMVar chunkVar . Just) - atomically $ putTMVar chunkVar Nothing + lift . runConduit $ Minio.gorObjectStream objRes .| C.mapM_ (atomically . putTMVar chunkVar) let go = do - mChunk <- atomically $ readTMVar chunkVar + mChunk <- atomically $ Right <$> takeTMVar chunkVar + <|> Left <$> waitCatchSTM minioAsync case mChunk of - Nothing -> waitAsync minioAsync - Just chunk -> yield chunk >> go + Right chunk -> yield chunk >> go + Left (Right ()) -> return () + Left (Left exc) -> throwM exc in go 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 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 fileModified <- liftIO getCurrentTime return File{..}