aws 0.9.1 → 0.9.2

raw patch · 7 files changed

+112/−16 lines, 7 filesdep +networkdep ~aesondep ~basePVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: network

Dependency ranges changed: aeson, base

API changes (from Hackage documentation)

Files

• Aws.hs +2/−0
• Aws/Aws.hs +5/−4
• Aws/Core.hs +65/−4
• Aws/Network.hs +20/−0
• Aws/S3/Core.hs +10/−4
• README.org +4/−0
• aws.cabal +6/−4

@@ -53,7 +53,9 @@ , credentialsDefaultKey , loadCredentialsFromFile , loadCredentialsFromEnv+, loadCredentialsFromInstanceMetadata , loadCredentialsFromEnvOrFile+, loadCredentialsFromEnvOrFileOrInstanceMetadata , loadCredentialsDefault ) where

@@ -79,13 +79,14 @@ -- (see 'loadCredentialsDefault'). baseConfiguration :: MonadIO io => io Configuration baseConfiguration = liftIO $ do-  Just cr <- loadCredentialsDefault-  return Configuration {+  cr <- loadCredentialsDefault+  case cr of+    Nothing -> E.throw $ NoCredentialsException "could not locate aws credentials"+    Just cr' -> return Configuration {                       timeInfo = Timestamp-                    , credentials = cr+                    , credentials = cr'                     , logger = defaultLog Warning                     }--- TODO: better error handling when credentials cannot be loaded  -- | Debug configuration, which logs much more verbosely. dbgConfiguration :: MonadIO io => io Configuration

@@ -21,6 +21,7 @@ , XmlException(..) , HeaderException(..) , FormException(..)+, NoCredentialsException(..)   -- ** Response deconstruction helpers , readHex2   -- *** XML@@ -73,7 +74,9 @@ , credentialsDefaultKey , loadCredentialsFromFile , loadCredentialsFromEnv+, loadCredentialsFromInstanceMetadata , loadCredentialsFromEnvOrFile+, loadCredentialsFromEnvOrFileOrInstanceMetadata , loadCredentialsDefault   -- * Service configuration , DefaultServiceConfiguration(..)@@ -85,6 +88,8 @@ ) where +import           Aws.Ec2.InstanceMetadata+import           Aws.Network import qualified Blaze.ByteString.Builder as Blaze import           Control.Applicative import           Control.Arrow@@ -93,6 +98,7 @@ import           Control.Monad.IO.Class import           Control.Monad.Trans.Resource (ResourceT, MonadThrow (throwM)) import           Crypto.Hash+import qualified Data.Aeson               as A import           Data.Byteable import           Data.ByteString          (ByteString) import qualified Data.ByteString          as B@@ -108,6 +114,7 @@ import           Data.Default             (def) import           Data.IORef import           Data.List+import qualified Data.Map                 as M import           Data.Maybe import           Data.Monoid import qualified Data.Text                as T@@ -232,9 +239,11 @@       , secretAccessKey :: B.ByteString         -- | Signing keys for signature version 4       , v4SigningKeys :: IORef [V4Key]+        -- | Signed IAM token+      , iamToken :: Maybe B.ByteString       } instance Show Credentials where-    show c = "Credentials{accessKeyID=" ++ show (accessKeyID c) ++ ",secretAccessKey=" ++ show (secretAccessKey c) ++ "}"+    show c = "Credentials{accessKeyID=" ++ show (accessKeyID c) ++ ",secretAccessKey=" ++ show (secretAccessKey c) ++ ",iamToken=" ++ show (iamToken c) ++ "}"  -- | The file where access credentials are loaded, when using 'loadCredentialsDefault'. --@@ -262,6 +271,7 @@     return Credentials { accessKeyID = T.encodeUtf8 keyID                        , secretAccessKey = T.encodeUtf8 secret                        , v4SigningKeys = ref+                       , iamToken = Nothing                        }       where         hasKey _ [] = False@@ -278,8 +288,37 @@       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 ref+                      <*> return Nothing) +loadCredentialsFromInstanceMetadata :: MonadIO io => io (Maybe Credentials)+loadCredentialsFromInstanceMetadata = liftIO $ HTTP.withManager $ \mgr ->+  do+    -- check if the path is routable+    avail <- liftIO $ hostAvailable "169.254.169.254"+    if not avail+      then return Nothing+      else do+        info <- liftIO $ E.catch (getInstanceMetadata mgr "latest/meta-data/iam" "info" >>= return . Just) (\(_ :: HTTP.HttpException) -> return Nothing)+        let infodict = info >>= A.decode :: Maybe (M.Map String String)+            info'    = infodict >>= M.lookup "InstanceProfileArn"+        case info' of+          Just name ->+            do+              let name' = drop 1 $ dropWhile (/= '/') $ name+              creds <- liftIO $ E.catch (getInstanceMetadata mgr "latest/meta-data/iam/security-credentials" name' >>= return . Just) (\(_ :: HTTP.HttpException) -> return Nothing)+              -- this token lasts ~6 hours+              let dict   = creds >>= A.decode :: Maybe (M.Map String String)+                  keyID  = dict  >>= M.lookup "AccessKeyId"+                  secret = dict  >>= M.lookup "SecretAccessKey"+                  token  = dict  >>= M.lookup "Token"+              ref <- liftIO $ newIORef []+              return (Credentials <$> (T.encodeUtf8 . T.pack <$> keyID)+                                  <*> (T.encodeUtf8 . T.pack <$> secret)+                                  <*> return ref+                                  <*> (Just . T.encodeUtf8 . T.pack <$> token))+          Nothing -> return Nothing+ -- | Load credentials from environment variables if possible, or alternatively from a file with a given key name. -- -- See 'loadCredentialsFromEnv' and 'loadCredentialsFromFile' for details.@@ -291,6 +330,22 @@       Just cr -> return (Just cr)       Nothing -> loadCredentialsFromFile file key +-- | Load credentials from environment variables if possible, or alternatively from the instance metadata store, or alternatively from a file with a given key name.+--+-- See 'loadCredentialsFromEnv', 'loadCredentialsFromFile' and 'loadCredentialsFromInstanceMetadata' for details.+loadCredentialsFromEnvOrFileOrInstanceMetadata :: MonadIO io => FilePath -> T.Text -> io (Maybe Credentials)+loadCredentialsFromEnvOrFileOrInstanceMetadata file key =+  do+    envcr <- loadCredentialsFromEnv+    case envcr of+      Just cr -> return (Just cr)+      Nothing ->+        do+          instcr <- loadCredentialsFromInstanceMetadata+          case instcr of+            Just cr -> return (Just cr)+            Nothing -> loadCredentialsFromFile file key+ -- | Load credentials from environment variables if possible, or alternative from the default file with the default -- key name. --@@ -301,7 +356,7 @@ loadCredentialsDefault :: MonadIO io => io (Maybe Credentials) loadCredentialsDefault = do   file <- credentialsDefaultFile-  loadCredentialsFromEnvOrFile file credentialsDefaultKey+  loadCredentialsFromEnvOrFileOrInstanceMetadata file credentialsDefaultKey  -- | Protocols supported by AWS. Currently, all AWS services use the HTTP or HTTPS protocols. data Protocol@@ -682,10 +737,16 @@ instance E.Exception HeaderException  -- | An error that occurred during form parsing / validation.-newtype FormException  = FormException { formErrorMesage :: String }+newtype FormException = FormException { formErrorMesage :: String }     deriving (Show, Typeable)  instance E.Exception FormException++-- | No credentials were found and an invariant was violated.+newtype NoCredentialsException = NoCredentialsException { noCredentialsErrorMesage :: String }+    deriving (Show, Typeable)++instance E.Exception NoCredentialsException   -- | A specific element (case-insensitive, ignoring namespace - sadly necessary), extracting only the textual contents.

@@ -0,0 +1,20 @@+module Aws.Network where++import Data.Maybe+import Control.Exception+import Network.BSD (getProtocolNumber)+import Network.Socket+import System.Timeout++-- Make a good guess if a host is reachable.+hostAvailable :: String -> IO Bool+hostAvailable h = do+  sock <- getProtocolNumber "tcp" >>= socket AF_INET Stream+  addr <- (addrAddress . head) `fmap` getAddrInfo (Just (defaultHints { addrFlags = [ AI_PASSIVE ] } )) (Just h) (Just "80")+  case addr of+    remote@(SockAddrInet _ _) -> do+      v <- catch (timeout 100000 (connect sock remote) >>= return . isJust)+                 (\(_ :: SomeException) -> return False)+      sClose sock+      return v+    _ -> return False

@@ -177,7 +177,7 @@       , sqStringToSign = stringToSign       }     where-      amzHeaders = merge $ sortBy (compare `on` fst) s3QAmzHeaders+      amzHeaders = merge $ sortBy (compare `on` fst) (s3QAmzHeaders ++ (fmap (\(k, v) -> (CI.mk k, v)) iamTok))           where merge (x1@(k1,v1):x2@(k2,v2):xs) | k1 == k2  = merge ((k1, B8.intercalate "," [v1, v2]) : xs)                                                  | otherwise = x1 : merge (x2 : xs)                 merge xs = xs@@ -196,6 +196,7 @@              (True, AbsoluteTimestamp time) -> AbsoluteExpires $ s3DefaultExpiry `addUTCTime` time              (True, AbsoluteExpires time) -> AbsoluteExpires time       sig = signature signatureCredentials HmacSHA1 stringToSign+      iamTok = maybe [] (\x -> [("x-amz-security-token", x)]) (iamToken signatureCredentials)       stringToSign = Blaze.toByteString . mconcat . intersperse (Blaze8.fromChar '\n') . concat  $                        [[Blaze.copyByteString $ httpMethod s3QMethod]                        , [maybe mempty (Blaze.copyByteString . Base64.encode . toBytes) s3QContentMd5]@@ -214,7 +215,7 @@           = [("Expires" :: B8.ByteString, fmtTimeEpochSeconds time)             , ("AWSAccessKeyId", accessKeyID signatureCredentials)             , ("SignatureMethod", "HmacSHA256")-            , ("Signature", sig)]+            , ("Signature", sig)] ++ iamTok  s3ResponseConsumer :: HTTPResponseConsumer a                    -> IORef S3Metadata@@ -356,7 +357,7 @@       , objectETag         :: T.Text       , objectSize         :: Integer       , objectStorageClass :: StorageClass-      , objectOwner        :: UserInfo+      , objectOwner        :: Maybe UserInfo       }     deriving (Show) @@ -371,7 +372,9 @@          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" &| parseStorageClass-         owner <- forceM "Missing object Owner" $ el $/ Cu.laxElement "Owner" &| parseUserInfo+         owner <- case el $/ Cu.laxElement "Owner" &| parseUserInfo of+                    (x:_) -> fmap' Just x+                    [] -> return Nothing          return ObjectInfo{                       objectKey          = key                     , objectLastModified = lastModified@@ -380,6 +383,9 @@                     , objectStorageClass = storageClass                     , objectOwner        = owner                     }+    where+      fmap' :: Monad m => (a -> b) -> m a -> m b+      fmap' f ma = ma >>= return . f  data ObjectMetadata     = ObjectMetadata {

@@ -90,6 +90,10 @@  ** 0.9 series +- 0.9.2+  - Support for credentials from EC2 instance metadata (only S3 for now)+  - aeson 0.8 compatibility+ - 0.9.1   - Support for multi-page S3 GetBucket requests   - S3 GLACIER support

@@ -1,5 +1,5 @@ Name:                aws-Version:             0.9.1+Version:             0.9.2 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.1+  tag: 0.9.2  Source-repository head   type: git@@ -95,10 +95,11 @@                        Aws.Ses.Core,                        Aws.DynamoDb.Commands,                        Aws.DynamoDb.Commands.Table,-                       Aws.DynamoDb.Core+                       Aws.DynamoDb.Core,+                       Aws.Network    Build-depends:-                       aeson                >= 0.6     && < 0.8,+                       aeson                >= 0.6,                        base                 == 4.*,                        base16-bytestring    == 0.1.*,                        base64-bytestring    == 1.0.*,@@ -119,6 +120,7 @@                        lifted-base          >= 0.1     && < 0.3,                        monad-control        >= 0.3,                        mtl                  == 2.*,+                       network              == 2.*,                        old-locale           == 1.*,                        resourcet            >= 1.1     && < 1.2,                        text                 >= 0.11,