diff --git a/Aws/Aws.hs b/Aws/Aws.hs --- a/Aws/Aws.hs +++ b/Aws/Aws.hs @@ -296,7 +296,7 @@ -> ServiceConfiguration r NormalQuery -> HTTP.Manager -> r - -> C.Producer (ResourceT IO) (Response (ResponseMetadata a) a) + -> forall i. C.ConduitT i (Response (ResponseMetadata a) a) (ResourceT IO) () awsIteratedSource cfg scfg manager req_ = awsIteratedSource' run req_ where run r = do @@ -311,7 +311,7 @@ -> ServiceConfiguration r NormalQuery -> HTTP.Manager -> r - -> C.Producer (ResourceT IO) i + -> forall j. C.ConduitT j i (ResourceT IO) () awsIteratedList cfg scfg manager req = awsIteratedList' run req where run r = readResponseIO =<< aws cfg scfg manager r @@ -327,7 +327,7 @@ -- ^ A runner function for executing transactions. -> r -- ^ An initial request - -> C.Producer m b + -> forall i. C.ConduitT i b m () awsIteratedSource' run r0 = go r0 where go q = do @@ -348,9 +348,9 @@ -- ^ A runner function for executing transactions. -> r -- ^ An initial request - -> C.Producer m c + -> forall i. C.ConduitT i c m () awsIteratedList' run r0 = - awsIteratedSource' run' r0 C.=$= + awsIteratedSource' run' r0 `C.fuse` CL.concatMap listResponse where dupl a = (a,a) diff --git a/Aws/Core.hs b/Aws/Core.hs --- a/Aws/Core.hs +++ b/Aws/Core.hs @@ -122,6 +122,7 @@ import qualified Data.Conduit.Binary as CB #endif import qualified Data.Conduit.List as CL +import Data.Kind import Data.IORef import Data.List import qualified Data.Map as M @@ -226,7 +227,7 @@ -- | Class for responses that are fully loaded into memory class AsMemoryResponse resp where - type MemoryResponse resp :: * + type MemoryResponse resp :: Type loadToMemory :: resp -> ResourceT IO (MemoryResponse resp) -- | Responses that have one main list in them, and perhaps some decoration. @@ -590,7 +591,7 @@ -- | A "signable" request object. Assembles together the Query, and signs it in one go. class SignQuery request where -- | Additional information, like API endpoints and service-specific preferences. - type ServiceConfiguration request :: * {- Query Type -} -> * + type ServiceConfiguration request :: Type {- Query Type -} -> Type -- | Create a 'SignedQuery' from a request, additional 'Info', and 'SignatureData'. signQuery :: request -> ServiceConfiguration request queryType -> SignatureData -> SignedQuery diff --git a/Aws/S3/Commands/Multipart.hs b/Aws/S3/Commands/Multipart.hs --- a/Aws/S3/Commands/Multipart.hs +++ b/Aws/S3/Commands/Multipart.hs @@ -1,5 +1,5 @@ module Aws.S3.Commands.Multipart - where +where import Aws.Aws import Aws.Core import Aws.S3.Core @@ -370,7 +370,7 @@ -> T.Text -> T.Text -> T.Text - -> Conduit BL.ByteString m T.Text + -> ConduitT BL.ByteString T.Text m () putConduit cfg s3cfg mgr bucket object uploadId = loop 1 where loop n = do @@ -383,13 +383,13 @@ loop (n+1) Nothing -> return () -chunkedConduit :: (MonadResource m) => Integer -> Conduit B8.ByteString m BL.ByteString +chunkedConduit :: (MonadResource m) => Integer -> ConduitT B8.ByteString BL.ByteString m () chunkedConduit size = loop 0 [] where - loop :: Monad m => Integer -> [B8.ByteString] -> Conduit B8.ByteString m BL.ByteString + loop :: Monad m => Integer -> [B8.ByteString] -> ConduitT B8.ByteString BL.ByteString m () loop cnt str = await >>= maybe (yieldChunk str) go where - go :: Monad m => B8.ByteString -> Conduit B8.ByteString m BL.ByteString + go :: Monad m => B8.ByteString -> ConduitT B8.ByteString BL.ByteString m () go line | size <= len = yieldChunk newStr >> loop 0 [] | otherwise = loop len newStr @@ -397,7 +397,7 @@ len = fromIntegral (B8.length line) + cnt newStr = line:str - yieldChunk :: Monad m => [B8.ByteString] -> Conduit i m BL.ByteString + yieldChunk :: Monad m => [B8.ByteString] -> ConduitT i BL.ByteString m () yieldChunk = yield . BL.fromChunks . reverse multipartUpload :: @@ -406,15 +406,15 @@ -> HTTP.Manager -> T.Text -> T.Text - -> Conduit () (ResourceT IO) B8.ByteString + -> ConduitT () B8.ByteString (ResourceT IO) () -> Integer -> ResourceT IO () multipartUpload cfg s3cfg mgr bucket object src chunkSize = do uploadId <- liftIO $ getUploadId cfg s3cfg mgr bucket object - etags <- src - $= chunkedConduit chunkSize - $= putConduit cfg s3cfg mgr bucket object uploadId - $$ CL.consume + etags <- (src + .| chunkedConduit chunkSize + .| putConduit cfg s3cfg mgr bucket object uploadId + ) `connect` CL.consume void $ liftIO $ sendEtag cfg s3cfg mgr bucket object uploadId etags multipartUploadSink :: MonadResource m @@ -424,7 +424,7 @@ -> T.Text -- ^ Bucket name -> T.Text -- ^ Object name -> Integer -- ^ chunkSize (minimum: 5MB) - -> Sink B8.ByteString m () + -> ConduitT B8.ByteString Void m () multipartUploadSink cfg s3cfg = multipartUploadSinkWithInitiator cfg s3cfg postInitiateMultipartUpload multipartUploadWithInitiator :: @@ -434,15 +434,15 @@ -> HTTP.Manager -> T.Text -> T.Text - -> Conduit () (ResourceT IO) B8.ByteString + -> ConduitT () B8.ByteString (ResourceT IO) () -> Integer -> ResourceT IO () multipartUploadWithInitiator cfg s3cfg initiator mgr bucket object src chunkSize = do uploadId <- liftIO $ imurUploadId <$> memoryAws cfg s3cfg mgr (initiator bucket object) - etags <- src - $= chunkedConduit chunkSize - $= putConduit cfg s3cfg mgr bucket object uploadId - $$ CL.consume + etags <- (src + .| chunkedConduit chunkSize + .| putConduit cfg s3cfg mgr bucket object uploadId + ) `connect` CL.consume void $ liftIO $ sendEtag cfg s3cfg mgr bucket object uploadId etags multipartUploadSinkWithInitiator :: MonadResource m @@ -453,10 +453,10 @@ -> T.Text -- ^ Bucket name -> T.Text -- ^ Object name -> Integer -- ^ chunkSize (minimum: 5MB) - -> Sink B8.ByteString m () + -> ConduitT B8.ByteString Void m () multipartUploadSinkWithInitiator cfg s3cfg initiator mgr bucket object chunkSize = do uploadId <- liftIO $ imurUploadId <$> memoryAws cfg s3cfg mgr (initiator bucket object) etags <- chunkedConduit chunkSize - $= putConduit cfg s3cfg mgr bucket object uploadId - $= CL.consume + .| putConduit cfg s3cfg mgr bucket object uploadId + .| CL.consume void $ liftIO $ sendEtag cfg s3cfg mgr bucket object uploadId etags diff --git a/Aws/S3/Core.hs b/Aws/S3/Core.hs --- a/Aws/S3/Core.hs +++ b/Aws/S3/Core.hs @@ -67,16 +67,17 @@ deriving (Eq, Show, Read, Typeable) data S3Configuration qt - = S3Configuration { - s3Protocol :: Protocol - , s3Endpoint :: B.ByteString - , s3RequestStyle :: RequestStyle - , s3Port :: Int - , s3ServerSideEncryption :: Maybe ServerSideEncryption - , s3UseUri :: Bool - , s3DefaultExpiry :: NominalDiffTime - , s3SignVersion :: S3SignVersion - } + = S3Configuration + { s3Protocol :: Protocol + , s3Endpoint :: B.ByteString + , s3Region :: Maybe B.ByteString + , s3RequestStyle :: RequestStyle + , s3Port :: Int + , s3ServerSideEncryption :: Maybe ServerSideEncryption + , s3UseUri :: Bool + , s3DefaultExpiry :: NominalDiffTime + , s3SignVersion :: S3SignVersion + } deriving (Show) instance DefaultServiceConfiguration (S3Configuration NormalQuery) where @@ -114,9 +115,10 @@ s3 :: Protocol -> B.ByteString -> Bool -> S3Configuration qt s3 protocol endpoint uri - = S3Configuration { - s3Protocol = protocol + = S3Configuration + { s3Protocol = protocol , s3Endpoint = endpoint + , s3Region = Nothing , s3RequestStyle = BucketStyle , s3Port = defaultPort protocol , s3ServerSideEncryption = Nothing @@ -128,15 +130,16 @@ s3v4 :: Protocol -> B.ByteString -> Bool -> S3SignPayloadMode -> S3Configuration qt s3v4 protocol endpoint uri payload = S3Configuration - { s3Protocol = protocol - , s3Endpoint = endpoint - , s3RequestStyle = BucketStyle - , s3Port = defaultPort protocol - , s3ServerSideEncryption = Nothing - , s3UseUri = uri - , s3DefaultExpiry = 15*60 - , s3SignVersion = S3SignV4 payload - } + { s3Protocol = protocol + , s3Endpoint = endpoint + , s3Region = Nothing + , s3RequestStyle = BucketStyle + , s3Port = defaultPort protocol + , s3ServerSideEncryption = Nothing + , s3UseUri = uri + , s3DefaultExpiry = 15*60 + , s3SignVersion = S3SignV4 payload + } type ErrorCode = T.Text @@ -373,7 +376,7 @@ ) where allQueries = s3QSubresources ++ s3QQuery - region = s3ExtractRegion s3Endpoint + region = fromMaybe (s3ExtractRegion s3Endpoint) s3Region auth = authorizationV4 sd HmacSHA256 region "s3" signedHeaders stringToSign sig = signatureV4 sd HmacSHA256 region "s3" stringToSign cred = credentialV4 sd region "s3" @@ -410,7 +413,10 @@ renderItem (k, Just v) = s3UriEncode True k Sem.<> "=" Sem.<> s3UriEncode True v renderItem (k, Nothing) = s3UriEncode True k Sem.<> "=" --- | see: +-- | Extract a S3 region from the S3 endpoint. AWS encodes the region names +-- in the hostnames of endpoints in a way that makes this possible, +-- see: +-- For other S3 implementations, may instead need to specify s3Region. s3ExtractRegion :: B.ByteString -> B.ByteString s3ExtractRegion "s3.amazonaws.com" = "us-east-1" s3ExtractRegion "s3-external-1.amazonaws.com" = "us-east-1" diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,3 +1,16 @@ +0.24 series +----------- + +NOTES: 0.24 brings technically breaking changes, which should not affect +most users. I recommend using smart constructors and {} matching syntax +whenever possible when interacting with aws types. + +- 0.24 + - [breaking change] Added s3Region constructor to S3Configuration, to + support custom S3 regions. + - Fixed several build warnings. + - Needs base-4.9 or newer. + 0.23 series ----------- @@ -6,7 +19,7 @@ whenever possible when interacting with aws types. - 0.23 - - Support anonymous access of S3 buckets.a + - Support anonymous access of S3 buckets. - [breaking change] added isAnonymousCredentials to Credentials. - Support bytestring 0.11 diff --git a/Examples/DynamoDb.hs b/Examples/DynamoDb.hs --- a/Examples/DynamoDb.hs +++ b/Examples/DynamoDb.hs @@ -121,7 +121,7 @@ let q0 = (scan "devel-1") { sLimit = Just 5 } mgr <- newManager tlsManagerSettings - xs <- runResourceT $ awsIteratedList cfg debugServiceConfig mgr q0 $$ C.consume + xs <- runResourceT $ awsIteratedList cfg debugServiceConfig mgr q0 `connect` C.consume echo ("Pagination returned " ++ show (length xs) ++ " items") diff --git a/Examples/MultipartUpload.hs b/Examples/MultipartUpload.hs --- a/Examples/MultipartUpload.hs +++ b/Examples/MultipartUpload.hs @@ -4,7 +4,7 @@ import qualified Aws.Core as Aws import qualified Aws.S3 as S3 import qualified Data.ByteString.Char8 as B -import Data.Conduit (($$)) +import Data.Conduit (connect) import Data.Conduit.Binary (sourceFile) import qualified Data.Text as T import Network.HTTP.Conduit (newManager, tlsManagerSettings, responseBody) @@ -27,4 +27,4 @@ let s3cfg = S3.s3v4 Aws.HTTPS (B.pack endpoint) False S3.SignWithEffort mgr <- newManager tlsManagerSettings runResourceT $ - sourceFile file $$ S3.multipartUploadSink cfg s3cfg mgr (T.pack bucket) (T.pack obj) (chunkSize*1024*1024) + sourceFile file `connect` S3.multipartUploadSink cfg s3cfg mgr (T.pack bucket) (T.pack obj) (chunkSize*1024*1024) diff --git a/Examples/NukeBucket.hs b/Examples/NukeBucket.hs --- a/Examples/NukeBucket.hs +++ b/Examples/NukeBucket.hs @@ -30,7 +30,7 @@ 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) + src `C.connect` CL.mapM_ (deleteObjects . S3.gbrContents <=< Aws.readResponseIO) liftIO $ putStrLn ("Deleting bucket: " ++ show bucket) _ <- Aws.pureAws cfg s3cfg mgr (S3.DeleteBucket bucket) return () diff --git a/aws.cabal b/aws.cabal --- a/aws.cabal +++ b/aws.cabal @@ -1,5 +1,5 @@ Name: aws -Version: 0.23 +Version: 0.24 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 . Homepage: http://github.com/aristidb/aws @@ -19,7 +19,7 @@ Source-repository this type: git location: https://github.com/aristidb/aws.git - tag: 0.23 + tag: 0.24 Source-repository head type: git @@ -130,7 +130,7 @@ Build-depends: aeson >= 2.0.0.0, attoparsec >= 0.11 && < 0.15, - base >= 4.6 && < 5, + base >= 4.9 && < 5, base16-bytestring >= 0.1 && < 1.1, base64-bytestring >= 1.0 && < 1.3, blaze-builder >= 0.2.1.4 && < 0.5, diff --git a/tests/DynamoDb/Main.hs b/tests/DynamoDb/Main.hs --- a/tests/DynamoDb/Main.hs +++ b/tests/DynamoDb/Main.hs @@ -138,7 +138,8 @@ -- counts the number of TCP connections ref <- newIORef (0 :: Int) - void . HTTP.withManager (managerSettings ref) $ \manager -> runExceptT $ + manager <- HTTP.newManager (managerSettings ref) + void $ runExceptT $ flip catchE (error . T.unpack) . replicateM_ 3 $ do void $ dyT cfg manager DY.ListTables mustFail . dyT cfg manager $ DY.DescribeTable "____" diff --git a/tests/S3/Main.hs b/tests/S3/Main.hs --- a/tests/S3/Main.hs +++ b/tests/S3/Main.hs @@ -228,10 +228,10 @@ (cfg, s3cfg, mgr) <- setup resp <- runResourceT $ do uploadId <- liftIO $ getUploadId cfg s3cfg mgr bucket k - etags <- sourceLazy testStr - $= chunkedConduit 65536 - $= putConduit cfg s3cfg mgr bucket k uploadId - $$ sinkList + etags <- (sourceLazy testStr + .| chunkedConduit 65536 + .| putConduit cfg s3cfg mgr bucket k uploadId + ) `connect` sinkList liftIO $ sendEtag cfg s3cfg mgr bucket k uploadId etags let Just vid = cmurVersionId resp bs <- runResourceT $ do diff --git a/tests/Sqs/Main.hs b/tests/Sqs/Main.hs --- a/tests/Sqs/Main.hs +++ b/tests/Sqs/Main.hs @@ -35,8 +35,9 @@ import Data.IORef import qualified Data.List as L -import Data.Monoid import qualified Data.Text as T +import Data.Monoid +import Prelude import qualified Network.HTTP.Client as HTTP @@ -353,8 +354,8 @@ ref <- newIORef (0 :: Int) -- Use a single manager for all HTTP requests - void . HTTP.withManager (managerSettings ref) $ \manager -> runExceptT $ - + manager <- HTTP.newManager (managerSettings ref) + void $ runExceptT $ flip catchE (error . T.unpack) . replicateM_ 3 $ do void . sqsT cfg manager $ SQS.ListQueues Nothing mustFail . sqsT cfg manager $ diff --git a/tests/Utils.hs b/tests/Utils.hs --- a/tests/Utils.hs +++ b/tests/Utils.hs @@ -38,7 +38,6 @@ , prop_jsonRoundtrip ) where -import Control.Applicative import Control.Concurrent (threadDelay) import qualified Control.Exception.Lifted as LE import Control.Error hiding (syncIO) @@ -47,10 +46,12 @@ import Control.Monad.IO.Class import Control.Monad.Base import Control.Monad.Trans.Control +import Control.Applicative +import Data.Monoid +import Prelude import Data.Aeson (FromJSON, ToJSON, encode, eitherDecode) import Data.Dynamic (Dynamic) -import Data.Monoid import Data.Proxy import Data.String import qualified Data.Text as T