feat(minio): use separate bucket for temporary files

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

package.yaml

@@ -159,6 +159,7 @@ dependencies:
   - topograph
   - network-uri
   - psqueues
+  - nonce
 other-extensions:
   - GeneralizedNewtypeDeriving
   - IncoherentInstances

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'

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"
 

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