Test.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.
--

module Network.Minio.XmlParser.Test
  (
    xmlParserTests
  ) where

import qualified Control.Monad.Catch     as MC
import           Data.Time               (fromGregorian)
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.
      ("<?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 $ 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>&quot;fba9dede5f27731c9771645a39863328&quot;</ETag>\
              \<Size>434234</Size>\
              \<StorageClass>STANDARD</StorageClass>\
              \</Contents>\
              \</ListBucketResult>"

    expectedListResult = ListObjectsResult True (Just "opaque") [object1] []
    object1 = ObjectInfo "my-image.jpg" modifiedTime1 "\"fba9dede5f27731c9771645a39863328\"" 434234
    modifiedTime1 = flip UTCTime 64230 $ fromGregorian 2009 10 12

  parsedListObjectsResult <- tryValidationErr $ 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>&quot;fba9dede5f27731c9771645a39863328&quot;</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
    modifiedTime1 = flip UTCTime 64230 $ fromGregorian 2009 10 12

  parsedListObjectsV1Result <- tryValidationErr $ 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 $ 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 $ 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 $ 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 $ 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] def
                ]
                [])
            , ("<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] 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)