minio-hs-0.3.2: test/LiveServer.hs
--
-- Minio Haskell SDK, (C) 2017 Minio, Inc.
--
-- Licensed under the Apache License, Version 2.0 (the "License");
-- you may not use this file except in compliance with the License.
-- You may obtain a copy of the License at
--
-- http://www.apache.org/licenses/LICENSE-2.0
--
-- Unless required by applicable law or agreed to in writing, software
-- distributed under the License is distributed on an "AS IS" BASIS,
-- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-- See the License for the specific language governing permissions and
-- limitations under the License.
--
import qualified Test.QuickCheck as Q
import Test.Tasty
import Test.Tasty.HUnit
import Test.Tasty.QuickCheck as QC
import Lib.Prelude
import System.Directory (getTemporaryDirectory)
import qualified System.IO as SIO
import qualified Control.Monad.Catch as MC
import qualified Control.Monad.Trans.Resource as R
import qualified Data.ByteString as BS
import Data.Conduit (yield, ($$))
import qualified Data.Conduit as C
import qualified Data.Conduit.Binary as CB
import Data.Conduit.Combinators (sinkList)
import Data.Default (Default (..))
import qualified Data.Map.Strict as Map
import qualified Data.Text as T
import qualified Data.Time as Time
import qualified Network.HTTP.Client.MultipartFormData as Form
import qualified Network.HTTP.Conduit as NC
import qualified Network.HTTP.Types as HT
import System.Environment (lookupEnv)
import Network.Minio
import Network.Minio.Data
import Network.Minio.ListOps
import Network.Minio.PutObject
import Network.Minio.S3API
import Network.Minio.Utils
main :: IO ()
main = defaultMain tests
tests :: TestTree
tests = testGroup "Tests" [liveServerUnitTests]
-- conduit that generates random binary stream of given length
randomDataSrc :: MonadIO m => Int64 -> C.Producer m ByteString
randomDataSrc s' = genBS s'
where
oneMiB = 1024*1024
concatIt bs n = BS.concat $ replicate (fromIntegral q) bs ++
[BS.take (fromIntegral r) bs]
where (q, r) = n `divMod` fromIntegral (BS.length bs)
genBS s = do
w8s <- liftIO $ generate $ Q.vectorOf 64 (Q.choose (0, 255))
let byteArr64 = BS.pack w8s
if s < oneMiB
then yield $ concatIt byteArr64 s
else do yield $ concatIt byteArr64 oneMiB
genBS (s - oneMiB)
mkRandFile :: R.MonadResource m => Int64 -> m FilePath
mkRandFile size = do
dir <- liftIO $ getTemporaryDirectory
randomDataSrc size C.$$ CB.sinkTempFile dir "miniohstest.random"
funTestBucketPrefix :: Text
funTestBucketPrefix = "miniohstest-"
funTestWithBucket :: TestName
-> (([Char] -> Minio ()) -> Bucket -> Minio ()) -> TestTree
funTestWithBucket t minioTest = testCaseSteps t $ \step -> do
-- generate a random name for the bucket
bktSuffix <- liftIO $ generate $ Q.vectorOf 10 (Q.choose ('a', 'z'))
let b = T.concat [funTestBucketPrefix, T.pack bktSuffix]
liftStep = liftIO . step
connInfo <- maybe minioPlayCI (const def) <$> lookupEnv "MINIO_LOCAL"
ret <- runMinio connInfo $ do
liftStep $ "Creating bucket for test - " ++ t
foundBucket <- bucketExists b
liftIO $ foundBucket @?= False
makeBucket b def
minioTest liftStep b
deleteBucket b
isRight ret @? ("Functional test " ++ t ++ " failed => " ++ show ret)
lowLevelMultipartTest :: TestTree
lowLevelMultipartTest = funTestWithBucket "Low-level Multipart Test" $
\step bucket -> do
-- low-level multipart operation tests.
let object = "newmpupload"
mb15 = 15 * 1024 * 1024
step "Prepare for low-level multipart tests."
step "create new multipart upload"
uid <- newMultipartUpload bucket object []
liftIO $ (T.length uid > 0) @? ("Got an empty multipartUpload Id.")
randFile <- mkRandFile mb15
step "put object parts 1 of 1"
h <- liftIO $ SIO.openBinaryFile randFile SIO.ReadMode
partInfo <- putObjectPart bucket object uid 1 [] $ PayloadH h 0 mb15
step "complete multipart"
void $ completeMultipartUpload bucket object uid [partInfo]
destFile <- mkRandFile 0
step "Retrieve the created object and check size"
fGetObject bucket object destFile
gotSize <- withNewHandle destFile getFileSize
liftIO $ gotSize == Right (Just mb15) @?
"Wrong file size of put file after getting"
step "Cleanup actions"
removeObject bucket object
putObjectNoSizeTest :: TestTree
putObjectNoSizeTest = funTestWithBucket "PutObject of conduit source with no size" $
\step bucket -> do
-- putObject test (conduit source, no size specified)
let obj = "mpart"
mb70 = 70 * 1024 * 1024
step "Prepare for putObject with from source without providing size."
rFile <- mkRandFile mb70
step "Upload multipart file."
putObject bucket obj (CB.sourceFile rFile) Nothing
step "Retrieve and verify file size"
destFile <- mkRandFile 0
fGetObject bucket obj destFile
gotSize <- withNewHandle destFile getFileSize
liftIO $ gotSize == Right (Just mb70) @?
"Wrong file size of put file after getting"
step "Cleanup actions"
deleteObject bucket obj
highLevelListingTest :: TestTree
highLevelListingTest = funTestWithBucket "High-level listObjects Test" $
\step bucket -> do
step "High-level listObjects Test"
step "put 3 objects"
let expectedObjects = ["dir/o1", "dir/dir1/o2", "dir/dir2/o3"]
forM_ expectedObjects $
\obj -> fPutObject bucket obj "/etc/lsb-release"
step "High-level listing of objects"
objects <- listObjects bucket Nothing True $$ sinkList
liftIO $ assertEqual "Objects match failed!" (sort expectedObjects)
(map oiObject objects)
step "High-level listing of objects (version 1)"
objects <- listObjectsV1 bucket Nothing True $$ sinkList
step "Cleanup actions"
forM_ expectedObjects $
\obj -> removeObject bucket obj
step "High-level listIncompleteUploads Test"
let object = "newmpupload"
step "create 10 multipart uploads"
forM_ [1..10::Int] $ \_ -> do
uid <- newMultipartUpload bucket object []
liftIO $ (T.length uid > 0) @? ("Got an empty multipartUpload Id.")
step "High-level listing of incomplete multipart uploads"
uploads <- listIncompleteUploads bucket Nothing True $$ sinkList
-- Minio server behaviour changed to list no incomplete uploads,
-- so the check below reflects this; this test is expected to
-- fail on AWS S3.
liftIO $ length uploads @?= 0
step "cleanup"
forM_ uploads $ \(UploadInfo _ uid _ _) ->
abortMultipartUpload bucket object uid
step "High-level listIncompleteParts Test"
let mb5 = 5 * 1024 * 1024
step "create a multipart upload"
uid <- newMultipartUpload bucket object []
liftIO $ (T.length uid > 0) @? "Got an empty multipartUpload Id."
step "put object parts 1..10"
inputFile <- mkRandFile mb5
h <- liftIO $ SIO.openBinaryFile inputFile SIO.ReadMode
forM_ [1..10] $ \pnum ->
putObjectPart bucket object uid pnum [] $ PayloadH h 0 mb5
step "fetch list parts"
incompleteParts <- listIncompleteParts bucket object uid $$ sinkList
liftIO $ length incompleteParts @?= 10
step "cleanup"
abortMultipartUpload bucket object uid
listingTest :: TestTree
listingTest = funTestWithBucket "Listing Test" $ \step bucket -> do
step "listObjects' test"
step "put 10 objects"
let objects = (\s ->T.concat ["lsb-release", T.pack (show s)]) <$> [1..10::Int]
forM_ [1..10::Int] $ \s ->
fPutObject bucket (T.concat ["lsb-release", T.pack (show s)]) "/etc/lsb-release"
step "Simple list"
res <- listObjects' bucket Nothing Nothing Nothing Nothing
let expectedObjects = sort objects
liftIO $ assertEqual "Objects match failed!" expectedObjects
(map oiObject $ lorObjects res)
step "Simple list version 1"
res <- listObjectsV1' bucket Nothing Nothing Nothing Nothing
let expected = sort $ map (T.concat .
("lsb-release":) .
(\x -> [x]) .
T.pack .
show) [1..10::Int]
liftIO $ assertEqual "Objects match failed!" expected
(map oiObject $ lorObjects' res)
step "Cleanup actions"
forM_ objects $ \obj -> deleteObject bucket obj
step "listIncompleteUploads' test"
step "create 10 multipart uploads"
let object = "newmpupload"
forM_ [1..10::Int] $ \_ -> do
uid <- newMultipartUpload bucket object []
liftIO $ (T.length uid > 0) @? ("Got an empty multipartUpload Id.")
step "list incomplete multipart uploads"
incompleteUploads <- listIncompleteUploads' bucket Nothing Nothing
Nothing Nothing Nothing
-- Minio server behaviour changed to list no incomplete uploads,
-- so the check below reflects this; this test is expected to
-- fail on AWS S3.
liftIO $ (length $ lurUploads incompleteUploads) @?= 0
step "cleanup"
forM_ (lurUploads incompleteUploads) $
\(_, uid, _) -> abortMultipartUpload bucket object uid
step "Basic listIncompleteParts Test"
let mb5 = 5 * 1024 * 1024
step "create a multipart upload"
uid <- newMultipartUpload bucket object []
liftIO $ (T.length uid > 0) @? ("Got an empty multipartUpload Id.")
step "put object parts 1..10"
inputFile <- mkRandFile mb5
h <- liftIO $ SIO.openBinaryFile inputFile SIO.ReadMode
forM_ [1..10] $ \pnum ->
putObjectPart bucket object uid pnum [] $ PayloadH h 0 mb5
step "fetch list parts"
listPartsResult <- listIncompleteParts' bucket object uid Nothing Nothing
liftIO $ (length $ lprParts listPartsResult) @?= 10
abortMultipartUpload bucket object uid
liveServerUnitTests :: TestTree
liveServerUnitTests = testGroup "Unit tests against a live server"
[ basicTests
, listingTest
, highLevelListingTest
, lowLevelMultipartTest
, putObjectNoSizeTest
, funTestWithBucket "Multipart Tests" $
\step bucket -> do
step "Prepare for putObjectInternal with non-seekable file, with size."
step "Upload multipart file."
let mb80 = 80 * 1024 * 1024
obj = "mpart"
void $ putObjectInternal bucket obj $ ODFile "/dev/zero" (Just mb80)
step "Retrieve and verify file size"
destFile <- mkRandFile 0
fGetObject bucket obj destFile
gotSize <- withNewHandle destFile getFileSize
liftIO $ gotSize == Right (Just mb80) @?
"Wrong file size of put file after getting"
step "Cleanup actions"
removeObject bucket obj
step "cleanup"
removeObject bucket "big"
step "Prepare for removeIncompleteUpload"
-- low-level multipart operation tests.
let object = "newmpupload"
kb5 = 5 * 1024
step "create new multipart upload"
uid <- newMultipartUpload bucket object []
liftIO $ (T.length uid > 0) @? "Got an empty multipartUpload Id."
randFile <- mkRandFile kb5
step "upload 2 parts"
forM_ [1,2] $ \partNum -> do
h <- liftIO $ SIO.openBinaryFile randFile SIO.ReadMode
void $ putObjectPart bucket object uid partNum [] $ PayloadH h 0 kb5
step "remove ongoing upload"
removeIncompleteUpload bucket object
uploads <- listIncompleteUploads bucket (Just object) False C.$$ sinkList
liftIO $ (null uploads) @? "removeIncompleteUploads didn't complete successfully"
, funTestWithBucket "copyObject related tests" $ \step bucket -> do
step "copyObjectSingle basic tests"
let object = "xxx"
objCopy = "xxxCopy"
size1 = 100 :: Int64
step "create server object to copy"
inputFile <- mkRandFile size1
fPutObject bucket object inputFile
step "copy object"
let cps = def { cpSource = format "/{}/{}" [bucket, object] }
(etag, modTime) <- copyObjectSingle bucket objCopy cps []
-- retrieve obj info to check
ObjectInfo _ t e s <- headObject bucket objCopy
let isMTimeDiffOk = abs (diffUTCTime modTime t) < 1.0
liftIO $ (s == size1 && e == etag && isMTimeDiffOk) @?
"Copied object did not match expected."
step "cleanup actions"
removeObject bucket object
removeObject bucket objCopy
step "copyObjectPart basic tests"
let srcObj = "XXX"
copyObj = "XXXCopy"
step "Prepare"
let mb15 = 15 * 1024 * 1024
mb5 = 5 * 1024 * 1024
randFile <- mkRandFile mb15
fPutObject bucket srcObj randFile
step "create new multipart upload"
uid <- newMultipartUpload bucket copyObj []
liftIO $ (T.length uid > 0) @? "Got an empty multipartUpload Id."
step "put object parts 1-3"
let cps' = def {cpSource = format "/{}/{}" [bucket, srcObj]}
parts <- forM [1..3] $ \p -> do
(etag', _) <- copyObjectPart bucket copyObj cps'{
cpSourceRange = Just ((p-1)*mb5, (p-1)*mb5 + (mb5 - 1))
} uid (fromIntegral p) []
return (fromIntegral p, etag')
step "complete multipart"
void $ completeMultipartUpload bucket copyObj uid parts
step "verify copied object size"
(ObjectInfo _ _ _ s') <- headObject bucket copyObj
liftIO $ (s' == mb15) @? "Size failed to match"
step "Cleanup actions"
removeObject bucket srcObj
removeObject bucket copyObj
step "copyObject basic tests"
let srcs = ["XXX", "XXXL"]
copyObjs = ["XXXCopy", "XXXLCopy"]
sizes = map (* (1024 * 1024)) [15, 65]
step "Prepare"
forM_ (zip srcs sizes) $ \(src, size) ->
fPutObject bucket src =<< mkRandFile size
step "make small and large object copy"
forM_ (zip copyObjs srcs) $ \(cp, src) ->
copyObject bucket cp def{cpSource = format "/{}/{}" [bucket, src]}
step "verify uploaded objects"
uploadedSizes <- fmap oiSize <$> forM copyObjs (headObject bucket)
liftIO $ (sizes == uploadedSizes) @? "Uploaded obj sizes failed to match"
forM_ (srcs ++ copyObjs) (removeObject bucket)
step "copyObject with offset test "
let src = "XXX"
size = 15 * 1024 * 1024
step "Prepare"
fPutObject bucket src =<< mkRandFile size
step "copy last 10MiB of object"
copyObject bucket copyObj def{
cpSource = format "/{}/{}" [bucket, src]
, cpSourceRange = Just (5 * 1024 * 1024, size - 1)
}
step "verify uploaded object"
cSize <- oiSize <$> headObject bucket copyObj
liftIO $ (cSize == 10 * 1024 * 1024) @? "Uploaded obj size mismatched!"
forM_ [src, copyObj] (removeObject bucket)
, presignedUrlFunTest
, presignedPostPolicyFunTest
]
basicTests :: TestTree
basicTests = funTestWithBucket "Basic tests" $ \step bucket -> do
step "getService works and contains the test bucket."
buckets <- getService
unless (length (filter (== bucket) $ map biName buckets) == 1) $
liftIO $
assertFailure ("The bucket " ++ show bucket ++
" was expected to exist.")
step "makeBucket again to check if BucketAlreadyOwnedByYou exception is raised."
mbE <- MC.try $ makeBucket bucket Nothing
case mbE of
Left exn -> liftIO $ exn @?= BucketAlreadyOwnedByYou
_ -> return ()
step "makeBucket with an invalid bucket name and check for appropriate exception."
invalidMBE <- MC.try $ makeBucket "invalidBucketName" Nothing
case invalidMBE of
Left exn -> liftIO $ exn @?= MErrVInvalidBucketName "invalidBucketName"
_ -> return ()
step "getLocation works"
region <- getLocation bucket
liftIO $ region == "us-east-1" @? ("Got unexpected region => " ++ show region)
step "singlepart putObject works"
fPutObject bucket "lsb-release" "/etc/lsb-release"
step "fPutObject onto a non-existent bucket and check for NoSuchBucket exception"
fpE <- MC.try $ fPutObject "nosuchbucket" "lsb-release" "/etc/lsb-release"
case fpE of
Left exn -> liftIO $ exn @?= NoSuchBucket
_ -> return ()
outFile <- mkRandFile 0
step "simple fGetObject works"
fGetObject bucket "lsb-release" outFile
step "fGetObject a non-existent object and check for NoSuchKey exception"
resE <- MC.try $ fGetObject bucket "noSuchKey" outFile
case resE of
Left exn -> liftIO $ exn @?= NoSuchKey
_ -> return ()
step "create new multipart upload works"
uid <- newMultipartUpload bucket "newmpupload" []
liftIO $ (T.length uid > 0) @? ("Got an empty multipartUpload Id.")
step "abort a new multipart upload works"
abortMultipartUpload bucket "newmpupload" uid
step "delete object works"
deleteObject bucket "lsb-release"
step "statObject test"
let object = "sample"
step "create an object"
inputFile <- mkRandFile 0
fPutObject bucket object inputFile
step "get metadata of the object"
res <- statObject bucket object
liftIO $ (oiSize res) @?= 0
step "delete object"
deleteObject bucket object
presignedUrlFunTest :: TestTree
presignedUrlFunTest = funTestWithBucket "presigned Url tests" $
\step bucket -> do
let obj = "mydir/myput"
obj2 = "mydir1/myfile1"
-- manager for http requests
mgr <- liftIO $ NC.newManager NC.tlsManagerSettings
step "PUT object presigned URL - makePresignedUrl"
putUrl <- makePresignedUrl 3600 HT.methodPut (Just bucket)
(Just obj) (Just "us-east-1") [] []
let size1 = 1000 :: Int64
inputFile <- mkRandFile size1
-- attempt to upload using the presigned URL
putResp <- putR size1 inputFile mgr putUrl
liftIO $ (NC.responseStatus putResp == HT.status200) @?
"presigned PUT failed"
step "GET object presigned URL - makePresignedUrl"
getUrl <- makePresignedUrl 3600 HT.methodGet (Just bucket)
(Just obj) (Just "us-east-1") [] []
getResp <- getR mgr getUrl
liftIO $ (NC.responseStatus getResp == HT.status200) @?
"presigned GET failed"
-- read content from file to compare with response above
bs <- CB.sourceFile inputFile $$ CB.sinkLbs
liftIO $ (bs == NC.responseBody getResp) @?
"presigned put and get got mismatched data"
step "PUT object presigned - presignedPutObjectURL"
putUrl2 <- presignedPutObjectUrl bucket obj2 3600 []
let size2 = 1200
testFile <- mkRandFile size2
putResp2 <- putR size2 testFile mgr putUrl2
liftIO $ (NC.responseStatus putResp2 == HT.status200) @?
"presigned PUT failed (presignedPutObjectUrl)"
step "HEAD object presigned URL - presignedHeadObjectUrl"
headUrl <- presignedHeadObjectUrl bucket obj2 3600 []
headResp <- do req <- NC.parseRequest $ toS headUrl
NC.httpLbs (req {NC.method = HT.methodHead}) mgr
liftIO $ (NC.responseStatus headResp == HT.status200) @?
"presigned HEAD failed (presignedHeadObjectUrl)"
-- check that header info is accurate
let h = Map.fromList $ NC.responseHeaders headResp
cLen = Map.findWithDefault "0" HT.hContentLength h
liftIO $ (cLen == show size2) @? "Head req returned bad content length"
step "GET object presigned URL - presignedGetObjectUrl"
getUrl2 <- presignedGetObjectUrl bucket obj2 3600 [] []
getResp2 <- getR mgr getUrl2
liftIO $ (NC.responseStatus getResp2 == HT.status200) @?
"presigned GET failed (presignedGetObjectUrl)"
-- read content from file to compare with response above
bs2 <- CB.sourceFile testFile $$ CB.sinkLbs
liftIO $ (bs2 == NC.responseBody getResp2) @?
"presigned put and get got mismatched data (presigned*Url)"
mapM_ (removeObject bucket) [obj, obj2]
where
putR size filePath mgr url = do
req <- NC.parseRequest $ toS url
let req' = req { NC.method = HT.methodPut
, NC.requestBody = NC.requestBodySource size $
CB.sourceFile filePath}
NC.httpLbs req' mgr
getR mgr url = do
req <- NC.parseRequest $ toS url
NC.httpLbs req mgr
presignedPostPolicyFunTest :: TestTree
presignedPostPolicyFunTest = funTestWithBucket "Presigned Post Policy tests" $
\step bucket -> do
step "presignedPostPolicy basic test"
now <- liftIO $ Time.getCurrentTime
let key = "presignedPostPolicyTest/myfile"
policyConds = [ ppCondBucket bucket
, ppCondKey key
, ppCondContentLengthRange 1 1000
, ppCondContentType "application/octet-stream"
, ppCondSuccessActionStatus 200
]
expirationTime = Time.addUTCTime 3600 now
postPolicyE = newPostPolicy expirationTime policyConds
size = 1000 :: Int64
inputFile <- mkRandFile size
case postPolicyE of
Left err -> liftIO $ assertFailure $ show err
Right postPolicy -> do
(url, formData) <- presignedPostPolicy postPolicy
-- liftIO (print url) >> liftIO (print formData)
result <- liftIO $ postForm url formData inputFile
liftIO $ (NC.responseStatus result == HT.status200) @?
"presigned POST failed"
mapM_ (removeObject bucket) [key]
where
postForm url formData inputFile = do
req <- NC.parseRequest $ toS url
let parts = map (\(x, y) -> Form.partBS x y) $
Map.toList formData
parts' = parts ++ [Form.partFile "file" inputFile]
req' <- Form.formDataBody parts' req
mgr <- NC.newManager NC.tlsManagerSettings
NC.httpLbs req' mgr