403 lines
17 KiB
Haskell
403 lines
17 KiB
Haskell
--
|
|
-- 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.
|
|
--
|
|
{-# LANGUAGE QuasiQuotes #-}
|
|
|
|
module Network.Minio.XmlParser.Test
|
|
( xmlParserTests,
|
|
)
|
|
where
|
|
|
|
import qualified Data.HashMap.Strict as H
|
|
import Data.Time (fromGregorian)
|
|
import Lib.Prelude
|
|
import Network.Minio.Data
|
|
import Network.Minio.Errors
|
|
import Network.Minio.TestHelpers
|
|
import Network.Minio.XmlParser
|
|
import Test.Tasty
|
|
import Test.Tasty.HUnit
|
|
import Text.RawString.QQ (r)
|
|
import UnliftIO (MonadUnliftIO)
|
|
|
|
xmlParserTests :: TestTree
|
|
xmlParserTests =
|
|
testGroup
|
|
"XML Parser Tests"
|
|
[ testCase "Test parseLocation" testParseLocation,
|
|
testCase "Test parseNewMultipartUpload" testParseNewMultipartUpload,
|
|
testCase "Test parseListObjectsResponse" testParseListObjectsResult,
|
|
testCase "Test parseListObjectsV1Response" testParseListObjectsV1Result,
|
|
testCase "Test parseListUploadsresponse" testParseListIncompleteUploads,
|
|
testCase "Test parseCompleteMultipartUploadResponse" testParseCompleteMultipartUploadResponse,
|
|
testCase "Test parseListPartsResponse" testParseListPartsResponse,
|
|
testCase "Test parseCopyObjectResponse" testParseCopyObjectResponse,
|
|
testCase "Test parseNotification" testParseNotification,
|
|
testCase "Test parseSelectProgress" testParseSelectProgress
|
|
]
|
|
|
|
tryValidationErr :: (MonadUnliftIO m) => m a -> m (Either MErrV a)
|
|
tryValidationErr act = try act
|
|
|
|
assertValidtionErr :: MErrV -> Assertion
|
|
assertValidtionErr e = assertFailure $ "Failed due to validation error => " ++ show e
|
|
|
|
eitherValidationErr :: Either MErrV a -> (a -> Assertion) -> Assertion
|
|
eitherValidationErr (Left e) _ = assertValidtionErr e
|
|
eitherValidationErr (Right a) f = f a
|
|
|
|
testParseLocation :: Assertion
|
|
testParseLocation = do
|
|
-- 1. Test parsing of an invalid location constraint xml.
|
|
parseResE <- tryValidationErr $ parseLocation "ClearlyInvalidXml"
|
|
when (isRight parseResE)
|
|
$ assertFailure
|
|
$ "Parsing should have failed => " ++ show parseResE
|
|
|
|
forM_ cases $ \(xmldata, expectedLocation) -> do
|
|
parseLocE <- tryValidationErr $ parseLocation xmldata
|
|
either assertValidtionErr (@?= expectedLocation) parseLocE
|
|
where
|
|
cases =
|
|
[ -- 2. Test parsing of a valid location xml.
|
|
( "<?xml version=\"1.0\" encoding=\"UTF-8\"?>\
|
|
\<LocationConstraint xmlns=\"http://s3.amazonaws.com/doc/2006-03-01/\">EU</LocationConstraint>",
|
|
"EU"
|
|
),
|
|
-- 3. Test parsing of a valid, empty location xml.
|
|
( "<LocationConstraint xmlns=\"http://s3.amazonaws.com/doc/2006-03-01/\"/>",
|
|
"us-east-1"
|
|
)
|
|
]
|
|
|
|
testParseNewMultipartUpload :: Assertion
|
|
testParseNewMultipartUpload = do
|
|
forM_ cases $ \(xmldata, expectedUploadId) -> do
|
|
parsedUploadIdE <- tryValidationErr $ runTestNS $ parseNewMultipartUpload xmldata
|
|
eitherValidationErr parsedUploadIdE (@?= expectedUploadId)
|
|
where
|
|
cases =
|
|
[ ( "<?xml version=\"1.0\" encoding=\"UTF-8\"?>\
|
|
\<InitiateMultipartUploadResult xmlns=\"http://s3.amazonaws.com/doc/2006-03-01/\">\
|
|
\ <Bucket>example-bucket</Bucket>\
|
|
\ <Key>example-object</Key>\
|
|
\ <UploadId>VXBsb2FkIElEIGZvciA2aWWpbmcncyBteS1tb3ZpZS5tMnRzIHVwbG9hZA</UploadId>\
|
|
\</InitiateMultipartUploadResult>",
|
|
"VXBsb2FkIElEIGZvciA2aWWpbmcncyBteS1tb3ZpZS5tMnRzIHVwbG9hZA"
|
|
),
|
|
( "<?xml version=\"1.0\" encoding=\"UTF-8\"?>\
|
|
\<InitiateMultipartUploadResult xmlns=\"http://s3.amazonaws.com/doc/2006-03-01/\">\
|
|
\ <Bucket>example-bucket</Bucket>\
|
|
\ <Key>example-object</Key>\
|
|
\ <UploadId>EXAMPLEJZ6e0YupT2h66iePQCc9IEbYbDUy4RTpMeoSMLPRp8Z5o1u8feSRonpvnWsKKG35tI2LB9VDPiCgTy.Gq2VxQLYjrue4Nq.NBdqI-</UploadId>\
|
|
\</InitiateMultipartUploadResult>",
|
|
"EXAMPLEJZ6e0YupT2h66iePQCc9IEbYbDUy4RTpMeoSMLPRp8Z5o1u8feSRonpvnWsKKG35tI2LB9VDPiCgTy.Gq2VxQLYjrue4Nq.NBdqI-"
|
|
)
|
|
]
|
|
|
|
testParseListObjectsResult :: Assertion
|
|
testParseListObjectsResult = do
|
|
let xmldata =
|
|
"<?xml version=\"1.0\" encoding=\"UTF-8\"?>\
|
|
\<ListBucketResult xmlns=\"http://s3.amazonaws.com/doc/2006-03-01/\">\
|
|
\<Name>bucket</Name>\
|
|
\<Prefix/>\
|
|
\<NextContinuationToken>opaque</NextContinuationToken>\
|
|
\<KeyCount>1000</KeyCount>\
|
|
\<MaxKeys>1000</MaxKeys>\
|
|
\<IsTruncated>true</IsTruncated>\
|
|
\<Contents>\
|
|
\<Key>my-image.jpg</Key>\
|
|
\<LastModified>2009-10-12T17:50:30.000Z</LastModified>\
|
|
\<ETag>"fba9dede5f27731c9771645a39863328"</ETag>\
|
|
\<Size>434234</Size>\
|
|
\<StorageClass>STANDARD</StorageClass>\
|
|
\</Contents>\
|
|
\</ListBucketResult>"
|
|
expectedListResult = ListObjectsResult True (Just "opaque") [object1] []
|
|
object1 = ObjectInfo "my-image.jpg" modifiedTime1 "\"fba9dede5f27731c9771645a39863328\"" 434234 H.empty H.empty
|
|
modifiedTime1 = flip UTCTime 64230 $ fromGregorian 2009 10 12
|
|
|
|
parsedListObjectsResult <- tryValidationErr $ runTestNS $ parseListObjectsResponse xmldata
|
|
eitherValidationErr parsedListObjectsResult (@?= expectedListResult)
|
|
|
|
testParseListObjectsV1Result :: Assertion
|
|
testParseListObjectsV1Result = do
|
|
let xmldata =
|
|
"<?xml version=\"1.0\" encoding=\"UTF-8\"?>\
|
|
\<ListBucketResult xmlns=\"http://s3.amazonaws.com/doc/2006-03-01/\">\
|
|
\<Name>bucket</Name>\
|
|
\<Prefix/>\
|
|
\<NextMarker>my-image1.jpg</NextMarker>\
|
|
\<KeyCount>1000</KeyCount>\
|
|
\<MaxKeys>1000</MaxKeys>\
|
|
\<IsTruncated>true</IsTruncated>\
|
|
\<Contents>\
|
|
\<Key>my-image.jpg</Key>\
|
|
\<LastModified>2009-10-12T17:50:30.000Z</LastModified>\
|
|
\<ETag>"fba9dede5f27731c9771645a39863328"</ETag>\
|
|
\<Size>434234</Size>\
|
|
\<StorageClass>STANDARD</StorageClass>\
|
|
\</Contents>\
|
|
\</ListBucketResult>"
|
|
expectedListResult = ListObjectsV1Result True (Just "my-image1.jpg") [object1] []
|
|
object1 = ObjectInfo "my-image.jpg" modifiedTime1 "\"fba9dede5f27731c9771645a39863328\"" 434234 H.empty H.empty
|
|
modifiedTime1 = flip UTCTime 64230 $ fromGregorian 2009 10 12
|
|
|
|
parsedListObjectsV1Result <- tryValidationErr $ runTestNS $ parseListObjectsV1Response xmldata
|
|
eitherValidationErr parsedListObjectsV1Result (@?= expectedListResult)
|
|
|
|
testParseListIncompleteUploads :: Assertion
|
|
testParseListIncompleteUploads = do
|
|
let xmldata =
|
|
"<ListMultipartUploadsResult xmlns=\"http://s3.amazonaws.com/doc/2006-03-01/\">\
|
|
\<Bucket>example-bucket</Bucket>\
|
|
\<KeyMarker/>\
|
|
\<UploadIdMarker/>\
|
|
\<NextKeyMarker>sample.jpg</NextKeyMarker>\
|
|
\<NextUploadIdMarker>Xgw4MJT6ZPAVxpY0SAuGN7q4uWJJM22ZYg1W99trdp4tpO88.PT6.MhO0w2E17eutfAvQfQWoajgE_W2gpcxQw--</NextUploadIdMarker>\
|
|
\<Delimiter>/</Delimiter>\
|
|
\<Prefix/>\
|
|
\<MaxUploads>1000</MaxUploads>\
|
|
\<IsTruncated>false</IsTruncated>\
|
|
\<Upload>\
|
|
\<Key>sample.jpg</Key>\
|
|
\<UploadId>Agw4MJT6ZPAVxpY0SAuGN7q4uWJJM22ZYg1N99trdp4tpO88.PT6.MhO0w2E17eutfAvQfQWoajgE_W2gpcxQw--</UploadId>\
|
|
\<Initiator>\
|
|
\<ID>314133b66967d86f031c7249d1d9a80249109428335cd0ef1cdc487b4566cb1b</ID>\
|
|
\<DisplayName>s3-nickname</DisplayName>\
|
|
\</Initiator>\
|
|
\<Owner>\
|
|
\<ID>314133b66967d86f031c7249d1d9a80249109428335cd0ef1cdc487b4566cb1b</ID>\
|
|
\<DisplayName>s3-nickname</DisplayName>\
|
|
\</Owner>\
|
|
\<StorageClass>STANDARD</StorageClass>\
|
|
\<Initiated>2010-11-26T19:24:17.000Z</Initiated>\
|
|
\</Upload>\
|
|
\<CommonPrefixes>\
|
|
\<Prefix>photos/</Prefix>\
|
|
\</CommonPrefixes>\
|
|
\<CommonPrefixes>\
|
|
\<Prefix>videos/</Prefix>\
|
|
\</CommonPrefixes>\
|
|
\</ListMultipartUploadsResult>"
|
|
expectedListResult = ListUploadsResult False (Just "sample.jpg") (Just "Xgw4MJT6ZPAVxpY0SAuGN7q4uWJJM22ZYg1W99trdp4tpO88.PT6.MhO0w2E17eutfAvQfQWoajgE_W2gpcxQw--") uploads prefixes
|
|
uploads = [("sample.jpg", "Agw4MJT6ZPAVxpY0SAuGN7q4uWJJM22ZYg1N99trdp4tpO88.PT6.MhO0w2E17eutfAvQfQWoajgE_W2gpcxQw--", initTime)]
|
|
initTime = UTCTime (fromGregorian 2010 11 26) 69857
|
|
prefixes = ["photos/", "videos/"]
|
|
|
|
parsedListUploadsResult <- tryValidationErr $ runTestNS $ parseListUploadsResponse xmldata
|
|
eitherValidationErr parsedListUploadsResult (@?= expectedListResult)
|
|
|
|
testParseCompleteMultipartUploadResponse :: Assertion
|
|
testParseCompleteMultipartUploadResponse = do
|
|
let xmldata =
|
|
"<?xml version=\"1.0\" encoding=\"UTF-8\"?>\
|
|
\<CompleteMultipartUploadResult xmlns=\"http://s3.amazonaws.com/doc/2006-03-01/\">\
|
|
\<Location>http://Example-Bucket.s3.amazonaws.com/Example-Object</Location>\
|
|
\<Bucket>Example-Bucket</Bucket>\
|
|
\<Key>Example-Object</Key>\
|
|
\<ETag>\"3858f62230ac3c915f300c664312c11f-9\"</ETag>\
|
|
\</CompleteMultipartUploadResult>"
|
|
expectedETag = "\"3858f62230ac3c915f300c664312c11f-9\""
|
|
|
|
parsedETagE <- runExceptT $ runTestNS $ parseCompleteMultipartUploadResponse xmldata
|
|
eitherValidationErr parsedETagE (@?= expectedETag)
|
|
|
|
testParseListPartsResponse :: Assertion
|
|
testParseListPartsResponse = do
|
|
let xmldata =
|
|
"<?xml version=\"1.0\" encoding=\"UTF-8\"?>\
|
|
\<ListPartsResult xmlns=\"http://s3.amazonaws.com/doc/2006-03-01/\">\
|
|
\<Bucket>example-bucket</Bucket>\
|
|
\<Key>example-object</Key>\
|
|
\<UploadId>XXBsb2FkIElEIGZvciBlbHZpbmcncyVcdS1tb3ZpZS5tMnRzEEEwbG9hZA</UploadId>\
|
|
\<Initiator>\
|
|
\<ID>arn:aws:iam::111122223333:user/some-user-11116a31-17b5-4fb7-9df5-b288870f11xx</ID>\
|
|
\<DisplayName>umat-user-11116a31-17b5-4fb7-9df5-b288870f11xx</DisplayName>\
|
|
\</Initiator>\
|
|
\<Owner>\
|
|
\<ID>75aa57f09aa0c8caeab4f8c24e99d10f8e7faeebf76c078efc7c6caea54ba06a</ID>\
|
|
\<DisplayName>someName</DisplayName>\
|
|
\</Owner>\
|
|
\<StorageClass>STANDARD</StorageClass>\
|
|
\<PartNumberMarker>1</PartNumberMarker>\
|
|
\<NextPartNumberMarker>3</NextPartNumberMarker>\
|
|
\<MaxParts>2</MaxParts>\
|
|
\<IsTruncated>true</IsTruncated>\
|
|
\<Part>\
|
|
\<PartNumber>2</PartNumber>\
|
|
\<LastModified>2010-11-10T20:48:34.000Z</LastModified>\
|
|
\<ETag>\"7778aef83f66abc1fa1e8477f296d394\"</ETag>\
|
|
\<Size>10485760</Size>\
|
|
\</Part>\
|
|
\<Part>\
|
|
\<PartNumber>3</PartNumber>\
|
|
\<LastModified>2010-11-10T20:48:33.000Z</LastModified>\
|
|
\<ETag>\"aaaa18db4cc2f85cedef654fccc4a4x8\"</ETag>\
|
|
\<Size>10485760</Size>\
|
|
\</Part>\
|
|
\</ListPartsResult>"
|
|
expectedListResult = ListPartsResult True (Just 3) [part1, part2]
|
|
part1 = ObjectPartInfo 2 "\"7778aef83f66abc1fa1e8477f296d394\"" 10485760 modifiedTime1
|
|
modifiedTime1 = flip UTCTime 74914 $ fromGregorian 2010 11 10
|
|
part2 = ObjectPartInfo 3 "\"aaaa18db4cc2f85cedef654fccc4a4x8\"" 10485760 modifiedTime2
|
|
modifiedTime2 = flip UTCTime 74913 $ fromGregorian 2010 11 10
|
|
|
|
parsedListPartsResult <- runExceptT $ runTestNS $ parseListPartsResponse xmldata
|
|
eitherValidationErr parsedListPartsResult (@?= expectedListResult)
|
|
|
|
testParseCopyObjectResponse :: Assertion
|
|
testParseCopyObjectResponse = do
|
|
let cases =
|
|
[ ( "<?xml version=\"1.0\" encoding=\"UTF-8\"?>\
|
|
\<CopyObjectResult xmlns=\"http://s3.amazonaws.com/doc/2006-03-01/\">\
|
|
\<LastModified>2009-10-28T22:32:00.000Z</LastModified>\
|
|
\<ETag>\"9b2cf535f27731c974343645a3985328\"</ETag>\
|
|
\</CopyObjectResult>",
|
|
( "\"9b2cf535f27731c974343645a3985328\"",
|
|
UTCTime (fromGregorian 2009 10 28) 81120
|
|
)
|
|
),
|
|
( "<?xml version=\"1.0\" encoding=\"UTF-8\"?>\
|
|
\<CopyPartResult xmlns=\"http://s3.amazonaws.com/doc/2006-03-01/\">\
|
|
\<LastModified>2009-10-28T22:32:00.000Z</LastModified>\
|
|
\<ETag>\"9b2cf535f27731c974343645a3985328\"</ETag>\
|
|
\</CopyPartResult>",
|
|
( "\"9b2cf535f27731c974343645a3985328\"",
|
|
UTCTime (fromGregorian 2009 10 28) 81120
|
|
)
|
|
)
|
|
]
|
|
|
|
forM_ cases $ \(xmldata, (etag, modTime)) -> do
|
|
parseResult <- runExceptT $ runTestNS $ parseCopyObjectResponse xmldata
|
|
eitherValidationErr parseResult (@?= (etag, modTime))
|
|
|
|
testParseNotification :: Assertion
|
|
testParseNotification = do
|
|
let cases =
|
|
[ ( "<NotificationConfiguration xmlns=\"http://s3.amazonaws.com/doc/2006-03-01/\">\
|
|
\ <TopicConfiguration>\
|
|
\ <Id>YjVkM2Y0YmUtNGI3NC00ZjQyLWEwNGItNDIyYWUxY2I0N2M4</Id>\
|
|
\ <Topic>arn:aws:sns:us-east-1:account-id:s3notificationtopic2</Topic>\
|
|
\ <Event>s3:ReducedRedundancyLostObject</Event>\
|
|
\ <Event>s3:ObjectCreated:*</Event>\
|
|
\ </TopicConfiguration>\
|
|
\</NotificationConfiguration>",
|
|
Notification
|
|
[]
|
|
[ NotificationConfig
|
|
"YjVkM2Y0YmUtNGI3NC00ZjQyLWEwNGItNDIyYWUxY2I0N2M4"
|
|
"arn:aws:sns:us-east-1:account-id:s3notificationtopic2"
|
|
[ReducedRedundancyLostObject, ObjectCreated]
|
|
defaultFilter
|
|
]
|
|
[]
|
|
),
|
|
( "<NotificationConfiguration xmlns=\"http://s3.amazonaws.com/doc/2006-03-01/\">\
|
|
\ <CloudFunctionConfiguration>\
|
|
\ <Id>ObjectCreatedEvents</Id>\
|
|
\ <CloudFunction>arn:aws:lambda:us-west-2:35667example:function:CreateThumbnail</CloudFunction>\
|
|
\ <Event>s3:ObjectCreated:*</Event>\
|
|
\ </CloudFunctionConfiguration>\
|
|
\ <QueueConfiguration>\
|
|
\ <Id>1</Id>\
|
|
\ <Filter>\
|
|
\ <S3Key>\
|
|
\ <FilterRule>\
|
|
\ <Name>prefix</Name>\
|
|
\ <Value>images/</Value>\
|
|
\ </FilterRule>\
|
|
\ <FilterRule>\
|
|
\ <Name>suffix</Name>\
|
|
\ <Value>.jpg</Value>\
|
|
\ </FilterRule>\
|
|
\ </S3Key>\
|
|
\ </Filter>\
|
|
\ <Queue>arn:aws:sqs:us-west-2:444455556666:s3notificationqueue</Queue>\
|
|
\ <Event>s3:ObjectCreated:Put</Event>\
|
|
\ </QueueConfiguration>\
|
|
\ <TopicConfiguration>\
|
|
\ <Topic>arn:aws:sns:us-east-1:356671443308:s3notificationtopic2</Topic>\
|
|
\ <Event>s3:ReducedRedundancyLostObject</Event>\
|
|
\ </TopicConfiguration>\
|
|
\ <QueueConfiguration>\
|
|
\ <Queue>arn:aws:sqs:us-east-1:356671443308:s3notificationqueue</Queue>\
|
|
\ <Event>s3:ObjectCreated:*</Event>\
|
|
\ </QueueConfiguration>)\
|
|
\</NotificationConfiguration>",
|
|
Notification
|
|
[ NotificationConfig
|
|
"1"
|
|
"arn:aws:sqs:us-west-2:444455556666:s3notificationqueue"
|
|
[ObjectCreatedPut]
|
|
( Filter $ FilterKey $
|
|
FilterRules
|
|
[ FilterRule "prefix" "images/",
|
|
FilterRule "suffix" ".jpg"
|
|
]
|
|
),
|
|
NotificationConfig
|
|
""
|
|
"arn:aws:sqs:us-east-1:356671443308:s3notificationqueue"
|
|
[ObjectCreated]
|
|
defaultFilter
|
|
]
|
|
[ NotificationConfig
|
|
""
|
|
"arn:aws:sns:us-east-1:356671443308:s3notificationtopic2"
|
|
[ReducedRedundancyLostObject]
|
|
defaultFilter
|
|
]
|
|
[ NotificationConfig
|
|
"ObjectCreatedEvents"
|
|
"arn:aws:lambda:us-west-2:35667example:function:CreateThumbnail"
|
|
[ObjectCreated]
|
|
defaultFilter
|
|
]
|
|
)
|
|
]
|
|
|
|
forM_ cases $ \(xmldata, val) -> do
|
|
result <- runExceptT $ runTestNS $ parseNotification xmldata
|
|
eitherValidationErr result (@?= val)
|
|
|
|
-- | Tests parsing of both progress and stats
|
|
testParseSelectProgress :: Assertion
|
|
testParseSelectProgress = do
|
|
let cases =
|
|
[ ( [r|<?xml version="1.0" encoding="UTF-8"?>
|
|
<Progress>
|
|
<BytesScanned>512</BytesScanned>
|
|
<BytesProcessed>1024</BytesProcessed>
|
|
<BytesReturned>1024</BytesReturned>
|
|
</Progress>|],
|
|
Progress 512 1024 1024
|
|
),
|
|
( [r|<?xml version="1.0" encoding="UTF-8"?>
|
|
<Stats>
|
|
<BytesScanned>512</BytesScanned>
|
|
<BytesProcessed>1024</BytesProcessed>
|
|
<BytesReturned>1024</BytesReturned>
|
|
</Stats>|],
|
|
Progress 512 1024 1024
|
|
)
|
|
]
|
|
|
|
forM_ cases $ \(xmldata, progress) -> do
|
|
result <- runExceptT $ parseSelectProgress xmldata
|
|
eitherValidationErr result (@?= progress)
|