Hello community,
here is the log from the commit of package ghc-aws for openSUSE:Factory checked
in at 2016-10-23 12:50:31
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Comparing /work/SRC/openSUSE:Factory/ghc-aws (Old)
and /work/SRC/openSUSE:Factory/.ghc-aws.new (New)
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Package is "ghc-aws"
Changes:
--------
--- /work/SRC/openSUSE:Factory/ghc-aws/ghc-aws.changes 2016-07-20
09:19:01.000000000 +0200
+++ /work/SRC/openSUSE:Factory/.ghc-aws.new/ghc-aws.changes 2016-10-23
12:50:36.000000000 +0200
@@ -1,0 +2,5 @@
+Thu Sep 15 07:05:23 UTC 2016 - psim...@suse.com
+
+- Update to version 0.14.0 revision 0 with cabal2obs.
+
+-------------------------------------------------------------------
Old:
----
aws-0.13.2.tar.gz
New:
----
aws-0.14.0.tar.gz
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Other differences:
------------------
++++++ ghc-aws.spec ++++++
--- /var/tmp/diff_new_pack.frwvwg/_old 2016-10-23 12:50:37.000000000 +0200
+++ /var/tmp/diff_new_pack.frwvwg/_new 2016-10-23 12:50:37.000000000 +0200
@@ -19,15 +19,14 @@
%global pkg_name aws
%bcond_with tests
Name: ghc-%{pkg_name}
-Version: 0.13.2
+Version: 0.14.0
Release: 0
Summary: Amazon Web Services (AWS) for Haskell
License: BSD-3-Clause
-Group: System/Libraries
+Group: Development/Languages/Other
Url: https://hackage.haskell.org/package/%{pkg_name}
Source0:
https://hackage.haskell.org/package/%{pkg_name}-%{version}/%{pkg_name}-%{version}.tar.gz
BuildRequires: ghc-Cabal-devel
-# Begin cabal-rpm deps:
BuildRequires: ghc-aeson-devel
BuildRequires: ghc-attoparsec-devel
BuildRequires: ghc-base16-bytestring-devel
@@ -68,17 +67,18 @@
BuildRequires: ghc-QuickCheck-devel
BuildRequires: ghc-errors-devel
BuildRequires: ghc-http-client-devel
+BuildRequires: ghc-http-client-tls-devel
BuildRequires: ghc-quickcheck-instances-devel
BuildRequires: ghc-tasty-devel
+BuildRequires: ghc-tasty-hunit-devel
BuildRequires: ghc-tasty-quickcheck-devel
BuildRequires: ghc-transformers-base-devel
%endif
-# End cabal-rpm deps
%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
-<https://github.com/aristidb/aws/blob/master/README.org>.
+<https://github.com/aristidb/aws/blob/master/README.md>.
%package devel
Summary: Haskell %{pkg_name} library development files
@@ -94,20 +94,14 @@
%prep
%setup -q -n %{pkg_name}-%{version}
-
%build
%ghc_lib_build
-
%install
%ghc_lib_install
-
%check
-%if %{with tests}
-%{cabal} test
-%endif
-
+%cabal_test
%post devel
%ghc_pkg_recache
++++++ aws-0.13.2.tar.gz -> aws-0.14.0.tar.gz ++++++
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/aws-0.13.2/Aws/Core.hs new/aws-0.14.0/Aws/Core.hs
--- old/aws-0.13.2/Aws/Core.hs 2016-06-04 19:00:17.000000000 +0200
+++ new/aws-0.14.0/Aws/Core.hs 2016-06-04 18:23:48.000000000 +0200
@@ -267,10 +267,17 @@
return Credentials { .. }
-- | The file where access credentials are loaded, when using
'loadCredentialsDefault'.
+-- May return 'Nothing' if @HOME@ is unset.
--
-- Value: /<user directory>/@/.aws-keys@
-credentialsDefaultFile :: MonadIO io => io FilePath
-credentialsDefaultFile = liftIO $ (</> ".aws-keys") <$> getHomeDirectory
+credentialsDefaultFile :: MonadIO io => io (Maybe FilePath)
+credentialsDefaultFile = liftIO $ tryMaybe ((</> ".aws-keys") <$>
getHomeDirectory)
+
+tryMaybe :: IO a -> IO (Maybe a)
+tryMaybe action = E.catch (Just <$> action) f
+ where
+ f :: E.SomeException -> IO (Maybe a)
+ f _ = return Nothing
-- | The key to be used in the access credential file that is loaded, when
using 'loadCredentialsDefault'.
--
@@ -302,12 +309,12 @@
loadCredentialsFromEnv :: MonadIO io => io (Maybe Credentials)
loadCredentialsFromEnv = liftIO $ do
env <- getEnvironment
- let lk = flip lookup env
+ let lk = fmap (T.encodeUtf8 . T.pack) . flip lookup env
keyID = lk "AWS_ACCESS_KEY_ID"
secret = lk "AWS_ACCESS_KEY_SECRET" `mplus` lk "AWS_SECRET_ACCESS_KEY"
- Traversable.sequence
- (makeCredentials <$> (T.encodeUtf8 . T.pack <$> keyID)
- <*> (T.encodeUtf8 . T.pack <$> secret))
+ setSession creds = creds { iamToken = lk "AWS_SESSION_TOKEN" }
+ makeCredentials' k s = setSession <$> makeCredentials k s
+ Traversable.sequence $ makeCredentials' <$> keyID <*> secret
loadCredentialsFromInstanceMetadata :: MonadIO io => io (Maybe Credentials)
loadCredentialsFromInstanceMetadata = liftIO $ HTTP.withManager $ \mgr ->
@@ -373,8 +380,10 @@
-- See 'loadCredentialsFromEnv' and 'loadCredentialsFromFile' for details.
loadCredentialsDefault :: MonadIO io => io (Maybe Credentials)
loadCredentialsDefault = do
- file <- credentialsDefaultFile
- loadCredentialsFromEnvOrFileOrInstanceMetadata file credentialsDefaultKey
+ mfile <- credentialsDefaultFile
+ case mfile of
+ Just file -> loadCredentialsFromEnvOrFileOrInstanceMetadata file
credentialsDefaultKey
+ Nothing -> loadCredentialsFromEnv
-- | Protocols supported by AWS. Currently, all AWS services use the HTTP or
HTTPS protocols.
data Protocol
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/aws-0.13.2/Aws/DynamoDb/Core.hs
new/aws-0.14.0/Aws/DynamoDb/Core.hs
--- old/aws-0.13.2/Aws/DynamoDb/Core.hs 2016-06-04 19:00:17.000000000 +0200
+++ new/aws-0.14.0/Aws/DynamoDb/Core.hs 2016-06-04 18:23:48.000000000 +0200
@@ -49,7 +49,7 @@
-- * Defining new 'DynVal' instances
, DynData(..)
- , DynBinary(..), DynNumber(..), DynString(..)
+ , DynBinary(..), DynNumber(..), DynString(..), DynBool(..)
-- * Working with key/value pairs
, Attribute (..)
@@ -75,6 +75,7 @@
, Parser (..)
, getAttr
, getAttr'
+ , parseAttr
-- * Common types used by operations
, Conditions (..)
@@ -1348,6 +1349,19 @@
Nothing -> return Nothing
Just dv -> return $ fromValue dv
+-- | Combinator for parsing an attribute into a 'FromDynItem'.
+parseAttr
+ :: FromDynItem a
+ => T.Text
+ -- ^ Attribute name
+ -> Item
+ -- ^ Item from DynamoDb
+ -> Parser a
+parseAttr k m =
+ case M.lookup k m of
+ Nothing -> fail ("Key " <> T.unpack k <> " not found")
+ Just (DMap dv) -> either (fail "...") return $ fromItem dv
+ _ -> fail ("Key " <> T.unpack k <> " is not a map!")
-------------------------------------------------------------------------------
-- | Parse an 'Item' into target type using the 'FromDynItem'
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/aws-0.13.2/Aws/S3/Commands/GetObject.hs
new/aws-0.14.0/Aws/S3/Commands/GetObject.hs
--- old/aws-0.13.2/Aws/S3/Commands/GetObject.hs 2016-06-04 19:00:17.000000000
+0200
+++ new/aws-0.14.0/Aws/S3/Commands/GetObject.hs 2016-06-04 18:23:48.000000000
+0200
@@ -4,7 +4,7 @@
import Aws.Core
import Aws.S3.Core
import Control.Applicative
-import Control.Monad.Trans.Resource (ResourceT)
+import Control.Monad.Trans.Resource (ResourceT, throwM)
import Data.ByteString.Char8 ({- IsString -})
import qualified Data.ByteString.Char8 as B8
import qualified Data.ByteString.Lazy as L
@@ -28,11 +28,15 @@
, goResponseContentDisposition :: Maybe T.Text
, goResponseContentEncoding :: Maybe T.Text
, goResponseContentRange :: Maybe (Int,Int)
+ , goIfMatch :: Maybe T.Text
+ -- ^ Return the object only if its entity tag (ETag, which is an md5sum
of the content) is the same as the one specified; otherwise, catch a
'StatusCodeException' with a status of 412 precondition failed.
+ , goIfNoneMatch :: Maybe T.Text
+ -- ^ Return the object only if its entity tag (ETag, which is an md5sum
of the content) is different from the one specified; otherwise, catch a
'StatusCodeException' with a status of 304 not modified.
}
deriving (Show)
getObject :: Bucket -> T.Text -> GetObject
-getObject b o = GetObject b o Nothing Nothing Nothing Nothing Nothing Nothing
Nothing Nothing
+getObject b o = GetObject b o Nothing Nothing Nothing Nothing Nothing Nothing
Nothing Nothing Nothing Nothing
data GetObjectResponse
= GetObjectResponse {
@@ -66,6 +70,8 @@
, s3QAmzHeaders = []
, s3QOtherHeaders = catMaybes [
decodeRange <$>
goResponseContentRange
+ , ("if-match",) .
T.encodeUtf8 <$> goIfMatch
+ , ("if-none-match",) .
T.encodeUtf8 <$> goIfNoneMatch
]
, s3QRequestBody = Nothing
}
@@ -74,9 +80,15 @@
instance ResponseConsumer GetObject GetObjectResponse where
type ResponseMetadata GetObjectResponse = S3Metadata
responseConsumer GetObject{..} metadata resp
- = do rsp <- s3BinaryResponseConsumer return metadata resp
- om <- parseObjectMetadata (HTTP.responseHeaders resp)
- return $ GetObjectResponse om rsp
+ | status == HTTP.status200 = do
+ rsp <- s3BinaryResponseConsumer return metadata resp
+ om <- parseObjectMetadata (HTTP.responseHeaders resp)
+ return $ GetObjectResponse om rsp
+ | otherwise = throwM $ HTTP.StatusCodeException status headers cookies
+ where
+ status = HTTP.responseStatus resp
+ headers = HTTP.responseHeaders resp
+ cookies = HTTP.responseCookieJar resp
instance Transaction GetObject GetObjectResponse
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/aws-0.13.2/Aws/S3/Commands/HeadObject.hs
new/aws-0.14.0/Aws/S3/Commands/HeadObject.hs
--- old/aws-0.13.2/Aws/S3/Commands/HeadObject.hs 2016-06-04
19:00:17.000000000 +0200
+++ new/aws-0.14.0/Aws/S3/Commands/HeadObject.hs 2016-06-04
18:23:48.000000000 +0200
@@ -7,6 +7,7 @@
import Control.Monad.Trans.Resource (throwM)
import Data.ByteString.Char8 ({- IsString -})
import qualified Data.ByteString.Char8 as B8
+import Data.Maybe
import qualified Data.Text as T
import qualified Data.Text.Encoding as T
import qualified Network.HTTP.Conduit as HTTP
@@ -17,11 +18,15 @@
hoBucket :: Bucket
, hoObjectName :: Object
, hoVersionId :: Maybe T.Text
+ , hoIfMatch :: Maybe T.Text
+ -- ^ Return the object only if its entity tag (ETag, which is an md5sum
of the content) is the same as the one specified; otherwise, catch a
'StatusCodeException' with a status of 412 precondition failed.
+ , hoIfNoneMatch :: Maybe T.Text
+ -- ^ Return the object only if its entity tag (ETag, which is an md5sum
of the content) is different from the one specified; otherwise, catch a
'StatusCodeException' with a status of 304 not modified.
}
deriving (Show)
headObject :: Bucket -> T.Text -> HeadObject
-headObject b o = HeadObject b o Nothing
+headObject b o = HeadObject b o Nothing Nothing Nothing
data HeadObjectResponse
= HeadObjectResponse {
@@ -46,7 +51,10 @@
, s3QContentType = Nothing
, s3QContentMd5 = Nothing
, s3QAmzHeaders = []
- , s3QOtherHeaders = []
+ , s3QOtherHeaders = catMaybes [
+ ("if-match",) .
T.encodeUtf8 <$> hoIfMatch
+ , ("if-none-match",) .
T.encodeUtf8 <$> hoIfNoneMatch
+ ]
, s3QRequestBody = Nothing
}
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/aws-0.13.2/CHANGELOG.md new/aws-0.14.0/CHANGELOG.md
--- old/aws-0.13.2/CHANGELOG.md 2016-06-04 19:00:17.000000000 +0200
+++ new/aws-0.14.0/CHANGELOG.md 2016-06-04 18:23:48.000000000 +0200
@@ -1,13 +1,22 @@
+0.14 series
+
+NOTES: 0.14 brings potentially breaking changes
+
+- 0.14
+ - transformers 0.5 support
+ - data-default 0.6 support (also in 0.13.1)
+ - time < 2.0 support
+ - General: Use AWS_SESSION_TOKEN if in environment for loading
credentials
+ - General: loadCredentialsDefault fails gracefully if HOME is not set
+ - DDB: Add parseAttr combinator for parsing an attribute into a
FromDynItem
+ - DDB: Expose the new DynBool type
+ - S3: Add ETag fields to get/head object
+
0.13 series
-----------
NOTE: 0.13 brings breaking changes compared to 0.12.1!
-- 0.13.2
- - ghc 8 support, via:
- - time 1.6 support
- - transformers 0.5 support
- - cereal 0.6 support
- 0.13.1
- data-default 0.6 support
- 0.13
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/aws-0.13.2/aws.cabal new/aws-0.14.0/aws.cabal
--- old/aws-0.13.2/aws.cabal 2016-06-04 19:00:17.000000000 +0200
+++ new/aws-0.14.0/aws.cabal 2016-06-04 18:23:48.000000000 +0200
@@ -1,7 +1,7 @@
Name: aws
-Version: 0.13.2
+Version: 0.14.0
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 <https://github.com/aristidb/aws/blob/master/README.org>.
+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 <https://github.com/aristidb/aws/blob/master/README.md>.
Homepage: http://github.com/aristidb/aws
License: BSD3
License-file: LICENSE
@@ -19,7 +19,7 @@
Source-repository this
type: git
location: https://github.com/aristidb/aws.git
- tag: 0.13.2
+ tag: 0.14.0
Source-repository head
type: git
@@ -124,7 +124,7 @@
conduit-extra >= 1.1 && < 1.2,
containers >= 0.4,
cryptohash >= 0.11 && < 0.12,
- data-default >= 0.5.3 && < 0.7,
+ data-default >= 0.5.3 && < 0.8,
directory >= 1.0 && < 1.3,
filepath >= 1.1 && < 1.5,
http-conduit >= 2.1 && < 2.2,
@@ -373,3 +373,26 @@
time,
transformers >= 0.3,
transformers-base >= 0.4
+
+
+test-suite s3-tests
+ type: exitcode-stdio-1.0
+ default-language: Haskell2010
+ hs-source-dirs: tests
+ main-is: S3/Main.hs
+
+ other-modules:
+ Utils
+
+ build-depends:
+ aws,
+ base == 4.*,
+ bytestring,
+ http-client,
+ http-client-tls,
+ http-types,
+ resourcet,
+ tasty >= 0.8,
+ tasty-hunit >= 0.8,
+ text,
+ tagged >= 0.7
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/aws-0.13.2/tests/S3/Main.hs
new/aws-0.14.0/tests/S3/Main.hs
--- old/aws-0.13.2/tests/S3/Main.hs 1970-01-01 01:00:00.000000000 +0100
+++ new/aws-0.14.0/tests/S3/Main.hs 2016-06-04 18:23:48.000000000 +0200
@@ -0,0 +1,195 @@
+{-# LANGUAGE DeriveDataTypeable #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE OverloadedStrings #-}
+-- |
+-- Module: Main
+-- Copyright: Copyright © 2016 Soostone, Inc.
+-- License: BSD3
+-- Maintainer: Michael Xavier <michael.xav...@soostone.com>
+-- Stability: experimental
+--
+-- Tests for Haskell AWS S3 bindings
+--
+module Main
+ ( main
+ ) where
+
+import Control.Applicative
+import Data.ByteString (ByteString)
+import Control.Arrow (second)
+import Control.Exception
+import Control.Monad
+import Control.Monad.Trans.Resource
+import qualified Data.List as L
+import Data.Monoid
+import qualified Data.Text as T
+import Data.Typeable
+import Data.Proxy
+import Network.HTTP.Client (HttpException (..),
+ RequestBody (..), newManager)
+import Network.HTTP.Client.TLS (tlsManagerSettings)
+import Network.HTTP.Types.Status
+import System.Environment
+import System.Exit
+import Test.Tasty
+import Test.Tasty.HUnit
+import Test.Tasty.Options
+
+import Aws
+import Aws.S3
+
+
+newtype BucketOption = BucketOption Bucket
+ deriving (Show, Eq, Ord, Typeable)
+
+instance IsOption BucketOption where
+ defaultValue = error "The --bucket flag is required"
+ parseValue = Just . BucketOption . T.pack
+ optionName = return "bucket"
+ optionHelp = return "Bucket to use for performing S3 operations. Tests will
write to the 's3-test-object' key."
+
+
+main :: IO ()
+main = do
+ args <- getArgs
+ runMain args $ map (second tail . span (/= '=')) args
+ where
+ runMain :: [String] -> [(String,String)] -> IO ()
+ runMain args _argsMap
+ | any (`elem` helpArgs) args = defaultMainWithIngredients ings tests
+ | "--run-with-aws-credentials" `elem` args =
+ withArgs (tastyArgs args) . defaultMainWithIngredients ings $ tests
+ | otherwise = putStrLn help >> exitFailure
+ helpArgs = ["--help", "-h"]
+ mainArgs =
+ [ "--run-with-aws-credentials"
+ ]
+ tastyArgs args = flip filter args $ \x -> not
+ $ any (`L.isPrefixOf` x) mainArgs
+ ings = includingOptions [Option (Proxy :: Proxy
BucketOption)]:defaultIngredients
+
+
+help :: String
+help = L.intercalate "\n"
+ [ ""
+ , "NOTE"
+ , ""
+ , "This test suite accesses the AWS account that is associated with"
+ , "the default credentials from the credential file ~/.aws-keys."
+ , ""
+ , "By running the tests in this test-suite costs for usage of AWS"
+ , "services may incur."
+ , ""
+ , "In order to actually excute the tests in this test-suite you must"
+ , "provide the command line options:"
+ , ""
+ , " --run-with-aws-credentials"
+ , ""
+ , "When running this test-suite through cabal you may use the following"
+ , "command:"
+ , ""
+ , " cabal test --test-option=--run-with-aws-credentials s3-tests"
+ , ""
+ ]
+
+
+tests :: TestTree
+tests = testGroup "S3 Tests"
+ [ test_head
+ , test_get
+ ]
+
+
+-------------------------------------------------------------------------------
+-- HeadObject Tests
+-------------------------------------------------------------------------------
+
+
+test_head :: TestTree
+test_head = askOption $ \(BucketOption bucket) -> testGroup "HeadObject"
+ [ test_head_caching bucket
+ ]
+
+
+test_head_caching :: Bucket -> TestTree
+test_head_caching bucket = withResource mkSetup teardown $ \setup -> testGroup
"Caches"
+ [ testCase "If-Matches match succeeds" $ do
+ (cfg, s3cfg, mgr) <- setup
+ void (runResourceT (pureAws cfg s3cfg mgr (headObject bucket k) {
hoIfMatch = Just payloadMD5 }))
+ , testCase "If-Matches mismatch fails with 412" $ do
+ (cfg, s3cfg, mgr) <- setup
+ assertStatus 412 (runResourceT (pureAws cfg s3cfg mgr (headObject bucket
k) { hoIfMatch = Just (T.reverse payloadMD5) }))
+ , testCase "If-None-Match mismatch succeeds" $ do
+ (cfg, s3cfg, mgr) <- setup
+ void (runResourceT (pureAws cfg s3cfg mgr (headObject bucket k) {
hoIfNoneMatch = Just (T.reverse payloadMD5) }))
+ , testCase "If-None-Match match fails with 304" $ do
+ (cfg, s3cfg, mgr) <- setup
+ assertStatus 304 (runResourceT (pureAws cfg s3cfg mgr (headObject bucket
k) { hoIfNoneMatch = Just payloadMD5 }))
+ ]
+ where
+ k = "s3-test-object"
+ content = "example"
+ payloadMD5 = "1a79a4d60de6718e8e5b326e338ae533"
+ mkSetup = do
+ cfg <- baseConfiguration
+ let s3cfg = defServiceConfig
+ mgr <- newManager tlsManagerSettings
+ 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)))
+
+
+-------------------------------------------------------------------------------
+-- GetObject Tests
+-------------------------------------------------------------------------------
+
+
+test_get :: TestTree
+test_get = askOption $ \(BucketOption bucket) -> testGroup "GetObject"
+ [ test_get_caching bucket
+ ]
+
+
+test_get_caching :: Bucket -> TestTree
+test_get_caching bucket = withResource mkSetup teardown $ \setup -> testGroup
"Caches"
+ [ testCase "If-Matches match succeeds" $ do
+ (cfg, s3cfg, mgr) <- setup
+ void (runResourceT (pureAws cfg s3cfg mgr (getObject bucket k) {
goIfMatch = Just payloadMD5 }))
+ , testCase "If-Matches mismatch fails with 412" $ do
+ (cfg, s3cfg, mgr) <- setup
+ assertStatus 412 (runResourceT (pureAws cfg s3cfg mgr (getObject bucket
k) { goIfMatch = Just (T.reverse payloadMD5) }))
+ , testCase "If-None-Match mismatch succeeds" $ do
+ (cfg, s3cfg, mgr) <- setup
+ void (runResourceT (pureAws cfg s3cfg mgr (getObject bucket k) {
goIfNoneMatch = Just (T.reverse payloadMD5) }))
+ , testCase "If-None-Match match fails with 304" $ do
+ (cfg, s3cfg, mgr) <- setup
+ assertStatus 304 (runResourceT (pureAws cfg s3cfg mgr (getObject bucket
k) { goIfNoneMatch = Just payloadMD5 }))
+ ]
+ where
+ k = "s3-test-object"
+ content = "example"
+ payloadMD5 = "1a79a4d60de6718e8e5b326e338ae533"
+ mkSetup = do
+ cfg <- baseConfiguration
+ let s3cfg = defServiceConfig
+ mgr <- newManager tlsManagerSettings
+ 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)))
+
+
+assertStatus :: Int -> IO a -> Assertion
+assertStatus expectedStatus f = do
+ res <- catchJust selector
+ (Right <$> f)
+ (return . Left)
+ case res of
+ Right _ -> assertFailure ("Expected error with status " <> show
expectedStatus <> ", but got success.")
+ Left _ -> return ()
+ where
+ selector (StatusCodeException s _ _)
+ | statusCode s == expectedStatus = Just ()
+ | otherwise = Nothing
+ selector _ = Nothing
