--
-- 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.
--
module Network.Minio.XmlParser.Test
(
xmlParserTests
) where
import qualified Control.Monad.Catch as MC
import Data.Time (fromGregorian)
import qualified Data.Map as Map
import Test.Tasty
import Test.Tasty.HUnit
import Lib.Prelude
import Data.Default (def)
import Network.Minio.Data
import Network.Minio.Errors
import Network.Minio.XmlParser
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
]
tryValidationErr :: (MC.MonadCatch m) => m a -> m (Either MErrV a)
tryValidationErr act = MC.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.
("\
\EU",
"EU"
)
,
-- 3. Test parsing of a valid, empty location xml.
("",
"us-east-1"
)
]
testParseNewMultipartUpload :: Assertion
testParseNewMultipartUpload = do
forM_ cases $ \(xmldata, expectedUploadId) -> do
parsedUploadIdE <- tryValidationErr $ parseNewMultipartUpload xmldata
eitherValidationErr parsedUploadIdE (@?= expectedUploadId)
where
cases = [
("\
\\
\ example-bucket\
\ example-object\
\ VXBsb2FkIElEIGZvciA2aWWpbmcncyBteS1tb3ZpZS5tMnRzIHVwbG9hZA\
\",
"VXBsb2FkIElEIGZvciA2aWWpbmcncyBteS1tb3ZpZS5tMnRzIHVwbG9hZA"
),
("\
\\
\ example-bucket\
\ example-object\
\ EXAMPLEJZ6e0YupT2h66iePQCc9IEbYbDUy4RTpMeoSMLPRp8Z5o1u8feSRonpvnWsKKG35tI2LB9VDPiCgTy.Gq2VxQLYjrue4Nq.NBdqI-\
\",
"EXAMPLEJZ6e0YupT2h66iePQCc9IEbYbDUy4RTpMeoSMLPRp8Z5o1u8feSRonpvnWsKKG35tI2LB9VDPiCgTy.Gq2VxQLYjrue4Nq.NBdqI-"
)
]
testParseListObjectsResult :: Assertion
testParseListObjectsResult = do
let
xmldata = "\
\\
\bucket\
\\
\opaque\
\1000\
\1000\
\true\
\\
\my-image.jpg\
\2009-10-12T17:50:30.000Z\
\"fba9dede5f27731c9771645a39863328"\
\434234\
\STANDARD\
\\
\"
expectedListResult = ListObjectsResult True (Just "opaque") [object1] []
object1 = ObjectInfo "my-image.jpg" modifiedTime1 "\"fba9dede5f27731c9771645a39863328\"" 434234 Map.empty
modifiedTime1 = flip UTCTime 64230 $ fromGregorian 2009 10 12
parsedListObjectsResult <- tryValidationErr $ parseListObjectsResponse xmldata
eitherValidationErr parsedListObjectsResult (@?= expectedListResult)
testParseListObjectsV1Result :: Assertion
testParseListObjectsV1Result = do
let
xmldata = "\
\\
\bucket\
\\
\my-image1.jpg\
\1000\
\1000\
\true\
\\
\my-image.jpg\
\2009-10-12T17:50:30.000Z\
\"fba9dede5f27731c9771645a39863328"\
\434234\
\STANDARD\
\\
\"
expectedListResult = ListObjectsV1Result True (Just "my-image1.jpg") [object1] []
object1 = ObjectInfo "my-image.jpg" modifiedTime1 "\"fba9dede5f27731c9771645a39863328\"" 434234 Map.empty
modifiedTime1 = flip UTCTime 64230 $ fromGregorian 2009 10 12
parsedListObjectsV1Result <- tryValidationErr $ parseListObjectsV1Response xmldata
eitherValidationErr parsedListObjectsV1Result (@?= expectedListResult)
testParseListIncompleteUploads :: Assertion
testParseListIncompleteUploads = do
let
xmldata = "\
\example-bucket\
\\
\\
\sample.jpg\
\Xgw4MJT6ZPAVxpY0SAuGN7q4uWJJM22ZYg1W99trdp4tpO88.PT6.MhO0w2E17eutfAvQfQWoajgE_W2gpcxQw--\
\/\
\\
\1000\
\false\
\\
\sample.jpg\
\Agw4MJT6ZPAVxpY0SAuGN7q4uWJJM22ZYg1N99trdp4tpO88.PT6.MhO0w2E17eutfAvQfQWoajgE_W2gpcxQw--\
\\
\314133b66967d86f031c7249d1d9a80249109428335cd0ef1cdc487b4566cb1b\
\s3-nickname\
\\
\\
\314133b66967d86f031c7249d1d9a80249109428335cd0ef1cdc487b4566cb1b\
\s3-nickname\
\\
\STANDARD\
\2010-11-26T19:24:17.000Z\
\\
\\
\photos/\
\\
\\
\videos/\
\\
\"
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 $ parseListUploadsResponse xmldata
eitherValidationErr parsedListUploadsResult (@?= expectedListResult)
testParseCompleteMultipartUploadResponse :: Assertion
testParseCompleteMultipartUploadResponse = do
let
xmldata = "\
\\
\http://Example-Bucket.s3.amazonaws.com/Example-Object\
\Example-Bucket\
\Example-Object\
\\"3858f62230ac3c915f300c664312c11f-9\"\
\"
expectedETag = "\"3858f62230ac3c915f300c664312c11f-9\""
parsedETagE <- runExceptT $ parseCompleteMultipartUploadResponse xmldata
eitherValidationErr parsedETagE (@?= expectedETag)
testParseListPartsResponse :: Assertion
testParseListPartsResponse = do
let
xmldata = "\
\\
\example-bucket\
\example-object\
\XXBsb2FkIElEIGZvciBlbHZpbmcncyVcdS1tb3ZpZS5tMnRzEEEwbG9hZA\
\\
\arn:aws:iam::111122223333:user/some-user-11116a31-17b5-4fb7-9df5-b288870f11xx\
\umat-user-11116a31-17b5-4fb7-9df5-b288870f11xx\
\\
\\
\75aa57f09aa0c8caeab4f8c24e99d10f8e7faeebf76c078efc7c6caea54ba06a\
\someName\
\\
\STANDARD\
\1\
\3\
\2\
\true\
\\
\2\
\2010-11-10T20:48:34.000Z\
\\"7778aef83f66abc1fa1e8477f296d394\"\
\10485760\
\\
\\
\3\
\2010-11-10T20:48:33.000Z\
\\"aaaa18db4cc2f85cedef654fccc4a4x8\"\
\10485760\
\\
\"
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 $ parseListPartsResponse xmldata
eitherValidationErr parsedListPartsResult (@?= expectedListResult)
testParseCopyObjectResponse :: Assertion
testParseCopyObjectResponse = do
let
cases = [ ("\
\\
\2009-10-28T22:32:00.000Z\
\\"9b2cf535f27731c974343645a3985328\"\
\",
("\"9b2cf535f27731c974343645a3985328\"",
UTCTime (fromGregorian 2009 10 28) 81120))
, ("\
\\
\2009-10-28T22:32:00.000Z\
\\"9b2cf535f27731c974343645a3985328\"\
\",
("\"9b2cf535f27731c974343645a3985328\"",
UTCTime (fromGregorian 2009 10 28) 81120))]
forM_ cases $ \(xmldata, (etag, modTime)) -> do
parseResult <- runExceptT $ parseCopyObjectResponse xmldata
eitherValidationErr parseResult (@?= (etag, modTime))
testParseNotification :: Assertion
testParseNotification = do
let
cases = [ ("\
\ \
\ YjVkM2Y0YmUtNGI3NC00ZjQyLWEwNGItNDIyYWUxY2I0N2M4\
\ arn:aws:sns:us-east-1:account-id:s3notificationtopic2\
\ s3:ReducedRedundancyLostObject\
\ s3:ObjectCreated:*\
\ \
\",
Notification []
[ NotificationConfig
"YjVkM2Y0YmUtNGI3NC00ZjQyLWEwNGItNDIyYWUxY2I0N2M4"
"arn:aws:sns:us-east-1:account-id:s3notificationtopic2"
[ReducedRedundancyLostObject, ObjectCreated] def
]
[])
, ("\
\ \
\ ObjectCreatedEvents\
\ arn:aws:lambda:us-west-2:35667example:function:CreateThumbnail\
\ s3:ObjectCreated:*\
\ \
\ \
\ 1\
\ \
\ \
\ \
\ prefix\
\ images/\
\ \
\ \
\ suffix\
\ .jpg\
\ \
\ \
\ \
\ arn:aws:sqs:us-west-2:444455556666:s3notificationqueue\
\ s3:ObjectCreated:Put\
\ \
\ \
\ arn:aws:sns:us-east-1:356671443308:s3notificationtopic2\
\ s3:ReducedRedundancyLostObject\
\ \
\ \
\ arn:aws:sqs:us-east-1:356671443308:s3notificationqueue\
\ s3:ObjectCreated:*\
\ )\
\",
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] def
]
[ NotificationConfig
"" "arn:aws:sns:us-east-1:356671443308:s3notificationtopic2"
[ReducedRedundancyLostObject] def
]
[ NotificationConfig
"ObjectCreatedEvents" "arn:aws:lambda:us-west-2:35667example:function:CreateThumbnail"
[ObjectCreated] def
])
]
forM_ cases $ \(xmldata, val) -> do
result <- runExceptT $ parseNotification xmldata
eitherValidationErr result (@?= val)