diff --git a/Aws/Core.hs b/Aws/Core.hs --- a/Aws/Core.hs +++ b/Aws/Core.hs @@ -30,6 +30,7 @@ , elCont , force , forceM +, textReadBool , textReadInt , readInt , xmlCursorConsumer @@ -833,6 +834,13 @@ -- | Extract the first element from a monadic parser result list, and throw an 'XmlException' if the list is empty. forceM :: MonadThrow m => String -> [m a] -> m a forceM = Cu.forceM . XmlException + +-- | Read a boolean from a 'T.Text', throwing an 'XmlException' on failure. +textReadBool :: MonadThrow m => T.Text -> m Bool +textReadBool s = case T.unpack s of + "true" -> return True + "false" -> return False + _ -> throwM $ XmlException "Invalid Bool" -- | Read an integer from a 'T.Text', throwing an 'XmlException' on failure. textReadInt :: (MonadThrow m, Num a) => T.Text -> m a diff --git a/Aws/S3/Commands.hs b/Aws/S3/Commands.hs --- a/Aws/S3/Commands.hs +++ b/Aws/S3/Commands.hs @@ -3,9 +3,11 @@ module Aws.S3.Commands.CopyObject , module Aws.S3.Commands.DeleteBucket , module Aws.S3.Commands.DeleteObject +, module Aws.S3.Commands.DeleteObjectVersion , module Aws.S3.Commands.DeleteObjects , module Aws.S3.Commands.GetBucket , module Aws.S3.Commands.GetBucketLocation +, module Aws.S3.Commands.GetBucketObjectVersions , module Aws.S3.Commands.GetObject , module Aws.S3.Commands.GetService , module Aws.S3.Commands.HeadObject @@ -18,9 +20,11 @@ import Aws.S3.Commands.CopyObject import Aws.S3.Commands.DeleteBucket import Aws.S3.Commands.DeleteObject +import Aws.S3.Commands.DeleteObjectVersion import Aws.S3.Commands.DeleteObjects import Aws.S3.Commands.GetBucket import Aws.S3.Commands.GetBucketLocation +import Aws.S3.Commands.GetBucketObjectVersions import Aws.S3.Commands.GetObject import Aws.S3.Commands.GetService import Aws.S3.Commands.HeadObject diff --git a/Aws/S3/Commands/DeleteObjectVersion.hs b/Aws/S3/Commands/DeleteObjectVersion.hs new file mode 100644 --- /dev/null +++ b/Aws/S3/Commands/DeleteObjectVersion.hs @@ -0,0 +1,52 @@ +module Aws.S3.Commands.DeleteObjectVersion +where + +import Aws.Core +import Aws.S3.Core +import Data.ByteString.Char8 ({- IsString -}) +import qualified Data.Text as T +import qualified Data.Text.Encoding as T + +data DeleteObjectVersion = DeleteObjectVersion { + dovObjectName :: T.Text, + dovBucket :: Bucket, + dovVersionId :: T.Text +} + +deleteObjectVersion :: Bucket -> T.Text -> T.Text -> DeleteObjectVersion +deleteObjectVersion bucket object version + = DeleteObjectVersion { + dovObjectName = object + , dovBucket = bucket + , dovVersionId = version + } + +data DeleteObjectVersionResponse = DeleteObjectVersionResponse { +} + +-- | ServiceConfiguration: 'S3Configuration' +instance SignQuery DeleteObjectVersion where + type ServiceConfiguration DeleteObjectVersion = S3Configuration + signQuery DeleteObjectVersion {..} = s3SignQuery S3Query { + s3QMethod = Delete + , s3QBucket = Just $ T.encodeUtf8 dovBucket + , s3QSubresources = [ ("versionId", Just $ T.encodeUtf8 dovVersionId) ] + , s3QQuery = [] + , s3QContentType = Nothing + , s3QContentMd5 = Nothing + , s3QAmzHeaders = [] + , s3QOtherHeaders = [] + , s3QRequestBody = Nothing + , s3QObject = Just $ T.encodeUtf8 dovObjectName + } + +instance ResponseConsumer DeleteObjectVersion DeleteObjectVersionResponse where + type ResponseMetadata DeleteObjectVersionResponse = S3Metadata + responseConsumer _ _ + = s3ResponseConsumer $ \_ -> return DeleteObjectVersionResponse + +instance Transaction DeleteObjectVersion DeleteObjectVersionResponse + +instance AsMemoryResponse DeleteObjectVersionResponse where + type MemoryResponse DeleteObjectVersionResponse = DeleteObjectVersionResponse + loadToMemory = return diff --git a/Aws/S3/Commands/GetBucketObjectVersions.hs b/Aws/S3/Commands/GetBucketObjectVersions.hs new file mode 100644 --- /dev/null +++ b/Aws/S3/Commands/GetBucketObjectVersions.hs @@ -0,0 +1,125 @@ +module Aws.S3.Commands.GetBucketObjectVersions +where + +import Aws.Core +import Aws.S3.Core +import Control.Applicative +import Data.ByteString.Char8 ({- IsString -}) +import Data.Maybe +import Text.XML.Cursor (($/), (&|), (&//)) +import qualified Data.ByteString.Char8 as B8 +import qualified Data.Text as T +import qualified Data.Text.Encoding as T +import qualified Data.Traversable +import Prelude +import qualified Network.HTTP.Types as HTTP +import qualified Text.XML.Cursor as Cu +import qualified Text.XML as XML + +data GetBucketObjectVersions + = GetBucketObjectVersions { + gbovBucket :: Bucket + , gbovDelimiter :: Maybe T.Text + , gbovKeyMarker :: Maybe T.Text + , gbovMaxKeys :: Maybe Int + , gbovPrefix :: Maybe T.Text + , gbovVersionIdMarker :: Maybe T.Text + } + deriving (Show) + +getBucketObjectVersions :: Bucket -> GetBucketObjectVersions +getBucketObjectVersions bucket + = GetBucketObjectVersions { + gbovBucket = bucket + , gbovDelimiter = Nothing + , gbovKeyMarker = Nothing + , gbovMaxKeys = Nothing + , gbovPrefix = Nothing + , gbovVersionIdMarker = Nothing + } + +data GetBucketObjectVersionsResponse + = GetBucketObjectVersionsResponse { + gbovrName :: Bucket + , gbovrDelimiter :: Maybe T.Text + , gbovrKeyMarker :: Maybe T.Text + , gbovrMaxKeys :: Maybe Int + , gbovrPrefix :: Maybe T.Text + , gbovrVersionIdMarker :: Maybe T.Text + , gbovrContents :: [ObjectVersionInfo] + , gbovrCommonPrefixes :: [T.Text] + , gbovrIsTruncated :: Bool + , gbovrNextKeyMarker :: Maybe T.Text + , gbovrNextVersionIdMarker :: Maybe T.Text + } + deriving (Show) + +-- | ServiceConfiguration: 'S3Configuration' +instance SignQuery GetBucketObjectVersions where + type ServiceConfiguration GetBucketObjectVersions = S3Configuration + signQuery GetBucketObjectVersions {..} = s3SignQuery S3Query { + s3QMethod = Get + , s3QBucket = Just $ T.encodeUtf8 gbovBucket + , s3QObject = Nothing + , s3QSubresources = [ ("versions", Nothing) ] + , s3QQuery = HTTP.toQuery [ + ("delimiter" :: B8.ByteString ,) <$> gbovDelimiter + , ("key-marker",) <$> gbovKeyMarker + , ("max-keys",) . T.pack . show <$> gbovMaxKeys + , ("prefix",) <$> gbovPrefix + , ("version-id-marker",) <$> gbovVersionIdMarker + ] + , s3QContentType = Nothing + , s3QContentMd5 = Nothing + , s3QAmzHeaders = [] + , s3QOtherHeaders = [] + , s3QRequestBody = Nothing + } + +instance ResponseConsumer r GetBucketObjectVersionsResponse where + type ResponseMetadata GetBucketObjectVersionsResponse = S3Metadata + + responseConsumer _ _ = s3XmlResponseConsumer parse + where parse cursor + = do name <- force "Missing Name" $ cursor $/ elContent "Name" + let delimiter = listToMaybe $ cursor $/ elContent "Delimiter" + let keyMarker = listToMaybe $ cursor $/ elContent "KeyMarker" + let versionMarker = listToMaybe $ cursor $/ elContent "VersionIdMarker" + maxKeys <- Data.Traversable.sequence . listToMaybe $ cursor $/ elContent "MaxKeys" &| textReadInt + let truncated = maybe True (/= "false") $ listToMaybe $ cursor $/ elContent "IsTruncated" + let nextKeyMarker = listToMaybe $ cursor $/ elContent "NextKeyMarker" + let nextVersionMarker = listToMaybe $ cursor $/ elContent "NextVersionIdMarker" + let prefix = listToMaybe $ cursor $/ elContent "Prefix" + contents <- sequence $ cursor $/ Cu.checkName objectNodeName &| parseObjectVersionInfo + let commonPrefixes = cursor $/ Cu.laxElement "CommonPrefixes" &// Cu.content + return GetBucketObjectVersionsResponse{ + gbovrName = name + , gbovrDelimiter = delimiter + , gbovrKeyMarker = keyMarker + , gbovrMaxKeys = maxKeys + , gbovrPrefix = prefix + , gbovrVersionIdMarker = versionMarker + , gbovrContents = contents + , gbovrCommonPrefixes = commonPrefixes + , gbovrIsTruncated = truncated + , gbovrNextKeyMarker = nextKeyMarker + , gbovrNextVersionIdMarker = nextVersionMarker + } + objectNodeName n = let fn = T.toCaseFold $ XML.nameLocalName n + in fn == T.toCaseFold "Version" || fn == T.toCaseFold "DeleteMarker" + +instance Transaction GetBucketObjectVersions GetBucketObjectVersionsResponse + +instance IteratedTransaction GetBucketObjectVersions GetBucketObjectVersionsResponse where + nextIteratedRequest request response + = case (gbovrIsTruncated response, gbovrNextKeyMarker response, gbovrNextVersionIdMarker response, gbovrContents response) of + (True, Just keyMarker, Just versionMarker, _ ) -> Just $ request { gbovKeyMarker = Just keyMarker, gbovVersionIdMarker = Just versionMarker } + (True, Nothing, Nothing, contents@(_:_)) -> Just $ request { gbovKeyMarker = Just $ oviKey $ last contents, gbovVersionIdMarker = Just $ oviVersionId $ last contents } + (_, _, _, _ ) -> Nothing + +instance ListResponse GetBucketObjectVersionsResponse ObjectVersionInfo where + listResponse = gbovrContents + +instance AsMemoryResponse GetBucketObjectVersionsResponse where + type MemoryResponse GetBucketObjectVersionsResponse = GetBucketObjectVersionsResponse + loadToMemory = return diff --git a/Aws/S3/Commands/Multipart.hs b/Aws/S3/Commands/Multipart.hs --- a/Aws/S3/Commands/Multipart.hs +++ b/Aws/S3/Commands/Multipart.hs @@ -5,6 +5,7 @@ import Aws.S3.Core import Control.Applicative import Control.Arrow (second) +import Control.Monad import Control.Monad.IO.Class import Control.Monad.Trans.Resource import Crypto.Hash @@ -141,7 +142,6 @@ data UploadPartResponse = UploadPartResponse { - uprVersionId :: !(Maybe T.Text), uprETag :: !T.Text } deriving (Show) @@ -174,9 +174,8 @@ instance ResponseConsumer UploadPart UploadPartResponse where type ResponseMetadata UploadPartResponse = S3Metadata responseConsumer _ _ = s3ResponseConsumer $ \resp -> do - let vid = T.decodeUtf8 `fmap` lookup "x-amz-version-id" (HTTP.responseHeaders resp) let etag = fromMaybe "" $ T.decodeUtf8 `fmap` lookup "ETag" (HTTP.responseHeaders resp) - return $ UploadPartResponse vid etag + return $ UploadPartResponse etag instance Transaction UploadPart UploadPartResponse @@ -197,12 +196,11 @@ , cmuExpiration :: Maybe T.Text , cmuServerSideEncryption :: Maybe T.Text , cmuServerSideEncryptionCustomerAlgorithm :: Maybe T.Text - , cmuVersionId :: Maybe T.Text } deriving (Show) postCompleteMultipartUpload :: Bucket -> T.Text -> T.Text -> [(Integer,T.Text)]-> CompleteMultipartUpload -postCompleteMultipartUpload b o i p = CompleteMultipartUpload b o i p Nothing Nothing Nothing Nothing +postCompleteMultipartUpload b o i p = CompleteMultipartUpload b o i p Nothing Nothing Nothing data CompleteMultipartUploadResponse = CompleteMultipartUploadResponse { @@ -210,6 +208,7 @@ , cmurBucket :: !Bucket , cmurKey :: !T.Text , cmurETag :: !T.Text + , cmurVersionId :: !(Maybe T.Text) } -- | ServiceConfiguration: 'S3Configuration' @@ -229,7 +228,6 @@ , ("x-amz-server-side-encryption",) <$> (T.encodeUtf8 <$> cmuServerSideEncryption) , ("x-amz-server-side-encryption-customer-algorithm",) <$> (T.encodeUtf8 <$> cmuServerSideEncryptionCustomerAlgorithm) - , ("x-amz-version-id",) <$> (T.encodeUtf8 <$> cmuVersionId) ] , s3QOtherHeaders = [] , s3QRequestBody = Just $ HTTP.RequestBodyLBS reqBody @@ -260,8 +258,9 @@ instance ResponseConsumer r CompleteMultipartUploadResponse where type ResponseMetadata CompleteMultipartUploadResponse = S3Metadata - responseConsumer _ _ = s3XmlResponseConsumer parse - where parse cursor + responseConsumer _ _ metadata resp = s3XmlResponseConsumer parse metadata resp + where vid = T.decodeUtf8 `fmap` lookup "x-amz-version-id" (HTTP.responseHeaders resp) + parse cursor = do location <- force "Missing Location" $ cursor $/ elContent "Location" bucket <- force "Missing Bucket Name" $ cursor $/ elContent "Bucket" key <- force "Missing Key" $ cursor $/ elContent "Key" @@ -271,6 +270,7 @@ , cmurBucket = bucket , cmurKey = key , cmurETag = etag + , cmurVersionId = vid } instance Transaction CompleteMultipartUpload CompleteMultipartUploadResponse @@ -357,11 +357,10 @@ -> T.Text -> T.Text -> [T.Text] - -> IO () + -> IO CompleteMultipartUploadResponse sendEtag cfg s3cfg mgr bucket object uploadId etags = do - _ <- memoryAws cfg s3cfg mgr $ + memoryAws cfg s3cfg mgr $ postCompleteMultipartUpload bucket object uploadId (zip [1..] etags) - return () putConduit :: MonadResource m => @@ -378,7 +377,7 @@ v' <- await case v' of Just v -> do - UploadPartResponse _ etag <- memoryAws cfg s3cfg mgr $ + UploadPartResponse etag <- memoryAws cfg s3cfg mgr $ uploadPart bucket object n uploadId (HTTP.RequestBodyLBS v) yield etag loop (n+1) @@ -416,7 +415,7 @@ $= chunkedConduit chunkSize $= putConduit cfg s3cfg mgr bucket object uploadId $$ CL.consume - liftIO $ sendEtag cfg s3cfg mgr bucket object uploadId etags + void $ liftIO $ sendEtag cfg s3cfg mgr bucket object uploadId etags multipartUploadSink :: MonadResource m => Configuration @@ -444,7 +443,7 @@ $= chunkedConduit chunkSize $= putConduit cfg s3cfg mgr bucket object uploadId $$ CL.consume - liftIO $ sendEtag cfg s3cfg mgr bucket object uploadId etags + void $ liftIO $ sendEtag cfg s3cfg mgr bucket object uploadId etags multipartUploadSinkWithInitiator :: MonadResource m => Configuration @@ -460,4 +459,4 @@ etags <- chunkedConduit chunkSize $= putConduit cfg s3cfg mgr bucket object uploadId $= CL.consume - liftIO $ sendEtag cfg s3cfg mgr bucket object uploadId etags + void $ liftIO $ sendEtag cfg s3cfg mgr bucket object uploadId etags diff --git a/Aws/S3/Core.hs b/Aws/S3/Core.hs --- a/Aws/S3/Core.hs +++ b/Aws/S3/Core.hs @@ -390,6 +390,68 @@ } deriving (Show) +data ObjectVersionInfo + = ObjectVersion { + oviKey :: T.Text + , oviVersionId :: T.Text + , oviIsLatest :: Bool + , oviLastModified :: UTCTime + , oviETag :: T.Text + , oviSize :: Integer + , oviStorageClass :: StorageClass + , oviOwner :: Maybe UserInfo + } + | DeleteMarker { + oviKey :: T.Text + , oviVersionId :: T.Text + , oviIsLatest :: Bool + , oviLastModified :: UTCTime + , oviOwner :: Maybe UserInfo + } + deriving (Show) + +parseObjectVersionInfo :: MonadThrow m => Cu.Cursor -> m ObjectVersionInfo +parseObjectVersionInfo el + = do key <- force "Missing object Key" $ el $/ elContent "Key" + versionId <- force "Missing object VersionId" $ el $/ elContent "VersionId" + isLatest <- forceM "Missing object IsLatest" $ el $/ elContent "IsLatest" &| textReadBool + let time s = case (parseTime defaultTimeLocale "%Y-%m-%dT%H:%M:%S%QZ" $ T.unpack s) <|> + (parseTime defaultTimeLocale "%Y-%m-%dT%H:%M:%S%Q%Z" $ T.unpack s) of + Nothing -> throwM $ XmlException "Invalid time" + Just v -> return v + lastModified <- forceM "Missing object LastModified" $ el $/ elContent "LastModified" &| time + owner <- case el $/ Cu.laxElement "Owner" &| parseUserInfo of + (x:_) -> fmap' Just x + [] -> return Nothing + case Cu.node el of + XML.NodeElement e | elName e == "Version" -> + do eTag <- force "Missing object ETag" $ el $/ elContent "ETag" + size <- forceM "Missing object Size" $ el $/ elContent "Size" &| textReadInt + storageClass <- forceM "Missing object StorageClass" $ el $/ elContent "StorageClass" &| return . parseStorageClass + return ObjectVersion{ + oviKey = key + , oviVersionId = versionId + , oviIsLatest = isLatest + , oviLastModified = lastModified + , oviETag = eTag + , oviSize = size + , oviStorageClass = storageClass + , oviOwner = owner + } + XML.NodeElement e | elName e == "DeleteMarker" -> + return DeleteMarker{ + oviKey = key + , oviVersionId = versionId + , oviIsLatest = isLatest + , oviLastModified = lastModified + , oviOwner = owner + } + _ -> throwM $ XmlException "Invalid object version tag" + where + elName = XML.nameLocalName . XML.elementName + fmap' :: Monad m => (a -> b) -> m a -> m b + fmap' f ma = ma >>= return . f + data ObjectInfo = ObjectInfo { objectKey :: T.Text diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,3 +1,15 @@ +0.16 series +----------- + +NOTES: 0.16 brings technically breaking changes, which should not affect +most users. I recommend using smart constructors and {} matching syntax +whenever possible when interacting with aws types. + +- 0.16 + - S3: Add support for versioning + - S3: [breaking change] Move version ID from UploadPartResponse to + CompleteMultipartUpload. + 0.15 series ----------- diff --git a/aws.cabal b/aws.cabal --- a/aws.cabal +++ b/aws.cabal @@ -1,5 +1,5 @@ Name: aws -Version: 0.15.1 +Version: 0.16 Synopsis: Amazon Web Services (AWS) for Haskell Description: Bindings for Amazon Web Services (AWS), with the aim of supporting all AWS services. To see a high level overview of the library, see the README at . Homepage: http://github.com/aristidb/aws @@ -19,7 +19,7 @@ Source-repository this type: git location: https://github.com/aristidb/aws.git - tag: 0.15.1 + tag: 0.16 Source-repository head type: git @@ -69,9 +69,11 @@ Aws.S3.Commands.CopyObject Aws.S3.Commands.DeleteBucket Aws.S3.Commands.DeleteObject + Aws.S3.Commands.DeleteObjectVersion Aws.S3.Commands.DeleteObjects Aws.S3.Commands.GetBucket Aws.S3.Commands.GetBucketLocation + Aws.S3.Commands.GetBucketObjectVersions Aws.S3.Commands.GetObject Aws.S3.Commands.GetService Aws.S3.Commands.HeadObject @@ -404,6 +406,7 @@ aws, base == 4.*, bytestring, + conduit-combinators, http-client < 0.5, http-client-tls < 0.5, http-types, diff --git a/tests/S3/Main.hs b/tests/S3/Main.hs --- a/tests/S3/Main.hs +++ b/tests/S3/Main.hs @@ -15,7 +15,9 @@ ) where import Control.Applicative -import Data.ByteString (ByteString) +import qualified Data.ByteString as BS +import qualified Data.ByteString.Lazy as BL +import Conduit import Control.Arrow (second) import Control.Exception import Control.Monad @@ -26,7 +28,8 @@ import Data.Typeable import Data.Proxy import Network.HTTP.Client (HttpException (..), - RequestBody (..), newManager) + RequestBody (..), newManager, + responseBody) import Network.HTTP.Client.TLS (tlsManagerSettings) import Network.HTTP.Types.Status import System.Environment @@ -97,6 +100,7 @@ tests = testGroup "S3 Tests" [ test_head , test_get + , test_versioning ] @@ -177,6 +181,84 @@ void (runResourceT (pureAws cfg s3cfg mgr (putObject bucket k (RequestBodyBS content)))) return (cfg, s3cfg, mgr) teardown (cfg, s3cfg, mgr) = + void (runResourceT (pureAws cfg s3cfg mgr (DeleteObject k bucket))) + + +------------------------------------------------------------------------------- +-- GetBucketObjectVersions Tests +------------------------------------------------------------------------------- + + +test_versioning :: TestTree +test_versioning = askOption $ \(BucketOption bucket) -> + withResource (mkSetup bucket) (teardown bucket) $ \setup -> testGroup "Versioning" + [ testCase "GetBucketObjectVersions succeeds" $ do + (cfg, s3cfg, mgr) <- setup + resp <- runResourceT $ pureAws cfg s3cfg mgr $ (getBucketObjectVersions bucket) + { gbovPrefix = Just k + } + let [o1, o2, o3, o4] = take 4 $ gbovrContents resp + checkObject True o1 + checkDeleteMarker False o2 + checkObject False o3 + checkObject False o4 + , testCase "DeleteObjectVersion succeeds" $ do + -- Note: this test requires bucket with versioning enabled + (cfg, s3cfg, mgr) <- setup + resp <- runResourceT $ pureAws cfg s3cfg mgr $ (getBucketObjectVersions bucket) + { gbovPrefix = Just k + } + let [v1, v2, v3, v4] = map oviVersionId $ take 4 $ gbovrContents resp + void (runResourceT (pureAws cfg s3cfg mgr (deleteObjectVersion bucket k v2))) + void (runResourceT (pureAws cfg s3cfg mgr (deleteObjectVersion bucket k v3))) + + resp' <- runResourceT $ pureAws cfg s3cfg mgr $ (getBucketObjectVersions bucket) + { gbovPrefix = Just k + } + let [v1', v4'] = map oviVersionId $ take 2 $ gbovrContents resp' + assertEqual "invalid v1 version" v1 v1' + assertEqual "invalid v4 version" v4 v4' + , testCase "Multipart upload succeeds" $ do + -- Note: this test requires bucket with versioning enabled + (cfg, s3cfg, mgr) <- setup + resp <- runResourceT $ do + uploadId <- liftIO $ getUploadId cfg s3cfg mgr bucket k + etags <- sourceLazy testStr + $= chunkedConduit 65536 + $= putConduit cfg s3cfg mgr bucket k uploadId + $$ sinkList + liftIO $ sendEtag cfg s3cfg mgr bucket k uploadId etags + let Just vid = cmurVersionId resp + bs <- runResourceT $ do + gor <- pureAws cfg s3cfg mgr (getObject bucket k) { goVersionId = Just vid } + responseBody (gorResponse gor) $$+- sinkLazy + + assertEqual "data do not match" testStr bs + ] + where + testStr = "foobar" :: BL.ByteString + k = "s3-test-object" + content = "example" + payloadMD5 = "1a79a4d60de6718e8e5b326e338ae533" + checkObject marker obj@ObjectVersion{} = do + assertEqual "invalid object key" k (oviKey obj) + assertEqual "invalid isLatest flag" marker (oviIsLatest obj) + assertEqual "invalid object size" (fromIntegral $ BS.length content) (oviSize obj) + checkObject _ obj = assertFailure $ "Invalid object type " <> show obj + checkDeleteMarker marker obj@DeleteMarker{} = do + assertEqual "invalid object key" k (oviKey obj) + assertEqual "invalid isLatest flag" marker (oviIsLatest obj) + checkDeleteMarker _ obj = assertFailure $ "Invalid object type " <> show obj + mkSetup bucket = do + cfg <- baseConfiguration + let s3cfg = defServiceConfig + mgr <- newManager tlsManagerSettings + void (runResourceT (pureAws cfg s3cfg mgr (putObject bucket k (RequestBodyBS content)))) + void (runResourceT (pureAws cfg s3cfg mgr (putObject bucket k (RequestBodyBS content)))) + void (runResourceT (pureAws cfg s3cfg mgr (DeleteObject k bucket))) + void (runResourceT (pureAws cfg s3cfg mgr (putObject bucket k (RequestBodyBS content)))) + return (cfg, s3cfg, mgr) + teardown bucket (cfg, s3cfg, mgr) = void (runResourceT (pureAws cfg s3cfg mgr (DeleteObject k bucket)))