aws 0.13.2 → 0.14.0

raw patch · 7 files changed

+295/−25 lines, 7 filesdep +http-client-tlsdep +tasty-hunitdep ~basedep ~bytestringdep ~data-defaultPVP ok

version bump matches the API change (PVP)

Dependencies added: http-client-tls, tasty-hunit

Dependency ranges changed: base, bytestring, data-default, http-client, http-types, resourcet, tagged, text

API changes (from Hackage documentation)

Files

• Aws/Core.hs +17/−8
• Aws/DynamoDb/Core.hs +15/−1
• Aws/S3/Commands/GetObject.hs +17/−5
• Aws/S3/Commands/HeadObject.hs +10/−2
• CHANGELOG.md +14/−5
• aws.cabal +27/−4
• tests/S3/Main.hs +195/−0

@@ -267,11 +267,18 @@     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'. -- -- Value: @default@@@ -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

@@ -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'

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

@@ -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                                  } 

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

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

@@ -0,0 +1,195 @@+{-# LANGUAGE DeriveDataTypeable         #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE OverloadedStrings          #-}+-- |+-- Module: Main+-- Copyright: Copyright © 2016 Soostone, Inc.+-- License: BSD3+-- Maintainer: Michael Xavier <michael.xavier@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