diff --git a/Aws/Aws.hs b/Aws/Aws.hs --- a/Aws/Aws.hs +++ b/Aws/Aws.hs @@ -35,8 +35,8 @@ import Aws.Core import Control.Applicative -import qualified Control.Exception.Lifted as E import Control.Monad +import qualified Control.Monad.Catch as E import Control.Monad.IO.Class import Control.Monad.Trans import Control.Monad.Trans.Resource @@ -91,7 +91,7 @@ baseConfiguration = liftIO $ do cr <- loadCredentialsDefault case cr of - Nothing -> E.throw $ NoCredentialsException "could not locate aws credentials" + Nothing -> E.throwM $ NoCredentialsException "could not locate aws credentials" Just cr' -> return Configuration { timeInfo = Timestamp , credentials = cr' diff --git a/Aws/Core.hs b/Aws/Core.hs --- a/Aws/Core.hs +++ b/Aws/Core.hs @@ -115,7 +115,7 @@ import qualified Data.ByteString.Lazy as L import qualified Data.ByteString.UTF8 as BU import Data.Char -import Data.Conduit (($$+-)) +import Data.Conduit ((.|)) import qualified Data.Conduit as C #if MIN_VERSION_http_conduit(2,2,0) import qualified Data.Conduit.Binary as CB @@ -195,7 +195,7 @@ tellMetadataRef r m = modifyIORef r (`mappend` m) -- | A full HTTP response parser. Takes HTTP status, response headers, and response body. -type HTTPResponseConsumer a = HTTP.Response (C.ResumableSource (ResourceT IO) ByteString) +type HTTPResponseConsumer a = HTTP.Response (C.ConduitM () ByteString (ResourceT IO) ()) -> ResourceT IO a -- | Class for types that AWS HTTP responses can be parsed into. @@ -217,7 +217,7 @@ instance ResponseConsumer r (HTTP.Response L.ByteString) where type ResponseMetadata (HTTP.Response L.ByteString) = () responseConsumer _ _ _ resp = do - bss <- HTTP.responseBody resp $$+- CL.consume + bss <- C.runConduit $ HTTP.responseBody resp .| CL.consume return resp { HTTP.responseBody = L.fromChunks bss } @@ -875,23 +875,13 @@ instance E.Exception NoCredentialsException -- | A helper to throw an 'HTTP.StatusCodeException'. -throwStatusCodeException :: HTTP.Request - -> HTTP.Response (C.ResumableSource (ResourceT IO) ByteString) - -> ResourceT IO a -#if MIN_VERSION_http_conduit(2,2,0) +throwStatusCodeException :: MonadThrow m => HTTP.Request -> HTTP.Response (C.ConduitM () ByteString m ()) -> m a throwStatusCodeException req resp = do let resp' = fmap (const ()) resp -- only take first 10kB of error response - body <- HTTP.responseBody resp C.$$+- CB.take (10*1024) + body <- C.runConduit $ HTTP.responseBody resp .| CB.take (10*1024) let sce = HTTP.StatusCodeException resp' (L.toStrict body) throwM $ HTTP.HttpExceptionRequest req sce -#else -throwStatusCodeException _req resp = do - let cookies = HTTP.responseCookieJar resp - headers = HTTP.responseHeaders resp - status = HTTP.responseStatus resp - throwM $ HTTP.StatusCodeException status headers cookies -#endif -- | A specific element (case-insensitive, ignoring namespace - sadly necessary), extracting only the textual contents. elContent :: T.Text -> Cursor -> [T.Text] @@ -939,7 +929,7 @@ -> IORef m -> HTTPResponseConsumer a xmlCursorConsumer parse metadataRef res - = do doc <- HTTP.responseBody res $$+- XML.sinkDoc XML.def + = do doc <- C.runConduit $ HTTP.responseBody res .| XML.sinkDoc XML.def let cursor = Cu.fromDocument doc let Response metadata x = parse cursor liftIO $ tellMetadataRef metadataRef metadata diff --git a/Aws/DynamoDb/Core.hs b/Aws/DynamoDb/Core.hs --- a/Aws/DynamoDb/Core.hs +++ b/Aws/DynamoDb/Core.hs @@ -143,7 +143,8 @@ import Data.List import qualified Data.Map as M import Data.Maybe -import Data.Monoid +import Data.Monoid () +import qualified Data.Semigroup as Sem import Data.Proxy import Data.Scientific import qualified Data.Serialize as Ser @@ -749,9 +750,12 @@ ", x-amz-id-2=" `mappend` fromMaybe "" id2 +instance Sem.Semigroup DdbResponse where + a <> b = DdbResponse (ddbrCrc a `mplus` ddbrCrc b) (ddbrMsgId a `mplus` ddbrMsgId b) + instance Monoid DdbResponse where mempty = DdbResponse Nothing Nothing - mappend a b = DdbResponse (ddbrCrc a `mplus` ddbrCrc b) (ddbrMsgId a `mplus` ddbrMsgId b) + mappend = (Sem.<>) data Region = Region { @@ -856,7 +860,7 @@ -- for some reason AWS doesn't want the x-amz-security-token in the canonical request amzHeaders = [ ("x-amz-date", sigTime) - , ("x-amz-target", dyApiVersion <> target) + , ("x-amz-target", dyApiVersion Sem.<> target) ] canonicalHeaders = sortBy (compare `on` fst) $ amzHeaders ++ @@ -895,7 +899,7 @@ ------------------------------------------------------------------------------- ddbResponseConsumer :: A.FromJSON a => IORef DdbResponse -> HTTPResponseConsumer a ddbResponseConsumer ref resp = do - val <- HTTP.responseBody resp $$+- sinkParser (A.json' <* AttoB.endOfInput) + val <- runConduit $ HTTP.responseBody resp .| sinkParser (A.json' <* AttoB.endOfInput) case statusCode of 200 -> rSuccess val _ -> rError val @@ -1273,10 +1277,14 @@ in runParser a kf' ks {-# INLINE mplus #-} +instance Sem.Semigroup (Parser a) where + (<>) = mplus + {-# INLINE (<>) #-} + instance Monoid (Parser a) where mempty = fail "mempty" {-# INLINE mempty #-} - mappend = mplus + mappend = (Sem.<>) {-# INLINE mappend #-} apP :: Parser (a -> b) -> Parser a -> Parser b @@ -1330,8 +1338,8 @@ valErr :: forall a. Typeable a => Tagged a DValue -> String -valErr (Tagged dv) = "Can't convert DynamoDb value " <> show dv <> - " into type " <> (show (typeOf (undefined :: a))) +valErr (Tagged dv) = "Can't convert DynamoDb value " Sem.<> show dv Sem.<> + " into type " Sem.<> (show (typeOf (undefined :: a))) -- | Convenience combinator for parsing fields from an 'Item' returned @@ -1345,7 +1353,7 @@ -> Parser a getAttr k m = do case M.lookup k m of - Nothing -> fail ("Key " <> T.unpack k <> " not found") + Nothing -> fail ("Key " Sem.<> T.unpack k Sem.<> " not found") Just dv -> maybe (fail (valErr (Tagged dv :: Tagged a DValue))) return $ fromValue dv @@ -1373,9 +1381,9 @@ -> Parser a parseAttr k m = case M.lookup k m of - Nothing -> fail ("Key " <> T.unpack k <> " not found") + Nothing -> fail ("Key " Sem.<> T.unpack k Sem.<> " not found") Just (DMap dv) -> either (fail "...") return $ fromItem dv - _ -> fail ("Key " <> T.unpack k <> " is not a map!") + _ -> fail ("Key " Sem.<> T.unpack k Sem.<> " is not a map!") ------------------------------------------------------------------------------- -- | Parse an 'Item' into target type using the 'FromDynItem' diff --git a/Aws/Iam/Core.hs b/Aws/Iam/Core.hs --- a/Aws/Iam/Core.hs +++ b/Aws/Iam/Core.hs @@ -28,7 +28,8 @@ import Data.IORef import Data.List (intersperse, sort) import Data.Maybe -import Data.Monoid +import Data.Monoid () +import qualified Data.Semigroup as Sem import Data.Text (Text) import qualified Data.Text as Text import Data.Time @@ -58,11 +59,14 @@ deriving (Show, Typeable) instance Loggable IamMetadata where - toLogText (IamMetadata r) = "IAM: request ID=" <> fromMaybe "" r + toLogText (IamMetadata r) = "IAM: request ID=" Sem.<> fromMaybe "" r +instance Sem.Semigroup IamMetadata where + IamMetadata r1 <> IamMetadata r2 = IamMetadata (r1 `mplus` r2) + instance Monoid IamMetadata where mempty = IamMetadata Nothing - IamMetadata r1 `mappend` IamMetadata r2 = IamMetadata (r1 `mplus` r2) + mappend = (Sem.<>) data IamConfiguration qt = IamConfiguration { diff --git a/Aws/S3/Commands/GetObject.hs b/Aws/S3/Commands/GetObject.hs --- a/Aws/S3/Commands/GetObject.hs +++ b/Aws/S3/Commands/GetObject.hs @@ -11,6 +11,7 @@ import qualified Data.ByteString.Char8 as B8 import qualified Data.ByteString.Lazy as L import qualified Data.Conduit as C +import Data.Conduit ((.|)) import qualified Data.Conduit.List as CL import Data.Maybe import qualified Data.Text as T @@ -44,7 +45,7 @@ data GetObjectResponse = GetObjectResponse { gorMetadata :: ObjectMetadata, - gorResponse :: HTTP.Response (C.ResumableSource (ResourceT IO) B8.ByteString) + gorResponse :: HTTP.Response (C.ConduitM () B8.ByteString (ResourceT IO) ()) } data GetObjectMemoryResponse @@ -96,7 +97,7 @@ instance AsMemoryResponse GetObjectResponse where type MemoryResponse GetObjectResponse = GetObjectMemoryResponse loadToMemory (GetObjectResponse om x) = do - bss <- HTTP.responseBody x C.$$+- CL.consume + bss <- C.runConduit $ HTTP.responseBody x .| CL.consume return $ GetObjectMemoryResponse om x { HTTP.responseBody = L.fromChunks bss } diff --git a/Aws/S3/Core.hs b/Aws/S3/Core.hs --- a/Aws/S3/Core.hs +++ b/Aws/S3/Core.hs @@ -7,13 +7,14 @@ import Control.Monad.IO.Class import Control.Monad.Trans.Resource (MonadThrow, throwM) import Data.Char (isAscii, isAlphaNum, toUpper, ord) -import Data.Conduit (($$+-)) +import Data.Conduit ((.|)) import Data.Function import Data.Functor ((<$>)) import Data.IORef import Data.List import Data.Maybe import Data.Monoid +import qualified Data.Semigroup as Sem import Control.Applicative ((<|>)) import Data.Time import Data.Typeable @@ -164,9 +165,12 @@ } deriving (Show, Typeable) +instance Sem.Semigroup S3Metadata where + S3Metadata a1 r1 <> S3Metadata a2 r2 = S3Metadata (a1 `mplus` a2) (r1 `mplus` r2) + instance Monoid S3Metadata where mempty = S3Metadata Nothing Nothing - S3Metadata a1 r1 `mappend` S3Metadata a2 r2 = S3Metadata (a1 `mplus` a2) (r1 `mplus` r2) + mappend = (Sem.<>) instance Loggable S3Metadata where toLogText (S3Metadata id2 rid) = "S3: request ID=" `mappend` @@ -231,7 +235,7 @@ | otherwise = x1 : merge (x2 : xs) merge xs = xs - urlEncodedS3QObject = HTTP.urlEncode False <$> s3QObject + urlEncodedS3QObject = s3UriEncode False <$> s3QObject (host, path) = case s3RequestStyle of PathStyle -> ([Just s3Endpoint], [Just "/", fmap (`B8.snoc` '/') s3QBucket, urlEncodedS3QObject]) BucketStyle -> ([s3QBucket, Just s3Endpoint], [Just "/", urlEncodedS3QObject]) @@ -337,7 +341,7 @@ , mconcat . catMaybes $ path -- path , s3RenderQuery False $ sort queryString -- query string ] ++ - Map.foldMapWithKey (\a b -> [CI.foldedCase a <> ":" <> b]) canonicalHeaders ++ + Map.foldMapWithKey (\a b -> [CI.foldedCase a Sem.<> ":" Sem.<> b]) canonicalHeaders ++ [ "" -- end headers , signedHeaders , amzHeaders Map.! hAmzContentSha256 @@ -392,8 +396,8 @@ qmf = if qm then ("?":) else id renderItem :: HTTP.QueryItem -> B8.ByteString - renderItem (k, Just v) = s3UriEncode True k <> "=" <> s3UriEncode True v - renderItem (k, Nothing) = s3UriEncode True k <> "=" + renderItem (k, Just v) = s3UriEncode True k Sem.<> "=" Sem.<> s3UriEncode True v + renderItem (k, Nothing) = s3UriEncode True k Sem.<> "=" -- | see: s3ExtractRegion :: B.ByteString -> B.ByteString @@ -418,7 +422,6 @@ where inner' resp = do !res <- inner resp - C.closeResumableSource (HTTP.responseBody resp) return res s3BinaryResponseConsumer :: HTTPResponseConsumer a @@ -444,7 +447,7 @@ s3ErrorResponseConsumer :: HTTPResponseConsumer a s3ErrorResponseConsumer resp - = do doc <- HTTP.responseBody resp $$+- XML.sinkDoc XML.def + = do doc <- C.runConduit $ HTTP.responseBody resp .| XML.sinkDoc XML.def let cursor = Cu.fromDocument doc liftIO $ case parseError cursor of Right err -> throwM err @@ -458,7 +461,7 @@ accessKeyId = listToMaybe $ root $/ elContent "AWSAccessKeyId" bucket = listToMaybe $ root $/ elContent "Bucket" endpointRaw = listToMaybe $ root $/ elContent "Endpoint" - endpoint = T.encodeUtf8 <$> (T.stripPrefix (fromMaybe "" bucket <> ".") =<< endpointRaw) + endpoint = T.encodeUtf8 <$> (T.stripPrefix (fromMaybe "" bucket Sem.<> ".") =<< endpointRaw) stringToSign = do unprocessed <- listToMaybe $ root $/ elCont "StringToSignBytes" bytes <- mapM readHex2 $ words unprocessed return $ B.pack bytes diff --git a/Aws/Ses/Core.hs b/Aws/Ses/Core.hs --- a/Aws/Ses/Core.hs +++ b/Aws/Ses/Core.hs @@ -33,6 +33,7 @@ import Data.IORef import Data.Maybe import Data.Monoid +import qualified Data.Semigroup as Sem import Data.Text (Text) import qualified Data.Text.Encoding as TE import Data.Typeable @@ -61,9 +62,12 @@ instance Loggable SesMetadata where toLogText (SesMetadata rid) = "SES: request ID=" `mappend` fromMaybe "" rid +instance Sem.Semigroup SesMetadata where + SesMetadata r1 <> SesMetadata r2 = SesMetadata (r1 `mplus` r2) + instance Monoid SesMetadata where mempty = SesMetadata Nothing - SesMetadata r1 `mappend` SesMetadata r2 = SesMetadata (r1 `mplus` r2) + mappend = (Sem.<>) data SesConfiguration qt = SesConfiguration { @@ -184,11 +188,13 @@ s = Blaze.fromByteString one = 1 :: Int -instance Monoid Destination where - mempty = Destination [] [] [] - mappend (Destination a1 a2 a3) (Destination b1 b2 b3) = +instance Sem.Semigroup Destination where + (Destination a1 a2 a3) <> (Destination b1 b2 b3) = Destination (a1 ++ b1) (a2 ++ b2) (a3 ++ b3) +instance Monoid Destination where + mempty = Destination [] [] [] + mappend = (Sem.<>) -- | An e-mail address. type EmailAddress = Text diff --git a/Aws/SimpleDb/Core.hs b/Aws/SimpleDb/Core.hs --- a/Aws/SimpleDb/Core.hs +++ b/Aws/SimpleDb/Core.hs @@ -12,6 +12,7 @@ import Data.List import Data.Maybe import Data.Monoid +import qualified Data.Semigroup as Sem import qualified Data.Text as T import qualified Data.Text.Encoding as T import Data.Typeable @@ -46,9 +47,12 @@ ", box usage=" `mappend` fromMaybe "" bu +instance Sem.Semigroup SdbMetadata where + SdbMetadata r1 b1 <> SdbMetadata r2 b2 = SdbMetadata (r1 `mplus` r2) (b1 `mplus` b2) + instance Monoid SdbMetadata where mempty = SdbMetadata Nothing Nothing - SdbMetadata r1 b1 `mappend` SdbMetadata r2 b2 = SdbMetadata (r1 `mplus` r2) (b1 `mplus` b2) + mappend = (Sem.<>) data SdbConfiguration qt = SdbConfiguration { diff --git a/Aws/Sqs/Core.hs b/Aws/Sqs/Core.hs --- a/Aws/Sqs/Core.hs +++ b/Aws/Sqs/Core.hs @@ -11,11 +11,13 @@ import Control.Monad.Trans.Resource (MonadThrow, throwM) import qualified Data.ByteString as B import qualified Data.ByteString.Char8 as BC -import Data.Conduit (($$+-)) +import qualified Data.Conduit +import Data.Conduit ((.|)) import Data.IORef import Data.List import Data.Maybe import Data.Monoid +import qualified Data.Semigroup as Sem import Data.Ord import qualified Data.Text as T import qualified Data.Text.Encoding as T @@ -64,9 +66,12 @@ ", x-amz-id-2=" `mappend` fromMaybe "" id2 +instance Sem.Semigroup SqsMetadata where + SqsMetadata a1 r1 <> SqsMetadata a2 r2 = SqsMetadata (a1 `mplus` a2) (r1 `mplus` r2) + instance Monoid SqsMetadata where mempty = SqsMetadata Nothing Nothing - SqsMetadata a1 r1 `mappend` SqsMetadata a2 r2 = SqsMetadata (a1 `mplus` a2) (r1 `mplus` r2) + mappend = (Sem.<>) data SqsAuthorization = SqsAuthorizationHeader @@ -248,7 +253,7 @@ sqsErrorResponseConsumer :: HTTPResponseConsumer a sqsErrorResponseConsumer resp - = do doc <- HTTP.responseBody resp $$+- XML.sinkDoc XML.def + = do doc <- Data.Conduit.runConduit $ HTTP.responseBody resp .| XML.sinkDoc XML.def let cursor = Cu.fromDocument doc liftIO $ case parseError cursor of Right err -> throwM err diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,3 +1,11 @@ +0.20 series +----------- + +- 0.20 + - Update to conduit 1.3 and http-conduit 2.3 (breaking API change + due to removal of ResumableSource, which was used in public APIs) + - S3: Fix to V2 string signing + 0.19 series ----------- diff --git a/Examples/DynamoDb.hs b/Examples/DynamoDb.hs --- a/Examples/DynamoDb.hs +++ b/Examples/DynamoDb.hs @@ -11,12 +11,13 @@ import Control.Concurrent import Control.Monad import Control.Monad.Catch +import Control.Monad.Trans.Resource import Control.Applicative import Data.Conduit import Data.Maybe import qualified Data.Conduit.List as C import qualified Data.Text as T -import Network.HTTP.Conduit (withManager) +import Network.HTTP.Conduit (newManager, tlsManagerSettings) ------------------------------------------------------------------------------- createTableAndWait :: IO () @@ -119,8 +120,8 @@ echo "Now paginating in increments of 5..." let q0 = (scan "devel-1") { sLimit = Just 5 } - xs <- withManager $ \mgr -> do - awsIteratedList cfg debugServiceConfig mgr q0 $$ C.consume + mgr <- newManager tlsManagerSettings + xs <- runResourceT $ awsIteratedList cfg debugServiceConfig mgr q0 $$ C.consume echo ("Pagination returned " ++ show (length xs) ++ " items") diff --git a/Examples/GetObject.hs b/Examples/GetObject.hs --- a/Examples/GetObject.hs +++ b/Examples/GetObject.hs @@ -2,9 +2,10 @@ import qualified Aws import qualified Aws.S3 as S3 -import Data.Conduit (($$+-)) +import Control.Monad.Trans.Resource +import Data.Conduit ((.|), runConduit) import Data.Conduit.Binary (sinkFile) -import Network.HTTP.Conduit (withManager, responseBody) +import Network.HTTP.Conduit (newManager, tlsManagerSettings, responseBody) main :: IO () main = do @@ -13,11 +14,12 @@ let s3cfg = Aws.defServiceConfig :: S3.S3Configuration Aws.NormalQuery {- Set up a ResourceT region with an available HTTP manager. -} - withManager $ \mgr -> do + mgr <- newManager tlsManagerSettings + runResourceT $ do {- Create a request object with S3.getObject and run the request with pureAws. -} S3.GetObjectResponse { S3.gorResponse = rsp } <- Aws.pureAws cfg s3cfg mgr $ S3.getObject "haskell-aws" "cloud-remote.pdf" {- Save the response to a file. -} - responseBody rsp $$+- sinkFile "cloud-remote.pdf" + runConduit $ responseBody rsp .| sinkFile "cloud-remote.pdf" diff --git a/Examples/GetObjectGoogle.hs b/Examples/GetObjectGoogle.hs --- a/Examples/GetObjectGoogle.hs +++ b/Examples/GetObjectGoogle.hs @@ -3,9 +3,10 @@ import qualified Aws import qualified Aws.Core as Aws import qualified Aws.S3 as S3 -import Data.Conduit (($$+-)) +import Control.Monad.Trans.Resource +import Data.Conduit ((.|), runConduit) import Data.Conduit.Binary (sinkFile) -import Network.HTTP.Conduit (withManager, responseBody) +import Network.HTTP.Conduit (newManager, tlsManagerSettings, responseBody) main :: IO () main = do @@ -13,7 +14,8 @@ let cfg = Aws.Configuration Aws.Timestamp creds (Aws.defaultLog Aws.Debug) Nothing let s3cfg = S3.s3 Aws.HTTP "storage.googleapis.com" False {- Set up a ResourceT region with an available HTTP manager. -} - withManager $ \mgr -> do + mgr <- newManager tlsManagerSettings + runResourceT $ do {- Create a request object with S3.getObject and run the request with pureAws. -} S3.GetObjectResponse { S3.gorResponse = rsp } <- Aws.pureAws cfg s3cfg mgr $ @@ -21,4 +23,4 @@ S3.getObject "uspto-pair" "applications/05900016.zip" {- Save the response to a file. -} - responseBody rsp $$+- sinkFile "getobject-test.zip" + runConduit $ responseBody rsp .| sinkFile "getobject-test.zip" diff --git a/Examples/GetObjectV4.hs b/Examples/GetObjectV4.hs --- a/Examples/GetObjectV4.hs +++ b/Examples/GetObjectV4.hs @@ -4,7 +4,7 @@ import qualified Aws.Core as Aws import qualified Aws.S3 as S3 import Control.Monad.Trans.Resource -import Data.Conduit (($$+-)) +import Data.Conduit ((.|), runConduit) import Data.Conduit.Binary (sinkFile) import Network.HTTP.Conduit (newManager, tlsManagerSettings, responseBody) @@ -24,4 +24,4 @@ S3.getObject "haskell-aws" "cloud-remote.pdf" {- Save the response to a file. -} - responseBody rsp $$+- sinkFile "cloud-remote.pdf" + runConduit $ responseBody rsp .| sinkFile "cloud-remote.pdf" diff --git a/Examples/MultipartTransfer.hs b/Examples/MultipartTransfer.hs --- a/Examples/MultipartTransfer.hs +++ b/Examples/MultipartTransfer.hs @@ -7,10 +7,10 @@ import Aws.Aws (Configuration (..)) import qualified Aws.S3 as S3 import Control.Applicative ((<$>)) -import Data.Conduit (unwrapResumable) +import Control.Monad.Trans.Resource import qualified Data.Text as T import Network.HTTP.Conduit (http, parseUrl, responseBody, - withManager) + newManager, tlsManagerSettings) import System.Environment (getArgs) main :: IO () @@ -27,9 +27,9 @@ case args of [sourceUrl,destBucket,destObj] -> do request <- parseUrl sourceUrl - withManager $ \mgr -> do - resumableSource <- responseBody <$> http request mgr - (source, _) <- unwrapResumable resumableSource + mgr <- newManager tlsManagerSettings + runResourceT $ do + source <- responseBody <$> http request mgr let initiator b o = (S3.postInitiateMultipartUpload b o){S3.imuAcl = Just S3.AclPublicRead} S3.multipartUploadWithInitiator cfg{credentials = creds} s3cfg initiator mgr (T.pack destBucket) (T.pack destObj) source (10*1024*1024) _ -> do diff --git a/Examples/NukeBucket.hs b/Examples/NukeBucket.hs --- a/Examples/NukeBucket.hs +++ b/Examples/NukeBucket.hs @@ -7,7 +7,8 @@ import Data.Text (pack) import Control.Monad ((<=<)) import Control.Monad.IO.Class (liftIO) -import Network.HTTP.Conduit (withManager, responseBody) +import Control.Monad.Trans.Resource +import Network.HTTP.Conduit (newManager, tlsManagerSettings, responseBody) import System.Environment (getArgs) main :: IO () @@ -19,7 +20,8 @@ let s3cfg = Aws.defServiceConfig :: S3.S3Configuration Aws.NormalQuery {- Set up a ResourceT region with an available HTTP manager. -} - withManager $ \mgr -> do + mgr <- newManager tlsManagerSettings + runResourceT $ do let src = Aws.awsIteratedSource cfg s3cfg mgr (S3.getBucket bucket) let deleteObjects [] = return () deleteObjects os = diff --git a/Examples/PutBucketNearLine.hs b/Examples/PutBucketNearLine.hs --- a/Examples/PutBucketNearLine.hs +++ b/Examples/PutBucketNearLine.hs @@ -5,9 +5,9 @@ import qualified Aws import qualified Aws.Core as Aws import qualified Aws.S3 as S3 -import Data.Conduit (($$+-)) import Data.Conduit.Binary (sinkFile) -import Network.HTTP.Conduit (withManager, RequestBody(..)) +import Control.Monad.Trans.Resource +import Network.HTTP.Conduit (newManager, tlsManagerSettings, RequestBody(..)) import Control.Monad.IO.Class import Control.Concurrent import System.IO @@ -29,7 +29,8 @@ let s3cfg = S3.s3 Aws.HTTP "storage.googleapis.com" False {- Set up a ResourceT region with an available HTTP manager. -} - withManager $ \mgr -> do + mgr <- newManager tlsManagerSettings + runResourceT $ do {- Create a request object with S3.PutBucket and run the request with pureAws. -} rsp <- Aws.pureAws cfg s3cfg mgr $ diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -67,9 +67,10 @@ import qualified Aws import qualified Aws.S3 as S3 -import Data.Conduit (($$+-)) +import Control.Monad.Trans.Resource +import Data.Conduit ((.|), runConduit) import Data.Conduit.Binary (sinkFile) -import Network.HTTP.Conduit (withManager, responseBody) +import Network.HTTP.Conduit (newManager, tlsManagerSettings, responseBody) main :: IO () main = do @@ -78,14 +79,15 @@ let s3cfg = Aws.defServiceConfig :: S3.S3Configuration Aws.NormalQuery {- Set up a ResourceT region with an available HTTP manager. -} - withManager $ \mgr -> do + mgr <- newManager tlsManagerSettings + runResourceT $ do {- Create a request object with S3.getObject and run the request with pureAws. -} S3.GetObjectResponse { S3.gorResponse = rsp } <- Aws.pureAws cfg s3cfg mgr $ S3.getObject "haskell-aws" "cloud-remote.pdf" {- Save the response to a file. -} - responseBody rsp $$+- sinkFile "cloud-remote.pdf" + runConduit $ responseBody rsp .| sinkFile "cloud-remote.pdf" ``` You can also find this example in the source distribution in the diff --git a/aws.cabal b/aws.cabal --- a/aws.cabal +++ b/aws.cabal @@ -1,5 +1,5 @@ Name: aws -Version: 0.19 +Version: 0.20 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.19 + tag: 0.20 Source-repository head type: git @@ -123,22 +123,23 @@ bytestring >= 0.9 && < 0.11, case-insensitive >= 0.2 && < 1.3, cereal >= 0.3 && < 0.6, - conduit >= 1.1 && < 1.3, - conduit-extra >= 1.1 && < 1.3, + conduit >= 1.3 && < 1.4, + conduit-extra >= 1.3 && < 1.4, containers >= 0.4, cryptonite >= 0.11, data-default >= 0.5.3 && < 0.8, directory >= 1.0 && < 2.0, filepath >= 1.1 && < 1.5, - http-conduit >= 2.1 && < 2.4, + http-conduit >= 2.3 && < 2.4, http-types >= 0.7 && < 1.0, lifted-base >= 0.1 && < 0.3, memory, monad-control >= 0.3, + exceptions >= 0.8 && < 0.11, mtl == 2.*, network == 2.*, old-locale == 1.*, - resourcet >= 1.1 && < 1.2, + resourcet >= 1.2 && < 1.3, safe >= 0.3 && < 0.4, scientific >= 0.3, tagged >= 0.7 && < 0.9, @@ -148,11 +149,14 @@ unordered-containers >= 0.2, utf8-string >= 0.3 && < 1.1, vector >= 0.10, - xml-conduit >= 1.2 && <2.0 + xml-conduit >= 1.8 && <2.0 if !impl(ghc >= 7.6) Build-depends: ghc-prim + if !impl(ghc >= 8.0) + Build-depends: semigroups == 0.18.* + GHC-Options: -Wall Default-Language: Haskell2010 @@ -202,7 +206,8 @@ aws, http-conduit, conduit, - conduit-extra + conduit-extra, + resourcet Default-Language: Haskell2010 @@ -219,7 +224,8 @@ aws, http-conduit, conduit, - conduit-extra + conduit-extra, + resourcet Default-Language: Haskell2010 @@ -257,7 +263,8 @@ http-conduit, conduit, conduit-extra, - text + text, + resourcet Default-Language: Haskell2010 @@ -276,7 +283,8 @@ conduit, conduit-extra, text >=0.1, - transformers + transformers, + resourcet Default-Language: Haskell2010 @@ -295,7 +303,8 @@ conduit, conduit-extra, text >=0.1, - transformers + transformers, + resourcet Default-Language: Haskell2010 @@ -328,6 +337,7 @@ data-default, exceptions, http-conduit, + resourcet, text, conduit @@ -430,7 +440,7 @@ QuickCheck >= 2.7, aeson >= 0.7, bytestring, - conduit-combinators, + conduit, errors >= 2.0, lifted-base >= 0.2, monad-control >= 0.3, diff --git a/tests/S3/Main.hs b/tests/S3/Main.hs --- a/tests/S3/Main.hs +++ b/tests/S3/Main.hs @@ -236,7 +236,7 @@ let Just vid = cmurVersionId resp bs <- runResourceT $ do gor <- pureAws cfg s3cfg mgr (getObject bucket k) { goVersionId = Just vid } - responseBody (gorResponse gor) $$+- sinkLazy + sealConduitT (responseBody (gorResponse gor)) $$+- sinkLazy assertEqual "data do not match" testStr bs ]