diff --git a/amazonka-core.cabal b/amazonka-core.cabal --- a/amazonka-core.cabal +++ b/amazonka-core.cabal @@ -1,5 +1,5 @@ name: amazonka-core -version: 0.1.0 +version: 0.1.1 synopsis: Core functionality and data types for Amazonka libraries. homepage: https://github.com/brendanhay/amazonka license: OtherLicense @@ -7,7 +7,7 @@ author: Brendan Hay maintainer: Brendan Hay copyright: Copyright (c) 2013-2014 Brendan Hay -category: Network, AWS, Cloud +category: Network, AWS, Cloud, Distributed Computing build-type: Simple extra-source-files: README.md cabal-version: >= 1.10 diff --git a/src/Network/AWS/Data/Internal/List.hs b/src/Network/AWS/Data/Internal/List.hs --- a/src/Network/AWS/Data/Internal/List.hs +++ b/src/Network/AWS/Data/Internal/List.hs @@ -1,7 +1,7 @@ {-# LANGUAGE DataKinds #-} {-# LANGUAGE DeriveFoldable #-} {-# LANGUAGE DeriveTraversable #-} -{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE KindSignatures #-} {-# LANGUAGE LambdaCase #-} @@ -23,23 +23,21 @@ module Network.AWS.Data.Internal.List where -import Control.Lens hiding (coerce, element) +import Control.Lens hiding (coerce, element) import Control.Monad import Data.Aeson -import Data.ByteString (ByteString) import Data.Coerce -import Data.Foldable (Foldable) -import Data.List.NonEmpty (NonEmpty(..)) +import Data.Foldable (Foldable) +import Data.List.NonEmpty (NonEmpty(..)) import Data.Maybe import Data.Monoid import Data.Proxy -import Data.Semigroup (Semigroup) +import Data.Semigroup (Semigroup) import Data.String -import qualified Data.Text as Text -import qualified Data.Vector as Vector +import qualified Data.Text as Text +import qualified Data.Vector as Vector import GHC.Exts import GHC.TypeLits -import Network.AWS.Data.Internal.ByteString import Network.AWS.Data.Internal.Query import Network.AWS.Data.Internal.XML import Text.XML @@ -76,12 +74,6 @@ toList1 (List (x:xs)) = Right $ List1 (x :| xs) toList1 _ = Left $ "Unexpected empty list, expected at least 1 element." - -toQueryList :: ToQuery a => ByteString -> [a] -> Query -toQueryList n = mconcat . zipWith (\i v -> n =? (toBS i, v)) idx - where - idx = [1..] :: [Int] -{-# INLINE toQueryList #-} instance (KnownSymbol e, ToQuery a) => ToQuery (List e a) where toQuery = toQueryList n . toList . list diff --git a/src/Network/AWS/Data/Internal/Query.hs b/src/Network/AWS/Data/Internal/Query.hs --- a/src/Network/AWS/Data/Internal/Query.hs +++ b/src/Network/AWS/Data/Internal/Query.hs @@ -26,8 +26,9 @@ , Query , valuesOf - , pair , (=?) + , pair + , toQueryList ) where import Control.Lens @@ -40,6 +41,7 @@ import Data.String import Data.Text (Text) import qualified Data.Text.Encoding as Text +import GHC.Exts import Network.AWS.Data.Internal.ByteString import Network.AWS.Data.Internal.Text import Network.HTTP.Types.URI (urlEncode) @@ -81,9 +83,17 @@ pair :: ToQuery a => ByteString -> a -> Query -> Query pair k v = mappend (Pair k (toQuery v)) +{-# INLINE pair #-} (=?) :: ToQuery a => ByteString -> a -> Query (=?) k v = Pair k (toQuery v) +{-# INLINE (=?) #-} + +toQueryList :: (IsList a, ToQuery (Item a)) => ByteString -> a -> Query +toQueryList n = mconcat . zipWith (\i v -> n =? (toBS i, v)) idx . toList + where + idx = [1..] :: [Int] +{-# INLINE toQueryList #-} renderQuery :: Query -> ByteString renderQuery = intercalate . sort . enc Nothing diff --git a/src/Network/AWS/Response.hs b/src/Network/AWS/Response.hs --- a/src/Network/AWS/Response.hs +++ b/src/Network/AWS/Response.hs @@ -1,4 +1,5 @@ {-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TupleSections #-} {-# LANGUAGE TypeFamilies #-} @@ -27,13 +28,15 @@ import Control.Applicative import Control.Monad +import Control.Monad.IO.Class import Control.Monad.Trans.Resource import Data.Aeson import Data.Bifunctor import qualified Data.ByteString.Lazy as LBS import Data.Conduit import qualified Data.Conduit.Binary as Conduit -import Network.AWS.Data (LazyByteString, FromXML(..), decodeXML) +import Data.Monoid +import Network.AWS.Data (LazyByteString, FromXML(..), decodeXML, build) import Network.AWS.Types import Network.HTTP.Client hiding (Request, Response) import Network.HTTP.Types @@ -41,15 +44,17 @@ nullResponse :: (MonadResource m, AWSService (Sv a)) => Rs a + -> Logger -> Request a -> Either HttpException ClientResponse -> m (Response' a) -nullResponse rs = receive $ \_ _ bdy -> +nullResponse rs _ = receive $ \_ _ bdy -> liftResourceT (bdy $$+- return (Right rs)) {-# INLINE nullResponse #-} headerResponse :: (MonadResource m, AWSService (Sv a)) => (ResponseHeaders -> Either String (Rs a)) + -> Logger -> Request a -> Either HttpException ClientResponse -> m (Response' a) @@ -57,7 +62,8 @@ {-# INLINE headerResponse #-} xmlResponse :: (MonadResource m, AWSService (Sv a), FromXML (Rs a)) - => Request a + => Logger + -> Request a -> Either HttpException ClientResponse -> m (Response' a) xmlResponse = deserialise (decodeXML >=> parseXML) (const Right) @@ -65,6 +71,7 @@ xmlHeaderResponse :: (MonadResource m, AWSService (Sv a)) => (ResponseHeaders -> [Node] -> Either String (Rs a)) + -> Logger -> Request a -> Either HttpException ClientResponse -> m (Response' a) @@ -72,7 +79,8 @@ {-# INLINE xmlHeaderResponse #-} jsonResponse :: (MonadResource m, AWSService (Sv a), FromJSON (Rs a)) - => Request a + => Logger + -> Request a -> Either HttpException ClientResponse -> m (Response' a) jsonResponse = deserialise eitherDecode' (const Right) @@ -80,6 +88,7 @@ jsonHeaderResponse :: (MonadResource m, AWSService (Sv a)) => (ResponseHeaders -> Object -> Either String (Rs a)) + -> Logger -> Request a -> Either HttpException ClientResponse -> m (Response' a) @@ -88,21 +97,24 @@ bodyResponse :: (MonadResource m, AWSService (Sv a)) => (ResponseHeaders -> ResponseBody -> Either String (Rs a)) + -> Logger -> Request a -> Either HttpException ClientResponse -> m (Response' a) -bodyResponse f = receive $ \a hs bdy -> +bodyResponse f _ = receive $ \a hs bdy -> return (SerializerError a `first` f hs bdy) {-# INLINE bodyResponse #-} deserialise :: (AWSService (Sv a), MonadResource m) => (LazyByteString -> Either String b) -> (ResponseHeaders -> b -> Either String (Rs a)) + -> Logger -> Request a -> Either HttpException ClientResponse -> m (Response' a) -deserialise g f = receive $ \a hs bdy -> do +deserialise g f l = receive $ \a hs bdy -> do lbs <- sinkLbs bdy + liftIO $ l Trace ("[Client Response Body]\n" <> build lbs) return $! case g lbs of Left e -> Left (SerializerError a e) Right o -> diff --git a/src/Network/AWS/Types.hs b/src/Network/AWS/Types.hs --- a/src/Network/AWS/Types.hs +++ b/src/Network/AWS/Types.hs @@ -79,6 +79,10 @@ , Response' , Empty (..) + -- * Logging + , LogLevel (..) + , Logger + -- * Regions , Region (..) @@ -101,6 +105,7 @@ import Data.Aeson hiding (Error) import Data.ByteString (ByteString) import qualified Data.ByteString as BS +import Data.ByteString.Builder (Builder) import qualified Data.CaseInsensitive as CI import Data.Conduit import Data.Default.Class @@ -163,6 +168,14 @@ type Response' a = Either (ServiceError (Er (Sv a))) (Status, Rs a) +data LogLevel + = Info -- ^ Informational messages supplied by the user, not used by the library. + | Debug -- ^ Info level + debug messages + non-streaming response bodies. + | Trace -- ^ Debug level + potentially sensitive signing metadata. + deriving (Eq, Ord, Enum, Show) + +type Logger = LogLevel -> Builder -> IO () + -- | Specify how a request can be de/serialised. class (AWSService (Sv a), AWSSigner (Sg (Sv a))) => AWSRequest a where -- | The service definition for a request. @@ -173,7 +186,8 @@ request :: a -> Request a response :: MonadResource m - => Request a + => Logger + -> Request a -> Either HttpException ClientResponse -> m (Response' a) @@ -251,11 +265,11 @@ instance ToBuilder AuthEnv where build AuthEnv{..} = mconcat $ intersperse "\n" - [ "[Authentication] {" - , " access key = " <> build _authAccess - , " secret key = ****" - , " security token = ****" - , " expiry = " <> build _authExpiry + [ "[Amazonka Auth] {" + , " access key = " <> build _authAccess + , " secret key = ****" + , " security token = " <> maybe "Nothing" (const "Just ****") _authToken + , " expiry = " <> build _authExpiry , "}" ] @@ -266,7 +280,7 @@ | Auth AuthEnv instance ToBuilder Auth where - build (Ref t _) = "[Authentication] { build (show t) <> "> }" + build (Ref t _) = "[Amazonka Auth] { build (show t) <> "> }" build (Auth e) = build e withAuth :: MonadIO m => Auth -> (AuthEnv -> m a) -> m a