amazonka 0.0.5 → 0.0.6
raw patch · 6 files changed
+261/−21 lines, 6 filesdep +textdep ~amazonka-core
Dependencies added: text
Dependency ranges changed: amazonka-core
Files
- amazonka.cabal +6/−3
- src/Control/Monad/Trans/AWS.hs +6/−2
- src/Network/AWS.hs +2/−13
- src/Network/AWS/Auth.hs +204/−0
- src/Network/AWS/Internal/Env.hs +41/−0
- src/Network/AWS/Internal/Log.hs +2/−3
amazonka.cabal view
@@ -1,5 +1,5 @@ name: amazonka-version: 0.0.5+version: 0.0.6 synopsis: Comprehensive Amazon Web Services SDK homepage: https://github.com/brendanhay/amazonka license: OtherLicense@@ -32,12 +32,14 @@ exposed-modules: Control.Monad.Trans.AWS , Network.AWS+ , Network.AWS.Auth other-modules:- Network.AWS.Internal.Log+ Network.AWS.Internal.Env+ , Network.AWS.Internal.Log build-depends:- amazonka-core == 0.0.5.*+ amazonka-core == 0.0.6.* , base >= 4.7 && < 5 , bytestring >= 0.9 , conduit >= 1.1 && < 1.3@@ -48,6 +50,7 @@ , monad-control >= 0.3.2 && < 4 , mtl >= 2.2.1 && < 2.3 , resourcet >= 1.1 && < 1.3+ , text >= 1.1 , time >= 1.4 , transformers == 0.4.* , transformers-base >= 0.4.2
src/Control/Monad/Trans/AWS.hs view
@@ -7,6 +7,8 @@ {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE TupleSections #-} {-# LANGUAGE TypeFamilies #-}++-- This is required due to the MonadBaseControl instance. {-# LANGUAGE UndecidableInstances #-} -- Module : Control.Monad.Trans.AWS@@ -89,10 +91,10 @@ import Control.Monad.Trans.Resource import Data.Conduit import Data.Time-import Network.AWS (Env, envRegion, envLogger, envAuth, envManager) import qualified Network.AWS as AWS import Network.AWS.Auth import Network.AWS.Data (ToBuilder(..))+import Network.AWS.Internal.Env import Network.AWS.Internal.Log import Network.AWS.Types @@ -190,7 +192,9 @@ -- | Unwrap an 'AWST' transformer, calling all of the registered 'ResourceT' -- release actions. runAWST :: MonadBaseControl IO m => Env -> AWST m a -> m (Either Error a)-runAWST e m = runResourceT (withInternalState (runAWST' m . (e,)))+runAWST e m = runResourceT . withInternalState $ runAWST' f . (e,)+ where+ f = liftBase ((_envLogger e) Debug (build e)) >> m runAWST' :: AWST m a -> (Env, InternalState) -> m (Either Error a) runAWST' (AWST k) = runExceptT . runReaderT k
src/Network/AWS.hs view
@@ -2,7 +2,6 @@ {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-}-{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE ViewPatterns #-} @@ -47,7 +46,6 @@ , module Network.AWS.Types ) where -import Control.Lens import Control.Monad.Catch import Control.Monad.Except import Control.Monad.Trans.Resource@@ -55,20 +53,11 @@ import Data.Time import Network.AWS.Auth import Network.AWS.Data+import Network.AWS.Internal.Env import Network.AWS.Internal.Log-import qualified Network.AWS.Signing.Internal as Sign+import qualified Network.AWS.Signing as Sign import Network.AWS.Types import Network.HTTP.Conduit hiding (Response)---- | The environment containing the parameters required to make AWS requests.-data Env = Env- { _envRegion :: !Region- , _envLogger :: Logger- , _envManager :: Manager- , _envAuth :: Auth- }--makeLenses ''Env -- | This creates a new environment without debug logging and uses 'getAuth' -- to expand/discover the supplied 'Credentials'.
+ src/Network/AWS/Auth.hs view
@@ -0,0 +1,204 @@+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ViewPatterns #-}++-- Module : Network.AWS.Auth+-- Copyright : (c) 2013-2014 Brendan Hay <brendan.g.hay@gmail.com>+-- License : This Source Code Form is subject to the terms of+-- the Mozilla Public License, v. 2.0.+-- A copy of the MPL can be found in the LICENSE file or+-- you can obtain it at http://mozilla.org/MPL/2.0/.+-- Maintainer : Brendan Hay <brendan.g.hay@gmail.com>+-- Stability : experimental+-- Portability : non-portable (GHC extensions)++-- | Explicitly specify your Amazon AWS security credentials, or retrieve them+-- from the underlying OS.+module Network.AWS.Auth+ (+ -- * Defaults+ accessKey+ , secretKey++ -- * Specifying credentials+ , fromKeys+ , fromSession++ -- * Retrieving credentials+ , Credentials (..)+ , getAuth+ ) where++import Control.Applicative+import Control.Concurrent+import Control.Monad.Except+import qualified Data.ByteString.Char8 as BS+import qualified Data.ByteString.Lazy.Char8 as LBS+import Data.IORef+import Data.Monoid+import Data.Text (Text)+import qualified Data.Text as Text+import qualified Data.Text.Encoding as Text+import Data.Time+import Network.AWS.Data+import Network.AWS.EC2.Metadata+import Network.AWS.Types+import Network.HTTP.Conduit+import System.Environment+import System.Mem.Weak++-- | Default access key environment variable.+accessKey :: Text -- ^ 'AWS_ACCESS_KEY'+accessKey = "AWS_ACCESS_KEY"++-- | Default secret key environment variable.+secretKey :: Text -- ^ 'AWS_SECRET_KEY'+secretKey = "AWS_SECRET_KEY"++-- | Explicit access and secret keys.+fromKeys :: AccessKey -> SecretKey -> Auth+fromKeys a s = Auth (AuthEnv a s Nothing Nothing)++-- | A session containing the access key, secret key, and a security token.+fromSession :: AccessKey -> SecretKey -> SecurityToken -> Auth+fromSession a s t = Auth (AuthEnv a s (Just t) Nothing)++-- | Determines how authentication information is retrieved.+data Credentials+ = FromKeys AccessKey SecretKey+ -- ^ Explicit access and secret keys.+ -- /Note:/ you can achieve the same result purely using 'fromKeys' without+ -- having to use the impure 'getAuth'.+ | FromSession AccessKey SecretKey SecurityToken+ -- ^ A session containing the access key, secret key, and a security token.+ -- /Note:/ you can achieve the same result purely using 'fromSession'+ -- without having to use the impure 'getAuth'.+ | FromProfile Text+ -- ^ An IAM Profile name to lookup from the local EC2 instance-data.+ | FromEnv Text Text+ -- ^ Environment variables to lookup for the access and secret keys.+ | Discover+ -- ^ Attempt to read the default access and secret keys from the environment,+ -- falling back to the first available IAM profile if they are not set.+ --+ -- /Note:/ This attempts to resolve <http://instance-data> rather than directly+ -- retrieving <http://169.254.169.254> for IAM profile information to ensure+ -- the dns lookup terminates promptly if not running on EC2.+ deriving (Eq)++instance ToBuilder Credentials where+ build = \case+ FromKeys a _ -> "FromKeys " <> build a <> " ****"+ FromSession a _ _ -> "FromSession " <> build a <> " **** ****"+ FromProfile n -> "FromProfile " <> build n+ FromEnv a s -> "FromEnv " <> build a <> " " <> build s+ Discover -> "Discover"++instance Show Credentials where+ show = LBS.unpack . buildBS++-- | Retrieve authentication information using the specified 'Credentials' style.+getAuth :: (Functor m, MonadIO m)+ => Manager+ -> Credentials+ -> ExceptT String m Auth+getAuth m = \case+ FromKeys a s -> return (fromKeys a s)+ FromSession a s t -> return (fromSession a s t)+ FromProfile n -> show `withExceptT` fromProfileName m n+ FromEnv a s -> fromEnvVars a s+ Discover -> fromEnv `catchError` const (iam `catchError` const err)+ where+ iam = show `withExceptT` fromProfile m+ err = throwError "Unable to read environment variables or IAM profile."++-- | Retrieve access and secret keys from the default environment variables.+--+-- /See:/ 'accessKey' and 'secretKey'+fromEnv :: (Functor m, MonadIO m) => ExceptT String m Auth+fromEnv = fromEnvVars accessKey secretKey++-- | Retrieve access and secret keys from specific environment variables.+fromEnvVars :: (Functor m, MonadIO m) => Text -> Text -> ExceptT String m Auth+fromEnvVars a s = fmap Auth $ AuthEnv+ <$> (AccessKey <$> key a)+ <*> (SecretKey <$> key s)+ <*> pure Nothing+ <*> pure Nothing+ where+ key (Text.unpack -> k) = ExceptT $ do+ m <- liftIO (lookupEnv k)+ return $+ maybe (Left $ "Unable to read ENV variable: " ++ k)+ (Right . BS.pack)+ m++-- | Retrieve the default IAM Profile from the local EC2 instance-data.+--+-- This determined by Amazon as the first IAM profile found in the response from:+-- @http://169.254.169.254/latest/meta-data/iam/security-credentials/@+fromProfile :: MonadIO m => Manager -> ExceptT HttpException m Auth+fromProfile m = do+ !ls <- BS.lines `liftM` metadata m (IAM $ SecurityCredentials Nothing)+ case ls of+ (x:_) -> fromProfileName m (Text.decodeUtf8 x)+ _ -> throwError $+ HttpParserException "Unable to get default IAM Profile from EC2 metadata"++-- | Lookup a specific IAM Profile by name from the local EC2 instance-data.+--+-- The resulting IONewRef wrapper + timer is designed so that multiple concurrent+-- accesses of 'AuthEnv' from the 'AWS' environment are not required to calculate+-- expiry and sequentially queue to update it.+--+-- The forked timer ensures a singular owner and pre-emptive refresh of the+-- temporary session credentials.+--+-- A weak reference is used to ensure that the forked thread will eventually+-- terminate when 'Auth' is no longer referenced.+fromProfileName :: MonadIO m+ => Manager+ -> Text+ -> ExceptT HttpException m Auth+fromProfileName m name = auth >>= start+ where+ auth :: MonadIO m => ExceptT HttpException m AuthEnv+ auth = do+ !lbs <- LBS.fromStrict `liftM` metadata m+ (IAM . SecurityCredentials $ Just name)+ either (throwError . HttpParserException)+ return+ (eitherDecode' lbs)++ start !a = ExceptT . liftM Right . liftIO $+ case _authExpiry a of+ Nothing -> return (Auth a)+ Just x -> do+ r <- newIORef a+ p <- myThreadId+ s <- timer r p x+ return (Ref s r)++ timer r p x = forkIO $ do+ s <- myThreadId+ w <- mkWeakIORef r (killThread s)+ loop w p x++ loop w p x = do+ diff x <$> getCurrentTime >>= threadDelay+ ea <- runExceptT auth+ case ea of+ Left e -> throwTo p e+ Right !a -> do+ mr <- deRefWeak w+ case mr of+ Nothing -> return ()+ Just r -> do+ atomicWriteIORef r a+ maybe (return ()) (loop w p) (_authExpiry a)++ diff x y = (* 1000000) $+ let n = truncate (diffUTCTime x y) - 60+ in if n > 0 then n else 1
+ src/Network/AWS/Internal/Env.hs view
@@ -0,0 +1,41 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE TemplateHaskell #-}++-- Module : Network.AWS.Internal.Env+-- Copyright : (c) 2013-2014 Brendan Hay <brendan.g.hay@gmail.com>+-- License : This Source Code Form is subject to the terms of+-- the Mozilla Public License, v. 2.0.+-- A copy of the MPL can be found in the LICENSE file or+-- you can obtain it at http://mozilla.org/MPL/2.0/.+-- Maintainer : Brendan Hay <brendan.g.hay@gmail.com>+-- Stability : experimental+-- Portability : non-portable (GHC extensions)++module Network.AWS.Internal.Env where++import Control.Lens+import Data.List (intersperse)+import Data.Monoid+import Network.AWS.Data (ToBuilder(..))+import Network.AWS.Internal.Log+import Network.AWS.Types (Region, Auth)+import Network.HTTP.Conduit++-- | The environment containing the parameters required to make AWS requests.+data Env = Env+ { _envRegion :: !Region+ , _envLogger :: Logger+ , _envManager :: Manager+ , _envAuth :: Auth+ }++makeLenses ''Env++instance ToBuilder Env where+ build Env{..} = mconcat $ intersperse "\n"+ [ "[Environment] {"+ , " region = " <> build _envRegion+ , " auth = " <> build _envAuth+ , "}"+ ]
src/Network/AWS/Internal/Log.hs view
@@ -1,5 +1,4 @@ {-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE MultiWayIf #-} -- Module : Network.AWS.Internal.Log -- Copyright : (c) 2013-2014 Brendan Hay <brendan.g.hay@gmail.com>@@ -23,7 +22,7 @@ data LogLevel = Info -- ^ Informational messages supplied by the user, not used by the library.- | Debug -- ^ Info level + Debug messages + non-streaming response bodies.+ | Debug -- ^ Info level + debug messages + non-streaming response bodies. | Trace -- ^ Debug level + potentially sensitive signing metadata. deriving (Eq, Ord, Enum, Show) @@ -35,7 +34,7 @@ newLogger :: MonadIO m => LogLevel -> Handle -> m Logger newLogger x hd = liftIO $ do hSetBinaryMode hd True- hSetBuffering hd LineBuffering -- ^ Should be BlockBuffering, but .. concurrency.+ hSetBuffering hd LineBuffering return $ \y b -> if x >= y then hPutBuilder hd (b <> "\n")