aws 0.9.2 → 0.9.3

raw patch · 10 files changed

+152/−34 lines, 10 filesdep ~basedep ~conduitdep ~conduit-extranew-component:exe:NukeBucketPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: base, conduit, conduit-extra, http-conduit, text, transformers

API changes (from Hackage documentation)

Files

• Aws.hs +1/−0
• Aws/Aws.hs +4/−6
• Aws/Core.hs +28/−20
• Aws/S3/Commands.hs +2/−0
• Aws/S3/Commands/DeleteBucket.hs +40/−0
• Aws/S3/Commands/GetBucket.hs +3/−0
• Aws/Ses/Core.hs +11/−6
• Examples/NukeBucket.hs +34/−0
• README.org +7/−0
• aws.cabal +22/−2

@@ -49,6 +49,7 @@ , IteratedTransaction   -- * Credentials , Credentials(..)+, makeCredentials , credentialsDefaultFile , credentialsDefaultKey , loadCredentialsFromFile

@@ -212,12 +212,10 @@   liftIO $ logger cfg Debug $ T.pack $ "String to sign: " ++ show (sqStringToSign q)   httpRequest <- liftIO $ queryToHttpRequest q   liftIO $ logger cfg Debug $ T.pack $ "Host: " ++ show (HTTP.host httpRequest)-  resp <- do-      hresp <- HTTP.http httpRequest manager-      forM_ (HTTP.responseHeaders hresp) $ \(hname,hvalue) -> liftIO $ do-        logger cfg Debug $ T.decodeUtf8 $ "Response header '" `mappend` CI.original hname `mappend` "': '" `mappend` hvalue `mappend` "'"-      responseConsumer request metadataRef hresp-  return resp+  hresp <- HTTP.http httpRequest manager+  forM_ (HTTP.responseHeaders hresp) $ \(hname,hvalue) -> liftIO $+    logger cfg Debug $ T.decodeUtf8 $ "Response header '" `mappend` CI.original hname `mappend` "': '" `mappend` hvalue `mappend` "'"+  responseConsumer request metadataRef hresp  -- | Run a URI-only AWS transaction. Returns a URI that can be sent anywhere. Does not work with all requests. -- 

@@ -70,6 +70,7 @@ , IteratedTransaction(..)   -- * Credentials , Credentials(..)+, makeCredentials , credentialsDefaultFile , credentialsDefaultKey , loadCredentialsFromFile@@ -121,6 +122,7 @@ import qualified Data.Text.Encoding       as T import qualified Data.Text.IO             as T import           Data.Time+import qualified Data.Traversable         as Traversable import           Data.Typeable import           Data.Word import qualified Network.HTTP.Conduit     as HTTP@@ -245,6 +247,15 @@ instance Show Credentials where     show c = "Credentials{accessKeyID=" ++ show (accessKeyID c) ++ ",secretAccessKey=" ++ show (secretAccessKey c) ++ ",iamToken=" ++ show (iamToken c) ++ "}" +makeCredentials :: MonadIO io+                => B.ByteString -- ^ AWS Access Key ID+                -> B.ByteString -- ^ AWS Secret Access Key+                -> io Credentials+makeCredentials accessKeyID secretAccessKey = liftIO $ do+    v4SigningKeys <- newIORef []+    let iamToken = Nothing+    return Credentials { .. }+ -- | The file where access credentials are loaded, when using 'loadCredentialsDefault'. -- -- Value: /<user directory>/@/.aws-keys@@@ -264,32 +275,29 @@ -- @keyName awsKeyID awsKeySecret@ loadCredentialsFromFile :: MonadIO io => FilePath -> T.Text -> io (Maybe Credentials) loadCredentialsFromFile file key = liftIO $ do-  contents <- map T.words . T.lines <$> T.readFile file-  ref <- newIORef []-  return $ do-    [_key, keyID, secret] <- find (hasKey key) contents-    return Credentials { accessKeyID = T.encodeUtf8 keyID-                       , secretAccessKey = T.encodeUtf8 secret-                       , v4SigningKeys = ref-                       , iamToken = Nothing-                       }-      where-        hasKey _ [] = False-        hasKey k (k2 : _) = k == k2+  exists <- doesFileExist file+  if exists+    then do+      contents <- map T.words . T.lines <$> T.readFile file+      Traversable.sequence $ do+        [_key, keyID, secret] <- find (hasKey key) contents+        return (makeCredentials (T.encodeUtf8 keyID) (T.encodeUtf8 secret))+    else return Nothing+  where+    hasKey _ [] = False+    hasKey k (k2 : _) = k == k2  -- | Load credentials from the environment variables @AWS_ACCESS_KEY_ID@ and @AWS_ACCESS_KEY_SECRET@ --   (or @AWS_SECRET_ACCESS_KEY@), if possible. loadCredentialsFromEnv :: MonadIO io => io (Maybe Credentials) loadCredentialsFromEnv = liftIO $ do   env <- getEnvironment-  ref <- newIORef []   let lk = flip lookup env       keyID = lk "AWS_ACCESS_KEY_ID"       secret = lk "AWS_ACCESS_KEY_SECRET" `mplus` lk "AWS_SECRET_ACCESS_KEY"-  return (Credentials <$> (T.encodeUtf8 . T.pack <$> keyID) -                      <*> (T.encodeUtf8 . T.pack <$> secret)-                      <*> return ref-                      <*> return Nothing)+  Traversable.sequence+      (makeCredentials <$> (T.encodeUtf8 . T.pack <$> keyID)+                       <*> (T.encodeUtf8 . T.pack <$> secret))  loadCredentialsFromInstanceMetadata :: MonadIO io => io (Maybe Credentials) loadCredentialsFromInstanceMetadata = liftIO $ HTTP.withManager $ \mgr ->@@ -341,10 +349,10 @@       Just cr -> return (Just cr)       Nothing ->         do-          instcr <- loadCredentialsFromInstanceMetadata-          case instcr of+          filecr <- loadCredentialsFromFile file key+          case filecr of             Just cr -> return (Just cr)-            Nothing -> loadCredentialsFromFile file key+            Nothing -> loadCredentialsFromInstanceMetadata  -- | Load credentials from environment variables if possible, or alternative from the default file with the default -- key name.

@@ -1,6 +1,7 @@ module Aws.S3.Commands (   module Aws.S3.Commands.CopyObject+, module Aws.S3.Commands.DeleteBucket , module Aws.S3.Commands.DeleteObject , module Aws.S3.Commands.DeleteObjects , module Aws.S3.Commands.GetBucket@@ -13,6 +14,7 @@ where  import Aws.S3.Commands.CopyObject+import Aws.S3.Commands.DeleteBucket import Aws.S3.Commands.DeleteObject import Aws.S3.Commands.DeleteObjects import Aws.S3.Commands.GetBucket

@@ -0,0 +1,40 @@+module Aws.S3.Commands.DeleteBucket+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 DeleteBucket = DeleteBucket { dbBucket :: Bucket }+    deriving (Show)++data DeleteBucketResponse = DeleteBucketResponse {}+    deriving (Show)++-- | ServiceConfiguration: 'S3Configuration'+instance SignQuery DeleteBucket where+    type ServiceConfiguration DeleteBucket = S3Configuration+    signQuery DeleteBucket {..} = s3SignQuery S3Query {+                                 s3QMethod = Delete+                               , s3QBucket = Just $ T.encodeUtf8 dbBucket+                               , s3QSubresources = []+                               , s3QQuery = []+                               , s3QContentType = Nothing+                               , s3QContentMd5 = Nothing+                               , s3QAmzHeaders = []+                               , s3QOtherHeaders = []+                               , s3QRequestBody = Nothing+                               , s3QObject = Nothing+                               }++instance ResponseConsumer DeleteBucket DeleteBucketResponse where+    type ResponseMetadata DeleteBucketResponse = S3Metadata+    responseConsumer _ = s3ResponseConsumer $ \_ -> return DeleteBucketResponse++instance Transaction DeleteBucket DeleteBucketResponse++instance AsMemoryResponse DeleteBucketResponse where+    type MemoryResponse DeleteBucketResponse = DeleteBucketResponse+    loadToMemory = return

@@ -104,6 +104,9 @@             (True, Nothing,     contents@(_:_)) -> Just $ request { gbMarker = Just $ objectKey $ last contents }             (_,    _,           _             ) -> Nothing +instance ListResponse GetBucketResponse ObjectInfo where+    listResponse = gbrContents+ instance AsMemoryResponse GetBucketResponse where     type MemoryResponse GetBucketResponse = GetBucketResponse     loadToMemory = return

@@ -97,7 +97,7 @@       , sqAuthorization = Nothing       , sqContentType   = Nothing       , sqContentMd5    = Nothing-      , sqAmzHeaders    = [("X-Amzn-Authorization", authorization)]+      , sqAmzHeaders    = amzHeaders       , sqOtherHeaders  = []       , sqBody          = Nothing       , sqStringToSign  = stringToSign@@ -106,11 +106,16 @@       stringToSign  = fmtRfc822Time (signatureTime sd)       credentials   = signatureCredentials sd       accessKeyId   = accessKeyID credentials-      authorization = B.concat [ "AWS3-HTTPS AWSAccessKeyId="-                               , accessKeyId-                               , ", Algorithm=HmacSHA256, Signature="-                               , signature credentials HmacSHA256 stringToSign-                               ]+      amzHeaders    = catMaybes+                    [ Just ("X-Amzn-Authorization", authorization)+                    , ("x-amz-security-token",) `fmap` iamToken credentials+                    ]+      authorization = B.concat+                    [ "AWS3-HTTPS AWSAccessKeyId="+                    , accessKeyId+                    , ", Algorithm=HmacSHA256, Signature="+                    , signature credentials HmacSHA256 stringToSign+                    ]       query' = ("AWSAccessKeyId", accessKeyId) : query  sesResponseConsumer :: (Cu.Cursor -> Response SesMetadata a)

@@ -0,0 +1,34 @@+{-# LANGUAGE OverloadedStrings #-}++import qualified Aws+import qualified Aws.S3 as S3+import qualified Data.Conduit as C+import qualified Data.Conduit.List as CL+import           Data.Text (pack)+import           Control.Monad ((<=<))+import           Control.Monad.IO.Class (liftIO)+import           Network.HTTP.Conduit (withManager, responseBody)+import           System.Environment (getArgs)++main :: IO ()+main = do+  [bucket] <- fmap (map pack) getArgs++  {- Set up AWS credentials and the default configuration. -}+  cfg <- Aws.baseConfiguration+  let s3cfg = Aws.defServiceConfig :: S3.S3Configuration Aws.NormalQuery++  {- Set up a ResourceT region with an available HTTP manager. -}+  withManager $ \mgr -> do+    let src = Aws.awsIteratedSource cfg s3cfg mgr (S3.getBucket bucket)+    let deleteObjects [] = return ()+        deleteObjects os =+          do+            let keys = map S3.objectKey os+            liftIO $ putStrLn ("Deleting objects: " ++ show keys)+            _ <- Aws.pureAws cfg s3cfg mgr (S3.deleteObjects bucket (map S3.objectKey os))+            return ()+    src C.$$ CL.mapM_ (deleteObjects . S3.gbrContents <=< Aws.readResponseIO)+    liftIO $ putStrLn ("Deleting bucket: " ++ show bucket)+    _ <- Aws.pureAws cfg s3cfg mgr (S3.DeleteBucket bucket)+    return ()

@@ -90,6 +90,13 @@  ** 0.9 series +- 0.9.3+  - fix performance regression for loadCredentialsDefault+  - add generic makeCredentials function+  - add S3 DeleteBucket operation+  - add S3 NukeBucket example+  - SES: use security token if enabled (should allow using it with IAM roles on EC2 instances)+ - 0.9.2   - Support for credentials from EC2 instance metadata (only S3 for now)   - aeson 0.8 compatibility

@@ -1,5 +1,5 @@ Name:                aws-Version:             0.9.2+Version:             0.9.3 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>. Homepage:            http://github.com/aristidb/aws@@ -20,7 +20,7 @@ Source-repository this   type: git   location: https://github.com/aristidb/aws.git-  tag: 0.9.2+  tag: 0.9.3  Source-repository head   type: git@@ -56,6 +56,7 @@                        Aws.S3,                        Aws.S3.Commands,                        Aws.S3.Commands.CopyObject,+                       Aws.S3.Commands.DeleteBucket,                        Aws.S3.Commands.DeleteObject,                        Aws.S3.Commands.DeleteObjects,                        Aws.S3.Commands.GetBucket,@@ -166,6 +167,25 @@                        http-conduit,                        conduit,                        conduit-extra++  Default-Language: Haskell2010++Executable NukeBucket+  Main-is: NukeBucket.hs+  Hs-source-dirs: Examples++  if !flag(Examples)+    Buildable: False+  else+    Buildable: True+    Build-depends:+                       base == 4.*,+                       aws,+                       http-conduit,+                       conduit,+                       conduit-extra,+                       text >=0.1,+                       transformers    Default-Language: Haskell2010