118 lines
4.9 KiB
Haskell
118 lines
4.9 KiB
Haskell
-- SPDX-FileCopyrightText: 2022 Gregor Kleen <gregor.kleen@ifi.lmu.de>
|
|
--
|
|
-- SPDX-License-Identifier: AGPL-3.0-or-later
|
|
|
|
module Handler.Utils.FilesSpec where
|
|
|
|
import TestImport hiding (runDB)
|
|
import Yesod.Core.Handler (getsYesod)
|
|
import Yesod.Persist.Core (YesodPersist(runDB))
|
|
|
|
import ModelSpec ()
|
|
import Model.Types.FileSpec (LargeFile(..))
|
|
|
|
import Handler.Utils.Files
|
|
import Utils.Files
|
|
|
|
import Control.Lens.Extras (is)
|
|
|
|
import Data.Conduit
|
|
import qualified Data.Conduit.Combinators as C
|
|
|
|
import Control.Monad.Fail (MonadFail(..))
|
|
import Control.Monad.Trans.Maybe (runMaybeT)
|
|
|
|
import Utils.Sql (setSerializable)
|
|
|
|
import qualified Crypto.Hash.Conduit as Crypto (sinkHash)
|
|
|
|
import Utils (maybeT)
|
|
import Data.Conduit.Algorithms.FastCDC (fastCDC)
|
|
import Settings (_appFileChunkingParams)
|
|
|
|
import qualified Data.ByteString as BS
|
|
|
|
|
|
fileNull :: PureFile -> Bool
|
|
fileNull file = maybe True BS.null $ file ^. _pureFileContent
|
|
|
|
|
|
spec :: Spec
|
|
spec = withApp . describe "File handling" $ do
|
|
describe "Minio" $ do
|
|
modifyMaxSuccess (`div` 50) . it "roundtrips" $ \(tSite, _) -> property $ do
|
|
file <- fmap getLargeFile arbitrary `suchThat` (not . fileNull) :: Gen PureFile
|
|
let fileContentContent = fromMaybe (error "no file content") $ file ^. _fileContent
|
|
return . propertyIO . unsafeHandler tSite $ do
|
|
haveUploadCache <- getsYesod $ is _Just . appUploadCache
|
|
unless haveUploadCache . liftIO $
|
|
pendingWith "No upload cache (minio) configured"
|
|
|
|
let fRef = file ^. _FileReference . _1 . _fileReferenceContent
|
|
fRef' <- runMaybeT . sinkFileMinio $ transPipe generalize fileContentContent
|
|
|
|
liftIO $ fRef' `shouldBe` fRef
|
|
|
|
fileReferenceContentContent <- liftIO . maybe (fail "Produced no file reference") return $ fRef'
|
|
|
|
suppliedContent <- runConduit $ transPipe generalize fileContentContent
|
|
.| C.sinkLazy
|
|
for_ [1..10] $ \_i -> do
|
|
readContent <- runConduit $ sourceFileMinio fileReferenceContentContent
|
|
.| C.takeE (succ $ olength suppliedContent)
|
|
.| C.sinkLazy
|
|
|
|
liftIO $ readContent `shouldBe` suppliedContent
|
|
describe "Minio, chunkwise" $ do
|
|
modifyMaxSuccess (`div` 50) . it "roundtrips" $ \(tSite, _) -> property $ do
|
|
file <- fmap getLargeFile arbitrary `suchThat` (not . fileNull) :: Gen PureFile
|
|
let fileContentContent = fromMaybe (error "no file content") $ file ^. _fileContent
|
|
return . propertyIO . unsafeHandler tSite $ do
|
|
haveUploadCache <- getsYesod $ is _Just . appUploadCache
|
|
unless haveUploadCache . liftIO $
|
|
pendingWith "No upload cache (minio) configured"
|
|
|
|
chunkingParams <- getsYesod $ view _appFileChunkingParams
|
|
let mkChunks = transPipe generalize fileContentContent .| fastCDC chunkingParams
|
|
sinkChunks = C.mapM (maybeT (liftIO $ fail "sinkMinio produced no chunk reference") . sinkMinio @FileContentChunkReference . yield) .| C.foldMap (pure :: FileContentChunkReference -> [FileContentChunkReference])
|
|
(review _Wrapped -> fRef', chunks) <- runConduit $ mkChunks .| getZipConduit ((,) <$> ZipConduit Crypto.sinkHash <*> ZipConduit sinkChunks)
|
|
|
|
liftIO $ Just fRef' `shouldBe` view (_FileReference . _1 . _fileReferenceContent) file
|
|
|
|
runDB . void $ insertMany_
|
|
[ FileContentEntry{ fileContentEntryHash = fRef', .. }
|
|
| fileContentEntryChunkHash <- chunks
|
|
| fileContentEntryIx <- [0..]
|
|
]
|
|
|
|
suppliedContent <- runConduit $ transPipe generalize fileContentContent
|
|
.| C.sinkLazy
|
|
for_ [1..10] $ \_i -> do
|
|
let dbFile = sourceFile $ file ^. _FileReference . _1
|
|
fileContent' <- liftIO . maybe (fail "sourceFile produced no file reference") return $ fileContent dbFile
|
|
readContent <- runDB . runConduit
|
|
$ fileContent'
|
|
.| C.takeE (succ $ olength suppliedContent)
|
|
.| C.sinkLazy
|
|
|
|
liftIO $ readContent `shouldBe` suppliedContent
|
|
describe "DB" $ do
|
|
modifyMaxSuccess (`div` 50) . it "roundtrips" $ \(tSite, _) -> property $ do
|
|
file <- fmap getLargeFile arbitrary `suchThat` (not . fileNull) :: Gen PureFile
|
|
let fileContentContent = fromMaybe (error "no file content") $ file ^. _fileContent
|
|
return . propertyIO . unsafeHandler tSite $ do
|
|
let fRef = file ^. _FileReference . _1 . _fileReferenceContent
|
|
fRef' <- runDB . setSerializable . sinkFileDB True $ transPipe generalize fileContentContent
|
|
|
|
liftIO $ Just fRef' `shouldBe` fRef
|
|
|
|
suppliedContent <- runConduit $ transPipe generalize fileContentContent
|
|
.| C.sinkLazy
|
|
for_ [1..10] $ \_i -> do
|
|
readContent <- runDB . runConduit
|
|
$ sourceFileDB fRef'
|
|
.| C.takeE (succ $ olength suppliedContent)
|
|
.| C.sinkLazy
|
|
|
|
liftIO $ readContent `shouldBe` suppliedContent
|