Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Already on GitHub? Sign in to your account

Just made the minimal amount of changes to get it to work with conduit 0.4. #19

Merged
merged 2 commits into from Apr 11, 2012
Jump to file or symbol
Failed to load files and symbols.
+25 −20
Split
View
@@ -148,7 +148,7 @@ unsafeAwsRef cfg manager metadataRef request = do
logger cfg Debug $ T.pack $ "String to sign: " ++ show (sqStringToSign q)
let httpRequest = queryToHttpRequest q
resp <- runResourceT $ do
- HTTP.Response status headers body <- HTTP.http httpRequest manager
+ HTTP.Response status _ headers body <- HTTP.http httpRequest manager
responseConsumer request metadataRef status headers body
return resp
View
@@ -11,6 +11,7 @@ import qualified Blaze.ByteString.Builder as Blaze
import qualified Data.ByteString as B
import qualified Data.Text as T
import qualified Data.Text.Encoding as T
+import qualified Data.Conduit as C
import qualified Network.HTTP.Conduit as HTTP
import qualified Network.HTTP.Types as HTTP
@@ -28,12 +29,12 @@ data SignedQuery
, sqContentMd5 :: Maybe B.ByteString
, sqAmzHeaders :: HTTP.RequestHeaders
, sqOtherHeaders :: HTTP.RequestHeaders
- , sqBody :: Maybe (HTTP.RequestBody IO)
+ , sqBody :: Maybe (HTTP.RequestBody (C.ResourceT IO))
, sqStringToSign :: B.ByteString
}
--deriving (Show)
-queryToHttpRequest :: SignedQuery -> HTTP.Request IO
+queryToHttpRequest :: SignedQuery -> HTTP.Request (C.ResourceT IO)
queryToHttpRequest SignedQuery{..}
= HTTP.def {
HTTP.method = httpMethod sqMethod
View
@@ -35,7 +35,7 @@ tellMetadataRef r m = modifyIORef r (`mappend` m)
type HTTPResponseConsumer a = HTTP.Status
-> HTTP.ResponseHeaders
- -> Source IO ByteString
+ -> Source (ResourceT IO) ByteString
-> ResourceT IO a
class ResponseConsumer r a where
@@ -46,4 +46,4 @@ instance ResponseConsumer r (HTTP.Response L.ByteString) where
type ResponseMetadata (HTTP.Response L.ByteString) = ()
responseConsumer _ _ status headers bufsource = do
chunks <- bufsource $$ CL.consume
- return (HTTP.Response status headers $ L.fromChunks chunks)
+ return (HTTP.Response status HTTP.http11 headers $ L.fromChunks chunks)
@@ -20,6 +20,7 @@ import qualified Data.CaseInsensitive as CI
import qualified Data.Text as T
import qualified Data.Text.Encoding as T
import qualified Network.HTTP.Conduit as HTTP
+import qualified Data.Conduit as C
data PutObject = PutObject {
poObjectName :: T.Text,
@@ -32,11 +33,11 @@ data PutObject = PutObject {
poExpires :: Maybe Int,
poAcl :: Maybe CannedAcl,
poStorageClass :: Maybe StorageClass,
- poRequestBody :: HTTP.RequestBody IO,
+ poRequestBody :: HTTP.RequestBody (C.ResourceT IO),
poMetadata :: [(T.Text,T.Text)]
}
-putObject :: T.Text -> Bucket -> HTTP.RequestBody IO -> PutObject
+putObject :: T.Text -> Bucket -> HTTP.RequestBody (C.ResourceT IO) -> PutObject
putObject obj bucket body = PutObject obj bucket Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing body []
data PutObjectResponse
View
@@ -20,6 +20,7 @@ import qualified Data.ByteString as B
import qualified Data.ByteString.Char8 as B8
import qualified Data.CaseInsensitive as CI
import qualified Network.HTTP.Conduit as HTTP
+import qualified Data.Conduit as C
import qualified Network.HTTP.Types as HTTP
data S3Query
@@ -33,7 +34,7 @@ data S3Query
, s3QContentMd5 :: Maybe B.ByteString
, s3QAmzHeaders :: HTTP.RequestHeaders
, s3QOtherHeaders :: HTTP.RequestHeaders
- , s3QRequestBody :: Maybe (HTTP.RequestBody IO)
+ , s3QRequestBody :: Maybe (HTTP.RequestBody (C.ResourceT IO))
}
instance Show S3Query where
View
@@ -51,8 +51,8 @@ s3ErrorResponseConsumer status _headers source
= do doc <- source $$ XML.sinkDoc XML.def
let cursor = Cu.fromDocument doc
liftIO $ case parseError cursor of
- Success err -> C.resourceThrow err
- Failure otherErr -> C.resourceThrow otherErr
+ Success err -> C.monadThrow err
+ Failure otherErr -> C.monadThrow otherErr
where
parseError :: Cu.Cursor -> Attempt S3Error
parseError root = do code <- force "Missing error Code" $ root $/ elContent "Code"
View
@@ -42,8 +42,8 @@ sqsErrorResponseConsumer status _headers source
= do doc <- source $$ XML.sinkDoc XML.def
let cursor = Cu.fromDocument doc
liftIO $ case parseError cursor of
- Success err -> C.resourceThrow err
- Failure otherErr -> C.resourceThrow otherErr
+ Success err -> C.monadThrow err
+ Failure otherErr -> C.monadThrow otherErr
where
parseError :: Cu.Cursor -> Attempt SqsError
parseError root = do cursor <- force "Missing Error" $ root $/ Cu.laxElement "Error"
View
@@ -1,8 +1,9 @@
{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE FlexibleContexts #-}
-module Aws.Util
-where
+module Aws.Util where
+import Control.Monad.Trans.Control
import Control.Arrow
import Control.Exception
import Data.ByteString.Char8 ({- IsString -})
@@ -15,7 +16,7 @@ import qualified Data.ByteString as B
import qualified Data.ByteString.UTF8 as BU
import qualified Data.Conduit as C
-tryError :: (Exception e, C.ResourceIO m) => m b -> m (Either e b)
+tryError :: (Exception e, C.MonadResource m, MonadBaseControl IO m) => m b -> m (Either e b)
tryError = Control.Exception.Lifted.try
queryList :: (a -> [(B.ByteString, B.ByteString)]) -> B.ByteString -> [a] -> [(B.ByteString, B.ByteString)]
View
@@ -55,5 +55,5 @@ xmlCursorConsumer parse metadataRef _status _headers source
let Response metadata x = parse cursor
liftIO $ tellMetadataRef metadataRef metadata
case x of
- Failure err -> liftIO $ C.resourceThrow err
+ Failure err -> liftIO $ C.monadThrow err
Success v -> return v
View
@@ -6,7 +6,7 @@ Name: aws
-- The package version. See the Haskell package versioning policy
-- (http://www.haskell.org/haskellwiki/Package_versioning_policy) for
-- standards guiding when and how versions should be incremented.
-Version: 0.3.2
+Version: 0.3.3
-- A short (one-line) description of the package.
Synopsis: Amazon Web Services (AWS) for Haskell
@@ -136,22 +136,23 @@ Library
bytestring == 0.9.*,
case-insensitive >= 0.2 && < 0.5,
cereal == 0.3.*,
- conduit >= 0.2 && < 0.3,
+ conduit >= 0.4 && < 0.5,
crypto-api >= 0.9,
cryptohash >= 0.6 && < 0.8,
directory >= 1.0 && < 1.2,
failure >= 0.1.0.1 && < 0.3,
filepath >= 1.1 && < 1.4,
- http-conduit >= 1.2 && < 1.3,
+ http-conduit >= 1.4 && < 1.5,
http-types >= 0.6 && < 0.7,
lifted-base == 0.1.*,
mtl == 2.*,
+ monad-control >= 0.3,
old-locale == 1.*,
text >= 0.11,
time >= 1.1.4 && < 1.5,
transformers >= 0.2.2.0 && < 0.3,
utf8-string == 0.3.*,
- xml-conduit >= 0.5.0
+ xml-conduit >= 0.7.0
GHC-Options: -Wall