Add Bucket Notification APIs (#59)

- Adds get, put and remove operations

- Also adds more sections to the haddock API doc to make it more
  friendly.

src/Network/Minio.hs

@@ -19,61 +19,86 @@
 module Network.Minio
   (
 
+  -- * Connecting to object storage
+  ---------------------------------
     ConnectInfo(..)
   , awsCI
 
-
+  -- ** Connection helpers
+  ------------------------
   , awsWithRegionCI
   , minioPlayCI
   , minioCI
 
+  -- * Minio Monad
+  ----------------
+  -- | The Minio monad provides connection-reuse, bucket-location
+  -- caching, resource management and simpler error handling
+  -- functionality. All actions on object storage are performed within
+  -- this Monad.
+
   , Minio
   , runMinio
   , def
 
-  -- * Error handling
-  -----------------------
-  -- | Data types representing various errors that may occur while working
-  -- with an object storage service.
-  , MinioErr(..)
-  , MErrV(..)
-  , ServiceErr(..)
-
-  -- * Data Types
-  ----------------
-  -- | Data types representing various object store concepts.
-  , Bucket
-  , Object
-  , BucketInfo(..)
-  , ObjectInfo(..)
-  , UploadInfo(..)
-  , ObjectPartInfo(..)
-  , UploadId
-  , ObjectData(..)
-  , CopyPartSource(..)
-
   -- * Bucket Operations
   ----------------------
-  , listBuckets
+
-  , getLocation
+  -- ** Creation, removal and querying
-  , bucketExists
+  , Bucket
   , makeBucket
   , removeBucket
+  , bucketExists
+  , Region
+  , getLocation
 
+  -- ** Listing
+  , BucketInfo(..)
+  , listBuckets
+  , ObjectInfo(..)
   , listObjects
   , listObjectsV1
+  , UploadId
+  , UploadInfo(..)
   , listIncompleteUploads
+  , ObjectPartInfo(..)
+  , listIncompleteParts
+
+  -- ** Notifications
+  , Notification(..)
+  , NotificationConfig(..)
+  , Arn
+  , Event(..)
+  , Filter(..)
+  , FilterKey(..)
+  , FilterRules(..)
+  , FilterRule(..)
+  , getBucketNotification
+  , putBucketNotification
+  , removeAllBucketNotification
 
   -- * Object Operations
   ----------------------
+
+  , Object
+
+  -- ** File operations
   , fGetObject
   , fPutObject
-  , putObject
-  , copyObject
-  , removeObject
 
+  -- ** Conduit-based streaming operations
+  , putObject
   , getObject
+
+  -- ** Server-side copying
+  , CopyPartSource(..)
+  , copyObject
+
+  -- ** Querying
   , statObject
+
+  -- ** Object removal functions
+  , removeObject
   , removeIncompleteUpload
 
   -- * Presigned Operations
@@ -83,6 +108,14 @@ module Network.Minio
   , presignedGetObjectUrl
   , presignedHeadObjectUrl
 
+  -- ** Utilities for POST (browser) uploads
+  , PostPolicy
+  , PostPolicyError(..)
+  , newPostPolicy
+  , presignedPostPolicy
+  , showPostPolicy
+
+  -- *** Utilities to specify Post Policy conditions
   , PostPolicyCondition
   , ppCondBucket
   , ppCondContentLengthRange
@@ -91,12 +124,15 @@ module Network.Minio
   , ppCondKeyStartsWith
   , ppCondSuccessActionStatus
 
-  , PostPolicy
+  -- * Error handling
-  , PostPolicyError(..)
+  -----------------------
-  , newPostPolicy
+  -- | Data types representing various errors that may occur while working
-  , presignedPostPolicy
+  -- with an object storage service.
-  , showPostPolicy
+  , MinioErr(..)
-  ) where
+  , MErrV(..)
+  , ServiceErr(..)
+
+) where
 
 {-
 This module exports the high-level Minio API for object storage.

src/Network/Minio/Data.hs

@@ -34,6 +34,8 @@ import qualified Network.HTTP.Types as HT
 import           Network.Minio.Errors
 import           Text.XML
 
+import           GHC.Show (Show(..))
+
 import           Lib.Prelude
 
 
@@ -280,6 +282,106 @@ cpsToObject cps = do
   where
     splits = T.splitOn "/" $ cpSource cps
 
+-- | A data-type for events that can occur in the object storage
+-- server. Reference:
+-- https://docs.aws.amazon.com/AmazonS3/latest/dev/NotificationHowTo.html#supported-notification-event-types
+data Event = ObjectCreated
+           | ObjectCreatedPut
+           | ObjectCreatedPost
+           | ObjectCreatedCopy
+           | ObjectCreatedMultipartUpload
+           | ObjectRemoved
+           | ObjectRemovedDelete
+           | ObjectRemovedDeleteMarkerCreated
+           | ReducedRedundancyLostObject
+           deriving (Eq)
+
+instance Show Event where
+  show ObjectCreated                    = "s3:ObjectCreated:*"
+  show ObjectCreatedPut                 = "s3:ObjectCreated:Put"
+  show ObjectCreatedPost                = "s3:ObjectCreated:Post"
+  show ObjectCreatedCopy                = "s3:ObjectCreated:Copy"
+  show ObjectCreatedMultipartUpload     = "s3:ObjectCreated:MultipartUpload"
+  show ObjectRemoved                    = "s3:ObjectRemoved:*"
+  show ObjectRemovedDelete              = "s3:ObjectRemoved:Delete"
+  show ObjectRemovedDeleteMarkerCreated = "s3:ObjectRemoved:DeleteMarkerCreated"
+  show ReducedRedundancyLostObject      = "s3:ReducedRedundancyLostObject"
+
+textToEvent :: Text -> Maybe Event
+textToEvent t = case t of
+  "s3:ObjectCreated:*"                   -> Just ObjectCreated
+  "s3:ObjectCreated:Put"                 -> Just ObjectCreatedPut
+  "s3:ObjectCreated:Post"                -> Just ObjectCreatedPost
+  "s3:ObjectCreated:Copy"                -> Just ObjectCreatedCopy
+  "s3:ObjectCreated:MultipartUpload"     -> Just ObjectCreatedMultipartUpload
+  "s3:ObjectRemoved:*"                   -> Just ObjectRemoved
+  "s3:ObjectRemoved:Delete"              -> Just ObjectRemovedDelete
+  "s3:ObjectRemoved:DeleteMarkerCreated" -> Just ObjectRemovedDeleteMarkerCreated
+  "s3:ReducedRedundancyLostObject"       -> Just ReducedRedundancyLostObject
+  _                                      -> Nothing
+
+
+data Filter = Filter
+  { fFilter :: FilterKey
+  } deriving (Show, Eq)
+
+instance Default Filter where
+  def = Filter def
+
+data FilterKey = FilterKey
+  { fkKey :: FilterRules
+  } deriving (Show, Eq)
+
+instance Default FilterKey where
+  def = FilterKey def
+
+data FilterRules = FilterRules
+  { frFilterRules :: [FilterRule]
+  } deriving (Show, Eq)
+
+instance Default FilterRules where
+  def = FilterRules []
+
+-- | A filter rule that can act based on the suffix or prefix of an
+-- object. As an example, let's create two filter rules:
+--
+--    > let suffixRule = FilterRule "suffix" ".jpg"
+--    > let prefixRule = FilterRule "prefix" "images/"
+--
+-- The `suffixRule` restricts the notification to be triggered only
+-- for objects having a suffix of ".jpg", and the `prefixRule`
+-- restricts it to objects having a prefix of "images/".
+data FilterRule = FilterRule
+  { frName :: Text
+  , frValue :: Text
+  } deriving (Show, Eq)
+
+type Arn = Text
+
+-- | A data-type representing the configuration for a particular
+-- notification system. It could represent a Queue, Topic or Lambda
+-- Function configuration.
+data NotificationConfig = NotificationConfig
+  { ncId :: Text
+  , ncArn :: Arn
+  , ncEvents :: [Event]
+  , ncFilter :: Filter
+  } deriving (Show, Eq)
+
+-- | A data-type to represent bucket notification configuration. It is
+-- a collection of queue, topic or lambda function configurations. The
+-- structure of the types follow closely the XML representation
+-- described at
+-- <https://docs.aws.amazon.com/AmazonS3/latest/API/RESTBucketPUTnotification.html>
+data Notification = Notification
+  { nQueueConfigurations :: [NotificationConfig]
+  , nTopicConfigurations :: [NotificationConfig]
+  , nCloudFunctionConfigurations :: [NotificationConfig]
+  } deriving (Eq, Show)
+
+instance Default Notification where
+  def = Notification [] [] []
+
 -- | Represents different kinds of payload that are used with S3 API
 -- requests.
 data Payload = PayloadBS ByteString

src/Network/Minio/S3API.hs

@@ -32,6 +32,7 @@ module Network.Minio.S3API
 
   -- * Retrieving buckets
   , headBucket
+
   -- * Retrieving objects
   -----------------------
   , getObject'
@@ -69,6 +70,20 @@ module Network.Minio.S3API
   -- * Presigned Operations
   -----------------------------
   , module Network.Minio.PresignedOperations
+
+  -- * Bucket Notifications
+  -------------------------
+  , Notification(..)
+  , NotificationConfig(..)
+  , Arn
+  , Event(..)
+  , Filter(..)
+  , FilterKey(..)
+  , FilterRules(..)
+  , FilterRule(..)
+  , getBucketNotification
+  , putBucketNotification
+  , removeAllBucketNotification
   ) where
 
 import           Control.Monad.Catch (catches, Handler(..))
@@ -382,3 +397,26 @@ headBucket bucket = headBucketEx `catches`
                                    , riBucket = Just bucket
                                    }
       return $ NC.responseStatus resp == HT.ok200
+
+-- | Set the notification configuration on a bucket.
+putBucketNotification :: Bucket -> Notification -> Minio ()
+putBucketNotification bucket ncfg =
+  void $ executeRequest $ def { riMethod = HT.methodPut
+                              , riBucket = Just bucket
+                              , riQueryParams = [("notification", Nothing)]
+                              , riPayload = PayloadBS $
+                                            mkPutNotificationRequest ncfg
+                              }
+
+-- | Retrieve the notification configuration on a bucket.
+getBucketNotification :: Bucket -> Minio Notification
+getBucketNotification bucket = do
+  resp <- executeRequest $ def { riMethod = HT.methodGet
+                               , riBucket = Just bucket
+                               , riQueryParams = [("notification", Nothing)]
+                               }
+  parseNotification $ NC.responseBody resp
+
+-- | Remove all notifications configured on a bucket.
+removeAllBucketNotification :: Bucket -> Minio ()
+removeAllBucketNotification = flip putBucketNotification def

src/Network/Minio/XmlGenerator.hs

@@ -17,12 +17,13 @@
 module Network.Minio.XmlGenerator
   ( mkCreateBucketConfig
   , mkCompleteMultipartUploadRequest
+  , mkPutNotificationRequest
   ) where
 
 
 import qualified Data.ByteString.Lazy as LBS
-import qualified Data.Map as M
+import qualified Data.Map             as M
-import qualified Data.Text as T
+import qualified Data.Text            as T
 import           Text.XML
 
 import           Lib.Prelude
@@ -55,3 +56,47 @@ mkCompleteMultipartUploadRequest partInfo =
                                  [NodeContent etag]
                                ]
     cmur = Document (Prologue [] Nothing []) root []
+
+-- Simplified XML representation without element attributes.
+data XNode = XNode Text [XNode]
+           | XLeaf Text Text
+  deriving (Eq, Show)
+
+toXML :: XNode -> ByteString
+toXML node = LBS.toStrict $ renderLBS def $
+  Document (Prologue [] Nothing []) (xmlNode node) []
+  where
+    xmlNode :: XNode -> Element
+    xmlNode (XNode name nodes)   = Element (s3Name name) M.empty $
+                                   map (NodeElement . xmlNode) nodes
+    xmlNode (XLeaf name content) = Element (s3Name name) M.empty
+                                   [NodeContent content]
+
+class ToXNode a where
+  toXNode :: a -> XNode
+
+instance ToXNode Event where
+  toXNode = XLeaf "Event" . show
+
+instance ToXNode Notification where
+  toXNode (Notification qc tc lc) = XNode "NotificationConfiguration" $
+    map (toXNodesWithArnName "QueueConfiguration" "Queue") qc ++
+    map (toXNodesWithArnName "TopicConfiguration" "Topic") tc ++
+    map (toXNodesWithArnName "CloudFunctionConfiguration" "CloudFunction") lc
+
+toXNodesWithArnName :: Text -> Text -> NotificationConfig -> XNode
+toXNodesWithArnName eltName arnName (NotificationConfig id arn events fRule) =
+  XNode eltName $ [XLeaf "Id" id, XLeaf arnName arn] ++ map toXNode events ++
+  [toXNode fRule]
+
+instance ToXNode Filter where
+  toXNode (Filter (FilterKey (FilterRules rules))) =
+    XNode "Filter" [XNode "S3Key" (map getFRXNode rules)]
+
+getFRXNode :: FilterRule -> XNode
+getFRXNode (FilterRule n v) = XNode "FilterRule" [ XLeaf "Name" n
+                                                 , XLeaf "Value" v
+                                                 ]
+
+mkPutNotificationRequest :: Notification -> ByteString
+mkPutNotificationRequest = toXML . toXNode

src/Network/Minio/XmlParser.hs

@@ -25,15 +25,16 @@ module Network.Minio.XmlParser
   , parseListUploadsResponse
   , parseListPartsResponse
   , parseErrResponse
+  , parseNotification
   ) where
 
 import           Control.Monad.Trans.Resource
-import           Data.List (zip3, zip4)
+import           Data.List                    (zip3, zip4)
-import qualified Data.Text as T
+import qualified Data.Text                    as T
-import           Data.Text.Read (decimal)
+import           Data.Text.Read               (decimal)
 import           Data.Time
 import           Text.XML
-import           Text.XML.Cursor hiding (bool)
+import           Text.XML.Cursor              hiding (bool)
 
 import           Lib.Prelude
 
@@ -56,7 +57,8 @@ parseS3XMLTime = either (throwM . MErrVXmlParse) return
                . T.unpack
 
 parseDecimal :: (MonadThrow m, Integral a) => Text -> m a
-parseDecimal numStr = either (throwM . MErrVXmlParse . show) return $ fst <$> decimal numStr
+parseDecimal numStr = either (throwM . MErrVXmlParse . show) return $
+                      fst <$> decimal numStr
 
 parseDecimals :: (MonadThrow m, Integral a) => [Text] -> m [a]
 parseDecimals numStr = forM numStr parseDecimal
@@ -87,15 +89,13 @@ parseLocation xmldata = do
   return $ bool "us-east-1" region $ region /= ""
 
 -- | Parse the response XML of an newMultipartUpload call.
-parseNewMultipartUpload :: (MonadThrow m)
+parseNewMultipartUpload :: (MonadThrow m) => LByteString -> m UploadId
-                        => LByteString -> m UploadId
 parseNewMultipartUpload xmldata = do
   r <- parseRoot xmldata
   return $ T.concat $ r $// s3Elem "UploadId" &/ content
 
 -- | Parse the response XML of completeMultipartUpload call.
-parseCompleteMultipartUploadResponse :: (MonadThrow m)
+parseCompleteMultipartUploadResponse :: (MonadThrow m) => LByteString -> m ETag
-                                     => LByteString -> m ETag
 parseCompleteMultipartUploadResponse xmldata = do
   r <- parseRoot xmldata
   return $ T.concat $ r $// s3Elem "ETag" &/ content
@@ -139,8 +139,7 @@ parseListObjectsV1Response xmldata = do
   return $ ListObjectsV1Result hasMore nextMarker objects prefixes
 
 -- | Parse the response XML of a list objects call.
-parseListObjectsResponse :: (MonadThrow m)
+parseListObjectsResponse :: (MonadThrow m) => LByteString -> m ListObjectsResult
-                         => LByteString -> m ListObjectsResult
 parseListObjectsResponse xmldata = do
   r <- parseRoot xmldata
   let
@@ -167,8 +166,7 @@ parseListObjectsResponse xmldata = do
   return $ ListObjectsResult hasMore nextToken objects prefixes
 
 -- | Parse the response XML of a list incomplete multipart upload call.
-parseListUploadsResponse :: (MonadThrow m)
+parseListUploadsResponse :: (MonadThrow m) => LByteString -> m ListUploadsResult
-                         => LByteString -> m ListUploadsResult
 parseListUploadsResponse xmldata = do
   r <- parseRoot xmldata
   let
@@ -187,8 +185,7 @@ parseListUploadsResponse xmldata = do
 
   return $ ListUploadsResult hasMore nextKey nextUpload uploads prefixes
 
-parseListPartsResponse :: (MonadThrow m)
+parseListPartsResponse :: (MonadThrow m) => LByteString -> m ListPartsResult
-                       => LByteString -> m ListPartsResult
 parseListPartsResponse xmldata = do
   r <- parseRoot xmldata
   let
@@ -211,10 +208,35 @@ parseListPartsResponse xmldata = do
   return $ ListPartsResult hasMore (listToMaybe nextPartNum) partInfos
 
 
-parseErrResponse :: (MonadThrow m)
+parseErrResponse :: (MonadThrow m) => LByteString -> m ServiceErr
-                 => LByteString -> m ServiceErr
 parseErrResponse xmldata = do
   r <- parseRoot xmldata
   let code = T.concat $ r $/ element "Code" &/ content
       message = T.concat $ r $/ element "Message" &/ content
   return $ toServiceErr code message
+
+parseNotification :: (MonadThrow m) => LByteString -> m Notification
+parseNotification xmldata = do
+  r <- parseRoot xmldata
+  let qcfg = map node $ r $/ s3Elem "QueueConfiguration"
+      tcfg = map node $ r $/ s3Elem "TopicConfiguration"
+      lcfg = map node $ r $/ s3Elem "CloudFunctionConfiguration"
+  Notification <$> (mapM (parseNode "Queue") qcfg)
+    <*> (mapM (parseNode "Topic") tcfg)
+    <*> (mapM (parseNode "CloudFunction") lcfg)
+  where
+
+    getFilterRule c =
+      let name = T.concat $ c $/ s3Elem "Name" &/ content
+          value = T.concat $ c $/ s3Elem "Value" &/ content
+      in FilterRule name value
+
+    parseNode arnName nodeData = do
+      let c = fromNode nodeData
+          id = T.concat $ c $/ s3Elem "Id" &/ content
+          arn = T.concat $ c $/ s3Elem arnName &/ content
+          events = catMaybes $ map textToEvent $ c $/ s3Elem "Event" &/ content
+          rules = c $/ s3Elem "Filter" &/ s3Elem "S3Key" &/
+                  s3Elem "FilterRule" &| getFilterRule
+      return $ NotificationConfig id arn events
+        (Filter $ FilterKey $ FilterRules rules)

test/Network/Minio/XmlGenerator/Test.hs

@@ -18,17 +18,22 @@ module Network.Minio.XmlGenerator.Test
   ( xmlGeneratorTests
   ) where
 
-import Test.Tasty
+import           Test.Tasty
-import Test.Tasty.HUnit
+import           Test.Tasty.HUnit
 
-import Lib.Prelude
+import           Lib.Prelude
 
-import Network.Minio.XmlGenerator
+import           Data.Default               (def)
+
+import           Network.Minio.Data
+import           Network.Minio.XmlGenerator
+import           Network.Minio.XmlParser    (parseNotification)
 
 xmlGeneratorTests :: TestTree
 xmlGeneratorTests = testGroup "XML Generator Tests"
   [ testCase "Test mkCreateBucketConfig" testMkCreateBucketConfig
   , testCase "Test mkCompleteMultipartUploadRequest" testMkCompleteMultipartUploadRequest
+  , testCase "Test mkPutNotificationRequest" testMkPutNotificationRequest
   ]
 
 testMkCreateBucketConfig :: Assertion
@@ -52,3 +57,39 @@ testMkCompleteMultipartUploadRequest =
     \<PartNumber>1</PartNumber><ETag>abc</ETag>\
     \</Part>\
     \</CompleteMultipartUpload>"
+
+testMkPutNotificationRequest :: Assertion
+testMkPutNotificationRequest =
+  forM_ cases $ \val -> do
+    let result = toS $ mkPutNotificationRequest val
+    ntf <- runExceptT $ parseNotification result
+    either (\_ -> assertFailure "XML Parse Error!")
+      (@?= val) ntf
+  where
+    cases = [ Notification []
+              [ NotificationConfig
+                "YjVkM2Y0YmUtNGI3NC00ZjQyLWEwNGItNDIyYWUxY2I0N2M4"
+                "arn:aws:sns:us-east-1:account-id:s3notificationtopic2"
+                [ReducedRedundancyLostObject, ObjectCreated] def
+              ]
+              []
+            , 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
+              ]
+            ]

test/Network/Minio/XmlParser/Test.hs

@@ -19,13 +19,15 @@ module Network.Minio.XmlParser.Test
     xmlParserTests
   ) where
 
-import qualified Control.Monad.Catch as MC
+import qualified Control.Monad.Catch     as MC
-import           Data.Time (fromGregorian)
+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
@@ -40,6 +42,7 @@ xmlParserTests = testGroup "XML Parser Tests"
   , 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)
@@ -49,7 +52,7 @@ 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 (Left e) _  = assertValidtionErr e
 eitherValidationErr (Right a) f = f a
 
 testParseLocation :: Assertion
@@ -279,3 +282,77 @@ testParseCopyObjectResponse = do
   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)