From 1cd79d35e2761d84bb904a77e74d5cacb0b2244c Mon Sep 17 00:00:00 2001 From: Gregor Kleen Date: Mon, 15 Feb 2021 11:44:00 +0100 Subject: [PATCH] feat(minio): use separate bucket for temporary files --- config/settings.yml | 1 + package.yaml | 1 + src/Application.hs | 3 ++- src/Settings.hs | 3 ++- src/Utils/Files.hs | 25 ++++++++++++++++--------- 5 files changed, 22 insertions(+), 11 deletions(-) diff --git a/config/settings.yml b/config/settings.yml index 75924b7dc..54116ed5f 100644 --- a/config/settings.yml +++ b/config/settings.yml @@ -168,6 +168,7 @@ upload-cache: auto-discover-region: "_env:UPLOAD_S3_AUTO_DISCOVER_REGION:true" disable-cert-validation: "_env:UPLOAD_S3_DISABLE_CERT_VALIDATION:false" upload-cache-bucket: "uni2work-uploads" +upload-tmp-bucket: "uni2work-tmp" inject-files: 601 rechunk-files: 1201 diff --git a/package.yaml b/package.yaml index dc19eacfe..dd618b889 100644 --- a/package.yaml +++ b/package.yaml @@ -159,6 +159,7 @@ dependencies: - topograph - network-uri - psqueues + - nonce other-extensions: - GeneralizedNewtypeDeriving - IncoherentInstances diff --git a/src/Application.hs b/src/Application.hs index 4e5cdc8ed..e0f1da397 100644 --- a/src/Application.hs +++ b/src/Application.hs @@ -277,8 +277,9 @@ makeFoundation appSettings''@AppSettings{..} = do conn <- Minio.connect minioConf let isBucketExists Minio.BucketAlreadyOwnedByYou = True isBucketExists _ = False - either throwM return <=< Minio.runMinioWith conn $ + either throwM return <=< Minio.runMinioWith conn $ do handleIf isBucketExists (const $ return ()) $ Minio.makeBucket appUploadCacheBucket Nothing + handleIf isBucketExists (const $ return ()) $ Minio.makeBucket appUploadTmpBucket Nothing return conn $logDebugS "Runtime configuration" $ tshow appSettings' diff --git a/src/Settings.hs b/src/Settings.hs index 04ade63e8..e87cedfd4 100644 --- a/src/Settings.hs +++ b/src/Settings.hs @@ -184,7 +184,7 @@ data AppSettings = AppSettings , appMemcachedConf :: Maybe MemcachedConf , appUploadCacheConf :: Maybe Minio.ConnectInfo - , appUploadCacheBucket :: Minio.Bucket + , appUploadCacheBucket, appUploadTmpBucket :: Minio.Bucket , appInjectFiles :: Maybe NominalDiffTime , appRechunkFiles :: Maybe NominalDiffTime , appCheckMissingFiles :: Maybe NominalDiffTime @@ -619,6 +619,7 @@ instance FromJSON AppSettings where appUploadCacheConf <- assertM (not . null . Minio.connectHost) <$> o .:? "upload-cache" appUploadCacheBucket <- o .: "upload-cache-bucket" + appUploadTmpBucket <- o .: "upload-tmp-bucket" appFallbackPersonalisedSheetFilesKeysExpire <- o .: "fallback-personalised-sheet-files-keys-expire" diff --git a/src/Utils/Files.hs b/src/Utils/Files.hs index d6e18eeae..fb8c340dc 100644 --- a/src/Utils/Files.hs +++ b/src/Utils/Files.hs @@ -29,9 +29,7 @@ import qualified Data.Sequence as Seq import Database.Persist.Sql (deleteWhereCount) -import Control.Monad.Trans.Resource (allocate) - -import qualified Data.UUID.V4 as UUID +import Control.Monad.Trans.Resource (allocate, register, release) import qualified Database.Esqueleto as E import qualified Database.Esqueleto.Utils as E @@ -40,6 +38,9 @@ import Data.Conduit.Algorithms.FastCDC (fastCDC) import Control.Monad.Trans.Cont +import qualified Crypto.Nonce as Nonce +import System.IO.Unsafe + sinkFileDB :: (MonadCatch m, MonadHandler m, HandlerSite m ~ UniWorX, MonadUnliftIO m, BackendCompatible SqlBackend (YesodPersistBackend UniWorX), YesodPersist UniWorX) => Bool -- ^ Replace? Use only in serializable transaction @@ -96,12 +97,17 @@ sinkFileDB doReplace fileContentContent = do where fileContentChunkContentBased = True +minioTmpGenerator :: Nonce.Generator +minioTmpGenerator = unsafePerformIO Nonce.new +{-# NOINLINE minioTmpGenerator #-} + sinkFileMinio :: (MonadCatch m, MonadHandler m, HandlerSite m ~ UniWorX, MonadUnliftIO m) => ConduitT () ByteString m () -> MaybeT m FileContentReference -- ^ Cannot deal with zero length uploads sinkFileMinio fileContentContent = do uploadBucket <- getsYesod $ views appSettings appUploadCacheBucket + tmpBucket <- getsYesod $ views appSettings appUploadTmpBucket chunk <- liftIO newEmptyMVar let putChunks = do nextChunk <- await @@ -119,16 +125,17 @@ sinkFileMinio fileContentContent = do .| Crypto.sinkHash runAppMinio $ do - tmpUUID <- liftIO UUID.nextRandom - let uploadName = ".tmp." <> toPathPiece tmpUUID - pooOptions = Minio.defaultPutObjectOptions + uploadName <- Nonce.nonce128urlT minioTmpGenerator + let pooOptions = Minio.defaultPutObjectOptions { Minio.pooCacheControl = Just "immutable" } - Minio.putObject uploadBucket uploadName (C.unfoldM (\x -> fmap (, x) <$> takeMVar chunk) ()) Nothing pooOptions + removeObject <- withRunInIO $ \runInIO -> runInIO . register . runInIO $ Minio.removeObject tmpBucket uploadName + Minio.putObject tmpBucket uploadName (C.unfoldM (\x -> fmap (, x) <$> takeMVar chunk) ()) Nothing pooOptions fileContentHash <- review _Wrapped <$> waitAsync sinkAsync let dstName = minioFileReference # fileContentHash copySrc = Minio.defaultSourceInfo - { Minio.srcBucket = uploadBucket, Minio.srcObject = uploadName + { Minio.srcBucket = tmpBucket + , Minio.srcObject = uploadName } copyDst = Minio.defaultDestinationInfo { Minio.dstBucket = uploadBucket @@ -137,7 +144,7 @@ sinkFileMinio fileContentContent = do uploadExists <- handleIf minioIsDoesNotExist (const $ return False) $ True <$ Minio.statObject uploadBucket dstName Minio.defaultGetObjectOptions unless uploadExists $ Minio.copyObject copyDst copySrc - Minio.removeObject uploadBucket uploadName + release removeObject return fileContentHash