-- -- 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)