72 lines
3.0 KiB
Haskell
72 lines
3.0 KiB
Haskell
module Handler.Utils.FilesSpec where
|
|
|
|
import TestImport hiding (runDB)
|
|
import Yesod.Core.Handler (getsYesod)
|
|
import Yesod.Persist.Core (YesodPersist(runDB))
|
|
|
|
import ModelSpec ()
|
|
|
|
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)
|
|
|
|
|
|
spec :: Spec
|
|
spec = withApp . describe "File handling" $ do
|
|
describe "Minio" $ do
|
|
modifyMaxSuccess (`div` 10) . it "roundtrips" $ \(tSite, _) -> property $ do
|
|
fileContentContent <- arbitrary
|
|
`suchThat` (\fc -> not . null . runIdentity . runConduit $ fc .| C.sinkLazy) -- Minio (and by extension `sinkFileMinio`) cannot deal with zero length uploads; this is handled seperately by `sinkFile`
|
|
file' <- arbitrary :: Gen PureFile
|
|
let file = file' { fileContent = Just fileContentContent }
|
|
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 "DB" $ do
|
|
modifyMaxSuccess (`div` 10) . it "roundtrips" $ \(tSite, _) -> property $ do
|
|
fileContentContent <- arbitrary
|
|
`suchThat` (\fc -> not . null . runIdentity . runConduit $ fc .| C.sinkLazy) -- Minio (and by extension `sinkFileMinio`) cannot deal with zero length uploads; this is handled seperately by `sinkFile`
|
|
file' <- arbitrary :: Gen PureFile
|
|
let file = file' { fileContent = Just fileContentContent }
|
|
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
|